diff --git a/.gitignore b/.gitignore index ed8ebf67..4833f776 100644 --- a/.gitignore +++ b/.gitignore @@ -1,8 +1,12 @@ /dist -/dist-newstyle -/.ghc.environment.* -/cabal.project.local -/utils/patch/dist +/lib/*/dist +/lib/boot/pkg/ +/lib/ghc-api-ghcjs/ +/lib/ghci-ghcjs/ +/lib/template-haskell-ghcjs/ +/lib/haddock-api-ghcjs/ +/lib/haddock-library-ghcjs/ +/lib/upstream/ /vendor/ /GNUmakefile TAGS @@ -17,7 +21,11 @@ cabal.sandbox.config *~ \#* .#* +.*.swp /lib/cache/build .stack-work/ .cabal-sandbox/ - +/lib/boot/data/Prim.hs +/lib/boot/data/PrimopWrappers.hs +/lib/boot/data/primops.txt +/lib/boot/data/primops.txt.pp diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 00000000..7f277aaf --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "ghc"] + path = ghc + url = https://github.com/ghcjs/ghc.git diff --git a/.travis.yml b/.travis.yml index 4fff611e..3ad427af 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,8 +1,8 @@ env: - - GHCVER=7.10.3 TEST_PART=CORE1 - - GHCVER=7.10.3 TEST_PART=CORE2 - - GHCVER=7.10.3 TEST_PART=PROFILING - - GHCVER=7.10.3 TEST_PART=GHCJS + - GHCVER=8.2.2 TEST_PART=CORE1 + - GHCVER=8.2.2 TEST_PART=CORE2 + - GHCVER=8.2.2 TEST_PART=PROFILING + - GHCVER=8.2.2 TEST_PART=GHCJS addons: apt: @@ -11,16 +11,14 @@ addons: packages: - build-essential - nodejs - - cabal-install-1.22 - - ghc-7.10.3 - - alex-3.1.4 - - happy-1.19.5 + - cabal-install-2.0.0.1 + - ghc-8.2.2 + - alex-3.2.3 + - happy-1.19.8 before_install: - - export GHCJS_BOOTING=1 - - export GHCJS_BOOTING_STAGE1=1 - - nvm install 4 - - export PATH=$HOME/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/1.22/bin:/opt/alex/3.1.4/bin:/opt/happy/1.19.5/bin:$PATH + - nvm install 8 + - export PATH=$HOME/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/2.0/bin:/opt/alex/3.2.3/bin:/opt/happy/1.19.8/bin:$PATH install: - travis_retry cabal update diff --git a/README.markdown b/README.markdown index 5f6e35b9..0bc61788 100644 --- a/README.markdown +++ b/README.markdown @@ -1,160 +1,106 @@ -Quick Start -=========== -Get GHC 7.10.2 ([MinGHC](https://www.haskell.org/downloads/windows) on Windows) and make sure that `happy` is installed. On linux you may need to install a package like `libtinfo-dev` to make the Haskell `terminfo` package work. - -Now run the following to install the current snapshot of the `master` branch: -``` -$ cabal install http://ghcjs.luite.com/master.tar.gz -$ ghcjs-boot -``` - - -Haskell to JavaScript compiler -============================== - -GHCJS is a Haskell to JavaScript compiler that uses the GHC API. - -GHCJS supports many modern Haskell features, including: - - * All type system extensions supported by GHC - * Lightweight preemptive threading with blackholes, MVar, STM, asynchronous exceptions - * Weak references, CAF deallocation, StableName, StablePtr - * Unboxed arrays, emulated pointers - * Integer support through [JSBN](http://www-cs-students.stanford.edu/~tjw/jsbn/), 32 and 64 bit signed and unsigned arithmetic (`Word64`, `Int32` etc.) - * Cost-centres, stack traces - * Cabal support, GHCJS has its own package database - -And some JavaScript-specific features: - - * new JavaScriptFFI extension, with convenient import patterns, asynchronous FFI and a JSVal FFI type, - * synchronous and asynchronous threads. - -Installation +Introduction ============ -GHCJS can be installed with GHC 7.10.2 or later. - -### Requirements - - - GHC 7.10.2 or higher - - Cabal 2.0.0.2 and cabal-install 2.0.0.0 or higher - - alex and happy - - [node.js](http://nodejs.org) 0.10.28 or higher. GHCJS uses node.js for its build system and for running Template Haskell. - -### Platform-specific preparation - -#### Linux / OS X - - * A recent version of `alex` and `happy` need to be in your `PATH` - * `git`, `make`, `cpp`, `autoreconf` need to be in your `PATH` - * One of the dependencies is the `terminfo` Haskell package, which requires `libtinfo`. On - Debian/Ubuntu this is provided by the `libtinfo-dev` package. - -#### Windows - - * You need a shell that's capable of running autotools scripts (with `git`, `make`, `cpp`, `autoreconf` installed). See the [GHCJS Wiki](https://github.com/ghcjs/ghcjs/wiki/Preparing-the-Windows-build-environment) or the `INSTALL.windows` file for instructions for setting up MSYS2 for this. - * A recent version of `alex` and `happy` need to be in your `PATH` - * Virus scanners often interfere with configure scripts (permission denied errors), - disable on-access scanning before running `ghcjs-boot`. - -### Installation steps - -#### Install GHCJS (for compiler development) - -Get `ghcjs` from Github and install it: - - $ git clone https://github.com/ghcjs/ghcjs.git - $ cabal install ./ghcjs +GHCJS is a Haskell to JavaScript compiler that uses the GHC API. -#### Build the libraries +Quick Start - Developing GHCJS +============================== -Use `ghcjs-boot` to build the base libraries for `GHCJS`: +Starting with GHC version 8.2, GHCJS depends on a customized `ghc` library, +installed under the name `ghc-api-ghcjs` - if you used the Git repository to install: - $ ghcjs-boot --dev +#### getting and preparing the source tree - if you are doing a development build from a different branch than `master`, you need to tell `ghcjs-boot` to use the correct branch of the `ghcjs-boot` and `shims` repositories: - $ ghcjs-boot --dev --ghcjs-boot-dev-branch somebranch --shims-dev-branch +``` +$ git clone https://github.com/ghcjs/ghcjs.git +$ cd ghcjs +$ git submodule update --init +$ ./utils/boot - if you are installing from hackage, the ghcjs source distribution package already includes the correct libraries. run: - $ ghcjs-boot +if you want to build with a Cabal sandbox, use the `makeSandbox.sh` script +to add the local packages. -Some distros install node.js as `nodejs` instead of `node`. Add `--with-node nodejs` to the `ghcjs-boot` command in that case. +``` +$ ./utils/makeSandbox.sh +$ cabal install +``` -Usage -===== +or you can use stack: -`ghcjs` can be invoked with the same command line arguments as `ghc`. The generated programs can be run directly from -the shell with [Node.js](http://nodejs.org/) and [SpiderMonkey jsshell](http://download.cdn.mozilla.net/pub/firefox/nightly/latest-mozilla-central/). -for example: +``` +$ stack build +``` - $ ghcjs -o helloWorld helloWorld.hs - $ node helloWorld.jsexe/all.js - Hello world! +#### Booting GHCJS -### Stack support +The `ghcjs-boot` program builds the "boot" libraries, like `ghc-prim`, `base` and `template-haskell` with GHCJS. After booting, GHCJS can compile regular +Haskell programs and packages. -[stack](https://github.com/commercialhaskell/stack) supports setting up the -GHCJS compiler and building your code. See stack's -[ghcjs documentation](https://docs.haskellstack.org/en/stable/ghcjs/) for -information on how to do this. +``` +$ ghcjs-boot +``` -### Cabal support +when invoked without arguments, ghcjs-boot will build the libraries from +`boot.tar` (unless the current directory contains a `boot.yaml` file), installed in GHCJS' data directory (`boot.tar` is generated +by the `makePackages.sh` script and included in a source distribution). -Use `cabal install --ghcjs packageName` to install a package +Optionally you can point `ghcjs-boot` to a different location, like another +`boot.tar` archive: -Most packages from hackage should work out of the box. The main exception is packages with foreign (non-Haskell) dependencies. -For these packages a JavaScript implementation of the dependencies must be provided. If a package you want to use does -not work, please create a ticket. +``` +$ ghcjs-boot -s location/of/boot.tar +``` -### Sandboxes +or a directory (must contain a `boot.yaml` file): -You can use Cabal sandboxes with GHCJS, create a new sandbox with: +``` +$ ghcjs-boot -s ./lib/boot +``` - $ cabal sandbox init +### GHCJS executables and library paths -Then you can just configure with `--ghcjs` to build with GHCJS inside the sandbox: +The GHCJS binaries like `ghcjs` and `ghcjs-pkg` are private executables +and installed in the `libexec` directory. The `Setup.hs` script installs +wrapper scripts in the `bin` directory to pass the library path to the binary. - $ cabal install --ghcjs +Note: reinstalling GHCJS (`cabal install`) does not cause existing wrapper +scripts to be overwritten. Remove the wrapper scripts first if you want +a fresh copy. -If you also want to set GHCJS as the default compiler in the sandbox, run: +Example: - $ cabal sandbox init - $ echo "compiler: ghcjs" >> cabal.config +`.cabal-sandbox/bin/ghcjs` might contain the following: -Setting the default compiler to `ghcjs` makes `cabal sandbox exec` and `cabal sandbox hc-pkg` use -GHCJS-specific settings. These commands do not know about the configure flags, so setting the default -compiler is the only way to make them use the correct settings for GHCJS. +``` +#!/bin/sh +topdir="/home/luite/.ghcjs/x86_64-linux-8.2.0.1-8.2.2/ghcjs" +executablename="/home/luite/haskell/ghcjs-8.2/ghcjs/.cabal-sandbox/libexec/x86_64-linux-ghc-8.2.2/ghcjs-8.2.0.1/ghcjs" +exec "$executablename" -B"$topdir" ${1+"$@"} +``` -### Package databases +To change the library installation location (`topdir`), modify the scripts +prior to running `ghcjs-boot`. -Use `ghcjs-pkg` to manipulate the GHCJS package database +on Windows, an `options` file is used instead of a wrapper script -The package database and runtime files from the [shims](https://github.com/ghcjs/shims.git) repository are kept in the -GHCJS application data directory, typically `~/.ghcjs/`. Remove this directory to reset your GHCJS installation, you -will need to run `ghcjs-boot --init` again. +#### Generating a source distribution -See [GHCJS introduction](http://weblog.luite.com/wordpress/?p=14) for more examples. +if you work on boot packages that need some for an upstream library, +make sure to update the patches in `/lib/patches` first -Hacking GHCJS -============= +``` +$ ./utils/updatePatches.sh +``` -If you want to hack on GHCJS, please join our friendly community on IRC at `#ghcjs` on freenode (You're also -welcome if you only use the compiler or just want to chat about it!). Read the [HACKING.markdown](HACKING.markdown) document -to get started. The [wiki](https://github.com/ghcjs/ghcjs/wiki) may also contain useful information. +then regenerate the packages and the `/data/boot.tar` archive -JSC and webkit -============== +``` +$ ./utils/makePackages.sh +``` -Applications that use the following libraries should compile with GHCJS -and run in a modern web browser and interface with DOM and JavaScript -in the browser. - * [webkit](https://patch-tag.com/r/hamish/webkit) - Bindings for WebKitGTK+ that provide a low level DOM interface. - * [webkit-javascriptcore](https://github.com/gtk2hs/webkit-javascriptcore) - Low level bindings for JavaScriptCore - * [jsc](https://github.com/ghcjs/jsaddle) - Higher level interface for JavaScriptCore +and the source distribution archive -You can use these libraries without GHCJS to build a native version of -your application (it will use WebKitGTK+ to run without a browser). -If you want to find out more about making GHCJS compatible Haskell -applications check out the [GHCJS Examples](https://github.com/ghcjs/ghcjs-examples/) +``` +$ cabal sdist +``` diff --git a/Setup.hs b/Setup.hs index 8fbf8b65..4d6470de 100644 --- a/Setup.hs +++ b/Setup.hs @@ -1,11 +1,12 @@ +{-# LANGUAGE NamedFieldPuns #-} import Control.Applicative ((<$>), (<*>), pure) import qualified Control.Exception as Ex -import Control.Monad (when) +import Control.Monad (when, forM_) import Data.Char (isSpace) -import Data.List (isPrefixOf, isSuffixOf) -import Data.Maybe (maybe, listToMaybe) -import Data.Version (showVersion) +import Data.List (isPrefixOf, isSuffixOf, partition) +import Data.Maybe (maybe, listToMaybe, fromMaybe) +import Data.Version (makeVersion, showVersion) import Distribution.PackageDescription hiding (Flag) import Distribution.Simple @@ -14,37 +15,41 @@ import Distribution.Simple.Setup import Distribution.Simple.Utils import Distribution.System import Distribution.Verbosity +import Distribution.Version +import Distribution.Types.ExecutableScope +import Distribution.Types.PackageDescription +import Distribution.Types.UnqualComponentName + +import Distribution.Simple.Install +import Distribution.Simple.Register import System.Exit (ExitCode(..)) -import System.Directory (doesFileExist, removeFile, renameFile) -import System.FilePath ((), (<.>), splitExtensions, dropExtensions) +import System.Directory + (doesFileExist, removeFile, renameFile, exeExtension) +import System.FilePath + ((), (<.>), splitExtensions, dropExtensions) import System.IO import System.IO.Error (IOError, isDoesNotExistError) -{- - add all executables that are not wrapped (or require an .options file on Windows) here - -} -notWrapped :: [String] -notWrapped = ["ghcjs-boot", "ghcjs-run"] - main :: IO () main = defaultMainWithHooks ghcjsHooks ghcjsHooks :: UserHooks -ghcjsHooks = simpleUserHooks { preSDist = ghcjsSDist - , postCopy = ghcjsPostCopy - , postInst = \args -> ghcjsPostCopy args . installFlagsToCopyFlags - } +ghcjsHooks = simpleUserHooks + { preSDist = ghcjsSDist + , postCopy = ghcjsPostCopy + , postInst = \args -> ghcjsPostCopy args . installFlagsToCopyFlags + } {- | - Build tar cache archives for ghcjs-boot libraries, shims (the runtime system) and the test suite - for the source distribution. These are required for doing a release installation (no --dev flag) - with ghcjs-boot (at least with the default boot.yaml). + check that we have a decent looking boot.tar file -} ghcjsSDist :: Args -> SDistFlags -> IO HookedBuildInfo ghcjsSDist as flags = do - rawSystemExit (fromFlagOrDefault normal $ sDistVerbosity flags) "bash" ["utils/update_archives.sh"] - return emptyHookedBuildInfo + size <- withFile "data/boot.tar" ReadMode hFileSize + if size < 1000000 + then error "aborting because data/boot.tar looks suspiciously small" + else return emptyHookedBuildInfo -- Necessary because postCopy isn't invoked when install is run. -- Copied from https://github.com/haskell/cabal/blob/589cc887c4ef10f514174e0875d7df1963bdcf71/Cabal/Distribution/Simple.hs#L689 @@ -55,13 +60,25 @@ installFlagsToCopyFlags flags = defaultCopyFlags , copyVerbosity = installVerbosity flags } -ghcjsPostCopy :: Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO () +ghcjsPostCopy :: Args + -> CopyFlags + -> PackageDescription + -> LocalBuildInfo + -> IO () ghcjsPostCopy args flags descr lbi - | (FlagName "no-wrapper-install", True) `elem` configConfigurationsFlags (configFlags lbi) = - return () -- User has opted to skip wrapper script installation. Let's hope they know what they're doing. - -- Executables will keep their original names, e.g. ghcjs.bin, ghcjs-pkg.bin + | any (\(flag, enabled) -> unFlagName flag == "no-wrapper-install" && enabled) + (configConfigurationsFlags (configFlags lbi)) = + return () {- User has opted to skip wrapper script installation. + Let's hope they know what they're doing. + + Executables are "private", in the libexec directory + -} | otherwise = do - wrapperEnv <- getWrapperEnv verbosity descr (copyDest flags) installDirs exes + wrapperEnv <- getWrapperEnv verbosity + descr + (copyDest flags) + installDirs + exes mapM_ (copyWrapper verbosity wrapperEnv descr installDirs) exes where exes = executables descr @@ -73,37 +90,51 @@ ghcjsPostCopy args flags descr lbi data WrapperEnv = WrapperEnv { weTopDir :: FilePath , weBinDir :: FilePath + , weLibexecDir :: FilePath , weVersion :: String , weGhcVersion :: String - } + } deriving (Show) verSuff :: WrapperEnv -> String verSuff env = weVersion env ++ "-" ++ weGhcVersion env -requiresWrapper :: String -> Bool -requiresWrapper exe = exe `notElem` notWrapped - -getWrapperEnv :: Verbosity -> PackageDescription -> Flag CopyDest -> InstallDirs FilePath -> [Executable] -> IO WrapperEnv +getWrapperEnv :: Verbosity + -> PackageDescription + -> Flag CopyDest + -> InstallDirs FilePath + -> [Executable] + -> IO WrapperEnv getWrapperEnv v descr copyDest' installDirs exes - | [Executable name _ bi] <- filter ((=="ghcjs").exeName) exes = + | [Executable name _ _ bi] <- + filter ((=="ghcjs").unUnqualComponentName.exeName) exes = let ghcjsVal xs = - trim <$> rawSystemStdout v (bindir installDirs "ghcjs") ["--ghcjs-setup-print", xs] + trim <$> rawSystemStdout v + (libexecdir installDirs "ghcjs") + ["--ghcjs-setup-print", xs] in WrapperEnv <$> ghcjsVal "--print-default-topdir" - <*> pure (dropPrefix copyDest' $ bindir installDirs) - <*> pure (showVersion . pkgVersion . package $ descr) + <*> pure ( dropPrefix copyDest' $ bindir installDirs) + <*> pure ( dropPrefix copyDest' $ libexecdir installDirs) + <*> pure ( Data.Version.showVersion + . makeVersion + . versionNumbers + . pkgVersion + . package + $ descr + ) <*> ghcjsVal "--numeric-ghc-version" | otherwise = error "cannot find ghcjs executable in package" dropPrefix (Flag (CopyTo pre)) s | isPrefixOf pre s = drop (length pre) s -dropPrefix (Flag (CopyTo pre)) s = error $ "dropPrefix - " ++ show pre ++ " not a prefix of " ++ show s +dropPrefix (Flag (CopyTo pre)) s = error $ "dropPrefix: " ++ show pre ++ + " not a prefix of " ++ show s dropPrefix _ s = s {- | on Windows we can't run shell scripts, so we don't install wrappers just copy program.exe to program-{version}-{ghcversion}.exe - the programs read a program-{version}-{ghcversion}.exe.options file from the - same directory, which contains the command line arguments to prepend + the programs read a program-{version}-{ghcversion}.exe.options file from + the same directory, which contains the command line arguments to prepend installation does not overwrite existing .options files -} @@ -113,35 +144,48 @@ copyWrapperW :: Verbosity -> InstallDirs FilePath -> Executable -> IO () -copyWrapperW v env descr installDirs exe = do - installExecutableFile v srcExe destExeVer -- always make a versioned copy - when (requiresWrapper e) $ do -- we need a wrapper - optionsExists <- doesFileExist destOptions - when (not optionsExists) $ do - options <- replacePlaceholders env <$> readFile srcOptions - withTempFile b "ghcjs-options-XXXXXX.tmp" $ \tmp h -> do - hPutStr h options - hClose h - installOrdinaryFile v tmp destOptions +copyWrapperW v env descr installDirs exe + | exeScope exe /= ExecutablePrivate = pure () + | otherwise = do + installExecutableFile v srcExe destExe + installExecutableFile v srcExe destExeVer -- always make a versioned copy + requiresOptions <- doesFileExist srcOptions + when requiresOptions $ do -- we need a wrapper + optionsExists <- doesFileExist destOptions + when (not optionsExists) $ do + options <- replacePlaceholders env <$> readFile srcOptions + withTempFile b "ghcjs-options-XXXXXX.tmp" $ \tmp h -> do + hPutStr h options + hClose h + installOrdinaryFile v tmp destOptions where - e = exeName exe + e = unUnqualComponentName . exeName $ exe e' = dropExtensions e b = bindir installDirs - srcExe = b e' <.> "exe" -- ex: bin\ghcjs.exe - destExeVer = b e' ++ "-" ++ verSuff env <.> "exe" -- ex: bin\ghcjs-0.1.0-7.8.3.exe (copy of srcExe) - srcOptions = datadir installDirs "lib" "bin" -- ex: lib\ghcjs.exe.options + -- example: libexec\ghcjs.exe + srcExe = libexecdir installDirs e + -- example: bin\ghcjs.exe + -- (copy of srcExe) + destExe = b e + -- example: bin\ghcjs-8.2.0.1-8.2.2.exe + -- (copy of srcExe) + destExeVer = b e' ++ "-" ++ verSuff env <.> "exe" + -- example: lib\ghcjs.exe.options + srcOptions = datadir installDirs "bin" e' <.> "exe" <.> "options" - destOptions = destExeVer <.> "options" -- ex: bin\ghcjs-0.1.0-7.8.3.exe.options (created, existing files not overwritten) + -- example: bin\ghcjs-8.2.0.1-8.2.2.exe.options + -- (created, existing files not overwritten) + destOptions = destExeVer <.> "options" {- | - on non-Windows we copy shell scripts that pass the -B flag to ghcjs, ghcjs-pkg etc + on non-Windows we copy shell scripts that pass the -B flag to ghcjs, + ghcjs-pkg etc - the ghcjs.bin executable is renamed to ghcjs-{version}-{ghcversion}.bin - the wrapper shell script is named ghcjs-{version}-{ghcversion}, with a - an unversioned symlink pointing to it. + installation updates the symlink, but does not overwrite the wrapper + scripts if they already exist - installation updates the symlink, but does not overwrite the wrapper scripts - if they already exist + if no wrapper is required, we simply symlink to the executable in the + libexec directory -} copyWrapperU :: Verbosity -> WrapperEnv @@ -150,30 +194,38 @@ copyWrapperU :: Verbosity -> Executable -> IO () copyWrapperU v env descr installDirs exe - | requiresWrapper e = do - installExecutableFile v (b srcExe) (b destExe) - removeFile (b srcExe) + | exeScope exe /= ExecutablePrivate = pure () + | otherwise = do + requiresWrapper <- doesFileExist srcWrapper + if requiresWrapper + then do + -- install wrapper, but do not overwrite existing files wrapperExists <- doesFileExist (b destWrapperVer) when (not wrapperExists) $ do - script <- replacePlaceholders env <$> readFile srcWrapper - withTempFile (bindir installDirs) "ghcjs-wrapper-XXXXXX.tmp" $ \tmp h -> do - hPutStr h script - hClose h - installExecutableFile v tmp (b destWrapperVer) - linkFileU v b destWrapperVer destWrapper - | otherwise = do - installExecutableFile v (b srcExe) (b srcExe ++ "-" ++ verSuff env) - removeFile (b srcExe) - linkFileU v b (srcExe ++ "-" ++ verSuff env) srcExe + wrapperScript <- replacePlaceholders env <$> readFile srcWrapper + withTempFile b "ghcjs-wrapper-XXXXXX.tmp" $ + \tmp h -> do hPutStr h wrapperScript + hClose h + installExecutableFile v tmp (b destWrapperVer) + else + -- just create symlink + linkFileU v b srcExe destWrapperVer + linkFileU v b destWrapperVer destWrapper where - e = exeName exe + e = unUnqualComponentName . exeName $ exe e' = dropExtensions e b = bindir installDirs - srcExe = e -- ex: bin/ghcjs (removed, replaced with symlink to destExe if there are no wrappers) - destExe = e' ++ "-" ++ verSuff env <.> ".bin" -- ex: bin/ghcjs-0.1.0-7.8.3.bin (copy of srcExe) - srcWrapper = datadir installDirs "lib" "bin" e' <.> "sh" -- ex: etc/ghcjs.sh - destWrapper = e' -- ex: bin/ghcjs (symlink to destWrapperVer, existing files/links overwritten) - destWrapperVer = e' ++ "-" ++ verSuff env -- ex: bin/ghcjs-0.1.0-7.8.3 (created if not exists, existing files not overwritten) + -- example: libexec/ghcjs + -- (replaced with symlink to destExe if there are no wrappers) + srcExe = libexecdir installDirs e + -- example: data/bin/ghcjs.sh + srcWrapper = datadir installDirs "bin" e' <.> "sh" + -- example: bin/ghcjs + -- (symlink to destWrapperVer, existing files/links overwritten) + destWrapper = e + -- example: bin/ghcjs-8.2.0.1-8.2.2 + -- (created if not exists, existing files not overwritten) + destWrapperVer = e ++ "-" ++ verSuff env {- | create a symlink, overwriting the target. unix only. @@ -190,8 +242,17 @@ linkFileU v workingDir src dest = do ignoreDoesNotExist e | isDoesNotExistError e = return () | otherwise = Ex.throw e removeFile (workingDir dest) `Ex.catch` ignoreDoesNotExist - exitCode <- rawSystemIOWithEnv v "/usr/bin/env" ["ln", "-s", src, dest] (Just workingDir) Nothing Nothing Nothing Nothing - when (exitCode /= ExitSuccess) (error $ "could not create symlink " ++ src ++ " -> " ++ dest ++ " in " ++ workingDir) + exitCode <- rawSystemIOWithEnv v + "/usr/bin/env" + ["ln", "-s", src, dest] + (Just workingDir) + Nothing + Nothing + Nothing + Nothing + when (exitCode /= ExitSuccess) + (error $ "could not create symlink " ++ + src ++ " -> " ++ dest ++ " in " ++ workingDir) -- | replace placeholders in a wrapper script or options file replacePlaceholders :: WrapperEnv -> String -> String @@ -199,6 +260,7 @@ replacePlaceholders env xs = foldl (\ys (p,r) -> replace p (r env) ys) xs [ ("{topdir}", weTopDir) , ("{bindir}", weBinDir) + , ("{libexecdir}", weLibexecDir) , ("{version}", weVersion) , ("{ghcversion}", weGhcVersion) ] diff --git a/lib/bin/ghcjs-pkg.exe.options b/data/bin/ghcjs-pkg.exe.options similarity index 100% rename from lib/bin/ghcjs-pkg.exe.options rename to data/bin/ghcjs-pkg.exe.options diff --git a/lib/bin/ghcjs-pkg.sh b/data/bin/ghcjs-pkg.sh old mode 100644 new mode 100755 similarity index 74% rename from lib/bin/ghcjs-pkg.sh rename to data/bin/ghcjs-pkg.sh index 6b68b846..080305a8 --- a/lib/bin/ghcjs-pkg.sh +++ b/data/bin/ghcjs-pkg.sh @@ -2,9 +2,8 @@ # wrapper script to pass the correct options to ghcjs-pkg.bin -executablename="{bindir}/ghcjs-pkg-{version}-{ghcversion}.bin" +executablename="{libexecdir}/ghcjs-pkg" topdir="{topdir}" PKGCONF="$topdir/package.conf.d" exec "$executablename" --global-package-db "$PKGCONF" ${1+"$@"} - diff --git a/lib/bin/ghcjs.exe.options b/data/bin/ghcjs.exe.options similarity index 100% rename from lib/bin/ghcjs.exe.options rename to data/bin/ghcjs.exe.options diff --git a/data/bin/ghcjs.sh b/data/bin/ghcjs.sh new file mode 100755 index 00000000..a2a78429 --- /dev/null +++ b/data/bin/ghcjs.sh @@ -0,0 +1,7 @@ +#!/bin/sh + +# wrapper script to pass the correct -B option to ghcjs + +topdir="{topdir}" +executablename="{libexecdir}/ghcjs" +exec "$executablename" -B"$topdir" ${1+"$@"} diff --git a/lib/bin/haddock-ghcjs.exe.options b/data/bin/haddock-ghcjs.exe.options similarity index 100% rename from lib/bin/haddock-ghcjs.exe.options rename to data/bin/haddock-ghcjs.exe.options diff --git a/lib/bin/haddock-ghcjs.sh b/data/bin/haddock-ghcjs.sh old mode 100644 new mode 100755 similarity index 61% rename from lib/bin/haddock-ghcjs.sh rename to data/bin/haddock-ghcjs.sh index 1ab078a6..6b534527 --- a/lib/bin/haddock-ghcjs.sh +++ b/data/bin/haddock-ghcjs.sh @@ -1,6 +1,6 @@ #!/bin/sh -exedir="{bindir}" -exeprog="haddock-ghcjs-{version}-{ghcversion}.bin" +exedir="{libexecdir}" +exeprog="haddock-ghcjs" executablename="$exedir/$exeprog" topdir="{topdir}" diff --git a/lib/bin/hsc2hs-ghcjs.exe.options b/data/bin/hsc2hs-ghcjs.exe.options similarity index 100% rename from lib/bin/hsc2hs-ghcjs.exe.options rename to data/bin/hsc2hs-ghcjs.exe.options diff --git a/data/bin/hsc2hs-ghcjs.sh b/data/bin/hsc2hs-ghcjs.sh new file mode 100755 index 00000000..e9dc11a5 --- /dev/null +++ b/data/bin/hsc2hs-ghcjs.sh @@ -0,0 +1,8 @@ +#!/bin/sh + +# wrapper script to pass the correct options to hsc2hs + +executablename="{libexecdir}/hsc2hs-ghcjs" +topdir="{topdir}" + +exec "$executablename" ${1+"$@"} diff --git a/lib/cache/boot.tar b/data/boot.tar similarity index 100% rename from lib/cache/boot.tar rename to data/boot.tar diff --git a/ghc b/ghc new file mode 160000 index 00000000..87724c49 --- /dev/null +++ b/ghc @@ -0,0 +1 @@ +Subproject commit 87724c49cd2c20a2bac73be8592c259ecdf9440b diff --git a/ghcjs.cabal b/ghcjs.cabal index 302a5f6a..aaf37911 100644 --- a/ghcjs.cabal +++ b/ghcjs.cabal @@ -1,6 +1,8 @@ Name: ghcjs -Version: 0.2.1 -Description: Haskell to JavaScript compiler +Version: 8.2.0.1 +Synopsis: Haskell to JavaScript compiler +Description: Haskell to JavaScript compiler based on GHC +Category: compiler, web License: MIT License-file: LICENSE Author: Victor Nazarov, Hamish Mackenzie, Luite Stegeman @@ -8,35 +10,12 @@ Copyright: Victor Nazarov, Hamish Mackenzie, Luite Stegeman Maintainer: Luite Stegeman Stability: Experimental Build-Type: Custom -Cabal-Version: >= 1.10 +Cabal-Version: >= 2.0 -data-dir: . -data-files: lib/include/ghcjs/*.h - lib/cache/boot.tar - lib/cache/shims.tar - lib/cache/test.tar - lib/etc/cabalBootConfig - lib/etc/*.yaml - lib/etc/*.html - lib/etc/*.js - lib/etc/*.c-tmpl - lib/etc/*.rc - lib/etc/*.manifest - lib/etc/manifest.webapp - lib/bin/*.sh - lib/bin/*.exe.options - lib/ghcjs-th/LICENSE - lib/ghcjs-th/Setup.hs - lib/ghcjs-th/ghcjs-th.cabal - lib/ghcjs-th/GHCJS/Prim/TH/*.hs - lib/ghcjs-prim/LICENSE - lib/ghcjs-prim/Setup.hs - lib/ghcjs-prim/cbits/*.c - lib/ghcjs-prim/GHCJS/*.hs - lib/ghcjs-prim/GHCJS/Prim/*.hs - lib/ghcjs-prim/GHCJS/Prim/Internal/*.hs - lib/ghcjs-prim/ghcjs-prim.cabal - doc/*.txt +data-dir: data +data-files: *.tar + bin/*.sh + bin/*.exe.options extra-source-files: utils/*.hs @@ -44,9 +23,8 @@ extra-source-files: include/prim/*.hs-incl include/prim/*.txt include/*.h - src-bin/Pkg-708.hs - src-bin/Pkg-710.hs src-bin/haddock/*.hs + HACKING.markdown README.markdown test/LICENSE test/ghcjs-testsuite.cabal @@ -62,10 +40,6 @@ flag compiler-only default: False manual: True -flag network-uri - description: select the network/network-uri >= 2.6 - default: True - -- Don't rename the executables to include the version number in the filename -- and install the wrapper scripts. This means that you need to supply your own -- scripts to pass the correct library paths to the programs. See Setup.hs and @@ -91,6 +65,7 @@ Library Gen2.StgAst, Gen2.Optimizer, Gen2.Dataflow, + Gen2.Deps, Gen2.Printer, Gen2.Linker, Gen2.Shim, @@ -124,16 +99,16 @@ Library Compiler.JMacro.QQ, Compiler.JMacro.ParseTH, Compiler.JMacro.Util, - GHCJS, - -- shared code from the ghcjs-th package, found in lib/ghcjs-th - GHCJS.Prim.TH.Types, - GHCJS.Prim.TH.Serialized + GHCJS other-modules: Paths_ghcjs + autogen-modules: Paths_ghcjs + build-depends: base >= 4 && < 5, - Cabal >= 1.23 && < 1.25, - ghc >= 7.11 && < 8.1, + Cabal >= 2, + ghc-api-ghcjs >= 8.1 && < 8.3, + ghcjs-th, ghc-boot, - ghci, + ghci-ghcjs, directory, filepath, containers, @@ -141,20 +116,20 @@ Library mtl, ghc-paths, template-haskell, - syb >= 0.6 && < 0.7, + template-haskell-ghcjs, + syb >= 0.6 && < 0.8, bytestring >= 0.10 && < 0.11, attoparsec >= 0.12 && < 0.14, - aeson >= 0.7 && < 0.12, + aeson >= 1.2 && < 1.3, text >= 1.2 && < 1.3, wl-pprint-text >= 1.1 && < 1.2, - lens >= 4.0 && < 4.16, + lens >= 4.15 && < 4.16, yaml >= 0.8 && < 0.9, time, - system-filepath, transformers, split >= 0.2 && < 0.3, deepseq, - vector >= 0.10 && < 0.12, + vector >= 0.12 && < 0.13, data-default >= 0.7 && < 0.8, array >= 0.4 && < 0.6, binary >= 0.7 && < 0.9, @@ -163,7 +138,7 @@ Library cryptohash >= 0.11 && < 0.12, hashable, unordered-containers, - optparse-applicative >= 0.11 && < 0.13, + optparse-applicative >= 0.14 && < 0.15, stringsearch >= 0.3 && < 0.4, base16-bytestring >= 0.1 && < 0.2, cryptohash, @@ -171,25 +146,27 @@ Library regex-posix >= 0.90 && < 0.100, safe >= 0.3 && < 0.4, parsec >= 3.1 && < 3.2, + -- fixme haskell-src-exts, bump? haskell-src-exts >= 1.16 && < 1.19, - haskell-src-meta >= 0.6.0.3 && < 0.8 + haskell-src-meta >= 0.6.0.3 && < 0.9 exposed: True buildable: True - hs-source-dirs: src lib/ghcjs-th + hs-source-dirs: src include-dirs: include - GHC-Options: -Wall -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind -auto-all -fprof-auto - + GHC-Options: -Wall -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind -fprof-auto-calls -- the compiler executable, Setup.hs installs a wrapper script that -- supplies the installation directory Executable ghcjs + scope: private Main-Is: Main.hs Default-Language: Haskell2010 hs-source-dirs: src-bin Build-Depends: base >= 4 && < 5, ghcjs - GHC-Options: -rtsopts -with-rtsopts=-N -with-rtsopts=-K256m -threaded + GHC-Options: -rtsopts -with-rtsopts=-N -with-rtsopts=-K256m -threaded -fprof-auto-calls Executable haddock-ghcjs + scope: private if os(Windows) cpp-options: -DWINDOWS Main-Is: Haddock.hs @@ -197,17 +174,18 @@ Executable haddock-ghcjs hs-source-dirs: src-bin, src-bin/haddock Build-Depends: base >= 4 && < 5, process, - ghc, + ghc-api-ghcjs, transformers, transformers-compat, containers, directory, filepath, ghcjs, - haddock-api >= 2.15 + haddock-api-ghcjs >= 2.15 GHC-Options: -Wall Executable hsc2hs-ghcjs + scope: private if os(Windows) cpp-options: -DWINDOWS Main-Is: Hsc2Hs.hs @@ -221,30 +199,22 @@ Executable hsc2hs-ghcjs -- the package manager, like with the compiler, this executable is called -- through a wrapper script Executable ghcjs-pkg + scope: private if flag(compiler-only) Buildable: False - -- cabal sdist is buggy when main-is is inside a conditional. - -- work around it by listing Pkg-708.hs in extra-source-files and - -- including that in Pkg.hs for older compilers - -- if impl(ghc >= 7.9) - -- Main-Is: Pkg.hs - -- else - -- Main-Is: Pkg-708.hs Main-Is: Pkg.hs Default-Language: Haskell2010 Hs-Source-Dirs: src-bin Build-Depends: ghcjs, base >= 4 && < 5, - directory, - process >= 1 && < 1.6, + directory >= 1, + process >= 1, filepath, containers, Cabal, binary, --- bin-package-db, - bytestring - if impl(ghc >= 7.11) - Build-Depends: ghc-boot + bytestring, + ghc-boot if !os(windows) Build-Depends: unix, @@ -255,11 +225,12 @@ Executable ghcjs-pkg -- the boot program, this prepares a ghcjs installation by populating the -- installation directory and building the boot libraries Executable ghcjs-boot + scope: private if flag(compiler-only) Buildable: False if os(Windows) cpp-options: -DWINDOWS - ghc-options: -threaded + ghc-options: -threaded -Wall -fno-warn-orphans -fno-warn-name-shadowing -fno-warn-unused-do-bind -fprof-auto Main-Is: Boot.hs Default-Language: Haskell2010 Hs-Source-Dirs: src-bin @@ -273,27 +244,21 @@ Executable ghcjs-boot unordered-containers, vector, filepath, - aeson, text >= 0.11 && < 1.3, bytestring >= 0.10 && < 0.11, system-filepath >= 0.4 && < 0.5, - shelly >= 1.5 && < 1.7, + shelly >= 1.7 && < 1.8, system-fileio >= 0.3 && < 0.4, - optparse-applicative >= 0.11 && < 0.13, + optparse-applicative >= 0.11 && < 0.15, tar >= 0.5 && < 0.6, - HTTP >= 4000.2 && < 5000, yaml >= 0.8 && < 0.9, - process >= 1.2 && < 1.5, - time >= 1.4 && < 1.7, - unix-compat >= 0.4 && < 0.5, + process >= 1.2, + time >= 1.4 && < 1.9, + unix-compat >= 0.5 && < 0.6, executable-path >= 0 && < 0.1 - if flag(network-uri) - build-depends: network-uri >= 2.6, network >= 2.6 - else - build-depends: network-uri < 2.6, network < 2.6 - Executable ghcjs-run + scope: private if flag(compiler-only) Buildable: False if os(Windows) @@ -307,6 +272,24 @@ Executable ghcjs-run process, filepath +Executable ghcjs-dumparchive + scope: private + if flag(compiler-only) + Buildable: False + if os(Windows) + cpp-options: -DWINDOWS + ghc-options: -threaded + Main-Is: dumpArchive.hs + Default-Language: Haskell2010 + Hs-Source-Dirs: utils + Build-Depends: base >= 4 && < 5, + text, + ghc-api-ghcjs, + ghcjs, + bytestring, + filepath + + -- our test suite, requires JavaScript environments to run the tests: -- - node.js http://nodejs.org/ -- - SpiderMonkey jsshell http://download.cdn.mozilla.net/pub/firefox/nightly/latest-mozilla-central/ @@ -334,7 +317,7 @@ test-suite test aeson, test-framework >= 0.8, test-framework-hunit >= 0.3, - HUnit >= 1.2 && < 1.4, + HUnit >= 1.6 && < 1.7, system-filepath >= 0.4 && < 0.5, system-fileio >= 0.3 && < 0.4, text, @@ -345,17 +328,27 @@ test-suite test bytestring, deepseq, unordered-containers, - shelly >= 1.5 && < 1.7, + shelly >= 1.5 && < 1.8, data-default >= 0.7 && < 0.8, yaml >= 0.8 && < 0.9, optparse-applicative, directory, - http-types >= 0.8 && < 0.10, - warp >= 3.0 && < 3.3, - wai >= 3.0 && < 3.3, - wai-extra >= 3.0 && < 3.1, - wai-app-static >= 3.0 && < 3.2, - wai-websockets >= 3.0 && < 3.1, - websockets >= 0.9 && < 0.10, - webdriver >= 0.8 && < 0.9, - lifted-base >= 0.2 && < 0.3 + http-types >= 0.11 && < 0.12, + warp >= 3.0 && < 3.3, + wai >= 3.0 && < 3.3, + wai-extra >= 3.0 && < 3.1, + wai-app-static >= 3.0 && < 3.2, + wai-websockets >= 3.0 && < 3.1, + websockets >= 0.12 && < 0.13, + webdriver >= 0.8 && < 0.9, + lifted-base >= 0.2 && < 0.3 + +Custom-Setup + Setup-Depends: base, + Cabal >= 2 && < 2.1, + containers, + filepath, + directory, + process, + template-haskell, + transformers diff --git a/include/ghcconfig.h b/include/ghcconfig.h deleted file mode 100644 index 5f10e923..00000000 --- a/include/ghcconfig.h +++ /dev/null @@ -1,7 +0,0 @@ -#ifndef __GHCCONFIG_H__ -#define __GHCCONFIG_H__ - -#include "ghcautoconf.h" -#include "ghcplatform.h" - -#endif diff --git a/include/prim/primop-primop-info-708.hs-incl b/include/prim/primop-primop-info-708.hs-incl deleted file mode 100644 index 0330a543..00000000 --- a/include/prim/primop-primop-info-708.hs-incl +++ /dev/null @@ -1,1016 +0,0 @@ -primOpInfo CharGtOp = mkCompare (fsLit "gtChar#") charPrimTy -primOpInfo CharGeOp = mkCompare (fsLit "geChar#") charPrimTy -primOpInfo CharEqOp = mkCompare (fsLit "eqChar#") charPrimTy -primOpInfo CharNeOp = mkCompare (fsLit "neChar#") charPrimTy -primOpInfo CharLtOp = mkCompare (fsLit "ltChar#") charPrimTy -primOpInfo CharLeOp = mkCompare (fsLit "leChar#") charPrimTy -primOpInfo OrdOp = mkGenPrimOp (fsLit "ord#") [] [charPrimTy] (intPrimTy) -primOpInfo IntAddOp = mkDyadic (fsLit "+#") intPrimTy -primOpInfo IntSubOp = mkDyadic (fsLit "-#") intPrimTy -primOpInfo IntMulOp = mkDyadic (fsLit "*#") intPrimTy -primOpInfo IntMulMayOfloOp = mkDyadic (fsLit "mulIntMayOflo#") intPrimTy -primOpInfo IntQuotOp = mkDyadic (fsLit "quotInt#") intPrimTy -primOpInfo IntRemOp = mkDyadic (fsLit "remInt#") intPrimTy -primOpInfo IntQuotRemOp = mkGenPrimOp (fsLit "quotRemInt#") [] [intPrimTy, intPrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy])) -primOpInfo AndIOp = mkDyadic (fsLit "andI#") intPrimTy -primOpInfo OrIOp = mkDyadic (fsLit "orI#") intPrimTy -primOpInfo XorIOp = mkDyadic (fsLit "xorI#") intPrimTy -primOpInfo NotIOp = mkMonadic (fsLit "notI#") intPrimTy -primOpInfo IntNegOp = mkMonadic (fsLit "negateInt#") intPrimTy -primOpInfo IntAddCOp = mkGenPrimOp (fsLit "addIntC#") [] [intPrimTy, intPrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy])) -primOpInfo IntSubCOp = mkGenPrimOp (fsLit "subIntC#") [] [intPrimTy, intPrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy])) -primOpInfo IntGtOp = mkCompare (fsLit ">#") intPrimTy -primOpInfo IntGeOp = mkCompare (fsLit ">=#") intPrimTy -primOpInfo IntEqOp = mkCompare (fsLit "==#") intPrimTy -primOpInfo IntNeOp = mkCompare (fsLit "/=#") intPrimTy -primOpInfo IntLtOp = mkCompare (fsLit "<#") intPrimTy -primOpInfo IntLeOp = mkCompare (fsLit "<=#") intPrimTy -primOpInfo ChrOp = mkGenPrimOp (fsLit "chr#") [] [intPrimTy] (charPrimTy) -primOpInfo Int2WordOp = mkGenPrimOp (fsLit "int2Word#") [] [intPrimTy] (wordPrimTy) -primOpInfo Int2FloatOp = mkGenPrimOp (fsLit "int2Float#") [] [intPrimTy] (floatPrimTy) -primOpInfo Int2DoubleOp = mkGenPrimOp (fsLit "int2Double#") [] [intPrimTy] (doublePrimTy) -primOpInfo Word2FloatOp = mkGenPrimOp (fsLit "word2Float#") [] [wordPrimTy] (floatPrimTy) -primOpInfo Word2DoubleOp = mkGenPrimOp (fsLit "word2Double#") [] [wordPrimTy] (doublePrimTy) -primOpInfo ISllOp = mkGenPrimOp (fsLit "uncheckedIShiftL#") [] [intPrimTy, intPrimTy] (intPrimTy) -primOpInfo ISraOp = mkGenPrimOp (fsLit "uncheckedIShiftRA#") [] [intPrimTy, intPrimTy] (intPrimTy) -primOpInfo ISrlOp = mkGenPrimOp (fsLit "uncheckedIShiftRL#") [] [intPrimTy, intPrimTy] (intPrimTy) -primOpInfo WordAddOp = mkDyadic (fsLit "plusWord#") wordPrimTy -primOpInfo WordAdd2Op = mkGenPrimOp (fsLit "plusWord2#") [] [wordPrimTy, wordPrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy])) -primOpInfo WordSubOp = mkDyadic (fsLit "minusWord#") wordPrimTy -primOpInfo WordMulOp = mkDyadic (fsLit "timesWord#") wordPrimTy -primOpInfo WordMul2Op = mkGenPrimOp (fsLit "timesWord2#") [] [wordPrimTy, wordPrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy])) -primOpInfo WordQuotOp = mkDyadic (fsLit "quotWord#") wordPrimTy -primOpInfo WordRemOp = mkDyadic (fsLit "remWord#") wordPrimTy -primOpInfo WordQuotRemOp = mkGenPrimOp (fsLit "quotRemWord#") [] [wordPrimTy, wordPrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy])) -primOpInfo WordQuotRem2Op = mkGenPrimOp (fsLit "quotRemWord2#") [] [wordPrimTy, wordPrimTy, wordPrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy])) -primOpInfo AndOp = mkDyadic (fsLit "and#") wordPrimTy -primOpInfo OrOp = mkDyadic (fsLit "or#") wordPrimTy -primOpInfo XorOp = mkDyadic (fsLit "xor#") wordPrimTy -primOpInfo NotOp = mkMonadic (fsLit "not#") wordPrimTy -primOpInfo SllOp = mkGenPrimOp (fsLit "uncheckedShiftL#") [] [wordPrimTy, intPrimTy] (wordPrimTy) -primOpInfo SrlOp = mkGenPrimOp (fsLit "uncheckedShiftRL#") [] [wordPrimTy, intPrimTy] (wordPrimTy) -primOpInfo Word2IntOp = mkGenPrimOp (fsLit "word2Int#") [] [wordPrimTy] (intPrimTy) -primOpInfo WordGtOp = mkCompare (fsLit "gtWord#") wordPrimTy -primOpInfo WordGeOp = mkCompare (fsLit "geWord#") wordPrimTy -primOpInfo WordEqOp = mkCompare (fsLit "eqWord#") wordPrimTy -primOpInfo WordNeOp = mkCompare (fsLit "neWord#") wordPrimTy -primOpInfo WordLtOp = mkCompare (fsLit "ltWord#") wordPrimTy -primOpInfo WordLeOp = mkCompare (fsLit "leWord#") wordPrimTy -primOpInfo PopCnt8Op = mkMonadic (fsLit "popCnt8#") wordPrimTy -primOpInfo PopCnt16Op = mkMonadic (fsLit "popCnt16#") wordPrimTy -primOpInfo PopCnt32Op = mkMonadic (fsLit "popCnt32#") wordPrimTy -primOpInfo PopCnt64Op = mkGenPrimOp (fsLit "popCnt64#") [] [word64PrimTy] (wordPrimTy) -primOpInfo PopCntOp = mkMonadic (fsLit "popCnt#") wordPrimTy -primOpInfo BSwap16Op = mkMonadic (fsLit "byteSwap16#") wordPrimTy -primOpInfo BSwap32Op = mkMonadic (fsLit "byteSwap32#") wordPrimTy -primOpInfo BSwap64Op = mkMonadic (fsLit "byteSwap64#") word64PrimTy -primOpInfo BSwapOp = mkMonadic (fsLit "byteSwap#") wordPrimTy -primOpInfo Narrow8IntOp = mkMonadic (fsLit "narrow8Int#") intPrimTy -primOpInfo Narrow16IntOp = mkMonadic (fsLit "narrow16Int#") intPrimTy -primOpInfo Narrow32IntOp = mkMonadic (fsLit "narrow32Int#") intPrimTy -primOpInfo Narrow8WordOp = mkMonadic (fsLit "narrow8Word#") wordPrimTy -primOpInfo Narrow16WordOp = mkMonadic (fsLit "narrow16Word#") wordPrimTy -primOpInfo Narrow32WordOp = mkMonadic (fsLit "narrow32Word#") wordPrimTy -primOpInfo DoubleGtOp = mkCompare (fsLit ">##") doublePrimTy -primOpInfo DoubleGeOp = mkCompare (fsLit ">=##") doublePrimTy -primOpInfo DoubleEqOp = mkCompare (fsLit "==##") doublePrimTy -primOpInfo DoubleNeOp = mkCompare (fsLit "/=##") doublePrimTy -primOpInfo DoubleLtOp = mkCompare (fsLit "<##") doublePrimTy -primOpInfo DoubleLeOp = mkCompare (fsLit "<=##") doublePrimTy -primOpInfo DoubleAddOp = mkDyadic (fsLit "+##") doublePrimTy -primOpInfo DoubleSubOp = mkDyadic (fsLit "-##") doublePrimTy -primOpInfo DoubleMulOp = mkDyadic (fsLit "*##") doublePrimTy -primOpInfo DoubleDivOp = mkDyadic (fsLit "/##") doublePrimTy -primOpInfo DoubleNegOp = mkMonadic (fsLit "negateDouble#") doublePrimTy -primOpInfo Double2IntOp = mkGenPrimOp (fsLit "double2Int#") [] [doublePrimTy] (intPrimTy) -primOpInfo Double2FloatOp = mkGenPrimOp (fsLit "double2Float#") [] [doublePrimTy] (floatPrimTy) -primOpInfo DoubleExpOp = mkMonadic (fsLit "expDouble#") doublePrimTy -primOpInfo DoubleLogOp = mkMonadic (fsLit "logDouble#") doublePrimTy -primOpInfo DoubleSqrtOp = mkMonadic (fsLit "sqrtDouble#") doublePrimTy -primOpInfo DoubleSinOp = mkMonadic (fsLit "sinDouble#") doublePrimTy -primOpInfo DoubleCosOp = mkMonadic (fsLit "cosDouble#") doublePrimTy -primOpInfo DoubleTanOp = mkMonadic (fsLit "tanDouble#") doublePrimTy -primOpInfo DoubleAsinOp = mkMonadic (fsLit "asinDouble#") doublePrimTy -primOpInfo DoubleAcosOp = mkMonadic (fsLit "acosDouble#") doublePrimTy -primOpInfo DoubleAtanOp = mkMonadic (fsLit "atanDouble#") doublePrimTy -primOpInfo DoubleSinhOp = mkMonadic (fsLit "sinhDouble#") doublePrimTy -primOpInfo DoubleCoshOp = mkMonadic (fsLit "coshDouble#") doublePrimTy -primOpInfo DoubleTanhOp = mkMonadic (fsLit "tanhDouble#") doublePrimTy -primOpInfo DoublePowerOp = mkDyadic (fsLit "**##") doublePrimTy -primOpInfo DoubleDecode_2IntOp = mkGenPrimOp (fsLit "decodeDouble_2Int#") [] [doublePrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, wordPrimTy, wordPrimTy, intPrimTy])) -primOpInfo FloatGtOp = mkCompare (fsLit "gtFloat#") floatPrimTy -primOpInfo FloatGeOp = mkCompare (fsLit "geFloat#") floatPrimTy -primOpInfo FloatEqOp = mkCompare (fsLit "eqFloat#") floatPrimTy -primOpInfo FloatNeOp = mkCompare (fsLit "neFloat#") floatPrimTy -primOpInfo FloatLtOp = mkCompare (fsLit "ltFloat#") floatPrimTy -primOpInfo FloatLeOp = mkCompare (fsLit "leFloat#") floatPrimTy -primOpInfo FloatAddOp = mkDyadic (fsLit "plusFloat#") floatPrimTy -primOpInfo FloatSubOp = mkDyadic (fsLit "minusFloat#") floatPrimTy -primOpInfo FloatMulOp = mkDyadic (fsLit "timesFloat#") floatPrimTy -primOpInfo FloatDivOp = mkDyadic (fsLit "divideFloat#") floatPrimTy -primOpInfo FloatNegOp = mkMonadic (fsLit "negateFloat#") floatPrimTy -primOpInfo Float2IntOp = mkGenPrimOp (fsLit "float2Int#") [] [floatPrimTy] (intPrimTy) -primOpInfo FloatExpOp = mkMonadic (fsLit "expFloat#") floatPrimTy -primOpInfo FloatLogOp = mkMonadic (fsLit "logFloat#") floatPrimTy -primOpInfo FloatSqrtOp = mkMonadic (fsLit "sqrtFloat#") floatPrimTy -primOpInfo FloatSinOp = mkMonadic (fsLit "sinFloat#") floatPrimTy -primOpInfo FloatCosOp = mkMonadic (fsLit "cosFloat#") floatPrimTy -primOpInfo FloatTanOp = mkMonadic (fsLit "tanFloat#") floatPrimTy -primOpInfo FloatAsinOp = mkMonadic (fsLit "asinFloat#") floatPrimTy -primOpInfo FloatAcosOp = mkMonadic (fsLit "acosFloat#") floatPrimTy -primOpInfo FloatAtanOp = mkMonadic (fsLit "atanFloat#") floatPrimTy -primOpInfo FloatSinhOp = mkMonadic (fsLit "sinhFloat#") floatPrimTy -primOpInfo FloatCoshOp = mkMonadic (fsLit "coshFloat#") floatPrimTy -primOpInfo FloatTanhOp = mkMonadic (fsLit "tanhFloat#") floatPrimTy -primOpInfo FloatPowerOp = mkDyadic (fsLit "powerFloat#") floatPrimTy -primOpInfo Float2DoubleOp = mkGenPrimOp (fsLit "float2Double#") [] [floatPrimTy] (doublePrimTy) -primOpInfo FloatDecode_IntOp = mkGenPrimOp (fsLit "decodeFloat_Int#") [] [floatPrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy])) -primOpInfo NewArrayOp = mkGenPrimOp (fsLit "newArray#") [alphaTyVar, deltaTyVar] [intPrimTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy])) -primOpInfo SameMutableArrayOp = mkGenPrimOp (fsLit "sameMutableArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, mkMutableArrayPrimTy deltaTy alphaTy] (intPrimTy) -primOpInfo ReadArrayOp = mkGenPrimOp (fsLit "readArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo WriteArrayOp = mkGenPrimOp (fsLit "writeArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo SizeofArrayOp = mkGenPrimOp (fsLit "sizeofArray#") [alphaTyVar] [mkArrayPrimTy alphaTy] (intPrimTy) -primOpInfo SizeofMutableArrayOp = mkGenPrimOp (fsLit "sizeofMutableArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy] (intPrimTy) -primOpInfo IndexArrayOp = mkGenPrimOp (fsLit "indexArray#") [alphaTyVar] [mkArrayPrimTy alphaTy, intPrimTy] ((mkTupleTy UnboxedTuple [alphaTy])) -primOpInfo UnsafeFreezeArrayOp = mkGenPrimOp (fsLit "unsafeFreezeArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkArrayPrimTy alphaTy])) -primOpInfo UnsafeThawArrayOp = mkGenPrimOp (fsLit "unsafeThawArray#") [alphaTyVar, deltaTyVar] [mkArrayPrimTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy])) -primOpInfo CopyArrayOp = mkGenPrimOp (fsLit "copyArray#") [alphaTyVar, deltaTyVar] [mkArrayPrimTy alphaTy, intPrimTy, mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyMutableArrayOp = mkGenPrimOp (fsLit "copyMutableArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CloneArrayOp = mkGenPrimOp (fsLit "cloneArray#") [alphaTyVar] [mkArrayPrimTy alphaTy, intPrimTy, intPrimTy] (mkArrayPrimTy alphaTy) -primOpInfo CloneMutableArrayOp = mkGenPrimOp (fsLit "cloneMutableArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy])) -primOpInfo FreezeArrayOp = mkGenPrimOp (fsLit "freezeArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkArrayPrimTy alphaTy])) -primOpInfo ThawArrayOp = mkGenPrimOp (fsLit "thawArray#") [alphaTyVar, deltaTyVar] [mkArrayPrimTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy])) -primOpInfo CasArrayOp = mkGenPrimOp (fsLit "casArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) -primOpInfo NewByteArrayOp_Char = mkGenPrimOp (fsLit "newByteArray#") [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy])) -primOpInfo NewPinnedByteArrayOp_Char = mkGenPrimOp (fsLit "newPinnedByteArray#") [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy])) -primOpInfo NewAlignedPinnedByteArrayOp_Char = mkGenPrimOp (fsLit "newAlignedPinnedByteArray#") [deltaTyVar] [intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy])) -primOpInfo ByteArrayContents_Char = mkGenPrimOp (fsLit "byteArrayContents#") [] [byteArrayPrimTy] (addrPrimTy) -primOpInfo SameMutableByteArrayOp = mkGenPrimOp (fsLit "sameMutableByteArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy] (intPrimTy) -primOpInfo UnsafeFreezeByteArrayOp = mkGenPrimOp (fsLit "unsafeFreezeByteArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, byteArrayPrimTy])) -primOpInfo SizeofByteArrayOp = mkGenPrimOp (fsLit "sizeofByteArray#") [] [byteArrayPrimTy] (intPrimTy) -primOpInfo SizeofMutableByteArrayOp = mkGenPrimOp (fsLit "sizeofMutableByteArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy] (intPrimTy) -primOpInfo IndexByteArrayOp_Char = mkGenPrimOp (fsLit "indexCharArray#") [] [byteArrayPrimTy, intPrimTy] (charPrimTy) -primOpInfo IndexByteArrayOp_WideChar = mkGenPrimOp (fsLit "indexWideCharArray#") [] [byteArrayPrimTy, intPrimTy] (charPrimTy) -primOpInfo IndexByteArrayOp_Int = mkGenPrimOp (fsLit "indexIntArray#") [] [byteArrayPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexByteArrayOp_Word = mkGenPrimOp (fsLit "indexWordArray#") [] [byteArrayPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexByteArrayOp_Addr = mkGenPrimOp (fsLit "indexAddrArray#") [] [byteArrayPrimTy, intPrimTy] (addrPrimTy) -primOpInfo IndexByteArrayOp_Float = mkGenPrimOp (fsLit "indexFloatArray#") [] [byteArrayPrimTy, intPrimTy] (floatPrimTy) -primOpInfo IndexByteArrayOp_Double = mkGenPrimOp (fsLit "indexDoubleArray#") [] [byteArrayPrimTy, intPrimTy] (doublePrimTy) -primOpInfo IndexByteArrayOp_StablePtr = mkGenPrimOp (fsLit "indexStablePtrArray#") [alphaTyVar] [byteArrayPrimTy, intPrimTy] (mkStablePtrPrimTy alphaTy) -primOpInfo IndexByteArrayOp_Int8 = mkGenPrimOp (fsLit "indexInt8Array#") [] [byteArrayPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexByteArrayOp_Int16 = mkGenPrimOp (fsLit "indexInt16Array#") [] [byteArrayPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexByteArrayOp_Int32 = mkGenPrimOp (fsLit "indexInt32Array#") [] [byteArrayPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexByteArrayOp_Int64 = mkGenPrimOp (fsLit "indexInt64Array#") [] [byteArrayPrimTy, intPrimTy] (int64PrimTy) -primOpInfo IndexByteArrayOp_Word8 = mkGenPrimOp (fsLit "indexWord8Array#") [] [byteArrayPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexByteArrayOp_Word16 = mkGenPrimOp (fsLit "indexWord16Array#") [] [byteArrayPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexByteArrayOp_Word32 = mkGenPrimOp (fsLit "indexWord32Array#") [] [byteArrayPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexByteArrayOp_Word64 = mkGenPrimOp (fsLit "indexWord64Array#") [] [byteArrayPrimTy, intPrimTy] (word64PrimTy) -primOpInfo ReadByteArrayOp_Char = mkGenPrimOp (fsLit "readCharArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, charPrimTy])) -primOpInfo ReadByteArrayOp_WideChar = mkGenPrimOp (fsLit "readWideCharArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, charPrimTy])) -primOpInfo ReadByteArrayOp_Int = mkGenPrimOp (fsLit "readIntArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadByteArrayOp_Word = mkGenPrimOp (fsLit "readWordArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadByteArrayOp_Addr = mkGenPrimOp (fsLit "readAddrArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, addrPrimTy])) -primOpInfo ReadByteArrayOp_Float = mkGenPrimOp (fsLit "readFloatArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatPrimTy])) -primOpInfo ReadByteArrayOp_Double = mkGenPrimOp (fsLit "readDoubleArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doublePrimTy])) -primOpInfo ReadByteArrayOp_StablePtr = mkGenPrimOp (fsLit "readStablePtrArray#") [deltaTyVar, alphaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkStablePtrPrimTy alphaTy])) -primOpInfo ReadByteArrayOp_Int8 = mkGenPrimOp (fsLit "readInt8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadByteArrayOp_Int16 = mkGenPrimOp (fsLit "readInt16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadByteArrayOp_Int32 = mkGenPrimOp (fsLit "readInt32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadByteArrayOp_Int64 = mkGenPrimOp (fsLit "readInt64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64PrimTy])) -primOpInfo ReadByteArrayOp_Word8 = mkGenPrimOp (fsLit "readWord8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadByteArrayOp_Word16 = mkGenPrimOp (fsLit "readWord16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadByteArrayOp_Word32 = mkGenPrimOp (fsLit "readWord32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadByteArrayOp_Word64 = mkGenPrimOp (fsLit "readWord64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64PrimTy])) -primOpInfo WriteByteArrayOp_Char = mkGenPrimOp (fsLit "writeCharArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, charPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_WideChar = mkGenPrimOp (fsLit "writeWideCharArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, charPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Int = mkGenPrimOp (fsLit "writeIntArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Word = mkGenPrimOp (fsLit "writeWordArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Addr = mkGenPrimOp (fsLit "writeAddrArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, addrPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Float = mkGenPrimOp (fsLit "writeFloatArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Double = mkGenPrimOp (fsLit "writeDoubleArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doublePrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_StablePtr = mkGenPrimOp (fsLit "writeStablePtrArray#") [deltaTyVar, alphaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStablePtrPrimTy alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Int8 = mkGenPrimOp (fsLit "writeInt8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Int16 = mkGenPrimOp (fsLit "writeInt16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Int32 = mkGenPrimOp (fsLit "writeInt32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Int64 = mkGenPrimOp (fsLit "writeInt64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Word8 = mkGenPrimOp (fsLit "writeWord8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Word16 = mkGenPrimOp (fsLit "writeWord16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Word32 = mkGenPrimOp (fsLit "writeWord32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Word64 = mkGenPrimOp (fsLit "writeWord64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyByteArrayOp = mkGenPrimOp (fsLit "copyByteArray#") [deltaTyVar] [byteArrayPrimTy, intPrimTy, mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyMutableByteArrayOp = mkGenPrimOp (fsLit "copyMutableByteArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyByteArrayToAddrOp = mkGenPrimOp (fsLit "copyByteArrayToAddr#") [deltaTyVar] [byteArrayPrimTy, intPrimTy, addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyMutableByteArrayToAddrOp = mkGenPrimOp (fsLit "copyMutableByteArrayToAddr#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyAddrToByteArrayOp = mkGenPrimOp (fsLit "copyAddrToByteArray#") [deltaTyVar] [addrPrimTy, mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo SetByteArrayOp = mkGenPrimOp (fsLit "setByteArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CasByteArrayOp_Int = mkGenPrimOp (fsLit "casIntArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo FetchAddByteArrayOp_Int = mkGenPrimOp (fsLit "fetchAddIntArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo NewArrayArrayOp = mkGenPrimOp (fsLit "newArrayArray#") [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableArrayArrayPrimTy deltaTy])) -primOpInfo SameMutableArrayArrayOp = mkGenPrimOp (fsLit "sameMutableArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, mkMutableArrayArrayPrimTy deltaTy] (intPrimTy) -primOpInfo UnsafeFreezeArrayArrayOp = mkGenPrimOp (fsLit "unsafeFreezeArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkArrayArrayPrimTy])) -primOpInfo SizeofArrayArrayOp = mkGenPrimOp (fsLit "sizeofArrayArray#") [] [mkArrayArrayPrimTy] (intPrimTy) -primOpInfo SizeofMutableArrayArrayOp = mkGenPrimOp (fsLit "sizeofMutableArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy] (intPrimTy) -primOpInfo IndexArrayArrayOp_ByteArray = mkGenPrimOp (fsLit "indexByteArrayArray#") [] [mkArrayArrayPrimTy, intPrimTy] (byteArrayPrimTy) -primOpInfo IndexArrayArrayOp_ArrayArray = mkGenPrimOp (fsLit "indexArrayArrayArray#") [] [mkArrayArrayPrimTy, intPrimTy] (mkArrayArrayPrimTy) -primOpInfo ReadArrayArrayOp_ByteArray = mkGenPrimOp (fsLit "readByteArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, byteArrayPrimTy])) -primOpInfo ReadArrayArrayOp_MutableByteArray = mkGenPrimOp (fsLit "readMutableByteArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy])) -primOpInfo ReadArrayArrayOp_ArrayArray = mkGenPrimOp (fsLit "readArrayArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkArrayArrayPrimTy])) -primOpInfo ReadArrayArrayOp_MutableArrayArray = mkGenPrimOp (fsLit "readMutableArrayArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableArrayArrayPrimTy deltaTy])) -primOpInfo WriteArrayArrayOp_ByteArray = mkGenPrimOp (fsLit "writeByteArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, byteArrayPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteArrayArrayOp_MutableByteArray = mkGenPrimOp (fsLit "writeMutableByteArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkMutableByteArrayPrimTy deltaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteArrayArrayOp_ArrayArray = mkGenPrimOp (fsLit "writeArrayArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkArrayArrayPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteArrayArrayOp_MutableArrayArray = mkGenPrimOp (fsLit "writeMutableArrayArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkMutableArrayArrayPrimTy deltaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyArrayArrayOp = mkGenPrimOp (fsLit "copyArrayArray#") [deltaTyVar] [mkArrayArrayPrimTy, intPrimTy, mkMutableArrayArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyMutableArrayArrayOp = mkGenPrimOp (fsLit "copyMutableArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkMutableArrayArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo AddrAddOp = mkGenPrimOp (fsLit "plusAddr#") [] [addrPrimTy, intPrimTy] (addrPrimTy) -primOpInfo AddrSubOp = mkGenPrimOp (fsLit "minusAddr#") [] [addrPrimTy, addrPrimTy] (intPrimTy) -primOpInfo AddrRemOp = mkGenPrimOp (fsLit "remAddr#") [] [addrPrimTy, intPrimTy] (intPrimTy) -primOpInfo Addr2IntOp = mkGenPrimOp (fsLit "addr2Int#") [] [addrPrimTy] (intPrimTy) -primOpInfo Int2AddrOp = mkGenPrimOp (fsLit "int2Addr#") [] [intPrimTy] (addrPrimTy) -primOpInfo AddrGtOp = mkCompare (fsLit "gtAddr#") addrPrimTy -primOpInfo AddrGeOp = mkCompare (fsLit "geAddr#") addrPrimTy -primOpInfo AddrEqOp = mkCompare (fsLit "eqAddr#") addrPrimTy -primOpInfo AddrNeOp = mkCompare (fsLit "neAddr#") addrPrimTy -primOpInfo AddrLtOp = mkCompare (fsLit "ltAddr#") addrPrimTy -primOpInfo AddrLeOp = mkCompare (fsLit "leAddr#") addrPrimTy -primOpInfo IndexOffAddrOp_Char = mkGenPrimOp (fsLit "indexCharOffAddr#") [] [addrPrimTy, intPrimTy] (charPrimTy) -primOpInfo IndexOffAddrOp_WideChar = mkGenPrimOp (fsLit "indexWideCharOffAddr#") [] [addrPrimTy, intPrimTy] (charPrimTy) -primOpInfo IndexOffAddrOp_Int = mkGenPrimOp (fsLit "indexIntOffAddr#") [] [addrPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexOffAddrOp_Word = mkGenPrimOp (fsLit "indexWordOffAddr#") [] [addrPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexOffAddrOp_Addr = mkGenPrimOp (fsLit "indexAddrOffAddr#") [] [addrPrimTy, intPrimTy] (addrPrimTy) -primOpInfo IndexOffAddrOp_Float = mkGenPrimOp (fsLit "indexFloatOffAddr#") [] [addrPrimTy, intPrimTy] (floatPrimTy) -primOpInfo IndexOffAddrOp_Double = mkGenPrimOp (fsLit "indexDoubleOffAddr#") [] [addrPrimTy, intPrimTy] (doublePrimTy) -primOpInfo IndexOffAddrOp_StablePtr = mkGenPrimOp (fsLit "indexStablePtrOffAddr#") [alphaTyVar] [addrPrimTy, intPrimTy] (mkStablePtrPrimTy alphaTy) -primOpInfo IndexOffAddrOp_Int8 = mkGenPrimOp (fsLit "indexInt8OffAddr#") [] [addrPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexOffAddrOp_Int16 = mkGenPrimOp (fsLit "indexInt16OffAddr#") [] [addrPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexOffAddrOp_Int32 = mkGenPrimOp (fsLit "indexInt32OffAddr#") [] [addrPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexOffAddrOp_Int64 = mkGenPrimOp (fsLit "indexInt64OffAddr#") [] [addrPrimTy, intPrimTy] (int64PrimTy) -primOpInfo IndexOffAddrOp_Word8 = mkGenPrimOp (fsLit "indexWord8OffAddr#") [] [addrPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexOffAddrOp_Word16 = mkGenPrimOp (fsLit "indexWord16OffAddr#") [] [addrPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexOffAddrOp_Word32 = mkGenPrimOp (fsLit "indexWord32OffAddr#") [] [addrPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexOffAddrOp_Word64 = mkGenPrimOp (fsLit "indexWord64OffAddr#") [] [addrPrimTy, intPrimTy] (word64PrimTy) -primOpInfo ReadOffAddrOp_Char = mkGenPrimOp (fsLit "readCharOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, charPrimTy])) -primOpInfo ReadOffAddrOp_WideChar = mkGenPrimOp (fsLit "readWideCharOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, charPrimTy])) -primOpInfo ReadOffAddrOp_Int = mkGenPrimOp (fsLit "readIntOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadOffAddrOp_Word = mkGenPrimOp (fsLit "readWordOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadOffAddrOp_Addr = mkGenPrimOp (fsLit "readAddrOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, addrPrimTy])) -primOpInfo ReadOffAddrOp_Float = mkGenPrimOp (fsLit "readFloatOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatPrimTy])) -primOpInfo ReadOffAddrOp_Double = mkGenPrimOp (fsLit "readDoubleOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doublePrimTy])) -primOpInfo ReadOffAddrOp_StablePtr = mkGenPrimOp (fsLit "readStablePtrOffAddr#") [deltaTyVar, alphaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkStablePtrPrimTy alphaTy])) -primOpInfo ReadOffAddrOp_Int8 = mkGenPrimOp (fsLit "readInt8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadOffAddrOp_Int16 = mkGenPrimOp (fsLit "readInt16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadOffAddrOp_Int32 = mkGenPrimOp (fsLit "readInt32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadOffAddrOp_Int64 = mkGenPrimOp (fsLit "readInt64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64PrimTy])) -primOpInfo ReadOffAddrOp_Word8 = mkGenPrimOp (fsLit "readWord8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadOffAddrOp_Word16 = mkGenPrimOp (fsLit "readWord16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadOffAddrOp_Word32 = mkGenPrimOp (fsLit "readWord32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadOffAddrOp_Word64 = mkGenPrimOp (fsLit "readWord64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64PrimTy])) -primOpInfo WriteOffAddrOp_Char = mkGenPrimOp (fsLit "writeCharOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, charPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_WideChar = mkGenPrimOp (fsLit "writeWideCharOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, charPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Int = mkGenPrimOp (fsLit "writeIntOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Word = mkGenPrimOp (fsLit "writeWordOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Addr = mkGenPrimOp (fsLit "writeAddrOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, addrPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Float = mkGenPrimOp (fsLit "writeFloatOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, floatPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Double = mkGenPrimOp (fsLit "writeDoubleOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, doublePrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_StablePtr = mkGenPrimOp (fsLit "writeStablePtrOffAddr#") [alphaTyVar, deltaTyVar] [addrPrimTy, intPrimTy, mkStablePtrPrimTy alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Int8 = mkGenPrimOp (fsLit "writeInt8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Int16 = mkGenPrimOp (fsLit "writeInt16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Int32 = mkGenPrimOp (fsLit "writeInt32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Int64 = mkGenPrimOp (fsLit "writeInt64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Word8 = mkGenPrimOp (fsLit "writeWord8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Word16 = mkGenPrimOp (fsLit "writeWord16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Word32 = mkGenPrimOp (fsLit "writeWord32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Word64 = mkGenPrimOp (fsLit "writeWord64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo NewMutVarOp = mkGenPrimOp (fsLit "newMutVar#") [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutVarPrimTy deltaTy alphaTy])) -primOpInfo ReadMutVarOp = mkGenPrimOp (fsLit "readMutVar#") [deltaTyVar, alphaTyVar] [mkMutVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo WriteMutVarOp = mkGenPrimOp (fsLit "writeMutVar#") [deltaTyVar, alphaTyVar] [mkMutVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo SameMutVarOp = mkGenPrimOp (fsLit "sameMutVar#") [deltaTyVar, alphaTyVar] [mkMutVarPrimTy deltaTy alphaTy, mkMutVarPrimTy deltaTy alphaTy] (intPrimTy) -primOpInfo AtomicModifyMutVarOp = mkGenPrimOp (fsLit "atomicModifyMutVar#") [deltaTyVar, alphaTyVar, betaTyVar, gammaTyVar] [mkMutVarPrimTy deltaTy alphaTy, (mkFunTy (alphaTy) (betaTy)), mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, gammaTy])) -primOpInfo CasMutVarOp = mkGenPrimOp (fsLit "casMutVar#") [deltaTyVar, alphaTyVar] [mkMutVarPrimTy deltaTy alphaTy, alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) -primOpInfo CatchOp = mkGenPrimOp (fsLit "catch#") [alphaTyVar, betaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), (mkFunTy (betaTy) ((mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo RaiseOp = mkGenPrimOp (fsLit "raise#") [alphaTyVar, betaTyVar] [alphaTy] (betaTy) -primOpInfo RaiseIOOp = mkGenPrimOp (fsLit "raiseIO#") [alphaTyVar, betaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, betaTy])) -primOpInfo MaskAsyncExceptionsOp = mkGenPrimOp (fsLit "maskAsyncExceptions#") [alphaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo MaskUninterruptibleOp = mkGenPrimOp (fsLit "maskUninterruptible#") [alphaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo UnmaskAsyncExceptionsOp = mkGenPrimOp (fsLit "unmaskAsyncExceptions#") [alphaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo MaskStatus = mkGenPrimOp (fsLit "getMaskingState#") [] [mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, intPrimTy])) -primOpInfo AtomicallyOp = mkGenPrimOp (fsLit "atomically#") [alphaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo RetryOp = mkGenPrimOp (fsLit "retry#") [alphaTyVar] [mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo CatchRetryOp = mkGenPrimOp (fsLit "catchRetry#") [alphaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), (mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo CatchSTMOp = mkGenPrimOp (fsLit "catchSTM#") [alphaTyVar, betaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), (mkFunTy (betaTy) ((mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo Check = mkGenPrimOp (fsLit "check#") [alphaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, unitTy])) -primOpInfo NewTVarOp = mkGenPrimOp (fsLit "newTVar#") [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkTVarPrimTy deltaTy alphaTy])) -primOpInfo ReadTVarOp = mkGenPrimOp (fsLit "readTVar#") [deltaTyVar, alphaTyVar] [mkTVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo ReadTVarIOOp = mkGenPrimOp (fsLit "readTVarIO#") [deltaTyVar, alphaTyVar] [mkTVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo WriteTVarOp = mkGenPrimOp (fsLit "writeTVar#") [deltaTyVar, alphaTyVar] [mkTVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo SameTVarOp = mkGenPrimOp (fsLit "sameTVar#") [deltaTyVar, alphaTyVar] [mkTVarPrimTy deltaTy alphaTy, mkTVarPrimTy deltaTy alphaTy] (intPrimTy) -primOpInfo NewMVarOp = mkGenPrimOp (fsLit "newMVar#") [deltaTyVar, alphaTyVar] [mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMVarPrimTy deltaTy alphaTy])) -primOpInfo TakeMVarOp = mkGenPrimOp (fsLit "takeMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo TryTakeMVarOp = mkGenPrimOp (fsLit "tryTakeMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) -primOpInfo PutMVarOp = mkGenPrimOp (fsLit "putMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo TryPutMVarOp = mkGenPrimOp (fsLit "tryPutMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadMVarOp = mkGenPrimOp (fsLit "readMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo TryReadMVarOp = mkGenPrimOp (fsLit "tryReadMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) -primOpInfo SameMVarOp = mkGenPrimOp (fsLit "sameMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkMVarPrimTy deltaTy alphaTy] (intPrimTy) -primOpInfo IsEmptyMVarOp = mkGenPrimOp (fsLit "isEmptyMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo DelayOp = mkGenPrimOp (fsLit "delay#") [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WaitReadOp = mkGenPrimOp (fsLit "waitRead#") [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WaitWriteOp = mkGenPrimOp (fsLit "waitWrite#") [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo ForkOp = mkGenPrimOp (fsLit "fork#") [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, threadIdPrimTy])) -primOpInfo ForkOnOp = mkGenPrimOp (fsLit "forkOn#") [alphaTyVar] [intPrimTy, alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, threadIdPrimTy])) -primOpInfo KillThreadOp = mkGenPrimOp (fsLit "killThread#") [alphaTyVar] [threadIdPrimTy, alphaTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) -primOpInfo YieldOp = mkGenPrimOp (fsLit "yield#") [] [mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) -primOpInfo MyThreadIdOp = mkGenPrimOp (fsLit "myThreadId#") [] [mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, threadIdPrimTy])) -primOpInfo LabelThreadOp = mkGenPrimOp (fsLit "labelThread#") [] [threadIdPrimTy, addrPrimTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) -primOpInfo IsCurrentThreadBoundOp = mkGenPrimOp (fsLit "isCurrentThreadBound#") [] [mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, intPrimTy])) -primOpInfo NoDuplicateOp = mkGenPrimOp (fsLit "noDuplicate#") [] [mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) -primOpInfo ThreadStatusOp = mkGenPrimOp (fsLit "threadStatus#") [] [threadIdPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo MkWeakOp = mkGenPrimOp (fsLit "mkWeak#") [openAlphaTyVar, betaTyVar, gammaTyVar] [openAlphaTy, betaTy, gammaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy])) -primOpInfo MkWeakNoFinalizerOp = mkGenPrimOp (fsLit "mkWeakNoFinalizer#") [openAlphaTyVar, betaTyVar] [openAlphaTy, betaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy])) -primOpInfo AddCFinalizerToWeakOp = mkGenPrimOp (fsLit "addCFinalizerToWeak#") [betaTyVar] [addrPrimTy, addrPrimTy, intPrimTy, addrPrimTy, mkWeakPrimTy betaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, intPrimTy])) -primOpInfo DeRefWeakOp = mkGenPrimOp (fsLit "deRefWeak#") [alphaTyVar] [mkWeakPrimTy alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, intPrimTy, alphaTy])) -primOpInfo FinalizeWeakOp = mkGenPrimOp (fsLit "finalizeWeak#") [alphaTyVar] [mkWeakPrimTy alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, intPrimTy, (mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, unitTy])))])) -primOpInfo TouchOp = mkGenPrimOp (fsLit "touch#") [openAlphaTyVar] [openAlphaTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) -primOpInfo MakeStablePtrOp = mkGenPrimOp (fsLit "makeStablePtr#") [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, mkStablePtrPrimTy alphaTy])) -primOpInfo DeRefStablePtrOp = mkGenPrimOp (fsLit "deRefStablePtr#") [alphaTyVar] [mkStablePtrPrimTy alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo EqStablePtrOp = mkGenPrimOp (fsLit "eqStablePtr#") [alphaTyVar] [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy alphaTy] (intPrimTy) -primOpInfo MakeStableNameOp = mkGenPrimOp (fsLit "makeStableName#") [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, mkStableNamePrimTy alphaTy])) -primOpInfo EqStableNameOp = mkGenPrimOp (fsLit "eqStableName#") [alphaTyVar, betaTyVar] [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy] (intPrimTy) -primOpInfo StableNameToIntOp = mkGenPrimOp (fsLit "stableNameToInt#") [alphaTyVar] [mkStableNamePrimTy alphaTy] (intPrimTy) -primOpInfo ReallyUnsafePtrEqualityOp = mkGenPrimOp (fsLit "reallyUnsafePtrEquality#") [alphaTyVar] [alphaTy, alphaTy] (intPrimTy) -primOpInfo ParOp = mkGenPrimOp (fsLit "par#") [alphaTyVar] [alphaTy] (intPrimTy) -primOpInfo SparkOp = mkGenPrimOp (fsLit "spark#") [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo SeqOp = mkGenPrimOp (fsLit "seq#") [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo GetSparkOp = mkGenPrimOp (fsLit "getSpark#") [deltaTyVar, alphaTyVar] [mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) -primOpInfo NumSparks = mkGenPrimOp (fsLit "numSparks#") [deltaTyVar] [mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ParGlobalOp = mkGenPrimOp (fsLit "parGlobal#") [alphaTyVar, betaTyVar] [alphaTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, betaTy] (intPrimTy) -primOpInfo ParLocalOp = mkGenPrimOp (fsLit "parLocal#") [alphaTyVar, betaTyVar] [alphaTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, betaTy] (intPrimTy) -primOpInfo ParAtOp = mkGenPrimOp (fsLit "parAt#") [betaTyVar, alphaTyVar, gammaTyVar] [betaTy, alphaTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, gammaTy] (intPrimTy) -primOpInfo ParAtAbsOp = mkGenPrimOp (fsLit "parAtAbs#") [alphaTyVar, betaTyVar] [alphaTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, betaTy] (intPrimTy) -primOpInfo ParAtRelOp = mkGenPrimOp (fsLit "parAtRel#") [alphaTyVar, betaTyVar] [alphaTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, betaTy] (intPrimTy) -primOpInfo ParAtForNowOp = mkGenPrimOp (fsLit "parAtForNow#") [betaTyVar, alphaTyVar, gammaTyVar] [betaTy, alphaTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, gammaTy] (intPrimTy) -primOpInfo DataToTagOp = mkGenPrimOp (fsLit "dataToTag#") [alphaTyVar] [alphaTy] (intPrimTy) -primOpInfo TagToEnumOp = mkGenPrimOp (fsLit "tagToEnum#") [alphaTyVar] [intPrimTy] (alphaTy) -primOpInfo AddrToAnyOp = mkGenPrimOp (fsLit "addrToAny#") [alphaTyVar] [addrPrimTy] ((mkTupleTy UnboxedTuple [alphaTy])) -primOpInfo MkApUpd0_Op = mkGenPrimOp (fsLit "mkApUpd0#") [alphaTyVar] [bcoPrimTy] ((mkTupleTy UnboxedTuple [alphaTy])) -primOpInfo NewBCOOp = mkGenPrimOp (fsLit "newBCO#") [alphaTyVar, deltaTyVar] [byteArrayPrimTy, byteArrayPrimTy, mkArrayPrimTy alphaTy, intPrimTy, byteArrayPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, bcoPrimTy])) -primOpInfo UnpackClosureOp = mkGenPrimOp (fsLit "unpackClosure#") [alphaTyVar, betaTyVar] [alphaTy] ((mkTupleTy UnboxedTuple [addrPrimTy, mkArrayPrimTy betaTy, byteArrayPrimTy])) -primOpInfo GetApStackValOp = mkGenPrimOp (fsLit "getApStackVal#") [alphaTyVar, betaTyVar] [alphaTy, intPrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, betaTy])) -primOpInfo GetCCSOfOp = mkGenPrimOp (fsLit "getCCSOf#") [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, addrPrimTy])) -primOpInfo GetCurrentCCSOp = mkGenPrimOp (fsLit "getCurrentCCS#") [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, addrPrimTy])) -primOpInfo TraceEventOp = mkGenPrimOp (fsLit "traceEvent#") [deltaTyVar] [addrPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo TraceMarkerOp = mkGenPrimOp (fsLit "traceMarker#") [deltaTyVar] [addrPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecBroadcastOp IntVec 16 W8) = mkGenPrimOp (fsLit "broadcastInt8X16#") [] [intPrimTy] (int8X16PrimTy) -primOpInfo (VecBroadcastOp IntVec 8 W16) = mkGenPrimOp (fsLit "broadcastInt16X8#") [] [intPrimTy] (int16X8PrimTy) -primOpInfo (VecBroadcastOp IntVec 4 W32) = mkGenPrimOp (fsLit "broadcastInt32X4#") [] [intPrimTy] (int32X4PrimTy) -primOpInfo (VecBroadcastOp IntVec 2 W64) = mkGenPrimOp (fsLit "broadcastInt64X2#") [] [int64PrimTy] (int64X2PrimTy) -primOpInfo (VecBroadcastOp IntVec 32 W8) = mkGenPrimOp (fsLit "broadcastInt8X32#") [] [intPrimTy] (int8X32PrimTy) -primOpInfo (VecBroadcastOp IntVec 16 W16) = mkGenPrimOp (fsLit "broadcastInt16X16#") [] [intPrimTy] (int16X16PrimTy) -primOpInfo (VecBroadcastOp IntVec 8 W32) = mkGenPrimOp (fsLit "broadcastInt32X8#") [] [intPrimTy] (int32X8PrimTy) -primOpInfo (VecBroadcastOp IntVec 4 W64) = mkGenPrimOp (fsLit "broadcastInt64X4#") [] [int64PrimTy] (int64X4PrimTy) -primOpInfo (VecBroadcastOp IntVec 64 W8) = mkGenPrimOp (fsLit "broadcastInt8X64#") [] [intPrimTy] (int8X64PrimTy) -primOpInfo (VecBroadcastOp IntVec 32 W16) = mkGenPrimOp (fsLit "broadcastInt16X32#") [] [intPrimTy] (int16X32PrimTy) -primOpInfo (VecBroadcastOp IntVec 16 W32) = mkGenPrimOp (fsLit "broadcastInt32X16#") [] [intPrimTy] (int32X16PrimTy) -primOpInfo (VecBroadcastOp IntVec 8 W64) = mkGenPrimOp (fsLit "broadcastInt64X8#") [] [int64PrimTy] (int64X8PrimTy) -primOpInfo (VecBroadcastOp WordVec 16 W8) = mkGenPrimOp (fsLit "broadcastWord8X16#") [] [wordPrimTy] (word8X16PrimTy) -primOpInfo (VecBroadcastOp WordVec 8 W16) = mkGenPrimOp (fsLit "broadcastWord16X8#") [] [wordPrimTy] (word16X8PrimTy) -primOpInfo (VecBroadcastOp WordVec 4 W32) = mkGenPrimOp (fsLit "broadcastWord32X4#") [] [wordPrimTy] (word32X4PrimTy) -primOpInfo (VecBroadcastOp WordVec 2 W64) = mkGenPrimOp (fsLit "broadcastWord64X2#") [] [word64PrimTy] (word64X2PrimTy) -primOpInfo (VecBroadcastOp WordVec 32 W8) = mkGenPrimOp (fsLit "broadcastWord8X32#") [] [wordPrimTy] (word8X32PrimTy) -primOpInfo (VecBroadcastOp WordVec 16 W16) = mkGenPrimOp (fsLit "broadcastWord16X16#") [] [wordPrimTy] (word16X16PrimTy) -primOpInfo (VecBroadcastOp WordVec 8 W32) = mkGenPrimOp (fsLit "broadcastWord32X8#") [] [wordPrimTy] (word32X8PrimTy) -primOpInfo (VecBroadcastOp WordVec 4 W64) = mkGenPrimOp (fsLit "broadcastWord64X4#") [] [word64PrimTy] (word64X4PrimTy) -primOpInfo (VecBroadcastOp WordVec 64 W8) = mkGenPrimOp (fsLit "broadcastWord8X64#") [] [wordPrimTy] (word8X64PrimTy) -primOpInfo (VecBroadcastOp WordVec 32 W16) = mkGenPrimOp (fsLit "broadcastWord16X32#") [] [wordPrimTy] (word16X32PrimTy) -primOpInfo (VecBroadcastOp WordVec 16 W32) = mkGenPrimOp (fsLit "broadcastWord32X16#") [] [wordPrimTy] (word32X16PrimTy) -primOpInfo (VecBroadcastOp WordVec 8 W64) = mkGenPrimOp (fsLit "broadcastWord64X8#") [] [word64PrimTy] (word64X8PrimTy) -primOpInfo (VecBroadcastOp FloatVec 4 W32) = mkGenPrimOp (fsLit "broadcastFloatX4#") [] [floatPrimTy] (floatX4PrimTy) -primOpInfo (VecBroadcastOp FloatVec 2 W64) = mkGenPrimOp (fsLit "broadcastDoubleX2#") [] [doublePrimTy] (doubleX2PrimTy) -primOpInfo (VecBroadcastOp FloatVec 8 W32) = mkGenPrimOp (fsLit "broadcastFloatX8#") [] [floatPrimTy] (floatX8PrimTy) -primOpInfo (VecBroadcastOp FloatVec 4 W64) = mkGenPrimOp (fsLit "broadcastDoubleX4#") [] [doublePrimTy] (doubleX4PrimTy) -primOpInfo (VecBroadcastOp FloatVec 16 W32) = mkGenPrimOp (fsLit "broadcastFloatX16#") [] [floatPrimTy] (floatX16PrimTy) -primOpInfo (VecBroadcastOp FloatVec 8 W64) = mkGenPrimOp (fsLit "broadcastDoubleX8#") [] [doublePrimTy] (doubleX8PrimTy) -primOpInfo (VecPackOp IntVec 16 W8) = mkGenPrimOp (fsLit "packInt8X16#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int8X16PrimTy) -primOpInfo (VecPackOp IntVec 8 W16) = mkGenPrimOp (fsLit "packInt16X8#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int16X8PrimTy) -primOpInfo (VecPackOp IntVec 4 W32) = mkGenPrimOp (fsLit "packInt32X4#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int32X4PrimTy) -primOpInfo (VecPackOp IntVec 2 W64) = mkGenPrimOp (fsLit "packInt64X2#") [] [(mkTupleTy UnboxedTuple [int64PrimTy, int64PrimTy])] (int64X2PrimTy) -primOpInfo (VecPackOp IntVec 32 W8) = mkGenPrimOp (fsLit "packInt8X32#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int8X32PrimTy) -primOpInfo (VecPackOp IntVec 16 W16) = mkGenPrimOp (fsLit "packInt16X16#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int16X16PrimTy) -primOpInfo (VecPackOp IntVec 8 W32) = mkGenPrimOp (fsLit "packInt32X8#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int32X8PrimTy) -primOpInfo (VecPackOp IntVec 4 W64) = mkGenPrimOp (fsLit "packInt64X4#") [] [(mkTupleTy UnboxedTuple [int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy])] (int64X4PrimTy) -primOpInfo (VecPackOp IntVec 64 W8) = mkGenPrimOp (fsLit "packInt8X64#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int8X64PrimTy) -primOpInfo (VecPackOp IntVec 32 W16) = mkGenPrimOp (fsLit "packInt16X32#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int16X32PrimTy) -primOpInfo (VecPackOp IntVec 16 W32) = mkGenPrimOp (fsLit "packInt32X16#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int32X16PrimTy) -primOpInfo (VecPackOp IntVec 8 W64) = mkGenPrimOp (fsLit "packInt64X8#") [] [(mkTupleTy UnboxedTuple [int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy])] (int64X8PrimTy) -primOpInfo (VecPackOp WordVec 16 W8) = mkGenPrimOp (fsLit "packWord8X16#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word8X16PrimTy) -primOpInfo (VecPackOp WordVec 8 W16) = mkGenPrimOp (fsLit "packWord16X8#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word16X8PrimTy) -primOpInfo (VecPackOp WordVec 4 W32) = mkGenPrimOp (fsLit "packWord32X4#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word32X4PrimTy) -primOpInfo (VecPackOp WordVec 2 W64) = mkGenPrimOp (fsLit "packWord64X2#") [] [(mkTupleTy UnboxedTuple [word64PrimTy, word64PrimTy])] (word64X2PrimTy) -primOpInfo (VecPackOp WordVec 32 W8) = mkGenPrimOp (fsLit "packWord8X32#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word8X32PrimTy) -primOpInfo (VecPackOp WordVec 16 W16) = mkGenPrimOp (fsLit "packWord16X16#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word16X16PrimTy) -primOpInfo (VecPackOp WordVec 8 W32) = mkGenPrimOp (fsLit "packWord32X8#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word32X8PrimTy) -primOpInfo (VecPackOp WordVec 4 W64) = mkGenPrimOp (fsLit "packWord64X4#") [] [(mkTupleTy UnboxedTuple [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy])] (word64X4PrimTy) -primOpInfo (VecPackOp WordVec 64 W8) = mkGenPrimOp (fsLit "packWord8X64#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word8X64PrimTy) -primOpInfo (VecPackOp WordVec 32 W16) = mkGenPrimOp (fsLit "packWord16X32#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word16X32PrimTy) -primOpInfo (VecPackOp WordVec 16 W32) = mkGenPrimOp (fsLit "packWord32X16#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word32X16PrimTy) -primOpInfo (VecPackOp WordVec 8 W64) = mkGenPrimOp (fsLit "packWord64X8#") [] [(mkTupleTy UnboxedTuple [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy])] (word64X8PrimTy) -primOpInfo (VecPackOp FloatVec 4 W32) = mkGenPrimOp (fsLit "packFloatX4#") [] [(mkTupleTy UnboxedTuple [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])] (floatX4PrimTy) -primOpInfo (VecPackOp FloatVec 2 W64) = mkGenPrimOp (fsLit "packDoubleX2#") [] [(mkTupleTy UnboxedTuple [doublePrimTy, doublePrimTy])] (doubleX2PrimTy) -primOpInfo (VecPackOp FloatVec 8 W32) = mkGenPrimOp (fsLit "packFloatX8#") [] [(mkTupleTy UnboxedTuple [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])] (floatX8PrimTy) -primOpInfo (VecPackOp FloatVec 4 W64) = mkGenPrimOp (fsLit "packDoubleX4#") [] [(mkTupleTy UnboxedTuple [doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy])] (doubleX4PrimTy) -primOpInfo (VecPackOp FloatVec 16 W32) = mkGenPrimOp (fsLit "packFloatX16#") [] [(mkTupleTy UnboxedTuple [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])] (floatX16PrimTy) -primOpInfo (VecPackOp FloatVec 8 W64) = mkGenPrimOp (fsLit "packDoubleX8#") [] [(mkTupleTy UnboxedTuple [doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy])] (doubleX8PrimTy) -primOpInfo (VecUnpackOp IntVec 16 W8) = mkGenPrimOp (fsLit "unpackInt8X16#") [] [int8X16PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 8 W16) = mkGenPrimOp (fsLit "unpackInt16X8#") [] [int16X8PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 4 W32) = mkGenPrimOp (fsLit "unpackInt32X4#") [] [int32X4PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 2 W64) = mkGenPrimOp (fsLit "unpackInt64X2#") [] [int64X2PrimTy] ((mkTupleTy UnboxedTuple [int64PrimTy, int64PrimTy])) -primOpInfo (VecUnpackOp IntVec 32 W8) = mkGenPrimOp (fsLit "unpackInt8X32#") [] [int8X32PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 16 W16) = mkGenPrimOp (fsLit "unpackInt16X16#") [] [int16X16PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 8 W32) = mkGenPrimOp (fsLit "unpackInt32X8#") [] [int32X8PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 4 W64) = mkGenPrimOp (fsLit "unpackInt64X4#") [] [int64X4PrimTy] ((mkTupleTy UnboxedTuple [int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy])) -primOpInfo (VecUnpackOp IntVec 64 W8) = mkGenPrimOp (fsLit "unpackInt8X64#") [] [int8X64PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 32 W16) = mkGenPrimOp (fsLit "unpackInt16X32#") [] [int16X32PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 16 W32) = mkGenPrimOp (fsLit "unpackInt32X16#") [] [int32X16PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 8 W64) = mkGenPrimOp (fsLit "unpackInt64X8#") [] [int64X8PrimTy] ((mkTupleTy UnboxedTuple [int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy])) -primOpInfo (VecUnpackOp WordVec 16 W8) = mkGenPrimOp (fsLit "unpackWord8X16#") [] [word8X16PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 8 W16) = mkGenPrimOp (fsLit "unpackWord16X8#") [] [word16X8PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 4 W32) = mkGenPrimOp (fsLit "unpackWord32X4#") [] [word32X4PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 2 W64) = mkGenPrimOp (fsLit "unpackWord64X2#") [] [word64X2PrimTy] ((mkTupleTy UnboxedTuple [word64PrimTy, word64PrimTy])) -primOpInfo (VecUnpackOp WordVec 32 W8) = mkGenPrimOp (fsLit "unpackWord8X32#") [] [word8X32PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 16 W16) = mkGenPrimOp (fsLit "unpackWord16X16#") [] [word16X16PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 8 W32) = mkGenPrimOp (fsLit "unpackWord32X8#") [] [word32X8PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 4 W64) = mkGenPrimOp (fsLit "unpackWord64X4#") [] [word64X4PrimTy] ((mkTupleTy UnboxedTuple [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy])) -primOpInfo (VecUnpackOp WordVec 64 W8) = mkGenPrimOp (fsLit "unpackWord8X64#") [] [word8X64PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 32 W16) = mkGenPrimOp (fsLit "unpackWord16X32#") [] [word16X32PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 16 W32) = mkGenPrimOp (fsLit "unpackWord32X16#") [] [word32X16PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 8 W64) = mkGenPrimOp (fsLit "unpackWord64X8#") [] [word64X8PrimTy] ((mkTupleTy UnboxedTuple [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy])) -primOpInfo (VecUnpackOp FloatVec 4 W32) = mkGenPrimOp (fsLit "unpackFloatX4#") [] [floatX4PrimTy] ((mkTupleTy UnboxedTuple [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])) -primOpInfo (VecUnpackOp FloatVec 2 W64) = mkGenPrimOp (fsLit "unpackDoubleX2#") [] [doubleX2PrimTy] ((mkTupleTy UnboxedTuple [doublePrimTy, doublePrimTy])) -primOpInfo (VecUnpackOp FloatVec 8 W32) = mkGenPrimOp (fsLit "unpackFloatX8#") [] [floatX8PrimTy] ((mkTupleTy UnboxedTuple [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])) -primOpInfo (VecUnpackOp FloatVec 4 W64) = mkGenPrimOp (fsLit "unpackDoubleX4#") [] [doubleX4PrimTy] ((mkTupleTy UnboxedTuple [doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy])) -primOpInfo (VecUnpackOp FloatVec 16 W32) = mkGenPrimOp (fsLit "unpackFloatX16#") [] [floatX16PrimTy] ((mkTupleTy UnboxedTuple [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])) -primOpInfo (VecUnpackOp FloatVec 8 W64) = mkGenPrimOp (fsLit "unpackDoubleX8#") [] [doubleX8PrimTy] ((mkTupleTy UnboxedTuple [doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy])) -primOpInfo (VecInsertOp IntVec 16 W8) = mkGenPrimOp (fsLit "insertInt8X16#") [] [int8X16PrimTy, intPrimTy, intPrimTy] (int8X16PrimTy) -primOpInfo (VecInsertOp IntVec 8 W16) = mkGenPrimOp (fsLit "insertInt16X8#") [] [int16X8PrimTy, intPrimTy, intPrimTy] (int16X8PrimTy) -primOpInfo (VecInsertOp IntVec 4 W32) = mkGenPrimOp (fsLit "insertInt32X4#") [] [int32X4PrimTy, intPrimTy, intPrimTy] (int32X4PrimTy) -primOpInfo (VecInsertOp IntVec 2 W64) = mkGenPrimOp (fsLit "insertInt64X2#") [] [int64X2PrimTy, int64PrimTy, intPrimTy] (int64X2PrimTy) -primOpInfo (VecInsertOp IntVec 32 W8) = mkGenPrimOp (fsLit "insertInt8X32#") [] [int8X32PrimTy, intPrimTy, intPrimTy] (int8X32PrimTy) -primOpInfo (VecInsertOp IntVec 16 W16) = mkGenPrimOp (fsLit "insertInt16X16#") [] [int16X16PrimTy, intPrimTy, intPrimTy] (int16X16PrimTy) -primOpInfo (VecInsertOp IntVec 8 W32) = mkGenPrimOp (fsLit "insertInt32X8#") [] [int32X8PrimTy, intPrimTy, intPrimTy] (int32X8PrimTy) -primOpInfo (VecInsertOp IntVec 4 W64) = mkGenPrimOp (fsLit "insertInt64X4#") [] [int64X4PrimTy, int64PrimTy, intPrimTy] (int64X4PrimTy) -primOpInfo (VecInsertOp IntVec 64 W8) = mkGenPrimOp (fsLit "insertInt8X64#") [] [int8X64PrimTy, intPrimTy, intPrimTy] (int8X64PrimTy) -primOpInfo (VecInsertOp IntVec 32 W16) = mkGenPrimOp (fsLit "insertInt16X32#") [] [int16X32PrimTy, intPrimTy, intPrimTy] (int16X32PrimTy) -primOpInfo (VecInsertOp IntVec 16 W32) = mkGenPrimOp (fsLit "insertInt32X16#") [] [int32X16PrimTy, intPrimTy, intPrimTy] (int32X16PrimTy) -primOpInfo (VecInsertOp IntVec 8 W64) = mkGenPrimOp (fsLit "insertInt64X8#") [] [int64X8PrimTy, int64PrimTy, intPrimTy] (int64X8PrimTy) -primOpInfo (VecInsertOp WordVec 16 W8) = mkGenPrimOp (fsLit "insertWord8X16#") [] [word8X16PrimTy, wordPrimTy, intPrimTy] (word8X16PrimTy) -primOpInfo (VecInsertOp WordVec 8 W16) = mkGenPrimOp (fsLit "insertWord16X8#") [] [word16X8PrimTy, wordPrimTy, intPrimTy] (word16X8PrimTy) -primOpInfo (VecInsertOp WordVec 4 W32) = mkGenPrimOp (fsLit "insertWord32X4#") [] [word32X4PrimTy, wordPrimTy, intPrimTy] (word32X4PrimTy) -primOpInfo (VecInsertOp WordVec 2 W64) = mkGenPrimOp (fsLit "insertWord64X2#") [] [word64X2PrimTy, word64PrimTy, intPrimTy] (word64X2PrimTy) -primOpInfo (VecInsertOp WordVec 32 W8) = mkGenPrimOp (fsLit "insertWord8X32#") [] [word8X32PrimTy, wordPrimTy, intPrimTy] (word8X32PrimTy) -primOpInfo (VecInsertOp WordVec 16 W16) = mkGenPrimOp (fsLit "insertWord16X16#") [] [word16X16PrimTy, wordPrimTy, intPrimTy] (word16X16PrimTy) -primOpInfo (VecInsertOp WordVec 8 W32) = mkGenPrimOp (fsLit "insertWord32X8#") [] [word32X8PrimTy, wordPrimTy, intPrimTy] (word32X8PrimTy) -primOpInfo (VecInsertOp WordVec 4 W64) = mkGenPrimOp (fsLit "insertWord64X4#") [] [word64X4PrimTy, word64PrimTy, intPrimTy] (word64X4PrimTy) -primOpInfo (VecInsertOp WordVec 64 W8) = mkGenPrimOp (fsLit "insertWord8X64#") [] [word8X64PrimTy, wordPrimTy, intPrimTy] (word8X64PrimTy) -primOpInfo (VecInsertOp WordVec 32 W16) = mkGenPrimOp (fsLit "insertWord16X32#") [] [word16X32PrimTy, wordPrimTy, intPrimTy] (word16X32PrimTy) -primOpInfo (VecInsertOp WordVec 16 W32) = mkGenPrimOp (fsLit "insertWord32X16#") [] [word32X16PrimTy, wordPrimTy, intPrimTy] (word32X16PrimTy) -primOpInfo (VecInsertOp WordVec 8 W64) = mkGenPrimOp (fsLit "insertWord64X8#") [] [word64X8PrimTy, word64PrimTy, intPrimTy] (word64X8PrimTy) -primOpInfo (VecInsertOp FloatVec 4 W32) = mkGenPrimOp (fsLit "insertFloatX4#") [] [floatX4PrimTy, floatPrimTy, intPrimTy] (floatX4PrimTy) -primOpInfo (VecInsertOp FloatVec 2 W64) = mkGenPrimOp (fsLit "insertDoubleX2#") [] [doubleX2PrimTy, doublePrimTy, intPrimTy] (doubleX2PrimTy) -primOpInfo (VecInsertOp FloatVec 8 W32) = mkGenPrimOp (fsLit "insertFloatX8#") [] [floatX8PrimTy, floatPrimTy, intPrimTy] (floatX8PrimTy) -primOpInfo (VecInsertOp FloatVec 4 W64) = mkGenPrimOp (fsLit "insertDoubleX4#") [] [doubleX4PrimTy, doublePrimTy, intPrimTy] (doubleX4PrimTy) -primOpInfo (VecInsertOp FloatVec 16 W32) = mkGenPrimOp (fsLit "insertFloatX16#") [] [floatX16PrimTy, floatPrimTy, intPrimTy] (floatX16PrimTy) -primOpInfo (VecInsertOp FloatVec 8 W64) = mkGenPrimOp (fsLit "insertDoubleX8#") [] [doubleX8PrimTy, doublePrimTy, intPrimTy] (doubleX8PrimTy) -primOpInfo (VecAddOp IntVec 16 W8) = mkDyadic (fsLit "plusInt8X16#") int8X16PrimTy -primOpInfo (VecAddOp IntVec 8 W16) = mkDyadic (fsLit "plusInt16X8#") int16X8PrimTy -primOpInfo (VecAddOp IntVec 4 W32) = mkDyadic (fsLit "plusInt32X4#") int32X4PrimTy -primOpInfo (VecAddOp IntVec 2 W64) = mkDyadic (fsLit "plusInt64X2#") int64X2PrimTy -primOpInfo (VecAddOp IntVec 32 W8) = mkDyadic (fsLit "plusInt8X32#") int8X32PrimTy -primOpInfo (VecAddOp IntVec 16 W16) = mkDyadic (fsLit "plusInt16X16#") int16X16PrimTy -primOpInfo (VecAddOp IntVec 8 W32) = mkDyadic (fsLit "plusInt32X8#") int32X8PrimTy -primOpInfo (VecAddOp IntVec 4 W64) = mkDyadic (fsLit "plusInt64X4#") int64X4PrimTy -primOpInfo (VecAddOp IntVec 64 W8) = mkDyadic (fsLit "plusInt8X64#") int8X64PrimTy -primOpInfo (VecAddOp IntVec 32 W16) = mkDyadic (fsLit "plusInt16X32#") int16X32PrimTy -primOpInfo (VecAddOp IntVec 16 W32) = mkDyadic (fsLit "plusInt32X16#") int32X16PrimTy -primOpInfo (VecAddOp IntVec 8 W64) = mkDyadic (fsLit "plusInt64X8#") int64X8PrimTy -primOpInfo (VecAddOp WordVec 16 W8) = mkDyadic (fsLit "plusWord8X16#") word8X16PrimTy -primOpInfo (VecAddOp WordVec 8 W16) = mkDyadic (fsLit "plusWord16X8#") word16X8PrimTy -primOpInfo (VecAddOp WordVec 4 W32) = mkDyadic (fsLit "plusWord32X4#") word32X4PrimTy -primOpInfo (VecAddOp WordVec 2 W64) = mkDyadic (fsLit "plusWord64X2#") word64X2PrimTy -primOpInfo (VecAddOp WordVec 32 W8) = mkDyadic (fsLit "plusWord8X32#") word8X32PrimTy -primOpInfo (VecAddOp WordVec 16 W16) = mkDyadic (fsLit "plusWord16X16#") word16X16PrimTy -primOpInfo (VecAddOp WordVec 8 W32) = mkDyadic (fsLit "plusWord32X8#") word32X8PrimTy -primOpInfo (VecAddOp WordVec 4 W64) = mkDyadic (fsLit "plusWord64X4#") word64X4PrimTy -primOpInfo (VecAddOp WordVec 64 W8) = mkDyadic (fsLit "plusWord8X64#") word8X64PrimTy -primOpInfo (VecAddOp WordVec 32 W16) = mkDyadic (fsLit "plusWord16X32#") word16X32PrimTy -primOpInfo (VecAddOp WordVec 16 W32) = mkDyadic (fsLit "plusWord32X16#") word32X16PrimTy -primOpInfo (VecAddOp WordVec 8 W64) = mkDyadic (fsLit "plusWord64X8#") word64X8PrimTy -primOpInfo (VecAddOp FloatVec 4 W32) = mkDyadic (fsLit "plusFloatX4#") floatX4PrimTy -primOpInfo (VecAddOp FloatVec 2 W64) = mkDyadic (fsLit "plusDoubleX2#") doubleX2PrimTy -primOpInfo (VecAddOp FloatVec 8 W32) = mkDyadic (fsLit "plusFloatX8#") floatX8PrimTy -primOpInfo (VecAddOp FloatVec 4 W64) = mkDyadic (fsLit "plusDoubleX4#") doubleX4PrimTy -primOpInfo (VecAddOp FloatVec 16 W32) = mkDyadic (fsLit "plusFloatX16#") floatX16PrimTy -primOpInfo (VecAddOp FloatVec 8 W64) = mkDyadic (fsLit "plusDoubleX8#") doubleX8PrimTy -primOpInfo (VecSubOp IntVec 16 W8) = mkDyadic (fsLit "minusInt8X16#") int8X16PrimTy -primOpInfo (VecSubOp IntVec 8 W16) = mkDyadic (fsLit "minusInt16X8#") int16X8PrimTy -primOpInfo (VecSubOp IntVec 4 W32) = mkDyadic (fsLit "minusInt32X4#") int32X4PrimTy -primOpInfo (VecSubOp IntVec 2 W64) = mkDyadic (fsLit "minusInt64X2#") int64X2PrimTy -primOpInfo (VecSubOp IntVec 32 W8) = mkDyadic (fsLit "minusInt8X32#") int8X32PrimTy -primOpInfo (VecSubOp IntVec 16 W16) = mkDyadic (fsLit "minusInt16X16#") int16X16PrimTy -primOpInfo (VecSubOp IntVec 8 W32) = mkDyadic (fsLit "minusInt32X8#") int32X8PrimTy -primOpInfo (VecSubOp IntVec 4 W64) = mkDyadic (fsLit "minusInt64X4#") int64X4PrimTy -primOpInfo (VecSubOp IntVec 64 W8) = mkDyadic (fsLit "minusInt8X64#") int8X64PrimTy -primOpInfo (VecSubOp IntVec 32 W16) = mkDyadic (fsLit "minusInt16X32#") int16X32PrimTy -primOpInfo (VecSubOp IntVec 16 W32) = mkDyadic (fsLit "minusInt32X16#") int32X16PrimTy -primOpInfo (VecSubOp IntVec 8 W64) = mkDyadic (fsLit "minusInt64X8#") int64X8PrimTy -primOpInfo (VecSubOp WordVec 16 W8) = mkDyadic (fsLit "minusWord8X16#") word8X16PrimTy -primOpInfo (VecSubOp WordVec 8 W16) = mkDyadic (fsLit "minusWord16X8#") word16X8PrimTy -primOpInfo (VecSubOp WordVec 4 W32) = mkDyadic (fsLit "minusWord32X4#") word32X4PrimTy -primOpInfo (VecSubOp WordVec 2 W64) = mkDyadic (fsLit "minusWord64X2#") word64X2PrimTy -primOpInfo (VecSubOp WordVec 32 W8) = mkDyadic (fsLit "minusWord8X32#") word8X32PrimTy -primOpInfo (VecSubOp WordVec 16 W16) = mkDyadic (fsLit "minusWord16X16#") word16X16PrimTy -primOpInfo (VecSubOp WordVec 8 W32) = mkDyadic (fsLit "minusWord32X8#") word32X8PrimTy -primOpInfo (VecSubOp WordVec 4 W64) = mkDyadic (fsLit "minusWord64X4#") word64X4PrimTy -primOpInfo (VecSubOp WordVec 64 W8) = mkDyadic (fsLit "minusWord8X64#") word8X64PrimTy -primOpInfo (VecSubOp WordVec 32 W16) = mkDyadic (fsLit "minusWord16X32#") word16X32PrimTy -primOpInfo (VecSubOp WordVec 16 W32) = mkDyadic (fsLit "minusWord32X16#") word32X16PrimTy -primOpInfo (VecSubOp WordVec 8 W64) = mkDyadic (fsLit "minusWord64X8#") word64X8PrimTy -primOpInfo (VecSubOp FloatVec 4 W32) = mkDyadic (fsLit "minusFloatX4#") floatX4PrimTy -primOpInfo (VecSubOp FloatVec 2 W64) = mkDyadic (fsLit "minusDoubleX2#") doubleX2PrimTy -primOpInfo (VecSubOp FloatVec 8 W32) = mkDyadic (fsLit "minusFloatX8#") floatX8PrimTy -primOpInfo (VecSubOp FloatVec 4 W64) = mkDyadic (fsLit "minusDoubleX4#") doubleX4PrimTy -primOpInfo (VecSubOp FloatVec 16 W32) = mkDyadic (fsLit "minusFloatX16#") floatX16PrimTy -primOpInfo (VecSubOp FloatVec 8 W64) = mkDyadic (fsLit "minusDoubleX8#") doubleX8PrimTy -primOpInfo (VecMulOp IntVec 16 W8) = mkDyadic (fsLit "timesInt8X16#") int8X16PrimTy -primOpInfo (VecMulOp IntVec 8 W16) = mkDyadic (fsLit "timesInt16X8#") int16X8PrimTy -primOpInfo (VecMulOp IntVec 4 W32) = mkDyadic (fsLit "timesInt32X4#") int32X4PrimTy -primOpInfo (VecMulOp IntVec 2 W64) = mkDyadic (fsLit "timesInt64X2#") int64X2PrimTy -primOpInfo (VecMulOp IntVec 32 W8) = mkDyadic (fsLit "timesInt8X32#") int8X32PrimTy -primOpInfo (VecMulOp IntVec 16 W16) = mkDyadic (fsLit "timesInt16X16#") int16X16PrimTy -primOpInfo (VecMulOp IntVec 8 W32) = mkDyadic (fsLit "timesInt32X8#") int32X8PrimTy -primOpInfo (VecMulOp IntVec 4 W64) = mkDyadic (fsLit "timesInt64X4#") int64X4PrimTy -primOpInfo (VecMulOp IntVec 64 W8) = mkDyadic (fsLit "timesInt8X64#") int8X64PrimTy -primOpInfo (VecMulOp IntVec 32 W16) = mkDyadic (fsLit "timesInt16X32#") int16X32PrimTy -primOpInfo (VecMulOp IntVec 16 W32) = mkDyadic (fsLit "timesInt32X16#") int32X16PrimTy -primOpInfo (VecMulOp IntVec 8 W64) = mkDyadic (fsLit "timesInt64X8#") int64X8PrimTy -primOpInfo (VecMulOp WordVec 16 W8) = mkDyadic (fsLit "timesWord8X16#") word8X16PrimTy -primOpInfo (VecMulOp WordVec 8 W16) = mkDyadic (fsLit "timesWord16X8#") word16X8PrimTy -primOpInfo (VecMulOp WordVec 4 W32) = mkDyadic (fsLit "timesWord32X4#") word32X4PrimTy -primOpInfo (VecMulOp WordVec 2 W64) = mkDyadic (fsLit "timesWord64X2#") word64X2PrimTy -primOpInfo (VecMulOp WordVec 32 W8) = mkDyadic (fsLit "timesWord8X32#") word8X32PrimTy -primOpInfo (VecMulOp WordVec 16 W16) = mkDyadic (fsLit "timesWord16X16#") word16X16PrimTy -primOpInfo (VecMulOp WordVec 8 W32) = mkDyadic (fsLit "timesWord32X8#") word32X8PrimTy -primOpInfo (VecMulOp WordVec 4 W64) = mkDyadic (fsLit "timesWord64X4#") word64X4PrimTy -primOpInfo (VecMulOp WordVec 64 W8) = mkDyadic (fsLit "timesWord8X64#") word8X64PrimTy -primOpInfo (VecMulOp WordVec 32 W16) = mkDyadic (fsLit "timesWord16X32#") word16X32PrimTy -primOpInfo (VecMulOp WordVec 16 W32) = mkDyadic (fsLit "timesWord32X16#") word32X16PrimTy -primOpInfo (VecMulOp WordVec 8 W64) = mkDyadic (fsLit "timesWord64X8#") word64X8PrimTy -primOpInfo (VecMulOp FloatVec 4 W32) = mkDyadic (fsLit "timesFloatX4#") floatX4PrimTy -primOpInfo (VecMulOp FloatVec 2 W64) = mkDyadic (fsLit "timesDoubleX2#") doubleX2PrimTy -primOpInfo (VecMulOp FloatVec 8 W32) = mkDyadic (fsLit "timesFloatX8#") floatX8PrimTy -primOpInfo (VecMulOp FloatVec 4 W64) = mkDyadic (fsLit "timesDoubleX4#") doubleX4PrimTy -primOpInfo (VecMulOp FloatVec 16 W32) = mkDyadic (fsLit "timesFloatX16#") floatX16PrimTy -primOpInfo (VecMulOp FloatVec 8 W64) = mkDyadic (fsLit "timesDoubleX8#") doubleX8PrimTy -primOpInfo (VecDivOp FloatVec 4 W32) = mkDyadic (fsLit "divideFloatX4#") floatX4PrimTy -primOpInfo (VecDivOp FloatVec 2 W64) = mkDyadic (fsLit "divideDoubleX2#") doubleX2PrimTy -primOpInfo (VecDivOp FloatVec 8 W32) = mkDyadic (fsLit "divideFloatX8#") floatX8PrimTy -primOpInfo (VecDivOp FloatVec 4 W64) = mkDyadic (fsLit "divideDoubleX4#") doubleX4PrimTy -primOpInfo (VecDivOp FloatVec 16 W32) = mkDyadic (fsLit "divideFloatX16#") floatX16PrimTy -primOpInfo (VecDivOp FloatVec 8 W64) = mkDyadic (fsLit "divideDoubleX8#") doubleX8PrimTy -primOpInfo (VecQuotOp IntVec 16 W8) = mkDyadic (fsLit "quotInt8X16#") int8X16PrimTy -primOpInfo (VecQuotOp IntVec 8 W16) = mkDyadic (fsLit "quotInt16X8#") int16X8PrimTy -primOpInfo (VecQuotOp IntVec 4 W32) = mkDyadic (fsLit "quotInt32X4#") int32X4PrimTy -primOpInfo (VecQuotOp IntVec 2 W64) = mkDyadic (fsLit "quotInt64X2#") int64X2PrimTy -primOpInfo (VecQuotOp IntVec 32 W8) = mkDyadic (fsLit "quotInt8X32#") int8X32PrimTy -primOpInfo (VecQuotOp IntVec 16 W16) = mkDyadic (fsLit "quotInt16X16#") int16X16PrimTy -primOpInfo (VecQuotOp IntVec 8 W32) = mkDyadic (fsLit "quotInt32X8#") int32X8PrimTy -primOpInfo (VecQuotOp IntVec 4 W64) = mkDyadic (fsLit "quotInt64X4#") int64X4PrimTy -primOpInfo (VecQuotOp IntVec 64 W8) = mkDyadic (fsLit "quotInt8X64#") int8X64PrimTy -primOpInfo (VecQuotOp IntVec 32 W16) = mkDyadic (fsLit "quotInt16X32#") int16X32PrimTy -primOpInfo (VecQuotOp IntVec 16 W32) = mkDyadic (fsLit "quotInt32X16#") int32X16PrimTy -primOpInfo (VecQuotOp IntVec 8 W64) = mkDyadic (fsLit "quotInt64X8#") int64X8PrimTy -primOpInfo (VecQuotOp WordVec 16 W8) = mkDyadic (fsLit "quotWord8X16#") word8X16PrimTy -primOpInfo (VecQuotOp WordVec 8 W16) = mkDyadic (fsLit "quotWord16X8#") word16X8PrimTy -primOpInfo (VecQuotOp WordVec 4 W32) = mkDyadic (fsLit "quotWord32X4#") word32X4PrimTy -primOpInfo (VecQuotOp WordVec 2 W64) = mkDyadic (fsLit "quotWord64X2#") word64X2PrimTy -primOpInfo (VecQuotOp WordVec 32 W8) = mkDyadic (fsLit "quotWord8X32#") word8X32PrimTy -primOpInfo (VecQuotOp WordVec 16 W16) = mkDyadic (fsLit "quotWord16X16#") word16X16PrimTy -primOpInfo (VecQuotOp WordVec 8 W32) = mkDyadic (fsLit "quotWord32X8#") word32X8PrimTy -primOpInfo (VecQuotOp WordVec 4 W64) = mkDyadic (fsLit "quotWord64X4#") word64X4PrimTy -primOpInfo (VecQuotOp WordVec 64 W8) = mkDyadic (fsLit "quotWord8X64#") word8X64PrimTy -primOpInfo (VecQuotOp WordVec 32 W16) = mkDyadic (fsLit "quotWord16X32#") word16X32PrimTy -primOpInfo (VecQuotOp WordVec 16 W32) = mkDyadic (fsLit "quotWord32X16#") word32X16PrimTy -primOpInfo (VecQuotOp WordVec 8 W64) = mkDyadic (fsLit "quotWord64X8#") word64X8PrimTy -primOpInfo (VecRemOp IntVec 16 W8) = mkDyadic (fsLit "remInt8X16#") int8X16PrimTy -primOpInfo (VecRemOp IntVec 8 W16) = mkDyadic (fsLit "remInt16X8#") int16X8PrimTy -primOpInfo (VecRemOp IntVec 4 W32) = mkDyadic (fsLit "remInt32X4#") int32X4PrimTy -primOpInfo (VecRemOp IntVec 2 W64) = mkDyadic (fsLit "remInt64X2#") int64X2PrimTy -primOpInfo (VecRemOp IntVec 32 W8) = mkDyadic (fsLit "remInt8X32#") int8X32PrimTy -primOpInfo (VecRemOp IntVec 16 W16) = mkDyadic (fsLit "remInt16X16#") int16X16PrimTy -primOpInfo (VecRemOp IntVec 8 W32) = mkDyadic (fsLit "remInt32X8#") int32X8PrimTy -primOpInfo (VecRemOp IntVec 4 W64) = mkDyadic (fsLit "remInt64X4#") int64X4PrimTy -primOpInfo (VecRemOp IntVec 64 W8) = mkDyadic (fsLit "remInt8X64#") int8X64PrimTy -primOpInfo (VecRemOp IntVec 32 W16) = mkDyadic (fsLit "remInt16X32#") int16X32PrimTy -primOpInfo (VecRemOp IntVec 16 W32) = mkDyadic (fsLit "remInt32X16#") int32X16PrimTy -primOpInfo (VecRemOp IntVec 8 W64) = mkDyadic (fsLit "remInt64X8#") int64X8PrimTy -primOpInfo (VecRemOp WordVec 16 W8) = mkDyadic (fsLit "remWord8X16#") word8X16PrimTy -primOpInfo (VecRemOp WordVec 8 W16) = mkDyadic (fsLit "remWord16X8#") word16X8PrimTy -primOpInfo (VecRemOp WordVec 4 W32) = mkDyadic (fsLit "remWord32X4#") word32X4PrimTy -primOpInfo (VecRemOp WordVec 2 W64) = mkDyadic (fsLit "remWord64X2#") word64X2PrimTy -primOpInfo (VecRemOp WordVec 32 W8) = mkDyadic (fsLit "remWord8X32#") word8X32PrimTy -primOpInfo (VecRemOp WordVec 16 W16) = mkDyadic (fsLit "remWord16X16#") word16X16PrimTy -primOpInfo (VecRemOp WordVec 8 W32) = mkDyadic (fsLit "remWord32X8#") word32X8PrimTy -primOpInfo (VecRemOp WordVec 4 W64) = mkDyadic (fsLit "remWord64X4#") word64X4PrimTy -primOpInfo (VecRemOp WordVec 64 W8) = mkDyadic (fsLit "remWord8X64#") word8X64PrimTy -primOpInfo (VecRemOp WordVec 32 W16) = mkDyadic (fsLit "remWord16X32#") word16X32PrimTy -primOpInfo (VecRemOp WordVec 16 W32) = mkDyadic (fsLit "remWord32X16#") word32X16PrimTy -primOpInfo (VecRemOp WordVec 8 W64) = mkDyadic (fsLit "remWord64X8#") word64X8PrimTy -primOpInfo (VecNegOp IntVec 16 W8) = mkMonadic (fsLit "negateInt8X16#") int8X16PrimTy -primOpInfo (VecNegOp IntVec 8 W16) = mkMonadic (fsLit "negateInt16X8#") int16X8PrimTy -primOpInfo (VecNegOp IntVec 4 W32) = mkMonadic (fsLit "negateInt32X4#") int32X4PrimTy -primOpInfo (VecNegOp IntVec 2 W64) = mkMonadic (fsLit "negateInt64X2#") int64X2PrimTy -primOpInfo (VecNegOp IntVec 32 W8) = mkMonadic (fsLit "negateInt8X32#") int8X32PrimTy -primOpInfo (VecNegOp IntVec 16 W16) = mkMonadic (fsLit "negateInt16X16#") int16X16PrimTy -primOpInfo (VecNegOp IntVec 8 W32) = mkMonadic (fsLit "negateInt32X8#") int32X8PrimTy -primOpInfo (VecNegOp IntVec 4 W64) = mkMonadic (fsLit "negateInt64X4#") int64X4PrimTy -primOpInfo (VecNegOp IntVec 64 W8) = mkMonadic (fsLit "negateInt8X64#") int8X64PrimTy -primOpInfo (VecNegOp IntVec 32 W16) = mkMonadic (fsLit "negateInt16X32#") int16X32PrimTy -primOpInfo (VecNegOp IntVec 16 W32) = mkMonadic (fsLit "negateInt32X16#") int32X16PrimTy -primOpInfo (VecNegOp IntVec 8 W64) = mkMonadic (fsLit "negateInt64X8#") int64X8PrimTy -primOpInfo (VecNegOp FloatVec 4 W32) = mkMonadic (fsLit "negateFloatX4#") floatX4PrimTy -primOpInfo (VecNegOp FloatVec 2 W64) = mkMonadic (fsLit "negateDoubleX2#") doubleX2PrimTy -primOpInfo (VecNegOp FloatVec 8 W32) = mkMonadic (fsLit "negateFloatX8#") floatX8PrimTy -primOpInfo (VecNegOp FloatVec 4 W64) = mkMonadic (fsLit "negateDoubleX4#") doubleX4PrimTy -primOpInfo (VecNegOp FloatVec 16 W32) = mkMonadic (fsLit "negateFloatX16#") floatX16PrimTy -primOpInfo (VecNegOp FloatVec 8 W64) = mkMonadic (fsLit "negateDoubleX8#") doubleX8PrimTy -primOpInfo (VecIndexByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "indexInt8X16Array#") [] [byteArrayPrimTy, intPrimTy] (int8X16PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "indexInt16X8Array#") [] [byteArrayPrimTy, intPrimTy] (int16X8PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "indexInt32X4Array#") [] [byteArrayPrimTy, intPrimTy] (int32X4PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "indexInt64X2Array#") [] [byteArrayPrimTy, intPrimTy] (int64X2PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "indexInt8X32Array#") [] [byteArrayPrimTy, intPrimTy] (int8X32PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "indexInt16X16Array#") [] [byteArrayPrimTy, intPrimTy] (int16X16PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "indexInt32X8Array#") [] [byteArrayPrimTy, intPrimTy] (int32X8PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "indexInt64X4Array#") [] [byteArrayPrimTy, intPrimTy] (int64X4PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "indexInt8X64Array#") [] [byteArrayPrimTy, intPrimTy] (int8X64PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "indexInt16X32Array#") [] [byteArrayPrimTy, intPrimTy] (int16X32PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "indexInt32X16Array#") [] [byteArrayPrimTy, intPrimTy] (int32X16PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "indexInt64X8Array#") [] [byteArrayPrimTy, intPrimTy] (int64X8PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "indexWord8X16Array#") [] [byteArrayPrimTy, intPrimTy] (word8X16PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "indexWord16X8Array#") [] [byteArrayPrimTy, intPrimTy] (word16X8PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "indexWord32X4Array#") [] [byteArrayPrimTy, intPrimTy] (word32X4PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "indexWord64X2Array#") [] [byteArrayPrimTy, intPrimTy] (word64X2PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "indexWord8X32Array#") [] [byteArrayPrimTy, intPrimTy] (word8X32PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "indexWord16X16Array#") [] [byteArrayPrimTy, intPrimTy] (word16X16PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "indexWord32X8Array#") [] [byteArrayPrimTy, intPrimTy] (word32X8PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "indexWord64X4Array#") [] [byteArrayPrimTy, intPrimTy] (word64X4PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "indexWord8X64Array#") [] [byteArrayPrimTy, intPrimTy] (word8X64PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "indexWord16X32Array#") [] [byteArrayPrimTy, intPrimTy] (word16X32PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "indexWord32X16Array#") [] [byteArrayPrimTy, intPrimTy] (word32X16PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "indexWord64X8Array#") [] [byteArrayPrimTy, intPrimTy] (word64X8PrimTy) -primOpInfo (VecIndexByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "indexFloatX4Array#") [] [byteArrayPrimTy, intPrimTy] (floatX4PrimTy) -primOpInfo (VecIndexByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "indexDoubleX2Array#") [] [byteArrayPrimTy, intPrimTy] (doubleX2PrimTy) -primOpInfo (VecIndexByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "indexFloatX8Array#") [] [byteArrayPrimTy, intPrimTy] (floatX8PrimTy) -primOpInfo (VecIndexByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "indexDoubleX4Array#") [] [byteArrayPrimTy, intPrimTy] (doubleX4PrimTy) -primOpInfo (VecIndexByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "indexFloatX16Array#") [] [byteArrayPrimTy, intPrimTy] (floatX16PrimTy) -primOpInfo (VecIndexByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "indexDoubleX8Array#") [] [byteArrayPrimTy, intPrimTy] (doubleX8PrimTy) -primOpInfo (VecReadByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "readInt8X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X16PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "readInt16X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X8PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "readInt32X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X4PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "readInt64X2Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X2PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "readInt8X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X32PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "readInt16X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X16PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "readInt32X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X8PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "readInt64X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X4PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "readInt8X64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X64PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "readInt16X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X32PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "readInt32X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X16PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "readInt64X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X8PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "readWord8X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X16PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "readWord16X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X8PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "readWord32X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X4PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "readWord64X2Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X2PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "readWord8X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X32PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "readWord16X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X16PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "readWord32X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X8PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "readWord64X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X4PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "readWord8X64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X64PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "readWord16X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X32PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "readWord32X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X16PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "readWord64X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X8PrimTy])) -primOpInfo (VecReadByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "readFloatX4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX4PrimTy])) -primOpInfo (VecReadByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "readDoubleX2Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX2PrimTy])) -primOpInfo (VecReadByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "readFloatX8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX8PrimTy])) -primOpInfo (VecReadByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "readDoubleX4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX4PrimTy])) -primOpInfo (VecReadByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "readFloatX16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX16PrimTy])) -primOpInfo (VecReadByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "readDoubleX8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX8PrimTy])) -primOpInfo (VecWriteByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "writeInt8X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "writeInt16X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "writeInt32X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "writeInt64X2Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "writeInt8X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "writeInt16X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "writeInt32X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "writeInt64X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "writeInt8X64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "writeInt16X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "writeInt32X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "writeInt64X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "writeWord8X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "writeWord16X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "writeWord32X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "writeWord64X2Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "writeWord8X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "writeWord16X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "writeWord32X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "writeWord64X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "writeWord8X64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "writeWord16X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "writeWord32X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "writeWord64X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "writeFloatX4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "writeDoubleX2Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "writeFloatX8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "writeDoubleX4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "writeFloatX16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "writeDoubleX8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecIndexOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "indexInt8X16OffAddr#") [] [addrPrimTy, intPrimTy] (int8X16PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "indexInt16X8OffAddr#") [] [addrPrimTy, intPrimTy] (int16X8PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "indexInt32X4OffAddr#") [] [addrPrimTy, intPrimTy] (int32X4PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "indexInt64X2OffAddr#") [] [addrPrimTy, intPrimTy] (int64X2PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "indexInt8X32OffAddr#") [] [addrPrimTy, intPrimTy] (int8X32PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "indexInt16X16OffAddr#") [] [addrPrimTy, intPrimTy] (int16X16PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "indexInt32X8OffAddr#") [] [addrPrimTy, intPrimTy] (int32X8PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "indexInt64X4OffAddr#") [] [addrPrimTy, intPrimTy] (int64X4PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "indexInt8X64OffAddr#") [] [addrPrimTy, intPrimTy] (int8X64PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "indexInt16X32OffAddr#") [] [addrPrimTy, intPrimTy] (int16X32PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "indexInt32X16OffAddr#") [] [addrPrimTy, intPrimTy] (int32X16PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "indexInt64X8OffAddr#") [] [addrPrimTy, intPrimTy] (int64X8PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "indexWord8X16OffAddr#") [] [addrPrimTy, intPrimTy] (word8X16PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "indexWord16X8OffAddr#") [] [addrPrimTy, intPrimTy] (word16X8PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "indexWord32X4OffAddr#") [] [addrPrimTy, intPrimTy] (word32X4PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "indexWord64X2OffAddr#") [] [addrPrimTy, intPrimTy] (word64X2PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "indexWord8X32OffAddr#") [] [addrPrimTy, intPrimTy] (word8X32PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "indexWord16X16OffAddr#") [] [addrPrimTy, intPrimTy] (word16X16PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "indexWord32X8OffAddr#") [] [addrPrimTy, intPrimTy] (word32X8PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "indexWord64X4OffAddr#") [] [addrPrimTy, intPrimTy] (word64X4PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "indexWord8X64OffAddr#") [] [addrPrimTy, intPrimTy] (word8X64PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "indexWord16X32OffAddr#") [] [addrPrimTy, intPrimTy] (word16X32PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "indexWord32X16OffAddr#") [] [addrPrimTy, intPrimTy] (word32X16PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "indexWord64X8OffAddr#") [] [addrPrimTy, intPrimTy] (word64X8PrimTy) -primOpInfo (VecIndexOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "indexFloatX4OffAddr#") [] [addrPrimTy, intPrimTy] (floatX4PrimTy) -primOpInfo (VecIndexOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "indexDoubleX2OffAddr#") [] [addrPrimTy, intPrimTy] (doubleX2PrimTy) -primOpInfo (VecIndexOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "indexFloatX8OffAddr#") [] [addrPrimTy, intPrimTy] (floatX8PrimTy) -primOpInfo (VecIndexOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "indexDoubleX4OffAddr#") [] [addrPrimTy, intPrimTy] (doubleX4PrimTy) -primOpInfo (VecIndexOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "indexFloatX16OffAddr#") [] [addrPrimTy, intPrimTy] (floatX16PrimTy) -primOpInfo (VecIndexOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "indexDoubleX8OffAddr#") [] [addrPrimTy, intPrimTy] (doubleX8PrimTy) -primOpInfo (VecReadOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "readInt8X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X16PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "readInt16X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X8PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "readInt32X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X4PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "readInt64X2OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X2PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "readInt8X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X32PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "readInt16X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X16PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "readInt32X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X8PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "readInt64X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X4PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "readInt8X64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X64PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "readInt16X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X32PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "readInt32X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X16PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "readInt64X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X8PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "readWord8X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X16PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "readWord16X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X8PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "readWord32X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X4PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "readWord64X2OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X2PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "readWord8X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X32PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "readWord16X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X16PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "readWord32X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X8PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "readWord64X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X4PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "readWord8X64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X64PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "readWord16X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X32PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "readWord32X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X16PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "readWord64X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X8PrimTy])) -primOpInfo (VecReadOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "readFloatX4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX4PrimTy])) -primOpInfo (VecReadOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "readDoubleX2OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX2PrimTy])) -primOpInfo (VecReadOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "readFloatX8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX8PrimTy])) -primOpInfo (VecReadOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "readDoubleX4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX4PrimTy])) -primOpInfo (VecReadOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "readFloatX16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX16PrimTy])) -primOpInfo (VecReadOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "readDoubleX8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX8PrimTy])) -primOpInfo (VecWriteOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "writeInt8X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "writeInt16X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "writeInt32X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "writeInt64X2OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "writeInt8X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "writeInt16X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "writeInt32X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "writeInt64X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "writeInt8X64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "writeInt16X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "writeInt32X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "writeInt64X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "writeWord8X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "writeWord16X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "writeWord32X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "writeWord64X2OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "writeWord8X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "writeWord16X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "writeWord32X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "writeWord64X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "writeWord8X64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "writeWord16X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "writeWord32X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "writeWord64X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "writeFloatX4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, floatX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "writeDoubleX2OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, doubleX2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "writeFloatX8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, floatX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "writeDoubleX4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, doubleX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "writeFloatX16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, floatX16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "writeDoubleX8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, doubleX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "indexInt8ArrayAsInt8X16#") [] [byteArrayPrimTy, intPrimTy] (int8X16PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "indexInt16ArrayAsInt16X8#") [] [byteArrayPrimTy, intPrimTy] (int16X8PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "indexInt32ArrayAsInt32X4#") [] [byteArrayPrimTy, intPrimTy] (int32X4PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "indexInt64ArrayAsInt64X2#") [] [byteArrayPrimTy, intPrimTy] (int64X2PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "indexInt8ArrayAsInt8X32#") [] [byteArrayPrimTy, intPrimTy] (int8X32PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "indexInt16ArrayAsInt16X16#") [] [byteArrayPrimTy, intPrimTy] (int16X16PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "indexInt32ArrayAsInt32X8#") [] [byteArrayPrimTy, intPrimTy] (int32X8PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "indexInt64ArrayAsInt64X4#") [] [byteArrayPrimTy, intPrimTy] (int64X4PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "indexInt8ArrayAsInt8X64#") [] [byteArrayPrimTy, intPrimTy] (int8X64PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "indexInt16ArrayAsInt16X32#") [] [byteArrayPrimTy, intPrimTy] (int16X32PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "indexInt32ArrayAsInt32X16#") [] [byteArrayPrimTy, intPrimTy] (int32X16PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "indexInt64ArrayAsInt64X8#") [] [byteArrayPrimTy, intPrimTy] (int64X8PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "indexWord8ArrayAsWord8X16#") [] [byteArrayPrimTy, intPrimTy] (word8X16PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "indexWord16ArrayAsWord16X8#") [] [byteArrayPrimTy, intPrimTy] (word16X8PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "indexWord32ArrayAsWord32X4#") [] [byteArrayPrimTy, intPrimTy] (word32X4PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "indexWord64ArrayAsWord64X2#") [] [byteArrayPrimTy, intPrimTy] (word64X2PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "indexWord8ArrayAsWord8X32#") [] [byteArrayPrimTy, intPrimTy] (word8X32PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "indexWord16ArrayAsWord16X16#") [] [byteArrayPrimTy, intPrimTy] (word16X16PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "indexWord32ArrayAsWord32X8#") [] [byteArrayPrimTy, intPrimTy] (word32X8PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "indexWord64ArrayAsWord64X4#") [] [byteArrayPrimTy, intPrimTy] (word64X4PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "indexWord8ArrayAsWord8X64#") [] [byteArrayPrimTy, intPrimTy] (word8X64PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "indexWord16ArrayAsWord16X32#") [] [byteArrayPrimTy, intPrimTy] (word16X32PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "indexWord32ArrayAsWord32X16#") [] [byteArrayPrimTy, intPrimTy] (word32X16PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "indexWord64ArrayAsWord64X8#") [] [byteArrayPrimTy, intPrimTy] (word64X8PrimTy) -primOpInfo (VecIndexScalarByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "indexFloatArrayAsFloatX4#") [] [byteArrayPrimTy, intPrimTy] (floatX4PrimTy) -primOpInfo (VecIndexScalarByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "indexDoubleArrayAsDoubleX2#") [] [byteArrayPrimTy, intPrimTy] (doubleX2PrimTy) -primOpInfo (VecIndexScalarByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "indexFloatArrayAsFloatX8#") [] [byteArrayPrimTy, intPrimTy] (floatX8PrimTy) -primOpInfo (VecIndexScalarByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "indexDoubleArrayAsDoubleX4#") [] [byteArrayPrimTy, intPrimTy] (doubleX4PrimTy) -primOpInfo (VecIndexScalarByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "indexFloatArrayAsFloatX16#") [] [byteArrayPrimTy, intPrimTy] (floatX16PrimTy) -primOpInfo (VecIndexScalarByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "indexDoubleArrayAsDoubleX8#") [] [byteArrayPrimTy, intPrimTy] (doubleX8PrimTy) -primOpInfo (VecReadScalarByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "readInt8ArrayAsInt8X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X16PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "readInt16ArrayAsInt16X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X8PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "readInt32ArrayAsInt32X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X4PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "readInt64ArrayAsInt64X2#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X2PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "readInt8ArrayAsInt8X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X32PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "readInt16ArrayAsInt16X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X16PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "readInt32ArrayAsInt32X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X8PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "readInt64ArrayAsInt64X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X4PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "readInt8ArrayAsInt8X64#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X64PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "readInt16ArrayAsInt16X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X32PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "readInt32ArrayAsInt32X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X16PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "readInt64ArrayAsInt64X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X8PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "readWord8ArrayAsWord8X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X16PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "readWord16ArrayAsWord16X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X8PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "readWord32ArrayAsWord32X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X4PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "readWord64ArrayAsWord64X2#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X2PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "readWord8ArrayAsWord8X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X32PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "readWord16ArrayAsWord16X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X16PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "readWord32ArrayAsWord32X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X8PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "readWord64ArrayAsWord64X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X4PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "readWord8ArrayAsWord8X64#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X64PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "readWord16ArrayAsWord16X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X32PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "readWord32ArrayAsWord32X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X16PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "readWord64ArrayAsWord64X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X8PrimTy])) -primOpInfo (VecReadScalarByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "readFloatArrayAsFloatX4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX4PrimTy])) -primOpInfo (VecReadScalarByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "readDoubleArrayAsDoubleX2#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX2PrimTy])) -primOpInfo (VecReadScalarByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "readFloatArrayAsFloatX8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX8PrimTy])) -primOpInfo (VecReadScalarByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "readDoubleArrayAsDoubleX4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX4PrimTy])) -primOpInfo (VecReadScalarByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "readFloatArrayAsFloatX16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX16PrimTy])) -primOpInfo (VecReadScalarByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "readDoubleArrayAsDoubleX8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX8PrimTy])) -primOpInfo (VecWriteScalarByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "writeInt8ArrayAsInt8X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "writeInt16ArrayAsInt16X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "writeInt32ArrayAsInt32X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "writeInt64ArrayAsInt64X2#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "writeInt8ArrayAsInt8X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "writeInt16ArrayAsInt16X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "writeInt32ArrayAsInt32X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "writeInt64ArrayAsInt64X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "writeInt8ArrayAsInt8X64#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "writeInt16ArrayAsInt16X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "writeInt32ArrayAsInt32X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "writeInt64ArrayAsInt64X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "writeWord8ArrayAsWord8X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "writeWord16ArrayAsWord16X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "writeWord32ArrayAsWord32X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "writeWord64ArrayAsWord64X2#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "writeWord8ArrayAsWord8X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "writeWord16ArrayAsWord16X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "writeWord32ArrayAsWord32X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "writeWord64ArrayAsWord64X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "writeWord8ArrayAsWord8X64#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "writeWord16ArrayAsWord16X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "writeWord32ArrayAsWord32X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "writeWord64ArrayAsWord64X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "writeFloatArrayAsFloatX4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "writeDoubleArrayAsDoubleX2#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "writeFloatArrayAsFloatX8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "writeDoubleArrayAsDoubleX4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "writeFloatArrayAsFloatX16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "writeDoubleArrayAsDoubleX8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "indexInt8OffAddrAsInt8X16#") [] [addrPrimTy, intPrimTy] (int8X16PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "indexInt16OffAddrAsInt16X8#") [] [addrPrimTy, intPrimTy] (int16X8PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "indexInt32OffAddrAsInt32X4#") [] [addrPrimTy, intPrimTy] (int32X4PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "indexInt64OffAddrAsInt64X2#") [] [addrPrimTy, intPrimTy] (int64X2PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "indexInt8OffAddrAsInt8X32#") [] [addrPrimTy, intPrimTy] (int8X32PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "indexInt16OffAddrAsInt16X16#") [] [addrPrimTy, intPrimTy] (int16X16PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "indexInt32OffAddrAsInt32X8#") [] [addrPrimTy, intPrimTy] (int32X8PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "indexInt64OffAddrAsInt64X4#") [] [addrPrimTy, intPrimTy] (int64X4PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "indexInt8OffAddrAsInt8X64#") [] [addrPrimTy, intPrimTy] (int8X64PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "indexInt16OffAddrAsInt16X32#") [] [addrPrimTy, intPrimTy] (int16X32PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "indexInt32OffAddrAsInt32X16#") [] [addrPrimTy, intPrimTy] (int32X16PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "indexInt64OffAddrAsInt64X8#") [] [addrPrimTy, intPrimTy] (int64X8PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "indexWord8OffAddrAsWord8X16#") [] [addrPrimTy, intPrimTy] (word8X16PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "indexWord16OffAddrAsWord16X8#") [] [addrPrimTy, intPrimTy] (word16X8PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "indexWord32OffAddrAsWord32X4#") [] [addrPrimTy, intPrimTy] (word32X4PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "indexWord64OffAddrAsWord64X2#") [] [addrPrimTy, intPrimTy] (word64X2PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "indexWord8OffAddrAsWord8X32#") [] [addrPrimTy, intPrimTy] (word8X32PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "indexWord16OffAddrAsWord16X16#") [] [addrPrimTy, intPrimTy] (word16X16PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "indexWord32OffAddrAsWord32X8#") [] [addrPrimTy, intPrimTy] (word32X8PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "indexWord64OffAddrAsWord64X4#") [] [addrPrimTy, intPrimTy] (word64X4PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "indexWord8OffAddrAsWord8X64#") [] [addrPrimTy, intPrimTy] (word8X64PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "indexWord16OffAddrAsWord16X32#") [] [addrPrimTy, intPrimTy] (word16X32PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "indexWord32OffAddrAsWord32X16#") [] [addrPrimTy, intPrimTy] (word32X16PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "indexWord64OffAddrAsWord64X8#") [] [addrPrimTy, intPrimTy] (word64X8PrimTy) -primOpInfo (VecIndexScalarOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "indexFloatOffAddrAsFloatX4#") [] [addrPrimTy, intPrimTy] (floatX4PrimTy) -primOpInfo (VecIndexScalarOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "indexDoubleOffAddrAsDoubleX2#") [] [addrPrimTy, intPrimTy] (doubleX2PrimTy) -primOpInfo (VecIndexScalarOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "indexFloatOffAddrAsFloatX8#") [] [addrPrimTy, intPrimTy] (floatX8PrimTy) -primOpInfo (VecIndexScalarOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "indexDoubleOffAddrAsDoubleX4#") [] [addrPrimTy, intPrimTy] (doubleX4PrimTy) -primOpInfo (VecIndexScalarOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "indexFloatOffAddrAsFloatX16#") [] [addrPrimTy, intPrimTy] (floatX16PrimTy) -primOpInfo (VecIndexScalarOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "indexDoubleOffAddrAsDoubleX8#") [] [addrPrimTy, intPrimTy] (doubleX8PrimTy) -primOpInfo (VecReadScalarOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "readInt8OffAddrAsInt8X16#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X16PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "readInt16OffAddrAsInt16X8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X8PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "readInt32OffAddrAsInt32X4#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X4PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "readInt64OffAddrAsInt64X2#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X2PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "readInt8OffAddrAsInt8X32#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X32PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "readInt16OffAddrAsInt16X16#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X16PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "readInt32OffAddrAsInt32X8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X8PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "readInt64OffAddrAsInt64X4#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X4PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "readInt8OffAddrAsInt8X64#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X64PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "readInt16OffAddrAsInt16X32#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X32PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "readInt32OffAddrAsInt32X16#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X16PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "readInt64OffAddrAsInt64X8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X8PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "readWord8OffAddrAsWord8X16#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X16PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "readWord16OffAddrAsWord16X8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X8PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "readWord32OffAddrAsWord32X4#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X4PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "readWord64OffAddrAsWord64X2#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X2PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "readWord8OffAddrAsWord8X32#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X32PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "readWord16OffAddrAsWord16X16#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X16PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "readWord32OffAddrAsWord32X8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X8PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "readWord64OffAddrAsWord64X4#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X4PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "readWord8OffAddrAsWord8X64#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X64PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "readWord16OffAddrAsWord16X32#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X32PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "readWord32OffAddrAsWord32X16#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X16PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "readWord64OffAddrAsWord64X8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X8PrimTy])) -primOpInfo (VecReadScalarOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "readFloatOffAddrAsFloatX4#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX4PrimTy])) -primOpInfo (VecReadScalarOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "readDoubleOffAddrAsDoubleX2#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX2PrimTy])) -primOpInfo (VecReadScalarOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "readFloatOffAddrAsFloatX8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX8PrimTy])) -primOpInfo (VecReadScalarOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "readDoubleOffAddrAsDoubleX4#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX4PrimTy])) -primOpInfo (VecReadScalarOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "readFloatOffAddrAsFloatX16#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX16PrimTy])) -primOpInfo (VecReadScalarOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "readDoubleOffAddrAsDoubleX8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX8PrimTy])) -primOpInfo (VecWriteScalarOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "writeInt8OffAddrAsInt8X16#") [deltaTyVar] [addrPrimTy, intPrimTy, int8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "writeInt16OffAddrAsInt16X8#") [deltaTyVar] [addrPrimTy, intPrimTy, int16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "writeInt32OffAddrAsInt32X4#") [deltaTyVar] [addrPrimTy, intPrimTy, int32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "writeInt64OffAddrAsInt64X2#") [deltaTyVar] [addrPrimTy, intPrimTy, int64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "writeInt8OffAddrAsInt8X32#") [deltaTyVar] [addrPrimTy, intPrimTy, int8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "writeInt16OffAddrAsInt16X16#") [deltaTyVar] [addrPrimTy, intPrimTy, int16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "writeInt32OffAddrAsInt32X8#") [deltaTyVar] [addrPrimTy, intPrimTy, int32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "writeInt64OffAddrAsInt64X4#") [deltaTyVar] [addrPrimTy, intPrimTy, int64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "writeInt8OffAddrAsInt8X64#") [deltaTyVar] [addrPrimTy, intPrimTy, int8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "writeInt16OffAddrAsInt16X32#") [deltaTyVar] [addrPrimTy, intPrimTy, int16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "writeInt32OffAddrAsInt32X16#") [deltaTyVar] [addrPrimTy, intPrimTy, int32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "writeInt64OffAddrAsInt64X8#") [deltaTyVar] [addrPrimTy, intPrimTy, int64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "writeWord8OffAddrAsWord8X16#") [deltaTyVar] [addrPrimTy, intPrimTy, word8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "writeWord16OffAddrAsWord16X8#") [deltaTyVar] [addrPrimTy, intPrimTy, word16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "writeWord32OffAddrAsWord32X4#") [deltaTyVar] [addrPrimTy, intPrimTy, word32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "writeWord64OffAddrAsWord64X2#") [deltaTyVar] [addrPrimTy, intPrimTy, word64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "writeWord8OffAddrAsWord8X32#") [deltaTyVar] [addrPrimTy, intPrimTy, word8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "writeWord16OffAddrAsWord16X16#") [deltaTyVar] [addrPrimTy, intPrimTy, word16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "writeWord32OffAddrAsWord32X8#") [deltaTyVar] [addrPrimTy, intPrimTy, word32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "writeWord64OffAddrAsWord64X4#") [deltaTyVar] [addrPrimTy, intPrimTy, word64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "writeWord8OffAddrAsWord8X64#") [deltaTyVar] [addrPrimTy, intPrimTy, word8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "writeWord16OffAddrAsWord16X32#") [deltaTyVar] [addrPrimTy, intPrimTy, word16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "writeWord32OffAddrAsWord32X16#") [deltaTyVar] [addrPrimTy, intPrimTy, word32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "writeWord64OffAddrAsWord64X8#") [deltaTyVar] [addrPrimTy, intPrimTy, word64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "writeFloatOffAddrAsFloatX4#") [deltaTyVar] [addrPrimTy, intPrimTy, floatX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "writeDoubleOffAddrAsDoubleX2#") [deltaTyVar] [addrPrimTy, intPrimTy, doubleX2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "writeFloatOffAddrAsFloatX8#") [deltaTyVar] [addrPrimTy, intPrimTy, floatX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "writeDoubleOffAddrAsDoubleX4#") [deltaTyVar] [addrPrimTy, intPrimTy, doubleX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "writeFloatOffAddrAsFloatX16#") [deltaTyVar] [addrPrimTy, intPrimTy, floatX16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "writeDoubleOffAddrAsDoubleX8#") [deltaTyVar] [addrPrimTy, intPrimTy, doubleX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo PrefetchByteArrayOp3 = mkGenPrimOp (fsLit "prefetchByteArray3#") [] [byteArrayPrimTy, intPrimTy] (byteArrayPrimTy) -primOpInfo PrefetchMutableByteArrayOp3 = mkGenPrimOp (fsLit "prefetchMutableByteArray3#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo PrefetchAddrOp3 = mkGenPrimOp (fsLit "prefetchAddr3#") [] [addrPrimTy, intPrimTy] (addrPrimTy) -primOpInfo PrefetchByteArrayOp2 = mkGenPrimOp (fsLit "prefetchByteArray2#") [] [byteArrayPrimTy, intPrimTy] (byteArrayPrimTy) -primOpInfo PrefetchMutableByteArrayOp2 = mkGenPrimOp (fsLit "prefetchMutableByteArray2#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo PrefetchAddrOp2 = mkGenPrimOp (fsLit "prefetchAddr2#") [] [addrPrimTy, intPrimTy] (addrPrimTy) -primOpInfo PrefetchByteArrayOp1 = mkGenPrimOp (fsLit "prefetchByteArray1#") [] [byteArrayPrimTy, intPrimTy] (byteArrayPrimTy) -primOpInfo PrefetchMutableByteArrayOp1 = mkGenPrimOp (fsLit "prefetchMutableByteArray1#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo PrefetchAddrOp1 = mkGenPrimOp (fsLit "prefetchAddr1#") [] [addrPrimTy, intPrimTy] (addrPrimTy) -primOpInfo PrefetchByteArrayOp0 = mkGenPrimOp (fsLit "prefetchByteArray0#") [] [byteArrayPrimTy, intPrimTy] (byteArrayPrimTy) -primOpInfo PrefetchMutableByteArrayOp0 = mkGenPrimOp (fsLit "prefetchMutableByteArray0#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo PrefetchAddrOp0 = mkGenPrimOp (fsLit "prefetchAddr0#") [] [addrPrimTy, intPrimTy] (addrPrimTy) diff --git a/include/prim/primop-primop-info-710.hs-incl b/include/prim/primop-primop-info-710.hs-incl deleted file mode 100644 index 78200849..00000000 --- a/include/prim/primop-primop-info-710.hs-incl +++ /dev/null @@ -1,1052 +0,0 @@ -primOpInfo CharGtOp = mkCompare (fsLit "gtChar#") charPrimTy -primOpInfo CharGeOp = mkCompare (fsLit "geChar#") charPrimTy -primOpInfo CharEqOp = mkCompare (fsLit "eqChar#") charPrimTy -primOpInfo CharNeOp = mkCompare (fsLit "neChar#") charPrimTy -primOpInfo CharLtOp = mkCompare (fsLit "ltChar#") charPrimTy -primOpInfo CharLeOp = mkCompare (fsLit "leChar#") charPrimTy -primOpInfo OrdOp = mkGenPrimOp (fsLit "ord#") [] [charPrimTy] (intPrimTy) -primOpInfo IntAddOp = mkDyadic (fsLit "+#") intPrimTy -primOpInfo IntSubOp = mkDyadic (fsLit "-#") intPrimTy -primOpInfo IntMulOp = mkDyadic (fsLit "*#") intPrimTy -primOpInfo IntMulMayOfloOp = mkDyadic (fsLit "mulIntMayOflo#") intPrimTy -primOpInfo IntQuotOp = mkDyadic (fsLit "quotInt#") intPrimTy -primOpInfo IntRemOp = mkDyadic (fsLit "remInt#") intPrimTy -primOpInfo IntQuotRemOp = mkGenPrimOp (fsLit "quotRemInt#") [] [intPrimTy, intPrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy])) -primOpInfo AndIOp = mkDyadic (fsLit "andI#") intPrimTy -primOpInfo OrIOp = mkDyadic (fsLit "orI#") intPrimTy -primOpInfo XorIOp = mkDyadic (fsLit "xorI#") intPrimTy -primOpInfo NotIOp = mkMonadic (fsLit "notI#") intPrimTy -primOpInfo IntNegOp = mkMonadic (fsLit "negateInt#") intPrimTy -primOpInfo IntAddCOp = mkGenPrimOp (fsLit "addIntC#") [] [intPrimTy, intPrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy])) -primOpInfo IntSubCOp = mkGenPrimOp (fsLit "subIntC#") [] [intPrimTy, intPrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy])) -primOpInfo IntGtOp = mkCompare (fsLit ">#") intPrimTy -primOpInfo IntGeOp = mkCompare (fsLit ">=#") intPrimTy -primOpInfo IntEqOp = mkCompare (fsLit "==#") intPrimTy -primOpInfo IntNeOp = mkCompare (fsLit "/=#") intPrimTy -primOpInfo IntLtOp = mkCompare (fsLit "<#") intPrimTy -primOpInfo IntLeOp = mkCompare (fsLit "<=#") intPrimTy -primOpInfo ChrOp = mkGenPrimOp (fsLit "chr#") [] [intPrimTy] (charPrimTy) -primOpInfo Int2WordOp = mkGenPrimOp (fsLit "int2Word#") [] [intPrimTy] (wordPrimTy) -primOpInfo Int2FloatOp = mkGenPrimOp (fsLit "int2Float#") [] [intPrimTy] (floatPrimTy) -primOpInfo Int2DoubleOp = mkGenPrimOp (fsLit "int2Double#") [] [intPrimTy] (doublePrimTy) -primOpInfo Word2FloatOp = mkGenPrimOp (fsLit "word2Float#") [] [wordPrimTy] (floatPrimTy) -primOpInfo Word2DoubleOp = mkGenPrimOp (fsLit "word2Double#") [] [wordPrimTy] (doublePrimTy) -primOpInfo ISllOp = mkGenPrimOp (fsLit "uncheckedIShiftL#") [] [intPrimTy, intPrimTy] (intPrimTy) -primOpInfo ISraOp = mkGenPrimOp (fsLit "uncheckedIShiftRA#") [] [intPrimTy, intPrimTy] (intPrimTy) -primOpInfo ISrlOp = mkGenPrimOp (fsLit "uncheckedIShiftRL#") [] [intPrimTy, intPrimTy] (intPrimTy) -primOpInfo WordAddOp = mkDyadic (fsLit "plusWord#") wordPrimTy -primOpInfo WordAdd2Op = mkGenPrimOp (fsLit "plusWord2#") [] [wordPrimTy, wordPrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy])) -primOpInfo WordSubOp = mkDyadic (fsLit "minusWord#") wordPrimTy -primOpInfo WordMulOp = mkDyadic (fsLit "timesWord#") wordPrimTy -primOpInfo WordMul2Op = mkGenPrimOp (fsLit "timesWord2#") [] [wordPrimTy, wordPrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy])) -primOpInfo WordQuotOp = mkDyadic (fsLit "quotWord#") wordPrimTy -primOpInfo WordRemOp = mkDyadic (fsLit "remWord#") wordPrimTy -primOpInfo WordQuotRemOp = mkGenPrimOp (fsLit "quotRemWord#") [] [wordPrimTy, wordPrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy])) -primOpInfo WordQuotRem2Op = mkGenPrimOp (fsLit "quotRemWord2#") [] [wordPrimTy, wordPrimTy, wordPrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy])) -primOpInfo AndOp = mkDyadic (fsLit "and#") wordPrimTy -primOpInfo OrOp = mkDyadic (fsLit "or#") wordPrimTy -primOpInfo XorOp = mkDyadic (fsLit "xor#") wordPrimTy -primOpInfo NotOp = mkMonadic (fsLit "not#") wordPrimTy -primOpInfo SllOp = mkGenPrimOp (fsLit "uncheckedShiftL#") [] [wordPrimTy, intPrimTy] (wordPrimTy) -primOpInfo SrlOp = mkGenPrimOp (fsLit "uncheckedShiftRL#") [] [wordPrimTy, intPrimTy] (wordPrimTy) -primOpInfo Word2IntOp = mkGenPrimOp (fsLit "word2Int#") [] [wordPrimTy] (intPrimTy) -primOpInfo WordGtOp = mkCompare (fsLit "gtWord#") wordPrimTy -primOpInfo WordGeOp = mkCompare (fsLit "geWord#") wordPrimTy -primOpInfo WordEqOp = mkCompare (fsLit "eqWord#") wordPrimTy -primOpInfo WordNeOp = mkCompare (fsLit "neWord#") wordPrimTy -primOpInfo WordLtOp = mkCompare (fsLit "ltWord#") wordPrimTy -primOpInfo WordLeOp = mkCompare (fsLit "leWord#") wordPrimTy -primOpInfo PopCnt8Op = mkMonadic (fsLit "popCnt8#") wordPrimTy -primOpInfo PopCnt16Op = mkMonadic (fsLit "popCnt16#") wordPrimTy -primOpInfo PopCnt32Op = mkMonadic (fsLit "popCnt32#") wordPrimTy -primOpInfo PopCnt64Op = mkGenPrimOp (fsLit "popCnt64#") [] [word64PrimTy] (wordPrimTy) -primOpInfo PopCntOp = mkMonadic (fsLit "popCnt#") wordPrimTy -primOpInfo Clz8Op = mkMonadic (fsLit "clz8#") wordPrimTy -primOpInfo Clz16Op = mkMonadic (fsLit "clz16#") wordPrimTy -primOpInfo Clz32Op = mkMonadic (fsLit "clz32#") wordPrimTy -primOpInfo Clz64Op = mkGenPrimOp (fsLit "clz64#") [] [word64PrimTy] (wordPrimTy) -primOpInfo ClzOp = mkMonadic (fsLit "clz#") wordPrimTy -primOpInfo Ctz8Op = mkMonadic (fsLit "ctz8#") wordPrimTy -primOpInfo Ctz16Op = mkMonadic (fsLit "ctz16#") wordPrimTy -primOpInfo Ctz32Op = mkMonadic (fsLit "ctz32#") wordPrimTy -primOpInfo Ctz64Op = mkGenPrimOp (fsLit "ctz64#") [] [word64PrimTy] (wordPrimTy) -primOpInfo CtzOp = mkMonadic (fsLit "ctz#") wordPrimTy -primOpInfo BSwap16Op = mkMonadic (fsLit "byteSwap16#") wordPrimTy -primOpInfo BSwap32Op = mkMonadic (fsLit "byteSwap32#") wordPrimTy -primOpInfo BSwap64Op = mkMonadic (fsLit "byteSwap64#") word64PrimTy -primOpInfo BSwapOp = mkMonadic (fsLit "byteSwap#") wordPrimTy -primOpInfo Narrow8IntOp = mkMonadic (fsLit "narrow8Int#") intPrimTy -primOpInfo Narrow16IntOp = mkMonadic (fsLit "narrow16Int#") intPrimTy -primOpInfo Narrow32IntOp = mkMonadic (fsLit "narrow32Int#") intPrimTy -primOpInfo Narrow8WordOp = mkMonadic (fsLit "narrow8Word#") wordPrimTy -primOpInfo Narrow16WordOp = mkMonadic (fsLit "narrow16Word#") wordPrimTy -primOpInfo Narrow32WordOp = mkMonadic (fsLit "narrow32Word#") wordPrimTy -primOpInfo DoubleGtOp = mkCompare (fsLit ">##") doublePrimTy -primOpInfo DoubleGeOp = mkCompare (fsLit ">=##") doublePrimTy -primOpInfo DoubleEqOp = mkCompare (fsLit "==##") doublePrimTy -primOpInfo DoubleNeOp = mkCompare (fsLit "/=##") doublePrimTy -primOpInfo DoubleLtOp = mkCompare (fsLit "<##") doublePrimTy -primOpInfo DoubleLeOp = mkCompare (fsLit "<=##") doublePrimTy -primOpInfo DoubleAddOp = mkDyadic (fsLit "+##") doublePrimTy -primOpInfo DoubleSubOp = mkDyadic (fsLit "-##") doublePrimTy -primOpInfo DoubleMulOp = mkDyadic (fsLit "*##") doublePrimTy -primOpInfo DoubleDivOp = mkDyadic (fsLit "/##") doublePrimTy -primOpInfo DoubleNegOp = mkMonadic (fsLit "negateDouble#") doublePrimTy -primOpInfo Double2IntOp = mkGenPrimOp (fsLit "double2Int#") [] [doublePrimTy] (intPrimTy) -primOpInfo Double2FloatOp = mkGenPrimOp (fsLit "double2Float#") [] [doublePrimTy] (floatPrimTy) -primOpInfo DoubleExpOp = mkMonadic (fsLit "expDouble#") doublePrimTy -primOpInfo DoubleLogOp = mkMonadic (fsLit "logDouble#") doublePrimTy -primOpInfo DoubleSqrtOp = mkMonadic (fsLit "sqrtDouble#") doublePrimTy -primOpInfo DoubleSinOp = mkMonadic (fsLit "sinDouble#") doublePrimTy -primOpInfo DoubleCosOp = mkMonadic (fsLit "cosDouble#") doublePrimTy -primOpInfo DoubleTanOp = mkMonadic (fsLit "tanDouble#") doublePrimTy -primOpInfo DoubleAsinOp = mkMonadic (fsLit "asinDouble#") doublePrimTy -primOpInfo DoubleAcosOp = mkMonadic (fsLit "acosDouble#") doublePrimTy -primOpInfo DoubleAtanOp = mkMonadic (fsLit "atanDouble#") doublePrimTy -primOpInfo DoubleSinhOp = mkMonadic (fsLit "sinhDouble#") doublePrimTy -primOpInfo DoubleCoshOp = mkMonadic (fsLit "coshDouble#") doublePrimTy -primOpInfo DoubleTanhOp = mkMonadic (fsLit "tanhDouble#") doublePrimTy -primOpInfo DoublePowerOp = mkDyadic (fsLit "**##") doublePrimTy -primOpInfo DoubleDecode_2IntOp = mkGenPrimOp (fsLit "decodeDouble_2Int#") [] [doublePrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, wordPrimTy, wordPrimTy, intPrimTy])) -primOpInfo DoubleDecode_Int64Op = mkGenPrimOp (fsLit "decodeDouble_Int64#") [] [doublePrimTy] ((mkTupleTy UnboxedTuple [int64PrimTy, intPrimTy])) -primOpInfo FloatGtOp = mkCompare (fsLit "gtFloat#") floatPrimTy -primOpInfo FloatGeOp = mkCompare (fsLit "geFloat#") floatPrimTy -primOpInfo FloatEqOp = mkCompare (fsLit "eqFloat#") floatPrimTy -primOpInfo FloatNeOp = mkCompare (fsLit "neFloat#") floatPrimTy -primOpInfo FloatLtOp = mkCompare (fsLit "ltFloat#") floatPrimTy -primOpInfo FloatLeOp = mkCompare (fsLit "leFloat#") floatPrimTy -primOpInfo FloatAddOp = mkDyadic (fsLit "plusFloat#") floatPrimTy -primOpInfo FloatSubOp = mkDyadic (fsLit "minusFloat#") floatPrimTy -primOpInfo FloatMulOp = mkDyadic (fsLit "timesFloat#") floatPrimTy -primOpInfo FloatDivOp = mkDyadic (fsLit "divideFloat#") floatPrimTy -primOpInfo FloatNegOp = mkMonadic (fsLit "negateFloat#") floatPrimTy -primOpInfo Float2IntOp = mkGenPrimOp (fsLit "float2Int#") [] [floatPrimTy] (intPrimTy) -primOpInfo FloatExpOp = mkMonadic (fsLit "expFloat#") floatPrimTy -primOpInfo FloatLogOp = mkMonadic (fsLit "logFloat#") floatPrimTy -primOpInfo FloatSqrtOp = mkMonadic (fsLit "sqrtFloat#") floatPrimTy -primOpInfo FloatSinOp = mkMonadic (fsLit "sinFloat#") floatPrimTy -primOpInfo FloatCosOp = mkMonadic (fsLit "cosFloat#") floatPrimTy -primOpInfo FloatTanOp = mkMonadic (fsLit "tanFloat#") floatPrimTy -primOpInfo FloatAsinOp = mkMonadic (fsLit "asinFloat#") floatPrimTy -primOpInfo FloatAcosOp = mkMonadic (fsLit "acosFloat#") floatPrimTy -primOpInfo FloatAtanOp = mkMonadic (fsLit "atanFloat#") floatPrimTy -primOpInfo FloatSinhOp = mkMonadic (fsLit "sinhFloat#") floatPrimTy -primOpInfo FloatCoshOp = mkMonadic (fsLit "coshFloat#") floatPrimTy -primOpInfo FloatTanhOp = mkMonadic (fsLit "tanhFloat#") floatPrimTy -primOpInfo FloatPowerOp = mkDyadic (fsLit "powerFloat#") floatPrimTy -primOpInfo Float2DoubleOp = mkGenPrimOp (fsLit "float2Double#") [] [floatPrimTy] (doublePrimTy) -primOpInfo FloatDecode_IntOp = mkGenPrimOp (fsLit "decodeFloat_Int#") [] [floatPrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy])) -primOpInfo NewArrayOp = mkGenPrimOp (fsLit "newArray#") [alphaTyVar, deltaTyVar] [intPrimTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy])) -primOpInfo SameMutableArrayOp = mkGenPrimOp (fsLit "sameMutableArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, mkMutableArrayPrimTy deltaTy alphaTy] (intPrimTy) -primOpInfo ReadArrayOp = mkGenPrimOp (fsLit "readArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo WriteArrayOp = mkGenPrimOp (fsLit "writeArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo SizeofArrayOp = mkGenPrimOp (fsLit "sizeofArray#") [alphaTyVar] [mkArrayPrimTy alphaTy] (intPrimTy) -primOpInfo SizeofMutableArrayOp = mkGenPrimOp (fsLit "sizeofMutableArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy] (intPrimTy) -primOpInfo IndexArrayOp = mkGenPrimOp (fsLit "indexArray#") [alphaTyVar] [mkArrayPrimTy alphaTy, intPrimTy] ((mkTupleTy UnboxedTuple [alphaTy])) -primOpInfo UnsafeFreezeArrayOp = mkGenPrimOp (fsLit "unsafeFreezeArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkArrayPrimTy alphaTy])) -primOpInfo UnsafeThawArrayOp = mkGenPrimOp (fsLit "unsafeThawArray#") [alphaTyVar, deltaTyVar] [mkArrayPrimTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy])) -primOpInfo CopyArrayOp = mkGenPrimOp (fsLit "copyArray#") [alphaTyVar, deltaTyVar] [mkArrayPrimTy alphaTy, intPrimTy, mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyMutableArrayOp = mkGenPrimOp (fsLit "copyMutableArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CloneArrayOp = mkGenPrimOp (fsLit "cloneArray#") [alphaTyVar] [mkArrayPrimTy alphaTy, intPrimTy, intPrimTy] (mkArrayPrimTy alphaTy) -primOpInfo CloneMutableArrayOp = mkGenPrimOp (fsLit "cloneMutableArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy])) -primOpInfo FreezeArrayOp = mkGenPrimOp (fsLit "freezeArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkArrayPrimTy alphaTy])) -primOpInfo ThawArrayOp = mkGenPrimOp (fsLit "thawArray#") [alphaTyVar, deltaTyVar] [mkArrayPrimTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy])) -primOpInfo CasArrayOp = mkGenPrimOp (fsLit "casArray#") [deltaTyVar, alphaTyVar] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) -primOpInfo NewSmallArrayOp = mkGenPrimOp (fsLit "newSmallArray#") [alphaTyVar, deltaTyVar] [intPrimTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkSmallMutableArrayPrimTy deltaTy alphaTy])) -primOpInfo SameSmallMutableArrayOp = mkGenPrimOp (fsLit "sameSmallMutableArray#") [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, mkSmallMutableArrayPrimTy deltaTy alphaTy] (intPrimTy) -primOpInfo ReadSmallArrayOp = mkGenPrimOp (fsLit "readSmallArray#") [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo WriteSmallArrayOp = mkGenPrimOp (fsLit "writeSmallArray#") [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo SizeofSmallArrayOp = mkGenPrimOp (fsLit "sizeofSmallArray#") [alphaTyVar] [mkSmallArrayPrimTy alphaTy] (intPrimTy) -primOpInfo SizeofSmallMutableArrayOp = mkGenPrimOp (fsLit "sizeofSmallMutableArray#") [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy] (intPrimTy) -primOpInfo IndexSmallArrayOp = mkGenPrimOp (fsLit "indexSmallArray#") [alphaTyVar] [mkSmallArrayPrimTy alphaTy, intPrimTy] ((mkTupleTy UnboxedTuple [alphaTy])) -primOpInfo UnsafeFreezeSmallArrayOp = mkGenPrimOp (fsLit "unsafeFreezeSmallArray#") [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkSmallArrayPrimTy alphaTy])) -primOpInfo UnsafeThawSmallArrayOp = mkGenPrimOp (fsLit "unsafeThawSmallArray#") [alphaTyVar, deltaTyVar] [mkSmallArrayPrimTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkSmallMutableArrayPrimTy deltaTy alphaTy])) -primOpInfo CopySmallArrayOp = mkGenPrimOp (fsLit "copySmallArray#") [alphaTyVar, deltaTyVar] [mkSmallArrayPrimTy alphaTy, intPrimTy, mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopySmallMutableArrayOp = mkGenPrimOp (fsLit "copySmallMutableArray#") [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CloneSmallArrayOp = mkGenPrimOp (fsLit "cloneSmallArray#") [alphaTyVar] [mkSmallArrayPrimTy alphaTy, intPrimTy, intPrimTy] (mkSmallArrayPrimTy alphaTy) -primOpInfo CloneSmallMutableArrayOp = mkGenPrimOp (fsLit "cloneSmallMutableArray#") [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkSmallMutableArrayPrimTy deltaTy alphaTy])) -primOpInfo FreezeSmallArrayOp = mkGenPrimOp (fsLit "freezeSmallArray#") [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkSmallArrayPrimTy alphaTy])) -primOpInfo ThawSmallArrayOp = mkGenPrimOp (fsLit "thawSmallArray#") [alphaTyVar, deltaTyVar] [mkSmallArrayPrimTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkSmallMutableArrayPrimTy deltaTy alphaTy])) -primOpInfo CasSmallArrayOp = mkGenPrimOp (fsLit "casSmallArray#") [deltaTyVar, alphaTyVar] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) -primOpInfo NewByteArrayOp_Char = mkGenPrimOp (fsLit "newByteArray#") [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy])) -primOpInfo NewPinnedByteArrayOp_Char = mkGenPrimOp (fsLit "newPinnedByteArray#") [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy])) -primOpInfo NewAlignedPinnedByteArrayOp_Char = mkGenPrimOp (fsLit "newAlignedPinnedByteArray#") [deltaTyVar] [intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy])) -primOpInfo ByteArrayContents_Char = mkGenPrimOp (fsLit "byteArrayContents#") [] [byteArrayPrimTy] (addrPrimTy) -primOpInfo SameMutableByteArrayOp = mkGenPrimOp (fsLit "sameMutableByteArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy] (intPrimTy) -primOpInfo ShrinkMutableByteArrayOp_Char = mkGenPrimOp (fsLit "shrinkMutableByteArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo ResizeMutableByteArrayOp_Char = mkGenPrimOp (fsLit "resizeMutableByteArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy])) -primOpInfo UnsafeFreezeByteArrayOp = mkGenPrimOp (fsLit "unsafeFreezeByteArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, byteArrayPrimTy])) -primOpInfo SizeofByteArrayOp = mkGenPrimOp (fsLit "sizeofByteArray#") [] [byteArrayPrimTy] (intPrimTy) -primOpInfo SizeofMutableByteArrayOp = mkGenPrimOp (fsLit "sizeofMutableByteArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy] (intPrimTy) -primOpInfo IndexByteArrayOp_Char = mkGenPrimOp (fsLit "indexCharArray#") [] [byteArrayPrimTy, intPrimTy] (charPrimTy) -primOpInfo IndexByteArrayOp_WideChar = mkGenPrimOp (fsLit "indexWideCharArray#") [] [byteArrayPrimTy, intPrimTy] (charPrimTy) -primOpInfo IndexByteArrayOp_Int = mkGenPrimOp (fsLit "indexIntArray#") [] [byteArrayPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexByteArrayOp_Word = mkGenPrimOp (fsLit "indexWordArray#") [] [byteArrayPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexByteArrayOp_Addr = mkGenPrimOp (fsLit "indexAddrArray#") [] [byteArrayPrimTy, intPrimTy] (addrPrimTy) -primOpInfo IndexByteArrayOp_Float = mkGenPrimOp (fsLit "indexFloatArray#") [] [byteArrayPrimTy, intPrimTy] (floatPrimTy) -primOpInfo IndexByteArrayOp_Double = mkGenPrimOp (fsLit "indexDoubleArray#") [] [byteArrayPrimTy, intPrimTy] (doublePrimTy) -primOpInfo IndexByteArrayOp_StablePtr = mkGenPrimOp (fsLit "indexStablePtrArray#") [alphaTyVar] [byteArrayPrimTy, intPrimTy] (mkStablePtrPrimTy alphaTy) -primOpInfo IndexByteArrayOp_Int8 = mkGenPrimOp (fsLit "indexInt8Array#") [] [byteArrayPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexByteArrayOp_Int16 = mkGenPrimOp (fsLit "indexInt16Array#") [] [byteArrayPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexByteArrayOp_Int32 = mkGenPrimOp (fsLit "indexInt32Array#") [] [byteArrayPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexByteArrayOp_Int64 = mkGenPrimOp (fsLit "indexInt64Array#") [] [byteArrayPrimTy, intPrimTy] (int64PrimTy) -primOpInfo IndexByteArrayOp_Word8 = mkGenPrimOp (fsLit "indexWord8Array#") [] [byteArrayPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexByteArrayOp_Word16 = mkGenPrimOp (fsLit "indexWord16Array#") [] [byteArrayPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexByteArrayOp_Word32 = mkGenPrimOp (fsLit "indexWord32Array#") [] [byteArrayPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexByteArrayOp_Word64 = mkGenPrimOp (fsLit "indexWord64Array#") [] [byteArrayPrimTy, intPrimTy] (word64PrimTy) -primOpInfo ReadByteArrayOp_Char = mkGenPrimOp (fsLit "readCharArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, charPrimTy])) -primOpInfo ReadByteArrayOp_WideChar = mkGenPrimOp (fsLit "readWideCharArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, charPrimTy])) -primOpInfo ReadByteArrayOp_Int = mkGenPrimOp (fsLit "readIntArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadByteArrayOp_Word = mkGenPrimOp (fsLit "readWordArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadByteArrayOp_Addr = mkGenPrimOp (fsLit "readAddrArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, addrPrimTy])) -primOpInfo ReadByteArrayOp_Float = mkGenPrimOp (fsLit "readFloatArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatPrimTy])) -primOpInfo ReadByteArrayOp_Double = mkGenPrimOp (fsLit "readDoubleArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doublePrimTy])) -primOpInfo ReadByteArrayOp_StablePtr = mkGenPrimOp (fsLit "readStablePtrArray#") [deltaTyVar, alphaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkStablePtrPrimTy alphaTy])) -primOpInfo ReadByteArrayOp_Int8 = mkGenPrimOp (fsLit "readInt8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadByteArrayOp_Int16 = mkGenPrimOp (fsLit "readInt16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadByteArrayOp_Int32 = mkGenPrimOp (fsLit "readInt32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadByteArrayOp_Int64 = mkGenPrimOp (fsLit "readInt64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64PrimTy])) -primOpInfo ReadByteArrayOp_Word8 = mkGenPrimOp (fsLit "readWord8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadByteArrayOp_Word16 = mkGenPrimOp (fsLit "readWord16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadByteArrayOp_Word32 = mkGenPrimOp (fsLit "readWord32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadByteArrayOp_Word64 = mkGenPrimOp (fsLit "readWord64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64PrimTy])) -primOpInfo WriteByteArrayOp_Char = mkGenPrimOp (fsLit "writeCharArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, charPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_WideChar = mkGenPrimOp (fsLit "writeWideCharArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, charPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Int = mkGenPrimOp (fsLit "writeIntArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Word = mkGenPrimOp (fsLit "writeWordArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Addr = mkGenPrimOp (fsLit "writeAddrArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, addrPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Float = mkGenPrimOp (fsLit "writeFloatArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Double = mkGenPrimOp (fsLit "writeDoubleArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doublePrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_StablePtr = mkGenPrimOp (fsLit "writeStablePtrArray#") [deltaTyVar, alphaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStablePtrPrimTy alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Int8 = mkGenPrimOp (fsLit "writeInt8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Int16 = mkGenPrimOp (fsLit "writeInt16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Int32 = mkGenPrimOp (fsLit "writeInt32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Int64 = mkGenPrimOp (fsLit "writeInt64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Word8 = mkGenPrimOp (fsLit "writeWord8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Word16 = mkGenPrimOp (fsLit "writeWord16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Word32 = mkGenPrimOp (fsLit "writeWord32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteByteArrayOp_Word64 = mkGenPrimOp (fsLit "writeWord64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyByteArrayOp = mkGenPrimOp (fsLit "copyByteArray#") [deltaTyVar] [byteArrayPrimTy, intPrimTy, mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyMutableByteArrayOp = mkGenPrimOp (fsLit "copyMutableByteArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyByteArrayToAddrOp = mkGenPrimOp (fsLit "copyByteArrayToAddr#") [deltaTyVar] [byteArrayPrimTy, intPrimTy, addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyMutableByteArrayToAddrOp = mkGenPrimOp (fsLit "copyMutableByteArrayToAddr#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyAddrToByteArrayOp = mkGenPrimOp (fsLit "copyAddrToByteArray#") [deltaTyVar] [addrPrimTy, mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo SetByteArrayOp = mkGenPrimOp (fsLit "setByteArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo AtomicReadByteArrayOp_Int = mkGenPrimOp (fsLit "atomicReadIntArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo AtomicWriteByteArrayOp_Int = mkGenPrimOp (fsLit "atomicWriteIntArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CasByteArrayOp_Int = mkGenPrimOp (fsLit "casIntArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo FetchAddByteArrayOp_Int = mkGenPrimOp (fsLit "fetchAddIntArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo FetchSubByteArrayOp_Int = mkGenPrimOp (fsLit "fetchSubIntArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo FetchAndByteArrayOp_Int = mkGenPrimOp (fsLit "fetchAndIntArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo FetchNandByteArrayOp_Int = mkGenPrimOp (fsLit "fetchNandIntArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo FetchOrByteArrayOp_Int = mkGenPrimOp (fsLit "fetchOrIntArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo FetchXorByteArrayOp_Int = mkGenPrimOp (fsLit "fetchXorIntArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo NewArrayArrayOp = mkGenPrimOp (fsLit "newArrayArray#") [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableArrayArrayPrimTy deltaTy])) -primOpInfo SameMutableArrayArrayOp = mkGenPrimOp (fsLit "sameMutableArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, mkMutableArrayArrayPrimTy deltaTy] (intPrimTy) -primOpInfo UnsafeFreezeArrayArrayOp = mkGenPrimOp (fsLit "unsafeFreezeArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkArrayArrayPrimTy])) -primOpInfo SizeofArrayArrayOp = mkGenPrimOp (fsLit "sizeofArrayArray#") [] [mkArrayArrayPrimTy] (intPrimTy) -primOpInfo SizeofMutableArrayArrayOp = mkGenPrimOp (fsLit "sizeofMutableArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy] (intPrimTy) -primOpInfo IndexArrayArrayOp_ByteArray = mkGenPrimOp (fsLit "indexByteArrayArray#") [] [mkArrayArrayPrimTy, intPrimTy] (byteArrayPrimTy) -primOpInfo IndexArrayArrayOp_ArrayArray = mkGenPrimOp (fsLit "indexArrayArrayArray#") [] [mkArrayArrayPrimTy, intPrimTy] (mkArrayArrayPrimTy) -primOpInfo ReadArrayArrayOp_ByteArray = mkGenPrimOp (fsLit "readByteArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, byteArrayPrimTy])) -primOpInfo ReadArrayArrayOp_MutableByteArray = mkGenPrimOp (fsLit "readMutableByteArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy])) -primOpInfo ReadArrayArrayOp_ArrayArray = mkGenPrimOp (fsLit "readArrayArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkArrayArrayPrimTy])) -primOpInfo ReadArrayArrayOp_MutableArrayArray = mkGenPrimOp (fsLit "readMutableArrayArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutableArrayArrayPrimTy deltaTy])) -primOpInfo WriteArrayArrayOp_ByteArray = mkGenPrimOp (fsLit "writeByteArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, byteArrayPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteArrayArrayOp_MutableByteArray = mkGenPrimOp (fsLit "writeMutableByteArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkMutableByteArrayPrimTy deltaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteArrayArrayOp_ArrayArray = mkGenPrimOp (fsLit "writeArrayArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkArrayArrayPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteArrayArrayOp_MutableArrayArray = mkGenPrimOp (fsLit "writeMutableArrayArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkMutableArrayArrayPrimTy deltaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyArrayArrayOp = mkGenPrimOp (fsLit "copyArrayArray#") [deltaTyVar] [mkArrayArrayPrimTy, intPrimTy, mkMutableArrayArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo CopyMutableArrayArrayOp = mkGenPrimOp (fsLit "copyMutableArrayArray#") [deltaTyVar] [mkMutableArrayArrayPrimTy deltaTy, intPrimTy, mkMutableArrayArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo AddrAddOp = mkGenPrimOp (fsLit "plusAddr#") [] [addrPrimTy, intPrimTy] (addrPrimTy) -primOpInfo AddrSubOp = mkGenPrimOp (fsLit "minusAddr#") [] [addrPrimTy, addrPrimTy] (intPrimTy) -primOpInfo AddrRemOp = mkGenPrimOp (fsLit "remAddr#") [] [addrPrimTy, intPrimTy] (intPrimTy) -primOpInfo Addr2IntOp = mkGenPrimOp (fsLit "addr2Int#") [] [addrPrimTy] (intPrimTy) -primOpInfo Int2AddrOp = mkGenPrimOp (fsLit "int2Addr#") [] [intPrimTy] (addrPrimTy) -primOpInfo AddrGtOp = mkCompare (fsLit "gtAddr#") addrPrimTy -primOpInfo AddrGeOp = mkCompare (fsLit "geAddr#") addrPrimTy -primOpInfo AddrEqOp = mkCompare (fsLit "eqAddr#") addrPrimTy -primOpInfo AddrNeOp = mkCompare (fsLit "neAddr#") addrPrimTy -primOpInfo AddrLtOp = mkCompare (fsLit "ltAddr#") addrPrimTy -primOpInfo AddrLeOp = mkCompare (fsLit "leAddr#") addrPrimTy -primOpInfo IndexOffAddrOp_Char = mkGenPrimOp (fsLit "indexCharOffAddr#") [] [addrPrimTy, intPrimTy] (charPrimTy) -primOpInfo IndexOffAddrOp_WideChar = mkGenPrimOp (fsLit "indexWideCharOffAddr#") [] [addrPrimTy, intPrimTy] (charPrimTy) -primOpInfo IndexOffAddrOp_Int = mkGenPrimOp (fsLit "indexIntOffAddr#") [] [addrPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexOffAddrOp_Word = mkGenPrimOp (fsLit "indexWordOffAddr#") [] [addrPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexOffAddrOp_Addr = mkGenPrimOp (fsLit "indexAddrOffAddr#") [] [addrPrimTy, intPrimTy] (addrPrimTy) -primOpInfo IndexOffAddrOp_Float = mkGenPrimOp (fsLit "indexFloatOffAddr#") [] [addrPrimTy, intPrimTy] (floatPrimTy) -primOpInfo IndexOffAddrOp_Double = mkGenPrimOp (fsLit "indexDoubleOffAddr#") [] [addrPrimTy, intPrimTy] (doublePrimTy) -primOpInfo IndexOffAddrOp_StablePtr = mkGenPrimOp (fsLit "indexStablePtrOffAddr#") [alphaTyVar] [addrPrimTy, intPrimTy] (mkStablePtrPrimTy alphaTy) -primOpInfo IndexOffAddrOp_Int8 = mkGenPrimOp (fsLit "indexInt8OffAddr#") [] [addrPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexOffAddrOp_Int16 = mkGenPrimOp (fsLit "indexInt16OffAddr#") [] [addrPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexOffAddrOp_Int32 = mkGenPrimOp (fsLit "indexInt32OffAddr#") [] [addrPrimTy, intPrimTy] (intPrimTy) -primOpInfo IndexOffAddrOp_Int64 = mkGenPrimOp (fsLit "indexInt64OffAddr#") [] [addrPrimTy, intPrimTy] (int64PrimTy) -primOpInfo IndexOffAddrOp_Word8 = mkGenPrimOp (fsLit "indexWord8OffAddr#") [] [addrPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexOffAddrOp_Word16 = mkGenPrimOp (fsLit "indexWord16OffAddr#") [] [addrPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexOffAddrOp_Word32 = mkGenPrimOp (fsLit "indexWord32OffAddr#") [] [addrPrimTy, intPrimTy] (wordPrimTy) -primOpInfo IndexOffAddrOp_Word64 = mkGenPrimOp (fsLit "indexWord64OffAddr#") [] [addrPrimTy, intPrimTy] (word64PrimTy) -primOpInfo ReadOffAddrOp_Char = mkGenPrimOp (fsLit "readCharOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, charPrimTy])) -primOpInfo ReadOffAddrOp_WideChar = mkGenPrimOp (fsLit "readWideCharOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, charPrimTy])) -primOpInfo ReadOffAddrOp_Int = mkGenPrimOp (fsLit "readIntOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadOffAddrOp_Word = mkGenPrimOp (fsLit "readWordOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadOffAddrOp_Addr = mkGenPrimOp (fsLit "readAddrOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, addrPrimTy])) -primOpInfo ReadOffAddrOp_Float = mkGenPrimOp (fsLit "readFloatOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatPrimTy])) -primOpInfo ReadOffAddrOp_Double = mkGenPrimOp (fsLit "readDoubleOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doublePrimTy])) -primOpInfo ReadOffAddrOp_StablePtr = mkGenPrimOp (fsLit "readStablePtrOffAddr#") [deltaTyVar, alphaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkStablePtrPrimTy alphaTy])) -primOpInfo ReadOffAddrOp_Int8 = mkGenPrimOp (fsLit "readInt8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadOffAddrOp_Int16 = mkGenPrimOp (fsLit "readInt16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadOffAddrOp_Int32 = mkGenPrimOp (fsLit "readInt32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadOffAddrOp_Int64 = mkGenPrimOp (fsLit "readInt64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64PrimTy])) -primOpInfo ReadOffAddrOp_Word8 = mkGenPrimOp (fsLit "readWord8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadOffAddrOp_Word16 = mkGenPrimOp (fsLit "readWord16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadOffAddrOp_Word32 = mkGenPrimOp (fsLit "readWord32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, wordPrimTy])) -primOpInfo ReadOffAddrOp_Word64 = mkGenPrimOp (fsLit "readWord64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64PrimTy])) -primOpInfo WriteOffAddrOp_Char = mkGenPrimOp (fsLit "writeCharOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, charPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_WideChar = mkGenPrimOp (fsLit "writeWideCharOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, charPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Int = mkGenPrimOp (fsLit "writeIntOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Word = mkGenPrimOp (fsLit "writeWordOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Addr = mkGenPrimOp (fsLit "writeAddrOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, addrPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Float = mkGenPrimOp (fsLit "writeFloatOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, floatPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Double = mkGenPrimOp (fsLit "writeDoubleOffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, doublePrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_StablePtr = mkGenPrimOp (fsLit "writeStablePtrOffAddr#") [alphaTyVar, deltaTyVar] [addrPrimTy, intPrimTy, mkStablePtrPrimTy alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Int8 = mkGenPrimOp (fsLit "writeInt8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Int16 = mkGenPrimOp (fsLit "writeInt16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Int32 = mkGenPrimOp (fsLit "writeInt32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Int64 = mkGenPrimOp (fsLit "writeInt64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Word8 = mkGenPrimOp (fsLit "writeWord8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Word16 = mkGenPrimOp (fsLit "writeWord16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Word32 = mkGenPrimOp (fsLit "writeWord32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, wordPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WriteOffAddrOp_Word64 = mkGenPrimOp (fsLit "writeWord64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo NewMutVarOp = mkGenPrimOp (fsLit "newMutVar#") [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMutVarPrimTy deltaTy alphaTy])) -primOpInfo ReadMutVarOp = mkGenPrimOp (fsLit "readMutVar#") [deltaTyVar, alphaTyVar] [mkMutVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo WriteMutVarOp = mkGenPrimOp (fsLit "writeMutVar#") [deltaTyVar, alphaTyVar] [mkMutVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo SameMutVarOp = mkGenPrimOp (fsLit "sameMutVar#") [deltaTyVar, alphaTyVar] [mkMutVarPrimTy deltaTy alphaTy, mkMutVarPrimTy deltaTy alphaTy] (intPrimTy) -primOpInfo AtomicModifyMutVarOp = mkGenPrimOp (fsLit "atomicModifyMutVar#") [deltaTyVar, alphaTyVar, betaTyVar, gammaTyVar] [mkMutVarPrimTy deltaTy alphaTy, (mkFunTy (alphaTy) (betaTy)), mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, gammaTy])) -primOpInfo CasMutVarOp = mkGenPrimOp (fsLit "casMutVar#") [deltaTyVar, alphaTyVar] [mkMutVarPrimTy deltaTy alphaTy, alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) -primOpInfo CatchOp = mkGenPrimOp (fsLit "catch#") [alphaTyVar, betaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), (mkFunTy (betaTy) ((mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo RaiseOp = mkGenPrimOp (fsLit "raise#") [alphaTyVar, betaTyVar] [alphaTy] (betaTy) -primOpInfo RaiseIOOp = mkGenPrimOp (fsLit "raiseIO#") [alphaTyVar, betaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, betaTy])) -primOpInfo MaskAsyncExceptionsOp = mkGenPrimOp (fsLit "maskAsyncExceptions#") [alphaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo MaskUninterruptibleOp = mkGenPrimOp (fsLit "maskUninterruptible#") [alphaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo UnmaskAsyncExceptionsOp = mkGenPrimOp (fsLit "unmaskAsyncExceptions#") [alphaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo MaskStatus = mkGenPrimOp (fsLit "getMaskingState#") [] [mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, intPrimTy])) -primOpInfo AtomicallyOp = mkGenPrimOp (fsLit "atomically#") [alphaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo RetryOp = mkGenPrimOp (fsLit "retry#") [alphaTyVar] [mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo CatchRetryOp = mkGenPrimOp (fsLit "catchRetry#") [alphaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), (mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo CatchSTMOp = mkGenPrimOp (fsLit "catchSTM#") [alphaTyVar, betaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), (mkFunTy (betaTy) ((mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo Check = mkGenPrimOp (fsLit "check#") [alphaTyVar] [(mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, unitTy])) -primOpInfo NewTVarOp = mkGenPrimOp (fsLit "newTVar#") [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkTVarPrimTy deltaTy alphaTy])) -primOpInfo ReadTVarOp = mkGenPrimOp (fsLit "readTVar#") [deltaTyVar, alphaTyVar] [mkTVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo ReadTVarIOOp = mkGenPrimOp (fsLit "readTVarIO#") [deltaTyVar, alphaTyVar] [mkTVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo WriteTVarOp = mkGenPrimOp (fsLit "writeTVar#") [deltaTyVar, alphaTyVar] [mkTVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo SameTVarOp = mkGenPrimOp (fsLit "sameTVar#") [deltaTyVar, alphaTyVar] [mkTVarPrimTy deltaTy alphaTy, mkTVarPrimTy deltaTy alphaTy] (intPrimTy) -primOpInfo NewMVarOp = mkGenPrimOp (fsLit "newMVar#") [deltaTyVar, alphaTyVar] [mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, mkMVarPrimTy deltaTy alphaTy])) -primOpInfo TakeMVarOp = mkGenPrimOp (fsLit "takeMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo TryTakeMVarOp = mkGenPrimOp (fsLit "tryTakeMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) -primOpInfo PutMVarOp = mkGenPrimOp (fsLit "putMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo TryPutMVarOp = mkGenPrimOp (fsLit "tryPutMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ReadMVarOp = mkGenPrimOp (fsLit "readMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo TryReadMVarOp = mkGenPrimOp (fsLit "tryReadMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) -primOpInfo SameMVarOp = mkGenPrimOp (fsLit "sameMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkMVarPrimTy deltaTy alphaTy] (intPrimTy) -primOpInfo IsEmptyMVarOp = mkGenPrimOp (fsLit "isEmptyMVar#") [deltaTyVar, alphaTyVar] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo DelayOp = mkGenPrimOp (fsLit "delay#") [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WaitReadOp = mkGenPrimOp (fsLit "waitRead#") [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo WaitWriteOp = mkGenPrimOp (fsLit "waitWrite#") [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo ForkOp = mkGenPrimOp (fsLit "fork#") [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, threadIdPrimTy])) -primOpInfo ForkOnOp = mkGenPrimOp (fsLit "forkOn#") [alphaTyVar] [intPrimTy, alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, threadIdPrimTy])) -primOpInfo KillThreadOp = mkGenPrimOp (fsLit "killThread#") [alphaTyVar] [threadIdPrimTy, alphaTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) -primOpInfo YieldOp = mkGenPrimOp (fsLit "yield#") [] [mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) -primOpInfo MyThreadIdOp = mkGenPrimOp (fsLit "myThreadId#") [] [mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, threadIdPrimTy])) -primOpInfo LabelThreadOp = mkGenPrimOp (fsLit "labelThread#") [] [threadIdPrimTy, addrPrimTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) -primOpInfo IsCurrentThreadBoundOp = mkGenPrimOp (fsLit "isCurrentThreadBound#") [] [mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, intPrimTy])) -primOpInfo NoDuplicateOp = mkGenPrimOp (fsLit "noDuplicate#") [] [mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) -primOpInfo ThreadStatusOp = mkGenPrimOp (fsLit "threadStatus#") [] [threadIdPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo MkWeakOp = mkGenPrimOp (fsLit "mkWeak#") [openAlphaTyVar, betaTyVar, gammaTyVar] [openAlphaTy, betaTy, gammaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy])) -primOpInfo MkWeakNoFinalizerOp = mkGenPrimOp (fsLit "mkWeakNoFinalizer#") [openAlphaTyVar, betaTyVar] [openAlphaTy, betaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy])) -primOpInfo AddCFinalizerToWeakOp = mkGenPrimOp (fsLit "addCFinalizerToWeak#") [betaTyVar] [addrPrimTy, addrPrimTy, intPrimTy, addrPrimTy, mkWeakPrimTy betaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, intPrimTy])) -primOpInfo DeRefWeakOp = mkGenPrimOp (fsLit "deRefWeak#") [alphaTyVar] [mkWeakPrimTy alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, intPrimTy, alphaTy])) -primOpInfo FinalizeWeakOp = mkGenPrimOp (fsLit "finalizeWeak#") [alphaTyVar] [mkWeakPrimTy alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, intPrimTy, (mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, unitTy])))])) -primOpInfo TouchOp = mkGenPrimOp (fsLit "touch#") [openAlphaTyVar] [openAlphaTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) -primOpInfo MakeStablePtrOp = mkGenPrimOp (fsLit "makeStablePtr#") [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, mkStablePtrPrimTy alphaTy])) -primOpInfo DeRefStablePtrOp = mkGenPrimOp (fsLit "deRefStablePtr#") [alphaTyVar] [mkStablePtrPrimTy alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, alphaTy])) -primOpInfo EqStablePtrOp = mkGenPrimOp (fsLit "eqStablePtr#") [alphaTyVar] [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy alphaTy] (intPrimTy) -primOpInfo MakeStableNameOp = mkGenPrimOp (fsLit "makeStableName#") [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy realWorldTy, mkStableNamePrimTy alphaTy])) -primOpInfo EqStableNameOp = mkGenPrimOp (fsLit "eqStableName#") [alphaTyVar, betaTyVar] [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy] (intPrimTy) -primOpInfo StableNameToIntOp = mkGenPrimOp (fsLit "stableNameToInt#") [alphaTyVar] [mkStableNamePrimTy alphaTy] (intPrimTy) -primOpInfo ReallyUnsafePtrEqualityOp = mkGenPrimOp (fsLit "reallyUnsafePtrEquality#") [alphaTyVar] [alphaTy, alphaTy] (intPrimTy) -primOpInfo ParOp = mkGenPrimOp (fsLit "par#") [alphaTyVar] [alphaTy] (intPrimTy) -primOpInfo SparkOp = mkGenPrimOp (fsLit "spark#") [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo SeqOp = mkGenPrimOp (fsLit "seq#") [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, alphaTy])) -primOpInfo GetSparkOp = mkGenPrimOp (fsLit "getSpark#") [deltaTyVar, alphaTyVar] [mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) -primOpInfo NumSparks = mkGenPrimOp (fsLit "numSparks#") [deltaTyVar] [mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo ParGlobalOp = mkGenPrimOp (fsLit "parGlobal#") [alphaTyVar, betaTyVar] [alphaTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, betaTy] (intPrimTy) -primOpInfo ParLocalOp = mkGenPrimOp (fsLit "parLocal#") [alphaTyVar, betaTyVar] [alphaTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, betaTy] (intPrimTy) -primOpInfo ParAtOp = mkGenPrimOp (fsLit "parAt#") [betaTyVar, alphaTyVar, gammaTyVar] [betaTy, alphaTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, gammaTy] (intPrimTy) -primOpInfo ParAtAbsOp = mkGenPrimOp (fsLit "parAtAbs#") [alphaTyVar, betaTyVar] [alphaTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, betaTy] (intPrimTy) -primOpInfo ParAtRelOp = mkGenPrimOp (fsLit "parAtRel#") [alphaTyVar, betaTyVar] [alphaTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, betaTy] (intPrimTy) -primOpInfo ParAtForNowOp = mkGenPrimOp (fsLit "parAtForNow#") [betaTyVar, alphaTyVar, gammaTyVar] [betaTy, alphaTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, gammaTy] (intPrimTy) -primOpInfo DataToTagOp = mkGenPrimOp (fsLit "dataToTag#") [alphaTyVar] [alphaTy] (intPrimTy) -primOpInfo TagToEnumOp = mkGenPrimOp (fsLit "tagToEnum#") [alphaTyVar] [intPrimTy] (alphaTy) -primOpInfo AddrToAnyOp = mkGenPrimOp (fsLit "addrToAny#") [alphaTyVar] [addrPrimTy] ((mkTupleTy UnboxedTuple [alphaTy])) -primOpInfo MkApUpd0_Op = mkGenPrimOp (fsLit "mkApUpd0#") [alphaTyVar] [bcoPrimTy] ((mkTupleTy UnboxedTuple [alphaTy])) -primOpInfo NewBCOOp = mkGenPrimOp (fsLit "newBCO#") [alphaTyVar, deltaTyVar] [byteArrayPrimTy, byteArrayPrimTy, mkArrayPrimTy alphaTy, intPrimTy, byteArrayPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, bcoPrimTy])) -primOpInfo UnpackClosureOp = mkGenPrimOp (fsLit "unpackClosure#") [alphaTyVar, betaTyVar] [alphaTy] ((mkTupleTy UnboxedTuple [addrPrimTy, mkArrayPrimTy betaTy, byteArrayPrimTy])) -primOpInfo GetApStackValOp = mkGenPrimOp (fsLit "getApStackVal#") [alphaTyVar, betaTyVar] [alphaTy, intPrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, betaTy])) -primOpInfo GetCCSOfOp = mkGenPrimOp (fsLit "getCCSOf#") [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, addrPrimTy])) -primOpInfo GetCurrentCCSOp = mkGenPrimOp (fsLit "getCurrentCCS#") [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, addrPrimTy])) -primOpInfo TraceEventOp = mkGenPrimOp (fsLit "traceEvent#") [deltaTyVar] [addrPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo TraceMarkerOp = mkGenPrimOp (fsLit "traceMarker#") [deltaTyVar] [addrPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecBroadcastOp IntVec 16 W8) = mkGenPrimOp (fsLit "broadcastInt8X16#") [] [intPrimTy] (int8X16PrimTy) -primOpInfo (VecBroadcastOp IntVec 8 W16) = mkGenPrimOp (fsLit "broadcastInt16X8#") [] [intPrimTy] (int16X8PrimTy) -primOpInfo (VecBroadcastOp IntVec 4 W32) = mkGenPrimOp (fsLit "broadcastInt32X4#") [] [intPrimTy] (int32X4PrimTy) -primOpInfo (VecBroadcastOp IntVec 2 W64) = mkGenPrimOp (fsLit "broadcastInt64X2#") [] [int64PrimTy] (int64X2PrimTy) -primOpInfo (VecBroadcastOp IntVec 32 W8) = mkGenPrimOp (fsLit "broadcastInt8X32#") [] [intPrimTy] (int8X32PrimTy) -primOpInfo (VecBroadcastOp IntVec 16 W16) = mkGenPrimOp (fsLit "broadcastInt16X16#") [] [intPrimTy] (int16X16PrimTy) -primOpInfo (VecBroadcastOp IntVec 8 W32) = mkGenPrimOp (fsLit "broadcastInt32X8#") [] [intPrimTy] (int32X8PrimTy) -primOpInfo (VecBroadcastOp IntVec 4 W64) = mkGenPrimOp (fsLit "broadcastInt64X4#") [] [int64PrimTy] (int64X4PrimTy) -primOpInfo (VecBroadcastOp IntVec 64 W8) = mkGenPrimOp (fsLit "broadcastInt8X64#") [] [intPrimTy] (int8X64PrimTy) -primOpInfo (VecBroadcastOp IntVec 32 W16) = mkGenPrimOp (fsLit "broadcastInt16X32#") [] [intPrimTy] (int16X32PrimTy) -primOpInfo (VecBroadcastOp IntVec 16 W32) = mkGenPrimOp (fsLit "broadcastInt32X16#") [] [intPrimTy] (int32X16PrimTy) -primOpInfo (VecBroadcastOp IntVec 8 W64) = mkGenPrimOp (fsLit "broadcastInt64X8#") [] [int64PrimTy] (int64X8PrimTy) -primOpInfo (VecBroadcastOp WordVec 16 W8) = mkGenPrimOp (fsLit "broadcastWord8X16#") [] [wordPrimTy] (word8X16PrimTy) -primOpInfo (VecBroadcastOp WordVec 8 W16) = mkGenPrimOp (fsLit "broadcastWord16X8#") [] [wordPrimTy] (word16X8PrimTy) -primOpInfo (VecBroadcastOp WordVec 4 W32) = mkGenPrimOp (fsLit "broadcastWord32X4#") [] [wordPrimTy] (word32X4PrimTy) -primOpInfo (VecBroadcastOp WordVec 2 W64) = mkGenPrimOp (fsLit "broadcastWord64X2#") [] [word64PrimTy] (word64X2PrimTy) -primOpInfo (VecBroadcastOp WordVec 32 W8) = mkGenPrimOp (fsLit "broadcastWord8X32#") [] [wordPrimTy] (word8X32PrimTy) -primOpInfo (VecBroadcastOp WordVec 16 W16) = mkGenPrimOp (fsLit "broadcastWord16X16#") [] [wordPrimTy] (word16X16PrimTy) -primOpInfo (VecBroadcastOp WordVec 8 W32) = mkGenPrimOp (fsLit "broadcastWord32X8#") [] [wordPrimTy] (word32X8PrimTy) -primOpInfo (VecBroadcastOp WordVec 4 W64) = mkGenPrimOp (fsLit "broadcastWord64X4#") [] [word64PrimTy] (word64X4PrimTy) -primOpInfo (VecBroadcastOp WordVec 64 W8) = mkGenPrimOp (fsLit "broadcastWord8X64#") [] [wordPrimTy] (word8X64PrimTy) -primOpInfo (VecBroadcastOp WordVec 32 W16) = mkGenPrimOp (fsLit "broadcastWord16X32#") [] [wordPrimTy] (word16X32PrimTy) -primOpInfo (VecBroadcastOp WordVec 16 W32) = mkGenPrimOp (fsLit "broadcastWord32X16#") [] [wordPrimTy] (word32X16PrimTy) -primOpInfo (VecBroadcastOp WordVec 8 W64) = mkGenPrimOp (fsLit "broadcastWord64X8#") [] [word64PrimTy] (word64X8PrimTy) -primOpInfo (VecBroadcastOp FloatVec 4 W32) = mkGenPrimOp (fsLit "broadcastFloatX4#") [] [floatPrimTy] (floatX4PrimTy) -primOpInfo (VecBroadcastOp FloatVec 2 W64) = mkGenPrimOp (fsLit "broadcastDoubleX2#") [] [doublePrimTy] (doubleX2PrimTy) -primOpInfo (VecBroadcastOp FloatVec 8 W32) = mkGenPrimOp (fsLit "broadcastFloatX8#") [] [floatPrimTy] (floatX8PrimTy) -primOpInfo (VecBroadcastOp FloatVec 4 W64) = mkGenPrimOp (fsLit "broadcastDoubleX4#") [] [doublePrimTy] (doubleX4PrimTy) -primOpInfo (VecBroadcastOp FloatVec 16 W32) = mkGenPrimOp (fsLit "broadcastFloatX16#") [] [floatPrimTy] (floatX16PrimTy) -primOpInfo (VecBroadcastOp FloatVec 8 W64) = mkGenPrimOp (fsLit "broadcastDoubleX8#") [] [doublePrimTy] (doubleX8PrimTy) -primOpInfo (VecPackOp IntVec 16 W8) = mkGenPrimOp (fsLit "packInt8X16#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int8X16PrimTy) -primOpInfo (VecPackOp IntVec 8 W16) = mkGenPrimOp (fsLit "packInt16X8#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int16X8PrimTy) -primOpInfo (VecPackOp IntVec 4 W32) = mkGenPrimOp (fsLit "packInt32X4#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int32X4PrimTy) -primOpInfo (VecPackOp IntVec 2 W64) = mkGenPrimOp (fsLit "packInt64X2#") [] [(mkTupleTy UnboxedTuple [int64PrimTy, int64PrimTy])] (int64X2PrimTy) -primOpInfo (VecPackOp IntVec 32 W8) = mkGenPrimOp (fsLit "packInt8X32#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int8X32PrimTy) -primOpInfo (VecPackOp IntVec 16 W16) = mkGenPrimOp (fsLit "packInt16X16#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int16X16PrimTy) -primOpInfo (VecPackOp IntVec 8 W32) = mkGenPrimOp (fsLit "packInt32X8#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int32X8PrimTy) -primOpInfo (VecPackOp IntVec 4 W64) = mkGenPrimOp (fsLit "packInt64X4#") [] [(mkTupleTy UnboxedTuple [int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy])] (int64X4PrimTy) -primOpInfo (VecPackOp IntVec 64 W8) = mkGenPrimOp (fsLit "packInt8X64#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int8X64PrimTy) -primOpInfo (VecPackOp IntVec 32 W16) = mkGenPrimOp (fsLit "packInt16X32#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int16X32PrimTy) -primOpInfo (VecPackOp IntVec 16 W32) = mkGenPrimOp (fsLit "packInt32X16#") [] [(mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])] (int32X16PrimTy) -primOpInfo (VecPackOp IntVec 8 W64) = mkGenPrimOp (fsLit "packInt64X8#") [] [(mkTupleTy UnboxedTuple [int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy])] (int64X8PrimTy) -primOpInfo (VecPackOp WordVec 16 W8) = mkGenPrimOp (fsLit "packWord8X16#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word8X16PrimTy) -primOpInfo (VecPackOp WordVec 8 W16) = mkGenPrimOp (fsLit "packWord16X8#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word16X8PrimTy) -primOpInfo (VecPackOp WordVec 4 W32) = mkGenPrimOp (fsLit "packWord32X4#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word32X4PrimTy) -primOpInfo (VecPackOp WordVec 2 W64) = mkGenPrimOp (fsLit "packWord64X2#") [] [(mkTupleTy UnboxedTuple [word64PrimTy, word64PrimTy])] (word64X2PrimTy) -primOpInfo (VecPackOp WordVec 32 W8) = mkGenPrimOp (fsLit "packWord8X32#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word8X32PrimTy) -primOpInfo (VecPackOp WordVec 16 W16) = mkGenPrimOp (fsLit "packWord16X16#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word16X16PrimTy) -primOpInfo (VecPackOp WordVec 8 W32) = mkGenPrimOp (fsLit "packWord32X8#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word32X8PrimTy) -primOpInfo (VecPackOp WordVec 4 W64) = mkGenPrimOp (fsLit "packWord64X4#") [] [(mkTupleTy UnboxedTuple [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy])] (word64X4PrimTy) -primOpInfo (VecPackOp WordVec 64 W8) = mkGenPrimOp (fsLit "packWord8X64#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word8X64PrimTy) -primOpInfo (VecPackOp WordVec 32 W16) = mkGenPrimOp (fsLit "packWord16X32#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word16X32PrimTy) -primOpInfo (VecPackOp WordVec 16 W32) = mkGenPrimOp (fsLit "packWord32X16#") [] [(mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word32X16PrimTy) -primOpInfo (VecPackOp WordVec 8 W64) = mkGenPrimOp (fsLit "packWord64X8#") [] [(mkTupleTy UnboxedTuple [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy])] (word64X8PrimTy) -primOpInfo (VecPackOp FloatVec 4 W32) = mkGenPrimOp (fsLit "packFloatX4#") [] [(mkTupleTy UnboxedTuple [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])] (floatX4PrimTy) -primOpInfo (VecPackOp FloatVec 2 W64) = mkGenPrimOp (fsLit "packDoubleX2#") [] [(mkTupleTy UnboxedTuple [doublePrimTy, doublePrimTy])] (doubleX2PrimTy) -primOpInfo (VecPackOp FloatVec 8 W32) = mkGenPrimOp (fsLit "packFloatX8#") [] [(mkTupleTy UnboxedTuple [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])] (floatX8PrimTy) -primOpInfo (VecPackOp FloatVec 4 W64) = mkGenPrimOp (fsLit "packDoubleX4#") [] [(mkTupleTy UnboxedTuple [doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy])] (doubleX4PrimTy) -primOpInfo (VecPackOp FloatVec 16 W32) = mkGenPrimOp (fsLit "packFloatX16#") [] [(mkTupleTy UnboxedTuple [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])] (floatX16PrimTy) -primOpInfo (VecPackOp FloatVec 8 W64) = mkGenPrimOp (fsLit "packDoubleX8#") [] [(mkTupleTy UnboxedTuple [doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy])] (doubleX8PrimTy) -primOpInfo (VecUnpackOp IntVec 16 W8) = mkGenPrimOp (fsLit "unpackInt8X16#") [] [int8X16PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 8 W16) = mkGenPrimOp (fsLit "unpackInt16X8#") [] [int16X8PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 4 W32) = mkGenPrimOp (fsLit "unpackInt32X4#") [] [int32X4PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 2 W64) = mkGenPrimOp (fsLit "unpackInt64X2#") [] [int64X2PrimTy] ((mkTupleTy UnboxedTuple [int64PrimTy, int64PrimTy])) -primOpInfo (VecUnpackOp IntVec 32 W8) = mkGenPrimOp (fsLit "unpackInt8X32#") [] [int8X32PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 16 W16) = mkGenPrimOp (fsLit "unpackInt16X16#") [] [int16X16PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 8 W32) = mkGenPrimOp (fsLit "unpackInt32X8#") [] [int32X8PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 4 W64) = mkGenPrimOp (fsLit "unpackInt64X4#") [] [int64X4PrimTy] ((mkTupleTy UnboxedTuple [int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy])) -primOpInfo (VecUnpackOp IntVec 64 W8) = mkGenPrimOp (fsLit "unpackInt8X64#") [] [int8X64PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 32 W16) = mkGenPrimOp (fsLit "unpackInt16X32#") [] [int16X32PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 16 W32) = mkGenPrimOp (fsLit "unpackInt32X16#") [] [int32X16PrimTy] ((mkTupleTy UnboxedTuple [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo (VecUnpackOp IntVec 8 W64) = mkGenPrimOp (fsLit "unpackInt64X8#") [] [int64X8PrimTy] ((mkTupleTy UnboxedTuple [int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy])) -primOpInfo (VecUnpackOp WordVec 16 W8) = mkGenPrimOp (fsLit "unpackWord8X16#") [] [word8X16PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 8 W16) = mkGenPrimOp (fsLit "unpackWord16X8#") [] [word16X8PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 4 W32) = mkGenPrimOp (fsLit "unpackWord32X4#") [] [word32X4PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 2 W64) = mkGenPrimOp (fsLit "unpackWord64X2#") [] [word64X2PrimTy] ((mkTupleTy UnboxedTuple [word64PrimTy, word64PrimTy])) -primOpInfo (VecUnpackOp WordVec 32 W8) = mkGenPrimOp (fsLit "unpackWord8X32#") [] [word8X32PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 16 W16) = mkGenPrimOp (fsLit "unpackWord16X16#") [] [word16X16PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 8 W32) = mkGenPrimOp (fsLit "unpackWord32X8#") [] [word32X8PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 4 W64) = mkGenPrimOp (fsLit "unpackWord64X4#") [] [word64X4PrimTy] ((mkTupleTy UnboxedTuple [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy])) -primOpInfo (VecUnpackOp WordVec 64 W8) = mkGenPrimOp (fsLit "unpackWord8X64#") [] [word8X64PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 32 W16) = mkGenPrimOp (fsLit "unpackWord16X32#") [] [word16X32PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 16 W32) = mkGenPrimOp (fsLit "unpackWord32X16#") [] [word32X16PrimTy] ((mkTupleTy UnboxedTuple [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 8 W64) = mkGenPrimOp (fsLit "unpackWord64X8#") [] [word64X8PrimTy] ((mkTupleTy UnboxedTuple [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy])) -primOpInfo (VecUnpackOp FloatVec 4 W32) = mkGenPrimOp (fsLit "unpackFloatX4#") [] [floatX4PrimTy] ((mkTupleTy UnboxedTuple [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])) -primOpInfo (VecUnpackOp FloatVec 2 W64) = mkGenPrimOp (fsLit "unpackDoubleX2#") [] [doubleX2PrimTy] ((mkTupleTy UnboxedTuple [doublePrimTy, doublePrimTy])) -primOpInfo (VecUnpackOp FloatVec 8 W32) = mkGenPrimOp (fsLit "unpackFloatX8#") [] [floatX8PrimTy] ((mkTupleTy UnboxedTuple [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])) -primOpInfo (VecUnpackOp FloatVec 4 W64) = mkGenPrimOp (fsLit "unpackDoubleX4#") [] [doubleX4PrimTy] ((mkTupleTy UnboxedTuple [doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy])) -primOpInfo (VecUnpackOp FloatVec 16 W32) = mkGenPrimOp (fsLit "unpackFloatX16#") [] [floatX16PrimTy] ((mkTupleTy UnboxedTuple [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])) -primOpInfo (VecUnpackOp FloatVec 8 W64) = mkGenPrimOp (fsLit "unpackDoubleX8#") [] [doubleX8PrimTy] ((mkTupleTy UnboxedTuple [doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy, doublePrimTy])) -primOpInfo (VecInsertOp IntVec 16 W8) = mkGenPrimOp (fsLit "insertInt8X16#") [] [int8X16PrimTy, intPrimTy, intPrimTy] (int8X16PrimTy) -primOpInfo (VecInsertOp IntVec 8 W16) = mkGenPrimOp (fsLit "insertInt16X8#") [] [int16X8PrimTy, intPrimTy, intPrimTy] (int16X8PrimTy) -primOpInfo (VecInsertOp IntVec 4 W32) = mkGenPrimOp (fsLit "insertInt32X4#") [] [int32X4PrimTy, intPrimTy, intPrimTy] (int32X4PrimTy) -primOpInfo (VecInsertOp IntVec 2 W64) = mkGenPrimOp (fsLit "insertInt64X2#") [] [int64X2PrimTy, int64PrimTy, intPrimTy] (int64X2PrimTy) -primOpInfo (VecInsertOp IntVec 32 W8) = mkGenPrimOp (fsLit "insertInt8X32#") [] [int8X32PrimTy, intPrimTy, intPrimTy] (int8X32PrimTy) -primOpInfo (VecInsertOp IntVec 16 W16) = mkGenPrimOp (fsLit "insertInt16X16#") [] [int16X16PrimTy, intPrimTy, intPrimTy] (int16X16PrimTy) -primOpInfo (VecInsertOp IntVec 8 W32) = mkGenPrimOp (fsLit "insertInt32X8#") [] [int32X8PrimTy, intPrimTy, intPrimTy] (int32X8PrimTy) -primOpInfo (VecInsertOp IntVec 4 W64) = mkGenPrimOp (fsLit "insertInt64X4#") [] [int64X4PrimTy, int64PrimTy, intPrimTy] (int64X4PrimTy) -primOpInfo (VecInsertOp IntVec 64 W8) = mkGenPrimOp (fsLit "insertInt8X64#") [] [int8X64PrimTy, intPrimTy, intPrimTy] (int8X64PrimTy) -primOpInfo (VecInsertOp IntVec 32 W16) = mkGenPrimOp (fsLit "insertInt16X32#") [] [int16X32PrimTy, intPrimTy, intPrimTy] (int16X32PrimTy) -primOpInfo (VecInsertOp IntVec 16 W32) = mkGenPrimOp (fsLit "insertInt32X16#") [] [int32X16PrimTy, intPrimTy, intPrimTy] (int32X16PrimTy) -primOpInfo (VecInsertOp IntVec 8 W64) = mkGenPrimOp (fsLit "insertInt64X8#") [] [int64X8PrimTy, int64PrimTy, intPrimTy] (int64X8PrimTy) -primOpInfo (VecInsertOp WordVec 16 W8) = mkGenPrimOp (fsLit "insertWord8X16#") [] [word8X16PrimTy, wordPrimTy, intPrimTy] (word8X16PrimTy) -primOpInfo (VecInsertOp WordVec 8 W16) = mkGenPrimOp (fsLit "insertWord16X8#") [] [word16X8PrimTy, wordPrimTy, intPrimTy] (word16X8PrimTy) -primOpInfo (VecInsertOp WordVec 4 W32) = mkGenPrimOp (fsLit "insertWord32X4#") [] [word32X4PrimTy, wordPrimTy, intPrimTy] (word32X4PrimTy) -primOpInfo (VecInsertOp WordVec 2 W64) = mkGenPrimOp (fsLit "insertWord64X2#") [] [word64X2PrimTy, word64PrimTy, intPrimTy] (word64X2PrimTy) -primOpInfo (VecInsertOp WordVec 32 W8) = mkGenPrimOp (fsLit "insertWord8X32#") [] [word8X32PrimTy, wordPrimTy, intPrimTy] (word8X32PrimTy) -primOpInfo (VecInsertOp WordVec 16 W16) = mkGenPrimOp (fsLit "insertWord16X16#") [] [word16X16PrimTy, wordPrimTy, intPrimTy] (word16X16PrimTy) -primOpInfo (VecInsertOp WordVec 8 W32) = mkGenPrimOp (fsLit "insertWord32X8#") [] [word32X8PrimTy, wordPrimTy, intPrimTy] (word32X8PrimTy) -primOpInfo (VecInsertOp WordVec 4 W64) = mkGenPrimOp (fsLit "insertWord64X4#") [] [word64X4PrimTy, word64PrimTy, intPrimTy] (word64X4PrimTy) -primOpInfo (VecInsertOp WordVec 64 W8) = mkGenPrimOp (fsLit "insertWord8X64#") [] [word8X64PrimTy, wordPrimTy, intPrimTy] (word8X64PrimTy) -primOpInfo (VecInsertOp WordVec 32 W16) = mkGenPrimOp (fsLit "insertWord16X32#") [] [word16X32PrimTy, wordPrimTy, intPrimTy] (word16X32PrimTy) -primOpInfo (VecInsertOp WordVec 16 W32) = mkGenPrimOp (fsLit "insertWord32X16#") [] [word32X16PrimTy, wordPrimTy, intPrimTy] (word32X16PrimTy) -primOpInfo (VecInsertOp WordVec 8 W64) = mkGenPrimOp (fsLit "insertWord64X8#") [] [word64X8PrimTy, word64PrimTy, intPrimTy] (word64X8PrimTy) -primOpInfo (VecInsertOp FloatVec 4 W32) = mkGenPrimOp (fsLit "insertFloatX4#") [] [floatX4PrimTy, floatPrimTy, intPrimTy] (floatX4PrimTy) -primOpInfo (VecInsertOp FloatVec 2 W64) = mkGenPrimOp (fsLit "insertDoubleX2#") [] [doubleX2PrimTy, doublePrimTy, intPrimTy] (doubleX2PrimTy) -primOpInfo (VecInsertOp FloatVec 8 W32) = mkGenPrimOp (fsLit "insertFloatX8#") [] [floatX8PrimTy, floatPrimTy, intPrimTy] (floatX8PrimTy) -primOpInfo (VecInsertOp FloatVec 4 W64) = mkGenPrimOp (fsLit "insertDoubleX4#") [] [doubleX4PrimTy, doublePrimTy, intPrimTy] (doubleX4PrimTy) -primOpInfo (VecInsertOp FloatVec 16 W32) = mkGenPrimOp (fsLit "insertFloatX16#") [] [floatX16PrimTy, floatPrimTy, intPrimTy] (floatX16PrimTy) -primOpInfo (VecInsertOp FloatVec 8 W64) = mkGenPrimOp (fsLit "insertDoubleX8#") [] [doubleX8PrimTy, doublePrimTy, intPrimTy] (doubleX8PrimTy) -primOpInfo (VecAddOp IntVec 16 W8) = mkDyadic (fsLit "plusInt8X16#") int8X16PrimTy -primOpInfo (VecAddOp IntVec 8 W16) = mkDyadic (fsLit "plusInt16X8#") int16X8PrimTy -primOpInfo (VecAddOp IntVec 4 W32) = mkDyadic (fsLit "plusInt32X4#") int32X4PrimTy -primOpInfo (VecAddOp IntVec 2 W64) = mkDyadic (fsLit "plusInt64X2#") int64X2PrimTy -primOpInfo (VecAddOp IntVec 32 W8) = mkDyadic (fsLit "plusInt8X32#") int8X32PrimTy -primOpInfo (VecAddOp IntVec 16 W16) = mkDyadic (fsLit "plusInt16X16#") int16X16PrimTy -primOpInfo (VecAddOp IntVec 8 W32) = mkDyadic (fsLit "plusInt32X8#") int32X8PrimTy -primOpInfo (VecAddOp IntVec 4 W64) = mkDyadic (fsLit "plusInt64X4#") int64X4PrimTy -primOpInfo (VecAddOp IntVec 64 W8) = mkDyadic (fsLit "plusInt8X64#") int8X64PrimTy -primOpInfo (VecAddOp IntVec 32 W16) = mkDyadic (fsLit "plusInt16X32#") int16X32PrimTy -primOpInfo (VecAddOp IntVec 16 W32) = mkDyadic (fsLit "plusInt32X16#") int32X16PrimTy -primOpInfo (VecAddOp IntVec 8 W64) = mkDyadic (fsLit "plusInt64X8#") int64X8PrimTy -primOpInfo (VecAddOp WordVec 16 W8) = mkDyadic (fsLit "plusWord8X16#") word8X16PrimTy -primOpInfo (VecAddOp WordVec 8 W16) = mkDyadic (fsLit "plusWord16X8#") word16X8PrimTy -primOpInfo (VecAddOp WordVec 4 W32) = mkDyadic (fsLit "plusWord32X4#") word32X4PrimTy -primOpInfo (VecAddOp WordVec 2 W64) = mkDyadic (fsLit "plusWord64X2#") word64X2PrimTy -primOpInfo (VecAddOp WordVec 32 W8) = mkDyadic (fsLit "plusWord8X32#") word8X32PrimTy -primOpInfo (VecAddOp WordVec 16 W16) = mkDyadic (fsLit "plusWord16X16#") word16X16PrimTy -primOpInfo (VecAddOp WordVec 8 W32) = mkDyadic (fsLit "plusWord32X8#") word32X8PrimTy -primOpInfo (VecAddOp WordVec 4 W64) = mkDyadic (fsLit "plusWord64X4#") word64X4PrimTy -primOpInfo (VecAddOp WordVec 64 W8) = mkDyadic (fsLit "plusWord8X64#") word8X64PrimTy -primOpInfo (VecAddOp WordVec 32 W16) = mkDyadic (fsLit "plusWord16X32#") word16X32PrimTy -primOpInfo (VecAddOp WordVec 16 W32) = mkDyadic (fsLit "plusWord32X16#") word32X16PrimTy -primOpInfo (VecAddOp WordVec 8 W64) = mkDyadic (fsLit "plusWord64X8#") word64X8PrimTy -primOpInfo (VecAddOp FloatVec 4 W32) = mkDyadic (fsLit "plusFloatX4#") floatX4PrimTy -primOpInfo (VecAddOp FloatVec 2 W64) = mkDyadic (fsLit "plusDoubleX2#") doubleX2PrimTy -primOpInfo (VecAddOp FloatVec 8 W32) = mkDyadic (fsLit "plusFloatX8#") floatX8PrimTy -primOpInfo (VecAddOp FloatVec 4 W64) = mkDyadic (fsLit "plusDoubleX4#") doubleX4PrimTy -primOpInfo (VecAddOp FloatVec 16 W32) = mkDyadic (fsLit "plusFloatX16#") floatX16PrimTy -primOpInfo (VecAddOp FloatVec 8 W64) = mkDyadic (fsLit "plusDoubleX8#") doubleX8PrimTy -primOpInfo (VecSubOp IntVec 16 W8) = mkDyadic (fsLit "minusInt8X16#") int8X16PrimTy -primOpInfo (VecSubOp IntVec 8 W16) = mkDyadic (fsLit "minusInt16X8#") int16X8PrimTy -primOpInfo (VecSubOp IntVec 4 W32) = mkDyadic (fsLit "minusInt32X4#") int32X4PrimTy -primOpInfo (VecSubOp IntVec 2 W64) = mkDyadic (fsLit "minusInt64X2#") int64X2PrimTy -primOpInfo (VecSubOp IntVec 32 W8) = mkDyadic (fsLit "minusInt8X32#") int8X32PrimTy -primOpInfo (VecSubOp IntVec 16 W16) = mkDyadic (fsLit "minusInt16X16#") int16X16PrimTy -primOpInfo (VecSubOp IntVec 8 W32) = mkDyadic (fsLit "minusInt32X8#") int32X8PrimTy -primOpInfo (VecSubOp IntVec 4 W64) = mkDyadic (fsLit "minusInt64X4#") int64X4PrimTy -primOpInfo (VecSubOp IntVec 64 W8) = mkDyadic (fsLit "minusInt8X64#") int8X64PrimTy -primOpInfo (VecSubOp IntVec 32 W16) = mkDyadic (fsLit "minusInt16X32#") int16X32PrimTy -primOpInfo (VecSubOp IntVec 16 W32) = mkDyadic (fsLit "minusInt32X16#") int32X16PrimTy -primOpInfo (VecSubOp IntVec 8 W64) = mkDyadic (fsLit "minusInt64X8#") int64X8PrimTy -primOpInfo (VecSubOp WordVec 16 W8) = mkDyadic (fsLit "minusWord8X16#") word8X16PrimTy -primOpInfo (VecSubOp WordVec 8 W16) = mkDyadic (fsLit "minusWord16X8#") word16X8PrimTy -primOpInfo (VecSubOp WordVec 4 W32) = mkDyadic (fsLit "minusWord32X4#") word32X4PrimTy -primOpInfo (VecSubOp WordVec 2 W64) = mkDyadic (fsLit "minusWord64X2#") word64X2PrimTy -primOpInfo (VecSubOp WordVec 32 W8) = mkDyadic (fsLit "minusWord8X32#") word8X32PrimTy -primOpInfo (VecSubOp WordVec 16 W16) = mkDyadic (fsLit "minusWord16X16#") word16X16PrimTy -primOpInfo (VecSubOp WordVec 8 W32) = mkDyadic (fsLit "minusWord32X8#") word32X8PrimTy -primOpInfo (VecSubOp WordVec 4 W64) = mkDyadic (fsLit "minusWord64X4#") word64X4PrimTy -primOpInfo (VecSubOp WordVec 64 W8) = mkDyadic (fsLit "minusWord8X64#") word8X64PrimTy -primOpInfo (VecSubOp WordVec 32 W16) = mkDyadic (fsLit "minusWord16X32#") word16X32PrimTy -primOpInfo (VecSubOp WordVec 16 W32) = mkDyadic (fsLit "minusWord32X16#") word32X16PrimTy -primOpInfo (VecSubOp WordVec 8 W64) = mkDyadic (fsLit "minusWord64X8#") word64X8PrimTy -primOpInfo (VecSubOp FloatVec 4 W32) = mkDyadic (fsLit "minusFloatX4#") floatX4PrimTy -primOpInfo (VecSubOp FloatVec 2 W64) = mkDyadic (fsLit "minusDoubleX2#") doubleX2PrimTy -primOpInfo (VecSubOp FloatVec 8 W32) = mkDyadic (fsLit "minusFloatX8#") floatX8PrimTy -primOpInfo (VecSubOp FloatVec 4 W64) = mkDyadic (fsLit "minusDoubleX4#") doubleX4PrimTy -primOpInfo (VecSubOp FloatVec 16 W32) = mkDyadic (fsLit "minusFloatX16#") floatX16PrimTy -primOpInfo (VecSubOp FloatVec 8 W64) = mkDyadic (fsLit "minusDoubleX8#") doubleX8PrimTy -primOpInfo (VecMulOp IntVec 16 W8) = mkDyadic (fsLit "timesInt8X16#") int8X16PrimTy -primOpInfo (VecMulOp IntVec 8 W16) = mkDyadic (fsLit "timesInt16X8#") int16X8PrimTy -primOpInfo (VecMulOp IntVec 4 W32) = mkDyadic (fsLit "timesInt32X4#") int32X4PrimTy -primOpInfo (VecMulOp IntVec 2 W64) = mkDyadic (fsLit "timesInt64X2#") int64X2PrimTy -primOpInfo (VecMulOp IntVec 32 W8) = mkDyadic (fsLit "timesInt8X32#") int8X32PrimTy -primOpInfo (VecMulOp IntVec 16 W16) = mkDyadic (fsLit "timesInt16X16#") int16X16PrimTy -primOpInfo (VecMulOp IntVec 8 W32) = mkDyadic (fsLit "timesInt32X8#") int32X8PrimTy -primOpInfo (VecMulOp IntVec 4 W64) = mkDyadic (fsLit "timesInt64X4#") int64X4PrimTy -primOpInfo (VecMulOp IntVec 64 W8) = mkDyadic (fsLit "timesInt8X64#") int8X64PrimTy -primOpInfo (VecMulOp IntVec 32 W16) = mkDyadic (fsLit "timesInt16X32#") int16X32PrimTy -primOpInfo (VecMulOp IntVec 16 W32) = mkDyadic (fsLit "timesInt32X16#") int32X16PrimTy -primOpInfo (VecMulOp IntVec 8 W64) = mkDyadic (fsLit "timesInt64X8#") int64X8PrimTy -primOpInfo (VecMulOp WordVec 16 W8) = mkDyadic (fsLit "timesWord8X16#") word8X16PrimTy -primOpInfo (VecMulOp WordVec 8 W16) = mkDyadic (fsLit "timesWord16X8#") word16X8PrimTy -primOpInfo (VecMulOp WordVec 4 W32) = mkDyadic (fsLit "timesWord32X4#") word32X4PrimTy -primOpInfo (VecMulOp WordVec 2 W64) = mkDyadic (fsLit "timesWord64X2#") word64X2PrimTy -primOpInfo (VecMulOp WordVec 32 W8) = mkDyadic (fsLit "timesWord8X32#") word8X32PrimTy -primOpInfo (VecMulOp WordVec 16 W16) = mkDyadic (fsLit "timesWord16X16#") word16X16PrimTy -primOpInfo (VecMulOp WordVec 8 W32) = mkDyadic (fsLit "timesWord32X8#") word32X8PrimTy -primOpInfo (VecMulOp WordVec 4 W64) = mkDyadic (fsLit "timesWord64X4#") word64X4PrimTy -primOpInfo (VecMulOp WordVec 64 W8) = mkDyadic (fsLit "timesWord8X64#") word8X64PrimTy -primOpInfo (VecMulOp WordVec 32 W16) = mkDyadic (fsLit "timesWord16X32#") word16X32PrimTy -primOpInfo (VecMulOp WordVec 16 W32) = mkDyadic (fsLit "timesWord32X16#") word32X16PrimTy -primOpInfo (VecMulOp WordVec 8 W64) = mkDyadic (fsLit "timesWord64X8#") word64X8PrimTy -primOpInfo (VecMulOp FloatVec 4 W32) = mkDyadic (fsLit "timesFloatX4#") floatX4PrimTy -primOpInfo (VecMulOp FloatVec 2 W64) = mkDyadic (fsLit "timesDoubleX2#") doubleX2PrimTy -primOpInfo (VecMulOp FloatVec 8 W32) = mkDyadic (fsLit "timesFloatX8#") floatX8PrimTy -primOpInfo (VecMulOp FloatVec 4 W64) = mkDyadic (fsLit "timesDoubleX4#") doubleX4PrimTy -primOpInfo (VecMulOp FloatVec 16 W32) = mkDyadic (fsLit "timesFloatX16#") floatX16PrimTy -primOpInfo (VecMulOp FloatVec 8 W64) = mkDyadic (fsLit "timesDoubleX8#") doubleX8PrimTy -primOpInfo (VecDivOp FloatVec 4 W32) = mkDyadic (fsLit "divideFloatX4#") floatX4PrimTy -primOpInfo (VecDivOp FloatVec 2 W64) = mkDyadic (fsLit "divideDoubleX2#") doubleX2PrimTy -primOpInfo (VecDivOp FloatVec 8 W32) = mkDyadic (fsLit "divideFloatX8#") floatX8PrimTy -primOpInfo (VecDivOp FloatVec 4 W64) = mkDyadic (fsLit "divideDoubleX4#") doubleX4PrimTy -primOpInfo (VecDivOp FloatVec 16 W32) = mkDyadic (fsLit "divideFloatX16#") floatX16PrimTy -primOpInfo (VecDivOp FloatVec 8 W64) = mkDyadic (fsLit "divideDoubleX8#") doubleX8PrimTy -primOpInfo (VecQuotOp IntVec 16 W8) = mkDyadic (fsLit "quotInt8X16#") int8X16PrimTy -primOpInfo (VecQuotOp IntVec 8 W16) = mkDyadic (fsLit "quotInt16X8#") int16X8PrimTy -primOpInfo (VecQuotOp IntVec 4 W32) = mkDyadic (fsLit "quotInt32X4#") int32X4PrimTy -primOpInfo (VecQuotOp IntVec 2 W64) = mkDyadic (fsLit "quotInt64X2#") int64X2PrimTy -primOpInfo (VecQuotOp IntVec 32 W8) = mkDyadic (fsLit "quotInt8X32#") int8X32PrimTy -primOpInfo (VecQuotOp IntVec 16 W16) = mkDyadic (fsLit "quotInt16X16#") int16X16PrimTy -primOpInfo (VecQuotOp IntVec 8 W32) = mkDyadic (fsLit "quotInt32X8#") int32X8PrimTy -primOpInfo (VecQuotOp IntVec 4 W64) = mkDyadic (fsLit "quotInt64X4#") int64X4PrimTy -primOpInfo (VecQuotOp IntVec 64 W8) = mkDyadic (fsLit "quotInt8X64#") int8X64PrimTy -primOpInfo (VecQuotOp IntVec 32 W16) = mkDyadic (fsLit "quotInt16X32#") int16X32PrimTy -primOpInfo (VecQuotOp IntVec 16 W32) = mkDyadic (fsLit "quotInt32X16#") int32X16PrimTy -primOpInfo (VecQuotOp IntVec 8 W64) = mkDyadic (fsLit "quotInt64X8#") int64X8PrimTy -primOpInfo (VecQuotOp WordVec 16 W8) = mkDyadic (fsLit "quotWord8X16#") word8X16PrimTy -primOpInfo (VecQuotOp WordVec 8 W16) = mkDyadic (fsLit "quotWord16X8#") word16X8PrimTy -primOpInfo (VecQuotOp WordVec 4 W32) = mkDyadic (fsLit "quotWord32X4#") word32X4PrimTy -primOpInfo (VecQuotOp WordVec 2 W64) = mkDyadic (fsLit "quotWord64X2#") word64X2PrimTy -primOpInfo (VecQuotOp WordVec 32 W8) = mkDyadic (fsLit "quotWord8X32#") word8X32PrimTy -primOpInfo (VecQuotOp WordVec 16 W16) = mkDyadic (fsLit "quotWord16X16#") word16X16PrimTy -primOpInfo (VecQuotOp WordVec 8 W32) = mkDyadic (fsLit "quotWord32X8#") word32X8PrimTy -primOpInfo (VecQuotOp WordVec 4 W64) = mkDyadic (fsLit "quotWord64X4#") word64X4PrimTy -primOpInfo (VecQuotOp WordVec 64 W8) = mkDyadic (fsLit "quotWord8X64#") word8X64PrimTy -primOpInfo (VecQuotOp WordVec 32 W16) = mkDyadic (fsLit "quotWord16X32#") word16X32PrimTy -primOpInfo (VecQuotOp WordVec 16 W32) = mkDyadic (fsLit "quotWord32X16#") word32X16PrimTy -primOpInfo (VecQuotOp WordVec 8 W64) = mkDyadic (fsLit "quotWord64X8#") word64X8PrimTy -primOpInfo (VecRemOp IntVec 16 W8) = mkDyadic (fsLit "remInt8X16#") int8X16PrimTy -primOpInfo (VecRemOp IntVec 8 W16) = mkDyadic (fsLit "remInt16X8#") int16X8PrimTy -primOpInfo (VecRemOp IntVec 4 W32) = mkDyadic (fsLit "remInt32X4#") int32X4PrimTy -primOpInfo (VecRemOp IntVec 2 W64) = mkDyadic (fsLit "remInt64X2#") int64X2PrimTy -primOpInfo (VecRemOp IntVec 32 W8) = mkDyadic (fsLit "remInt8X32#") int8X32PrimTy -primOpInfo (VecRemOp IntVec 16 W16) = mkDyadic (fsLit "remInt16X16#") int16X16PrimTy -primOpInfo (VecRemOp IntVec 8 W32) = mkDyadic (fsLit "remInt32X8#") int32X8PrimTy -primOpInfo (VecRemOp IntVec 4 W64) = mkDyadic (fsLit "remInt64X4#") int64X4PrimTy -primOpInfo (VecRemOp IntVec 64 W8) = mkDyadic (fsLit "remInt8X64#") int8X64PrimTy -primOpInfo (VecRemOp IntVec 32 W16) = mkDyadic (fsLit "remInt16X32#") int16X32PrimTy -primOpInfo (VecRemOp IntVec 16 W32) = mkDyadic (fsLit "remInt32X16#") int32X16PrimTy -primOpInfo (VecRemOp IntVec 8 W64) = mkDyadic (fsLit "remInt64X8#") int64X8PrimTy -primOpInfo (VecRemOp WordVec 16 W8) = mkDyadic (fsLit "remWord8X16#") word8X16PrimTy -primOpInfo (VecRemOp WordVec 8 W16) = mkDyadic (fsLit "remWord16X8#") word16X8PrimTy -primOpInfo (VecRemOp WordVec 4 W32) = mkDyadic (fsLit "remWord32X4#") word32X4PrimTy -primOpInfo (VecRemOp WordVec 2 W64) = mkDyadic (fsLit "remWord64X2#") word64X2PrimTy -primOpInfo (VecRemOp WordVec 32 W8) = mkDyadic (fsLit "remWord8X32#") word8X32PrimTy -primOpInfo (VecRemOp WordVec 16 W16) = mkDyadic (fsLit "remWord16X16#") word16X16PrimTy -primOpInfo (VecRemOp WordVec 8 W32) = mkDyadic (fsLit "remWord32X8#") word32X8PrimTy -primOpInfo (VecRemOp WordVec 4 W64) = mkDyadic (fsLit "remWord64X4#") word64X4PrimTy -primOpInfo (VecRemOp WordVec 64 W8) = mkDyadic (fsLit "remWord8X64#") word8X64PrimTy -primOpInfo (VecRemOp WordVec 32 W16) = mkDyadic (fsLit "remWord16X32#") word16X32PrimTy -primOpInfo (VecRemOp WordVec 16 W32) = mkDyadic (fsLit "remWord32X16#") word32X16PrimTy -primOpInfo (VecRemOp WordVec 8 W64) = mkDyadic (fsLit "remWord64X8#") word64X8PrimTy -primOpInfo (VecNegOp IntVec 16 W8) = mkMonadic (fsLit "negateInt8X16#") int8X16PrimTy -primOpInfo (VecNegOp IntVec 8 W16) = mkMonadic (fsLit "negateInt16X8#") int16X8PrimTy -primOpInfo (VecNegOp IntVec 4 W32) = mkMonadic (fsLit "negateInt32X4#") int32X4PrimTy -primOpInfo (VecNegOp IntVec 2 W64) = mkMonadic (fsLit "negateInt64X2#") int64X2PrimTy -primOpInfo (VecNegOp IntVec 32 W8) = mkMonadic (fsLit "negateInt8X32#") int8X32PrimTy -primOpInfo (VecNegOp IntVec 16 W16) = mkMonadic (fsLit "negateInt16X16#") int16X16PrimTy -primOpInfo (VecNegOp IntVec 8 W32) = mkMonadic (fsLit "negateInt32X8#") int32X8PrimTy -primOpInfo (VecNegOp IntVec 4 W64) = mkMonadic (fsLit "negateInt64X4#") int64X4PrimTy -primOpInfo (VecNegOp IntVec 64 W8) = mkMonadic (fsLit "negateInt8X64#") int8X64PrimTy -primOpInfo (VecNegOp IntVec 32 W16) = mkMonadic (fsLit "negateInt16X32#") int16X32PrimTy -primOpInfo (VecNegOp IntVec 16 W32) = mkMonadic (fsLit "negateInt32X16#") int32X16PrimTy -primOpInfo (VecNegOp IntVec 8 W64) = mkMonadic (fsLit "negateInt64X8#") int64X8PrimTy -primOpInfo (VecNegOp FloatVec 4 W32) = mkMonadic (fsLit "negateFloatX4#") floatX4PrimTy -primOpInfo (VecNegOp FloatVec 2 W64) = mkMonadic (fsLit "negateDoubleX2#") doubleX2PrimTy -primOpInfo (VecNegOp FloatVec 8 W32) = mkMonadic (fsLit "negateFloatX8#") floatX8PrimTy -primOpInfo (VecNegOp FloatVec 4 W64) = mkMonadic (fsLit "negateDoubleX4#") doubleX4PrimTy -primOpInfo (VecNegOp FloatVec 16 W32) = mkMonadic (fsLit "negateFloatX16#") floatX16PrimTy -primOpInfo (VecNegOp FloatVec 8 W64) = mkMonadic (fsLit "negateDoubleX8#") doubleX8PrimTy -primOpInfo (VecIndexByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "indexInt8X16Array#") [] [byteArrayPrimTy, intPrimTy] (int8X16PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "indexInt16X8Array#") [] [byteArrayPrimTy, intPrimTy] (int16X8PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "indexInt32X4Array#") [] [byteArrayPrimTy, intPrimTy] (int32X4PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "indexInt64X2Array#") [] [byteArrayPrimTy, intPrimTy] (int64X2PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "indexInt8X32Array#") [] [byteArrayPrimTy, intPrimTy] (int8X32PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "indexInt16X16Array#") [] [byteArrayPrimTy, intPrimTy] (int16X16PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "indexInt32X8Array#") [] [byteArrayPrimTy, intPrimTy] (int32X8PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "indexInt64X4Array#") [] [byteArrayPrimTy, intPrimTy] (int64X4PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "indexInt8X64Array#") [] [byteArrayPrimTy, intPrimTy] (int8X64PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "indexInt16X32Array#") [] [byteArrayPrimTy, intPrimTy] (int16X32PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "indexInt32X16Array#") [] [byteArrayPrimTy, intPrimTy] (int32X16PrimTy) -primOpInfo (VecIndexByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "indexInt64X8Array#") [] [byteArrayPrimTy, intPrimTy] (int64X8PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "indexWord8X16Array#") [] [byteArrayPrimTy, intPrimTy] (word8X16PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "indexWord16X8Array#") [] [byteArrayPrimTy, intPrimTy] (word16X8PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "indexWord32X4Array#") [] [byteArrayPrimTy, intPrimTy] (word32X4PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "indexWord64X2Array#") [] [byteArrayPrimTy, intPrimTy] (word64X2PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "indexWord8X32Array#") [] [byteArrayPrimTy, intPrimTy] (word8X32PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "indexWord16X16Array#") [] [byteArrayPrimTy, intPrimTy] (word16X16PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "indexWord32X8Array#") [] [byteArrayPrimTy, intPrimTy] (word32X8PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "indexWord64X4Array#") [] [byteArrayPrimTy, intPrimTy] (word64X4PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "indexWord8X64Array#") [] [byteArrayPrimTy, intPrimTy] (word8X64PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "indexWord16X32Array#") [] [byteArrayPrimTy, intPrimTy] (word16X32PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "indexWord32X16Array#") [] [byteArrayPrimTy, intPrimTy] (word32X16PrimTy) -primOpInfo (VecIndexByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "indexWord64X8Array#") [] [byteArrayPrimTy, intPrimTy] (word64X8PrimTy) -primOpInfo (VecIndexByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "indexFloatX4Array#") [] [byteArrayPrimTy, intPrimTy] (floatX4PrimTy) -primOpInfo (VecIndexByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "indexDoubleX2Array#") [] [byteArrayPrimTy, intPrimTy] (doubleX2PrimTy) -primOpInfo (VecIndexByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "indexFloatX8Array#") [] [byteArrayPrimTy, intPrimTy] (floatX8PrimTy) -primOpInfo (VecIndexByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "indexDoubleX4Array#") [] [byteArrayPrimTy, intPrimTy] (doubleX4PrimTy) -primOpInfo (VecIndexByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "indexFloatX16Array#") [] [byteArrayPrimTy, intPrimTy] (floatX16PrimTy) -primOpInfo (VecIndexByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "indexDoubleX8Array#") [] [byteArrayPrimTy, intPrimTy] (doubleX8PrimTy) -primOpInfo (VecReadByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "readInt8X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X16PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "readInt16X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X8PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "readInt32X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X4PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "readInt64X2Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X2PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "readInt8X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X32PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "readInt16X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X16PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "readInt32X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X8PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "readInt64X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X4PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "readInt8X64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X64PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "readInt16X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X32PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "readInt32X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X16PrimTy])) -primOpInfo (VecReadByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "readInt64X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X8PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "readWord8X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X16PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "readWord16X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X8PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "readWord32X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X4PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "readWord64X2Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X2PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "readWord8X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X32PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "readWord16X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X16PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "readWord32X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X8PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "readWord64X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X4PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "readWord8X64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X64PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "readWord16X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X32PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "readWord32X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X16PrimTy])) -primOpInfo (VecReadByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "readWord64X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X8PrimTy])) -primOpInfo (VecReadByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "readFloatX4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX4PrimTy])) -primOpInfo (VecReadByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "readDoubleX2Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX2PrimTy])) -primOpInfo (VecReadByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "readFloatX8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX8PrimTy])) -primOpInfo (VecReadByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "readDoubleX4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX4PrimTy])) -primOpInfo (VecReadByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "readFloatX16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX16PrimTy])) -primOpInfo (VecReadByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "readDoubleX8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX8PrimTy])) -primOpInfo (VecWriteByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "writeInt8X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "writeInt16X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "writeInt32X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "writeInt64X2Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "writeInt8X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "writeInt16X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "writeInt32X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "writeInt64X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "writeInt8X64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "writeInt16X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "writeInt32X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "writeInt64X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "writeWord8X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "writeWord16X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "writeWord32X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "writeWord64X2Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "writeWord8X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "writeWord16X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "writeWord32X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "writeWord64X4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "writeWord8X64Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "writeWord16X32Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "writeWord32X16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "writeWord64X8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "writeFloatX4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "writeDoubleX2Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "writeFloatX8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "writeDoubleX4Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "writeFloatX16Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "writeDoubleX8Array#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecIndexOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "indexInt8X16OffAddr#") [] [addrPrimTy, intPrimTy] (int8X16PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "indexInt16X8OffAddr#") [] [addrPrimTy, intPrimTy] (int16X8PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "indexInt32X4OffAddr#") [] [addrPrimTy, intPrimTy] (int32X4PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "indexInt64X2OffAddr#") [] [addrPrimTy, intPrimTy] (int64X2PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "indexInt8X32OffAddr#") [] [addrPrimTy, intPrimTy] (int8X32PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "indexInt16X16OffAddr#") [] [addrPrimTy, intPrimTy] (int16X16PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "indexInt32X8OffAddr#") [] [addrPrimTy, intPrimTy] (int32X8PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "indexInt64X4OffAddr#") [] [addrPrimTy, intPrimTy] (int64X4PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "indexInt8X64OffAddr#") [] [addrPrimTy, intPrimTy] (int8X64PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "indexInt16X32OffAddr#") [] [addrPrimTy, intPrimTy] (int16X32PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "indexInt32X16OffAddr#") [] [addrPrimTy, intPrimTy] (int32X16PrimTy) -primOpInfo (VecIndexOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "indexInt64X8OffAddr#") [] [addrPrimTy, intPrimTy] (int64X8PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "indexWord8X16OffAddr#") [] [addrPrimTy, intPrimTy] (word8X16PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "indexWord16X8OffAddr#") [] [addrPrimTy, intPrimTy] (word16X8PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "indexWord32X4OffAddr#") [] [addrPrimTy, intPrimTy] (word32X4PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "indexWord64X2OffAddr#") [] [addrPrimTy, intPrimTy] (word64X2PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "indexWord8X32OffAddr#") [] [addrPrimTy, intPrimTy] (word8X32PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "indexWord16X16OffAddr#") [] [addrPrimTy, intPrimTy] (word16X16PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "indexWord32X8OffAddr#") [] [addrPrimTy, intPrimTy] (word32X8PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "indexWord64X4OffAddr#") [] [addrPrimTy, intPrimTy] (word64X4PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "indexWord8X64OffAddr#") [] [addrPrimTy, intPrimTy] (word8X64PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "indexWord16X32OffAddr#") [] [addrPrimTy, intPrimTy] (word16X32PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "indexWord32X16OffAddr#") [] [addrPrimTy, intPrimTy] (word32X16PrimTy) -primOpInfo (VecIndexOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "indexWord64X8OffAddr#") [] [addrPrimTy, intPrimTy] (word64X8PrimTy) -primOpInfo (VecIndexOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "indexFloatX4OffAddr#") [] [addrPrimTy, intPrimTy] (floatX4PrimTy) -primOpInfo (VecIndexOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "indexDoubleX2OffAddr#") [] [addrPrimTy, intPrimTy] (doubleX2PrimTy) -primOpInfo (VecIndexOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "indexFloatX8OffAddr#") [] [addrPrimTy, intPrimTy] (floatX8PrimTy) -primOpInfo (VecIndexOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "indexDoubleX4OffAddr#") [] [addrPrimTy, intPrimTy] (doubleX4PrimTy) -primOpInfo (VecIndexOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "indexFloatX16OffAddr#") [] [addrPrimTy, intPrimTy] (floatX16PrimTy) -primOpInfo (VecIndexOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "indexDoubleX8OffAddr#") [] [addrPrimTy, intPrimTy] (doubleX8PrimTy) -primOpInfo (VecReadOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "readInt8X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X16PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "readInt16X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X8PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "readInt32X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X4PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "readInt64X2OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X2PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "readInt8X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X32PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "readInt16X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X16PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "readInt32X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X8PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "readInt64X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X4PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "readInt8X64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X64PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "readInt16X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X32PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "readInt32X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X16PrimTy])) -primOpInfo (VecReadOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "readInt64X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X8PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "readWord8X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X16PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "readWord16X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X8PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "readWord32X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X4PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "readWord64X2OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X2PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "readWord8X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X32PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "readWord16X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X16PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "readWord32X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X8PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "readWord64X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X4PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "readWord8X64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X64PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "readWord16X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X32PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "readWord32X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X16PrimTy])) -primOpInfo (VecReadOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "readWord64X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X8PrimTy])) -primOpInfo (VecReadOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "readFloatX4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX4PrimTy])) -primOpInfo (VecReadOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "readDoubleX2OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX2PrimTy])) -primOpInfo (VecReadOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "readFloatX8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX8PrimTy])) -primOpInfo (VecReadOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "readDoubleX4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX4PrimTy])) -primOpInfo (VecReadOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "readFloatX16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX16PrimTy])) -primOpInfo (VecReadOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "readDoubleX8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX8PrimTy])) -primOpInfo (VecWriteOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "writeInt8X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "writeInt16X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "writeInt32X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "writeInt64X2OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "writeInt8X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "writeInt16X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "writeInt32X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "writeInt64X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "writeInt8X64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "writeInt16X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "writeInt32X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "writeInt64X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, int64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "writeWord8X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "writeWord16X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "writeWord32X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "writeWord64X2OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "writeWord8X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "writeWord16X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "writeWord32X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "writeWord64X4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "writeWord8X64OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "writeWord16X32OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "writeWord32X16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "writeWord64X8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, word64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "writeFloatX4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, floatX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "writeDoubleX2OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, doubleX2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "writeFloatX8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, floatX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "writeDoubleX4OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, doubleX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "writeFloatX16OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, floatX16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "writeDoubleX8OffAddr#") [deltaTyVar] [addrPrimTy, intPrimTy, doubleX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "indexInt8ArrayAsInt8X16#") [] [byteArrayPrimTy, intPrimTy] (int8X16PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "indexInt16ArrayAsInt16X8#") [] [byteArrayPrimTy, intPrimTy] (int16X8PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "indexInt32ArrayAsInt32X4#") [] [byteArrayPrimTy, intPrimTy] (int32X4PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "indexInt64ArrayAsInt64X2#") [] [byteArrayPrimTy, intPrimTy] (int64X2PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "indexInt8ArrayAsInt8X32#") [] [byteArrayPrimTy, intPrimTy] (int8X32PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "indexInt16ArrayAsInt16X16#") [] [byteArrayPrimTy, intPrimTy] (int16X16PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "indexInt32ArrayAsInt32X8#") [] [byteArrayPrimTy, intPrimTy] (int32X8PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "indexInt64ArrayAsInt64X4#") [] [byteArrayPrimTy, intPrimTy] (int64X4PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "indexInt8ArrayAsInt8X64#") [] [byteArrayPrimTy, intPrimTy] (int8X64PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "indexInt16ArrayAsInt16X32#") [] [byteArrayPrimTy, intPrimTy] (int16X32PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "indexInt32ArrayAsInt32X16#") [] [byteArrayPrimTy, intPrimTy] (int32X16PrimTy) -primOpInfo (VecIndexScalarByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "indexInt64ArrayAsInt64X8#") [] [byteArrayPrimTy, intPrimTy] (int64X8PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "indexWord8ArrayAsWord8X16#") [] [byteArrayPrimTy, intPrimTy] (word8X16PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "indexWord16ArrayAsWord16X8#") [] [byteArrayPrimTy, intPrimTy] (word16X8PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "indexWord32ArrayAsWord32X4#") [] [byteArrayPrimTy, intPrimTy] (word32X4PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "indexWord64ArrayAsWord64X2#") [] [byteArrayPrimTy, intPrimTy] (word64X2PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "indexWord8ArrayAsWord8X32#") [] [byteArrayPrimTy, intPrimTy] (word8X32PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "indexWord16ArrayAsWord16X16#") [] [byteArrayPrimTy, intPrimTy] (word16X16PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "indexWord32ArrayAsWord32X8#") [] [byteArrayPrimTy, intPrimTy] (word32X8PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "indexWord64ArrayAsWord64X4#") [] [byteArrayPrimTy, intPrimTy] (word64X4PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "indexWord8ArrayAsWord8X64#") [] [byteArrayPrimTy, intPrimTy] (word8X64PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "indexWord16ArrayAsWord16X32#") [] [byteArrayPrimTy, intPrimTy] (word16X32PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "indexWord32ArrayAsWord32X16#") [] [byteArrayPrimTy, intPrimTy] (word32X16PrimTy) -primOpInfo (VecIndexScalarByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "indexWord64ArrayAsWord64X8#") [] [byteArrayPrimTy, intPrimTy] (word64X8PrimTy) -primOpInfo (VecIndexScalarByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "indexFloatArrayAsFloatX4#") [] [byteArrayPrimTy, intPrimTy] (floatX4PrimTy) -primOpInfo (VecIndexScalarByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "indexDoubleArrayAsDoubleX2#") [] [byteArrayPrimTy, intPrimTy] (doubleX2PrimTy) -primOpInfo (VecIndexScalarByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "indexFloatArrayAsFloatX8#") [] [byteArrayPrimTy, intPrimTy] (floatX8PrimTy) -primOpInfo (VecIndexScalarByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "indexDoubleArrayAsDoubleX4#") [] [byteArrayPrimTy, intPrimTy] (doubleX4PrimTy) -primOpInfo (VecIndexScalarByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "indexFloatArrayAsFloatX16#") [] [byteArrayPrimTy, intPrimTy] (floatX16PrimTy) -primOpInfo (VecIndexScalarByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "indexDoubleArrayAsDoubleX8#") [] [byteArrayPrimTy, intPrimTy] (doubleX8PrimTy) -primOpInfo (VecReadScalarByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "readInt8ArrayAsInt8X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X16PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "readInt16ArrayAsInt16X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X8PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "readInt32ArrayAsInt32X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X4PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "readInt64ArrayAsInt64X2#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X2PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "readInt8ArrayAsInt8X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X32PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "readInt16ArrayAsInt16X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X16PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "readInt32ArrayAsInt32X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X8PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "readInt64ArrayAsInt64X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X4PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "readInt8ArrayAsInt8X64#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X64PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "readInt16ArrayAsInt16X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X32PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "readInt32ArrayAsInt32X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X16PrimTy])) -primOpInfo (VecReadScalarByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "readInt64ArrayAsInt64X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X8PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "readWord8ArrayAsWord8X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X16PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "readWord16ArrayAsWord16X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X8PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "readWord32ArrayAsWord32X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X4PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "readWord64ArrayAsWord64X2#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X2PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "readWord8ArrayAsWord8X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X32PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "readWord16ArrayAsWord16X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X16PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "readWord32ArrayAsWord32X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X8PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "readWord64ArrayAsWord64X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X4PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "readWord8ArrayAsWord8X64#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X64PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "readWord16ArrayAsWord16X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X32PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "readWord32ArrayAsWord32X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X16PrimTy])) -primOpInfo (VecReadScalarByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "readWord64ArrayAsWord64X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X8PrimTy])) -primOpInfo (VecReadScalarByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "readFloatArrayAsFloatX4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX4PrimTy])) -primOpInfo (VecReadScalarByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "readDoubleArrayAsDoubleX2#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX2PrimTy])) -primOpInfo (VecReadScalarByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "readFloatArrayAsFloatX8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX8PrimTy])) -primOpInfo (VecReadScalarByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "readDoubleArrayAsDoubleX4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX4PrimTy])) -primOpInfo (VecReadScalarByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "readFloatArrayAsFloatX16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX16PrimTy])) -primOpInfo (VecReadScalarByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "readDoubleArrayAsDoubleX8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX8PrimTy])) -primOpInfo (VecWriteScalarByteArrayOp IntVec 16 W8) = mkGenPrimOp (fsLit "writeInt8ArrayAsInt8X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 8 W16) = mkGenPrimOp (fsLit "writeInt16ArrayAsInt16X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 4 W32) = mkGenPrimOp (fsLit "writeInt32ArrayAsInt32X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 2 W64) = mkGenPrimOp (fsLit "writeInt64ArrayAsInt64X2#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 32 W8) = mkGenPrimOp (fsLit "writeInt8ArrayAsInt8X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 16 W16) = mkGenPrimOp (fsLit "writeInt16ArrayAsInt16X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 8 W32) = mkGenPrimOp (fsLit "writeInt32ArrayAsInt32X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 4 W64) = mkGenPrimOp (fsLit "writeInt64ArrayAsInt64X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 64 W8) = mkGenPrimOp (fsLit "writeInt8ArrayAsInt8X64#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 32 W16) = mkGenPrimOp (fsLit "writeInt16ArrayAsInt16X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 16 W32) = mkGenPrimOp (fsLit "writeInt32ArrayAsInt32X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp IntVec 8 W64) = mkGenPrimOp (fsLit "writeInt64ArrayAsInt64X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, int64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 16 W8) = mkGenPrimOp (fsLit "writeWord8ArrayAsWord8X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 8 W16) = mkGenPrimOp (fsLit "writeWord16ArrayAsWord16X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 4 W32) = mkGenPrimOp (fsLit "writeWord32ArrayAsWord32X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 2 W64) = mkGenPrimOp (fsLit "writeWord64ArrayAsWord64X2#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 32 W8) = mkGenPrimOp (fsLit "writeWord8ArrayAsWord8X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 16 W16) = mkGenPrimOp (fsLit "writeWord16ArrayAsWord16X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 8 W32) = mkGenPrimOp (fsLit "writeWord32ArrayAsWord32X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 4 W64) = mkGenPrimOp (fsLit "writeWord64ArrayAsWord64X4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 64 W8) = mkGenPrimOp (fsLit "writeWord8ArrayAsWord8X64#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 32 W16) = mkGenPrimOp (fsLit "writeWord16ArrayAsWord16X32#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 16 W32) = mkGenPrimOp (fsLit "writeWord32ArrayAsWord32X16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp WordVec 8 W64) = mkGenPrimOp (fsLit "writeWord64ArrayAsWord64X8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, word64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp FloatVec 4 W32) = mkGenPrimOp (fsLit "writeFloatArrayAsFloatX4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp FloatVec 2 W64) = mkGenPrimOp (fsLit "writeDoubleArrayAsDoubleX2#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp FloatVec 8 W32) = mkGenPrimOp (fsLit "writeFloatArrayAsFloatX8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp FloatVec 4 W64) = mkGenPrimOp (fsLit "writeDoubleArrayAsDoubleX4#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp FloatVec 16 W32) = mkGenPrimOp (fsLit "writeFloatArrayAsFloatX16#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, floatX16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarByteArrayOp FloatVec 8 W64) = mkGenPrimOp (fsLit "writeDoubleArrayAsDoubleX8#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, doubleX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "indexInt8OffAddrAsInt8X16#") [] [addrPrimTy, intPrimTy] (int8X16PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "indexInt16OffAddrAsInt16X8#") [] [addrPrimTy, intPrimTy] (int16X8PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "indexInt32OffAddrAsInt32X4#") [] [addrPrimTy, intPrimTy] (int32X4PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "indexInt64OffAddrAsInt64X2#") [] [addrPrimTy, intPrimTy] (int64X2PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "indexInt8OffAddrAsInt8X32#") [] [addrPrimTy, intPrimTy] (int8X32PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "indexInt16OffAddrAsInt16X16#") [] [addrPrimTy, intPrimTy] (int16X16PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "indexInt32OffAddrAsInt32X8#") [] [addrPrimTy, intPrimTy] (int32X8PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "indexInt64OffAddrAsInt64X4#") [] [addrPrimTy, intPrimTy] (int64X4PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "indexInt8OffAddrAsInt8X64#") [] [addrPrimTy, intPrimTy] (int8X64PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "indexInt16OffAddrAsInt16X32#") [] [addrPrimTy, intPrimTy] (int16X32PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "indexInt32OffAddrAsInt32X16#") [] [addrPrimTy, intPrimTy] (int32X16PrimTy) -primOpInfo (VecIndexScalarOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "indexInt64OffAddrAsInt64X8#") [] [addrPrimTy, intPrimTy] (int64X8PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "indexWord8OffAddrAsWord8X16#") [] [addrPrimTy, intPrimTy] (word8X16PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "indexWord16OffAddrAsWord16X8#") [] [addrPrimTy, intPrimTy] (word16X8PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "indexWord32OffAddrAsWord32X4#") [] [addrPrimTy, intPrimTy] (word32X4PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "indexWord64OffAddrAsWord64X2#") [] [addrPrimTy, intPrimTy] (word64X2PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "indexWord8OffAddrAsWord8X32#") [] [addrPrimTy, intPrimTy] (word8X32PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "indexWord16OffAddrAsWord16X16#") [] [addrPrimTy, intPrimTy] (word16X16PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "indexWord32OffAddrAsWord32X8#") [] [addrPrimTy, intPrimTy] (word32X8PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "indexWord64OffAddrAsWord64X4#") [] [addrPrimTy, intPrimTy] (word64X4PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "indexWord8OffAddrAsWord8X64#") [] [addrPrimTy, intPrimTy] (word8X64PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "indexWord16OffAddrAsWord16X32#") [] [addrPrimTy, intPrimTy] (word16X32PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "indexWord32OffAddrAsWord32X16#") [] [addrPrimTy, intPrimTy] (word32X16PrimTy) -primOpInfo (VecIndexScalarOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "indexWord64OffAddrAsWord64X8#") [] [addrPrimTy, intPrimTy] (word64X8PrimTy) -primOpInfo (VecIndexScalarOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "indexFloatOffAddrAsFloatX4#") [] [addrPrimTy, intPrimTy] (floatX4PrimTy) -primOpInfo (VecIndexScalarOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "indexDoubleOffAddrAsDoubleX2#") [] [addrPrimTy, intPrimTy] (doubleX2PrimTy) -primOpInfo (VecIndexScalarOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "indexFloatOffAddrAsFloatX8#") [] [addrPrimTy, intPrimTy] (floatX8PrimTy) -primOpInfo (VecIndexScalarOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "indexDoubleOffAddrAsDoubleX4#") [] [addrPrimTy, intPrimTy] (doubleX4PrimTy) -primOpInfo (VecIndexScalarOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "indexFloatOffAddrAsFloatX16#") [] [addrPrimTy, intPrimTy] (floatX16PrimTy) -primOpInfo (VecIndexScalarOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "indexDoubleOffAddrAsDoubleX8#") [] [addrPrimTy, intPrimTy] (doubleX8PrimTy) -primOpInfo (VecReadScalarOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "readInt8OffAddrAsInt8X16#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X16PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "readInt16OffAddrAsInt16X8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X8PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "readInt32OffAddrAsInt32X4#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X4PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "readInt64OffAddrAsInt64X2#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X2PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "readInt8OffAddrAsInt8X32#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X32PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "readInt16OffAddrAsInt16X16#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X16PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "readInt32OffAddrAsInt32X8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X8PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "readInt64OffAddrAsInt64X4#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X4PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "readInt8OffAddrAsInt8X64#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int8X64PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "readInt16OffAddrAsInt16X32#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int16X32PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "readInt32OffAddrAsInt32X16#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int32X16PrimTy])) -primOpInfo (VecReadScalarOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "readInt64OffAddrAsInt64X8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, int64X8PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "readWord8OffAddrAsWord8X16#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X16PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "readWord16OffAddrAsWord16X8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X8PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "readWord32OffAddrAsWord32X4#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X4PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "readWord64OffAddrAsWord64X2#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X2PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "readWord8OffAddrAsWord8X32#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X32PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "readWord16OffAddrAsWord16X16#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X16PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "readWord32OffAddrAsWord32X8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X8PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "readWord64OffAddrAsWord64X4#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X4PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "readWord8OffAddrAsWord8X64#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word8X64PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "readWord16OffAddrAsWord16X32#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word16X32PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "readWord32OffAddrAsWord32X16#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word32X16PrimTy])) -primOpInfo (VecReadScalarOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "readWord64OffAddrAsWord64X8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, word64X8PrimTy])) -primOpInfo (VecReadScalarOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "readFloatOffAddrAsFloatX4#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX4PrimTy])) -primOpInfo (VecReadScalarOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "readDoubleOffAddrAsDoubleX2#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX2PrimTy])) -primOpInfo (VecReadScalarOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "readFloatOffAddrAsFloatX8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX8PrimTy])) -primOpInfo (VecReadScalarOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "readDoubleOffAddrAsDoubleX4#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX4PrimTy])) -primOpInfo (VecReadScalarOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "readFloatOffAddrAsFloatX16#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, floatX16PrimTy])) -primOpInfo (VecReadScalarOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "readDoubleOffAddrAsDoubleX8#") [deltaTyVar] [addrPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy UnboxedTuple [mkStatePrimTy deltaTy, doubleX8PrimTy])) -primOpInfo (VecWriteScalarOffAddrOp IntVec 16 W8) = mkGenPrimOp (fsLit "writeInt8OffAddrAsInt8X16#") [deltaTyVar] [addrPrimTy, intPrimTy, int8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 8 W16) = mkGenPrimOp (fsLit "writeInt16OffAddrAsInt16X8#") [deltaTyVar] [addrPrimTy, intPrimTy, int16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 4 W32) = mkGenPrimOp (fsLit "writeInt32OffAddrAsInt32X4#") [deltaTyVar] [addrPrimTy, intPrimTy, int32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 2 W64) = mkGenPrimOp (fsLit "writeInt64OffAddrAsInt64X2#") [deltaTyVar] [addrPrimTy, intPrimTy, int64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 32 W8) = mkGenPrimOp (fsLit "writeInt8OffAddrAsInt8X32#") [deltaTyVar] [addrPrimTy, intPrimTy, int8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 16 W16) = mkGenPrimOp (fsLit "writeInt16OffAddrAsInt16X16#") [deltaTyVar] [addrPrimTy, intPrimTy, int16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 8 W32) = mkGenPrimOp (fsLit "writeInt32OffAddrAsInt32X8#") [deltaTyVar] [addrPrimTy, intPrimTy, int32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 4 W64) = mkGenPrimOp (fsLit "writeInt64OffAddrAsInt64X4#") [deltaTyVar] [addrPrimTy, intPrimTy, int64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 64 W8) = mkGenPrimOp (fsLit "writeInt8OffAddrAsInt8X64#") [deltaTyVar] [addrPrimTy, intPrimTy, int8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 32 W16) = mkGenPrimOp (fsLit "writeInt16OffAddrAsInt16X32#") [deltaTyVar] [addrPrimTy, intPrimTy, int16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 16 W32) = mkGenPrimOp (fsLit "writeInt32OffAddrAsInt32X16#") [deltaTyVar] [addrPrimTy, intPrimTy, int32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp IntVec 8 W64) = mkGenPrimOp (fsLit "writeInt64OffAddrAsInt64X8#") [deltaTyVar] [addrPrimTy, intPrimTy, int64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 16 W8) = mkGenPrimOp (fsLit "writeWord8OffAddrAsWord8X16#") [deltaTyVar] [addrPrimTy, intPrimTy, word8X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 8 W16) = mkGenPrimOp (fsLit "writeWord16OffAddrAsWord16X8#") [deltaTyVar] [addrPrimTy, intPrimTy, word16X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 4 W32) = mkGenPrimOp (fsLit "writeWord32OffAddrAsWord32X4#") [deltaTyVar] [addrPrimTy, intPrimTy, word32X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 2 W64) = mkGenPrimOp (fsLit "writeWord64OffAddrAsWord64X2#") [deltaTyVar] [addrPrimTy, intPrimTy, word64X2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 32 W8) = mkGenPrimOp (fsLit "writeWord8OffAddrAsWord8X32#") [deltaTyVar] [addrPrimTy, intPrimTy, word8X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 16 W16) = mkGenPrimOp (fsLit "writeWord16OffAddrAsWord16X16#") [deltaTyVar] [addrPrimTy, intPrimTy, word16X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 8 W32) = mkGenPrimOp (fsLit "writeWord32OffAddrAsWord32X8#") [deltaTyVar] [addrPrimTy, intPrimTy, word32X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 4 W64) = mkGenPrimOp (fsLit "writeWord64OffAddrAsWord64X4#") [deltaTyVar] [addrPrimTy, intPrimTy, word64X4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 64 W8) = mkGenPrimOp (fsLit "writeWord8OffAddrAsWord8X64#") [deltaTyVar] [addrPrimTy, intPrimTy, word8X64PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 32 W16) = mkGenPrimOp (fsLit "writeWord16OffAddrAsWord16X32#") [deltaTyVar] [addrPrimTy, intPrimTy, word16X32PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 16 W32) = mkGenPrimOp (fsLit "writeWord32OffAddrAsWord32X16#") [deltaTyVar] [addrPrimTy, intPrimTy, word32X16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp WordVec 8 W64) = mkGenPrimOp (fsLit "writeWord64OffAddrAsWord64X8#") [deltaTyVar] [addrPrimTy, intPrimTy, word64X8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp FloatVec 4 W32) = mkGenPrimOp (fsLit "writeFloatOffAddrAsFloatX4#") [deltaTyVar] [addrPrimTy, intPrimTy, floatX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp FloatVec 2 W64) = mkGenPrimOp (fsLit "writeDoubleOffAddrAsDoubleX2#") [deltaTyVar] [addrPrimTy, intPrimTy, doubleX2PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp FloatVec 8 W32) = mkGenPrimOp (fsLit "writeFloatOffAddrAsFloatX8#") [deltaTyVar] [addrPrimTy, intPrimTy, floatX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp FloatVec 4 W64) = mkGenPrimOp (fsLit "writeDoubleOffAddrAsDoubleX4#") [deltaTyVar] [addrPrimTy, intPrimTy, doubleX4PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp FloatVec 16 W32) = mkGenPrimOp (fsLit "writeFloatOffAddrAsFloatX16#") [deltaTyVar] [addrPrimTy, intPrimTy, floatX16PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo (VecWriteScalarOffAddrOp FloatVec 8 W64) = mkGenPrimOp (fsLit "writeDoubleOffAddrAsDoubleX8#") [deltaTyVar] [addrPrimTy, intPrimTy, doubleX8PrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo PrefetchByteArrayOp3 = mkGenPrimOp (fsLit "prefetchByteArray3#") [] [byteArrayPrimTy, intPrimTy] (byteArrayPrimTy) -primOpInfo PrefetchMutableByteArrayOp3 = mkGenPrimOp (fsLit "prefetchMutableByteArray3#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo PrefetchAddrOp3 = mkGenPrimOp (fsLit "prefetchAddr3#") [] [addrPrimTy, intPrimTy] (addrPrimTy) -primOpInfo PrefetchByteArrayOp2 = mkGenPrimOp (fsLit "prefetchByteArray2#") [] [byteArrayPrimTy, intPrimTy] (byteArrayPrimTy) -primOpInfo PrefetchMutableByteArrayOp2 = mkGenPrimOp (fsLit "prefetchMutableByteArray2#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo PrefetchAddrOp2 = mkGenPrimOp (fsLit "prefetchAddr2#") [] [addrPrimTy, intPrimTy] (addrPrimTy) -primOpInfo PrefetchByteArrayOp1 = mkGenPrimOp (fsLit "prefetchByteArray1#") [] [byteArrayPrimTy, intPrimTy] (byteArrayPrimTy) -primOpInfo PrefetchMutableByteArrayOp1 = mkGenPrimOp (fsLit "prefetchMutableByteArray1#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo PrefetchAddrOp1 = mkGenPrimOp (fsLit "prefetchAddr1#") [] [addrPrimTy, intPrimTy] (addrPrimTy) -primOpInfo PrefetchByteArrayOp0 = mkGenPrimOp (fsLit "prefetchByteArray0#") [] [byteArrayPrimTy, intPrimTy] (byteArrayPrimTy) -primOpInfo PrefetchMutableByteArrayOp0 = mkGenPrimOp (fsLit "prefetchMutableByteArray0#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo PrefetchAddrOp0 = mkGenPrimOp (fsLit "prefetchAddr0#") [] [addrPrimTy, intPrimTy] (addrPrimTy) diff --git a/include/prim/primop-primop-info-800.hs-incl b/include/prim/primop-primop-info-820.hs-incl similarity index 98% rename from include/prim/primop-primop-info-800.hs-incl rename to include/prim/primop-primop-info-820.hs-incl index e75bb66f..dd53104b 100644 --- a/include/prim/primop-primop-info-800.hs-incl +++ b/include/prim/primop-primop-info-820.hs-incl @@ -93,6 +93,7 @@ primOpInfo DoubleSubOp = mkDyadic (fsLit "-##") doublePrimTy primOpInfo DoubleMulOp = mkDyadic (fsLit "*##") doublePrimTy primOpInfo DoubleDivOp = mkDyadic (fsLit "/##") doublePrimTy primOpInfo DoubleNegOp = mkMonadic (fsLit "negateDouble#") doublePrimTy +primOpInfo DoubleFabsOp = mkMonadic (fsLit "fabsDouble#") doublePrimTy primOpInfo Double2IntOp = mkGenPrimOp (fsLit "double2Int#") [] [doublePrimTy] (intPrimTy) primOpInfo Double2FloatOp = mkGenPrimOp (fsLit "double2Float#") [] [doublePrimTy] (floatPrimTy) primOpInfo DoubleExpOp = mkMonadic (fsLit "expDouble#") doublePrimTy @@ -121,6 +122,7 @@ primOpInfo FloatSubOp = mkDyadic (fsLit "minusFloat#") floatPrimTy primOpInfo FloatMulOp = mkDyadic (fsLit "timesFloat#") floatPrimTy primOpInfo FloatDivOp = mkDyadic (fsLit "divideFloat#") floatPrimTy primOpInfo FloatNegOp = mkMonadic (fsLit "negateFloat#") floatPrimTy +primOpInfo FloatFabsOp = mkMonadic (fsLit "fabsFloat#") floatPrimTy primOpInfo Float2IntOp = mkGenPrimOp (fsLit "float2Int#") [] [floatPrimTy] (intPrimTy) primOpInfo FloatExpOp = mkMonadic (fsLit "expFloat#") floatPrimTy primOpInfo FloatLogOp = mkMonadic (fsLit "logFloat#") floatPrimTy @@ -172,6 +174,8 @@ primOpInfo CasSmallArrayOp = mkGenPrimOp (fsLit "casSmallArray#") [deltaTyVar, primOpInfo NewByteArrayOp_Char = mkGenPrimOp (fsLit "newByteArray#") [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy])) primOpInfo NewPinnedByteArrayOp_Char = mkGenPrimOp (fsLit "newPinnedByteArray#") [deltaTyVar] [intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy])) primOpInfo NewAlignedPinnedByteArrayOp_Char = mkGenPrimOp (fsLit "newAlignedPinnedByteArray#") [deltaTyVar] [intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy])) +primOpInfo MutableByteArrayIsPinnedOp = mkGenPrimOp (fsLit "isMutableByteArrayPinned#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy] (intPrimTy) +primOpInfo ByteArrayIsPinnedOp = mkGenPrimOp (fsLit "isByteArrayPinned#") [] [byteArrayPrimTy] (intPrimTy) primOpInfo ByteArrayContents_Char = mkGenPrimOp (fsLit "byteArrayContents#") [] [byteArrayPrimTy] (addrPrimTy) primOpInfo SameMutableByteArrayOp = mkGenPrimOp (fsLit "sameMutableByteArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy] (intPrimTy) primOpInfo ShrinkMutableByteArrayOp_Char = mkGenPrimOp (fsLit "shrinkMutableByteArray#") [deltaTyVar] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) @@ -361,7 +365,7 @@ primOpInfo YieldOp = mkGenPrimOp (fsLit "yield#") [] [mkStatePrimTy realWorldTy primOpInfo MyThreadIdOp = mkGenPrimOp (fsLit "myThreadId#") [] [mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, threadIdPrimTy])) primOpInfo LabelThreadOp = mkGenPrimOp (fsLit "labelThread#") [] [threadIdPrimTy, addrPrimTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) primOpInfo IsCurrentThreadBoundOp = mkGenPrimOp (fsLit "isCurrentThreadBound#") [] [mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy])) -primOpInfo NoDuplicateOp = mkGenPrimOp (fsLit "noDuplicate#") [] [mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) +primOpInfo NoDuplicateOp = mkGenPrimOp (fsLit "noDuplicate#") [deltaTyVar] [mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo ThreadStatusOp = mkGenPrimOp (fsLit "threadStatus#") [] [threadIdPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy, intPrimTy, intPrimTy])) primOpInfo MkWeakOp = mkGenPrimOp (fsLit "mkWeak#") [runtimeRep1TyVar, openAlphaTyVar, betaTyVar, gammaTyVar] [openAlphaTy, betaTy, (mkFunTy (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, gammaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy])) primOpInfo MkWeakNoFinalizerOp = mkGenPrimOp (fsLit "mkWeakNoFinalizer#") [runtimeRep1TyVar, openAlphaTyVar, betaTyVar] [openAlphaTy, betaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy])) @@ -375,6 +379,17 @@ primOpInfo EqStablePtrOp = mkGenPrimOp (fsLit "eqStablePtr#") [alphaTyVar] [mkS primOpInfo MakeStableNameOp = mkGenPrimOp (fsLit "makeStableName#") [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkStableNamePrimTy alphaTy])) primOpInfo EqStableNameOp = mkGenPrimOp (fsLit "eqStableName#") [alphaTyVar, betaTyVar] [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy] (intPrimTy) primOpInfo StableNameToIntOp = mkGenPrimOp (fsLit "stableNameToInt#") [alphaTyVar] [mkStableNamePrimTy alphaTy] (intPrimTy) +primOpInfo CompactNewOp = mkGenPrimOp (fsLit "compactNew#") [] [wordPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, compactPrimTy])) +primOpInfo CompactResizeOp = mkGenPrimOp (fsLit "compactResize#") [] [compactPrimTy, wordPrimTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) +primOpInfo CompactContainsOp = mkGenPrimOp (fsLit "compactContains#") [alphaTyVar] [compactPrimTy, alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy])) +primOpInfo CompactContainsAnyOp = mkGenPrimOp (fsLit "compactContainsAny#") [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy])) +primOpInfo CompactGetFirstBlockOp = mkGenPrimOp (fsLit "compactGetFirstBlock#") [] [compactPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, addrPrimTy, wordPrimTy])) +primOpInfo CompactGetNextBlockOp = mkGenPrimOp (fsLit "compactGetNextBlock#") [] [compactPrimTy, addrPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, addrPrimTy, wordPrimTy])) +primOpInfo CompactAllocateBlockOp = mkGenPrimOp (fsLit "compactAllocateBlock#") [] [wordPrimTy, addrPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, addrPrimTy])) +primOpInfo CompactFixupPointersOp = mkGenPrimOp (fsLit "compactFixupPointers#") [] [addrPrimTy, addrPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, compactPrimTy, addrPrimTy])) +primOpInfo CompactAdd = mkGenPrimOp (fsLit "compactAdd#") [alphaTyVar] [compactPrimTy, alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy])) +primOpInfo CompactAddWithSharing = mkGenPrimOp (fsLit "compactAddWithSharing#") [alphaTyVar] [compactPrimTy, alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy])) +primOpInfo CompactSize = mkGenPrimOp (fsLit "compactSize#") [] [compactPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, wordPrimTy])) primOpInfo ReallyUnsafePtrEqualityOp = mkGenPrimOp (fsLit "reallyUnsafePtrEquality#") [alphaTyVar] [alphaTy, alphaTy] (intPrimTy) primOpInfo ParOp = mkGenPrimOp (fsLit "par#") [alphaTyVar] [alphaTy] (intPrimTy) primOpInfo SparkOp = mkGenPrimOp (fsLit "spark#") [alphaTyVar, deltaTyVar] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) @@ -384,6 +399,7 @@ primOpInfo NumSparks = mkGenPrimOp (fsLit "numSparks#") [deltaTyVar] [mkStatePr primOpInfo DataToTagOp = mkGenPrimOp (fsLit "dataToTag#") [alphaTyVar] [alphaTy] (intPrimTy) primOpInfo TagToEnumOp = mkGenPrimOp (fsLit "tagToEnum#") [alphaTyVar] [intPrimTy] (alphaTy) primOpInfo AddrToAnyOp = mkGenPrimOp (fsLit "addrToAny#") [alphaTyVar] [addrPrimTy] ((mkTupleTy Unboxed [alphaTy])) +primOpInfo AnyToAddrOp = mkGenPrimOp (fsLit "anyToAddr#") [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, addrPrimTy])) primOpInfo MkApUpd0_Op = mkGenPrimOp (fsLit "mkApUpd0#") [alphaTyVar] [bcoPrimTy] ((mkTupleTy Unboxed [alphaTy])) primOpInfo NewBCOOp = mkGenPrimOp (fsLit "newBCO#") [alphaTyVar, deltaTyVar] [byteArrayPrimTy, byteArrayPrimTy, mkArrayPrimTy alphaTy, intPrimTy, byteArrayPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, bcoPrimTy])) primOpInfo UnpackClosureOp = mkGenPrimOp (fsLit "unpackClosure#") [alphaTyVar, betaTyVar] [alphaTy] ((mkTupleTy Unboxed [addrPrimTy, mkArrayPrimTy betaTy, byteArrayPrimTy])) diff --git a/include/prim/primop-strictness-708.hs-incl b/include/prim/primop-strictness-708.hs-incl deleted file mode 100644 index 5721a624..00000000 --- a/include/prim/primop-strictness-708.hs-incl +++ /dev/null @@ -1,12 +0,0 @@ -primOpStrictness CatchOp = \ _arity -> mkClosedStrictSig [apply1Dmd,apply2Dmd,topDmd] topRes -primOpStrictness RaiseOp = \ _arity -> mkClosedStrictSig [topDmd] botRes -primOpStrictness RaiseIOOp = \ _arity -> mkClosedStrictSig [topDmd, topDmd] botRes -primOpStrictness MaskAsyncExceptionsOp = \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes -primOpStrictness MaskUninterruptibleOp = \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes -primOpStrictness UnmaskAsyncExceptionsOp = \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes -primOpStrictness AtomicallyOp = \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes -primOpStrictness RetryOp = \ _arity -> mkClosedStrictSig [topDmd] botRes -primOpStrictness CatchRetryOp = \ _arity -> mkClosedStrictSig [apply1Dmd,apply1Dmd,topDmd] topRes -primOpStrictness CatchSTMOp = \ _arity -> mkClosedStrictSig [apply1Dmd,apply2Dmd,topDmd] topRes -primOpStrictness DataToTagOp = \ _arity -> mkClosedStrictSig [evalDmd] topRes -primOpStrictness _ = \ arity -> mkClosedStrictSig (replicate arity topDmd) topRes diff --git a/include/prim/primop-strictness-710.hs-incl b/include/prim/primop-strictness-710.hs-incl deleted file mode 100644 index 5721a624..00000000 --- a/include/prim/primop-strictness-710.hs-incl +++ /dev/null @@ -1,12 +0,0 @@ -primOpStrictness CatchOp = \ _arity -> mkClosedStrictSig [apply1Dmd,apply2Dmd,topDmd] topRes -primOpStrictness RaiseOp = \ _arity -> mkClosedStrictSig [topDmd] botRes -primOpStrictness RaiseIOOp = \ _arity -> mkClosedStrictSig [topDmd, topDmd] botRes -primOpStrictness MaskAsyncExceptionsOp = \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes -primOpStrictness MaskUninterruptibleOp = \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes -primOpStrictness UnmaskAsyncExceptionsOp = \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes -primOpStrictness AtomicallyOp = \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes -primOpStrictness RetryOp = \ _arity -> mkClosedStrictSig [topDmd] botRes -primOpStrictness CatchRetryOp = \ _arity -> mkClosedStrictSig [apply1Dmd,apply1Dmd,topDmd] topRes -primOpStrictness CatchSTMOp = \ _arity -> mkClosedStrictSig [apply1Dmd,apply2Dmd,topDmd] topRes -primOpStrictness DataToTagOp = \ _arity -> mkClosedStrictSig [evalDmd] topRes -primOpStrictness _ = \ arity -> mkClosedStrictSig (replicate arity topDmd) topRes diff --git a/include/prim/primop-strictness-800.hs-incl b/include/prim/primop-strictness-820.hs-incl similarity index 91% rename from include/prim/primop-strictness-800.hs-incl rename to include/prim/primop-strictness-820.hs-incl index 730bbf73..69a163e5 100644 --- a/include/prim/primop-strictness-800.hs-incl +++ b/include/prim/primop-strictness-820.hs-incl @@ -1,4 +1,4 @@ -primOpStrictness CatchOp = \ _arity -> mkClosedStrictSig [ catchArgDmd +primOpStrictness CatchOp = \ _arity -> mkClosedStrictSig [ lazyApply1Dmd , lazyApply2Dmd , topDmd] topRes primOpStrictness RaiseOp = \ _arity -> mkClosedStrictSig [topDmd] exnRes @@ -7,11 +7,11 @@ primOpStrictness MaskAsyncExceptionsOp = \ _arity -> mkClosedStrictSig [strictA primOpStrictness MaskUninterruptibleOp = \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topRes primOpStrictness UnmaskAsyncExceptionsOp = \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topRes primOpStrictness AtomicallyOp = \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topRes -primOpStrictness RetryOp = \ _arity -> mkClosedStrictSig [topDmd] botRes +primOpStrictness RetryOp = \ _arity -> mkClosedStrictSig [topDmd] exnRes primOpStrictness CatchRetryOp = \ _arity -> mkClosedStrictSig [ catchArgDmd , lazyApply1Dmd , topDmd ] topRes -primOpStrictness CatchSTMOp = \ _arity -> mkClosedStrictSig [ catchArgDmd +primOpStrictness CatchSTMOp = \ _arity -> mkClosedStrictSig [ lazyApply1Dmd , lazyApply2Dmd , topDmd ] topRes primOpStrictness DataToTagOp = \ _arity -> mkClosedStrictSig [evalDmd] topRes diff --git a/include/prim/primops-708.txt b/include/prim/primops-708.txt deleted file mode 100644 index 3ba2b6f7..00000000 --- a/include/prim/primops-708.txt +++ /dev/null @@ -1,3007 +0,0 @@ ------------------------------------------------------------------------ --- --- (c) 2010 The University of Glasgow --- --- Primitive Operations and Types --- --- For more information on PrimOps, see --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/PrimOps --- ------------------------------------------------------------------------ - --- This file is processed by the utility program genprimopcode to produce --- a number of include files within the compiler and optionally to produce --- human-readable documentation. --- --- It should first be preprocessed. --- --- Information on how PrimOps are implemented and the steps necessary to --- add a new one can be found in the Commentary: --- --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/PrimOps - --- This file is divided into named sections, each containing or more --- primop entries. Section headers have the format: --- --- section "section-name" {description} --- --- This information is used solely when producing documentation; it is --- otherwise ignored. The description is optional. --- --- The format of each primop entry is as follows: --- --- primop internal-name "name-in-program-text" type category {description} attributes - --- The default attribute values which apply if you don't specify --- other ones. Attribute values can be True, False, or arbitrary --- text between curly brackets. This is a kludge to enable --- processors of this file to easily get hold of simple info --- (eg, out_of_line), whilst avoiding parsing complex expressions --- needed for strictness info. - --- The vector attribute is rather special. It takes a list of 3-tuples, each of --- which is of the form . ELEM_TYPE is the type of --- the elements in the vector; LENGTH is the length of the vector; and --- SCALAR_TYPE is the scalar type used to inject to/project from vector --- element. Note that ELEM_TYPE and SCALAR_TYPE are not the same; for example, --- to broadcast a scalar value to a vector whose elements are of type Int8, we --- use an Int#. - --- When a primtype or primop has a vector attribute, it is instantiated at each --- 3-tuple in the list of 3-tuples. That is, the vector attribute allows us to --- define a family of types or primops. Vector support also adds three new --- keywords: VECTOR, SCALAR, and VECTUPLE. These keywords are expanded to types --- derived from the 3-tuple. For the 3-tuple , VECTOR expands to --- Int64X2#, SCALAR expands to INT64, and VECTUPLE expands to (# INT64, INT64 --- #). - -defaults - has_side_effects = False - out_of_line = False -- See Note Note [PrimOp can_fail and has_side_effects] in PrimOp - can_fail = False -- See Note Note [PrimOp can_fail and has_side_effects] in PrimOp - commutable = False - code_size = { primOpCodeSizeDefault } - strictness = { \ arity -> mkClosedStrictSig (replicate arity topDmd) topRes } - fixity = Nothing - llvm_only = False - vector = [] - --- Currently, documentation is produced using latex, so contents of --- description fields should be legal latex. Descriptions can contain --- matched pairs of embedded curly brackets. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - --- We need platform defines (tests for mingw32 below). - - - - - - - -section "The word size story." - {Haskell98 specifies that signed integers (type {\tt Int}) - must contain at least 30 bits. GHC always implements {\tt - Int} using the primitive type {\tt Int\#}, whose size equals - the {\tt MachDeps.h} constant {\tt WORD\_SIZE\_IN\_BITS}. - This is normally set based on the {\tt config.h} parameter - {\tt SIZEOF\_HSWORD}, i.e., 32 bits on 32-bit machines, 64 - bits on 64-bit machines. However, it can also be explicitly - set to a smaller number, e.g., 31 bits, to allow the - possibility of using tag bits. Currently GHC itself has only - 32-bit and 64-bit variants, but 30 or 31-bit code can be - exported as an external core file for use in other back ends. - - GHC also implements a primitive unsigned integer type {\tt - Word\#} which always has the same number of bits as {\tt - Int\#}. - - In addition, GHC supports families of explicit-sized integers - and words at 8, 16, 32, and 64 bits, with the usual - arithmetic operations, comparisons, and a range of - conversions. The 8-bit and 16-bit sizes are always - represented as {\tt Int\#} and {\tt Word\#}, and the - operations implemented in terms of the the primops on these - types, with suitable range restrictions on the results (using - the {\tt narrow$n$Int\#} and {\tt narrow$n$Word\#} families - of primops. The 32-bit sizes are represented using {\tt - Int\#} and {\tt Word\#} when {\tt WORD\_SIZE\_IN\_BITS} - $\geq$ 32; otherwise, these are represented using distinct - primitive types {\tt Int32\#} and {\tt Word32\#}. These (when - needed) have a complete set of corresponding operations; - however, nearly all of these are implemented as external C - functions rather than as primops. Exactly the same story - applies to the 64-bit sizes. All of these details are hidden - under the {\tt PrelInt} and {\tt PrelWord} modules, which use - {\tt \#if}-defs to invoke the appropriate types and - operators. - - Word size also matters for the families of primops for - indexing/reading/writing fixed-size quantities at offsets - from an array base, address, or foreign pointer. Here, a - slightly different approach is taken. The names of these - primops are fixed, but their {\it types} vary according to - the value of {\tt WORD\_SIZE\_IN\_BITS}. For example, if word - size is at least 32 bits then an operator like - \texttt{indexInt32Array\#} has type {\tt ByteArray\# -> Int\# - -> Int\#}; otherwise it has type {\tt ByteArray\# -> Int\# -> - Int32\#}. This approach confines the necessary {\tt - \#if}-defs to this file; no conditional compilation is needed - in the files that expose these primops. - - Finally, there are strongly deprecated primops for coercing - between {\tt Addr\#}, the primitive type of machine - addresses, and {\tt Int\#}. These are pretty bogus anyway, - but will work on existing 32-bit and 64-bit GHC targets; they - are completely bogus when tag bits are used in {\tt Int\#}, - so are not available in this case. } - --- Define synonyms for indexing ops. - - - ------------------------------------------------------------------------- -section "Char#" - {Operations on 31-bit characters.} ------------------------------------------------------------------------- - -primtype Char# - -primop CharGtOp "gtChar#" Compare Char# -> Char# -> Int# -primop CharGeOp "geChar#" Compare Char# -> Char# -> Int# - -primop CharEqOp "eqChar#" Compare - Char# -> Char# -> Int# - with commutable = True - -primop CharNeOp "neChar#" Compare - Char# -> Char# -> Int# - with commutable = True - -primop CharLtOp "ltChar#" Compare Char# -> Char# -> Int# -primop CharLeOp "leChar#" Compare Char# -> Char# -> Int# - -primop OrdOp "ord#" GenPrimOp Char# -> Int# - with code_size = 0 - ------------------------------------------------------------------------- -section "Int#" - {Operations on native-size integers (30+ bits).} ------------------------------------------------------------------------- - -primtype Int# - -primop IntAddOp "+#" Dyadic - Int# -> Int# -> Int# - with commutable = True - fixity = infixl 6 - -primop IntSubOp "-#" Dyadic Int# -> Int# -> Int# - with fixity = infixl 6 - -primop IntMulOp "*#" - Dyadic Int# -> Int# -> Int# - {Low word of signed integer multiply.} - with commutable = True - fixity = infixl 7 - -primop IntMulMayOfloOp "mulIntMayOflo#" - Dyadic Int# -> Int# -> Int# - {Return non-zero if there is any possibility that the upper word of a - signed integer multiply might contain useful information. Return - zero only if you are completely sure that no overflow can occur. - On a 32-bit platform, the recommmended implementation is to do a - 32 x 32 -> 64 signed multiply, and subtract result[63:32] from - (result[31] >>signed 31). If this is zero, meaning that the - upper word is merely a sign extension of the lower one, no - overflow can occur. - - On a 64-bit platform it is not always possible to - acquire the top 64 bits of the result. Therefore, a recommended - implementation is to take the absolute value of both operands, and - return 0 iff bits[63:31] of them are zero, since that means that their - magnitudes fit within 31 bits, so the magnitude of the product must fit - into 62 bits. - - If in doubt, return non-zero, but do make an effort to create the - correct answer for small args, since otherwise the performance of - \texttt{(*) :: Integer -> Integer -> Integer} will be poor. - } - with commutable = True - -primop IntQuotOp "quotInt#" Dyadic - Int# -> Int# -> Int# - {Rounds towards zero.} - with can_fail = True - -primop IntRemOp "remInt#" Dyadic - Int# -> Int# -> Int# - {Satisfies \texttt{(quotInt\# x y) *\# y +\# (remInt\# x y) == x}.} - with can_fail = True - -primop IntQuotRemOp "quotRemInt#" GenPrimOp - Int# -> Int# -> (# Int#, Int# #) - {Rounds towards zero.} - with can_fail = True - -primop AndIOp "andI#" Dyadic Int# -> Int# -> Int# - with commutable = True - -primop OrIOp "orI#" Dyadic Int# -> Int# -> Int# - with commutable = True - -primop XorIOp "xorI#" Dyadic Int# -> Int# -> Int# - with commutable = True - -primop NotIOp "notI#" Monadic Int# -> Int# - -primop IntNegOp "negateInt#" Monadic Int# -> Int# -primop IntAddCOp "addIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #) - {Add with carry. First member of result is (wrapped) sum; - second member is 0 iff no overflow occured.} - with code_size = 2 - -primop IntSubCOp "subIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #) - {Subtract with carry. First member of result is (wrapped) difference; - second member is 0 iff no overflow occured.} - with code_size = 2 - -primop IntGtOp ">#" Compare Int# -> Int# -> Int# - with fixity = infix 4 - -primop IntGeOp ">=#" Compare Int# -> Int# -> Int# - with fixity = infix 4 - -primop IntEqOp "==#" Compare - Int# -> Int# -> Int# - with commutable = True - fixity = infix 4 - -primop IntNeOp "/=#" Compare - Int# -> Int# -> Int# - with commutable = True - fixity = infix 4 - -primop IntLtOp "<#" Compare Int# -> Int# -> Int# - with fixity = infix 4 - -primop IntLeOp "<=#" Compare Int# -> Int# -> Int# - with fixity = infix 4 - -primop ChrOp "chr#" GenPrimOp Int# -> Char# - with code_size = 0 - -primop Int2WordOp "int2Word#" GenPrimOp Int# -> Word# - with code_size = 0 - -primop Int2FloatOp "int2Float#" GenPrimOp Int# -> Float# -primop Int2DoubleOp "int2Double#" GenPrimOp Int# -> Double# - -primop Word2FloatOp "word2Float#" GenPrimOp Word# -> Float# -primop Word2DoubleOp "word2Double#" GenPrimOp Word# -> Double# - -primop ISllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int# - {Shift left. Result undefined if shift amount is not - in the range 0 to word size - 1 inclusive.} -primop ISraOp "uncheckedIShiftRA#" GenPrimOp Int# -> Int# -> Int# - {Shift right arithmetic. Result undefined if shift amount is not - in the range 0 to word size - 1 inclusive.} -primop ISrlOp "uncheckedIShiftRL#" GenPrimOp Int# -> Int# -> Int# - {Shift right logical. Result undefined if shift amount is not - in the range 0 to word size - 1 inclusive.} - ------------------------------------------------------------------------- -section "Word#" - {Operations on native-sized unsigned words (30+ bits).} ------------------------------------------------------------------------- - -primtype Word# - -primop WordAddOp "plusWord#" Dyadic Word# -> Word# -> Word# - with commutable = True - --- Returns (# high, low #) (or equivalently, (# carry, low #)) -primop WordAdd2Op "plusWord2#" GenPrimOp - Word# -> Word# -> (# Word#, Word# #) - with commutable = True - -primop WordSubOp "minusWord#" Dyadic Word# -> Word# -> Word# - -primop WordMulOp "timesWord#" Dyadic Word# -> Word# -> Word# - with commutable = True - --- Returns (# high, low #) -primop WordMul2Op "timesWord2#" GenPrimOp - Word# -> Word# -> (# Word#, Word# #) - with commutable = True - -primop WordQuotOp "quotWord#" Dyadic Word# -> Word# -> Word# - with can_fail = True - -primop WordRemOp "remWord#" Dyadic Word# -> Word# -> Word# - with can_fail = True - -primop WordQuotRemOp "quotRemWord#" GenPrimOp - Word# -> Word# -> (# Word#, Word# #) - with can_fail = True - --- Takes high word of dividend, then low word of dividend, then divisor. --- Requires that high word is not divisible by divisor. -primop WordQuotRem2Op "quotRemWord2#" GenPrimOp - Word# -> Word# -> Word# -> (# Word#, Word# #) - with can_fail = True - -primop AndOp "and#" Dyadic Word# -> Word# -> Word# - with commutable = True - -primop OrOp "or#" Dyadic Word# -> Word# -> Word# - with commutable = True - -primop XorOp "xor#" Dyadic Word# -> Word# -> Word# - with commutable = True - -primop NotOp "not#" Monadic Word# -> Word# - -primop SllOp "uncheckedShiftL#" GenPrimOp Word# -> Int# -> Word# - {Shift left logical. Result undefined if shift amount is not - in the range 0 to word size - 1 inclusive.} -primop SrlOp "uncheckedShiftRL#" GenPrimOp Word# -> Int# -> Word# - {Shift right logical. Result undefined if shift amount is not - in the range 0 to word size - 1 inclusive.} - -primop Word2IntOp "word2Int#" GenPrimOp Word# -> Int# - with code_size = 0 - -primop WordGtOp "gtWord#" Compare Word# -> Word# -> Int# -primop WordGeOp "geWord#" Compare Word# -> Word# -> Int# -primop WordEqOp "eqWord#" Compare Word# -> Word# -> Int# -primop WordNeOp "neWord#" Compare Word# -> Word# -> Int# -primop WordLtOp "ltWord#" Compare Word# -> Word# -> Int# -primop WordLeOp "leWord#" Compare Word# -> Word# -> Int# - -primop PopCnt8Op "popCnt8#" Monadic Word# -> Word# - {Count the number of set bits in the lower 8 bits of a word.} -primop PopCnt16Op "popCnt16#" Monadic Word# -> Word# - {Count the number of set bits in the lower 16 bits of a word.} -primop PopCnt32Op "popCnt32#" Monadic Word# -> Word# - {Count the number of set bits in the lower 32 bits of a word.} -primop PopCnt64Op "popCnt64#" GenPrimOp Word64# -> Word# - {Count the number of set bits in a 64-bit word.} -primop PopCntOp "popCnt#" Monadic Word# -> Word# - {Count the number of set bits in a word.} - -primop BSwap16Op "byteSwap16#" Monadic Word# -> Word# - {Swap bytes in the lower 16 bits of a word. The higher bytes are undefined. } -primop BSwap32Op "byteSwap32#" Monadic Word# -> Word# - {Swap bytes in the lower 32 bits of a word. The higher bytes are undefined. } -primop BSwap64Op "byteSwap64#" Monadic Word64# -> Word64# - {Swap bytes in a 64 bits of a word.} -primop BSwapOp "byteSwap#" Monadic Word# -> Word# - {Swap bytes in a word.} - ------------------------------------------------------------------------- -section "Narrowings" - {Explicit narrowing of native-sized ints or words.} ------------------------------------------------------------------------- - -primop Narrow8IntOp "narrow8Int#" Monadic Int# -> Int# -primop Narrow16IntOp "narrow16Int#" Monadic Int# -> Int# -primop Narrow32IntOp "narrow32Int#" Monadic Int# -> Int# -primop Narrow8WordOp "narrow8Word#" Monadic Word# -> Word# -primop Narrow16WordOp "narrow16Word#" Monadic Word# -> Word# -primop Narrow32WordOp "narrow32Word#" Monadic Word# -> Word# - - - - ------------------------------------------------------------------------- -section "Int64#" - {Operations on 64-bit unsigned words. This type is only used - if plain {\tt Int\#} has less than 64 bits. In any case, the operations - are not primops; they are implemented (if needed) as ccalls instead.} ------------------------------------------------------------------------- - -primtype Int64# - ------------------------------------------------------------------------- -section "Word64#" - {Operations on 64-bit unsigned words. This type is only used - if plain {\tt Word\#} has less than 64 bits. In any case, the operations - are not primops; they are implemented (if needed) as ccalls instead.} ------------------------------------------------------------------------- - -primtype Word64# - - ------------------------------------------------------------------------- -section "Double#" - {Operations on double-precision (64 bit) floating-point numbers.} ------------------------------------------------------------------------- - -primtype Double# - -primop DoubleGtOp ">##" Compare Double# -> Double# -> Int# - with fixity = infix 4 - -primop DoubleGeOp ">=##" Compare Double# -> Double# -> Int# - with fixity = infix 4 - -primop DoubleEqOp "==##" Compare - Double# -> Double# -> Int# - with commutable = True - fixity = infix 4 - -primop DoubleNeOp "/=##" Compare - Double# -> Double# -> Int# - with commutable = True - fixity = infix 4 - -primop DoubleLtOp "<##" Compare Double# -> Double# -> Int# - with fixity = infix 4 - -primop DoubleLeOp "<=##" Compare Double# -> Double# -> Int# - with fixity = infix 4 - -primop DoubleAddOp "+##" Dyadic - Double# -> Double# -> Double# - with commutable = True - fixity = infixl 6 - -primop DoubleSubOp "-##" Dyadic Double# -> Double# -> Double# - with fixity = infixl 6 - -primop DoubleMulOp "*##" Dyadic - Double# -> Double# -> Double# - with commutable = True - fixity = infixl 7 - -primop DoubleDivOp "/##" Dyadic - Double# -> Double# -> Double# - with can_fail = True - fixity = infixl 7 - -primop DoubleNegOp "negateDouble#" Monadic Double# -> Double# - -primop Double2IntOp "double2Int#" GenPrimOp Double# -> Int# - {Truncates a {\tt Double#} value to the nearest {\tt Int#}. - Results are undefined if the truncation if truncation yields - a value outside the range of {\tt Int#}.} - -primop Double2FloatOp "double2Float#" GenPrimOp Double# -> Float# - -primop DoubleExpOp "expDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } - -primop DoubleLogOp "logDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } - can_fail = True - -primop DoubleSqrtOp "sqrtDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } - -primop DoubleSinOp "sinDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } - -primop DoubleCosOp "cosDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } - -primop DoubleTanOp "tanDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } - -primop DoubleAsinOp "asinDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } - can_fail = True - -primop DoubleAcosOp "acosDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } - can_fail = True - -primop DoubleAtanOp "atanDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } - -primop DoubleSinhOp "sinhDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } - -primop DoubleCoshOp "coshDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } - -primop DoubleTanhOp "tanhDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } - -primop DoublePowerOp "**##" Dyadic - Double# -> Double# -> Double# - {Exponentiation.} - with - code_size = { primOpCodeSizeForeignCall } - -primop DoubleDecode_2IntOp "decodeDouble_2Int#" GenPrimOp - Double# -> (# Int#, Word#, Word#, Int# #) - {Convert to integer. - First component of the result is -1 or 1, indicating the sign of the - mantissa. The next two are the high and low 32 bits of the mantissa - respectively, and the last is the exponent.} - with out_of_line = True - ------------------------------------------------------------------------- -section "Float#" - {Operations on single-precision (32-bit) floating-point numbers.} ------------------------------------------------------------------------- - -primtype Float# - -primop FloatGtOp "gtFloat#" Compare Float# -> Float# -> Int# -primop FloatGeOp "geFloat#" Compare Float# -> Float# -> Int# - -primop FloatEqOp "eqFloat#" Compare - Float# -> Float# -> Int# - with commutable = True - -primop FloatNeOp "neFloat#" Compare - Float# -> Float# -> Int# - with commutable = True - -primop FloatLtOp "ltFloat#" Compare Float# -> Float# -> Int# -primop FloatLeOp "leFloat#" Compare Float# -> Float# -> Int# - -primop FloatAddOp "plusFloat#" Dyadic - Float# -> Float# -> Float# - with commutable = True - -primop FloatSubOp "minusFloat#" Dyadic Float# -> Float# -> Float# - -primop FloatMulOp "timesFloat#" Dyadic - Float# -> Float# -> Float# - with commutable = True - -primop FloatDivOp "divideFloat#" Dyadic - Float# -> Float# -> Float# - with can_fail = True - -primop FloatNegOp "negateFloat#" Monadic Float# -> Float# - -primop Float2IntOp "float2Int#" GenPrimOp Float# -> Int# - {Truncates a {\tt Float#} value to the nearest {\tt Int#}. - Results are undefined if the truncation if truncation yields - a value outside the range of {\tt Int#}.} - -primop FloatExpOp "expFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - -primop FloatLogOp "logFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - can_fail = True - -primop FloatSqrtOp "sqrtFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - -primop FloatSinOp "sinFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - -primop FloatCosOp "cosFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - -primop FloatTanOp "tanFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - -primop FloatAsinOp "asinFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - can_fail = True - -primop FloatAcosOp "acosFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - can_fail = True - -primop FloatAtanOp "atanFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - -primop FloatSinhOp "sinhFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - -primop FloatCoshOp "coshFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - -primop FloatTanhOp "tanhFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - -primop FloatPowerOp "powerFloat#" Dyadic - Float# -> Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - -primop Float2DoubleOp "float2Double#" GenPrimOp Float# -> Double# - -primop FloatDecode_IntOp "decodeFloat_Int#" GenPrimOp - Float# -> (# Int#, Int# #) - {Convert to integers. - First {\tt Int\#} in result is the mantissa; second is the exponent.} - with out_of_line = True - ------------------------------------------------------------------------- -section "Arrays" - {Operations on {\tt Array\#}.} ------------------------------------------------------------------------- - -primtype Array# a - -primtype MutableArray# s a - -primop NewArrayOp "newArray#" GenPrimOp - Int# -> a -> State# s -> (# State# s, MutableArray# s a #) - {Create a new mutable array with the specified number of elements, - in the specified state thread, - with each element containing the specified initial value.} - with - out_of_line = True - has_side_effects = True - -primop SameMutableArrayOp "sameMutableArray#" GenPrimOp - MutableArray# s a -> MutableArray# s a -> Int# - -primop ReadArrayOp "readArray#" GenPrimOp - MutableArray# s a -> Int# -> State# s -> (# State# s, a #) - {Read from specified index of mutable array. Result is not yet evaluated.} - with - has_side_effects = True - can_fail = True - -primop WriteArrayOp "writeArray#" GenPrimOp - MutableArray# s a -> Int# -> a -> State# s -> State# s - {Write to specified index of mutable array.} - with - has_side_effects = True - can_fail = True - code_size = 2 -- card update too - -primop SizeofArrayOp "sizeofArray#" GenPrimOp - Array# a -> Int# - {Return the number of elements in the array.} - -primop SizeofMutableArrayOp "sizeofMutableArray#" GenPrimOp - MutableArray# s a -> Int# - {Return the number of elements in the array.} - -primop IndexArrayOp "indexArray#" GenPrimOp - Array# a -> Int# -> (# a #) - {Read from specified index of immutable array. Result is packaged into - an unboxed singleton; the result itself is not yet evaluated.} - with - can_fail = True - -primop UnsafeFreezeArrayOp "unsafeFreezeArray#" GenPrimOp - MutableArray# s a -> State# s -> (# State# s, Array# a #) - {Make a mutable array immutable, without copying.} - with - has_side_effects = True - -primop UnsafeThawArrayOp "unsafeThawArray#" GenPrimOp - Array# a -> State# s -> (# State# s, MutableArray# s a #) - {Make an immutable array mutable, without copying.} - with - out_of_line = True - has_side_effects = True - -primop CopyArrayOp "copyArray#" GenPrimOp - Array# a -> Int# -> MutableArray# s a -> Int# -> Int# -> State# s -> State# s - {Copy a range of the Array# to the specified region in the MutableArray#. - Both arrays must fully contain the specified ranges, but this is not checked. - The two arrays must not be the same array in different states, but this is not checked either.} - with - has_side_effects = True - can_fail = True - code_size = { primOpCodeSizeForeignCall + 4 } - -primop CopyMutableArrayOp "copyMutableArray#" GenPrimOp - MutableArray# s a -> Int# -> MutableArray# s a -> Int# -> Int# -> State# s -> State# s - {Copy a range of the first MutableArray# to the specified region in the second MutableArray#. - Both arrays must fully contain the specified ranges, but this is not checked.} - with - has_side_effects = True - can_fail = True - code_size = { primOpCodeSizeForeignCall + 4 } - -primop CloneArrayOp "cloneArray#" GenPrimOp - Array# a -> Int# -> Int# -> Array# a - {Return a newly allocated Array# with the specified subrange of the provided Array#. - The provided Array# should contain the full subrange specified by the two Int#s, but this is not checked.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4 } - -primop CloneMutableArrayOp "cloneMutableArray#" GenPrimOp - MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #) - {Return a newly allocated Array# with the specified subrange of the provided Array#. - The provided MutableArray# should contain the full subrange specified by the two Int#s, but this is not checked.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4 } - -primop FreezeArrayOp "freezeArray#" GenPrimOp - MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, Array# a #) - {Return a newly allocated Array# with the specified subrange of the provided MutableArray#. - The provided MutableArray# should contain the full subrange specified by the two Int#s, but this is not checked.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4 } - -primop ThawArrayOp "thawArray#" GenPrimOp - Array# a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #) - {Return a newly allocated Array# with the specified subrange of the provided MutableArray#. - The provided Array# should contain the full subrange specified by the two Int#s, but this is not checked.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4 } - -primop CasArrayOp "casArray#" GenPrimOp - MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #) - {Unsafe, machine-level atomic compare and swap on an element within an Array.} - with - out_of_line = True - has_side_effects = True - - ------------------------------------------------------------------------- -section "Byte Arrays" - {Operations on {\tt ByteArray\#}. A {\tt ByteArray\#} is a just a region of - raw memory in the garbage-collected heap, which is not - scanned for pointers. It carries its own size (in bytes). - There are - three sets of operations for accessing byte array contents: - index for reading from immutable byte arrays, and read/write - for mutable byte arrays. Each set contains operations for a - range of useful primitive data types. Each operation takes - an offset measured in terms of the size of the primitive type - being read or written.} - ------------------------------------------------------------------------- - -primtype ByteArray# - -primtype MutableByteArray# s - -primop NewByteArrayOp_Char "newByteArray#" GenPrimOp - Int# -> State# s -> (# State# s, MutableByteArray# s #) - {Create a new mutable byte array of specified size (in bytes), in - the specified state thread.} - with out_of_line = True - has_side_effects = True - -primop NewPinnedByteArrayOp_Char "newPinnedByteArray#" GenPrimOp - Int# -> State# s -> (# State# s, MutableByteArray# s #) - {Create a mutable byte array that the GC guarantees not to move.} - with out_of_line = True - has_side_effects = True - -primop NewAlignedPinnedByteArrayOp_Char "newAlignedPinnedByteArray#" GenPrimOp - Int# -> Int# -> State# s -> (# State# s, MutableByteArray# s #) - {Create a mutable byte array, aligned by the specified amount, that the GC guarantees not to move.} - with out_of_line = True - has_side_effects = True - -primop ByteArrayContents_Char "byteArrayContents#" GenPrimOp - ByteArray# -> Addr# - {Intended for use with pinned arrays; otherwise very unsafe!} - -primop SameMutableByteArrayOp "sameMutableByteArray#" GenPrimOp - MutableByteArray# s -> MutableByteArray# s -> Int# - -primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp - MutableByteArray# s -> State# s -> (# State# s, ByteArray# #) - {Make a mutable byte array immutable, without copying.} - with - has_side_effects = True - -primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp - ByteArray# -> Int# - {Return the size of the array in bytes.} - -primop SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp - MutableByteArray# s -> Int# - {Return the size of the array in bytes.} - -primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read 31-bit character; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp - ByteArray# -> Int# -> Int# - with can_fail = True - -primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp - ByteArray# -> Int# -> Word# - with can_fail = True - -primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp - ByteArray# -> Int# -> Addr# - with can_fail = True - -primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp - ByteArray# -> Int# -> Float# - with can_fail = True - -primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp - ByteArray# -> Int# -> Double# - with can_fail = True - -primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp - ByteArray# -> Int# -> StablePtr# a - with can_fail = True - -primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp - ByteArray# -> Int# -> Int# - with can_fail = True - -primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp - ByteArray# -> Int# -> Int# - with can_fail = True - -primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp - ByteArray# -> Int# -> Int# - with can_fail = True - -primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp - ByteArray# -> Int# -> Int64# - with can_fail = True - -primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp - ByteArray# -> Int# -> Word# - with can_fail = True - -primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp - ByteArray# -> Int# -> Word# - with can_fail = True - -primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp - ByteArray# -> Int# -> Word# - with can_fail = True - -primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp - ByteArray# -> Int# -> Word64# - with can_fail = True - -primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read 31-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int "readIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word "readWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Addr "readAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Float "readFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Double "readDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int8 "readInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #) - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #) - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Char "writeCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write 31-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int "writeIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word "writeWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Addr "writeAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Float "writeFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> Float# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Double "writeDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> Double# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_StablePtr "writeStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int8 "writeInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s - with can_fail = True - has_side_effects = True - -primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word16 "writeWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop CopyByteArrayOp "copyByteArray#" GenPrimOp - ByteArray# -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Copy a range of the ByteArray# to the specified region in the MutableByteArray#. - Both arrays must fully contain the specified ranges, but this is not checked. - The two arrays must not be the same array in different states, but this is not checked either.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4} - can_fail = True - -primop CopyMutableByteArrayOp "copyMutableByteArray#" GenPrimOp - MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Copy a range of the first MutableByteArray# to the specified region in the second MutableByteArray#. - Both arrays must fully contain the specified ranges, but this is not checked.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4 } - can_fail = True - -primop CopyByteArrayToAddrOp "copyByteArrayToAddr#" GenPrimOp - ByteArray# -> Int# -> Addr# -> Int# -> State# s -> State# s - {Copy a range of the ByteArray# to the memory range starting at the Addr#. - The ByteArray# and the memory region at Addr# must fully contain the - specified ranges, but this is not checked. The Addr# must not point into the - ByteArray# (e.g. if the ByteArray# were pinned), but this is not checked - either.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4} - can_fail = True - -primop CopyMutableByteArrayToAddrOp "copyMutableByteArrayToAddr#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> Int# -> State# s -> State# s - {Copy a range of the MutableByteArray# to the memory range starting at the - Addr#. The MutableByteArray# and the memory region at Addr# must fully - contain the specified ranges, but this is not checked. The Addr# must not - point into the MutableByteArray# (e.g. if the MutableByteArray# were - pinned), but this is not checked either.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4} - can_fail = True - -primop CopyAddrToByteArrayOp "copyAddrToByteArray#" GenPrimOp - Addr# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Copy a memory range starting at the Addr# to the specified range in the - MutableByteArray#. The memory region at Addr# and the ByteArray# must fully - contain the specified ranges, but this is not checked. The Addr# must not - point into the MutableByteArray# (e.g. if the MutableByteArray# were pinned), - but this is not checked either.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4} - can_fail = True - -primop SetByteArrayOp "setByteArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> State# s - {Set the range of the MutableByteArray# to the specified character.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4 } - can_fail = True - -primop CasByteArrayOp_Int "casIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> (# State# s, Int# #) - {Machine-level atomic compare and swap on a word within a ByteArray.} - with - out_of_line = True - has_side_effects = True - -primop FetchAddByteArrayOp_Int "fetchAddIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) - {Machine-level word-sized fetch-and-add within a ByteArray.} - with - out_of_line = True - has_side_effects = True - - ------------------------------------------------------------------------- -section "Arrays of arrays" - {Operations on {\tt ArrayArray\#}. An {\tt ArrayArray\#} contains references to {\em unpointed} - arrays, such as {\tt ByteArray\#s}. Hence, it is not parameterised by the element types, - just like a {\tt ByteArray\#}, but it needs to be scanned during GC, just like an {\tt Array#}. - We represent an {\tt ArrayArray\#} exactly as a {\tt Array\#}, but provide element-type-specific - indexing, reading, and writing.} ------------------------------------------------------------------------- - -primtype ArrayArray# - -primtype MutableArrayArray# s - -primop NewArrayArrayOp "newArrayArray#" GenPrimOp - Int# -> State# s -> (# State# s, MutableArrayArray# s #) - {Create a new mutable array of arrays with the specified number of elements, - in the specified state thread, with each element recursively referring to the - newly created array.} - with - out_of_line = True - has_side_effects = True - -primop SameMutableArrayArrayOp "sameMutableArrayArray#" GenPrimOp - MutableArrayArray# s -> MutableArrayArray# s -> Int# - -primop UnsafeFreezeArrayArrayOp "unsafeFreezeArrayArray#" GenPrimOp - MutableArrayArray# s -> State# s -> (# State# s, ArrayArray# #) - {Make a mutable array of arrays immutable, without copying.} - with - has_side_effects = True - -primop SizeofArrayArrayOp "sizeofArrayArray#" GenPrimOp - ArrayArray# -> Int# - {Return the number of elements in the array.} - -primop SizeofMutableArrayArrayOp "sizeofMutableArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# - {Return the number of elements in the array.} - -primop IndexArrayArrayOp_ByteArray "indexByteArrayArray#" GenPrimOp - ArrayArray# -> Int# -> ByteArray# - with can_fail = True - -primop IndexArrayArrayOp_ArrayArray "indexArrayArrayArray#" GenPrimOp - ArrayArray# -> Int# -> ArrayArray# - with can_fail = True - -primop ReadArrayArrayOp_ByteArray "readByteArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> State# s -> (# State# s, ByteArray# #) - with has_side_effects = True - can_fail = True - -primop ReadArrayArrayOp_MutableByteArray "readMutableByteArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #) - with has_side_effects = True - can_fail = True - -primop ReadArrayArrayOp_ArrayArray "readArrayArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> State# s -> (# State# s, ArrayArray# #) - with has_side_effects = True - can_fail = True - -primop ReadArrayArrayOp_MutableArrayArray "readMutableArrayArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableArrayArray# s #) - with has_side_effects = True - can_fail = True - -primop WriteArrayArrayOp_ByteArray "writeByteArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> ByteArray# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteArrayArrayOp_MutableByteArray "writeMutableByteArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> MutableByteArray# s -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteArrayArrayOp_ArrayArray "writeArrayArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> ArrayArray# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteArrayArrayOp_MutableArrayArray "writeMutableArrayArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> MutableArrayArray# s -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop CopyArrayArrayOp "copyArrayArray#" GenPrimOp - ArrayArray# -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s - {Copy a range of the ArrayArray# to the specified region in the MutableArrayArray#. - Both arrays must fully contain the specified ranges, but this is not checked. - The two arrays must not be the same array in different states, but this is not checked either.} - with - has_side_effects = True - can_fail = True - code_size = { primOpCodeSizeForeignCall } - -primop CopyMutableArrayArrayOp "copyMutableArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s - {Copy a range of the first MutableArrayArray# to the specified region in the second - MutableArrayArray#. - Both arrays must fully contain the specified ranges, but this is not checked.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall } - can_fail = True - ------------------------------------------------------------------------- -section "Addr#" ------------------------------------------------------------------------- - -primtype Addr# - { An arbitrary machine address assumed to point outside - the garbage-collected heap. } - -pseudoop "nullAddr#" Addr# - { The null address. } - -primop AddrAddOp "plusAddr#" GenPrimOp Addr# -> Int# -> Addr# -primop AddrSubOp "minusAddr#" GenPrimOp Addr# -> Addr# -> Int# - {Result is meaningless if two {\tt Addr\#}s are so far apart that their - difference doesn't fit in an {\tt Int\#}.} -primop AddrRemOp "remAddr#" GenPrimOp Addr# -> Int# -> Int# - {Return the remainder when the {\tt Addr\#} arg, treated like an {\tt Int\#}, - is divided by the {\tt Int\#} arg.} -primop Addr2IntOp "addr2Int#" GenPrimOp Addr# -> Int# - {Coerce directly from address to int. Strongly deprecated.} - with code_size = 0 -primop Int2AddrOp "int2Addr#" GenPrimOp Int# -> Addr# - {Coerce directly from int to address. Strongly deprecated.} - with code_size = 0 - -primop AddrGtOp "gtAddr#" Compare Addr# -> Addr# -> Int# -primop AddrGeOp "geAddr#" Compare Addr# -> Addr# -> Int# -primop AddrEqOp "eqAddr#" Compare Addr# -> Addr# -> Int# -primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Int# -primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Int# -primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Int# - -primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 31-bit character; offset in 4-byte words.} - with can_fail = True - -primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# - with can_fail = True - -primop IndexOffAddrOp_Word "indexWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# - with can_fail = True - -primop IndexOffAddrOp_Addr "indexAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# - with can_fail = True - -primop IndexOffAddrOp_Float "indexFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# - with can_fail = True - -primop IndexOffAddrOp_Double "indexDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# - with can_fail = True - -primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a - with can_fail = True - -primop IndexOffAddrOp_Int8 "indexInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int# - with can_fail = True - -primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int# - with can_fail = True - -primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int# - with can_fail = True - -primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# - with can_fail = True - -primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word# - with can_fail = True - -primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word# - with can_fail = True - -primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word# - with can_fail = True - -primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# - with can_fail = True - -primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 31-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word "readWordOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Addr "readAddrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Addr# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Float "readFloatOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Float# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Double# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int8 "readInt8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int64# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word64# #) - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_WideChar "writeWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word "writeWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Double "writeDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int8 "writeInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word16 "writeWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# -> State# s -> State# s - with has_side_effects = True - can_fail = True - ------------------------------------------------------------------------- -section "Mutable variables" - {Operations on MutVar\#s.} ------------------------------------------------------------------------- - -primtype MutVar# s a - {A {\tt MutVar\#} behaves like a single-element mutable array.} - -primop NewMutVarOp "newMutVar#" GenPrimOp - a -> State# s -> (# State# s, MutVar# s a #) - {Create {\tt MutVar\#} with specified initial value in specified state thread.} - with - out_of_line = True - has_side_effects = True - -primop ReadMutVarOp "readMutVar#" GenPrimOp - MutVar# s a -> State# s -> (# State# s, a #) - {Read contents of {\tt MutVar\#}. Result is not yet evaluated.} - with - has_side_effects = True - can_fail = True - -primop WriteMutVarOp "writeMutVar#" GenPrimOp - MutVar# s a -> a -> State# s -> State# s - {Write contents of {\tt MutVar\#}.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall } -- for the write barrier - can_fail = True - -primop SameMutVarOp "sameMutVar#" GenPrimOp - MutVar# s a -> MutVar# s a -> Int# - --- not really the right type, but we don't know about pairs here. The --- correct type is --- --- MutVar# s a -> (a -> (a,b)) -> State# s -> (# State# s, b #) --- -primop AtomicModifyMutVarOp "atomicModifyMutVar#" GenPrimOp - MutVar# s a -> (a -> b) -> State# s -> (# State# s, c #) - with - out_of_line = True - has_side_effects = True - can_fail = True - -primop CasMutVarOp "casMutVar#" GenPrimOp - MutVar# s a -> a -> a -> State# s -> (# State# s, Int#, a #) - with - out_of_line = True - has_side_effects = True - ------------------------------------------------------------------------- -section "Exceptions" ------------------------------------------------------------------------- - -primop CatchOp "catch#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #) ) - -> (b -> State# RealWorld -> (# State# RealWorld, a #) ) - -> State# RealWorld - -> (# State# RealWorld, a #) - with - -- Catch is actually strict in its first argument - -- but we don't want to tell the strictness - -- analyser about that, so that exceptions stay inside it. - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,apply2Dmd,topDmd] topRes } - out_of_line = True - has_side_effects = True - -primop RaiseOp "raise#" GenPrimOp - a -> b - with - strictness = { \ _arity -> mkClosedStrictSig [topDmd] botRes } - -- NB: result is bottom - out_of_line = True - --- raiseIO# needs to be a primop, because exceptions in the IO monad --- must be *precise* - we don't want the strictness analyser turning --- one kind of bottom into another, as it is allowed to do in pure code. --- --- But we *do* want to know that it returns bottom after --- being applied to two arguments, so that this function is strict in y --- f x y | x>0 = raiseIO blah --- | y>0 = return 1 --- | otherwise = return 2 - -primop RaiseIOOp "raiseIO#" GenPrimOp - a -> State# RealWorld -> (# State# RealWorld, b #) - with - strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] botRes } - out_of_line = True - has_side_effects = True - -primop MaskAsyncExceptionsOp "maskAsyncExceptions#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #)) - -> (State# RealWorld -> (# State# RealWorld, a #)) - with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes } - out_of_line = True - has_side_effects = True - -primop MaskUninterruptibleOp "maskUninterruptible#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #)) - -> (State# RealWorld -> (# State# RealWorld, a #)) - with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes } - out_of_line = True - has_side_effects = True - -primop UnmaskAsyncExceptionsOp "unmaskAsyncExceptions#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #)) - -> (State# RealWorld -> (# State# RealWorld, a #)) - with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes } - out_of_line = True - has_side_effects = True - -primop MaskStatus "getMaskingState#" GenPrimOp - State# RealWorld -> (# State# RealWorld, Int# #) - with - out_of_line = True - has_side_effects = True - ------------------------------------------------------------------------- -section "STM-accessible Mutable Variables" ------------------------------------------------------------------------- - -primtype TVar# s a - -primop AtomicallyOp "atomically#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #) ) - -> State# RealWorld -> (# State# RealWorld, a #) - with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes } - out_of_line = True - has_side_effects = True - --- NB: retry#'s strictness information specifies it to return bottom. --- This lets the compiler perform some extra simplifications, since retry# --- will technically never return. --- --- This allows the simplifier to replace things like: --- case retry# s1 --- (# s2, a #) -> e --- with: --- retry# s1 --- where 'e' would be unreachable anyway. See Trac #8091. -primop RetryOp "retry#" GenPrimOp - State# RealWorld -> (# State# RealWorld, a #) - with - strictness = { \ _arity -> mkClosedStrictSig [topDmd] botRes } - out_of_line = True - has_side_effects = True - -primop CatchRetryOp "catchRetry#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #) ) - -> (State# RealWorld -> (# State# RealWorld, a #) ) - -> (State# RealWorld -> (# State# RealWorld, a #) ) - with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,apply1Dmd,topDmd] topRes } - out_of_line = True - has_side_effects = True - -primop CatchSTMOp "catchSTM#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #) ) - -> (b -> State# RealWorld -> (# State# RealWorld, a #) ) - -> (State# RealWorld -> (# State# RealWorld, a #) ) - with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,apply2Dmd,topDmd] topRes } - out_of_line = True - has_side_effects = True - -primop Check "check#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #) ) - -> (State# RealWorld -> (# State# RealWorld, () #) ) - with - out_of_line = True - has_side_effects = True - -primop NewTVarOp "newTVar#" GenPrimOp - a - -> State# s -> (# State# s, TVar# s a #) - {Create a new {\tt TVar\#} holding a specified initial value.} - with - out_of_line = True - has_side_effects = True - -primop ReadTVarOp "readTVar#" GenPrimOp - TVar# s a - -> State# s -> (# State# s, a #) - {Read contents of {\tt TVar\#}. Result is not yet evaluated.} - with - out_of_line = True - has_side_effects = True - -primop ReadTVarIOOp "readTVarIO#" GenPrimOp - TVar# s a - -> State# s -> (# State# s, a #) - {Read contents of {\tt TVar\#} outside an STM transaction} - with - out_of_line = True - has_side_effects = True - -primop WriteTVarOp "writeTVar#" GenPrimOp - TVar# s a - -> a - -> State# s -> State# s - {Write contents of {\tt TVar\#}.} - with - out_of_line = True - has_side_effects = True - -primop SameTVarOp "sameTVar#" GenPrimOp - TVar# s a -> TVar# s a -> Int# - - ------------------------------------------------------------------------- -section "Synchronized Mutable Variables" - {Operations on {\tt MVar\#}s. } ------------------------------------------------------------------------- - -primtype MVar# s a - { A shared mutable variable ({\it not} the same as a {\tt MutVar\#}!). - (Note: in a non-concurrent implementation, {\tt (MVar\# a)} can be - represented by {\tt (MutVar\# (Maybe a))}.) } - -primop NewMVarOp "newMVar#" GenPrimOp - State# s -> (# State# s, MVar# s a #) - {Create new {\tt MVar\#}; initially empty.} - with - out_of_line = True - has_side_effects = True - -primop TakeMVarOp "takeMVar#" GenPrimOp - MVar# s a -> State# s -> (# State# s, a #) - {If {\tt MVar\#} is empty, block until it becomes full. - Then remove and return its contents, and set it empty.} - with - out_of_line = True - has_side_effects = True - -primop TryTakeMVarOp "tryTakeMVar#" GenPrimOp - MVar# s a -> State# s -> (# State# s, Int#, a #) - {If {\tt MVar\#} is empty, immediately return with integer 0 and value undefined. - Otherwise, return with integer 1 and contents of {\tt MVar\#}, and set {\tt MVar\#} empty.} - with - out_of_line = True - has_side_effects = True - -primop PutMVarOp "putMVar#" GenPrimOp - MVar# s a -> a -> State# s -> State# s - {If {\tt MVar\#} is full, block until it becomes empty. - Then store value arg as its new contents.} - with - out_of_line = True - has_side_effects = True - -primop TryPutMVarOp "tryPutMVar#" GenPrimOp - MVar# s a -> a -> State# s -> (# State# s, Int# #) - {If {\tt MVar\#} is full, immediately return with integer 0. - Otherwise, store value arg as {\tt MVar\#}'s new contents, and return with integer 1.} - with - out_of_line = True - has_side_effects = True - -primop ReadMVarOp "readMVar#" GenPrimOp - MVar# s a -> State# s -> (# State# s, a #) - {If {\tt MVar\#} is empty, block until it becomes full. - Then read its contents without modifying the MVar, without possibility - of intervention from other threads.} - with - out_of_line = True - has_side_effects = True - -primop TryReadMVarOp "tryReadMVar#" GenPrimOp - MVar# s a -> State# s -> (# State# s, Int#, a #) - {If {\tt MVar\#} is empty, immediately return with integer 0 and value undefined. - Otherwise, return with integer 1 and contents of {\tt MVar\#}.} - with - out_of_line = True - has_side_effects = True - -primop SameMVarOp "sameMVar#" GenPrimOp - MVar# s a -> MVar# s a -> Int# - -primop IsEmptyMVarOp "isEmptyMVar#" GenPrimOp - MVar# s a -> State# s -> (# State# s, Int# #) - {Return 1 if {\tt MVar\#} is empty; 0 otherwise.} - with - out_of_line = True - has_side_effects = True - ------------------------------------------------------------------------- -section "Delay/wait operations" ------------------------------------------------------------------------- - -primop DelayOp "delay#" GenPrimOp - Int# -> State# s -> State# s - {Sleep specified number of microseconds.} - with - has_side_effects = True - out_of_line = True - -primop WaitReadOp "waitRead#" GenPrimOp - Int# -> State# s -> State# s - {Block until input is available on specified file descriptor.} - with - has_side_effects = True - out_of_line = True - -primop WaitWriteOp "waitWrite#" GenPrimOp - Int# -> State# s -> State# s - {Block until output is possible on specified file descriptor.} - with - has_side_effects = True - out_of_line = True - - ------------------------------------------------------------------------- -section "Concurrency primitives" ------------------------------------------------------------------------- - -primtype State# s - { {\tt State\#} is the primitive, unlifted type of states. It has - one type parameter, thus {\tt State\# RealWorld}, or {\tt State\# s}, - where s is a type variable. The only purpose of the type parameter - is to keep different state threads separate. It is represented by - nothing at all. } - -primtype RealWorld - { {\tt RealWorld} is deeply magical. It is {\it primitive}, but it is not - {\it unlifted} (hence {\tt ptrArg}). We never manipulate values of type - {\tt RealWorld}; it's only used in the type system, to parameterise {\tt State\#}. } - -primtype ThreadId# - {(In a non-concurrent implementation, this can be a singleton - type, whose (unique) value is returned by {\tt myThreadId\#}. The - other operations can be omitted.)} - -primop ForkOp "fork#" GenPrimOp - a -> State# RealWorld -> (# State# RealWorld, ThreadId# #) - with - has_side_effects = True - out_of_line = True - -primop ForkOnOp "forkOn#" GenPrimOp - Int# -> a -> State# RealWorld -> (# State# RealWorld, ThreadId# #) - with - has_side_effects = True - out_of_line = True - -primop KillThreadOp "killThread#" GenPrimOp - ThreadId# -> a -> State# RealWorld -> State# RealWorld - with - has_side_effects = True - out_of_line = True - -primop YieldOp "yield#" GenPrimOp - State# RealWorld -> State# RealWorld - with - has_side_effects = True - out_of_line = True - -primop MyThreadIdOp "myThreadId#" GenPrimOp - State# RealWorld -> (# State# RealWorld, ThreadId# #) - with - out_of_line = True - has_side_effects = True - -primop LabelThreadOp "labelThread#" GenPrimOp - ThreadId# -> Addr# -> State# RealWorld -> State# RealWorld - with - has_side_effects = True - out_of_line = True - -primop IsCurrentThreadBoundOp "isCurrentThreadBound#" GenPrimOp - State# RealWorld -> (# State# RealWorld, Int# #) - with - out_of_line = True - has_side_effects = True - -primop NoDuplicateOp "noDuplicate#" GenPrimOp - State# RealWorld -> State# RealWorld - with - out_of_line = True - has_side_effects = True - -primop ThreadStatusOp "threadStatus#" GenPrimOp - ThreadId# -> State# RealWorld -> (# State# RealWorld, Int#, Int#, Int# #) - with - out_of_line = True - has_side_effects = True - ------------------------------------------------------------------------- -section "Weak pointers" ------------------------------------------------------------------------- - -primtype Weak# b - --- note that tyvar "o" denotes openAlphaTyVar - -primop MkWeakOp "mkWeak#" GenPrimOp - o -> b -> c -> State# RealWorld -> (# State# RealWorld, Weak# b #) - with - has_side_effects = True - out_of_line = True - -primop MkWeakNoFinalizerOp "mkWeakNoFinalizer#" GenPrimOp - o -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #) - with - has_side_effects = True - out_of_line = True - -primop AddCFinalizerToWeakOp "addCFinalizerToWeak#" GenPrimOp - Addr# -> Addr# -> Int# -> Addr# -> Weak# b - -> State# RealWorld -> (# State# RealWorld, Int# #) - { {\tt addCFinalizerToWeak# fptr ptr flag eptr w} attaches a C - function pointer {\tt fptr} to a weak pointer {\tt w} as a finalizer. If - {\tt flag} is zero, {\tt fptr} will be called with one argument, - {\tt ptr}. Otherwise, it will be called with two arguments, - {\tt eptr} and {\tt ptr}. {\tt addCFinalizerToWeak#} returns - 1 on success, or 0 if {\tt w} is already dead. } - with - has_side_effects = True - out_of_line = True - -primop DeRefWeakOp "deRefWeak#" GenPrimOp - Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, a #) - with - has_side_effects = True - out_of_line = True - -primop FinalizeWeakOp "finalizeWeak#" GenPrimOp - Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, - (State# RealWorld -> (# State# RealWorld, () #)) #) - with - has_side_effects = True - out_of_line = True - -primop TouchOp "touch#" GenPrimOp - o -> State# RealWorld -> State# RealWorld - with - code_size = { 0 } - has_side_effects = True - ------------------------------------------------------------------------- -section "Stable pointers and names" ------------------------------------------------------------------------- - -primtype StablePtr# a - -primtype StableName# a - -primop MakeStablePtrOp "makeStablePtr#" GenPrimOp - a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #) - with - has_side_effects = True - out_of_line = True - -primop DeRefStablePtrOp "deRefStablePtr#" GenPrimOp - StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #) - with - has_side_effects = True - out_of_line = True - -primop EqStablePtrOp "eqStablePtr#" GenPrimOp - StablePtr# a -> StablePtr# a -> Int# - with - has_side_effects = True - -primop MakeStableNameOp "makeStableName#" GenPrimOp - a -> State# RealWorld -> (# State# RealWorld, StableName# a #) - with - has_side_effects = True - out_of_line = True - -primop EqStableNameOp "eqStableName#" GenPrimOp - StableName# a -> StableName# b -> Int# - -primop StableNameToIntOp "stableNameToInt#" GenPrimOp - StableName# a -> Int# - ------------------------------------------------------------------------- -section "Unsafe pointer equality" --- (#1 Bad Guy: Alistair Reid :) ------------------------------------------------------------------------- - -primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp - a -> a -> Int# - ------------------------------------------------------------------------- -section "Parallelism" ------------------------------------------------------------------------- - -primop ParOp "par#" GenPrimOp - a -> Int# - with - -- Note that Par is lazy to avoid that the sparked thing - -- gets evaluted strictly, which it should *not* be - has_side_effects = True - code_size = { primOpCodeSizeForeignCall } - -primop SparkOp "spark#" GenPrimOp - a -> State# s -> (# State# s, a #) - with has_side_effects = True - code_size = { primOpCodeSizeForeignCall } - -primop SeqOp "seq#" GenPrimOp - a -> State# s -> (# State# s, a #) - - -- why return the value? So that we can control sharing of seq'd - -- values: in - -- let x = e in x `seq` ... x ... - -- we don't want to inline x, so better to represent it as - -- let x = e in case seq# x RW of (# _, x' #) -> ... x' ... - -- also it matches the type of rseq in the Eval monad. - -primop GetSparkOp "getSpark#" GenPrimOp - State# s -> (# State# s, Int#, a #) - with - has_side_effects = True - out_of_line = True - -primop NumSparks "numSparks#" GenPrimOp - State# s -> (# State# s, Int# #) - { Returns the number of sparks in the local spark pool. } - with - has_side_effects = True - out_of_line = True - --- HWL: The first 4 Int# in all par... annotations denote: --- name, granularity info, size of result, degree of parallelism --- Same structure as _seq_ i.e. returns Int# --- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine --- `the processor containing the expression v'; it is not evaluated - -primop ParGlobalOp "parGlobal#" GenPrimOp - a -> Int# -> Int# -> Int# -> Int# -> b -> Int# - with - has_side_effects = True - -primop ParLocalOp "parLocal#" GenPrimOp - a -> Int# -> Int# -> Int# -> Int# -> b -> Int# - with - has_side_effects = True - -primop ParAtOp "parAt#" GenPrimOp - b -> a -> Int# -> Int# -> Int# -> Int# -> c -> Int# - with - has_side_effects = True - -primop ParAtAbsOp "parAtAbs#" GenPrimOp - a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int# - with - has_side_effects = True - -primop ParAtRelOp "parAtRel#" GenPrimOp - a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int# - with - has_side_effects = True - -primop ParAtForNowOp "parAtForNow#" GenPrimOp - b -> a -> Int# -> Int# -> Int# -> Int# -> c -> Int# - with - has_side_effects = True - --- copyable# and noFollow# are yet to be implemented (for GpH) --- ---primop CopyableOp "copyable#" GenPrimOp --- a -> Int# --- with --- has_side_effects = True --- ---primop NoFollowOp "noFollow#" GenPrimOp --- a -> Int# --- with --- has_side_effects = True - - ------------------------------------------------------------------------- -section "Tag to enum stuff" - {Convert back and forth between values of enumerated types - and small integers.} ------------------------------------------------------------------------- - -primop DataToTagOp "dataToTag#" GenPrimOp - a -> Int# - with - strictness = { \ _arity -> mkClosedStrictSig [evalDmd] topRes } - - -- dataToTag# must have an evaluated argument - -primop TagToEnumOp "tagToEnum#" GenPrimOp - Int# -> a - ------------------------------------------------------------------------- -section "Bytecode operations" - {Support for the bytecode interpreter and linker.} ------------------------------------------------------------------------- - -primtype BCO# - {Primitive bytecode type.} - -primop AddrToAnyOp "addrToAny#" GenPrimOp - Addr# -> (# a #) - {Convert an {\tt Addr\#} to a followable Any type.} - with - code_size = 0 - -primop MkApUpd0_Op "mkApUpd0#" GenPrimOp - BCO# -> (# a #) - with - out_of_line = True - -primop NewBCOOp "newBCO#" GenPrimOp - ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO# #) - with - has_side_effects = True - out_of_line = True - -primop UnpackClosureOp "unpackClosure#" GenPrimOp - a -> (# Addr#, Array# b, ByteArray# #) - with - out_of_line = True - -primop GetApStackValOp "getApStackVal#" GenPrimOp - a -> Int# -> (# Int#, b #) - with - out_of_line = True - ------------------------------------------------------------------------- -section "Misc" - {These aren't nearly as wired in as Etc...} ------------------------------------------------------------------------- - -primop GetCCSOfOp "getCCSOf#" GenPrimOp - a -> State# s -> (# State# s, Addr# #) - -primop GetCurrentCCSOp "getCurrentCCS#" GenPrimOp - a -> State# s -> (# State# s, Addr# #) - { Returns the current {\tt CostCentreStack} (value is {\tt NULL} if - not profiling). Takes a dummy argument which can be used to - avoid the call to {\tt getCCCS\#} being floated out by the - simplifier, which would result in an uninformative stack - ("CAF"). } - ------------------------------------------------------------------------- -section "Etc" - {Miscellaneous built-ins} ------------------------------------------------------------------------- - -primtype Proxy# a - { The type constructor {\tt Proxy#} is used to bear witness to some - type variable. It's used when you want to pass around proxy values - for doing things like modelling type applications. A {\tt Proxy#} - is not only unboxed, it also has a polymorphic kind, and has no - runtime representation, being totally free. } - -pseudoop "proxy#" - Proxy# a - { Witness for an unboxed {\tt Proxy#} value, which has no runtime - representation. } - -pseudoop "seq" - a -> b -> b - { Evaluates its first argument to head normal form, and then returns its second - argument as the result. } - -primtype Any k - { The type constructor {\tt Any} is type to which you can unsafely coerce any - lifted type, and back. - - * It is lifted, and hence represented by a pointer - - * It does not claim to be a {\it data} type, and that's important for - the code generator, because the code gen may {\it enter} a data value - but never enters a function value. - - It's also used to instantiate un-constrained type variables after type - checking. For example, {\tt length} has type - - {\tt length :: forall a. [a] -> Int} - - and the list datacon for the empty list has type - - {\tt [] :: forall a. [a]} - - In order to compose these two terms as {\tt length []} a type - application is required, but there is no constraint on the - choice. In this situation GHC uses {\tt Any}: - - {\tt length (Any *) ([] (Any *))} - - Note that {\tt Any} is kind polymorphic, and takes a kind {\tt k} as its - first argument. The kind of {\tt Any} is thus {\tt forall k. k -> k}.} - -primtype AnyK - { The kind {\tt AnyK} is the kind level counterpart to {\tt Any}. In a - kind polymorphic setting, a similar example to the length of the empty - list can be given at the type level: - - {\tt type family Length (l :: [k]) :: Nat} - {\tt type instance Length [] = Zero} - - When {\tt Length} is applied to the empty (promoted) list it will have - the kind {\tt Length AnyK []}. - - {\tt AnyK} is currently not exported and cannot be used directly, but - you might see it in debug output from the compiler. - } - -pseudoop "unsafeCoerce#" - a -> b - { The function {\tt unsafeCoerce\#} allows you to side-step the typechecker entirely. That - is, it allows you to coerce any type into any other type. If you use this function, - you had better get it right, otherwise segmentation faults await. It is generally - used when you want to write a program that you know is well-typed, but where Haskell's - type system is not expressive enough to prove that it is well typed. - - The following uses of {\tt unsafeCoerce\#} are supposed to work (i.e. not lead to - spurious compile-time or run-time crashes): - - * Casting any lifted type to {\tt Any} - - * Casting {\tt Any} back to the real type - - * Casting an unboxed type to another unboxed type of the same size - (but not coercions between floating-point and integral types) - - * Casting between two types that have the same runtime representation. One case is when - the two types differ only in "phantom" type parameters, for example - {\tt Ptr Int} to {\tt Ptr Float}, or {\tt [Int]} to {\tt [Float]} when the list is - known to be empty. Also, a {\tt newtype} of a type {\tt T} has the same representation - at runtime as {\tt T}. - - Other uses of {\tt unsafeCoerce\#} are undefined. In particular, you should not use - {\tt unsafeCoerce\#} to cast a T to an algebraic data type D, unless T is also - an algebraic data type. For example, do not cast {\tt Int->Int} to {\tt Bool}, even if - you later cast that {\tt Bool} back to {\tt Int->Int} before applying it. The reasons - have to do with GHC's internal representation details (for the congnoscenti, data values - can be entered but function closures cannot). If you want a safe type to cast things - to, use {\tt Any}, which is not an algebraic data type. - - } - --- NB. It is tempting to think that casting a value to a type that it doesn't have is safe --- as long as you don't "do anything" with the value in its cast form, such as seq on it. This --- isn't the case: the compiler can insert seqs itself, and if these happen at the wrong type, --- Bad Things Might Happen. See bug #1616: in this case we cast a function of type (a,b) -> (a,b) --- to () -> () and back again. The strictness analyser saw that the function was strict, but --- the wrapper had type () -> (), and hence the wrapper de-constructed the (), the worker re-constructed --- a new (), with the result that the code ended up with "case () of (a,b) -> ...". - -primop TraceEventOp "traceEvent#" GenPrimOp - Addr# -> State# s -> State# s - { Emits an event via the RTS tracing framework. The contents - of the event is the zero-terminated byte string passed as the first - argument. The event will be emitted either to the .eventlog file, - or to stderr, depending on the runtime RTS flags. } - with - has_side_effects = True - out_of_line = True - -primop TraceMarkerOp "traceMarker#" GenPrimOp - Addr# -> State# s -> State# s - { Emits a marker event via the RTS tracing framework. The contents - of the event is the zero-terminated byte string passed as the first - argument. The event will be emitted either to the .eventlog file, - or to stderr, depending on the runtime RTS flags. } - with - has_side_effects = True - out_of_line = True - ------------------------------------------------------------------------- -section "Safe coercions" ------------------------------------------------------------------------- - -pseudoop "coerce" - Coercible a b => a -> b - { The function {\tt coerce} allows you to safely convert between values of - types that have the same representation with no run-time overhead. In the - simplest case you can use it instead of a newtype constructor, to go from - the newtype's concrete type to the abstract type. But it also works in - more complicated settings, e.g. converting a list of newtypes to a list of - concrete types. - } - -primclass Coercible a b - { This two-parameter class has instances for types {\tt a} and {\tt b} if - the compiler can infer that they have the same representation. This class - does not have regular instances; instead they are created on-the-fly during - type-checking. Trying to manually declare an instance of {\tt Coercible} - is an error. - - Nevertheless one can pretend that the following three kinds of instances - exist. First, as a trivial base-case: - - {\tt instance a a} - - Furthermore, for every type constructor there is - an instance that allows to coerce under the type constructor. For - example, let {\tt D} be a prototypical type constructor ({\tt data} or {\tt - newtype}) with three type arguments, which have roles Nominal, - Representational resp. Phantom. Then there is an instance of the form - - {\tt instance Coercible b b' => Coercible (D a b c) (D a b' c')} - - Note that the nominal type arguments are equal, the representational type - arguments can differ, but need to have a {\tt Coercible} instance - themself, and the phantom type arguments can be changed arbitrarily. - - In SafeHaskell code, this instance is only usable if the constructors of - every type constructor used in the definition of {\tt D} (including - those of {\tt D} itself) are in scope. - - The third kind of instance exists for every {\tt newtype NT = MkNT T} and - comes in two variants, namely - - {\tt instance Coercible a T => Coercible a NT} - - {\tt instance Coercible T b => Coercible NT b} - - This instance is only usable if the constructor {\tt MkNT} is in scope. - - If, as a library author of a type constructor like {\tt Set a}, you - want to prevent a user of your module to write - {\tt coerce :: Set T -> Set NT}, - you need to set the role of {\tt Set}'s type parameter to Nominal. - } - ------------------------------------------------------------------------- -section "SIMD Vectors" - {Operations on SIMD vectors.} ------------------------------------------------------------------------- - - - - - -primtype VECTOR - with llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecBroadcastOp "broadcast#" GenPrimOp - SCALAR -> VECTOR - { Broadcast a scalar to all elements of a vector. } - with llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecPackOp "pack#" GenPrimOp - VECTUPLE -> VECTOR - { Pack the elements of an unboxed tuple into a vector. } - with llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecUnpackOp "unpack#" GenPrimOp - VECTOR -> VECTUPLE - { Unpack the elements of a vector into an unboxed tuple. #} - with llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecInsertOp "insert#" GenPrimOp - VECTOR -> SCALAR -> Int# -> VECTOR - { Insert a scalar at the given position in a vector. } - with can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecAddOp "plus#" Dyadic - VECTOR -> VECTOR -> VECTOR - { Add two vectors element-wise. } - with commutable = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecSubOp "minus#" Dyadic - VECTOR -> VECTOR -> VECTOR - { Subtract two vectors element-wise. } - with llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecMulOp "times#" Dyadic - VECTOR -> VECTOR -> VECTOR - { Multiply two vectors element-wise. } - with commutable = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecDivOp "divide#" Dyadic - VECTOR -> VECTOR -> VECTOR - { Divide two vectors element-wise. } - with can_fail = True - llvm_only = True - vector = [, ,, ,,] - -primop VecQuotOp "quot#" Dyadic - VECTOR -> VECTOR -> VECTOR - { Rounds towards zero element-wise. } - with can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,,] - -primop VecRemOp "rem#" Dyadic - VECTOR -> VECTOR -> VECTOR - { Satisfies \texttt{(quot\# x y) times\# y plus\# (rem\# x y) == x}. } - with can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,,] - -primop VecNegOp "negate#" Monadic - VECTOR -> VECTOR - { Negate element-wise. } - with llvm_only = True - vector = [,,, ,,,, ,,,, ,, ,, ,,] - -primop VecIndexByteArrayOp "indexArray#" GenPrimOp - ByteArray# -> Int# -> VECTOR - { Read a vector from specified index of immutable array. } - with can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecReadByteArrayOp "readArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, VECTOR #) - { Read a vector from specified index of mutable array. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecWriteByteArrayOp "writeArray#" GenPrimOp - MutableByteArray# s -> Int# -> VECTOR -> State# s -> State# s - { Write a vector to specified index of mutable array. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecIndexOffAddrOp "indexOffAddr#" GenPrimOp - Addr# -> Int# -> VECTOR - { Reads vector; offset in bytes. } - with can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecReadOffAddrOp "readOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, VECTOR #) - { Reads vector; offset in bytes. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecWriteOffAddrOp "writeOffAddr#" GenPrimOp - Addr# -> Int# -> VECTOR -> State# s -> State# s - { Write vector; offset in bytes. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - - -primop VecIndexScalarByteArrayOp "indexArrayAs#" GenPrimOp - ByteArray# -> Int# -> VECTOR - { Read a vector from specified index of immutable array of scalars; offset is in scalar elements. } - with can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecReadScalarByteArrayOp "readArrayAs#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, VECTOR #) - { Read a vector from specified index of mutable array of scalars; offset is in scalar elements. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecWriteScalarByteArrayOp "writeArrayAs#" GenPrimOp - MutableByteArray# s -> Int# -> VECTOR -> State# s -> State# s - { Write a vector to specified index of mutable array of scalars; offset is in scalar elements. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecIndexScalarOffAddrOp "indexOffAddrAs#" GenPrimOp - Addr# -> Int# -> VECTOR - { Reads vector; offset in scalar elements. } - with can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecReadScalarOffAddrOp "readOffAddrAs#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, VECTOR #) - { Reads vector; offset in scalar elements. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - -primop VecWriteScalarOffAddrOp "writeOffAddrAs#" GenPrimOp - Addr# -> Int# -> VECTOR -> State# s -> State# s - { Write vector; offset in scalar elements. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] - ------------------------------------------------------------------------- - -section "Prefetch" - {Prefetch operations: Note how every prefetch operation has a name - with the pattern prefetch*N#, where N is either 0,1,2, or 3. - - This suffix number, N, is the "locality level" of the prefetch, following the - convention in GCC and other compilers. - Higher locality numbers correspond to the memory being loaded in more - levels of the cpu cache, and being retained after initial use. The naming - convention follows the naming convention of the prefetch intrinsic found - in the GCC and Clang C compilers. - - On the LLVM backend, prefetch*N# uses the LLVM prefetch intrinsic - with locality level N. The code generated by LLVM is target architecture - dependent, but should agree with the GHC NCG on x86 systems. - - On the Sparc and PPC native backends, prefetch*N is a No-Op. - - On the x86 NCG, N=0 will generate prefetchNTA, - N=1 generates prefetcht2, N=2 generates prefetcht1, and - N=3 generates prefetcht0. - - For streaming workloads, the prefetch*0 operations are recommended. - For workloads which do many reads or writes to a memory location in a short period of time, - prefetch*3 operations are recommended. - - For further reading about prefetch and associated systems performance optimization, - the instruction set and optimization manuals by Intel and other CPU vendors are - excellent starting place. - - - The "Intel 64 and IA-32 Architectures Optimization Reference Manual" is - especially a helpful read, even if your software is meant for other CPU - architectures or vendor hardware. The manual can be found at - http://www.intel.com/content/www/us/en/architecture-and-technology/64-ia-32-architectures-optimization-manual.html . - - The {\tt prefetchMutableByteArray} family of operations has the order of operations - determined by passing around the {\tt State#} token. - - For the {\tt prefetchByteArray} - and {\tt prefetchAddr} families of operations, consider the following example: - - {\tt let a1 = prefetchByteArray2# a n in ...a1... } - - In the above fragement, {\tt a} is the input variable for the prefetch - and {\tt a1 == a} will be true. To ensure that the prefetch is not treated as deadcode, - the body of the let should only use {\tt a1} and NOT {\tt a}. The same principle - applies for uses of prefetch in a loop. - - } - - ------------------------------------------------------------------------- - - ---- the Int# argument for prefetch is the byte offset on the byteArray or Addr# - ---- -primop PrefetchByteArrayOp3 "prefetchByteArray3#" GenPrimOp - ByteArray# -> Int# -> ByteArray# - -primop PrefetchMutableByteArrayOp3 "prefetchMutableByteArray3#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> State# s - -primop PrefetchAddrOp3 "prefetchAddr3#" GenPrimOp - Addr# -> Int# -> Addr# - ----- - -primop PrefetchByteArrayOp2 "prefetchByteArray2#" GenPrimOp - ByteArray# -> Int# -> ByteArray# - -primop PrefetchMutableByteArrayOp2 "prefetchMutableByteArray2#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> State# s - -primop PrefetchAddrOp2 "prefetchAddr2#" GenPrimOp - Addr# -> Int# -> Addr# - ----- - -primop PrefetchByteArrayOp1 "prefetchByteArray1#" GenPrimOp - ByteArray# -> Int# -> ByteArray# - -primop PrefetchMutableByteArrayOp1 "prefetchMutableByteArray1#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> State# s - -primop PrefetchAddrOp1 "prefetchAddr1#" GenPrimOp - Addr# -> Int# -> Addr# - ----- - -primop PrefetchByteArrayOp0 "prefetchByteArray0#" GenPrimOp - ByteArray# -> Int# -> ByteArray# - -primop PrefetchMutableByteArrayOp0 "prefetchMutableByteArray0#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> State# s - -primop PrefetchAddrOp0 "prefetchAddr0#" GenPrimOp - Addr# -> Int# -> Addr# - - - ------------------------------------------------------------------------- ---- --- ------------------------------------------------------------------------- - -thats_all_folks diff --git a/include/prim/primops-710.txt b/include/prim/primops-710.txt deleted file mode 100644 index 043f14f0..00000000 --- a/include/prim/primops-710.txt +++ /dev/null @@ -1,2369 +0,0 @@ ------------------------------------------------------------------------ --- --- (c) 2010 The University of Glasgow --- --- Primitive Operations and Types --- --- For more information on PrimOps, see --- http: --- ------------------------------------------------------------------------ --- This file is processed by the utility program genprimopcode to produce --- a number of include files within the compiler and optionally to produce --- human-readable documentation. --- --- It should first be preprocessed. --- --- Information on how PrimOps are implemented and the steps necessary to --- add a new one can be found in the Commentary: --- --- http: --- This file is divided into named sections, each containing or more --- primop entries. Section headers have the format: --- --- section "section-name" {description} --- --- This information is used solely when producing documentation; it is --- otherwise ignored. The description is optional. --- --- The format of each primop entry is as follows: --- --- primop internal-name "name-in-program-text" type category {description} attributes --- The default attribute values which apply if you don't specify --- other ones. Attribute values can be True, False, or arbitrary --- text between curly brackets. This is a kludge to enable --- processors of this file to easily get hold of simple info --- (eg, out_of_line), whilst avoiding parsing complex expressions --- needed for strictness info. --- The vector attribute is rather special. It takes a list of 3-tuples, each of --- which is of the form . ELEM_TYPE is the type of --- the elements in the vector; LENGTH is the length of the vector; and --- SCALAR_TYPE is the scalar type used to inject to/project from vector --- element. Note that ELEM_TYPE and SCALAR_TYPE are not the same; for example, --- to broadcast a scalar value to a vector whose elements are of type Int8, we --- use an Int#. --- When a primtype or primop has a vector attribute, it is instantiated at each --- 3-tuple in the list of 3-tuples. That is, the vector attribute allows us to --- define a family of types or primops. Vector support also adds three new --- keywords: VECTOR, SCALAR, and VECTUPLE. These keywords are expanded to types --- derived from the 3-tuple. For the 3-tuple , VECTOR expands to --- Int64X2#, SCALAR expands to INT64, and VECTUPLE expands to (# INT64, INT64 --- #). -defaults - has_side_effects = False - out_of_line = False -- See Note Note [PrimOp can_fail and has_side_effects] in PrimOp - can_fail = False -- See Note Note [PrimOp can_fail and has_side_effects] in PrimOp - commutable = False - code_size = { primOpCodeSizeDefault } - strictness = { \ arity -> mkClosedStrictSig (replicate arity topDmd) topRes } - fixity = Nothing - llvm_only = False - vector = [] --- Currently, documentation is produced using latex, so contents of --- description fields should be legal latex. Descriptions can contain --- matched pairs of embedded curly brackets. --- We need platform defines (tests for mingw32 below). -section "The word size story." - {Haskell98 specifies that signed integers (type {\tt Int}) - must contain at least 30 bits. GHC always implements {\tt - Int} using the primitive type {\tt Int\#}, whose size equals - the {\tt MachDeps.h} constant {\tt WORD\_SIZE\_IN\_BITS}. - This is normally set based on the {\tt config.h} parameter - {\tt SIZEOF\_HSWORD}, i.e., 32 bits on 32-bit machines, 64 - bits on 64-bit machines. However, it can also be explicitly - set to a smaller number, e.g., 31 bits, to allow the - possibility of using tag bits. Currently GHC itself has only - 32-bit and 64-bit variants, but 30 or 31-bit code can be - exported as an external core file for use in other back ends. - GHC also implements a primitive unsigned integer type {\tt - Word\#} which always has the same number of bits as {\tt - Int\#}. - In addition, GHC supports families of explicit-sized integers - and words at 8, 16, 32, and 64 bits, with the usual - arithmetic operations, comparisons, and a range of - conversions. The 8-bit and 16-bit sizes are always - represented as {\tt Int\#} and {\tt Word\#}, and the - operations implemented in terms of the the primops on these - types, with suitable range restrictions on the results (using - the {\tt narrow$n$Int\#} and {\tt narrow$n$Word\#} families - of primops. The 32-bit sizes are represented using {\tt - Int\#} and {\tt Word\#} when {\tt WORD\_SIZE\_IN\_BITS} - $\geq$ 32; otherwise, these are represented using distinct - primitive types {\tt Int32\#} and {\tt Word32\#}. These (when - needed) have a complete set of corresponding operations; - however, nearly all of these are implemented as external C - functions rather than as primops. Exactly the same story - applies to the 64-bit sizes. All of these details are hidden - under the {\tt PrelInt} and {\tt PrelWord} modules, which use - {\tt \#if}-defs to invoke the appropriate types and - operators. - Word size also matters for the families of primops for - indexing/reading/writing fixed-size quantities at offsets - from an array base, address, or foreign pointer. Here, a - slightly different approach is taken. The names of these - primops are fixed, but their {\it types} vary according to - the value of {\tt WORD\_SIZE\_IN\_BITS}. For example, if word - size is at least 32 bits then an operator like - \texttt{indexInt32Array\#} has type {\tt ByteArray\# -> Int\# - -> Int\#}; otherwise it has type {\tt ByteArray\# -> Int\# -> - Int32\#}. This approach confines the necessary {\tt - \#if}-defs to this file; no conditional compilation is needed - in the files that expose these primops. - Finally, there are strongly deprecated primops for coercing - between {\tt Addr\#}, the primitive type of machine - addresses, and {\tt Int\#}. These are pretty bogus anyway, - but will work on existing 32-bit and 64-bit GHC targets; they - are completely bogus when tag bits are used in {\tt Int\#}, - so are not available in this case. } --- Define synonyms for indexing ops. ------------------------------------------------------------------------- -section "Char#" - {Operations on 31-bit characters.} ------------------------------------------------------------------------- -primtype Char# -primop CharGtOp "gtChar#" Compare Char# -> Char# -> Int# -primop CharGeOp "geChar#" Compare Char# -> Char# -> Int# -primop CharEqOp "eqChar#" Compare - Char# -> Char# -> Int# - with commutable = True -primop CharNeOp "neChar#" Compare - Char# -> Char# -> Int# - with commutable = True -primop CharLtOp "ltChar#" Compare Char# -> Char# -> Int# -primop CharLeOp "leChar#" Compare Char# -> Char# -> Int# -primop OrdOp "ord#" GenPrimOp Char# -> Int# - with code_size = 0 ------------------------------------------------------------------------- -section "Int#" - {Operations on native-size integers (30+ bits).} ------------------------------------------------------------------------- -primtype Int# -primop IntAddOp "+#" Dyadic - Int# -> Int# -> Int# - with commutable = True - fixity = infixl 6 -primop IntSubOp "-#" Dyadic Int# -> Int# -> Int# - with fixity = infixl 6 -primop IntMulOp "*#" - Dyadic Int# -> Int# -> Int# - {Low word of signed integer multiply.} - with commutable = True - fixity = infixl 7 -primop IntMulMayOfloOp "mulIntMayOflo#" - Dyadic Int# -> Int# -> Int# - {Return non-zero if there is any possibility that the upper word of a - signed integer multiply might contain useful information. Return - zero only if you are completely sure that no overflow can occur. - On a 32-bit platform, the recommmended implementation is to do a - 32 x 32 -> 64 signed multiply, and subtract result[63:32] from - (result[31] >>signed 31). If this is zero, meaning that the - upper word is merely a sign extension of the lower one, no - overflow can occur. - On a 64-bit platform it is not always possible to - acquire the top 64 bits of the result. Therefore, a recommended - implementation is to take the absolute value of both operands, and - return 0 iff bits[63:31] of them are zero, since that means that their - magnitudes fit within 31 bits, so the magnitude of the product must fit - into 62 bits. - If in doubt, return non-zero, but do make an effort to create the - correct answer for small args, since otherwise the performance of - \texttt{(*) :: Integer -> Integer -> Integer} will be poor. - } - with commutable = True -primop IntQuotOp "quotInt#" Dyadic - Int# -> Int# -> Int# - {Rounds towards zero.} - with can_fail = True -primop IntRemOp "remInt#" Dyadic - Int# -> Int# -> Int# - {Satisfies \texttt{(quotInt\# x y) *\# y +\# (remInt\# x y) == x}.} - with can_fail = True -primop IntQuotRemOp "quotRemInt#" GenPrimOp - Int# -> Int# -> (# Int#, Int# #) - {Rounds towards zero.} - with can_fail = True -primop AndIOp "andI#" Dyadic Int# -> Int# -> Int# - with commutable = True -primop OrIOp "orI#" Dyadic Int# -> Int# -> Int# - with commutable = True -primop XorIOp "xorI#" Dyadic Int# -> Int# -> Int# - with commutable = True -primop NotIOp "notI#" Monadic Int# -> Int# -primop IntNegOp "negateInt#" Monadic Int# -> Int# -primop IntAddCOp "addIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #) - {Add signed integers reporting overflow. - First member of result is the sum truncated to an {\tt Int#}; - second member is zero if the true sum fits in an {\tt Int#}, - nonzero if overflow occurred (the sum is either too large - or too small to fit in an {\tt Int#}).} - with code_size = 2 -primop IntSubCOp "subIntC#" GenPrimOp Int# -> Int# -> (# Int#, Int# #) - {Subtract signed integers reporting overflow. - First member of result is the difference truncated to an {\tt Int#}; - second member is zero if the true difference fits in an {\tt Int#}, - nonzero if overflow occurred (the difference is either too large - or too small to fit in an {\tt Int#}).} - with code_size = 2 -primop IntGtOp ">#" Compare Int# -> Int# -> Int# - with fixity = infix 4 -primop IntGeOp ">=#" Compare Int# -> Int# -> Int# - with fixity = infix 4 -primop IntEqOp "==#" Compare - Int# -> Int# -> Int# - with commutable = True - fixity = infix 4 -primop IntNeOp "/=#" Compare - Int# -> Int# -> Int# - with commutable = True - fixity = infix 4 -primop IntLtOp "<#" Compare Int# -> Int# -> Int# - with fixity = infix 4 -primop IntLeOp "<=#" Compare Int# -> Int# -> Int# - with fixity = infix 4 -primop ChrOp "chr#" GenPrimOp Int# -> Char# - with code_size = 0 -primop Int2WordOp "int2Word#" GenPrimOp Int# -> Word# - with code_size = 0 -primop Int2FloatOp "int2Float#" GenPrimOp Int# -> Float# -primop Int2DoubleOp "int2Double#" GenPrimOp Int# -> Double# -primop Word2FloatOp "word2Float#" GenPrimOp Word# -> Float# -primop Word2DoubleOp "word2Double#" GenPrimOp Word# -> Double# -primop ISllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int# - {Shift left. Result undefined if shift amount is not - in the range 0 to word size - 1 inclusive.} -primop ISraOp "uncheckedIShiftRA#" GenPrimOp Int# -> Int# -> Int# - {Shift right arithmetic. Result undefined if shift amount is not - in the range 0 to word size - 1 inclusive.} -primop ISrlOp "uncheckedIShiftRL#" GenPrimOp Int# -> Int# -> Int# - {Shift right logical. Result undefined if shift amount is not - in the range 0 to word size - 1 inclusive.} ------------------------------------------------------------------------- -section "Word#" - {Operations on native-sized unsigned words (30+ bits).} ------------------------------------------------------------------------- -primtype Word# -primop WordAddOp "plusWord#" Dyadic Word# -> Word# -> Word# - with commutable = True --- Returns (# high, low #) (or equivalently, (# carry, low #)) -primop WordAdd2Op "plusWord2#" GenPrimOp - Word# -> Word# -> (# Word#, Word# #) - with commutable = True -primop WordSubOp "minusWord#" Dyadic Word# -> Word# -> Word# -primop WordMulOp "timesWord#" Dyadic Word# -> Word# -> Word# - with commutable = True --- Returns (# high, low #) -primop WordMul2Op "timesWord2#" GenPrimOp - Word# -> Word# -> (# Word#, Word# #) - with commutable = True -primop WordQuotOp "quotWord#" Dyadic Word# -> Word# -> Word# - with can_fail = True -primop WordRemOp "remWord#" Dyadic Word# -> Word# -> Word# - with can_fail = True -primop WordQuotRemOp "quotRemWord#" GenPrimOp - Word# -> Word# -> (# Word#, Word# #) - with can_fail = True --- Takes high word of dividend, then low word of dividend, then divisor. --- Requires that high word is not divisible by divisor. -primop WordQuotRem2Op "quotRemWord2#" GenPrimOp - Word# -> Word# -> Word# -> (# Word#, Word# #) - with can_fail = True -primop AndOp "and#" Dyadic Word# -> Word# -> Word# - with commutable = True -primop OrOp "or#" Dyadic Word# -> Word# -> Word# - with commutable = True -primop XorOp "xor#" Dyadic Word# -> Word# -> Word# - with commutable = True -primop NotOp "not#" Monadic Word# -> Word# -primop SllOp "uncheckedShiftL#" GenPrimOp Word# -> Int# -> Word# - {Shift left logical. Result undefined if shift amount is not - in the range 0 to word size - 1 inclusive.} -primop SrlOp "uncheckedShiftRL#" GenPrimOp Word# -> Int# -> Word# - {Shift right logical. Result undefined if shift amount is not - in the range 0 to word size - 1 inclusive.} -primop Word2IntOp "word2Int#" GenPrimOp Word# -> Int# - with code_size = 0 -primop WordGtOp "gtWord#" Compare Word# -> Word# -> Int# -primop WordGeOp "geWord#" Compare Word# -> Word# -> Int# -primop WordEqOp "eqWord#" Compare Word# -> Word# -> Int# -primop WordNeOp "neWord#" Compare Word# -> Word# -> Int# -primop WordLtOp "ltWord#" Compare Word# -> Word# -> Int# -primop WordLeOp "leWord#" Compare Word# -> Word# -> Int# -primop PopCnt8Op "popCnt8#" Monadic Word# -> Word# - {Count the number of set bits in the lower 8 bits of a word.} -primop PopCnt16Op "popCnt16#" Monadic Word# -> Word# - {Count the number of set bits in the lower 16 bits of a word.} -primop PopCnt32Op "popCnt32#" Monadic Word# -> Word# - {Count the number of set bits in the lower 32 bits of a word.} -primop PopCnt64Op "popCnt64#" GenPrimOp Word64# -> Word# - {Count the number of set bits in a 64-bit word.} -primop PopCntOp "popCnt#" Monadic Word# -> Word# - {Count the number of set bits in a word.} -primop Clz8Op "clz8#" Monadic Word# -> Word# - {Count leading zeros in the lower 8 bits of a word.} -primop Clz16Op "clz16#" Monadic Word# -> Word# - {Count leading zeros in the lower 16 bits of a word.} -primop Clz32Op "clz32#" Monadic Word# -> Word# - {Count leading zeros in the lower 32 bits of a word.} -primop Clz64Op "clz64#" GenPrimOp Word64# -> Word# - {Count leading zeros in a 64-bit word.} -primop ClzOp "clz#" Monadic Word# -> Word# - {Count leading zeros in a word.} -primop Ctz8Op "ctz8#" Monadic Word# -> Word# - {Count trailing zeros in the lower 8 bits of a word.} -primop Ctz16Op "ctz16#" Monadic Word# -> Word# - {Count trailing zeros in the lower 16 bits of a word.} -primop Ctz32Op "ctz32#" Monadic Word# -> Word# - {Count trailing zeros in the lower 32 bits of a word.} -primop Ctz64Op "ctz64#" GenPrimOp Word64# -> Word# - {Count trailing zeros in a 64-bit word.} -primop CtzOp "ctz#" Monadic Word# -> Word# - {Count trailing zeros in a word.} -primop BSwap16Op "byteSwap16#" Monadic Word# -> Word# - {Swap bytes in the lower 16 bits of a word. The higher bytes are undefined. } -primop BSwap32Op "byteSwap32#" Monadic Word# -> Word# - {Swap bytes in the lower 32 bits of a word. The higher bytes are undefined. } -primop BSwap64Op "byteSwap64#" Monadic Word64# -> Word64# - {Swap bytes in a 64 bits of a word.} -primop BSwapOp "byteSwap#" Monadic Word# -> Word# - {Swap bytes in a word.} ------------------------------------------------------------------------- -section "Narrowings" - {Explicit narrowing of native-sized ints or words.} ------------------------------------------------------------------------- -primop Narrow8IntOp "narrow8Int#" Monadic Int# -> Int# -primop Narrow16IntOp "narrow16Int#" Monadic Int# -> Int# -primop Narrow32IntOp "narrow32Int#" Monadic Int# -> Int# -primop Narrow8WordOp "narrow8Word#" Monadic Word# -> Word# -primop Narrow16WordOp "narrow16Word#" Monadic Word# -> Word# -primop Narrow32WordOp "narrow32Word#" Monadic Word# -> Word# ------------------------------------------------------------------------- -section "Int64#" - {Operations on 64-bit unsigned words. This type is only used - if plain {\tt Int\#} has less than 64 bits. In any case, the operations - are not primops; they are implemented (if needed) as ccalls instead.} ------------------------------------------------------------------------- -primtype Int64# ------------------------------------------------------------------------- -section "Word64#" - {Operations on 64-bit unsigned words. This type is only used - if plain {\tt Word\#} has less than 64 bits. In any case, the operations - are not primops; they are implemented (if needed) as ccalls instead.} ------------------------------------------------------------------------- -primtype Word64# ------------------------------------------------------------------------- -section "Double#" - {Operations on double-precision (64 bit) floating-point numbers.} ------------------------------------------------------------------------- -primtype Double# -primop DoubleGtOp ">##" Compare Double# -> Double# -> Int# - with fixity = infix 4 -primop DoubleGeOp ">=##" Compare Double# -> Double# -> Int# - with fixity = infix 4 -primop DoubleEqOp "==##" Compare - Double# -> Double# -> Int# - with commutable = True - fixity = infix 4 -primop DoubleNeOp "/=##" Compare - Double# -> Double# -> Int# - with commutable = True - fixity = infix 4 -primop DoubleLtOp "<##" Compare Double# -> Double# -> Int# - with fixity = infix 4 -primop DoubleLeOp "<=##" Compare Double# -> Double# -> Int# - with fixity = infix 4 -primop DoubleAddOp "+##" Dyadic - Double# -> Double# -> Double# - with commutable = True - fixity = infixl 6 -primop DoubleSubOp "-##" Dyadic Double# -> Double# -> Double# - with fixity = infixl 6 -primop DoubleMulOp "*##" Dyadic - Double# -> Double# -> Double# - with commutable = True - fixity = infixl 7 -primop DoubleDivOp "/##" Dyadic - Double# -> Double# -> Double# - with can_fail = True - fixity = infixl 7 -primop DoubleNegOp "negateDouble#" Monadic Double# -> Double# -primop Double2IntOp "double2Int#" GenPrimOp Double# -> Int# - {Truncates a {\tt Double#} value to the nearest {\tt Int#}. - Results are undefined if the truncation if truncation yields - a value outside the range of {\tt Int#}.} -primop Double2FloatOp "double2Float#" GenPrimOp Double# -> Float# -primop DoubleExpOp "expDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } -primop DoubleLogOp "logDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } - can_fail = True -primop DoubleSqrtOp "sqrtDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } -primop DoubleSinOp "sinDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } -primop DoubleCosOp "cosDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } -primop DoubleTanOp "tanDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } -primop DoubleAsinOp "asinDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } - can_fail = True -primop DoubleAcosOp "acosDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } - can_fail = True -primop DoubleAtanOp "atanDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } -primop DoubleSinhOp "sinhDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } -primop DoubleCoshOp "coshDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } -primop DoubleTanhOp "tanhDouble#" Monadic - Double# -> Double# - with - code_size = { primOpCodeSizeForeignCall } -primop DoublePowerOp "**##" Dyadic - Double# -> Double# -> Double# - {Exponentiation.} - with - code_size = { primOpCodeSizeForeignCall } -primop DoubleDecode_2IntOp "decodeDouble_2Int#" GenPrimOp - Double# -> (# Int#, Word#, Word#, Int# #) - {Convert to integer. - First component of the result is -1 or 1, indicating the sign of the - mantissa. The next two are the high and low 32 bits of the mantissa - respectively, and the last is the exponent.} - with out_of_line = True -primop DoubleDecode_Int64Op "decodeDouble_Int64#" GenPrimOp - Double# -> (# Int64#, Int# #) - {Decode {\tt Double\#} into mantissa and base-2 exponent.} - with out_of_line = True ------------------------------------------------------------------------- -section "Float#" - {Operations on single-precision (32-bit) floating-point numbers.} ------------------------------------------------------------------------- -primtype Float# -primop FloatGtOp "gtFloat#" Compare Float# -> Float# -> Int# -primop FloatGeOp "geFloat#" Compare Float# -> Float# -> Int# -primop FloatEqOp "eqFloat#" Compare - Float# -> Float# -> Int# - with commutable = True -primop FloatNeOp "neFloat#" Compare - Float# -> Float# -> Int# - with commutable = True -primop FloatLtOp "ltFloat#" Compare Float# -> Float# -> Int# -primop FloatLeOp "leFloat#" Compare Float# -> Float# -> Int# -primop FloatAddOp "plusFloat#" Dyadic - Float# -> Float# -> Float# - with commutable = True -primop FloatSubOp "minusFloat#" Dyadic Float# -> Float# -> Float# -primop FloatMulOp "timesFloat#" Dyadic - Float# -> Float# -> Float# - with commutable = True -primop FloatDivOp "divideFloat#" Dyadic - Float# -> Float# -> Float# - with can_fail = True -primop FloatNegOp "negateFloat#" Monadic Float# -> Float# -primop Float2IntOp "float2Int#" GenPrimOp Float# -> Int# - {Truncates a {\tt Float#} value to the nearest {\tt Int#}. - Results are undefined if the truncation if truncation yields - a value outside the range of {\tt Int#}.} -primop FloatExpOp "expFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } -primop FloatLogOp "logFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - can_fail = True -primop FloatSqrtOp "sqrtFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } -primop FloatSinOp "sinFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } -primop FloatCosOp "cosFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } -primop FloatTanOp "tanFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } -primop FloatAsinOp "asinFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - can_fail = True -primop FloatAcosOp "acosFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } - can_fail = True -primop FloatAtanOp "atanFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } -primop FloatSinhOp "sinhFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } -primop FloatCoshOp "coshFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } -primop FloatTanhOp "tanhFloat#" Monadic - Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } -primop FloatPowerOp "powerFloat#" Dyadic - Float# -> Float# -> Float# - with - code_size = { primOpCodeSizeForeignCall } -primop Float2DoubleOp "float2Double#" GenPrimOp Float# -> Double# -primop FloatDecode_IntOp "decodeFloat_Int#" GenPrimOp - Float# -> (# Int#, Int# #) - {Convert to integers. - First {\tt Int\#} in result is the mantissa; second is the exponent.} - with out_of_line = True ------------------------------------------------------------------------- -section "Arrays" - {Operations on {\tt Array\#}.} ------------------------------------------------------------------------- -primtype Array# a -primtype MutableArray# s a -primop NewArrayOp "newArray#" GenPrimOp - Int# -> a -> State# s -> (# State# s, MutableArray# s a #) - {Create a new mutable array with the specified number of elements, - in the specified state thread, - with each element containing the specified initial value.} - with - out_of_line = True - has_side_effects = True -primop SameMutableArrayOp "sameMutableArray#" GenPrimOp - MutableArray# s a -> MutableArray# s a -> Int# -primop ReadArrayOp "readArray#" GenPrimOp - MutableArray# s a -> Int# -> State# s -> (# State# s, a #) - {Read from specified index of mutable array. Result is not yet evaluated.} - with - has_side_effects = True - can_fail = True -primop WriteArrayOp "writeArray#" GenPrimOp - MutableArray# s a -> Int# -> a -> State# s -> State# s - {Write to specified index of mutable array.} - with - has_side_effects = True - can_fail = True - code_size = 2 -- card update too -primop SizeofArrayOp "sizeofArray#" GenPrimOp - Array# a -> Int# - {Return the number of elements in the array.} -primop SizeofMutableArrayOp "sizeofMutableArray#" GenPrimOp - MutableArray# s a -> Int# - {Return the number of elements in the array.} -primop IndexArrayOp "indexArray#" GenPrimOp - Array# a -> Int# -> (# a #) - {Read from specified index of immutable array. Result is packaged into - an unboxed singleton; the result itself is not yet evaluated.} - with - can_fail = True -primop UnsafeFreezeArrayOp "unsafeFreezeArray#" GenPrimOp - MutableArray# s a -> State# s -> (# State# s, Array# a #) - {Make a mutable array immutable, without copying.} - with - has_side_effects = True -primop UnsafeThawArrayOp "unsafeThawArray#" GenPrimOp - Array# a -> State# s -> (# State# s, MutableArray# s a #) - {Make an immutable array mutable, without copying.} - with - out_of_line = True - has_side_effects = True -primop CopyArrayOp "copyArray#" GenPrimOp - Array# a -> Int# -> MutableArray# s a -> Int# -> Int# -> State# s -> State# s - {Given a source array, an offset into the source array, a - destination array, an offset into the destination array, and a - number of elements to copy, copy the elements from the source array - to the destination array. Both arrays must fully contain the - specified ranges, but this is not checked. The two arrays must not - be the same array in different states, but this is not checked - either.} - with - out_of_line = True - has_side_effects = True - can_fail = True -primop CopyMutableArrayOp "copyMutableArray#" GenPrimOp - MutableArray# s a -> Int# -> MutableArray# s a -> Int# -> Int# -> State# s -> State# s - {Given a source array, an offset into the source array, a - destination array, an offset into the destination array, and a - number of elements to copy, copy the elements from the source array - to the destination array. The source and destination arrays can - refer to the same array. Both arrays must fully contain the - specified ranges, but this is not checked.} - with - out_of_line = True - has_side_effects = True - can_fail = True -primop CloneArrayOp "cloneArray#" GenPrimOp - Array# a -> Int# -> Int# -> Array# a - {Given a source array, an offset into the source array, and a number - of elements to copy, create a new array with the elements from the - source array. The provided array must fully contain the specified - range, but this is not checked.} - with - out_of_line = True - has_side_effects = True - can_fail = True -primop CloneMutableArrayOp "cloneMutableArray#" GenPrimOp - MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #) - {Given a source array, an offset into the source array, and a number - of elements to copy, create a new array with the elements from the - source array. The provided array must fully contain the specified - range, but this is not checked.} - with - out_of_line = True - has_side_effects = True - can_fail = True -primop FreezeArrayOp "freezeArray#" GenPrimOp - MutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, Array# a #) - {Given a source array, an offset into the source array, and a number - of elements to copy, create a new array with the elements from the - source array. The provided array must fully contain the specified - range, but this is not checked.} - with - out_of_line = True - has_side_effects = True - can_fail = True -primop ThawArrayOp "thawArray#" GenPrimOp - Array# a -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a #) - {Given a source array, an offset into the source array, and a number - of elements to copy, create a new array with the elements from the - source array. The provided array must fully contain the specified - range, but this is not checked.} - with - out_of_line = True - has_side_effects = True - can_fail = True -primop CasArrayOp "casArray#" GenPrimOp - MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #) - {Unsafe, machine-level atomic compare and swap on an element within an Array.} - with - out_of_line = True - has_side_effects = True ------------------------------------------------------------------------- -section "Small Arrays" - {Operations on {\tt SmallArray\#}. A {\tt SmallArray\#} works - just like an {\tt Array\#}, but with different space use and - performance characteristics (that are often useful with small - arrays). The {\tt SmallArray\#} and {\tt SmallMutableArray#} - lack a `card table'. The purpose of a card table is to avoid - having to scan every element of the array on each GC by - keeping track of which elements have changed since the last GC - and only scanning those that have changed. So the consequence - of there being no card table is that the representation is - somewhat smaller and the writes are somewhat faster (because - the card table does not need to be updated). The disadvantage - of course is that for a {\tt SmallMutableArray#} the whole - array has to be scanned on each GC. Thus it is best suited for - use cases where the mutable array is not long lived, e.g. - where a mutable array is initialised quickly and then frozen - to become an immutable {\tt SmallArray\#}. - } ------------------------------------------------------------------------- -primtype SmallArray# a -primtype SmallMutableArray# s a -primop NewSmallArrayOp "newSmallArray#" GenPrimOp - Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #) - {Create a new mutable array with the specified number of elements, - in the specified state thread, - with each element containing the specified initial value.} - with - out_of_line = True - has_side_effects = True -primop SameSmallMutableArrayOp "sameSmallMutableArray#" GenPrimOp - SmallMutableArray# s a -> SmallMutableArray# s a -> Int# -primop ReadSmallArrayOp "readSmallArray#" GenPrimOp - SmallMutableArray# s a -> Int# -> State# s -> (# State# s, a #) - {Read from specified index of mutable array. Result is not yet evaluated.} - with - has_side_effects = True - can_fail = True -primop WriteSmallArrayOp "writeSmallArray#" GenPrimOp - SmallMutableArray# s a -> Int# -> a -> State# s -> State# s - {Write to specified index of mutable array.} - with - has_side_effects = True - can_fail = True -primop SizeofSmallArrayOp "sizeofSmallArray#" GenPrimOp - SmallArray# a -> Int# - {Return the number of elements in the array.} -primop SizeofSmallMutableArrayOp "sizeofSmallMutableArray#" GenPrimOp - SmallMutableArray# s a -> Int# - {Return the number of elements in the array.} -primop IndexSmallArrayOp "indexSmallArray#" GenPrimOp - SmallArray# a -> Int# -> (# a #) - {Read from specified index of immutable array. Result is packaged into - an unboxed singleton; the result itself is not yet evaluated.} - with - can_fail = True -primop UnsafeFreezeSmallArrayOp "unsafeFreezeSmallArray#" GenPrimOp - SmallMutableArray# s a -> State# s -> (# State# s, SmallArray# a #) - {Make a mutable array immutable, without copying.} - with - has_side_effects = True -primop UnsafeThawSmallArrayOp "unsafeThawSmallArray#" GenPrimOp - SmallArray# a -> State# s -> (# State# s, SmallMutableArray# s a #) - {Make an immutable array mutable, without copying.} - with - out_of_line = True - has_side_effects = True --- The code_size is only correct for the case when the copy family of --- primops aren't inlined. It would be nice to keep track of both. -primop CopySmallArrayOp "copySmallArray#" GenPrimOp - SmallArray# a -> Int# -> SmallMutableArray# s a -> Int# -> Int# -> State# s -> State# s - {Given a source array, an offset into the source array, a - destination array, an offset into the destination array, and a - number of elements to copy, copy the elements from the source array - to the destination array. Both arrays must fully contain the - specified ranges, but this is not checked. The two arrays must not - be the same array in different states, but this is not checked - either.} - with - out_of_line = True - has_side_effects = True - can_fail = True -primop CopySmallMutableArrayOp "copySmallMutableArray#" GenPrimOp - SmallMutableArray# s a -> Int# -> SmallMutableArray# s a -> Int# -> Int# -> State# s -> State# s - {Given a source array, an offset into the source array, a - destination array, an offset into the destination array, and a - number of elements to copy, copy the elements from the source array - to the destination array. The source and destination arrays can - refer to the same array. Both arrays must fully contain the - specified ranges, but this is not checked.} - with - out_of_line = True - has_side_effects = True - can_fail = True -primop CloneSmallArrayOp "cloneSmallArray#" GenPrimOp - SmallArray# a -> Int# -> Int# -> SmallArray# a - {Given a source array, an offset into the source array, and a number - of elements to copy, create a new array with the elements from the - source array. The provided array must fully contain the specified - range, but this is not checked.} - with - out_of_line = True - has_side_effects = True - can_fail = True -primop CloneSmallMutableArrayOp "cloneSmallMutableArray#" GenPrimOp - SmallMutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a #) - {Given a source array, an offset into the source array, and a number - of elements to copy, create a new array with the elements from the - source array. The provided array must fully contain the specified - range, but this is not checked.} - with - out_of_line = True - has_side_effects = True - can_fail = True -primop FreezeSmallArrayOp "freezeSmallArray#" GenPrimOp - SmallMutableArray# s a -> Int# -> Int# -> State# s -> (# State# s, SmallArray# a #) - {Given a source array, an offset into the source array, and a number - of elements to copy, create a new array with the elements from the - source array. The provided array must fully contain the specified - range, but this is not checked.} - with - out_of_line = True - has_side_effects = True - can_fail = True -primop ThawSmallArrayOp "thawSmallArray#" GenPrimOp - SmallArray# a -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a #) - {Given a source array, an offset into the source array, and a number - of elements to copy, create a new array with the elements from the - source array. The provided array must fully contain the specified - range, but this is not checked.} - with - out_of_line = True - has_side_effects = True - can_fail = True -primop CasSmallArrayOp "casSmallArray#" GenPrimOp - SmallMutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a #) - {Unsafe, machine-level atomic compare and swap on an element within an array.} - with - out_of_line = True - has_side_effects = True ------------------------------------------------------------------------- -section "Byte Arrays" - {Operations on {\tt ByteArray\#}. A {\tt ByteArray\#} is a just a region of - raw memory in the garbage-collected heap, which is not - scanned for pointers. It carries its own size (in bytes). - There are - three sets of operations for accessing byte array contents: - index for reading from immutable byte arrays, and read/write - for mutable byte arrays. Each set contains operations for a - range of useful primitive data types. Each operation takes - an offset measured in terms of the size of the primitive type - being read or written.} ------------------------------------------------------------------------- -primtype ByteArray# -primtype MutableByteArray# s -primop NewByteArrayOp_Char "newByteArray#" GenPrimOp - Int# -> State# s -> (# State# s, MutableByteArray# s #) - {Create a new mutable byte array of specified size (in bytes), in - the specified state thread.} - with out_of_line = True - has_side_effects = True -primop NewPinnedByteArrayOp_Char "newPinnedByteArray#" GenPrimOp - Int# -> State# s -> (# State# s, MutableByteArray# s #) - {Create a mutable byte array that the GC guarantees not to move.} - with out_of_line = True - has_side_effects = True -primop NewAlignedPinnedByteArrayOp_Char "newAlignedPinnedByteArray#" GenPrimOp - Int# -> Int# -> State# s -> (# State# s, MutableByteArray# s #) - {Create a mutable byte array, aligned by the specified amount, that the GC guarantees not to move.} - with out_of_line = True - has_side_effects = True -primop ByteArrayContents_Char "byteArrayContents#" GenPrimOp - ByteArray# -> Addr# - {Intended for use with pinned arrays; otherwise very unsafe!} -primop SameMutableByteArrayOp "sameMutableByteArray#" GenPrimOp - MutableByteArray# s -> MutableByteArray# s -> Int# -primop ShrinkMutableByteArrayOp_Char "shrinkMutableByteArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> State# s - {Shrink mutable byte array to new specified size (in bytes), in - the specified state thread. The new size argument must be less than or - equal to the current size as reported by {\tt sizeofMutableArray\#}.} - with out_of_line = True - has_side_effects = True -primop ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #) - {Resize (unpinned) mutable byte array to new specified size (in bytes). - The returned {\tt MutableByteArray\#} is either the original - {\tt MutableByteArray\#} resized in-place or, if not possible, a newly - allocated (unpinned) {\tt MutableByteArray\#} (with the original content - copied over). - To avoid undefined behaviour, the original {\tt MutableByteArray\#} shall - not be accessed anymore after a {\tt resizeMutableByteArray\#} has been - performed. Moreover, no reference to the old one should be kept in order - to allow garbage collection of the original {\tt MutableByteArray\#} in - case a new {\tt MutableByteArray\#} had to be allocated.} - with out_of_line = True - has_side_effects = True -primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp - MutableByteArray# s -> State# s -> (# State# s, ByteArray# #) - {Make a mutable byte array immutable, without copying.} - with - has_side_effects = True -primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp - ByteArray# -> Int# - {Return the size of the array in bytes.} -primop SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp - MutableByteArray# s -> Int# - {Return the size of the array in bytes.} -primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read 8-bit character; offset in bytes.} - with can_fail = True -primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read 31-bit character; offset in 4-byte words.} - with can_fail = True -primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp - ByteArray# -> Int# -> Int# - with can_fail = True -primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp - ByteArray# -> Int# -> Word# - with can_fail = True -primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp - ByteArray# -> Int# -> Addr# - with can_fail = True -primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp - ByteArray# -> Int# -> Float# - with can_fail = True -primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp - ByteArray# -> Int# -> Double# - with can_fail = True -primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp - ByteArray# -> Int# -> StablePtr# a - with can_fail = True -primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp - ByteArray# -> Int# -> Int# - {Read 8-bit integer; offset in bytes.} - with can_fail = True -primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp - ByteArray# -> Int# -> Int# - {Read 16-bit integer; offset in 16-bit words.} - with can_fail = True -primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp - ByteArray# -> Int# -> Int# - {Read 32-bit integer; offset in 32-bit words.} - with can_fail = True -primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp - ByteArray# -> Int# -> Int64# - {Read 64-bit integer; offset in 64-bit words.} - with can_fail = True -primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp - ByteArray# -> Int# -> Word# - {Read 8-bit word; offset in bytes.} - with can_fail = True -primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp - ByteArray# -> Int# -> Word# - {Read 16-bit word; offset in 16-bit words.} - with can_fail = True -primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp - ByteArray# -> Int# -> Word# - {Read 32-bit word; offset in 32-bit words.} - with can_fail = True -primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp - ByteArray# -> Int# -> Word64# - {Read 64-bit word; offset in 64-bit words.} - with can_fail = True -primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True -primop ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read 31-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True -primop ReadByteArrayOp_Int "readIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - {Read intger; offset in words.} - with has_side_effects = True - can_fail = True -primop ReadByteArrayOp_Word "readWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - {Read word; offset in words.} - with has_side_effects = True - can_fail = True -primop ReadByteArrayOp_Addr "readAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) - with has_side_effects = True - can_fail = True -primop ReadByteArrayOp_Float "readFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) - with has_side_effects = True - can_fail = True -primop ReadByteArrayOp_Double "readDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) - with has_side_effects = True - can_fail = True -primop ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) - with has_side_effects = True - can_fail = True -primop ReadByteArrayOp_Int8 "readInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True -primop ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True -primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True -primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #) - with has_side_effects = True - can_fail = True -primop ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True -primop ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True -primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True -primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #) - with has_side_effects = True - can_fail = True -primop WriteByteArrayOp_Char "writeCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True -primop WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write 31-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True -primop WriteByteArrayOp_Int "writeIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteByteArrayOp_Word "writeWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteByteArrayOp_Addr "writeAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteByteArrayOp_Float "writeFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> Float# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteByteArrayOp_Double "writeDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> Double# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteByteArrayOp_StablePtr "writeStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteByteArrayOp_Int8 "writeInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s - with can_fail = True - has_side_effects = True -primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteByteArrayOp_Word16 "writeWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop CopyByteArrayOp "copyByteArray#" GenPrimOp - ByteArray# -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Copy a range of the ByteArray# to the specified region in the MutableByteArray#. - Both arrays must fully contain the specified ranges, but this is not checked. - The two arrays must not be the same array in different states, but this is not checked either.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4} - can_fail = True -primop CopyMutableByteArrayOp "copyMutableByteArray#" GenPrimOp - MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Copy a range of the first MutableByteArray# to the specified region in the second MutableByteArray#. - Both arrays must fully contain the specified ranges, but this is not checked.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4 } - can_fail = True -primop CopyByteArrayToAddrOp "copyByteArrayToAddr#" GenPrimOp - ByteArray# -> Int# -> Addr# -> Int# -> State# s -> State# s - {Copy a range of the ByteArray# to the memory range starting at the Addr#. - The ByteArray# and the memory region at Addr# must fully contain the - specified ranges, but this is not checked. The Addr# must not point into the - ByteArray# (e.g. if the ByteArray# were pinned), but this is not checked - either.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4} - can_fail = True -primop CopyMutableByteArrayToAddrOp "copyMutableByteArrayToAddr#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> Int# -> State# s -> State# s - {Copy a range of the MutableByteArray# to the memory range starting at the - Addr#. The MutableByteArray# and the memory region at Addr# must fully - contain the specified ranges, but this is not checked. The Addr# must not - point into the MutableByteArray# (e.g. if the MutableByteArray# were - pinned), but this is not checked either.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4} - can_fail = True -primop CopyAddrToByteArrayOp "copyAddrToByteArray#" GenPrimOp - Addr# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Copy a memory range starting at the Addr# to the specified range in the - MutableByteArray#. The memory region at Addr# and the ByteArray# must fully - contain the specified ranges, but this is not checked. The Addr# must not - point into the MutableByteArray# (e.g. if the MutableByteArray# were pinned), - but this is not checked either.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4} - can_fail = True -primop SetByteArrayOp "setByteArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> State# s - {Set the range of the MutableByteArray# to the specified character.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall + 4 } - can_fail = True --- Atomic operations -primop AtomicReadByteArrayOp_Int "atomicReadIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - {Given an array and an offset in Int units, read an element. The - index is assumed to be in bounds. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True -primop AtomicWriteByteArrayOp_Int "atomicWriteIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Given an array and an offset in Int units, write an element. The - index is assumed to be in bounds. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True -primop CasByteArrayOp_Int "casIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> (# State# s, Int# #) - {Given an array, an offset in Int units, the expected old value, and - the new value, perform an atomic compare and swap i.e. write the new - value if the current value matches the provided old value. Returns - the value of the element before the operation. Implies a full memory - barrier.} - with has_side_effects = True - can_fail = True -primop FetchAddByteArrayOp_Int "fetchAddIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) - {Given an array, and offset in Int units, and a value to add, - atomically add the value to the element. Returns the value of the - element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True -primop FetchSubByteArrayOp_Int "fetchSubIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) - {Given an array, and offset in Int units, and a value to subtract, - atomically substract the value to the element. Returns the value of - the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True -primop FetchAndByteArrayOp_Int "fetchAndIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) - {Given an array, and offset in Int units, and a value to AND, - atomically AND the value to the element. Returns the value of the - element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True -primop FetchNandByteArrayOp_Int "fetchNandIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) - {Given an array, and offset in Int units, and a value to NAND, - atomically NAND the value to the element. Returns the value of the - element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True -primop FetchOrByteArrayOp_Int "fetchOrIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) - {Given an array, and offset in Int units, and a value to OR, - atomically OR the value to the element. Returns the value of the - element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True -primop FetchXorByteArrayOp_Int "fetchXorIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) - {Given an array, and offset in Int units, and a value to XOR, - atomically XOR the value to the element. Returns the value of the - element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True ------------------------------------------------------------------------- -section "Arrays of arrays" - {Operations on {\tt ArrayArray\#}. An {\tt ArrayArray\#} contains references to {\em unpointed} - arrays, such as {\tt ByteArray\#s}. Hence, it is not parameterised by the element types, - just like a {\tt ByteArray\#}, but it needs to be scanned during GC, just like an {\tt Array#}. - We represent an {\tt ArrayArray\#} exactly as a {\tt Array\#}, but provide element-type-specific - indexing, reading, and writing.} ------------------------------------------------------------------------- -primtype ArrayArray# -primtype MutableArrayArray# s -primop NewArrayArrayOp "newArrayArray#" GenPrimOp - Int# -> State# s -> (# State# s, MutableArrayArray# s #) - {Create a new mutable array of arrays with the specified number of elements, - in the specified state thread, with each element recursively referring to the - newly created array.} - with - out_of_line = True - has_side_effects = True -primop SameMutableArrayArrayOp "sameMutableArrayArray#" GenPrimOp - MutableArrayArray# s -> MutableArrayArray# s -> Int# -primop UnsafeFreezeArrayArrayOp "unsafeFreezeArrayArray#" GenPrimOp - MutableArrayArray# s -> State# s -> (# State# s, ArrayArray# #) - {Make a mutable array of arrays immutable, without copying.} - with - has_side_effects = True -primop SizeofArrayArrayOp "sizeofArrayArray#" GenPrimOp - ArrayArray# -> Int# - {Return the number of elements in the array.} -primop SizeofMutableArrayArrayOp "sizeofMutableArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# - {Return the number of elements in the array.} -primop IndexArrayArrayOp_ByteArray "indexByteArrayArray#" GenPrimOp - ArrayArray# -> Int# -> ByteArray# - with can_fail = True -primop IndexArrayArrayOp_ArrayArray "indexArrayArrayArray#" GenPrimOp - ArrayArray# -> Int# -> ArrayArray# - with can_fail = True -primop ReadArrayArrayOp_ByteArray "readByteArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> State# s -> (# State# s, ByteArray# #) - with has_side_effects = True - can_fail = True -primop ReadArrayArrayOp_MutableByteArray "readMutableByteArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #) - with has_side_effects = True - can_fail = True -primop ReadArrayArrayOp_ArrayArray "readArrayArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> State# s -> (# State# s, ArrayArray# #) - with has_side_effects = True - can_fail = True -primop ReadArrayArrayOp_MutableArrayArray "readMutableArrayArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> State# s -> (# State# s, MutableArrayArray# s #) - with has_side_effects = True - can_fail = True -primop WriteArrayArrayOp_ByteArray "writeByteArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> ByteArray# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteArrayArrayOp_MutableByteArray "writeMutableByteArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> MutableByteArray# s -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteArrayArrayOp_ArrayArray "writeArrayArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> ArrayArray# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteArrayArrayOp_MutableArrayArray "writeMutableArrayArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> MutableArrayArray# s -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop CopyArrayArrayOp "copyArrayArray#" GenPrimOp - ArrayArray# -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s - {Copy a range of the ArrayArray# to the specified region in the MutableArrayArray#. - Both arrays must fully contain the specified ranges, but this is not checked. - The two arrays must not be the same array in different states, but this is not checked either.} - with - out_of_line = True - has_side_effects = True - can_fail = True -primop CopyMutableArrayArrayOp "copyMutableArrayArray#" GenPrimOp - MutableArrayArray# s -> Int# -> MutableArrayArray# s -> Int# -> Int# -> State# s -> State# s - {Copy a range of the first MutableArrayArray# to the specified region in the second - MutableArrayArray#. - Both arrays must fully contain the specified ranges, but this is not checked.} - with - out_of_line = True - has_side_effects = True - can_fail = True ------------------------------------------------------------------------- -section "Addr#" ------------------------------------------------------------------------- -primtype Addr# - { An arbitrary machine address assumed to point outside - the garbage-collected heap. } -pseudoop "nullAddr#" Addr# - { The null address. } -primop AddrAddOp "plusAddr#" GenPrimOp Addr# -> Int# -> Addr# -primop AddrSubOp "minusAddr#" GenPrimOp Addr# -> Addr# -> Int# - {Result is meaningless if two {\tt Addr\#}s are so far apart that their - difference doesn't fit in an {\tt Int\#}.} -primop AddrRemOp "remAddr#" GenPrimOp Addr# -> Int# -> Int# - {Return the remainder when the {\tt Addr\#} arg, treated like an {\tt Int\#}, - is divided by the {\tt Int\#} arg.} -primop Addr2IntOp "addr2Int#" GenPrimOp Addr# -> Int# - {Coerce directly from address to int. Strongly deprecated.} - with code_size = 0 -primop Int2AddrOp "int2Addr#" GenPrimOp Int# -> Addr# - {Coerce directly from int to address. Strongly deprecated.} - with code_size = 0 -primop AddrGtOp "gtAddr#" Compare Addr# -> Addr# -> Int# -primop AddrGeOp "geAddr#" Compare Addr# -> Addr# -> Int# -primop AddrEqOp "eqAddr#" Compare Addr# -> Addr# -> Int# -primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Int# -primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Int# -primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Int# -primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 8-bit character; offset in bytes.} - with can_fail = True -primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 31-bit character; offset in 4-byte words.} - with can_fail = True -primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# - with can_fail = True -primop IndexOffAddrOp_Word "indexWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# - with can_fail = True -primop IndexOffAddrOp_Addr "indexAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# - with can_fail = True -primop IndexOffAddrOp_Float "indexFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# - with can_fail = True -primop IndexOffAddrOp_Double "indexDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# - with can_fail = True -primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a - with can_fail = True -primop IndexOffAddrOp_Int8 "indexInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int# - with can_fail = True -primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int# - with can_fail = True -primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int# - with can_fail = True -primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# - with can_fail = True -primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word# - with can_fail = True -primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word# - with can_fail = True -primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word# - with can_fail = True -primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# - with can_fail = True -primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True -primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 31-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True -primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True -primop ReadOffAddrOp_Word "readWordOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True -primop ReadOffAddrOp_Addr "readAddrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Addr# #) - with has_side_effects = True - can_fail = True -primop ReadOffAddrOp_Float "readFloatOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Float# #) - with has_side_effects = True - can_fail = True -primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Double# #) - with has_side_effects = True - can_fail = True -primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #) - with has_side_effects = True - can_fail = True -primop ReadOffAddrOp_Int8 "readInt8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True -primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True -primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True -primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int64# #) - with has_side_effects = True - can_fail = True -primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True -primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True -primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True -primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word64# #) - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_WideChar "writeWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_Word "writeWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_Double "writeDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_Int8 "writeInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_Word16 "writeWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True -primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# -> State# s -> State# s - with has_side_effects = True - can_fail = True ------------------------------------------------------------------------- -section "Mutable variables" - {Operations on MutVar\#s.} ------------------------------------------------------------------------- -primtype MutVar# s a - {A {\tt MutVar\#} behaves like a single-element mutable array.} -primop NewMutVarOp "newMutVar#" GenPrimOp - a -> State# s -> (# State# s, MutVar# s a #) - {Create {\tt MutVar\#} with specified initial value in specified state thread.} - with - out_of_line = True - has_side_effects = True -primop ReadMutVarOp "readMutVar#" GenPrimOp - MutVar# s a -> State# s -> (# State# s, a #) - {Read contents of {\tt MutVar\#}. Result is not yet evaluated.} - with - has_side_effects = True - can_fail = True -primop WriteMutVarOp "writeMutVar#" GenPrimOp - MutVar# s a -> a -> State# s -> State# s - {Write contents of {\tt MutVar\#}.} - with - has_side_effects = True - code_size = { primOpCodeSizeForeignCall } -- for the write barrier - can_fail = True -primop SameMutVarOp "sameMutVar#" GenPrimOp - MutVar# s a -> MutVar# s a -> Int# --- not really the right type, but we don't know about pairs here. The --- correct type is --- --- MutVar# s a -> (a -> (a,b)) -> State# s -> (# State# s, b #) --- -primop AtomicModifyMutVarOp "atomicModifyMutVar#" GenPrimOp - MutVar# s a -> (a -> b) -> State# s -> (# State# s, c #) - with - out_of_line = True - has_side_effects = True - can_fail = True -primop CasMutVarOp "casMutVar#" GenPrimOp - MutVar# s a -> a -> a -> State# s -> (# State# s, Int#, a #) - with - out_of_line = True - has_side_effects = True ------------------------------------------------------------------------- -section "Exceptions" ------------------------------------------------------------------------- -primop CatchOp "catch#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #) ) - -> (b -> State# RealWorld -> (# State# RealWorld, a #) ) - -> State# RealWorld - -> (# State# RealWorld, a #) - with - -- Catch is actually strict in its first argument - -- but we don't want to tell the strictness - -- analyser about that, so that exceptions stay inside it. - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,apply2Dmd,topDmd] topRes } - out_of_line = True - has_side_effects = True -primop RaiseOp "raise#" GenPrimOp - a -> b - with - strictness = { \ _arity -> mkClosedStrictSig [topDmd] botRes } - -- NB: result is bottom - out_of_line = True - has_side_effects = True - -- raise# certainly throws a Haskell exception and hence has_side_effects - -- It doesn't actually make much difference because the fact that it - -- returns bottom independently ensures that we are careful not to discard - -- it. But still, it's better to say the Right Thing. --- raiseIO# needs to be a primop, because exceptions in the IO monad --- must be *precise* - we don't want the strictness analyser turning --- one kind of bottom into another, as it is allowed to do in pure code. --- --- But we *do* want to know that it returns bottom after --- being applied to two arguments, so that this function is strict in y --- f x y | x>0 = raiseIO blah --- | y>0 = return 1 --- | otherwise = return 2 -primop RaiseIOOp "raiseIO#" GenPrimOp - a -> State# RealWorld -> (# State# RealWorld, b #) - with - strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] botRes } - out_of_line = True - has_side_effects = True -primop MaskAsyncExceptionsOp "maskAsyncExceptions#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #)) - -> (State# RealWorld -> (# State# RealWorld, a #)) - with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes } - out_of_line = True - has_side_effects = True -primop MaskUninterruptibleOp "maskUninterruptible#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #)) - -> (State# RealWorld -> (# State# RealWorld, a #)) - with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes } - out_of_line = True - has_side_effects = True -primop UnmaskAsyncExceptionsOp "unmaskAsyncExceptions#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #)) - -> (State# RealWorld -> (# State# RealWorld, a #)) - with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes } - out_of_line = True - has_side_effects = True -primop MaskStatus "getMaskingState#" GenPrimOp - State# RealWorld -> (# State# RealWorld, Int# #) - with - out_of_line = True - has_side_effects = True ------------------------------------------------------------------------- -section "STM-accessible Mutable Variables" ------------------------------------------------------------------------- -primtype TVar# s a -primop AtomicallyOp "atomically#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #) ) - -> State# RealWorld -> (# State# RealWorld, a #) - with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,topDmd] topRes } - out_of_line = True - has_side_effects = True --- NB: retry#'s strictness information specifies it to return bottom. --- This lets the compiler perform some extra simplifications, since retry# --- will technically never return. --- --- This allows the simplifier to replace things like: --- case retry# s1 --- (# s2, a #) -> e --- with: --- retry# s1 --- where 'e' would be unreachable anyway. See Trac #8091. -primop RetryOp "retry#" GenPrimOp - State# RealWorld -> (# State# RealWorld, a #) - with - strictness = { \ _arity -> mkClosedStrictSig [topDmd] botRes } - out_of_line = True - has_side_effects = True -primop CatchRetryOp "catchRetry#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #) ) - -> (State# RealWorld -> (# State# RealWorld, a #) ) - -> (State# RealWorld -> (# State# RealWorld, a #) ) - with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,apply1Dmd,topDmd] topRes } - out_of_line = True - has_side_effects = True -primop CatchSTMOp "catchSTM#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #) ) - -> (b -> State# RealWorld -> (# State# RealWorld, a #) ) - -> (State# RealWorld -> (# State# RealWorld, a #) ) - with - strictness = { \ _arity -> mkClosedStrictSig [apply1Dmd,apply2Dmd,topDmd] topRes } - out_of_line = True - has_side_effects = True -primop Check "check#" GenPrimOp - (State# RealWorld -> (# State# RealWorld, a #) ) - -> (State# RealWorld -> (# State# RealWorld, () #) ) - with - out_of_line = True - has_side_effects = True -primop NewTVarOp "newTVar#" GenPrimOp - a - -> State# s -> (# State# s, TVar# s a #) - {Create a new {\tt TVar\#} holding a specified initial value.} - with - out_of_line = True - has_side_effects = True -primop ReadTVarOp "readTVar#" GenPrimOp - TVar# s a - -> State# s -> (# State# s, a #) - {Read contents of {\tt TVar\#}. Result is not yet evaluated.} - with - out_of_line = True - has_side_effects = True -primop ReadTVarIOOp "readTVarIO#" GenPrimOp - TVar# s a - -> State# s -> (# State# s, a #) - {Read contents of {\tt TVar\#} outside an STM transaction} - with - out_of_line = True - has_side_effects = True -primop WriteTVarOp "writeTVar#" GenPrimOp - TVar# s a - -> a - -> State# s -> State# s - {Write contents of {\tt TVar\#}.} - with - out_of_line = True - has_side_effects = True -primop SameTVarOp "sameTVar#" GenPrimOp - TVar# s a -> TVar# s a -> Int# ------------------------------------------------------------------------- -section "Synchronized Mutable Variables" - {Operations on {\tt MVar\#}s. } ------------------------------------------------------------------------- -primtype MVar# s a - { A shared mutable variable ({\it not} the same as a {\tt MutVar\#}!). - (Note: in a non-concurrent implementation, {\tt (MVar\# a)} can be - represented by {\tt (MutVar\# (Maybe a))}.) } -primop NewMVarOp "newMVar#" GenPrimOp - State# s -> (# State# s, MVar# s a #) - {Create new {\tt MVar\#}; initially empty.} - with - out_of_line = True - has_side_effects = True -primop TakeMVarOp "takeMVar#" GenPrimOp - MVar# s a -> State# s -> (# State# s, a #) - {If {\tt MVar\#} is empty, block until it becomes full. - Then remove and return its contents, and set it empty.} - with - out_of_line = True - has_side_effects = True -primop TryTakeMVarOp "tryTakeMVar#" GenPrimOp - MVar# s a -> State# s -> (# State# s, Int#, a #) - {If {\tt MVar\#} is empty, immediately return with integer 0 and value undefined. - Otherwise, return with integer 1 and contents of {\tt MVar\#}, and set {\tt MVar\#} empty.} - with - out_of_line = True - has_side_effects = True -primop PutMVarOp "putMVar#" GenPrimOp - MVar# s a -> a -> State# s -> State# s - {If {\tt MVar\#} is full, block until it becomes empty. - Then store value arg as its new contents.} - with - out_of_line = True - has_side_effects = True -primop TryPutMVarOp "tryPutMVar#" GenPrimOp - MVar# s a -> a -> State# s -> (# State# s, Int# #) - {If {\tt MVar\#} is full, immediately return with integer 0. - Otherwise, store value arg as {\tt MVar\#}'s new contents, and return with integer 1.} - with - out_of_line = True - has_side_effects = True -primop ReadMVarOp "readMVar#" GenPrimOp - MVar# s a -> State# s -> (# State# s, a #) - {If {\tt MVar\#} is empty, block until it becomes full. - Then read its contents without modifying the MVar, without possibility - of intervention from other threads.} - with - out_of_line = True - has_side_effects = True -primop TryReadMVarOp "tryReadMVar#" GenPrimOp - MVar# s a -> State# s -> (# State# s, Int#, a #) - {If {\tt MVar\#} is empty, immediately return with integer 0 and value undefined. - Otherwise, return with integer 1 and contents of {\tt MVar\#}.} - with - out_of_line = True - has_side_effects = True -primop SameMVarOp "sameMVar#" GenPrimOp - MVar# s a -> MVar# s a -> Int# -primop IsEmptyMVarOp "isEmptyMVar#" GenPrimOp - MVar# s a -> State# s -> (# State# s, Int# #) - {Return 1 if {\tt MVar\#} is empty; 0 otherwise.} - with - out_of_line = True - has_side_effects = True ------------------------------------------------------------------------- -section "Delay/wait operations" ------------------------------------------------------------------------- -primop DelayOp "delay#" GenPrimOp - Int# -> State# s -> State# s - {Sleep specified number of microseconds.} - with - has_side_effects = True - out_of_line = True -primop WaitReadOp "waitRead#" GenPrimOp - Int# -> State# s -> State# s - {Block until input is available on specified file descriptor.} - with - has_side_effects = True - out_of_line = True -primop WaitWriteOp "waitWrite#" GenPrimOp - Int# -> State# s -> State# s - {Block until output is possible on specified file descriptor.} - with - has_side_effects = True - out_of_line = True ------------------------------------------------------------------------- -section "Concurrency primitives" ------------------------------------------------------------------------- -primtype State# s - { {\tt State\#} is the primitive, unlifted type of states. It has - one type parameter, thus {\tt State\# RealWorld}, or {\tt State\# s}, - where s is a type variable. The only purpose of the type parameter - is to keep different state threads separate. It is represented by - nothing at all. } -primtype RealWorld - { {\tt RealWorld} is deeply magical. It is {\it primitive}, but it is not - {\it unlifted} (hence {\tt ptrArg}). We never manipulate values of type - {\tt RealWorld}; it's only used in the type system, to parameterise {\tt State\#}. } -primtype ThreadId# - {(In a non-concurrent implementation, this can be a singleton - type, whose (unique) value is returned by {\tt myThreadId\#}. The - other operations can be omitted.)} -primop ForkOp "fork#" GenPrimOp - a -> State# RealWorld -> (# State# RealWorld, ThreadId# #) - with - has_side_effects = True - out_of_line = True -primop ForkOnOp "forkOn#" GenPrimOp - Int# -> a -> State# RealWorld -> (# State# RealWorld, ThreadId# #) - with - has_side_effects = True - out_of_line = True -primop KillThreadOp "killThread#" GenPrimOp - ThreadId# -> a -> State# RealWorld -> State# RealWorld - with - has_side_effects = True - out_of_line = True -primop YieldOp "yield#" GenPrimOp - State# RealWorld -> State# RealWorld - with - has_side_effects = True - out_of_line = True -primop MyThreadIdOp "myThreadId#" GenPrimOp - State# RealWorld -> (# State# RealWorld, ThreadId# #) - with - out_of_line = True - has_side_effects = True -primop LabelThreadOp "labelThread#" GenPrimOp - ThreadId# -> Addr# -> State# RealWorld -> State# RealWorld - with - has_side_effects = True - out_of_line = True -primop IsCurrentThreadBoundOp "isCurrentThreadBound#" GenPrimOp - State# RealWorld -> (# State# RealWorld, Int# #) - with - out_of_line = True - has_side_effects = True -primop NoDuplicateOp "noDuplicate#" GenPrimOp - State# RealWorld -> State# RealWorld - with - out_of_line = True - has_side_effects = True -primop ThreadStatusOp "threadStatus#" GenPrimOp - ThreadId# -> State# RealWorld -> (# State# RealWorld, Int#, Int#, Int# #) - with - out_of_line = True - has_side_effects = True ------------------------------------------------------------------------- -section "Weak pointers" ------------------------------------------------------------------------- -primtype Weak# b --- note that tyvar "o" denotes openAlphaTyVar -primop MkWeakOp "mkWeak#" GenPrimOp - o -> b -> c -> State# RealWorld -> (# State# RealWorld, Weak# b #) - with - has_side_effects = True - out_of_line = True -primop MkWeakNoFinalizerOp "mkWeakNoFinalizer#" GenPrimOp - o -> b -> State# RealWorld -> (# State# RealWorld, Weak# b #) - with - has_side_effects = True - out_of_line = True -primop AddCFinalizerToWeakOp "addCFinalizerToWeak#" GenPrimOp - Addr# -> Addr# -> Int# -> Addr# -> Weak# b - -> State# RealWorld -> (# State# RealWorld, Int# #) - { {\tt addCFinalizerToWeak# fptr ptr flag eptr w} attaches a C - function pointer {\tt fptr} to a weak pointer {\tt w} as a finalizer. If - {\tt flag} is zero, {\tt fptr} will be called with one argument, - {\tt ptr}. Otherwise, it will be called with two arguments, - {\tt eptr} and {\tt ptr}. {\tt addCFinalizerToWeak#} returns - 1 on success, or 0 if {\tt w} is already dead. } - with - has_side_effects = True - out_of_line = True -primop DeRefWeakOp "deRefWeak#" GenPrimOp - Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, a #) - with - has_side_effects = True - out_of_line = True -primop FinalizeWeakOp "finalizeWeak#" GenPrimOp - Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, - (State# RealWorld -> (# State# RealWorld, () #)) #) - with - has_side_effects = True - out_of_line = True -primop TouchOp "touch#" GenPrimOp - o -> State# RealWorld -> State# RealWorld - with - code_size = { 0 } - has_side_effects = True ------------------------------------------------------------------------- -section "Stable pointers and names" ------------------------------------------------------------------------- -primtype StablePtr# a -primtype StableName# a -primop MakeStablePtrOp "makeStablePtr#" GenPrimOp - a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #) - with - has_side_effects = True - out_of_line = True -primop DeRefStablePtrOp "deRefStablePtr#" GenPrimOp - StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #) - with - has_side_effects = True - out_of_line = True -primop EqStablePtrOp "eqStablePtr#" GenPrimOp - StablePtr# a -> StablePtr# a -> Int# - with - has_side_effects = True -primop MakeStableNameOp "makeStableName#" GenPrimOp - a -> State# RealWorld -> (# State# RealWorld, StableName# a #) - with - has_side_effects = True - out_of_line = True -primop EqStableNameOp "eqStableName#" GenPrimOp - StableName# a -> StableName# b -> Int# -primop StableNameToIntOp "stableNameToInt#" GenPrimOp - StableName# a -> Int# ------------------------------------------------------------------------- -section "Unsafe pointer equality" --- (#1 Bad Guy: Alistair Reid :) ------------------------------------------------------------------------- -primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp - a -> a -> Int# ------------------------------------------------------------------------- -section "Parallelism" ------------------------------------------------------------------------- -primop ParOp "par#" GenPrimOp - a -> Int# - with - -- Note that Par is lazy to avoid that the sparked thing - -- gets evaluted strictly, which it should *not* be - has_side_effects = True - code_size = { primOpCodeSizeForeignCall } -primop SparkOp "spark#" GenPrimOp - a -> State# s -> (# State# s, a #) - with has_side_effects = True - code_size = { primOpCodeSizeForeignCall } -primop SeqOp "seq#" GenPrimOp - a -> State# s -> (# State# s, a #) - -- why return the value? So that we can control sharing of seq'd - -- values: in - -- let x = e in x `seq` ... x ... - -- we don't want to inline x, so better to represent it as - -- let x = e in case seq# x RW of (# _, x' #) -> ... x' ... - -- also it matches the type of rseq in the Eval monad. -primop GetSparkOp "getSpark#" GenPrimOp - State# s -> (# State# s, Int#, a #) - with - has_side_effects = True - out_of_line = True -primop NumSparks "numSparks#" GenPrimOp - State# s -> (# State# s, Int# #) - { Returns the number of sparks in the local spark pool. } - with - has_side_effects = True - out_of_line = True --- HWL: The first 4 Int# in all par... annotations denote: --- name, granularity info, size of result, degree of parallelism --- Same structure as _seq_ i.e. returns Int# --- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine --- `the processor containing the expression v'; it is not evaluated -primop ParGlobalOp "parGlobal#" GenPrimOp - a -> Int# -> Int# -> Int# -> Int# -> b -> Int# - with - has_side_effects = True -primop ParLocalOp "parLocal#" GenPrimOp - a -> Int# -> Int# -> Int# -> Int# -> b -> Int# - with - has_side_effects = True -primop ParAtOp "parAt#" GenPrimOp - b -> a -> Int# -> Int# -> Int# -> Int# -> c -> Int# - with - has_side_effects = True -primop ParAtAbsOp "parAtAbs#" GenPrimOp - a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int# - with - has_side_effects = True -primop ParAtRelOp "parAtRel#" GenPrimOp - a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int# - with - has_side_effects = True -primop ParAtForNowOp "parAtForNow#" GenPrimOp - b -> a -> Int# -> Int# -> Int# -> Int# -> c -> Int# - with - has_side_effects = True --- copyable# and noFollow# are yet to be implemented (for GpH) --- ---primop CopyableOp "copyable#" GenPrimOp --- a -> Int# --- with --- has_side_effects = True --- ---primop NoFollowOp "noFollow#" GenPrimOp --- a -> Int# --- with --- has_side_effects = True ------------------------------------------------------------------------- -section "Tag to enum stuff" - {Convert back and forth between values of enumerated types - and small integers.} ------------------------------------------------------------------------- -primop DataToTagOp "dataToTag#" GenPrimOp - a -> Int# - with - strictness = { \ _arity -> mkClosedStrictSig [evalDmd] topRes } - -- dataToTag# must have an evaluated argument -primop TagToEnumOp "tagToEnum#" GenPrimOp - Int# -> a ------------------------------------------------------------------------- -section "Bytecode operations" - {Support for the bytecode interpreter and linker.} ------------------------------------------------------------------------- -primtype BCO# - {Primitive bytecode type.} -primop AddrToAnyOp "addrToAny#" GenPrimOp - Addr# -> (# a #) - {Convert an {\tt Addr\#} to a followable Any type.} - with - code_size = 0 -primop MkApUpd0_Op "mkApUpd0#" GenPrimOp - BCO# -> (# a #) - with - out_of_line = True -primop NewBCOOp "newBCO#" GenPrimOp - ByteArray# -> ByteArray# -> Array# a -> Int# -> ByteArray# -> State# s -> (# State# s, BCO# #) - with - has_side_effects = True - out_of_line = True -primop UnpackClosureOp "unpackClosure#" GenPrimOp - a -> (# Addr#, Array# b, ByteArray# #) - with - out_of_line = True -primop GetApStackValOp "getApStackVal#" GenPrimOp - a -> Int# -> (# Int#, b #) - with - out_of_line = True ------------------------------------------------------------------------- -section "Misc" - {These aren't nearly as wired in as Etc...} ------------------------------------------------------------------------- -primop GetCCSOfOp "getCCSOf#" GenPrimOp - a -> State# s -> (# State# s, Addr# #) -primop GetCurrentCCSOp "getCurrentCCS#" GenPrimOp - a -> State# s -> (# State# s, Addr# #) - { Returns the current {\tt CostCentreStack} (value is {\tt NULL} if - not profiling). Takes a dummy argument which can be used to - avoid the call to {\tt getCCCS\#} being floated out by the - simplifier, which would result in an uninformative stack - ("CAF"). } ------------------------------------------------------------------------- -section "Etc" - {Miscellaneous built-ins} ------------------------------------------------------------------------- -primtype Proxy# a - { The type constructor {\tt Proxy#} is used to bear witness to some - type variable. It's used when you want to pass around proxy values - for doing things like modelling type applications. A {\tt Proxy#} - is not only unboxed, it also has a polymorphic kind, and has no - runtime representation, being totally free. } -pseudoop "proxy#" - Proxy# a - { Witness for an unboxed {\tt Proxy#} value, which has no runtime - representation. } -pseudoop "seq" - a -> b -> b - { The value of {\tt seq a b} is bottom if {\tt a} is bottom, and - otherwise equal to {\tt b}. {\tt seq} is usually introduced to - improve performance by avoiding unneeded laziness. - A note on evaluation order: the expression {\tt seq a b} does - {\it not} guarantee that {\tt a} will be evaluated before {\tt b}. - The only guarantee given by {\tt seq} is that the both {\tt a} - and {\tt b} will be evaluated before {\tt seq} returns a value. - In particular, this means that {\tt b} may be evaluated before - {\tt a}. If you need to guarantee a specific order of evaluation, - you must use the function {\tt pseq} from the "parallel" package. } -primtype Any - { The type constructor {\tt Any} is type to which you can unsafely coerce any - lifted type, and back. - * It is lifted, and hence represented by a pointer - * It does not claim to be a {\it data} type, and that's important for - the code generator, because the code gen may {\it enter} a data value - but never enters a function value. - It's also used to instantiate un-constrained type variables after type - checking. For example, {\tt length} has type - {\tt length :: forall a. [a] -> Int} - and the list datacon for the empty list has type - {\tt [] :: forall a. [a]} - In order to compose these two terms as {\tt length []} a type - application is required, but there is no constraint on the - choice. In this situation GHC uses {\tt Any}: - {\tt length (Any *) ([] (Any *))} - Above, we print kinds explicitly, as if with - {\tt -fprint-explicit-kinds}. - Note that {\tt Any} is kind polymorphic; its kind is thus - {\tt forall k. k}.} -primtype AnyK - { The kind {\tt AnyK} is the kind level counterpart to {\tt Any}. In a - kind polymorphic setting, a similar example to the length of the empty - list can be given at the type level: - {\tt type family Length (l :: [k]) :: Nat} - {\tt type instance Length [] = Zero} - When {\tt Length} is applied to the empty (promoted) list it will have - the kind {\tt Length AnyK []}. - {\tt AnyK} is currently not exported and cannot be used directly, but - you might see it in debug output from the compiler. - } -pseudoop "unsafeCoerce#" - a -> b - { The function {\tt unsafeCoerce\#} allows you to side-step the typechecker entirely. That - is, it allows you to coerce any type into any other type. If you use this function, - you had better get it right, otherwise segmentation faults await. It is generally - used when you want to write a program that you know is well-typed, but where Haskell's - type system is not expressive enough to prove that it is well typed. - The following uses of {\tt unsafeCoerce\#} are supposed to work (i.e. not lead to - spurious compile-time or run-time crashes): - * Casting any lifted type to {\tt Any} - * Casting {\tt Any} back to the real type - * Casting an unboxed type to another unboxed type of the same size - (but not coercions between floating-point and integral types) - * Casting between two types that have the same runtime representation. One case is when - the two types differ only in "phantom" type parameters, for example - {\tt Ptr Int} to {\tt Ptr Float}, or {\tt [Int]} to {\tt [Float]} when the list is - known to be empty. Also, a {\tt newtype} of a type {\tt T} has the same representation - at runtime as {\tt T}. - Other uses of {\tt unsafeCoerce\#} are undefined. In particular, you should not use - {\tt unsafeCoerce\#} to cast a T to an algebraic data type D, unless T is also - an algebraic data type. For example, do not cast {\tt Int->Int} to {\tt Bool}, even if - you later cast that {\tt Bool} back to {\tt Int->Int} before applying it. The reasons - have to do with GHC's internal representation details (for the congnoscenti, data values - can be entered but function closures cannot). If you want a safe type to cast things - to, use {\tt Any}, which is not an algebraic data type. - } --- NB. It is tempting to think that casting a value to a type that it doesn't have is safe --- as long as you don't "do anything" with the value in its cast form, such as seq on it. This --- isn't the case: the compiler can insert seqs itself, and if these happen at the wrong type, --- Bad Things Might Happen. See bug #1616: in this case we cast a function of type (a,b) -> (a,b) --- to () -> () and back again. The strictness analyser saw that the function was strict, but --- the wrapper had type () -> (), and hence the wrapper de-constructed the (), the worker re-constructed --- a new (), with the result that the code ended up with "case () of (a,b) -> ...". -primop TraceEventOp "traceEvent#" GenPrimOp - Addr# -> State# s -> State# s - { Emits an event via the RTS tracing framework. The contents - of the event is the zero-terminated byte string passed as the first - argument. The event will be emitted either to the .eventlog file, - or to stderr, depending on the runtime RTS flags. } - with - has_side_effects = True - out_of_line = True -primop TraceMarkerOp "traceMarker#" GenPrimOp - Addr# -> State# s -> State# s - { Emits a marker event via the RTS tracing framework. The contents - of the event is the zero-terminated byte string passed as the first - argument. The event will be emitted either to the .eventlog file, - or to stderr, depending on the runtime RTS flags. } - with - has_side_effects = True - out_of_line = True ------------------------------------------------------------------------- -section "Safe coercions" ------------------------------------------------------------------------- -pseudoop "coerce" - Coercible a b => a -> b - { The function {\tt coerce} allows you to safely convert between values of - types that have the same representation with no run-time overhead. In the - simplest case you can use it instead of a newtype constructor, to go from - the newtype's concrete type to the abstract type. But it also works in - more complicated settings, e.g. converting a list of newtypes to a list of - concrete types. - } ------------------------------------------------------------------------- -section "SIMD Vectors" - {Operations on SIMD vectors.} ------------------------------------------------------------------------- -primtype VECTOR - with llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecBroadcastOp "broadcast#" GenPrimOp - SCALAR -> VECTOR - { Broadcast a scalar to all elements of a vector. } - with llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecPackOp "pack#" GenPrimOp - VECTUPLE -> VECTOR - { Pack the elements of an unboxed tuple into a vector. } - with llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecUnpackOp "unpack#" GenPrimOp - VECTOR -> VECTUPLE - { Unpack the elements of a vector into an unboxed tuple. #} - with llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecInsertOp "insert#" GenPrimOp - VECTOR -> SCALAR -> Int# -> VECTOR - { Insert a scalar at the given position in a vector. } - with can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecAddOp "plus#" Dyadic - VECTOR -> VECTOR -> VECTOR - { Add two vectors element-wise. } - with commutable = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecSubOp "minus#" Dyadic - VECTOR -> VECTOR -> VECTOR - { Subtract two vectors element-wise. } - with llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecMulOp "times#" Dyadic - VECTOR -> VECTOR -> VECTOR - { Multiply two vectors element-wise. } - with commutable = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecDivOp "divide#" Dyadic - VECTOR -> VECTOR -> VECTOR - { Divide two vectors element-wise. } - with can_fail = True - llvm_only = True - vector = [, ,, ,,] -primop VecQuotOp "quot#" Dyadic - VECTOR -> VECTOR -> VECTOR - { Rounds towards zero element-wise. } - with can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,,] -primop VecRemOp "rem#" Dyadic - VECTOR -> VECTOR -> VECTOR - { Satisfies \texttt{(quot\# x y) times\# y plus\# (rem\# x y) == x}. } - with can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,,] -primop VecNegOp "negate#" Monadic - VECTOR -> VECTOR - { Negate element-wise. } - with llvm_only = True - vector = [,,, ,,,, ,,,, ,, ,, ,,] -primop VecIndexByteArrayOp "indexArray#" GenPrimOp - ByteArray# -> Int# -> VECTOR - { Read a vector from specified index of immutable array. } - with can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecReadByteArrayOp "readArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, VECTOR #) - { Read a vector from specified index of mutable array. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecWriteByteArrayOp "writeArray#" GenPrimOp - MutableByteArray# s -> Int# -> VECTOR -> State# s -> State# s - { Write a vector to specified index of mutable array. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecIndexOffAddrOp "indexOffAddr#" GenPrimOp - Addr# -> Int# -> VECTOR - { Reads vector; offset in bytes. } - with can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecReadOffAddrOp "readOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, VECTOR #) - { Reads vector; offset in bytes. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecWriteOffAddrOp "writeOffAddr#" GenPrimOp - Addr# -> Int# -> VECTOR -> State# s -> State# s - { Write vector; offset in bytes. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecIndexScalarByteArrayOp "indexArrayAs#" GenPrimOp - ByteArray# -> Int# -> VECTOR - { Read a vector from specified index of immutable array of scalars; offset is in scalar elements. } - with can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecReadScalarByteArrayOp "readArrayAs#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, VECTOR #) - { Read a vector from specified index of mutable array of scalars; offset is in scalar elements. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecWriteScalarByteArrayOp "writeArrayAs#" GenPrimOp - MutableByteArray# s -> Int# -> VECTOR -> State# s -> State# s - { Write a vector to specified index of mutable array of scalars; offset is in scalar elements. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecIndexScalarOffAddrOp "indexOffAddrAs#" GenPrimOp - Addr# -> Int# -> VECTOR - { Reads vector; offset in scalar elements. } - with can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecReadScalarOffAddrOp "readOffAddrAs#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, VECTOR #) - { Reads vector; offset in scalar elements. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] -primop VecWriteScalarOffAddrOp "writeOffAddrAs#" GenPrimOp - Addr# -> Int# -> VECTOR -> State# s -> State# s - { Write vector; offset in scalar elements. } - with has_side_effects = True - can_fail = True - llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] ------------------------------------------------------------------------- -section "Prefetch" - {Prefetch operations: Note how every prefetch operation has a name - with the pattern prefetch*N#, where N is either 0,1,2, or 3. - This suffix number, N, is the "locality level" of the prefetch, following the - convention in GCC and other compilers. - Higher locality numbers correspond to the memory being loaded in more - levels of the cpu cache, and being retained after initial use. The naming - convention follows the naming convention of the prefetch intrinsic found - in the GCC and Clang C compilers. - On the LLVM backend, prefetch*N# uses the LLVM prefetch intrinsic - with locality level N. The code generated by LLVM is target architecture - dependent, but should agree with the GHC NCG on x86 systems. - On the Sparc and PPC native backends, prefetch*N is a No-Op. - On the x86 NCG, N=0 will generate prefetchNTA, - N=1 generates prefetcht2, N=2 generates prefetcht1, and - N=3 generates prefetcht0. - For streaming workloads, the prefetch*0 operations are recommended. - For workloads which do many reads or writes to a memory location in a short period of time, - prefetch*3 operations are recommended. - For further reading about prefetch and associated systems performance optimization, - the instruction set and optimization manuals by Intel and other CPU vendors are - excellent starting place. - The "Intel 64 and IA-32 Architectures Optimization Reference Manual" is - especially a helpful read, even if your software is meant for other CPU - architectures or vendor hardware. The manual can be found at - http: - The {\tt prefetchMutableByteArray} family of operations has the order of operations - determined by passing around the {\tt State#} token. - For the {\tt prefetchByteArray} - and {\tt prefetchAddr} families of operations, consider the following example: - {\tt let a1 = prefetchByteArray2# a n in ...a1... } - In the above fragement, {\tt a} is the input variable for the prefetch - and {\tt a1 == a} will be true. To ensure that the prefetch is not treated as deadcode, - the body of the let should only use {\tt a1} and NOT {\tt a}. The same principle - applies for uses of prefetch in a loop. - } ------------------------------------------------------------------------- ---- the Int# argument for prefetch is the byte offset on the byteArray or Addr# ---- -primop PrefetchByteArrayOp3 "prefetchByteArray3#" GenPrimOp - ByteArray# -> Int# -> ByteArray# -primop PrefetchMutableByteArrayOp3 "prefetchMutableByteArray3#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> State# s -primop PrefetchAddrOp3 "prefetchAddr3#" GenPrimOp - Addr# -> Int# -> Addr# ----- -primop PrefetchByteArrayOp2 "prefetchByteArray2#" GenPrimOp - ByteArray# -> Int# -> ByteArray# -primop PrefetchMutableByteArrayOp2 "prefetchMutableByteArray2#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> State# s -primop PrefetchAddrOp2 "prefetchAddr2#" GenPrimOp - Addr# -> Int# -> Addr# ----- -primop PrefetchByteArrayOp1 "prefetchByteArray1#" GenPrimOp - ByteArray# -> Int# -> ByteArray# -primop PrefetchMutableByteArrayOp1 "prefetchMutableByteArray1#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> State# s -primop PrefetchAddrOp1 "prefetchAddr1#" GenPrimOp - Addr# -> Int# -> Addr# ----- -primop PrefetchByteArrayOp0 "prefetchByteArray0#" GenPrimOp - ByteArray# -> Int# -> ByteArray# -primop PrefetchMutableByteArrayOp0 "prefetchMutableByteArray0#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> State# s -primop PrefetchAddrOp0 "prefetchAddr0#" GenPrimOp - Addr# -> Int# -> Addr# ------------------------------------------------------------------------- ---- --- ------------------------------------------------------------------------- -thats_all_folks diff --git a/include/prim/primops-800.txt b/include/prim/primops-820.txt similarity index 82% rename from include/prim/primops-800.txt rename to include/prim/primops-820.txt index bbe18fb3..7d0eddc1 100644 --- a/include/prim/primops-800.txt +++ b/include/prim/primops-820.txt @@ -2,6 +2,15 @@ + + + + + + + + + ----------------------------------------------------------------------- -- -- (c) 2010 The University of Glasgow @@ -13,72 +22,477 @@ -- ----------------------------------------------------------------------- --- This file is processed by the utility program genprimopcode to produce --- a number of include files within the compiler and optionally to produce --- human-readable documentation. --- --- It should first be preprocessed. --- --- Information on how PrimOps are implemented and the steps necessary to --- add a new one can be found in the Commentary: --- --- http://ghc.haskell.org/trac/ghc/wiki/Commentary/PrimOps +-- This file is processed by the utility program genprimopcode to produce +-- a number of include files within the compiler and optionally to produce +-- human-readable documentation. +-- +-- It should first be preprocessed. +-- +-- Information on how PrimOps are implemented and the steps necessary to +-- add a new one can be found in the Commentary: +-- +-- http://ghc.haskell.org/trac/ghc/wiki/Commentary/PrimOps + +-- This file is divided into named sections, each containing or more +-- primop entries. Section headers have the format: +-- +-- section "section-name" {description} +-- +-- This information is used solely when producing documentation; it is +-- otherwise ignored. The description is optional. +-- +-- The format of each primop entry is as follows: +-- +-- primop internal-name "name-in-program-text" type category {description} attributes + +-- The default attribute values which apply if you don't specify +-- other ones. Attribute values can be True, False, or arbitrary +-- text between curly brackets. This is a kludge to enable +-- processors of this file to easily get hold of simple info +-- (eg, out_of_line), whilst avoiding parsing complex expressions +-- needed for strictness info. + +-- The vector attribute is rather special. It takes a list of 3-tuples, each of +-- which is of the form . ELEM_TYPE is the type of +-- the elements in the vector; LENGTH is the length of the vector; and +-- SCALAR_TYPE is the scalar type used to inject to/project from vector +-- element. Note that ELEM_TYPE and SCALAR_TYPE are not the same; for example, +-- to broadcast a scalar value to a vector whose elements are of type Int8, we +-- use an Int#. + +-- When a primtype or primop has a vector attribute, it is instantiated at each +-- 3-tuple in the list of 3-tuples. That is, the vector attribute allows us to +-- define a family of types or primops. Vector support also adds three new +-- keywords: VECTOR, SCALAR, and VECTUPLE. These keywords are expanded to types +-- derived from the 3-tuple. For the 3-tuple , VECTOR expands to +-- Int64X2#, SCALAR expands to INT64, and VECTUPLE expands to (# INT64, INT64 +-- #). + +defaults + has_side_effects = False + out_of_line = False -- See Note Note [PrimOp can_fail and has_side_effects] in PrimOp + can_fail = False -- See Note Note [PrimOp can_fail and has_side_effects] in PrimOp + commutable = False + code_size = { primOpCodeSizeDefault } + strictness = { \ arity -> mkClosedStrictSig (replicate arity topDmd) topRes } + fixity = Nothing + llvm_only = False + vector = [] + +-- Currently, documentation is produced using latex, so contents of +-- description fields should be legal latex. Descriptions can contain +-- matched pairs of embedded curly brackets. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + --- This file is divided into named sections, each containing or more --- primop entries. Section headers have the format: --- --- section "section-name" {description} --- --- This information is used solely when producing documentation; it is --- otherwise ignored. The description is optional. --- --- The format of each primop entry is as follows: --- --- primop internal-name "name-in-program-text" type category {description} attributes --- The default attribute values which apply if you don't specify --- other ones. Attribute values can be True, False, or arbitrary --- text between curly brackets. This is a kludge to enable --- processors of this file to easily get hold of simple info --- (eg, out_of_line), whilst avoiding parsing complex expressions --- needed for strictness info. --- The vector attribute is rather special. It takes a list of 3-tuples, each of --- which is of the form . ELEM_TYPE is the type of --- the elements in the vector; LENGTH is the length of the vector; and --- SCALAR_TYPE is the scalar type used to inject to/project from vector --- element. Note that ELEM_TYPE and SCALAR_TYPE are not the same; for example, --- to broadcast a scalar value to a vector whose elements are of type Int8, we --- use an Int#. --- When a primtype or primop has a vector attribute, it is instantiated at each --- 3-tuple in the list of 3-tuples. That is, the vector attribute allows us to --- define a family of types or primops. Vector support also adds three new --- keywords: VECTOR, SCALAR, and VECTUPLE. These keywords are expanded to types --- derived from the 3-tuple. For the 3-tuple , VECTOR expands to --- Int64X2#, SCALAR expands to INT64, and VECTUPLE expands to (# INT64, INT64 --- #). -defaults - has_side_effects = False - out_of_line = False -- See Note Note [PrimOp can_fail and has_side_effects] in PrimOp - can_fail = False -- See Note Note [PrimOp can_fail and has_side_effects] in PrimOp - commutable = False - code_size = { primOpCodeSizeDefault } - strictness = { \ arity -> mkClosedStrictSig (replicate arity topDmd) topRes } - fixity = Nothing - llvm_only = False - vector = [] --- Currently, documentation is produced using latex, so contents of --- description fields should be legal latex. Descriptions can contain --- matched pairs of embedded curly brackets. -- We need platform defines (tests for mingw32 below). + + + + + section "The word size story." {Haskell98 specifies that signed integers (type {\tt Int}) must contain at least 30 bits. GHC always implements {\tt @@ -140,20 +554,6 @@ section "The word size story." - - - - - - - - - - - - - - ------------------------------------------------------------------------ section "Char#" {Operations on 31-bit characters.} @@ -225,12 +625,16 @@ primop IntMulMayOfloOp "mulIntMayOflo#" primop IntQuotOp "quotInt#" Dyadic Int# -> Int# -> Int# - {Rounds towards zero.} + {Rounds towards zero. The behavior is undefined if the second argument is + zero. + } with can_fail = True primop IntRemOp "remInt#" Dyadic Int# -> Int# -> Int# - {Satisfies \texttt{(quotInt\# x y) *\# y +\# (remInt\# x y) == x}.} + {Satisfies \texttt{(quotInt\# x y) *\# y +\# (remInt\# x y) == x}. The + behavior is undefined if the second argument is zero. + } with can_fail = True primop IntQuotRemOp "quotRemInt#" GenPrimOp @@ -441,8 +845,6 @@ primop Narrow32WordOp "narrow32Word#" Monadic Word# -> Word# - - ------------------------------------------------------------------------ section "Int64#" {Operations on 64-bit unsigned words. This type is only used @@ -462,7 +864,6 @@ section "Word64#" primtype Word64# - ------------------------------------------------------------------------ section "Double#" {Operations on double-precision (64 bit) floating-point numbers.} @@ -512,6 +913,8 @@ primop DoubleDivOp "/##" Dyadic primop DoubleNegOp "negateDouble#" Monadic Double# -> Double# +primop DoubleFabsOp "fabsDouble#" Monadic Double# -> Double# + primop Double2IntOp "double2Int#" GenPrimOp Double# -> Int# {Truncates a {\tt Double#} value to the nearest {\tt Int#}. Results are undefined if the truncation if truncation yields @@ -638,6 +1041,8 @@ primop FloatDivOp "divideFloat#" Dyadic primop FloatNegOp "negateFloat#" Monadic Float# -> Float# +primop FloatFabsOp "fabsFloat#" Monadic Float# -> Float# + primop Float2IntOp "float2Int#" GenPrimOp Float# -> Int# {Truncates a {\tt Float#} value to the nearest {\tt Int#}. Results are undefined if the truncation if truncation yields @@ -1062,6 +1467,17 @@ primop NewAlignedPinnedByteArrayOp_Char "newAlignedPinnedByteArray#" GenPrimOp with out_of_line = True has_side_effects = True +primop MutableByteArrayIsPinnedOp "isMutableByteArrayPinned#" GenPrimOp + MutableByteArray# s -> Int# + {Determine whether a {\tt MutableByteArray\#} is guaranteed not to move + during GC.} + with out_of_line = True + +primop ByteArrayIsPinnedOp "isByteArrayPinned#" GenPrimOp + ByteArray# -> Int# + {Determine whether a {\tt ByteArray\#} is guaranteed not to move during GC.} + with out_of_line = True + primop ByteArrayContents_Char "byteArrayContents#" GenPrimOp ByteArray# -> Addr# {Intended for use with pinned arrays; otherwise very unsafe!} @@ -1410,7 +1826,8 @@ primop CopyAddrToByteArrayOp "copyAddrToByteArray#" GenPrimOp primop SetByteArrayOp "setByteArray#" GenPrimOp MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> State# s - {Set the range of the MutableByteArray# to the specified character.} + {{\tt setByteArray# ba off len c} sets the byte range {\tt [off, off+len]} of + the {\tt MutableByteArray#} to the byte {\tt c}.} with has_side_effects = True code_size = { primOpCodeSizeForeignCall + 4 } @@ -1616,7 +2033,6 @@ primop AddrSubOp "minusAddr#" GenPrimOp Addr# -> Addr# -> Int# primop AddrRemOp "remAddr#" GenPrimOp Addr# -> Int# -> Int# {Return the remainder when the {\tt Addr\#} arg, treated like an {\tt Int\#}, is divided by the {\tt Int\#} arg.} - primop Addr2IntOp "addr2Int#" GenPrimOp Addr# -> Int# {Coerce directly from address to int. Strongly deprecated.} with code_size = 0 @@ -1624,7 +2040,6 @@ primop Int2AddrOp "int2Addr#" GenPrimOp Int# -> Addr# {Coerce directly from int to address. Strongly deprecated.} with code_size = 0 - primop AddrGtOp "gtAddr#" Compare Addr# -> Addr# -> Int# primop AddrGeOp "geAddr#" Compare Addr# -> Addr# -> Int# primop AddrEqOp "eqAddr#" Compare Addr# -> Addr# -> Int# @@ -1893,13 +2308,25 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp primop SameMutVarOp "sameMutVar#" GenPrimOp MutVar# s a -> MutVar# s a -> Int# --- not really the right type, but we don't know about pairs here. The --- correct type is +-- Note [Why not an unboxed tuple in atomicModifyMutVar#?] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Looking at the type of atomicModifyMutVar#, one might wonder why +-- it doesn't return an unboxed tuple. e.g., -- --- MutVar# s a -> (a -> (a,b)) -> State# s -> (# State# s, b #) +-- MutVar# s a -> (a -> (# a, b #)) -> State# s -> (# State# s, b #) -- +-- The reason is that atomicModifyMutVar# relies on laziness for its atomicity. +-- Given a MutVar# containing x, atomicModifyMutVar# merely replaces the +-- its contents with a thunk of the form (fst (f x)). This can be done using an +-- atomic compare-and-swap as it is merely replacing a pointer. + primop AtomicModifyMutVarOp "atomicModifyMutVar#" GenPrimOp MutVar# s a -> (a -> b) -> State# s -> (# State# s, c #) + { Modify the contents of a {\tt MutVar\#}. Note that this isn't strictly + speaking the correct type for this function, it should really be + {\tt MutVar# s a -> (a -> (a,b)) -> State# s -> (# State# s, b #)}, however + we don't know about pairs here. } with out_of_line = True has_side_effects = True @@ -1915,19 +2342,18 @@ primop CasMutVarOp "casMutVar#" GenPrimOp section "Exceptions" ------------------------------------------------------------------------ -{- Note [Strictness for mask/unmask/catch] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider this example, which comes from GHC.IO.Handle.Internals: - wantReadableHandle3 f ma b st - = case ... of - DEFAULT -> case ma of MVar a -> ... - 0# -> maskAsynchExceptions# (\st -> case ma of MVar a -> ...) -The outer case just decides whether to mask exceptions, but we don't want -thereby to hide the strictness in 'ma'! Hence the use of strictApply1Dmd. - -For catch, we must be extra careful; see -Note [Exceptions and strictness] in Demand --} +-- Note [Strictness for mask/unmask/catch] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Consider this example, which comes from GHC.IO.Handle.Internals: +-- wantReadableHandle3 f ma b st +-- = case ... of +-- DEFAULT -> case ma of MVar a -> ... +-- 0# -> maskAsynchExceptions# (\st -> case ma of MVar a -> ...) +-- The outer case just decides whether to mask exceptions, but we don't want +-- thereby to hide the strictness in 'ma'! Hence the use of strictApply1Dmd. +-- +-- For catch, catchSTM, and catchRetry, we must be extra careful; see +-- Note [Exceptions and strictness] in Demand primop CatchOp "catch#" GenPrimOp (State# RealWorld -> (# State# RealWorld, a #) ) @@ -1935,7 +2361,7 @@ primop CatchOp "catch#" GenPrimOp -> State# RealWorld -> (# State# RealWorld, a #) with - strictness = { \ _arity -> mkClosedStrictSig [ catchArgDmd + strictness = { \ _arity -> mkClosedStrictSig [ lazyApply1Dmd , lazyApply2Dmd , topDmd] topRes } -- See Note [Strictness for mask/unmask/catch] @@ -1964,6 +2390,13 @@ primop RaiseOp "raise#" GenPrimOp -- f x y | x>0 = raiseIO blah -- | y>0 = return 1 -- | otherwise = return 2 +-- +-- TODO Check that the above notes on @f@ are valid. The function successfully +-- produces an IO exception when compiled without optimization. If we analyze +-- it as strict in @y@, won't we change that behavior under optimization? +-- I thought the rule was that it was okay to replace one valid imprecise +-- exception with another, but not to replace a precise exception with +-- an imprecise one (dfeuer, 2017-03-05). primop RaiseIOOp "raiseIO#" GenPrimOp a -> State# RealWorld -> (# State# RealWorld, b #) @@ -2019,7 +2452,7 @@ primop AtomicallyOp "atomically#" GenPrimOp out_of_line = True has_side_effects = True --- NB: retry#'s strictness information specifies it to return bottom. +-- NB: retry#'s strictness information specifies it to throw an exception -- This lets the compiler perform some extra simplifications, since retry# -- will technically never return. -- @@ -2029,10 +2462,13 @@ primop AtomicallyOp "atomically#" GenPrimOp -- with: -- retry# s1 -- where 'e' would be unreachable anyway. See Trac #8091. +-- +-- Note that it *does not* return botRes as the "exception" that is throw may be +-- "caught" by catchRetry#. This mistake caused #14171. primop RetryOp "retry#" GenPrimOp State# RealWorld -> (# State# RealWorld, a #) with - strictness = { \ _arity -> mkClosedStrictSig [topDmd] botRes } + strictness = { \ _arity -> mkClosedStrictSig [topDmd] exnRes } out_of_line = True has_side_effects = True @@ -2053,7 +2489,7 @@ primop CatchSTMOp "catchSTM#" GenPrimOp -> (b -> State# RealWorld -> (# State# RealWorld, a #) ) -> (State# RealWorld -> (# State# RealWorld, a #) ) with - strictness = { \ _arity -> mkClosedStrictSig [ catchArgDmd + strictness = { \ _arity -> mkClosedStrictSig [ lazyApply1Dmd , lazyApply2Dmd , topDmd ] topRes } -- See Note [Strictness for mask/unmask/catch] @@ -2206,7 +2642,6 @@ primop WaitWriteOp "waitWrite#" GenPrimOp out_of_line = True - ------------------------------------------------------------------------ section "Concurrency primitives" ------------------------------------------------------------------------ @@ -2271,7 +2706,7 @@ primop IsCurrentThreadBoundOp "isCurrentThreadBound#" GenPrimOp has_side_effects = True primop NoDuplicateOp "noDuplicate#" GenPrimOp - State# RealWorld -> State# RealWorld + State# s -> State# s with out_of_line = True has_side_effects = True @@ -2293,6 +2728,11 @@ primtype Weak# b primop MkWeakOp "mkWeak#" GenPrimOp o -> b -> (State# RealWorld -> (# State# RealWorld, c #)) -> State# RealWorld -> (# State# RealWorld, Weak# b #) + { {\tt mkWeak# k v finalizer s} creates a weak reference to value {\tt k}, + with an associated reference to some value {\tt v}. If {\tt k} is still + alive then {\tt v} can be retrieved using {\tt deRefWeak#}. Note that + the type of {\tt k} must be represented by a pointer (i.e. of kind {\tt + TYPE 'LiftedRep} or {\tt TYPE 'UnliftedRep}). } with has_side_effects = True out_of_line = True @@ -2377,13 +2817,154 @@ primop EqStableNameOp "eqStableName#" GenPrimOp primop StableNameToIntOp "stableNameToInt#" GenPrimOp StableName# a -> Int# +------------------------------------------------------------------------ +section "Compact normal form" +------------------------------------------------------------------------ + +primtype Compact# + +primop CompactNewOp "compactNew#" GenPrimOp + Word# -> State# RealWorld -> (# State# RealWorld, Compact# #) + { Create a new Compact with the given size (in bytes, not words). + The size is rounded up to a multiple of the allocator block size, + and capped to one mega block. } + with + has_side_effects = True + out_of_line = True + +primop CompactResizeOp "compactResize#" GenPrimOp + Compact# -> Word# -> State# RealWorld -> + State# RealWorld + { Set the new allocation size of the compact. This value (in bytes) + determines the size of each block in the compact chain. } + with + has_side_effects = True + out_of_line = True + +primop CompactContainsOp "compactContains#" GenPrimOp + Compact# -> a -> State# RealWorld -> (# State# RealWorld, Int# #) + { Returns 1# if the object is contained in the compact, 0# otherwise. } + with + out_of_line = True + +primop CompactContainsAnyOp "compactContainsAny#" GenPrimOp + a -> State# RealWorld -> (# State# RealWorld, Int# #) + { Returns 1# if the object is in any compact at all, 0# otherwise. } + with + out_of_line = True + +primop CompactGetFirstBlockOp "compactGetFirstBlock#" GenPrimOp + Compact# -> State# RealWorld -> (# State# RealWorld, Addr#, Word# #) + { Returns the address and the size (in bytes) of the first block of + a compact. } + with + out_of_line = True + +primop CompactGetNextBlockOp "compactGetNextBlock#" GenPrimOp + Compact# -> Addr# -> State# RealWorld -> (# State# RealWorld, Addr#, Word# #) + { Given a compact and the address of one its blocks, returns the + next block and its size, or #nullAddr if the argument was the + last block in the compact. } + with + out_of_line = True + +primop CompactAllocateBlockOp "compactAllocateBlock#" GenPrimOp + Word# -> Addr# -> State# RealWorld -> (# State# RealWorld, Addr# #) + { Attempt to allocate a compact block with the given size (in + bytes) at the given address. The first argument is a hint to + the allocator, allocation might be satisfied at a different + address (which is returned). + The resulting block is not known to the GC until + compactFixupPointers# is called on it, and care must be taken + so that the address does not escape or memory will be leaked. + } + with + has_side_effects = True + out_of_line = True + +primop CompactFixupPointersOp "compactFixupPointers#" GenPrimOp + Addr# -> Addr# -> State# RealWorld -> (# State# RealWorld, Compact#, Addr# #) + { Given the pointer to the first block of a compact, and the + address of the root object in the old address space, fix up + the internal pointers inside the compact to account for + a different position in memory than when it was serialized. + This method must be called exactly once after importing + a serialized compact, and returns the new compact and + the new adjusted root address. } + with + has_side_effects = True + out_of_line = True + +primop CompactAdd "compactAdd#" GenPrimOp + Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #) + { Recursively add a closure and its transitive closure to a + {\texttt Compact\#}, evaluating any unevaluated components at the + same time. Note: {\texttt compactAdd\#} is not thread-safe, so + only one thread may call {\texttt compactAdd\#} with a particular + {\texttt Compact#} at any given time. The primop does not + enforce any mutual exclusion; the caller is expected to + arrange this. } + with + has_side_effects = True + out_of_line = True + +primop CompactAddWithSharing "compactAddWithSharing#" GenPrimOp + Compact# -> a -> State# RealWorld -> (# State# RealWorld, a #) + { Like {\texttt compactAdd\#}, but retains sharing and cycles + during compaction. } + with + has_side_effects = True + out_of_line = True + +primop CompactSize "compactSize#" GenPrimOp + Compact# -> State# RealWorld -> (# State# RealWorld, Word# #) + { Return the size (in bytes) of the total amount of data in the Compact# } + with + has_side_effects = True + out_of_line = True + ------------------------------------------------------------------------ section "Unsafe pointer equality" --- (#1 Bad Guy: Alistair Reid :) +-- (#1 Bad Guy: Alastair Reid :) ------------------------------------------------------------------------ primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp a -> a -> Int# + { Returns 1# if the given pointers are equal and 0# otherwise. } + with + can_fail = True -- See Note [reallyUnsafePtrEquality#] + + +-- Note [reallyUnsafePtrEquality#] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- reallyUnsafePtrEquality# can't actually fail, per se, but we mark it can_fail +-- anyway. Until 5a9a1738023a, GHC considered primops okay for speculation only +-- when their arguments were known to be forced. This was unnecessarily +-- conservative, but it prevented reallyUnsafePtrEquality# from floating out of +-- places where its arguments were known to be forced. Unfortunately, GHC could +-- sometimes lose track of whether those arguments were forced, leading to let/app +-- invariant failures (see Trac 13027 and the discussion in Trac 11444). Now that +-- ok_for_speculation skips over lifted arguments, we need to explicitly prevent +-- reallyUnsafePtrEquality# from floating out. The reasons are closely related +-- to those described in Note [dataToTag#], although the consequences are less +-- severe. Imagine if we had +-- +-- \x y . case x of x' +-- DEFAULT -> +-- case y of y' +-- DEFAULT -> +-- let eq = reallyUnsafePtrEquality# x' y' +-- in ... +-- +-- If the let floats out, we'll get +-- +-- \x y . let eq = reallyUnsafePtrEquality# x y +-- in case x of ... +-- +-- The trouble is that pointer equality between thunks is very different +-- from pointer equality between the values those thunks reduce to, and the latter +-- is typically much more precise. ------------------------------------------------------------------------ section "Parallelism" @@ -2393,7 +2974,7 @@ primop ParOp "par#" GenPrimOp a -> Int# with -- Note that Par is lazy to avoid that the sparked thing - -- gets evaluted strictly, which it should *not* be + -- gets evaluated strictly, which it should *not* be has_side_effects = True code_size = { primOpCodeSizeForeignCall } @@ -2434,13 +3015,37 @@ section "Tag to enum stuff" primop DataToTagOp "dataToTag#" GenPrimOp a -> Int# with - strictness = { \ _arity -> mkClosedStrictSig [evalDmd] topRes } - - -- dataToTag# must have an evaluated argument + can_fail = True -- See Note [dataToTag#] + strictness = { \ _arity -> mkClosedStrictSig [evalDmd] topRes } + -- dataToTag# must have an evaluated argument primop TagToEnumOp "tagToEnum#" GenPrimOp Int# -> a +{- Note [dataToTag#] +~~~~~~~~~~~~~~~~~~~~ +The dataToTag# primop should always be applied to an evaluated argument. +The way to ensure this is to invoke it via the 'getTag' wrapper in GHC.Base: + getTag :: a -> Int# + getTag !x = dataToTag# x + +But now consider + \z. case x of y -> let v = dataToTag# y in ... + +To improve floating, the FloatOut pass (deliberately) does a +binder-swap on the case, to give + \z. case x of y -> let v = dataToTag# x in ... + +Now FloatOut might float that v-binding outside the \z. But that is +bad because that might mean x gest evaluated much too early! (CorePrep +adds an eval to a dataToTag# call, to ensure that the argument really is +evaluated; see CorePrep Note [dataToTag magic].) + +Solution: make DataToTag into a can_fail primop. That will stop it floating +(see Note [PrimOp can_fail and has_side_effects] in PrimOp). It's a bit of +a hack but never mind. +-} + ------------------------------------------------------------------------ section "Bytecode operations" {Support for manipulating bytecode objects used by the interpreter and @@ -2459,6 +3064,21 @@ primop AddrToAnyOp "addrToAny#" GenPrimOp with code_size = 0 +primop AnyToAddrOp "anyToAddr#" GenPrimOp + a -> State# RealWorld -> (# State# RealWorld, Addr# #) + { Retrive the address of any Haskell value. This is + essentially an {\texttt unsafeCoerce\#}, but if implemented as such + the core lint pass complains and fails to compile. + As a primop, it is opaque to core/stg, and only appears + in cmm (where the copy propagation pass will get rid of it). + Note that "a" must be a value, not a thunk! It's too late + for strictness analysis to enforce this, so you're on your + own to guarantee this. Also note that {\texttt Addr\#} is not a GC + pointer - up to you to guarantee that it does not become + a dangling pointer immediately after you get it.} + with + code_size = 0 + primop MkApUpd0_Op "mkApUpd0#" GenPrimOp BCO# -> (# a #) { Wrap a BCO in a {\tt AP_UPD} thunk which will be updated with the value of @@ -2478,6 +3098,11 @@ primop NewBCOOp "newBCO#" GenPrimOp primop UnpackClosureOp "unpackClosure#" GenPrimOp a -> (# Addr#, Array# b, ByteArray# #) + { {\tt unpackClosure\# closure} copies non-pointers and pointers in the + payload of the given closure into two new arrays, and returns a pointer to + the first word of the closure's info table, a pointer array for the + pointers in the payload, and a non-pointer array for the non-pointers in + the payload. } with out_of_line = True @@ -2541,52 +3166,6 @@ pseudoop "seq" {\tt a}. If you need to guarantee a specific order of evaluation, you must use the function {\tt pseq} from the "parallel" package. } -primtype Any - { The type constructor {\tt Any} is type to which you can unsafely coerce any - lifted type, and back. - - * It is lifted, and hence represented by a pointer - - * It does not claim to be a {\it data} type, and that's important for - the code generator, because the code gen may {\it enter} a data value - but never enters a function value. - - It's also used to instantiate un-constrained type variables after type - checking. For example, {\tt length} has type - - {\tt length :: forall a. [a] -> Int} - - and the list datacon for the empty list has type - - {\tt [] :: forall a. [a]} - - In order to compose these two terms as {\tt length []} a type - application is required, but there is no constraint on the - choice. In this situation GHC uses {\tt Any}: - - {\tt length (Any *) ([] (Any *))} - - Above, we print kinds explicitly, as if with - {\tt -fprint-explicit-kinds}. - - Note that {\tt Any} is kind polymorphic; its kind is thus - {\tt forall k. k}.} - -primtype AnyK - { The kind {\tt AnyK} is the kind level counterpart to {\tt Any}. In a - kind polymorphic setting, a similar example to the length of the empty - list can be given at the type level: - - {\tt type family Length (l :: [k]) :: Nat} - {\tt type instance Length [] = Zero} - - When {\tt Length} is applied to the empty (promoted) list it will have - the kind {\tt Length AnyK []}. - - {\tt AnyK} is currently not exported and cannot be used directly, but - you might see it in debug output from the compiler. - } - pseudoop "unsafeCoerce#" a -> b { The function {\tt unsafeCoerce\#} allows you to side-step the typechecker entirely. That @@ -2670,109 +3249,90 @@ section "SIMD Vectors" - - - - - - - - - - - - - - - - - - - primtype VECTOR with llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecBroadcastOp "broadcast#" GenPrimOp SCALAR -> VECTOR { Broadcast a scalar to all elements of a vector. } with llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecPackOp "pack#" GenPrimOp VECTUPLE -> VECTOR { Pack the elements of an unboxed tuple into a vector. } with llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecUnpackOp "unpack#" GenPrimOp VECTOR -> VECTUPLE { Unpack the elements of a vector into an unboxed tuple. #} with llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecInsertOp "insert#" GenPrimOp VECTOR -> SCALAR -> Int# -> VECTOR { Insert a scalar at the given position in a vector. } with can_fail = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecAddOp "plus#" Dyadic VECTOR -> VECTOR -> VECTOR { Add two vectors element-wise. } with commutable = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecSubOp "minus#" Dyadic VECTOR -> VECTOR -> VECTOR { Subtract two vectors element-wise. } with llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecMulOp "times#" Dyadic VECTOR -> VECTOR -> VECTOR { Multiply two vectors element-wise. } with commutable = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecDivOp "divide#" Dyadic VECTOR -> VECTOR -> VECTOR { Divide two vectors element-wise. } with can_fail = True llvm_only = True - vector = [, ,, ,,] + vector = [, ,, ,,] primop VecQuotOp "quot#" Dyadic VECTOR -> VECTOR -> VECTOR { Rounds towards zero element-wise. } with can_fail = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,,] primop VecRemOp "rem#" Dyadic VECTOR -> VECTOR -> VECTOR { Satisfies \texttt{(quot\# x y) times\# y plus\# (rem\# x y) == x}. } with can_fail = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,,] primop VecNegOp "negate#" Monadic VECTOR -> VECTOR { Negate element-wise. } with llvm_only = True - vector = [,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,, ,, ,,] primop VecIndexByteArrayOp "indexArray#" GenPrimOp ByteArray# -> Int# -> VECTOR { Read a vector from specified index of immutable array. } with can_fail = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecReadByteArrayOp "readArray#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, VECTOR #) @@ -2780,7 +3340,7 @@ primop VecReadByteArrayOp "readArray#" GenPrimOp with has_side_effects = True can_fail = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecWriteByteArrayOp "writeArray#" GenPrimOp MutableByteArray# s -> Int# -> VECTOR -> State# s -> State# s @@ -2788,14 +3348,14 @@ primop VecWriteByteArrayOp "writeArray#" GenPrimOp with has_side_effects = True can_fail = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecIndexOffAddrOp "indexOffAddr#" GenPrimOp Addr# -> Int# -> VECTOR { Reads vector; offset in bytes. } with can_fail = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecReadOffAddrOp "readOffAddr#" GenPrimOp Addr# -> Int# -> State# s -> (# State# s, VECTOR #) @@ -2803,7 +3363,7 @@ primop VecReadOffAddrOp "readOffAddr#" GenPrimOp with has_side_effects = True can_fail = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecWriteOffAddrOp "writeOffAddr#" GenPrimOp Addr# -> Int# -> VECTOR -> State# s -> State# s @@ -2811,7 +3371,7 @@ primop VecWriteOffAddrOp "writeOffAddr#" GenPrimOp with has_side_effects = True can_fail = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecIndexScalarByteArrayOp "indexArrayAs#" GenPrimOp @@ -2819,7 +3379,7 @@ primop VecIndexScalarByteArrayOp "indexArrayAs#" GenPrimOp { Read a vector from specified index of immutable array of scalars; offset is in scalar elements. } with can_fail = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecReadScalarByteArrayOp "readArrayAs#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, VECTOR #) @@ -2827,7 +3387,7 @@ primop VecReadScalarByteArrayOp "readArrayAs#" GenPrimOp with has_side_effects = True can_fail = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecWriteScalarByteArrayOp "writeArrayAs#" GenPrimOp MutableByteArray# s -> Int# -> VECTOR -> State# s -> State# s @@ -2835,14 +3395,14 @@ primop VecWriteScalarByteArrayOp "writeArrayAs#" GenPrimOp with has_side_effects = True can_fail = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecIndexScalarOffAddrOp "indexOffAddrAs#" GenPrimOp Addr# -> Int# -> VECTOR { Reads vector; offset in scalar elements. } with can_fail = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecReadScalarOffAddrOp "readOffAddrAs#" GenPrimOp Addr# -> Int# -> State# s -> (# State# s, VECTOR #) @@ -2850,7 +3410,7 @@ primop VecReadScalarOffAddrOp "readOffAddrAs#" GenPrimOp with has_side_effects = True can_fail = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] primop VecWriteScalarOffAddrOp "writeOffAddrAs#" GenPrimOp Addr# -> Int# -> VECTOR -> State# s -> State# s @@ -2858,7 +3418,7 @@ primop VecWriteScalarOffAddrOp "writeOffAddrAs#" GenPrimOp with has_side_effects = True can_fail = True llvm_only = True - vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] + vector = [,,, ,,,, ,,,, ,,,, ,,,, ,,,, ,, ,, ,,] ------------------------------------------------------------------------ @@ -2996,4 +3556,3 @@ primop PrefetchValueOp0 "prefetchValue0#" GenPrimOp ------------------------------------------------------------------------ thats_all_folks - diff --git a/lib/bin/ghcjs.sh b/lib/bin/ghcjs.sh deleted file mode 100644 index cb409a87..00000000 --- a/lib/bin/ghcjs.sh +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/sh - -# wrapper script to pass the correct -B option to ghcjs.bin -# ghcjs-boot does substitution of {...} sections - -topdir="{topdir}" -executablename="{bindir}/ghcjs-{version}-{ghcversion}.bin" -exec "$executablename" -B"$topdir" ${1+"$@"} diff --git a/lib/bin/hsc2hs-ghcjs.sh b/lib/bin/hsc2hs-ghcjs.sh deleted file mode 100644 index 94f6784f..00000000 --- a/lib/bin/hsc2hs-ghcjs.sh +++ /dev/null @@ -1,9 +0,0 @@ -#!/bin/sh - -# wrapper script to pass the correct options to hsc2hs.bin - -executablename="{bindir}/hsc2hs-ghcjs-{version}-{ghcversion}.bin" -topdir="{topdir}" - -exec "$executablename" ${1+"$@"} - diff --git a/lib/boot/boot.yaml b/lib/boot/boot.yaml new file mode 100644 index 00000000..09701c25 --- /dev/null +++ b/lib/boot/boot.yaml @@ -0,0 +1,81 @@ +############################################################################### +# the packages that ghcjs-boot builds +# +# package names are relative to the directory containing this boot.yaml file + +packages: + + # special packages installed between stages: + + ghc-prim: ./pkg/ghc-prim + + ghcjs-prim: ./pkg/ghcjs-prim + ghcjs-th: ./pkg/ghcjs-th + + cabal: ./pkg/Cabal + + + # pretend to have these packages installed during stage 1, + # GHCJS calls GHC for anything that depends on them + # (these must be installed in the GHC installation used for booting) + + stage1PretendToHave: + - Cabal + + # in stage 1a, we cannot do linking yet, ghc-prim is installed + # before this + + stage1a: + - ./pkg/base + - ./pkg/integer-gmp + - ./pkg/transformers + + # after stage 1a, ghcjs-boot installs ghcjs-prim and + # continues with stage 1b + + stage1b: + - ./pkg/array + - ./pkg/binary + - ./pkg/bytestring + - ./pkg/containers + - ./pkg/deepseq + - ./pkg/directory + - ./pkg/filepath + - ./pkg/ghc + - ./pkg/ghc-boot + - ./pkg/ghc-boot-th + - ./pkg/ghci + - ./pkg/pretty + - ./pkg/template-haskell + - ./pkg/process + - ./pkg/time + - IfUnix: ./pkg/unix + - IfWindows: ./pkg/Win32 + +programs: + + # GHCJS programs + # + # customize their wrapper scripts to change the installation destination + + ghcjs: ghcjs + ghcjs-pkg: ghcjs-pkg + haddock-ghcjs: haddock-ghcjs + + # non-wrapped GHCJS programs + + ghcjs-run: ghcjs-run + + # third party programs + + cabal: cabal + ghc: ghc + ghc-pkg: ghc-pkg + node: node + bash: bash + make: make + cpp: cpp + alex: alex + happy: happy + git: git + autoreconf: autoreconf diff --git a/lib/etc/cabalBootConfig b/lib/boot/data/cabalBootConfig similarity index 100% rename from lib/etc/cabalBootConfig rename to lib/boot/data/cabalBootConfig diff --git a/lib/boot/data/doc/ghci-usage.txt b/lib/boot/data/doc/ghci-usage.txt new file mode 100644 index 00000000..d9628b2c --- /dev/null +++ b/lib/boot/data/doc/ghci-usage.txt @@ -0,0 +1,24 @@ +Usage: + + ghci [command-line-options-and-input-files] + +The kinds of input files that can be given on the command-line +include: + + - Haskell source files (.hs or .lhs suffix) + - Object files (.o suffix, or .obj on Windows) + - Dynamic libraries (.so suffix, or .dll on Windows) + +In addition, ghci accepts most of the command-line options that plain +GHC does. Some of the options that are commonly used are: + + -i Search for imported modules in the directory . + + -H32m Increase GHC's default heap size to 32m + + -cpp Enable CPP processing of source files + +Full details can be found in the User's Guide, an online copy of which +can be found here: + + http://haskell.org/haskellwiki/GHC diff --git a/lib/boot/data/doc/ghcjs-usage.txt b/lib/boot/data/doc/ghcjs-usage.txt new file mode 100644 index 00000000..239b4540 --- /dev/null +++ b/lib/boot/data/doc/ghcjs-usage.txt @@ -0,0 +1,81 @@ +Usage: + + $$ [command-line-options-and-input-files] + +To compile and link a complete Haskell program, run the compiler like +so: + + $$ --make Main + +where the module Main is in a file named Main.hs (or Main.lhs) in the +current directory. The other modules in the program will be located +and compiled automatically, and the linked program will be placed in +the file `a.out' (or `Main.exe' on Windows). + +Alternatively, $$ can be used to compile files individually. Each +input file is guided through (some of the) possible phases of a +compilation: + + - unlit: extract code from a "literate program" + - hscpp: run code through the C pre-processor (if -cpp flag given) + - hsc: run the Haskell compiler proper + - gcc: run the C compiler (if compiling via C) + - as: run the assembler + - ld: run the linker + +For each input file, the phase to START with is determined by the +file's suffix: + + - .lhs literate Haskell unlit + - .hs plain Haskell ghc + - .hc C from the Haskell compiler gcc + - .c C not from the Haskell compiler gcc + - .s assembly language as + - other passed directly to the linker ld + +The phase at which to STOP processing is determined by a command-line +option: + + -E stop after generating preprocessed, de-litted Haskell + (used in conjunction with -cpp) + -C stop after generating C (.hc output) + -S stop after generating assembler (.s output) + -c stop after generating object files (.o output) + +Other commonly-used options are: + + -v[n] Control verbosity (n is 0--5, normal verbosity level is 1, + -v alone is equivalent to -v3) + + -O An `optimising' package of compiler flags, for faster code + + -prof Compile for cost-centre profiling + (add -auto-all for automagic cost-centres on all + top-level functions) + + -H14m Increase compiler's heap size (might make compilation + faster, especially on large source files). + + -M Output Makefile rules recording the + dependencies of a list of Haskell files. + +Given the above, here are some TYPICAL invocations of $$: + + # compile a Haskell module to a .o file, optimising: + % $$ -c -O Foo.hs + # link three .o files into an executable called "test": + % $$ -o test Foo.o Bar.o Baz.o + # compile a Haskell module to C (a .hc file), using a bigger heap: + % $$ -C -H16m Foo.hs + # compile Haskell-produced C (.hc) to assembly language: + % $$ -S Foo.hc + +The User's Guide has more information about GHC's *many* options. An +online copy can be found here: + + http://haskell.org/haskellwiki/GHC + +If you *really* want to see every option, then you can pass +'--show-options' to the compiler. + +------------------------------------------------------------------------ diff --git a/include/HsBaseConfig.h b/lib/boot/data/include/HsBaseConfig.h similarity index 98% rename from include/HsBaseConfig.h rename to lib/boot/data/include/HsBaseConfig.h index d902ddfe..4522203f 100644 --- a/include/HsBaseConfig.h +++ b/lib/boot/data/include/HsBaseConfig.h @@ -1,5 +1,5 @@ #ifndef ghcjs_HOST_OS -#include "../../ghcjs-boot/boot/base/include/HsBaseConfig.h" +#include "../ghcjs-boot/boot/base/include/HsBaseConfig.h" #else /* include/HsBaseConfig.h. Generated from HsBaseConfig.h.in by configure. */ @@ -467,6 +467,15 @@ /* Define to 1 if you have the `_chsize' function. */ /* #undef HAVE__CHSIZE */ +/* Define to Haskell type for blkcnt_t */ +#define HTYPE_BLKCNT_T Int32 + +/* Define to Haskell type for blksize_t */ +#define HTYPE_BLKSIZE_T Int32 + +/* Define to Haskell type for bool */ +#define HTYPE_BOOL Word8 + /* Define to Haskell type for cc_t */ #define HTYPE_CC_T Word8 @@ -617,4 +626,4 @@ /* Define for large files, on AIX-style hosts. */ /* #undef _LARGE_FILES */ -#endif \ No newline at end of file +#endif diff --git a/lib/boot/data/include/HsFFI.h b/lib/boot/data/include/HsFFI.h new file mode 100644 index 00000000..c5bdeea2 --- /dev/null +++ b/lib/boot/data/include/HsFFI.h @@ -0,0 +1,117 @@ +#ifndef ghcjs_HOST_OS +#include "../include_native/HsFFI.h" +#else + +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2000 + * + * A mapping for Haskell types to C types, including the corresponding bounds. + * Intended to be used in conjuction with the FFI. + * + * WARNING: Keep this file and StgTypes.h in synch! + * + * ---------------------------------------------------------------------------*/ + +#ifndef HSFFI_H +#define HSFFI_H + +#ifdef __cplusplus +extern "C" { +#endif + +/* get types from GHC's runtime system */ +#include "ghcconfig.h" +#include "stg/Types.h" + +/* set limits for integral types (static config for GHCJS) */ +#define __INT8_MIN (-128) +#define __INT16_MIN (-32767-1) +#define __INT32_MIN (-2147483647-1) +#define __INT64_MIN (-9223372036854775807LL-1) +#define __INT8_MAX (127) +#define __INT16_MAX (32767) +#define __INT32_MAX (2147483647) +#define __INT64_MAX (9223372036854775807LL) +#define __UINT8_MAX (255U) +#define __UINT16_MAX (65535U) +#define __UINT32_MAX (4294967295U) +#define __UINT64_MAX (18446744073709551615ULL) + +typedef StgChar HsChar; +typedef StgInt HsInt; +typedef StgInt8 HsInt8; +typedef StgInt16 HsInt16; +typedef StgInt32 HsInt32; +typedef StgInt64 HsInt64; +typedef StgWord HsWord; +typedef StgWord8 HsWord8; +typedef StgWord16 HsWord16; +typedef StgWord32 HsWord32; +typedef StgWord64 HsWord64; +typedef StgFloat HsFloat; +typedef StgDouble HsDouble; +typedef StgInt HsBool; +typedef void* HsPtr; /* this should better match StgAddr */ +typedef void (*HsFunPtr)(void); /* this should better match StgAddr */ +typedef void* HsStablePtr; + +/* this should correspond to the type of StgChar in StgTypes.h */ +#define HS_CHAR_MIN 0 +#define HS_CHAR_MAX 0x10FFFF + +#define HS_BOOL_FALSE 0 +#define HS_BOOL_TRUE 1 + +#define HS_BOOL_MIN HS_BOOL_FALSE +#define HS_BOOL_MAX HS_BOOL_TRUE + +#define HS_INT_MIN __INT32_MIN +#define HS_INT_MAX __INT32_MAX +#define HS_WORD_MAX __UINT32_MAX + +#define HS_INT8_MIN __INT8_MIN +#define HS_INT8_MAX __INT8_MAX +#define HS_INT16_MIN __INT16_MIN +#define HS_INT16_MAX __INT16_MAX +#define HS_INT32_MIN __INT32_MIN +#define HS_INT32_MAX __INT32_MAX +#define HS_INT64_MIN __INT64_MIN +#define HS_INT64_MAX __INT64_MAX +#define HS_WORD8_MAX __UINT8_MAX +#define HS_WORD16_MAX __UINT16_MAX +#define HS_WORD32_MAX __UINT32_MAX +#define HS_WORD64_MAX __UINT64_MAX + +#define HS_FLOAT_RADIX FLT_RADIX +#define HS_FLOAT_ROUNDS FLT_ROUNDS +#define HS_FLOAT_EPSILON FLT_EPSILON +#define HS_FLOAT_DIG FLT_DIG +#define HS_FLOAT_MANT_DIG FLT_MANT_DIG +#define HS_FLOAT_MIN FLT_MIN +#define HS_FLOAT_MIN_EXP FLT_MIN_EXP +#define HS_FLOAT_MIN_10_EXP FLT_MIN_10_EXP +#define HS_FLOAT_MAX FLT_MAX +#define HS_FLOAT_MAX_EXP FLT_MAX_EXP +#define HS_FLOAT_MAX_10_EXP FLT_MAX_10_EXP + +#define HS_DOUBLE_RADIX DBL_RADIX +#define HS_DOUBLE_ROUNDS DBL_ROUNDS +#define HS_DOUBLE_EPSILON DBL_EPSILON +#define HS_DOUBLE_DIG DBL_DIG +#define HS_DOUBLE_MANT_DIG DBL_MANT_DIG +#define HS_DOUBLE_MIN DBL_MIN +#define HS_DOUBLE_MIN_EXP DBL_MIN_EXP +#define HS_DOUBLE_MIN_10_EXP DBL_MIN_10_EXP +#define HS_DOUBLE_MAX DBL_MAX +#define HS_DOUBLE_MAX_EXP DBL_MAX_EXP +#define HS_DOUBLE_MAX_10_EXP DBL_MAX_10_EXP + +#ifdef __cplusplus +} +#endif + +#endif /* HSFFI_H */ + +#endif + diff --git a/lib/boot/data/include/HsVersions.h b/lib/boot/data/include/HsVersions.h new file mode 100644 index 00000000..19c49b26 --- /dev/null +++ b/lib/boot/data/include/HsVersions.h @@ -0,0 +1,29 @@ +#ifndef HSVERSIONS_H +#define HSVERSIONS_H + +/* some definitions from HsVersions.h so that we can compile files from the GHC source tree */ + +/* Global variables may not work in other Haskell implementations, + * but we need them currently! so the conditional on GLASGOW won't do. */ +#if defined(__GLASGOW_HASKELL__) || !defined(__GLASGOW_HASKELL__) +#define GLOBAL_VAR(name,value,ty) \ +{-# NOINLINE name #-}; \ +name :: IORef (ty); \ +name = Util.global (value); + +#define GLOBAL_VAR_M(name,value,ty) \ +{-# NOINLINE name #-}; \ +name :: IORef (ty); \ +name = Util.globalM (value); +#endif + +#define ASSERT(e) if debugIsOn && not (e) then (assertPanic __FILE__ __LINE__) else +#define ASSERT2(e,msg) if debugIsOn && not (e) then (assertPprPanic __FILE__ __LINE__ (msg)) else +#define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg)) $ +#define MASSERT(e) ASSERT(e) return () +#define MASSERT2(e,msg) ASSERT2(e,msg) return () +#define ASSERTM(e) do { bool <- e; MASSERT(bool) } +#define ASSERTM2(e,msg) do { bool <- e; MASSERT2(bool,msg) } +#define WARNM2(e,msg) do { bool <- e; WARN(bool, msg) return () } + +#endif diff --git a/lib/boot/data/include/MachDeps.h b/lib/boot/data/include/MachDeps.h new file mode 100644 index 00000000..ec3ca8be --- /dev/null +++ b/lib/boot/data/include/MachDeps.h @@ -0,0 +1,127 @@ +#ifndef ghcjs_HOST_OS +#include "../include_native/MachDeps.h" +#else + +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow 2002 + * + * Definitions that characterise machine specific properties of basic + * types (C & Haskell). + * + * NB: Keep in sync with HsFFI.h and StgTypes.h. + * NB: THIS FILE IS INCLUDED IN HASKELL SOURCE! + * + * To understand the structure of the RTS headers, see the wiki: + * http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes + * + * ---------------------------------------------------------------------------*/ + +#ifndef MACHDEPS_H +#define MACHDEPS_H + +/* Sizes of C types come from here... */ +#include "ghcautoconf.h" + +/* Sizes of Haskell types follow. These sizes correspond to: + * - the number of bytes in the primitive type (eg. Int#) + * - the number of bytes in the external representation (eg. HsInt) + * - the scale offset used by writeFooOffAddr# + * + * In the heap, the type may take up more space: eg. SIZEOF_INT8 == 1, + * but it takes up SIZEOF_HSWORD (4 or 8) bytes in the heap. + */ + +/* First, check some assumptions.. */ +#if SIZEOF_CHAR != 1 +#error GHC untested on this architecture: sizeof(char) != 1 +#endif + +#if SIZEOF_SHORT != 2 +#error GHC untested on this architecture: sizeof(short) != 2 +#endif + +#if SIZEOF_UNSIGNED_INT != 4 +#error GHC untested on this architecture: sizeof(unsigned int) != 4 +#endif + +#define SIZEOF_HSCHAR SIZEOF_WORD32 +#define ALIGNMENT_HSCHAR ALIGNMENT_WORD32 + +#define SIZEOF_HSINT SIZEOF_VOID_P +#define ALIGNMENT_HSINT ALIGNMENT_VOID_P + +#define SIZEOF_HSWORD SIZEOF_VOID_P +#define ALIGNMENT_HSWORD ALIGNMENT_VOID_P + +#define SIZEOF_HSDOUBLE SIZEOF_DOUBLE +#define ALIGNMENT_HSDOUBLE ALIGNMENT_DOUBLE + +#define SIZEOF_HSFLOAT SIZEOF_FLOAT +#define ALIGNMENT_HSFLOAT ALIGNMENT_FLOAT + +#define SIZEOF_HSPTR SIZEOF_VOID_P +#define ALIGNMENT_HSPTR ALIGNMENT_VOID_P + +#define SIZEOF_HSFUNPTR SIZEOF_VOID_P +#define ALIGNMENT_HSFUNPTR ALIGNMENT_VOID_P + +#define SIZEOF_HSSTABLEPTR SIZEOF_VOID_P +#define ALIGNMENT_HSSTABLEPTR ALIGNMENT_VOID_P + +#define SIZEOF_INT8 SIZEOF_CHAR +#define ALIGNMENT_INT8 ALIGNMENT_CHAR + +#define SIZEOF_WORD8 SIZEOF_UNSIGNED_CHAR +#define ALIGNMENT_WORD8 ALIGNMENT_UNSIGNED_CHAR + +#define SIZEOF_INT16 SIZEOF_SHORT +#define ALIGNMENT_INT16 ALIGNMENT_SHORT + +#define SIZEOF_WORD16 SIZEOF_UNSIGNED_SHORT +#define ALIGNMENT_WORD16 ALIGNMENT_UNSIGNED_SHORT + +#define SIZEOF_INT32 SIZEOF_INT +#define ALIGNMENT_INT32 ALIGNMENT_INT + +#define SIZEOF_WORD32 SIZEOF_UNSIGNED_INT +#define ALIGNMENT_WORD32 ALIGNMENT_UNSIGNED_INT + +#if SIZEOF_LONG == 8 +#define SIZEOF_INT64 SIZEOF_LONG +#define ALIGNMENT_INT64 ALIGNMENT_LONG +#define SIZEOF_WORD64 SIZEOF_UNSIGNED_LONG +#define ALIGNMENT_WORD64 ALIGNMENT_UNSIGNED_LONG +#elif HAVE_LONG_LONG && SIZEOF_LONG_LONG == 8 +#define SIZEOF_INT64 SIZEOF_LONG_LONG +#define ALIGNMENT_INT64 ALIGNMENT_LONG_LONG +#define SIZEOF_WORD64 SIZEOF_UNSIGNED_LONG_LONG +#define ALIGNMENT_WORD64 ALIGNMENT_UNSIGNED_LONG_LONG +#else +#error Cannot find a 64bit type. +#endif + +#ifndef WORD_SIZE_IN_BITS +#if SIZEOF_HSWORD == 4 +#define WORD_SIZE_IN_BITS 32 +#define WORD_SIZE_IN_BITS_FLOAT 32.0 +#else +#define WORD_SIZE_IN_BITS 64 +#define WORD_SIZE_IN_BITS_FLOAT 64.0 +#endif +#endif + +#ifndef TAG_BITS +#if SIZEOF_HSWORD == 4 +#define TAG_BITS 2 +#else +#define TAG_BITS 3 +#endif +#endif + +#define TAG_MASK ((1 << TAG_BITS) - 1) + +#endif /* MACHDEPS_H */ + +#endif + diff --git a/lib/boot/data/include/Stg.h b/lib/boot/data/include/Stg.h new file mode 100644 index 00000000..be966aaf --- /dev/null +++ b/lib/boot/data/include/Stg.h @@ -0,0 +1,547 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2009 + * + * Top-level include file for everything required when compiling .hc + * code. NOTE: in .hc files, Stg.h must be included *before* any + * other headers, because we define some register variables which must + * be done before any inline functions are defined (some system + * headers have been known to define the odd inline function). + * + * We generally try to keep as little visible as possible when + * compiling .hc files. So for example the definitions of the + * InfoTable structs, closure structs and other RTS types are not + * visible here. The compiler knows enough about the representations + * of these types to generate code which manipulates them directly + * with pointer arithmetic. + * + * In ordinary C code, do not #include this file directly: #include + * "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * http://ghc.haskell.org/trac/ghc/wiki/Commentary/SourceTree/Includes + * + * ---------------------------------------------------------------------------*/ + +#ifndef STG_H +#define STG_H + +/* + * If we are compiling a .hc file, then we want all the register + * variables. This is the what happens if you #include "Stg.h" first: + * we assume this is a .hc file, and set IN_STG_CODE==1, which later + * causes the register variables to be enabled in stg/Regs.h. + * + * If instead "Rts.h" is included first, then we are compiling a + * vanilla C file. Everything from Stg.h is provided, except that + * IN_STG_CODE is not defined, and the register variables will not be + * active. + */ +#ifndef IN_STG_CODE +# define IN_STG_CODE 1 + +// Turn on C99 for .hc code. This gives us the INFINITY and NAN +// constants from math.h, which we occasionally need to use in .hc (#1861) +# define _ISOC99_SOURCE + +// We need _BSD_SOURCE so that math.h defines things like gamma +// on Linux +# define _BSD_SOURCE +#endif + +#if IN_STG_CODE == 0 || defined(llvm_CC_FLAVOR) +// C compilers that use an LLVM back end (clang or llvm-gcc) do not +// correctly support global register variables so we make sure that +// we do not declare them for these compilers. +# define NO_GLOBAL_REG_DECLS /* don't define fixed registers */ +#endif + +/* Configuration */ +#include "ghcconfig.h" + +/* The code generator calls the math functions directly in .hc code. + NB. after configuration stuff above, because this sets #defines + that depend on config info, such as __USE_FILE_OFFSET64 */ +#include + +// On Solaris, we don't get the INFINITY and NAN constants unless we +// #define _STDC_C99, and we can't do that unless we also use -std=c99, +// because _STDC_C99 causes the headers to use C99 syntax (e.g. restrict). +// We aren't ready for -std=c99 yet, so define INFINITY/NAN by hand using +// the gcc builtins. +#if !defined(INFINITY) +#if defined(__GNUC__) +#define INFINITY __builtin_inf() +#else +#error No definition for INFINITY +#endif +#endif + +#if !defined(NAN) +#if defined(__GNUC__) +#define NAN __builtin_nan("") +#else +#error No definition for NAN +#endif +#endif + +/* ----------------------------------------------------------------------------- + Useful definitions + -------------------------------------------------------------------------- */ + +/* + * The C backend likes to refer to labels by just mentioning their + * names. However, when a symbol is declared as a variable in C, the + * C compiler will implicitly dereference it when it occurs in source. + * So we must subvert this behaviour for .hc files by declaring + * variables as arrays, which eliminates the implicit dereference. + */ +#if IN_STG_CODE +#define RTS_VAR(x) (x)[] +#define RTS_DEREF(x) (*(x)) +#else +#define RTS_VAR(x) x +#define RTS_DEREF(x) x +#endif + +/* bit macros + */ +#define BITS_PER_BYTE 8 +#define BITS_IN(x) (BITS_PER_BYTE * sizeof(x)) + +/* Compute offsets of struct fields + */ +#define STG_FIELD_OFFSET(s_type, field) ((StgWord)&(((s_type*)0)->field)) + +/* + * 'Portable' inlining: + * INLINE_HEADER is for inline functions in header files (macros) + * STATIC_INLINE is for inline functions in source files + * EXTERN_INLINE is for functions that we want to inline sometimes + * (we also compile a static version of the function; see Inlines.c) + */ +#if defined(__GNUC__) || defined( __INTEL_COMPILER) + +# define INLINE_HEADER static inline +# define INLINE_ME inline +# define STATIC_INLINE INLINE_HEADER + +// The special "extern inline" behaviour is now only supported by gcc +// when _GNUC_GNU_INLINE__ is defined, and you have to use +// __attribute__((gnu_inline)). So when we don't have this, we use +// ordinary static inline. +// +// Apple's gcc defines __GNUC_GNU_INLINE__ without providing +// gnu_inline, so we exclude MacOS X and fall through to the safe +// version. +// +#if defined(__GNUC_GNU_INLINE__) && !defined(__APPLE__) +# if defined(KEEP_INLINES) +# define EXTERN_INLINE inline +# else +# define EXTERN_INLINE extern inline __attribute__((gnu_inline)) +# endif +#else +# if defined(KEEP_INLINES) +# define EXTERN_INLINE +# else +# define EXTERN_INLINE INLINE_HEADER +# endif +#endif + +#elif defined(_MSC_VER) + +# define INLINE_HEADER __inline static +# define INLINE_ME __inline +# define STATIC_INLINE INLINE_HEADER + +# if defined(KEEP_INLINES) +# define EXTERN_INLINE __inline +# else +# define EXTERN_INLINE __inline extern +# endif + +#else + +# error "Don't know how to inline functions with your C compiler." + +#endif + + +/* + * GCC attributes + */ +#if defined(__GNUC__) +#define GNU_ATTRIBUTE(at) __attribute__((at)) +#else +#define GNU_ATTRIBUTE(at) +#endif + +#if __GNUC__ >= 3 +#define GNUC3_ATTRIBUTE(at) __attribute__((at)) +#else +#define GNUC3_ATTRIBUTE(at) +#endif + +#if __GNUC__ > 4 || __GNUC__ == 4 && __GNUC_MINOR__ >= 3 +#define GNUC_ATTR_HOT __attribute__((hot)) +#else +#define GNUC_ATTR_HOT /* nothing */ +#endif + +#define STG_UNUSED GNUC3_ATTRIBUTE(__unused__) + +/* ----------------------------------------------------------------------------- + Global type definitions + -------------------------------------------------------------------------- */ + +#include "MachDeps.h" +#include "stg/Types.h" + +/* ----------------------------------------------------------------------------- + Shorthand forms + -------------------------------------------------------------------------- */ + +typedef StgChar C_; +typedef StgWord W_; +typedef StgWord* P_; +typedef StgInt I_; +typedef StgWord StgWordArray[]; +typedef StgFunPtr F_; + +#define EI_(X) extern StgWordArray (X) GNU_ATTRIBUTE(aligned (8)) +#define II_(X) static StgWordArray (X) GNU_ATTRIBUTE(aligned (8)) +#define IF_(f) static StgFunPtr GNUC3_ATTRIBUTE(used) f(void) +#define FN_(f) StgFunPtr f(void) +#define EF_(f) extern StgFunPtr f(void) + +/* ----------------------------------------------------------------------------- + Tail calls + -------------------------------------------------------------------------- */ + +#define JMP_(cont) return((StgFunPtr)(cont)) +#define FB_ +#define FE_ + +/* ----------------------------------------------------------------------------- + Other Stg stuff... + -------------------------------------------------------------------------- */ + +#include "stg/DLL.h" +#include "stg/RtsMachRegs.h" +#include "stg/Regs.h" +#include "stg/Ticky.h" + +#if IN_STG_CODE +/* + * This is included later for RTS sources, after definitions of + * StgInfoTable, StgClosure and so on. + */ +#include "stg/MiscClosures.h" +#endif + +#include "stg/Prim.h" /* ghc-prim fallbacks */ +#include "stg/SMP.h" // write_barrier() inline is required + +/* ----------------------------------------------------------------------------- + Moving Floats and Doubles + + ASSIGN_FLT is for assigning a float to memory (usually the + stack/heap). The memory address is guaranteed to be + StgWord aligned (currently == sizeof(void *)). + + PK_FLT is for pulling a float out of memory. The memory is + guaranteed to be StgWord aligned. + -------------------------------------------------------------------------- */ + +INLINE_HEADER void ASSIGN_FLT (W_ [], StgFloat); +INLINE_HEADER StgFloat PK_FLT (W_ []); + +#if ALIGNMENT_FLOAT <= ALIGNMENT_VOID_P + +INLINE_HEADER void ASSIGN_FLT(W_ p_dest[], StgFloat src) { *(StgFloat *)p_dest = src; } +INLINE_HEADER StgFloat PK_FLT (W_ p_src[]) { return *(StgFloat *)p_src; } + +#else /* ALIGNMENT_FLOAT > ALIGNMENT_UNSIGNED_INT */ + +INLINE_HEADER void ASSIGN_FLT(W_ p_dest[], StgFloat src) +{ + float_thing y; + y.f = src; + *p_dest = y.fu; +} + +INLINE_HEADER StgFloat PK_FLT(W_ p_src[]) +{ + float_thing y; + y.fu = *p_src; + return(y.f); +} + +#endif /* ALIGNMENT_FLOAT > ALIGNMENT_VOID_P */ + +#if ALIGNMENT_DOUBLE <= ALIGNMENT_VOID_P + +INLINE_HEADER void ASSIGN_DBL (W_ [], StgDouble); +INLINE_HEADER StgDouble PK_DBL (W_ []); + +INLINE_HEADER void ASSIGN_DBL(W_ p_dest[], StgDouble src) { *(StgDouble *)p_dest = src; } +INLINE_HEADER StgDouble PK_DBL (W_ p_src[]) { return *(StgDouble *)p_src; } + +#else /* ALIGNMENT_DOUBLE > ALIGNMENT_VOID_P */ + +/* Sparc uses two floating point registers to hold a double. We can + * write ASSIGN_DBL and PK_DBL by directly accessing the registers + * independently - unfortunately this code isn't writable in C, we + * have to use inline assembler. + */ +#if sparc_HOST_ARCH + +#define ASSIGN_DBL(dst0,src) \ + { StgPtr dst = (StgPtr)(dst0); \ + __asm__("st %2,%0\n\tst %R2,%1" : "=m" (((P_)(dst))[0]), \ + "=m" (((P_)(dst))[1]) : "f" (src)); \ + } + +#define PK_DBL(src0) \ + ( { StgPtr src = (StgPtr)(src0); \ + register double d; \ + __asm__("ld %1,%0\n\tld %2,%R0" : "=f" (d) : \ + "m" (((P_)(src))[0]), "m" (((P_)(src))[1])); d; \ + } ) + +#else /* ! sparc_HOST_ARCH */ + +INLINE_HEADER void ASSIGN_DBL (W_ [], StgDouble); +INLINE_HEADER StgDouble PK_DBL (W_ []); + +typedef struct + { StgWord dhi; + StgWord dlo; + } unpacked_double; + +typedef union + { StgDouble d; + unpacked_double du; + } double_thing; + +INLINE_HEADER void ASSIGN_DBL(W_ p_dest[], StgDouble src) +{ + double_thing y; + y.d = src; + p_dest[0] = y.du.dhi; + p_dest[1] = y.du.dlo; +} + +/* GCC also works with this version, but it generates + the same code as the previous one, and is not ANSI + +#define ASSIGN_DBL( p_dest, src ) \ + *p_dest = ((double_thing) src).du.dhi; \ + *(p_dest+1) = ((double_thing) src).du.dlo \ +*/ + +INLINE_HEADER StgDouble PK_DBL(W_ p_src[]) +{ + double_thing y; + y.du.dhi = p_src[0]; + y.du.dlo = p_src[1]; + return(y.d); +} + +#endif /* ! sparc_HOST_ARCH */ + +#endif /* ALIGNMENT_DOUBLE > ALIGNMENT_UNSIGNED_INT */ + + +/* ----------------------------------------------------------------------------- + Moving 64-bit quantities around + + ASSIGN_Word64 assign an StgWord64/StgInt64 to a memory location + PK_Word64 load an StgWord64/StgInt64 from a amemory location + + In both cases the memory location might not be 64-bit aligned. + -------------------------------------------------------------------------- */ + +#if SIZEOF_HSWORD == 4 + +typedef struct + { StgWord dhi; + StgWord dlo; + } unpacked_double_word; + +typedef union + { StgInt64 i; + unpacked_double_word iu; + } int64_thing; + +typedef union + { StgWord64 w; + unpacked_double_word wu; + } word64_thing; + +INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src) +{ + word64_thing y; + y.w = src; + p_dest[0] = y.wu.dhi; + p_dest[1] = y.wu.dlo; +} + +INLINE_HEADER StgWord64 PK_Word64(W_ p_src[]) +{ + word64_thing y; + y.wu.dhi = p_src[0]; + y.wu.dlo = p_src[1]; + return(y.w); +} + +INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src) +{ + int64_thing y; + y.i = src; + p_dest[0] = y.iu.dhi; + p_dest[1] = y.iu.dlo; +} + +INLINE_HEADER StgInt64 PK_Int64(W_ p_src[]) +{ + int64_thing y; + y.iu.dhi = p_src[0]; + y.iu.dlo = p_src[1]; + return(y.i); +} + +#elif SIZEOF_VOID_P == 8 + +INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src) +{ + p_dest[0] = src; +} + +INLINE_HEADER StgWord64 PK_Word64(W_ p_src[]) +{ + return p_src[0]; +} + +INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src) +{ + p_dest[0] = src; +} + +INLINE_HEADER StgInt64 PK_Int64(W_ p_src[]) +{ + return p_src[0]; +} + +#endif /* SIZEOF_HSWORD == 4 */ + +/* ----------------------------------------------------------------------------- + Split markers + -------------------------------------------------------------------------- */ + +#if defined(USE_SPLIT_MARKERS) +#if defined(LEADING_UNDERSCORE) +#define __STG_SPLIT_MARKER __asm__("\n___stg_split_marker:"); +#else +#define __STG_SPLIT_MARKER __asm__("\n__stg_split_marker:"); +#endif +#else +#define __STG_SPLIT_MARKER /* nothing */ +#endif + +/* ----------------------------------------------------------------------------- + Write-combining store + -------------------------------------------------------------------------- */ + +INLINE_HEADER void +wcStore (StgPtr p, StgWord w) +{ +#ifdef x86_64_HOST_ARCH + __asm__( + "movnti\t%1, %0" + : "=m" (*p) + : "r" (w) + ); +#else + *p = w; +#endif +} + +/* ----------------------------------------------------------------------------- + Integer multiply with overflow + -------------------------------------------------------------------------- */ + +/* Multiply with overflow checking. + * + * This is tricky - the usual sign rules for add/subtract don't apply. + * + * On 32-bit machines we use gcc's 'long long' types, finding + * overflow with some careful bit-twiddling. + * + * On 64-bit machines where gcc's 'long long' type is also 64-bits, + * we use a crude approximation, testing whether either operand is + * larger than 32-bits; if neither is, then we go ahead with the + * multiplication. + * + * Return non-zero if there is any possibility that the signed multiply + * of a and b might overflow. Return zero only if you are absolutely sure + * that it won't overflow. If in doubt, return non-zero. + */ + +#if SIZEOF_VOID_P == 4 + +#ifdef WORDS_BIGENDIAN +#define RTS_CARRY_IDX__ 0 +#define RTS_REM_IDX__ 1 +#else +#define RTS_CARRY_IDX__ 1 +#define RTS_REM_IDX__ 0 +#endif + +typedef union { + StgInt64 l; + StgInt32 i[2]; +} long_long_u ; + +#define mulIntMayOflo(a,b) \ +({ \ + StgInt32 r, c; \ + long_long_u z; \ + z.l = (StgInt64)a * (StgInt64)b; \ + r = z.i[RTS_REM_IDX__]; \ + c = z.i[RTS_CARRY_IDX__]; \ + if (c == 0 || c == -1) { \ + c = ((StgWord)((a^b) ^ r)) \ + >> (BITS_IN (I_) - 1); \ + } \ + c; \ +}) + +/* Careful: the carry calculation above is extremely delicate. Make sure + * you test it thoroughly after changing it. + */ + +#else + +/* Approximate version when we don't have long arithmetic (on 64-bit archs) */ + +/* If we have n-bit words then we have n-1 bits after accounting for the + * sign bit, so we can fit the result of multiplying 2 (n-1)/2-bit numbers */ +#define HALF_POS_INT (((I_)1) << ((BITS_IN (I_) - 1) / 2)) +#define HALF_NEG_INT (-HALF_POS_INT) + +#define mulIntMayOflo(a,b) \ +({ \ + I_ c; \ + if ((I_)a <= HALF_NEG_INT || a >= HALF_POS_INT \ + || (I_)b <= HALF_NEG_INT || b >= HALF_POS_INT) {\ + c = 1; \ + } else { \ + c = 0; \ + } \ + c; \ +}) +#endif + +#endif /* STG_H */ diff --git a/lib/boot/data/include/ghcautoconf.h b/lib/boot/data/include/ghcautoconf.h new file mode 100644 index 00000000..f87d5f6d --- /dev/null +++ b/lib/boot/data/include/ghcautoconf.h @@ -0,0 +1,46 @@ +#ifndef ghcjs_HOST_OS +#include "../include_native/ghcautoconf.h" +#else + +#ifndef __GHCAUTOCONF_H__ +#define __GHCAUTOCONF_H__ + +/* static config for GHCJS */ +#define ALIGNMENT_CHAR 1 +#define ALIGNMENT_DOUBLE 8 +#define ALIGNMENT_FLOAT 4 +#define ALIGNMENT_INT 4 +#define ALIGNMENT_LONG 4 +#define ALIGNMENT_LONG_LONG 8 +#define ALIGNMENT_SHORT 2 +#define ALIGNMENT_UNSIGNED_CHAR 1 +#define ALIGNMENT_UNSIGNED_INT 4 +#define ALIGNMENT_UNSIGNED_LONG 4 +#define ALIGNMENT_UNSIGNED_LONG_LONG 8 +#define ALIGNMENT_UNSIGNED_SHORT 2 +#define ALIGNMENT_VOID_P 4 +#define CC_SUPPORTS_TLS 0 +#define HAS_VISIBILITY_HIDDEN 1 +#define HAVE_BIN_SH 1 +#define HAVE_GETTIMEOFDAY 1 +#define HAVE_LONG_LONG 1 +#define LEADING_UNDERSCORE 1 +#define RETSIGTYPE void +#define SIZEOF_CHAR 1 +#define SIZEOF_DOUBLE 8 +#define SIZEOF_FLOAT 4 +#define SIZEOF_INT 4 +#define SIZEOF_LONG 4 +#define SIZEOF_LONG_LONG 8 +#define SIZEOF_SHORT 2 +#define SIZEOF_UNSIGNED_CHAR 1 +#define SIZEOF_UNSIGNED_INT 4 +#define SIZEOF_UNSIGNED_LONG 4 +#define SIZEOF_UNSIGNED_LONG_LONG 8 +#define SIZEOF_UNSIGNED_SHORT 2 +#define SIZEOF_VOID_P 4 +#define TABLES_NEXT_TO_CODE 1 +#endif /* __GHCAUTOCONF_H__ */ + +#endif + diff --git a/lib/boot/data/include/ghcjs.h b/lib/boot/data/include/ghcjs.h new file mode 100644 index 00000000..2ce5bf25 --- /dev/null +++ b/lib/boot/data/include/ghcjs.h @@ -0,0 +1,47 @@ +#ifndef __GHCJS_H__ +#define __GHCJS_H__ + +/* + The JavaScript handler is a function that is called when a + `foreign import javascript' function is called in native code + compiled with GHCJS. + + The default handler panics and quits the program immediately, + custom handlers could run the code in a JS engine. + + The arguments are as follows: + + 1. the JavaScript pattern in the declaration + + 2. safety: + 0: unsafe + 1: safe + 2: interruptible + + 3. pattern for the argument and result type. the first character + is the return value type, other characters are for the arguments + + possible values: + 'v' : void (only for return value) + 'p' : general pointer + 'r' : JSVal pointer + 'i' / 'I' : HsInt / HsWord + 'l' / 'L' : HsInt32 / HsWord32 + 'm' / 'M' : HsInt64 / HsWord64 + 's' / 'S' : HsInt16 / HsWord16 + 'b' / 'B' : HsInt8 / HsWord8 + 'c' : HsChar + 'd' : HsDouble + 'f' : HsFloat + + 4. pointer to store the return value + + 5... vararg arguments to the function, types according to arg 2. + */ + +typedef void (*javaScriptHandler)(const char*, int, const char*, void*, ...); + +javaScriptHandler getJavaScriptHandler(); +void setJavaScriptHandler(javaScriptHandler); + +#endif diff --git a/lib/boot/data/include/ghcjs/constants.h b/lib/boot/data/include/ghcjs/constants.h new file mode 100644 index 00000000..1ee40ef7 --- /dev/null +++ b/lib/boot/data/include/ghcjs/constants.h @@ -0,0 +1,18 @@ +#ifndef __GHCJS_CONSTANTS_H_ +#define __GHCJS_CONSTANTS_H_ + +// values defined in Gen2.ClosureInfo +#define CLOSURE_TYPE_FUN (1) +#define CLOSURE_TYPE_CON (2) +#define CLOSURE_TYPE_THUNK (0) +#define CLOSURE_TYPE_PAP (3) +#define CLOSURE_TYPE_BLACKHOLE (5) +#define CLOSURE_TYPE_STACKFRAME (-1) + +// thread status +#define THREAD_RUNNING (0) +#define THREAD_BLOCKED (1) +#define THREAD_FINISHED (16) +#define THREAD_DIED (17) + +#endif diff --git a/lib/boot/data/include/ghcjs/rts.h b/lib/boot/data/include/ghcjs/rts.h new file mode 100644 index 00000000..3542aaad --- /dev/null +++ b/lib/boot/data/include/ghcjs/rts.h @@ -0,0 +1,194 @@ +#ifndef __GHCJS_RTS_H_ +#define __GHCJS_RTS_H_ + +#include "constants.h" + +/* + * low-level heap object manipulation macros + */ + +#ifdef GHCJS_PROF +#define MK_TUP2(x1,x2) (h$c2(h$ghczmprimZCGHCziTupleziZLz2cUZR_con_e,(x1),(x2),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM)) +#define MK_TUP3(x1,x2,x3) (h$c3(h$ghczmprimZCGHCziTupleziZLz2cUz2cUZR_con_e,(x1),(x2),(x3),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM)) +#define MK_TUP4(x1,x2,x3,x4) (h$c4(h$ghczmprimZCGHCziTupleziZLz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM)) +#define MK_TUP5(x1,x2,x3,x4,x5) (h$c5(h$ghczmprimZCGHCziTupleziZLz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM)) +#define MK_TUP6(x1,x2,x3,x4,x5,x6) (h$c6(h$ghczmprimZCGHCziTupleziZLz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM)) +#define MK_TUP7(x1,x2,x3,x4,x5,x6,x7) (h$c7(h$ghczmprimZCGHCziTupleziZLz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM)) +#define MK_TUP8(x1,x2,x3,x4,x5,x6,x7,x8) (h$c8(h$ghczmprimZCGHCziTupleziZLz2cUz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7),(x8),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM)) +#define MK_TUP9(x1,x2,x3,x4,x5,x6,x7,x8,x9) (h$c9(h$ghczmprimZCGHCziTupleziZLz2cUz2cUz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7),(x8),(x9),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM)) +#define MK_TUP10(x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) (h$c10(h$ghczmprimZCGHCziTupleziZLz2cUz2cUz2cUz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7),(x8),(x9),(x10),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM)) +#else +#define MK_TUP2(x1,x2) (h$c2(h$ghczmprimZCGHCziTupleziZLz2cUZR_con_e,(x1),(x2))) +#define MK_TUP3(x1,x2,x3) (h$c3(h$ghczmprimZCGHCziTupleziZLz2cUz2cUZR_con_e,(x1),(x2),(x3))) +#define MK_TUP4(x1,x2,x3,x4) (h$c4(h$ghczmprimZCGHCziTupleziZLz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4))) +#define MK_TUP5(x1,x2,x3,x4,x5) (h$c5(h$ghczmprimZCGHCziTupleziZLz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5))) +#define MK_TUP6(x1,x2,x3,x4,x5,x6) (h$c6(h$ghczmprimZCGHCziTupleziZLz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6))) +#define MK_TUP7(x1,x2,x3,x4,x5,x6,x7) (h$c7(h$ghczmprimZCGHCziTupleziZLz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7))) +#define MK_TUP8(x1,x2,x3,x4,x5,x6,x7,x8) (h$c8(h$ghczmprimZCGHCziTupleziZLz2cUz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7),(x8))) +#define MK_TUP9(x1,x2,x3,x4,x5,x6,x7,x8,x9) (h$c9(h$ghczmprimZCGHCziTupleziZLz2cUz2cUz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7),(x8),(x9))) +#define MK_TUP10(x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) (h$c10(h$ghczmprimZCGHCziTupleziZLz2cUz2cUz2cUz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7),(x8),(x9),(x10))) +#endif + +#define TUP2_1(x) ((x).d1) +#define TUP2_2(x) ((x).d2) + + + +// GHCJS.Prim.JSVal +#ifdef GHCJS_PROF +#define MK_JSVAL(x) (h$c1(h$ghcjszmprimZCGHCJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM)) +#else +#define MK_JSVAL(x) (h$c1(h$ghcjszmprimZCGHCJSziPrimziJSVal_con_e, (x))) +#endif +#define JSVAL_VAL(x) ((x).d1) + +// GHCJS.Prim.JSException +#ifdef GHCJS_PROF +#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$ghcjszmprimZCGHCJSziPrimziJSException_con_e,(msg),(hsMsg),h$CCS_SYSTEM)) +#else +#define MK_JSEXCEPTION(msg,hsMsg) (h$c2(h$ghcjszmprimZCGHCJSziPrimziJSException_con_e,(msg),(hsMsg))) +#endif +// Exception dictionary for JSException +#define HS_JSEXCEPTION_EXCEPTION h$ghcjszmprimZCGHCJSziPrimzizdfExceptionJSException + +// SomeException +#ifdef GHCJS_PROF +#define MK_SOMEEXCEPTION(dict,except) (h$c2(h$baseZCGHCziExceptionziSomeException_con_e,(dict),(except),h$CCS_SYSTEM)) +#else +#define MK_SOMEEXCEPTION(dict,except) (h$c2(h$baseZCGHCziExceptionziSomeException_con_e,(dict),(except))) +#endif + +// GHC.Ptr.Ptr +#ifdef GHCJS_PROF +#define MK_PTR(val,offset) (h$c2(baseZCGHCziPtrziPtr_con_e, (val), (offset), h$CCS_SYSTEM)) +#else +#define MK_PTR(val,offset) (h$c2(baseZCGHCziPtrziPtr_con_e, (val), (offset))) +#endif + +// GHC.Integer.GMP.Internals +#define IS_INTEGER_S(cl) ((cl).f === h$integerzmgmpZCGHCziIntegerziTypeziSzh_con_e) +#define IS_INTEGER_Jp(cl) ((cl).f === h$integerzmgmpZCGHCziIntegerziTypeziJpzh_con_e) +#define IS_INTEGER_Jn(cl) ((cl).f === h$integerzmgmpZCGHCziIntegerziTypeziJnzh_con_e) +#define INTEGER_S_DATA(cl) ((cl).d1) +#define INTEGER_J_DATA(cl) ((cl).d1) +#ifdef GHCJS_PROF +#define MK_INTEGER_S(iii) (h$c1(h$integerzmgmpZCGHCziIntegerziTypeziSzh_con_e, (iii), h$CCS_SYSTEM)); +#define MK_INTEGER_Jp(iii) (h$c1(h$integerzmgmpZCGHCziIntegerziTypeziJpzh_con_e, (iii), h$CCS_SYSTEM)); +#define MK_INTEGER_Jn(iii) (h$c1(h$integerzmgmpZCGHCziIntegerziTypeziJnzh_con_e, (iii), h$CCS_SYSTEM)); +#else +#define MK_INTEGER_S(iii) (h$c1(h$integerzmgmpZCGHCziIntegerziTypeziSzh_con_e, (iii))); +#define MK_INTEGER_Jp(iii) (h$c1(h$integerzmgmpZCGHCziIntegerziTypeziJpzh_con_e, (iii))); +#define MK_INTEGER_Jn(iii) (h$c1(h$integerzmgmpZCGHCziIntegerziTypeziJnzh_con_e, (iii))); +#endif + +// Data.Maybe.Maybe +#define HS_NOTHING h$baseZCGHCziBaseziNothing +#define IS_NOTHING(cl) ((cl).f === h$baseZCGHCziBaseziNothing_con_e) +#define IS_JUST(cl) ((cl).f === h$baseZCGHCziBaseziJust_con_e) +#define JUST_VAL(jj) ((jj).d1) +// #define HS_NOTHING h$nothing +#ifdef GHCJS_PROF +#define MK_JUST(val) (h$c1(h$baseZCGHCziBaseziJust_con_e, (val), h$CCS_SYSTEM)) +#else +#define MK_JUST(val) (h$c1(h$baseZCGHCziBaseziJust_con_e, (val))) +#endif + +// Data.List +#define HS_NIL h$ghczmprimZCGHCziTypesziZMZN +#define HS_NIL_CON h$ghczmprimZCGHCziTypesziZMZN_con_e +#define IS_CONS(cl) ((cl).f === h$ghczmprimZCGHCziTypesziZC_con_e) +#define IS_NIL(cl) ((cl).f === h$ghczmprimZCGHCziTypesziZMZN_con_e) +#define CONS_HEAD(cl) ((cl).d1) +#define CONS_TAIL(cl) ((cl).d2) +#ifdef GHCJS_PROF +#define MK_CONS(head,tail) (h$c2(h$ghczmprimZCGHCziTypesziZC_con_e, (head), (tail), h$CCS_SYSTEM)) +#define MK_CONS_CC(head,tail,cc) (h$c2(h$ghczmprimZCGHCziTypesziZC_con_e, (head), (tail), (cc))) +#else +#define MK_CONS(head,tail) (h$c2(h$ghczmprimZCGHCziTypesziZC_con_e, (head), (tail))) +#define MK_CONS_CC(head,tail,cc) (h$c2(h$ghczmprimZCGHCziTypesziZC_con_e, (head), (tail))) +#endif + +// Data.Text +#define DATA_TEXT_ARRAY(x) ((x).d1) +#define DATA_TEXT_OFFSET(x) ((x).d2.d1) +#define DATA_TEXT_LENGTH(x) ((x).d2.d2) + +// Data.Text.Lazy +#define LAZY_TEXT_IS_CHUNK(x) ((x).f.a === 2) +#define LAZY_TEXT_IS_NIL(x) ((x).f.a === 1) +#define LAZY_TEXT_CHUNK_HEAD(x) ((x)) +#define LAZY_TEXT_CHUNK_TAIL(x) ((x).d2.d3) + +// black holes +// can we skip the indirection for black holes? +#define IS_BLACKHOLE(x) (typeof (x) === 'object' && (x) && (x).f && (x).f.t === CLOSURE_TYPE_BLACKHOLE) +#define BLACKHOLE_TID(bh) ((bh).d1) +#define SET_BLACKHOLE_TID(bh,tid) ((bh).d1 = (tid)) +#define BLACKHOLE_QUEUE(bh) ((bh).d2) +#define SET_BLACKHOLE_QUEUE(bh,val) ((bh).d2 = (val)) + +// resumable thunks +#define MAKE_RESUMABLE(closure,stack) { (closure).f = h$resume_e; (closure).d1 = (stack), (closure).d2 = null; } + +// general deconstruction +#define IS_THUNK(x) ((x).f.t === CLOSURE_TYPE_THUNK) +#define CONSTR_TAG(x) ((x).f.a) + +// retrieve a numeric value that's possibly stored as an indirection +#define IS_WRAPPED_NUMBER(val) ((typeof(val)==='object')&&(val).f === h$unbox_e) +#define UNWRAP_NUMBER(val) ((typeof(val) === 'number')?(val):(val).d1) + +// generic lazy values +#ifdef GHCJS_PROF +#define MK_LAZY(fun) (h$c1(h$lazy_e, (fun), h$CCS_SYSTEM)) +#define MK_LAZY_CC(fun,cc) (h$c1(h$lazy_e, (fun), (cc))) +#else +#define MK_LAZY(fun) (h$c1(h$lazy_e, (fun))) +#define MK_LAZY_CC(fun,cc) (h$c1(h$lazy_e, (fun))) +#endif + +// generic data constructors and selectors +#ifdef GHCJS_PROF +#define MK_DATA1_1(val) (h$c1(h$data1_e, (val), h$CCS_SYSTEM)) +#define MK_DATA1_2(val1,val2) (h$c2(h$data1_e, (val1), (val2), h$CCS_SYSTEM)) +#define MK_DATA2_1(val) (h$c1(h$data2_e, (val), h$CCS_SYSTEM)) +#define MK_DATA2_2(val1,val2) (h$c2(h$data1_e, (val1), (val2), h$CCS_SYSTEM)) +#define MK_SELECT1(val) (h$c1(h$select1_e, (val), h$CCS_SYSTEM)) +#define MK_SELECT2(val) (h$c1(h$select2_e, (val), h$CCS_SYSTEM)) +#define MK_AP1(fun,val) (h$c2(h$ap1_e, (fun), (val), h$CCS_SYSTEM)) +#define MK_AP2(fun,val1,val2) (h$c3(h$ap2_e, (fun), (val1), (val2), h$CCS_SYSTEM)) +#else +#define MK_DATA1_1(val) (h$c1(h$data1_e, (val))) +#define MK_DATA1_2(val1,val2) (h$c2(h$data1_e, (val1), (val2))) +#define MK_DATA2_1(val) (h$c1(h$data2_e, (val))) +#define MK_DATA2_2(val1,val2) (h$c2(h$data2_e, (val1), (val2))) +#define MK_SELECT1(val) (h$c1(h$select1_e, (val))) +#define MK_SELECT2(val) (h$c1(h$select2_e, (val))) +#define MK_AP1(fun,val) (h$c2(h$ap1_e,(fun),(val))) +#define MK_AP2(fun,val1,val2) (h$c3(h$ap2_e,(fun),(val1),(val2))) +#endif + +// unboxed tuple returns +// #define RETURN_UBX_TUP1(x) return x; +#define RETURN_UBX_TUP2(x1,x2) { h$ret1 = (x2); return (x1); } +#define RETURN_UBX_TUP3(x1,x2,x3) { h$ret1 = (x2); h$ret2 = (x3); return (x1); } +#define RETURN_UBX_TUP4(x1,x2,x3,x4) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); return (x1); } +#define RETURN_UBX_TUP5(x1,x2,x3,x4,x5) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); h$ret4 = (x5); return (x1); } +#define RETURN_UBX_TUP6(x1,x2,x3,x4,x5,x6) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); h$ret4 = (x5); h$ret5 = (x6); return (x1); } +#define RETURN_UBX_TUP7(x1,x2,x3,x4,x5,x6,x7) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); h$ret4 = (x5); h$ret5 = (x6); h$ret6 = (x7); return (x1); } +#define RETURN_UBX_TUP8(x1,x2,x3,x4,x5,x6,x7,x8) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); h$ret4 = (x5); h$ret5 = (x6); h$ret6 = (x7); h$ret7 = (x8); return (x1); } +#define RETURN_UBX_TUP9(x1,x2,x3,x4,x5,x6,x7,x8,x9) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); h$ret4 = (x5); h$ret5 = (x6); h$ret6 = (x7); h$ret7 = (x8); h$ret8 = (x9); return (x1); } +#define RETURN_UBX_TUP10(x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) { h$ret1 = (x2); h$ret2 = (x3); h$ret3 = (x4); h$ret4 = (x5); h$ret5 = (x6); h$ret6 = (x7); h$ret7 = (x8); h$ret8 = (x9); h$ret9 = (x10); return (x1); } + +#define CALL_UBX_TUP2(r1,r2,c) { (r1) = (c); (r2) = h$ret1; } +#define CALL_UBX_TUP3(r1,r2,r3,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; } +#define CALL_UBX_TUP4(r1,r2,r3,r4,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; (r4) = h$ret3; } +#define CALL_UBX_TUP5(r1,r2,r3,r4,r5,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; (r4) = h$ret3; (r5) = h$ret4; } +#define CALL_UBX_TUP6(r1,r2,r3,r4,r5,r6,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; (r4) = h$ret3; (r5) = h$ret4; (r6) = h$ret5; } +#define CALL_UBX_TUP7(r1,r2,r3,r4,r5,r6,r7,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; (r4) = h$ret3; (r5) = h$ret4; (r6) = h$ret5; (r7) = h$ret6; } +#define CALL_UBX_TUP8(r1,r2,r3,r4,r5,r6,r7,r8,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; (r4) = h$ret3; (r5) = h$ret4; (r6) = h$ret5; (r7) = h$ret6; (r8) = h$ret7; } +#define CALL_UBX_TUP9(r1,r2,r3,r4,r5,r6,r7,r8,r9,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; (r4) = h$ret3; (r5) = h$ret4; (r6) = h$ret5; (r7) = h$ret6; (r8) = h$ret7; (r9) = h$ret8; } +#define CALL_UBX_TUP10(r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,c) { (r1) = (c); (r2) = h$ret1; (r3) = h$ret2; (r4) = h$ret3; (r5) = h$ret4; (r6) = h$ret5; (r7) = h$ret6; (r8) = h$ret7; (r9) = h$ret8; (r10) = h$ret9; } + + +#endif diff --git a/lib/boot/data/include/ghcplatform.h b/lib/boot/data/include/ghcplatform.h new file mode 100644 index 00000000..ce656150 --- /dev/null +++ b/lib/boot/data/include/ghcplatform.h @@ -0,0 +1,40 @@ +#ifndef ghcjs_HOST_OS +#include "../include_native/ghcplatform.h" +#else + +#ifndef __GHCPLATFORM_H__ +#define __GHCPLATFORM_H__ + +#define BuildPlatform_TYPE ghcjs +#define HostPlatform_TYPE ghcjs + +#define ghcjs_BUILD 1 +#define ghcjs_HOST 1 + +#define ghcjs_BUILD_ARCH 1 +#define ghcjs_HOST_ARCH 1 +#define BUILD_ARCH "ghcjs" +#define HOST_ARCH "ghcjs" + +#define ghcjs_BUILD_OS 1 +#define ghcjs_HOST_OS 1 +#define BUILD_OS "ghcjs" +#define HOST_OS "ghcjs" + +#define ghcjs_BUILD_VENDOR 1 +#define ghcjs_HOST_VENDOR 1 +#define BUILD_VENDOR "ghcjs" +#define HOST_VENDOR "ghcjs" + +/* These TARGET macros are for backwards compatibility... DO NOT USE! */ +#define TargetPlatform_TYPE ghcjs +#define ghcjs_TARGET 1 +#define ghcjs_TARGET_ARCH 1 +#define TARGET_ARCH "ghcjs" +#define ghcjs_TARGET_OS 1 +#define TARGET_OS "ghcjs" +#define ghcjs_TARGET_VENDOR 1 + +#endif /* __GHCPLATFORM_H__ */ + +#endif diff --git a/lib/etc/manifest.webapp b/lib/boot/data/manifest.webapp similarity index 100% rename from lib/etc/manifest.webapp rename to lib/boot/data/manifest.webapp diff --git a/lib/etc/rtsdeps.yaml b/lib/boot/data/rtsdeps.yaml similarity index 100% rename from lib/etc/rtsdeps.yaml rename to lib/boot/data/rtsdeps.yaml diff --git a/lib/etc/runner.c-tmpl b/lib/boot/data/runner.c-tmpl similarity index 100% rename from lib/etc/runner.c-tmpl rename to lib/boot/data/runner.c-tmpl diff --git a/lib/etc/runner.manifest b/lib/boot/data/runner.manifest similarity index 100% rename from lib/etc/runner.manifest rename to lib/boot/data/runner.manifest diff --git a/lib/etc/runner.rc b/lib/boot/data/runner.rc similarity index 100% rename from lib/etc/runner.rc rename to lib/boot/data/runner.rc diff --git a/lib/etc/template.html b/lib/boot/data/template.html similarity index 100% rename from lib/etc/template.html rename to lib/boot/data/template.html diff --git a/lib/etc/thdeps.yaml b/lib/boot/data/thdeps.yaml similarity index 88% rename from lib/etc/thdeps.yaml rename to lib/boot/data/thdeps.yaml index c57441e1..e989282b 100644 --- a/lib/etc/thdeps.yaml +++ b/lib/boot/data/thdeps.yaml @@ -1,7 +1,5 @@ # symbols that we need for running Template Haskell -ghcjs-th: +ghcjs-prim: GHCJS.Prim.TH.Eval: runTHServer - - diff --git a/lib/etc/thrunner.js b/lib/boot/data/thrunner.js old mode 100755 new mode 100644 similarity index 75% rename from lib/etc/thrunner.js rename to lib/boot/data/thrunner.js index 386fee8e..25afe4dd --- a/lib/etc/thrunner.js +++ b/lib/boot/data/thrunner.js @@ -11,21 +11,16 @@ n: response to request n */ -var h$THfs = require('fs'); - -require('jsdom-global')(); - // set this to true to record each message and the received JS code to a file // you can then replay the TH session later with 'node thrunner.js replay' var h$THRecord = // true || - !!process.env['GHCJS_RECORD_TH']; + !!process.argv['GHCJS_RECORD_TH']; var h$THReplay = process.argv.length > 0 && process.argv[process.argv.length-1] === 'replay'; var h$TH = { nWaiters: 0 , waiters: {} - , data: [] - , dataLen: 0 + , data: null , requestId: 1 , loadedSymbol: null , sendRequest: h$sendRequest @@ -34,45 +29,26 @@ var h$TH = { nWaiters: 0 , loadCode: h$loadCode , loadCodeStr: h$loadCodeStr , bufSize: h$bufSize - , getMemoryUsage: h$getMemoryUsage }; global.h$TH = h$TH; global.require = require; global.module = module; +var h$THfs = require('fs'); + // start listening function h$initTH() { process.stdin.setEncoding('utf8'); process.stderr.setEncoding('binary'); process.on('uncaughtException', function(err) { console.log(err); }); h$awaitMessageRaw(0, h$loadInitialCode); - var leftover = null; process.stdin.on('readable', function() { while(true) { var str = process.stdin.read(); if(str) { - // save incomplete hex pair if needed - str = str.toString(); - if(leftover) str = leftover + str; - str = str.replace(/\s/gm, ''); - if(str.length % 2) { - leftover = str.slice(str.length-1); - str = str.slice(0,str.length-1); - } else { - leftover = null; - } var buf = new Buffer(str, 'hex'); - - // make sure the first 8 bytes into data[0] - // otherwise delay copying the buffers until a complete message - // has been received - if(h$TH.data.length < 1 || h$TH.data[0].length >= 8) { - h$TH.data.push(buf); - } else { - h$TH.data[0] = Buffer.concat([h$TH.data[0], buf]); - } - h$TH.dataLen += buf.length; + h$TH.data = h$TH.data ? Buffer.concat([h$TH.data, buf]) : buf; h$processQueue(); } else { return; @@ -82,31 +58,19 @@ function h$initTH() { process.stdin.on('close', function() { process.exit(0); }); } -function h$getMemoryUsage() { - var m = process.memoryUsage(); - // return m.rss; - return (m.heapTotal + m.external)|0; -} - var h$THMessageN = 0; function h$processQueue() { - while(h$TH.nWaiters > 0 && h$TH.data && h$TH.dataLen >= 8) { - // if we have at least 8 bytes, they are all in data[0] - var msgLength = h$TH.data[0].readUInt32BE(0); - var msgTarget = h$TH.data[0].readUInt32BE(4); - var msgBytes = msgLength + 8; - if(h$TH.dataLen >= msgBytes && h$TH.waiters[msgTarget]) { - var bb = Buffer.concat(h$TH.data); - var w = h$TH.waiters[msgTarget] - var msgPayload = bb.slice(8, msgBytes); - - h$TH.data = [bb.slice(msgBytes)]; - h$TH.dataLen -= msgBytes; + while(h$TH.nWaiters > 0 && h$TH.data && h$TH.data.length >= 8) { + var msgLength = h$TH.data.readUInt32BE(0); + var msgTarget = h$TH.data.readUInt32BE(4); + if(h$TH.data.length >= msgLength + 8 && h$TH.waiters[msgTarget]) { + var w = h$TH.waiters[msgTarget], b = h$TH.data.slice(8, msgLength + 8); + h$TH.data = h$TH.data.slice(msgLength + 8); delete h$TH.waiters[msgTarget]; h$TH.nWaiters--; if(h$THRecord && !h$THReplay) - h$THfs.writeFileSync("thmessage." + (++h$THMessageN) + ".dat", msgPayload); - w(msgPayload); + h$THfs.writeFileSync("thmessage." + (++h$THMessageN) + ".dat", b); + w(b); } else { return; } @@ -215,3 +179,4 @@ function h$THWrapBuffer(buf, unalignedOk, offset, length) { } h$initTH(); + diff --git a/lib/etc/wiredinpkgs.yaml b/lib/boot/data/wiredinpkgs.yaml similarity index 97% rename from lib/etc/wiredinpkgs.yaml rename to lib/boot/data/wiredinpkgs.yaml index 02138856..84f2a8c0 100644 --- a/lib/etc/wiredinpkgs.yaml +++ b/lib/boot/data/wiredinpkgs.yaml @@ -12,4 +12,3 @@ # Only stage1 packages can be wired-in. - ghcjs-prim -- ghcjs-th diff --git a/lib/boot/shims/Win32.yaml b/lib/boot/shims/Win32.yaml new file mode 100644 index 00000000..b80a099d --- /dev/null +++ b/lib/boot/shims/Win32.yaml @@ -0,0 +1 @@ +version: 2.3.0.2 .. \ No newline at end of file diff --git a/lib/boot/shims/base.yaml b/lib/boot/shims/base.yaml new file mode 100644 index 00000000..95dff376 --- /dev/null +++ b/lib/boot/shims/base.yaml @@ -0,0 +1,5 @@ +version: 4.7.0.1 .. +js: + - lib/closure-library/closure/goog/crypt/hash.js + - lib/closure-library/closure/goog/crypt/md5.js + - pkg/base.js diff --git a/lib/boot/shims/bytestring.yaml b/lib/boot/shims/bytestring.yaml new file mode 100644 index 00000000..ae257857 --- /dev/null +++ b/lib/boot/shims/bytestring.yaml @@ -0,0 +1,2 @@ +js: + - pkg/bytestring.js diff --git a/lib/boot/shims/directory.yaml b/lib/boot/shims/directory.yaml new file mode 100644 index 00000000..3b236c70 --- /dev/null +++ b/lib/boot/shims/directory.yaml @@ -0,0 +1,3 @@ +version: 1.2.1.0 .. +js: + - pkg/directory.js diff --git a/lib/boot/shims/filepath.yaml b/lib/boot/shims/filepath.yaml new file mode 100644 index 00000000..2332fdd0 --- /dev/null +++ b/lib/boot/shims/filepath.yaml @@ -0,0 +1,3 @@ +version: 1.3.0.2 .. +js: + - pkg/filepath.js diff --git a/lib/boot/shims/ghc-prim.yaml b/lib/boot/shims/ghc-prim.yaml new file mode 100644 index 00000000..9772396c --- /dev/null +++ b/lib/boot/shims/ghc-prim.yaml @@ -0,0 +1 @@ +version: 0.3.1.0 .. \ No newline at end of file diff --git a/lib/boot/shims/ghcjs-base.yaml b/lib/boot/shims/ghcjs-base.yaml new file mode 100644 index 00000000..e2850743 --- /dev/null +++ b/lib/boot/shims/ghcjs-base.yaml @@ -0,0 +1,2 @@ +js: + - src/object.js \ No newline at end of file diff --git a/lib/boot/shims/ghcjs-canvas.yaml b/lib/boot/shims/ghcjs-canvas.yaml new file mode 100644 index 00000000..76855ccb --- /dev/null +++ b/lib/boot/shims/ghcjs-canvas.yaml @@ -0,0 +1,3 @@ +js: + - pkg/ghcjs-canvas.js + \ No newline at end of file diff --git a/lib/boot/shims/ghcjs-dom.yaml b/lib/boot/shims/ghcjs-dom.yaml new file mode 100644 index 00000000..e5c99fa7 --- /dev/null +++ b/lib/boot/shims/ghcjs-dom.yaml @@ -0,0 +1,2 @@ +js: + - pkg/ghcjs-dom.js diff --git a/lib/boot/shims/glib.yaml b/lib/boot/shims/glib.yaml new file mode 100644 index 00000000..efd1ab30 --- /dev/null +++ b/lib/boot/shims/glib.yaml @@ -0,0 +1,3 @@ +version: 0.13.0.0 .. +js: + - pkg/glib.js diff --git a/lib/boot/shims/hashable.yaml b/lib/boot/shims/hashable.yaml new file mode 100644 index 00000000..9538b52e --- /dev/null +++ b/lib/boot/shims/hashable.yaml @@ -0,0 +1,3 @@ +version: 1.2.1.0 .. +js: + - pkg/hashable.js diff --git a/lib/boot/shims/integer-gmp.yaml b/lib/boot/shims/integer-gmp.yaml new file mode 100644 index 00000000..c3f65d62 --- /dev/null +++ b/lib/boot/shims/integer-gmp.yaml @@ -0,0 +1 @@ +version: 0.5.1.0 .. \ No newline at end of file diff --git a/lib/boot/shims/lib/closure-library/AUTHORS b/lib/boot/shims/lib/closure-library/AUTHORS new file mode 100644 index 00000000..c8ad75a8 --- /dev/null +++ b/lib/boot/shims/lib/closure-library/AUTHORS @@ -0,0 +1,17 @@ +# This is a list of contributors to the Closure Library. + +# Names should be added to this file like so: +# Name or Organization + +Google Inc. +Mohamed Mansour +Bjorn Tipling +SameGoal LLC +Guido Tapia +Andrew Mattie +Ilia Mirkin +Ivan Kozik +Rich Dougherty +Chad Killingsworth +Dan Pupius + diff --git a/lib/boot/shims/lib/closure-library/LICENSE b/lib/boot/shims/lib/closure-library/LICENSE new file mode 100644 index 00000000..d9a10c0d --- /dev/null +++ b/lib/boot/shims/lib/closure-library/LICENSE @@ -0,0 +1,176 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS diff --git a/lib/boot/shims/lib/closure-library/README.md b/lib/boot/shims/lib/closure-library/README.md new file mode 100644 index 00000000..d794d1b9 --- /dev/null +++ b/lib/boot/shims/lib/closure-library/README.md @@ -0,0 +1,9 @@ +# Closure Library + +Closure Library is a powerful, low-level JavaScript library designed +for building complex and scalable web applications. It is used by many +Google web applications, such as Gmail and Google Docs. + +For more information, visit the +[Google Developers](https://developers.google.com/closure/library) or +[GitHub](https://github.com/google/closure-library) sites. diff --git a/lib/boot/shims/lib/closure-library/closure/goog/crypt/hash.js b/lib/boot/shims/lib/closure-library/closure/goog/crypt/hash.js new file mode 100644 index 00000000..51209be6 --- /dev/null +++ b/lib/boot/shims/lib/closure-library/closure/goog/crypt/hash.js @@ -0,0 +1,69 @@ +// Copyright 2011 The Closure Library Authors. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS-IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +/** + * @fileoverview Abstract cryptographic hash interface. + * + * See goog.crypt.Sha1 and goog.crypt.Md5 for sample implementations. + * + */ + +goog.provide('goog.crypt.Hash'); + + + +/** + * Create a cryptographic hash instance. + * + * @constructor + * @struct + */ +goog.crypt.Hash = function() { + /** + * The block size for the hasher. + * @type {number} + */ + this.blockSize = -1; +}; + + +/** + * Resets the internal accumulator. + */ +goog.crypt.Hash.prototype.reset = goog.abstractMethod; + + +/** + * Adds a byte array (array with values in [0-255] range) or a string (might + * only contain 8-bit, i.e., Latin1 characters) to the internal accumulator. + * + * Many hash functions operate on blocks of data and implement optimizations + * when a full chunk of data is readily available. Hence it is often preferable + * to provide large chunks of data (a kilobyte or more) than to repeatedly + * call the update method with few tens of bytes. If this is not possible, or + * not feasible, it might be good to provide data in multiplies of hash block + * size (often 64 bytes). Please see the implementation and performance tests + * of your favourite hash. + * + * @param {Array|Uint8Array|string} bytes Data used for the update. + * @param {number=} opt_length Number of bytes to use. + */ +goog.crypt.Hash.prototype.update = goog.abstractMethod; + + +/** + * @return {!Array} The finalized hash computed + * from the internal accumulator. + */ +goog.crypt.Hash.prototype.digest = goog.abstractMethod; diff --git a/lib/boot/shims/lib/closure-library/closure/goog/crypt/md5.js b/lib/boot/shims/lib/closure-library/closure/goog/crypt/md5.js new file mode 100644 index 00000000..56335e15 --- /dev/null +++ b/lib/boot/shims/lib/closure-library/closure/goog/crypt/md5.js @@ -0,0 +1,435 @@ +// Copyright 2011 The Closure Library Authors. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS-IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +/** + * @fileoverview MD5 cryptographic hash. + * Implementation of http://tools.ietf.org/html/rfc1321 with common + * optimizations and tweaks (see http://en.wikipedia.org/wiki/MD5). + * + * Usage: + * var md5 = new goog.crypt.Md5(); + * md5.update(bytes); + * var hash = md5.digest(); + * + * Performance: + * Chrome 23 ~680 Mbit/s + * Chrome 13 (in a VM) ~250 Mbit/s + * Firefox 6.0 (in a VM) ~100 Mbit/s + * IE9 (in a VM) ~27 Mbit/s + * Firefox 3.6 ~15 Mbit/s + * IE8 (in a VM) ~13 Mbit/s + * + */ + +goog.provide('goog.crypt.Md5'); + +goog.require('goog.crypt.Hash'); + + + +/** + * MD5 cryptographic hash constructor. + * @constructor + * @extends {goog.crypt.Hash} + * @final + * @struct + */ +goog.crypt.Md5 = function() { + goog.crypt.Md5.base(this, 'constructor'); + + this.blockSize = 512 / 8; + + /** + * Holds the current values of accumulated A-D variables (MD buffer). + * @type {!Array} + * @private + */ + this.chain_ = new Array(4); + + /** + * A buffer holding the data until the whole block can be processed. + * @type {!Array} + * @private + */ + this.block_ = new Array(this.blockSize); + + /** + * The length of yet-unprocessed data as collected in the block. + * @type {number} + * @private + */ + this.blockLength_ = 0; + + /** + * The total length of the message so far. + * @type {number} + * @private + */ + this.totalLength_ = 0; + + this.reset(); +}; +goog.inherits(goog.crypt.Md5, goog.crypt.Hash); + + +/** + * Integer rotation constants used by the abbreviated implementation. + * They are hardcoded in the unrolled implementation, so it is left + * here commented out. + * @type {Array} + * @private + * +goog.crypt.Md5.S_ = [ + 7, 12, 17, 22, 7, 12, 17, 22, 7, 12, 17, 22, 7, 12, 17, 22, + 5, 9, 14, 20, 5, 9, 14, 20, 5, 9, 14, 20, 5, 9, 14, 20, + 4, 11, 16, 23, 4, 11, 16, 23, 4, 11, 16, 23, 4, 11, 16, 23, + 6, 10, 15, 21, 6, 10, 15, 21, 6, 10, 15, 21, 6, 10, 15, 21 +]; + */ + +/** + * Sine function constants used by the abbreviated implementation. + * They are hardcoded in the unrolled implementation, so it is left + * here commented out. + * @type {Array} + * @private + * +goog.crypt.Md5.T_ = [ + 0xd76aa478, 0xe8c7b756, 0x242070db, 0xc1bdceee, + 0xf57c0faf, 0x4787c62a, 0xa8304613, 0xfd469501, + 0x698098d8, 0x8b44f7af, 0xffff5bb1, 0x895cd7be, + 0x6b901122, 0xfd987193, 0xa679438e, 0x49b40821, + 0xf61e2562, 0xc040b340, 0x265e5a51, 0xe9b6c7aa, + 0xd62f105d, 0x02441453, 0xd8a1e681, 0xe7d3fbc8, + 0x21e1cde6, 0xc33707d6, 0xf4d50d87, 0x455a14ed, + 0xa9e3e905, 0xfcefa3f8, 0x676f02d9, 0x8d2a4c8a, + 0xfffa3942, 0x8771f681, 0x6d9d6122, 0xfde5380c, + 0xa4beea44, 0x4bdecfa9, 0xf6bb4b60, 0xbebfbc70, + 0x289b7ec6, 0xeaa127fa, 0xd4ef3085, 0x04881d05, + 0xd9d4d039, 0xe6db99e5, 0x1fa27cf8, 0xc4ac5665, + 0xf4292244, 0x432aff97, 0xab9423a7, 0xfc93a039, + 0x655b59c3, 0x8f0ccc92, 0xffeff47d, 0x85845dd1, + 0x6fa87e4f, 0xfe2ce6e0, 0xa3014314, 0x4e0811a1, + 0xf7537e82, 0xbd3af235, 0x2ad7d2bb, 0xeb86d391 +]; + */ + + +/** @override */ +goog.crypt.Md5.prototype.reset = function() { + this.chain_[0] = 0x67452301; + this.chain_[1] = 0xefcdab89; + this.chain_[2] = 0x98badcfe; + this.chain_[3] = 0x10325476; + + this.blockLength_ = 0; + this.totalLength_ = 0; +}; + + +/** + * Internal compress helper function. It takes a block of data (64 bytes) + * and updates the accumulator. + * @param {Array|Uint8Array|string} buf The block to compress. + * @param {number=} opt_offset Offset of the block in the buffer. + * @private + */ +goog.crypt.Md5.prototype.compress_ = function(buf, opt_offset) { + if (!opt_offset) { + opt_offset = 0; + } + + // We allocate the array every time, but it's cheap in practice. + var X = new Array(16); + + // Get 16 little endian words. It is not worth unrolling this for Chrome 11. + if (goog.isString(buf)) { + for (var i = 0; i < 16; ++i) { + X[i] = (buf.charCodeAt(opt_offset++)) | + (buf.charCodeAt(opt_offset++) << 8) | + (buf.charCodeAt(opt_offset++) << 16) | + (buf.charCodeAt(opt_offset++) << 24); + } + } else { + for (var i = 0; i < 16; ++i) { + X[i] = (buf[opt_offset++]) | + (buf[opt_offset++] << 8) | + (buf[opt_offset++] << 16) | + (buf[opt_offset++] << 24); + } + } + + var A = this.chain_[0]; + var B = this.chain_[1]; + var C = this.chain_[2]; + var D = this.chain_[3]; + var sum = 0; + + /* + * This is an abbreviated implementation, it is left here commented out for + * reference purposes. See below for an unrolled version in use. + * + var f, n, tmp; + for (var i = 0; i < 64; ++i) { + + if (i < 16) { + f = (D ^ (B & (C ^ D))); + n = i; + } else if (i < 32) { + f = (C ^ (D & (B ^ C))); + n = (5 * i + 1) % 16; + } else if (i < 48) { + f = (B ^ C ^ D); + n = (3 * i + 5) % 16; + } else { + f = (C ^ (B | (~D))); + n = (7 * i) % 16; + } + + tmp = D; + D = C; + C = B; + sum = (A + f + goog.crypt.Md5.T_[i] + X[n]) & 0xffffffff; + B += ((sum << goog.crypt.Md5.S_[i]) & 0xffffffff) | + (sum >>> (32 - goog.crypt.Md5.S_[i])); + A = tmp; + } + */ + + /* + * This is an unrolled MD5 implementation, which gives ~30% speedup compared + * to the abbreviated implementation above, as measured on Chrome 11. It is + * important to keep 32-bit croppings to minimum and inline the integer + * rotation. + */ + sum = (A + (D ^ (B & (C ^ D))) + X[0] + 0xd76aa478) & 0xffffffff; + A = B + (((sum << 7) & 0xffffffff) | (sum >>> 25)); + sum = (D + (C ^ (A & (B ^ C))) + X[1] + 0xe8c7b756) & 0xffffffff; + D = A + (((sum << 12) & 0xffffffff) | (sum >>> 20)); + sum = (C + (B ^ (D & (A ^ B))) + X[2] + 0x242070db) & 0xffffffff; + C = D + (((sum << 17) & 0xffffffff) | (sum >>> 15)); + sum = (B + (A ^ (C & (D ^ A))) + X[3] + 0xc1bdceee) & 0xffffffff; + B = C + (((sum << 22) & 0xffffffff) | (sum >>> 10)); + sum = (A + (D ^ (B & (C ^ D))) + X[4] + 0xf57c0faf) & 0xffffffff; + A = B + (((sum << 7) & 0xffffffff) | (sum >>> 25)); + sum = (D + (C ^ (A & (B ^ C))) + X[5] + 0x4787c62a) & 0xffffffff; + D = A + (((sum << 12) & 0xffffffff) | (sum >>> 20)); + sum = (C + (B ^ (D & (A ^ B))) + X[6] + 0xa8304613) & 0xffffffff; + C = D + (((sum << 17) & 0xffffffff) | (sum >>> 15)); + sum = (B + (A ^ (C & (D ^ A))) + X[7] + 0xfd469501) & 0xffffffff; + B = C + (((sum << 22) & 0xffffffff) | (sum >>> 10)); + sum = (A + (D ^ (B & (C ^ D))) + X[8] + 0x698098d8) & 0xffffffff; + A = B + (((sum << 7) & 0xffffffff) | (sum >>> 25)); + sum = (D + (C ^ (A & (B ^ C))) + X[9] + 0x8b44f7af) & 0xffffffff; + D = A + (((sum << 12) & 0xffffffff) | (sum >>> 20)); + sum = (C + (B ^ (D & (A ^ B))) + X[10] + 0xffff5bb1) & 0xffffffff; + C = D + (((sum << 17) & 0xffffffff) | (sum >>> 15)); + sum = (B + (A ^ (C & (D ^ A))) + X[11] + 0x895cd7be) & 0xffffffff; + B = C + (((sum << 22) & 0xffffffff) | (sum >>> 10)); + sum = (A + (D ^ (B & (C ^ D))) + X[12] + 0x6b901122) & 0xffffffff; + A = B + (((sum << 7) & 0xffffffff) | (sum >>> 25)); + sum = (D + (C ^ (A & (B ^ C))) + X[13] + 0xfd987193) & 0xffffffff; + D = A + (((sum << 12) & 0xffffffff) | (sum >>> 20)); + sum = (C + (B ^ (D & (A ^ B))) + X[14] + 0xa679438e) & 0xffffffff; + C = D + (((sum << 17) & 0xffffffff) | (sum >>> 15)); + sum = (B + (A ^ (C & (D ^ A))) + X[15] + 0x49b40821) & 0xffffffff; + B = C + (((sum << 22) & 0xffffffff) | (sum >>> 10)); + sum = (A + (C ^ (D & (B ^ C))) + X[1] + 0xf61e2562) & 0xffffffff; + A = B + (((sum << 5) & 0xffffffff) | (sum >>> 27)); + sum = (D + (B ^ (C & (A ^ B))) + X[6] + 0xc040b340) & 0xffffffff; + D = A + (((sum << 9) & 0xffffffff) | (sum >>> 23)); + sum = (C + (A ^ (B & (D ^ A))) + X[11] + 0x265e5a51) & 0xffffffff; + C = D + (((sum << 14) & 0xffffffff) | (sum >>> 18)); + sum = (B + (D ^ (A & (C ^ D))) + X[0] + 0xe9b6c7aa) & 0xffffffff; + B = C + (((sum << 20) & 0xffffffff) | (sum >>> 12)); + sum = (A + (C ^ (D & (B ^ C))) + X[5] + 0xd62f105d) & 0xffffffff; + A = B + (((sum << 5) & 0xffffffff) | (sum >>> 27)); + sum = (D + (B ^ (C & (A ^ B))) + X[10] + 0x02441453) & 0xffffffff; + D = A + (((sum << 9) & 0xffffffff) | (sum >>> 23)); + sum = (C + (A ^ (B & (D ^ A))) + X[15] + 0xd8a1e681) & 0xffffffff; + C = D + (((sum << 14) & 0xffffffff) | (sum >>> 18)); + sum = (B + (D ^ (A & (C ^ D))) + X[4] + 0xe7d3fbc8) & 0xffffffff; + B = C + (((sum << 20) & 0xffffffff) | (sum >>> 12)); + sum = (A + (C ^ (D & (B ^ C))) + X[9] + 0x21e1cde6) & 0xffffffff; + A = B + (((sum << 5) & 0xffffffff) | (sum >>> 27)); + sum = (D + (B ^ (C & (A ^ B))) + X[14] + 0xc33707d6) & 0xffffffff; + D = A + (((sum << 9) & 0xffffffff) | (sum >>> 23)); + sum = (C + (A ^ (B & (D ^ A))) + X[3] + 0xf4d50d87) & 0xffffffff; + C = D + (((sum << 14) & 0xffffffff) | (sum >>> 18)); + sum = (B + (D ^ (A & (C ^ D))) + X[8] + 0x455a14ed) & 0xffffffff; + B = C + (((sum << 20) & 0xffffffff) | (sum >>> 12)); + sum = (A + (C ^ (D & (B ^ C))) + X[13] + 0xa9e3e905) & 0xffffffff; + A = B + (((sum << 5) & 0xffffffff) | (sum >>> 27)); + sum = (D + (B ^ (C & (A ^ B))) + X[2] + 0xfcefa3f8) & 0xffffffff; + D = A + (((sum << 9) & 0xffffffff) | (sum >>> 23)); + sum = (C + (A ^ (B & (D ^ A))) + X[7] + 0x676f02d9) & 0xffffffff; + C = D + (((sum << 14) & 0xffffffff) | (sum >>> 18)); + sum = (B + (D ^ (A & (C ^ D))) + X[12] + 0x8d2a4c8a) & 0xffffffff; + B = C + (((sum << 20) & 0xffffffff) | (sum >>> 12)); + sum = (A + (B ^ C ^ D) + X[5] + 0xfffa3942) & 0xffffffff; + A = B + (((sum << 4) & 0xffffffff) | (sum >>> 28)); + sum = (D + (A ^ B ^ C) + X[8] + 0x8771f681) & 0xffffffff; + D = A + (((sum << 11) & 0xffffffff) | (sum >>> 21)); + sum = (C + (D ^ A ^ B) + X[11] + 0x6d9d6122) & 0xffffffff; + C = D + (((sum << 16) & 0xffffffff) | (sum >>> 16)); + sum = (B + (C ^ D ^ A) + X[14] + 0xfde5380c) & 0xffffffff; + B = C + (((sum << 23) & 0xffffffff) | (sum >>> 9)); + sum = (A + (B ^ C ^ D) + X[1] + 0xa4beea44) & 0xffffffff; + A = B + (((sum << 4) & 0xffffffff) | (sum >>> 28)); + sum = (D + (A ^ B ^ C) + X[4] + 0x4bdecfa9) & 0xffffffff; + D = A + (((sum << 11) & 0xffffffff) | (sum >>> 21)); + sum = (C + (D ^ A ^ B) + X[7] + 0xf6bb4b60) & 0xffffffff; + C = D + (((sum << 16) & 0xffffffff) | (sum >>> 16)); + sum = (B + (C ^ D ^ A) + X[10] + 0xbebfbc70) & 0xffffffff; + B = C + (((sum << 23) & 0xffffffff) | (sum >>> 9)); + sum = (A + (B ^ C ^ D) + X[13] + 0x289b7ec6) & 0xffffffff; + A = B + (((sum << 4) & 0xffffffff) | (sum >>> 28)); + sum = (D + (A ^ B ^ C) + X[0] + 0xeaa127fa) & 0xffffffff; + D = A + (((sum << 11) & 0xffffffff) | (sum >>> 21)); + sum = (C + (D ^ A ^ B) + X[3] + 0xd4ef3085) & 0xffffffff; + C = D + (((sum << 16) & 0xffffffff) | (sum >>> 16)); + sum = (B + (C ^ D ^ A) + X[6] + 0x04881d05) & 0xffffffff; + B = C + (((sum << 23) & 0xffffffff) | (sum >>> 9)); + sum = (A + (B ^ C ^ D) + X[9] + 0xd9d4d039) & 0xffffffff; + A = B + (((sum << 4) & 0xffffffff) | (sum >>> 28)); + sum = (D + (A ^ B ^ C) + X[12] + 0xe6db99e5) & 0xffffffff; + D = A + (((sum << 11) & 0xffffffff) | (sum >>> 21)); + sum = (C + (D ^ A ^ B) + X[15] + 0x1fa27cf8) & 0xffffffff; + C = D + (((sum << 16) & 0xffffffff) | (sum >>> 16)); + sum = (B + (C ^ D ^ A) + X[2] + 0xc4ac5665) & 0xffffffff; + B = C + (((sum << 23) & 0xffffffff) | (sum >>> 9)); + sum = (A + (C ^ (B | (~D))) + X[0] + 0xf4292244) & 0xffffffff; + A = B + (((sum << 6) & 0xffffffff) | (sum >>> 26)); + sum = (D + (B ^ (A | (~C))) + X[7] + 0x432aff97) & 0xffffffff; + D = A + (((sum << 10) & 0xffffffff) | (sum >>> 22)); + sum = (C + (A ^ (D | (~B))) + X[14] + 0xab9423a7) & 0xffffffff; + C = D + (((sum << 15) & 0xffffffff) | (sum >>> 17)); + sum = (B + (D ^ (C | (~A))) + X[5] + 0xfc93a039) & 0xffffffff; + B = C + (((sum << 21) & 0xffffffff) | (sum >>> 11)); + sum = (A + (C ^ (B | (~D))) + X[12] + 0x655b59c3) & 0xffffffff; + A = B + (((sum << 6) & 0xffffffff) | (sum >>> 26)); + sum = (D + (B ^ (A | (~C))) + X[3] + 0x8f0ccc92) & 0xffffffff; + D = A + (((sum << 10) & 0xffffffff) | (sum >>> 22)); + sum = (C + (A ^ (D | (~B))) + X[10] + 0xffeff47d) & 0xffffffff; + C = D + (((sum << 15) & 0xffffffff) | (sum >>> 17)); + sum = (B + (D ^ (C | (~A))) + X[1] + 0x85845dd1) & 0xffffffff; + B = C + (((sum << 21) & 0xffffffff) | (sum >>> 11)); + sum = (A + (C ^ (B | (~D))) + X[8] + 0x6fa87e4f) & 0xffffffff; + A = B + (((sum << 6) & 0xffffffff) | (sum >>> 26)); + sum = (D + (B ^ (A | (~C))) + X[15] + 0xfe2ce6e0) & 0xffffffff; + D = A + (((sum << 10) & 0xffffffff) | (sum >>> 22)); + sum = (C + (A ^ (D | (~B))) + X[6] + 0xa3014314) & 0xffffffff; + C = D + (((sum << 15) & 0xffffffff) | (sum >>> 17)); + sum = (B + (D ^ (C | (~A))) + X[13] + 0x4e0811a1) & 0xffffffff; + B = C + (((sum << 21) & 0xffffffff) | (sum >>> 11)); + sum = (A + (C ^ (B | (~D))) + X[4] + 0xf7537e82) & 0xffffffff; + A = B + (((sum << 6) & 0xffffffff) | (sum >>> 26)); + sum = (D + (B ^ (A | (~C))) + X[11] + 0xbd3af235) & 0xffffffff; + D = A + (((sum << 10) & 0xffffffff) | (sum >>> 22)); + sum = (C + (A ^ (D | (~B))) + X[2] + 0x2ad7d2bb) & 0xffffffff; + C = D + (((sum << 15) & 0xffffffff) | (sum >>> 17)); + sum = (B + (D ^ (C | (~A))) + X[9] + 0xeb86d391) & 0xffffffff; + B = C + (((sum << 21) & 0xffffffff) | (sum >>> 11)); + + this.chain_[0] = (this.chain_[0] + A) & 0xffffffff; + this.chain_[1] = (this.chain_[1] + B) & 0xffffffff; + this.chain_[2] = (this.chain_[2] + C) & 0xffffffff; + this.chain_[3] = (this.chain_[3] + D) & 0xffffffff; +}; + + +/** @override */ +goog.crypt.Md5.prototype.update = function(bytes, opt_length) { + if (!goog.isDef(opt_length)) { + opt_length = bytes.length; + } + var lengthMinusBlock = opt_length - this.blockSize; + + // Copy some object properties to local variables in order to save on access + // time from inside the loop (~10% speedup was observed on Chrome 11). + var block = this.block_; + var blockLength = this.blockLength_; + var i = 0; + + // The outer while loop should execute at most twice. + while (i < opt_length) { + // When we have no data in the block to top up, we can directly process the + // input buffer (assuming it contains sufficient data). This gives ~30% + // speedup on Chrome 14 and ~70% speedup on Firefox 6.0, but requires that + // the data is provided in large chunks (or in multiples of 64 bytes). + if (blockLength == 0) { + while (i <= lengthMinusBlock) { + this.compress_(bytes, i); + i += this.blockSize; + } + } + + if (goog.isString(bytes)) { + while (i < opt_length) { + block[blockLength++] = bytes.charCodeAt(i++); + if (blockLength == this.blockSize) { + this.compress_(block); + blockLength = 0; + // Jump to the outer loop so we use the full-block optimization. + break; + } + } + } else { + while (i < opt_length) { + block[blockLength++] = bytes[i++]; + if (blockLength == this.blockSize) { + this.compress_(block); + blockLength = 0; + // Jump to the outer loop so we use the full-block optimization. + break; + } + } + } + } + + this.blockLength_ = blockLength; + this.totalLength_ += opt_length; +}; + + +/** @override */ +goog.crypt.Md5.prototype.digest = function() { + // This must accommodate at least 1 padding byte (0x80), 8 bytes of + // total bitlength, and must end at a 64-byte boundary. + var pad = new Array((this.blockLength_ < 56 ? + this.blockSize : + this.blockSize * 2) - this.blockLength_); + + // Add padding: 0x80 0x00* + pad[0] = 0x80; + for (var i = 1; i < pad.length - 8; ++i) { + pad[i] = 0; + } + // Add the total number of bits, little endian 64-bit integer. + var totalBits = this.totalLength_ * 8; + for (var i = pad.length - 8; i < pad.length; ++i) { + pad[i] = totalBits & 0xff; + totalBits /= 0x100; // Don't use bit-shifting here! + } + this.update(pad); + + var digest = new Array(16); + var n = 0; + for (var i = 0; i < 4; ++i) { + for (var j = 0; j < 32; j += 8) { + digest[n++] = (this.chain_[i] >>> j) & 0xff; + } + } + return digest; +}; diff --git a/lib/boot/shims/lib/closure-library/closure/goog/math/long.js b/lib/boot/shims/lib/closure-library/closure/goog/math/long.js new file mode 100644 index 00000000..1bb4be9b --- /dev/null +++ b/lib/boot/shims/lib/closure-library/closure/goog/math/long.js @@ -0,0 +1,804 @@ +// Copyright 2009 The Closure Library Authors. All Rights Reserved. +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS-IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. + +/** + * @fileoverview Defines a Long class for representing a 64-bit two's-complement + * integer value, which faithfully simulates the behavior of a Java "long". This + * implementation is derived from LongLib in GWT. + * + */ + +goog.provide('goog.math.Long'); + + + +/** + * Constructs a 64-bit two's-complement integer, given its low and high 32-bit + * values as *signed* integers. See the from* functions below for more + * convenient ways of constructing Longs. + * + * The internal representation of a long is the two given signed, 32-bit values. + * We use 32-bit pieces because these are the size of integers on which + * Javascript performs bit-operations. For operations like addition and + * multiplication, we split each number into 16-bit pieces, which can easily be + * multiplied within Javascript's floating-point representation without overflow + * or change in sign. + * + * In the algorithms below, we frequently reduce the negative case to the + * positive case by negating the input(s) and then post-processing the result. + * Note that we must ALWAYS check specially whether those values are MIN_VALUE + * (-2^63) because -MIN_VALUE == MIN_VALUE (since 2^63 cannot be represented as + * a positive number, it overflows back into a negative). Not handling this + * case would often result in infinite recursion. + * + * @param {number} low The low (signed) 32 bits of the long. + * @param {number} high The high (signed) 32 bits of the long. + * @struct + * @constructor + * @final + */ +goog.math.Long = function(low, high) { + /** + * @type {number} + * @private + */ + this.low_ = low | 0; // force into 32 signed bits. + + /** + * @type {number} + * @private + */ + this.high_ = high | 0; // force into 32 signed bits. +}; + + +// NOTE: Common constant values ZERO, ONE, NEG_ONE, etc. are defined below the +// from* methods on which they depend. + + +/** + * A cache of the Long representations of small integer values. + * @type {!Object} + * @private + */ +goog.math.Long.IntCache_ = {}; + + +/** + * Returns a Long representing the given (32-bit) integer value. + * @param {number} value The 32-bit integer in question. + * @return {!goog.math.Long} The corresponding Long value. + */ +goog.math.Long.fromInt = function(value) { + if (-128 <= value && value < 128) { + var cachedObj = goog.math.Long.IntCache_[value]; + if (cachedObj) { + return cachedObj; + } + } + + var obj = new goog.math.Long(value | 0, value < 0 ? -1 : 0); + if (-128 <= value && value < 128) { + goog.math.Long.IntCache_[value] = obj; + } + return obj; +}; + + +/** + * Returns a Long representing the given value, provided that it is a finite + * number. Otherwise, zero is returned. + * @param {number} value The number in question. + * @return {!goog.math.Long} The corresponding Long value. + */ +goog.math.Long.fromNumber = function(value) { + if (isNaN(value) || !isFinite(value)) { + return goog.math.Long.ZERO; + } else if (value <= -goog.math.Long.TWO_PWR_63_DBL_) { + return goog.math.Long.MIN_VALUE; + } else if (value + 1 >= goog.math.Long.TWO_PWR_63_DBL_) { + return goog.math.Long.MAX_VALUE; + } else if (value < 0) { + return goog.math.Long.fromNumber(-value).negate(); + } else { + return new goog.math.Long( + (value % goog.math.Long.TWO_PWR_32_DBL_) | 0, + (value / goog.math.Long.TWO_PWR_32_DBL_) | 0); + } +}; + + +/** + * Returns a Long representing the 64-bit integer that comes by concatenating + * the given high and low bits. Each is assumed to use 32 bits. + * @param {number} lowBits The low 32-bits. + * @param {number} highBits The high 32-bits. + * @return {!goog.math.Long} The corresponding Long value. + */ +goog.math.Long.fromBits = function(lowBits, highBits) { + return new goog.math.Long(lowBits, highBits); +}; + + +/** + * Returns a Long representation of the given string, written using the given + * radix. + * @param {string} str The textual representation of the Long. + * @param {number=} opt_radix The radix in which the text is written. + * @return {!goog.math.Long} The corresponding Long value. + */ +goog.math.Long.fromString = function(str, opt_radix) { + if (str.length == 0) { + throw Error('number format error: empty string'); + } + + var radix = opt_radix || 10; + if (radix < 2 || 36 < radix) { + throw Error('radix out of range: ' + radix); + } + + if (str.charAt(0) == '-') { + return goog.math.Long.fromString(str.substring(1), radix).negate(); + } else if (str.indexOf('-') >= 0) { + throw Error('number format error: interior "-" character: ' + str); + } + + // Do several (8) digits each time through the loop, so as to + // minimize the calls to the very expensive emulated div. + var radixToPower = goog.math.Long.fromNumber(Math.pow(radix, 8)); + + var result = goog.math.Long.ZERO; + for (var i = 0; i < str.length; i += 8) { + var size = Math.min(8, str.length - i); + var value = parseInt(str.substring(i, i + size), radix); + if (size < 8) { + var power = goog.math.Long.fromNumber(Math.pow(radix, size)); + result = result.multiply(power).add(goog.math.Long.fromNumber(value)); + } else { + result = result.multiply(radixToPower); + result = result.add(goog.math.Long.fromNumber(value)); + } + } + return result; +}; + + +// NOTE: the compiler should inline these constant values below and then remove +// these variables, so there should be no runtime penalty for these. + + +/** + * Number used repeated below in calculations. This must appear before the + * first call to any from* function below. + * @type {number} + * @private + */ +goog.math.Long.TWO_PWR_16_DBL_ = 1 << 16; + + +/** + * @type {number} + * @private + */ +goog.math.Long.TWO_PWR_24_DBL_ = 1 << 24; + + +/** + * @type {number} + * @private + */ +goog.math.Long.TWO_PWR_32_DBL_ = + goog.math.Long.TWO_PWR_16_DBL_ * goog.math.Long.TWO_PWR_16_DBL_; + + +/** + * @type {number} + * @private + */ +goog.math.Long.TWO_PWR_31_DBL_ = + goog.math.Long.TWO_PWR_32_DBL_ / 2; + + +/** + * @type {number} + * @private + */ +goog.math.Long.TWO_PWR_48_DBL_ = + goog.math.Long.TWO_PWR_32_DBL_ * goog.math.Long.TWO_PWR_16_DBL_; + + +/** + * @type {number} + * @private + */ +goog.math.Long.TWO_PWR_64_DBL_ = + goog.math.Long.TWO_PWR_32_DBL_ * goog.math.Long.TWO_PWR_32_DBL_; + + +/** + * @type {number} + * @private + */ +goog.math.Long.TWO_PWR_63_DBL_ = + goog.math.Long.TWO_PWR_64_DBL_ / 2; + + +/** @type {!goog.math.Long} */ +goog.math.Long.ZERO = goog.math.Long.fromInt(0); + + +/** @type {!goog.math.Long} */ +goog.math.Long.ONE = goog.math.Long.fromInt(1); + + +/** @type {!goog.math.Long} */ +goog.math.Long.NEG_ONE = goog.math.Long.fromInt(-1); + + +/** @type {!goog.math.Long} */ +goog.math.Long.MAX_VALUE = + goog.math.Long.fromBits(0xFFFFFFFF | 0, 0x7FFFFFFF | 0); + + +/** @type {!goog.math.Long} */ +goog.math.Long.MIN_VALUE = goog.math.Long.fromBits(0, 0x80000000 | 0); + + +/** + * @type {!goog.math.Long} + * @private + */ +goog.math.Long.TWO_PWR_24_ = goog.math.Long.fromInt(1 << 24); + + +/** @return {number} The value, assuming it is a 32-bit integer. */ +goog.math.Long.prototype.toInt = function() { + return this.low_; +}; + + +/** @return {number} The closest floating-point representation to this value. */ +goog.math.Long.prototype.toNumber = function() { + return this.high_ * goog.math.Long.TWO_PWR_32_DBL_ + + this.getLowBitsUnsigned(); +}; + + +/** + * @param {number=} opt_radix The radix in which the text should be written. + * @return {string} The textual representation of this value. + * @override + */ +goog.math.Long.prototype.toString = function(opt_radix) { + var radix = opt_radix || 10; + if (radix < 2 || 36 < radix) { + throw Error('radix out of range: ' + radix); + } + + if (this.isZero()) { + return '0'; + } + + if (this.isNegative()) { + if (this.equals(goog.math.Long.MIN_VALUE)) { + // We need to change the Long value before it can be negated, so we remove + // the bottom-most digit in this base and then recurse to do the rest. + var radixLong = goog.math.Long.fromNumber(radix); + var div = this.div(radixLong); + var rem = div.multiply(radixLong).subtract(this); + return div.toString(radix) + rem.toInt().toString(radix); + } else { + return '-' + this.negate().toString(radix); + } + } + + // Do several (6) digits each time through the loop, so as to + // minimize the calls to the very expensive emulated div. + var radixToPower = goog.math.Long.fromNumber(Math.pow(radix, 6)); + + var rem = this; + var result = ''; + while (true) { + var remDiv = rem.div(radixToPower); + var intval = rem.subtract(remDiv.multiply(radixToPower)).toInt(); + var digits = intval.toString(radix); + + rem = remDiv; + if (rem.isZero()) { + return digits + result; + } else { + while (digits.length < 6) { + digits = '0' + digits; + } + result = '' + digits + result; + } + } +}; + + +/** @return {number} The high 32-bits as a signed value. */ +goog.math.Long.prototype.getHighBits = function() { + return this.high_; +}; + + +/** @return {number} The low 32-bits as a signed value. */ +goog.math.Long.prototype.getLowBits = function() { + return this.low_; +}; + + +/** @return {number} The low 32-bits as an unsigned value. */ +goog.math.Long.prototype.getLowBitsUnsigned = function() { + return (this.low_ >= 0) ? + this.low_ : goog.math.Long.TWO_PWR_32_DBL_ + this.low_; +}; + + +/** + * @return {number} Returns the number of bits needed to represent the absolute + * value of this Long. + */ +goog.math.Long.prototype.getNumBitsAbs = function() { + if (this.isNegative()) { + if (this.equals(goog.math.Long.MIN_VALUE)) { + return 64; + } else { + return this.negate().getNumBitsAbs(); + } + } else { + var val = this.high_ != 0 ? this.high_ : this.low_; + for (var bit = 31; bit > 0; bit--) { + if ((val & (1 << bit)) != 0) { + break; + } + } + return this.high_ != 0 ? bit + 33 : bit + 1; + } +}; + + +/** @return {boolean} Whether this value is zero. */ +goog.math.Long.prototype.isZero = function() { + return this.high_ == 0 && this.low_ == 0; +}; + + +/** @return {boolean} Whether this value is negative. */ +goog.math.Long.prototype.isNegative = function() { + return this.high_ < 0; +}; + + +/** @return {boolean} Whether this value is odd. */ +goog.math.Long.prototype.isOdd = function() { + return (this.low_ & 1) == 1; +}; + + +/** + * @param {goog.math.Long} other Long to compare against. + * @return {boolean} Whether this Long equals the other. + */ +goog.math.Long.prototype.equals = function(other) { + return (this.high_ == other.high_) && (this.low_ == other.low_); +}; + + +/** + * @param {goog.math.Long} other Long to compare against. + * @return {boolean} Whether this Long does not equal the other. + */ +goog.math.Long.prototype.notEquals = function(other) { + return (this.high_ != other.high_) || (this.low_ != other.low_); +}; + + +/** + * @param {goog.math.Long} other Long to compare against. + * @return {boolean} Whether this Long is less than the other. + */ +goog.math.Long.prototype.lessThan = function(other) { + return this.compare(other) < 0; +}; + + +/** + * @param {goog.math.Long} other Long to compare against. + * @return {boolean} Whether this Long is less than or equal to the other. + */ +goog.math.Long.prototype.lessThanOrEqual = function(other) { + return this.compare(other) <= 0; +}; + + +/** + * @param {goog.math.Long} other Long to compare against. + * @return {boolean} Whether this Long is greater than the other. + */ +goog.math.Long.prototype.greaterThan = function(other) { + return this.compare(other) > 0; +}; + + +/** + * @param {goog.math.Long} other Long to compare against. + * @return {boolean} Whether this Long is greater than or equal to the other. + */ +goog.math.Long.prototype.greaterThanOrEqual = function(other) { + return this.compare(other) >= 0; +}; + + +/** + * Compares this Long with the given one. + * @param {goog.math.Long} other Long to compare against. + * @return {number} 0 if they are the same, 1 if the this is greater, and -1 + * if the given one is greater. + */ +goog.math.Long.prototype.compare = function(other) { + if (this.equals(other)) { + return 0; + } + + var thisNeg = this.isNegative(); + var otherNeg = other.isNegative(); + if (thisNeg && !otherNeg) { + return -1; + } + if (!thisNeg && otherNeg) { + return 1; + } + + // at this point, the signs are the same, so subtraction will not overflow + if (this.subtract(other).isNegative()) { + return -1; + } else { + return 1; + } +}; + + +/** @return {!goog.math.Long} The negation of this value. */ +goog.math.Long.prototype.negate = function() { + if (this.equals(goog.math.Long.MIN_VALUE)) { + return goog.math.Long.MIN_VALUE; + } else { + return this.not().add(goog.math.Long.ONE); + } +}; + + +/** + * Returns the sum of this and the given Long. + * @param {goog.math.Long} other Long to add to this one. + * @return {!goog.math.Long} The sum of this and the given Long. + */ +goog.math.Long.prototype.add = function(other) { + // Divide each number into 4 chunks of 16 bits, and then sum the chunks. + + var a48 = this.high_ >>> 16; + var a32 = this.high_ & 0xFFFF; + var a16 = this.low_ >>> 16; + var a00 = this.low_ & 0xFFFF; + + var b48 = other.high_ >>> 16; + var b32 = other.high_ & 0xFFFF; + var b16 = other.low_ >>> 16; + var b00 = other.low_ & 0xFFFF; + + var c48 = 0, c32 = 0, c16 = 0, c00 = 0; + c00 += a00 + b00; + c16 += c00 >>> 16; + c00 &= 0xFFFF; + c16 += a16 + b16; + c32 += c16 >>> 16; + c16 &= 0xFFFF; + c32 += a32 + b32; + c48 += c32 >>> 16; + c32 &= 0xFFFF; + c48 += a48 + b48; + c48 &= 0xFFFF; + return goog.math.Long.fromBits((c16 << 16) | c00, (c48 << 16) | c32); +}; + + +/** + * Returns the difference of this and the given Long. + * @param {goog.math.Long} other Long to subtract from this. + * @return {!goog.math.Long} The difference of this and the given Long. + */ +goog.math.Long.prototype.subtract = function(other) { + return this.add(other.negate()); +}; + + +/** + * Returns the product of this and the given long. + * @param {goog.math.Long} other Long to multiply with this. + * @return {!goog.math.Long} The product of this and the other. + */ +goog.math.Long.prototype.multiply = function(other) { + if (this.isZero()) { + return goog.math.Long.ZERO; + } else if (other.isZero()) { + return goog.math.Long.ZERO; + } + + if (this.equals(goog.math.Long.MIN_VALUE)) { + return other.isOdd() ? goog.math.Long.MIN_VALUE : goog.math.Long.ZERO; + } else if (other.equals(goog.math.Long.MIN_VALUE)) { + return this.isOdd() ? goog.math.Long.MIN_VALUE : goog.math.Long.ZERO; + } + + if (this.isNegative()) { + if (other.isNegative()) { + return this.negate().multiply(other.negate()); + } else { + return this.negate().multiply(other).negate(); + } + } else if (other.isNegative()) { + return this.multiply(other.negate()).negate(); + } + + // If both longs are small, use float multiplication + if (this.lessThan(goog.math.Long.TWO_PWR_24_) && + other.lessThan(goog.math.Long.TWO_PWR_24_)) { + return goog.math.Long.fromNumber(this.toNumber() * other.toNumber()); + } + + // Divide each long into 4 chunks of 16 bits, and then add up 4x4 products. + // We can skip products that would overflow. + + var a48 = this.high_ >>> 16; + var a32 = this.high_ & 0xFFFF; + var a16 = this.low_ >>> 16; + var a00 = this.low_ & 0xFFFF; + + var b48 = other.high_ >>> 16; + var b32 = other.high_ & 0xFFFF; + var b16 = other.low_ >>> 16; + var b00 = other.low_ & 0xFFFF; + + var c48 = 0, c32 = 0, c16 = 0, c00 = 0; + c00 += a00 * b00; + c16 += c00 >>> 16; + c00 &= 0xFFFF; + c16 += a16 * b00; + c32 += c16 >>> 16; + c16 &= 0xFFFF; + c16 += a00 * b16; + c32 += c16 >>> 16; + c16 &= 0xFFFF; + c32 += a32 * b00; + c48 += c32 >>> 16; + c32 &= 0xFFFF; + c32 += a16 * b16; + c48 += c32 >>> 16; + c32 &= 0xFFFF; + c32 += a00 * b32; + c48 += c32 >>> 16; + c32 &= 0xFFFF; + c48 += a48 * b00 + a32 * b16 + a16 * b32 + a00 * b48; + c48 &= 0xFFFF; + return goog.math.Long.fromBits((c16 << 16) | c00, (c48 << 16) | c32); +}; + + +/** + * Returns this Long divided by the given one. + * @param {goog.math.Long} other Long by which to divide. + * @return {!goog.math.Long} This Long divided by the given one. + */ +goog.math.Long.prototype.div = function(other) { + if (other.isZero()) { + throw Error('division by zero'); + } else if (this.isZero()) { + return goog.math.Long.ZERO; + } + + if (this.equals(goog.math.Long.MIN_VALUE)) { + if (other.equals(goog.math.Long.ONE) || + other.equals(goog.math.Long.NEG_ONE)) { + return goog.math.Long.MIN_VALUE; // recall that -MIN_VALUE == MIN_VALUE + } else if (other.equals(goog.math.Long.MIN_VALUE)) { + return goog.math.Long.ONE; + } else { + // At this point, we have |other| >= 2, so |this/other| < |MIN_VALUE|. + var halfThis = this.shiftRight(1); + var approx = halfThis.div(other).shiftLeft(1); + if (approx.equals(goog.math.Long.ZERO)) { + return other.isNegative() ? goog.math.Long.ONE : goog.math.Long.NEG_ONE; + } else { + var rem = this.subtract(other.multiply(approx)); + var result = approx.add(rem.div(other)); + return result; + } + } + } else if (other.equals(goog.math.Long.MIN_VALUE)) { + return goog.math.Long.ZERO; + } + + if (this.isNegative()) { + if (other.isNegative()) { + return this.negate().div(other.negate()); + } else { + return this.negate().div(other).negate(); + } + } else if (other.isNegative()) { + return this.div(other.negate()).negate(); + } + + // Repeat the following until the remainder is less than other: find a + // floating-point that approximates remainder / other *from below*, add this + // into the result, and subtract it from the remainder. It is critical that + // the approximate value is less than or equal to the real value so that the + // remainder never becomes negative. + var res = goog.math.Long.ZERO; + var rem = this; + while (rem.greaterThanOrEqual(other)) { + // Approximate the result of division. This may be a little greater or + // smaller than the actual value. + var approx = Math.max(1, Math.floor(rem.toNumber() / other.toNumber())); + + // We will tweak the approximate result by changing it in the 48-th digit or + // the smallest non-fractional digit, whichever is larger. + var log2 = Math.ceil(Math.log(approx) / Math.LN2); + var delta = (log2 <= 48) ? 1 : Math.pow(2, log2 - 48); + + // Decrease the approximation until it is smaller than the remainder. Note + // that if it is too large, the product overflows and is negative. + var approxRes = goog.math.Long.fromNumber(approx); + var approxRem = approxRes.multiply(other); + while (approxRem.isNegative() || approxRem.greaterThan(rem)) { + approx -= delta; + approxRes = goog.math.Long.fromNumber(approx); + approxRem = approxRes.multiply(other); + } + + // We know the answer can't be zero... and actually, zero would cause + // infinite recursion since we would make no progress. + if (approxRes.isZero()) { + approxRes = goog.math.Long.ONE; + } + + res = res.add(approxRes); + rem = rem.subtract(approxRem); + } + return res; +}; + + +/** + * Returns this Long modulo the given one. + * @param {goog.math.Long} other Long by which to mod. + * @return {!goog.math.Long} This Long modulo the given one. + */ +goog.math.Long.prototype.modulo = function(other) { + return this.subtract(this.div(other).multiply(other)); +}; + + +/** @return {!goog.math.Long} The bitwise-NOT of this value. */ +goog.math.Long.prototype.not = function() { + return goog.math.Long.fromBits(~this.low_, ~this.high_); +}; + + +/** + * Returns the bitwise-AND of this Long and the given one. + * @param {goog.math.Long} other The Long with which to AND. + * @return {!goog.math.Long} The bitwise-AND of this and the other. + */ +goog.math.Long.prototype.and = function(other) { + return goog.math.Long.fromBits(this.low_ & other.low_, + this.high_ & other.high_); +}; + + +/** + * Returns the bitwise-OR of this Long and the given one. + * @param {goog.math.Long} other The Long with which to OR. + * @return {!goog.math.Long} The bitwise-OR of this and the other. + */ +goog.math.Long.prototype.or = function(other) { + return goog.math.Long.fromBits(this.low_ | other.low_, + this.high_ | other.high_); +}; + + +/** + * Returns the bitwise-XOR of this Long and the given one. + * @param {goog.math.Long} other The Long with which to XOR. + * @return {!goog.math.Long} The bitwise-XOR of this and the other. + */ +goog.math.Long.prototype.xor = function(other) { + return goog.math.Long.fromBits(this.low_ ^ other.low_, + this.high_ ^ other.high_); +}; + + +/** + * Returns this Long with bits shifted to the left by the given amount. + * @param {number} numBits The number of bits by which to shift. + * @return {!goog.math.Long} This shifted to the left by the given amount. + */ +goog.math.Long.prototype.shiftLeft = function(numBits) { + numBits &= 63; + if (numBits == 0) { + return this; + } else { + var low = this.low_; + if (numBits < 32) { + var high = this.high_; + return goog.math.Long.fromBits( + low << numBits, + (high << numBits) | (low >>> (32 - numBits))); + } else { + return goog.math.Long.fromBits(0, low << (numBits - 32)); + } + } +}; + + +/** + * Returns this Long with bits shifted to the right by the given amount. + * @param {number} numBits The number of bits by which to shift. + * @return {!goog.math.Long} This shifted to the right by the given amount. + */ +goog.math.Long.prototype.shiftRight = function(numBits) { + numBits &= 63; + if (numBits == 0) { + return this; + } else { + var high = this.high_; + if (numBits < 32) { + var low = this.low_; + return goog.math.Long.fromBits( + (low >>> numBits) | (high << (32 - numBits)), + high >> numBits); + } else { + return goog.math.Long.fromBits( + high >> (numBits - 32), + high >= 0 ? 0 : -1); + } + } +}; + + +/** + * Returns this Long with bits shifted to the right by the given amount, with + * zeros placed into the new leading bits. + * @param {number} numBits The number of bits by which to shift. + * @return {!goog.math.Long} This shifted to the right by the given amount, with + * zeros placed into the new leading bits. + */ +goog.math.Long.prototype.shiftRightUnsigned = function(numBits) { + numBits &= 63; + if (numBits == 0) { + return this; + } else { + var high = this.high_; + if (numBits < 32) { + var low = this.low_; + return goog.math.Long.fromBits( + (low >>> numBits) | (high << (32 - numBits)), + high >>> numBits); + } else if (numBits == 32) { + return goog.math.Long.fromBits(high, 0); + } else { + return goog.math.Long.fromBits(high >>> (numBits - 32), 0); + } + } +}; diff --git a/lib/boot/shims/lib/harmony-collections/README.md b/lib/boot/shims/lib/harmony-collections/README.md new file mode 100644 index 00000000..054fc7ea --- /dev/null +++ b/lib/boot/shims/lib/harmony-collections/README.md @@ -0,0 +1,164 @@ +# Harmony Collections Shim + +Use the new __Map__, __Set__, and __WeakMap__ from the upcoming ES6 standard right now! This shim provides full functionality for these collections and delivers the benefits of using them. + +## Compatability + +Works with IE9+, Chrome, Firefox, Safari, untested in Opera. __IE8 support has been recently added but is experimental.__ + +## Install/Use + +If using node, install via: + + npm install harmony-collections + +In the browser, include __harmony-collection.js__ or __harmony-collections.min.js__ and Map, WeakMap, Set, and HashMap will be exposed on the window. (you can also define `window.exports` which will cause them to end up there). + +## Overview + +ES6 Collections provide a new core weapon to your JS arsenal: objects as keys. This allows you to do the following awesome things: store private data "on" public objects, private properties, secretly "tag" objects, namespace properties, access controlled properties, check object uniqueness in `O(1)` time complexity. + +### WeakMap Garbage Collection Semantics + +The benefit of using WeakMaps is enhanced garbage collection. In a WeakMap, the only reference created is key -> value, so it's possible for a key/value in a WeakMap to be garbage collected while the WeakMap they're in still exists! Compare this to an Array, where all items in the Array will not be garbage collected as long as the Array isn't. This forces either explicit management of object lifespans or, more commonly, simply results in memory leaks. + +For example, data stored using jQuery.data can never be garbage collected unless explicitly nulled out, because it is stored in a container that strongly references the items held inside. Using a WeakMap, it's possible to associate data with an element and have the data destroyed when the element is -- without memory leaking the element; i.e. `weakmap.set(element, { myData: 'gc safe!' })`. jQuery.data (every library has similar functionality) prevents the *element* from memory leaking by using a numeric id, but this does nothing for the __data__ that is stored. + +## Detailed Examples + +### Map/WeakMap +```javascript +// reusable storage creator +function createStorage(){ + var store = new WeakMap; + return function(o){ + var v = store.get(o); + if (!v) store.set(o, v = {}); + return v; + }; +} + +// allows private/namespaced properties for the objects +var _ = createStorage(); + +functioon Wrapper(element){ + var _element = _(element); + if (_element.wrapper) + return _element.wrapper; + + _element.wrapper = this; + _(this).element = element; +} + +Wrapper.prototype = { + get classes(){ + return [].slice.call(_(this).element.classList); + }, + set classes(v){ + _(this).element.className = [].concat(v).join(' '); + } +}; +``` + +### Set +A Set is similar to an Array in what it stores, but different in how. A Set's values are unique. Determining whether an item is in a Set is `O(1)` but `O(n)` for an Array. An example of where this is useful is in implementing `Array.prototype.unique` that works with objects. + +Both of the following will output the same result, however the Set version is `O(n)` and the one using indexOf is `O(n^2)`. For an array taking 30 seconds using the set, an __*hour*__ is required for indexOf. + +```javascript +function uniqueUsingIndexOf(array){ + return array.filter(function(item, index){ + return array.lastIndexOf(item) > index; + }); +} + +function uniqueUsingSet(array){ + var seen = new Set; + return array.filter(function(item){ + if (!seen.has(item)) { + seen.add(item); + return true; + } + }); +} +``` + + +## API Reference + +* Collections may be inherited from. Initialize objects via `[WeakMap|Map|Set].call(obj)`. +* Iteration is insertion ordered. + + +### WeakMap + +__Non-primitives__ are valid keys. Objects, functions, DOM nodes, etc. + +WeakMaps require the use of objects as keys; primitives are not valid keys. WeakMaps have no way to enumerate their keys or values. Because of this, the only way to retrieve a value from a WeakMap is to have access to both the WeakMap itself as well as an object used as a key. + +* `new WeakMap(iterable)` Create a new WeakMap populated with the iterable. Accepts *[[Key, Value]...]*, *Array*, *Iterable*. +* `WeakMap#set(key, value)` Key must be non-primitive. Returns undefined. +* `WeakMap#get(key)` Returns the value that key corresponds to the key or undefined. +* `WeakMap#has(key)` Returns boolean. +* `WeakMap#delete(key)` Removes the value from the collection and returns boolean indicating if there was a value to delete. + + +### HashMap + +__Primitives__ are valid keys. Exact value is used; e.g. `'0'/-0/0` are all different keys. + +HashMap is not standard, but is used to implement Map and is exported as a bonus. Has the same API as Map except it only allows primitive keys. + +* `new HashMap(iterable)` Create a new HashMap populated with the iterable. Accepts *[[Key, Value]...]*, *Iterable*. +* `HashMap#set(key, value)` Key must be primitive. Returns undefined. +* `HashMap#get(key)` Returns the value the key corresponds to or undefined. +* `HashMap#has(key)` Returns boolean. +* `HashMap#delete(key)` Removes the value from the collection and returns boolean indicating if there was a value to delete. +* `HashMap#size()` Returns the number of items in the collection. +* `HashMap#forEach(callback, context)` Loop through the collection raising callback for each. + + +### Map + +__All possible values__ are valid keys, including -0, undefined, null, and NaN. + +Maps do not have the same garbage collection benefits that WeakMaps do, but instead are iterable and also accept primitive keys. This means any value can be a Map key. + +* `new Map(iterable)` Create a new Map populated with the iterable. Accepts *[[Key, Value]...]*, *Array*, *Iterable*. +* `Map#set(key, value)` Key is any value including objects. Returns undefined. +* `Map#get(key)` Returns the value the key maps to or undefined. +* `Map#has(key)` Returns boolean. +* `Map#delete(key)` Removes the key and value from the collection if found. Returns true. +* `Map#size()` Returns the number of items in the collection. +* `Map#forEach(callback, context)` Loop through the collection raising callback for each. + + +### Set + +Sets are similar to arrays but enforce uniqueness of values. Adding the same value twice will only result in one being added to the set. + +* `new Set(iterable)` Create a new Set populated with the iterable. Accepts *Array*, *Iterable*. +* `Set#add(value)` Inserts a value of any type into the set if it's not already in the set. +* `Set#has(value)` Returns boolean. +* `Set#delete(value)` Removes the value from the collection and returns boolean indicating if there was a value to delete. +* `Set#size()` Returns the number of items in the collection. +* `Set#forEach(callback, context)` Loop through the collection raising callback for each. + + + +## License + +(The MIT License) +Copyright (c) 2012 Brandon Benvie + +Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files +(the 'Software'), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, +publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, +subject to the following conditions: + +The above copyright notice and this permission notice shall be included with all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE +FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH +THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/lib/boot/shims/lib/harmony-collections/harmony-collections.js b/lib/boot/shims/lib/harmony-collections/harmony-collections.js new file mode 100644 index 00000000..cac06e20 --- /dev/null +++ b/lib/boot/shims/lib/harmony-collections/harmony-collections.js @@ -0,0 +1,795 @@ +/* (The MIT License) + * + * Copyright (c) 2012 Brandon Benvie + * + * Permission is hereby granted, free of charge, to any person obtaining a copy of this software and + * associated documentation files (the 'Software'), to deal in the Software without restriction, + * including without limitation the rights to use, copy, modify, merge, publish, distribute, + * sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is + * furnished to do so, subject to the following conditions: + * + * The above copyright notice and this permission notice shall be included with all copies or + * substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING + * BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, + * DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + */ + +// Original WeakMap implementation by Gozala @ https://gist.github.com/1269991 +// Updated and bugfixed by Raynos @ https://gist.github.com/1638059 +// Expanded by Benvie @ https://github.com/Benvie/harmony-collections + +void function(string_, object_, function_, prototype_, toString_, + Array, Object, Function, FP, global, exports, undefined_, undefined){ + + var getProperties = Object.getOwnPropertyNames, + es5 = typeof getProperties === function_ && !(prototype_ in getProperties); + + var callbind = FP.bind + ? FP.bind.bind(FP.call) + : (function(call){ + return function(func){ + return function(){ + return call.apply(func, arguments); + }; + }; + }(FP.call)); + + var functionToString = callbind(FP[toString_]), + objectToString = callbind({}[toString_]), + numberToString = callbind(.0.toString), + call = callbind(FP.call), + apply = callbind(FP.apply), + hasOwn = callbind({}.hasOwnProperty), + push = callbind([].push), + splice = callbind([].splice); + + var name = function(func){ + if (typeof func !== function_) + return ''; + else if ('name' in func) + return func.name; + + return functionToString(func).match(/^\n?function\s?(\w*)?_?\(/)[1]; + }; + + var create = es5 + ? Object.create + : function(proto, descs){ + var Ctor = function(){}; + Ctor[prototype_] = Object(proto); + var object = new Ctor; + + if (descs) + for (var key in descs) + defineProperty(object, key, descs[k]); + + return object; + }; + + + function Hash(){} + + if (es5) { + void function(ObjectCreate){ + Hash.prototype = ObjectCreate(null); + function inherit(obj){ + return ObjectCreate(obj); + } + Hash.inherit = inherit; + }(Object.create); + } else { + void function(F){ + var iframe = document.createElement('iframe'); + iframe.style.display = 'none'; + document.body.appendChild(iframe); + iframe.src = 'javascript:' + Hash.prototype = iframe.contentWindow.Object.prototype; + document.body.removeChild(iframe); + iframe = null; + + var props = ['constructor', 'hasOwnProperty', 'propertyIsEnumerable', + 'isProtoypeOf', 'toLocaleString', 'toString', 'valueOf']; + + for (var i=0; i < props.length; i++) + delete Hash.prototype[props[i]]; + + function inherit(obj){ + F.prototype = obj; + obj = new F; + F.prototype = null; + return obj; + } + + Hash.inherit = inherit; + }(function(){}); + } + + var defineProperty = es5 + ? Object.defineProperty + : function(object, key, desc) { + object[key] = desc.value; + return object; + }; + + var define = function(object, key, value){ + if (typeof key === function_) { + value = key; + key = name(value).replace(/_$/, ''); + } + + return defineProperty(object, key, { configurable: true, writable: true, value: value }); + }; + + var isArray = es5 + ? (function(isArray){ + return function(o){ + return isArray(o) || o instanceof Array; + }; + })(Array.isArray) + : function(o){ + return o instanceof Array || objectToString(o) === '[object Array]'; + }; + + // ############ + // ### Data ### + // ############ + + var builtinWeakMap = 'WeakMap' in global; + + var MapData = builtinWeakMap + ? (function(){ + var BuiltinWeakMap = global.WeakMap, + wmget = callbind(BuiltinWeakMap[prototype_].get), + wmset = callbind(BuiltinWeakMap[prototype_].set), + wmhas = callbind(BuiltinWeakMap[prototype_].has); + + function MapData(name){ + var map = new BuiltinWeakMap; + + this.get = function(o){ + return wmget(map, o); + }; + this.set = function(o, v){ + wmset(map, o, v); + }; + + if (name) { + this.wrap = function(o, v){ + if (wmhas(map, o)) + throw new TypeError("Object is already a " + name); + wmset(map, o, v); + }; + this.unwrap = function(o){ + var storage = wmget(map, o); + if (!storage) + throw new TypeError(name + " is not generic"); + return storage; + }; + } + } + + return MapData; + })() + : (function(){ + var locker = 'return function(k){if(k===s)return l}', + random = Math.random, + uids = new Hash, + slice = callbind(''.slice), + indexOf = callbind([].indexOf); + + var createUID = function(){ + var key = slice(numberToString(random(), 36), 2); + return key in uids ? createUID() : uids[key] = key; + }; + + var globalID = createUID(); + + // common per-object storage area made visible by patching getOwnPropertyNames' + function getOwnPropertyNames(obj){ + var props = getProperties(obj); + if (hasOwn(obj, globalID)) + splice(props, indexOf(props, globalID), 1); + return props; + } + + if (es5) { + // check for the random key on an object, create new storage if missing, return it + var storage = function(obj){ + if (!hasOwn(obj, globalID)) + defineProperty(obj, globalID, { value: new Hash }); + return obj[globalID]; + }; + + define(Object, getOwnPropertyNames); + } else { + + var toStringToString = function(s){ + function toString(){ return s } + return toString[toString_] = toString; + }(Object[prototype_][toString_]+''); + + // store the values on a custom valueOf in order to hide them but store them locally + var storage = function(obj){ + if (hasOwn(obj, toString_) && globalID in obj[toString_]) + return obj[toString_][globalID]; + + if (!(toString_ in obj)) + throw new Error("Can't store values for "+obj); + + var oldToString = obj[toString_]; + function toString(){ return oldToString.call(this) } + obj[toString_] = toString; + toString[toString_] = toStringToString; + return toString[globalID] = {}; + }; + } + + + + // shim for [[MapData]] from es6 spec, and pulls double duty as WeakMap storage + function MapData(name){ + var puid = createUID(), + iuid = createUID(), + secret = { value: undefined }; + + var attach = function(obj){ + var store = storage(obj); + if (hasOwn(store, puid)) + return store[puid](secret); + + var lockbox = new Hash; + defineProperty(lockbox, iuid, secret); + defineProperty(store, puid, { + value: new Function('s', 'l', locker)(secret, lockbox) + }); + return lockbox; + }; + + this.get = function(o){ + return attach(o)[iuid]; + }; + this.set = function(o, v){ + attach(o)[iuid] = v; + }; + + if (name) { + this.wrap = function(o, v){ + var lockbox = attach(o); + if (lockbox[iuid]) + throw new TypeError("Object is already a " + name); + lockbox[iuid] = v; + }; + this.unwrap = function(o){ + var storage = attach(o)[iuid]; + if (!storage) + throw new TypeError(name + " is not generic"); + return storage; + }; + } + } + + return MapData; + }()); + + var exporter = (function(){ + // [native code] looks slightly different in each engine + var src = (''+Object).split('Object'); + + // fake [native code] + function toString(){ + return src[0] + name(this) + src[1]; + } + + define(toString, toString); + + // attempt to use __proto__ so the methods don't all have an own toString + var prepFunction = { __proto__: [] } instanceof Array + ? function(func){ func.__proto__ = toString } + : function(func){ define(func, toString) }; + + // assemble an array of functions into a fully formed class + var prepare = function(methods){ + var Ctor = methods.shift(), + brand = '[object ' + name(Ctor) + ']'; + + function toString(){ return brand } + methods.push(toString); + prepFunction(Ctor); + + for (var i=0; i < methods.length; i++) { + prepFunction(methods[i]); + define(Ctor[prototype_], methods[i]); + } + + return Ctor; + }; + + return function(name, init){ + if (name in exports) + return exports[name]; + + var data = new MapData(name); + + return exports[name] = prepare(init( + function(collection, value){ + data.wrap(collection, value); + }, + function(collection){ + return data.unwrap(collection); + } + )); + }; + }()); + + + // initialize collection with an iterable, currently only supports forEach function + var initialize = function(iterable, callback){ + if (iterable !== null && typeof iterable === object_ && typeof iterable.forEach === function_) { + iterable.forEach(function(item, i){ + if (isArray(item) && item.length === 2) + callback(iterable[i][0], iterable[i][1]); + else + callback(iterable[i], i); + }); + } + } + + // attempt to fix the name of "delete_" methods, should work in V8 and spidermonkey + var fixDelete = function(func, scopeNames, scopeValues){ + try { + scopeNames[scopeNames.length] = ('return '+func).replace('e_', '\\u0065'); + return Function.apply(0, scopeNames).apply(0, scopeValues); + } catch (e) { + return func; + } + } + + var WM, HM, M; + + // ############### + // ### WeakMap ### + // ############### + + WM = builtinWeakMap ? (exports.WeakMap = global.WeakMap) : exporter('WeakMap', function(wrap, unwrap){ + var prototype = WeakMap[prototype_]; + var validate = function(key){ + if (key == null || typeof key !== object_ && typeof key !== function_) + throw new TypeError("Invalid WeakMap key"); + }; + + /** + * @class WeakMap + * @description Collection using objects with unique identities as keys that disallows enumeration + * and allows for better garbage collection. + * @param {Iterable} [iterable] An item to populate the collection with. + */ + function WeakMap(iterable){ + if (this === global || this == null || this === prototype) + return new WeakMap(iterable); + + wrap(this, new MapData); + + var self = this; + iterable && initialize(iterable, function(value, key){ + call(set, self, value, key); + }); + } + /** + * @method + * @description Retrieve the value in the collection that matches key + * @param {Any} key + * @return {Any} + */ + function get(key){ + validate(key); + var value = unwrap(this).get(key); + return value === undefined_ ? undefined : value; + } + /** + * @method + * @description Add or update a pair in the collection. Enforces uniqueness by overwriting. + * @param {Any} key + * @param {Any} val + **/ + function set(key, value){ + validate(key); + // store a token for explicit undefined so that "has" works correctly + unwrap(this).set(key, value === undefined ? undefined_ : value); + } + /* + * @method + * @description Check if key is in the collection + * @param {Any} key + * @return {Boolean} + **/ + function has(key){ + validate(key); + return unwrap(this).get(key) !== undefined; + } + /** + * @method + * @description Remove key and matching value if found + * @param {Any} key + * @return {Boolean} true if item was in collection + */ + function delete_(key){ + validate(key); + var data = unwrap(this); + + if (data.get(key) === undefined) + return false; + + data.set(key, undefined); + return true; + } + + delete_ = fixDelete(delete_, ['validate', 'unwrap'], [validate, unwrap]); + return [WeakMap, get, set, has, delete_]; + }); + + + // ############### + // ### HashMap ### + // ############### + + HM = exporter('HashMap', function(wrap, unwrap){ + // separate numbers, strings, and atoms to compensate for key coercion to string + + var prototype = HashMap[prototype_], + STRING = 0, NUMBER = 1, OTHER = 2, + others = { 'true': true, 'false': false, 'null': null, 0: -0 }; + + var proto = Math.random().toString(36).slice(2); + + var coerce = function(key){ + return key === '__proto__' ? proto : key; + }; + + var uncoerce = function(type, key){ + switch (type) { + case STRING: return key === proto ? '__proto__' : key; + case NUMBER: return +key; + case OTHER: return others[key]; + } + } + + + var validate = function(key){ + if (key == null) return OTHER; + switch (typeof key) { + case 'boolean': return OTHER; + case string_: return STRING; + // negative zero has to be explicitly accounted for + case 'number': return key === 0 && Infinity / key === -Infinity ? OTHER : NUMBER; + default: throw new TypeError("Invalid HashMap key"); + } + } + + /** + * @class HashMap + * @description Collection that only allows primitives to be keys. + * @param {Iterable} [iterable] An item to populate the collection with. + */ + function HashMap(iterable){ + if (this === global || this == null || this === prototype) + return new HashMap(iterable); + + wrap(this, { + size: 0, + 0: new Hash, + 1: new Hash, + 2: new Hash + }); + + var self = this; + iterable && initialize(iterable, function(value, key){ + call(set, self, value, key); + }); + } + /** + * @method + * @description Retrieve the value in the collection that matches key + * @param {Any} key + * @return {Any} + */ + function get(key){ + return unwrap(this)[validate(key)][coerce(key)]; + } + /** + * @method + * @description Add or update a pair in the collection. Enforces uniqueness by overwriting. + * @param {Any} key + * @param {Any} val + **/ + function set(key, value){ + var items = unwrap(this), + data = items[validate(key)]; + + key = coerce(key); + key in data || items.size++; + data[key] = value; + } + /** + * @method + * @description Check if key exists in the collection. + * @param {Any} key + * @return {Boolean} is in collection + **/ + function has(key){ + return coerce(key) in unwrap(this)[validate(key)]; + } + /** + * @method + * @description Remove key and matching value if found + * @param {Any} key + * @return {Boolean} true if item was in collection + */ + function delete_(key){ + var items = unwrap(this), + data = items[validate(key)]; + + key = coerce(key); + if (key in data) { + delete data[key]; + items.size--; + return true; + } + + return false; + } + /** + * @method + * @description Retrieve the amount of items in the collection + * @return {Number} + */ + function size(){ + return unwrap(this).size; + } + /** + * @method + * @description Loop through the collection raising callback for each + * @param {Function} callback `callback(value, key)` + * @param {Object} context The `this` binding for callbacks, default null + */ + function forEach(callback, context){ + var data = unwrap(this); + context = context == null ? global : context; + for (var i=0; i < 3; i++) + for (var key in data[i]) + call(callback, context, data[i][key], uncoerce(i, key), this); + } + + delete_ = fixDelete(delete_, ['validate', 'unwrap', 'coerce'], [validate, unwrap, coerce]); + return [HashMap, get, set, has, delete_, size, forEach]; + }); + + + // ########### + // ### Map ### + // ########### + + // if a fully implemented Map exists then use it + if ('Map' in global && 'forEach' in global.Map.prototype) { + M = exports.Map = global.Map; + } else { + M = exporter('Map', function(wrap, unwrap){ + // attempt to use an existing partially implemented Map + var BuiltinMap = global.Map, + prototype = Map[prototype_], + wm = WM[prototype_], + hm = (BuiltinMap || HM)[prototype_], + mget = [callbind(hm.get), callbind(wm.get)], + mset = [callbind(hm.set), callbind(wm.set)], + mhas = [callbind(hm.has), callbind(wm.has)], + mdelete = [callbind(hm['delete']), callbind(wm['delete'])]; + + var type = BuiltinMap + ? function(){ return 0 } + : function(o){ return +(typeof o === object_ ? o !== null : typeof o === function_) } + + // if we have a builtin Map we can let it do most of the heavy lifting + var init = BuiltinMap + ? function(){ return { 0: new BuiltinMap } } + : function(){ return { 0: new HM, 1: new WM } }; + + /** + * @class Map + * @description Collection that allows any kind of value to be a key. + * @param {Iterable} [iterable] An item to populate the collection with. + */ + function Map(iterable){ + if (this === global || this == null || this === prototype) + return new Map(iterable); + + var data = init(); + data.keys = []; + data.values = []; + wrap(this, data); + + var self = this; + iterable && initialize(iterable, function(value, key){ + call(set, self, value, key); + }); + } + /** + * @method + * @description Retrieve the value in the collection that matches key + * @param {Any} key + * @return {Any} + */ + function get(key){ + var data = unwrap(this), + t = type(key); + return data.values[mget[t](data[t], key)]; + } + /** + * @method + * @description Add or update a pair in the collection. Enforces uniqueness by overwriting. + * @param {Any} key + * @param {Any} val + **/ + function set(key, value){ + var data = unwrap(this), + t = type(key), + index = mget[t](data[t], key); + + if (index === undefined) { + mset[t](data[t], key, data.keys.length); + push(data.keys, key); + push(data.values, value); + } else { + data.keys[index] = key; + data.values[index] = value; + } + } + /** + * @method + * @description Check if key exists in the collection. + * @param {Any} key + * @return {Boolean} is in collection + **/ + function has(key){ + var t = type(key); + return mhas[t](unwrap(this)[t], key); + } + /** + * @method + * @description Remove key and matching value if found + * @param {Any} key + * @return {Boolean} true if item was in collection + */ + function delete_(key){ + var data = unwrap(this), + t = type(key), + index = mget[t](data[t], key); + + if (index === undefined) + return false; + + mdelete[t](data[t], key); + splice(data.keys, index, 1); + splice(data.values, index, 1); + return true; + } + /** + * @method + * @description Retrieve the amount of items in the collection + * @return {Number} + */ + function size(){ + return unwrap(this).keys.length; + } + /** + * @method + * @description Loop through the collection raising callback for each + * @param {Function} callback `callback(value, key)` + * @param {Object} context The `this` binding for callbacks, default null + */ + function forEach(callback, context){ + var data = unwrap(this), + keys = data.keys, + values = data.values; + + context = context == null ? global : context; + + for (var i=0, len=keys.length; i < len; i++) + call(callback, context, values[i], keys[i], this); + } + + delete_ = fixDelete(delete_, + ['type', 'unwrap', 'call', 'splice'], + [type, unwrap, call, splice] + ); + return [Map, get, set, has, delete_, size, forEach]; + }); + } + + + // ########### + // ### Set ### + // ########### + + exporter('Set', function(wrap, unwrap){ + var prototype = Set[prototype_], + m = M[prototype_], + msize = callbind(m.size), + mforEach = callbind(m.forEach), + mget = callbind(m.get), + mset = callbind(m.set), + mhas = callbind(m.has), + mdelete = callbind(m['delete']); + + /** + * @class Set + * @description Collection of values that enforces uniqueness. + * @param {Iterable} [iterable] An item to populate the collection with. + **/ + function Set(iterable){ + if (this === global || this == null || this === prototype) + return new Set(iterable); + + wrap(this, new M); + + var self = this; + iterable && initialize(iterable, function(value, key){ + call(add, self, key); + }); + } + /** + * @method + * @description Insert value if not found, enforcing uniqueness. + * @param {Any} val + */ + function add(key){ + mset(unwrap(this), key, key); + } + /** + * @method + * @description Check if key exists in the collection. + * @param {Any} key + * @return {Boolean} is in collection + **/ + function has(key){ + return mhas(unwrap(this), key); + } + /** + * @method + * @description Remove key and matching value if found + * @param {Any} key + * @return {Boolean} true if item was in collection + */ + function delete_(key){ + return mdelete(unwrap(this), key); + } + /** + * @method + * @description Retrieve the amount of items in the collection + * @return {Number} + */ + function size(){ + return msize(unwrap(this)); + } + /** + * @method + * @description Loop through the collection raising callback for each. Index is simply the counter for the current iteration. + * @param {Function} callback `callback(value, index)` + * @param {Object} context The `this` binding for callbacks, default null + */ + function forEach(callback, context){ + var index = 0, + self = this; + mforEach(unwrap(this, function(key){ + call(callback, this, key, index++, self); + }, context)); + } + + delete_ = fixDelete(delete_, ['mdelete', 'unwrap'], [mdelete, unwrap]); + return [Set, add, has, delete_, size, forEach]; + }); +}('string', 'object', 'function', 'prototype', 'toString', + Array, Object, Function, Function.prototype, (0, eval)('this'), + typeof exports === 'undefined' ? this : exports, {}); diff --git a/utils/patch/LICENSE b/lib/boot/shims/lib/setImmediate/LICENSE.txt similarity index 92% rename from utils/patch/LICENSE rename to lib/boot/shims/lib/setImmediate/LICENSE.txt index 5cd27868..32b20de6 100644 --- a/utils/patch/LICENSE +++ b/lib/boot/shims/lib/setImmediate/LICENSE.txt @@ -1,4 +1,4 @@ -Copyright (c) 2014 Hamish Mackenzie +Copyright (c) 2012 Barnesandnoble.com, llc, Donavon West, and Domenic Denicola Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the @@ -18,4 +18,3 @@ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - diff --git a/lib/boot/shims/lib/setImmediate/README.md b/lib/boot/shims/lib/setImmediate/README.md new file mode 100644 index 00000000..0dc67684 --- /dev/null +++ b/lib/boot/shims/lib/setImmediate/README.md @@ -0,0 +1,92 @@ +# setImmediate.js +**A YuzuJS production** + +## Introduction + +**setImmediate.js** is a highly cross-browser implementation of the `setImmediate` and `clearImmediate` APIs, [proposed][spec] by Microsoft to the Web Performance Working Group. `setImmediate` allows scripts to yield to the browser, executing a given operation asynchronously, in a manner that is typically more efficient and consumes less power than the usual `setTimeout(..., 0)` pattern. + +setImmediate.js runs at “full speed” in the following browsers and environments, using various clever tricks: + + * Internet Explorer 6+ + * Firefox 3+ + * WebKit + * Opera 9.5+ + * Node.js + * Web workers in browsers that support `MessageChannel`, which I can't find solid info on. + +In all other browsers we fall back to using `setTimeout`, so it's always safe to use. + +## Macrotasks and Microtasks + +The `setImmediate` API, as specified, gives you access to the environment's [task queue][], sometimes known as its "macrotask" queue. This is crucially different from the [microtask queue][] used by web features such as `MutationObserver`, language features such as promises and `Object.observe`, and Node.js features such as `process.nextTick`. Each go-around of the macrotask queue yields back to the event loop once all queued tasks have been processed, even if the macrotask itself queued more macrotasks. Whereas, the microtask queue will continue executing any queued microtasks until it is exhausted. + +In practice, what this means is that if you call `setImmediate` inside of another task queued with `setImmediate`, you will yield back to the event loop and any I/O or rendering tasks that need to take place between those calls, instead of executing the queued task as soon as possible. + +If you are looking specifically to yield as part of a render loop, consider using [`requestAnimationFrame`][raf]; if you are looking solely for the control-flow ordering effects, use a microtask solution such as [asap][]. + +## The Tricks + +### `process.nextTick` + +In Node.js versions below 0.9, `setImmediate` is not available, but [`process.nextTick`][nextTick] is—and in those versions, `process.nextTick` uses macrotask semantics. So, we use it to shim support for a global `setImmediate`. + +In Node.js 0.9 and above, `process.nextTick` moved to microtask semantics, but `setImmediate` was introduced with macrotask semantics, so there's no need to polyfill anything. + +Note that we check for *actual* Node.js environments, not emulated ones like those produced by browserify or similar. Such emulated environments often already include a `process.nextTick` shim that's not as browser-compatible as setImmediate.js. + +### `postMessage` + +In Firefox 3+, Internet Explorer 9+, all modern WebKit browsers, and Opera 9.5+, [`postMessage`][postMessage] is available and provides a good way to queue tasks on the event loop. It's quite the abuse, using a cross-document messaging protocol within the same document simply to get access to the event loop task queue, but until there are native implementations, this is the best option. + +Note that Internet Explorer 8 includes a synchronous version of `postMessage`. We detect this, or any other such synchronous implementation, and fall back to another trick. + +### `MessageChannel` + +Unfortunately, `postMessage` has completely different semantics inside web workers, and so cannot be used there. So we turn to [`MessageChannel`][MessageChannel], which has worse browser support, but does work inside a web worker. + +### ` + + + + + + diff --git a/lib/boot/shims/lib/setImmediate/test/browserOnly/selfClose.htm b/lib/boot/shims/lib/setImmediate/test/browserOnly/selfClose.htm new file mode 100644 index 00000000..a90e2594 --- /dev/null +++ b/lib/boot/shims/lib/setImmediate/test/browserOnly/selfClose.htm @@ -0,0 +1,14 @@ + + + + Modal Dialog for Testing + + +

This'll be gone in one second; we're just testing the interaction of setImmediate and window.showModalDialog.

+ + + diff --git a/lib/boot/shims/lib/setImmediate/test/browserOnly/tests.js b/lib/boot/shims/lib/setImmediate/test/browserOnly/tests.js new file mode 100644 index 00000000..0567fb0a --- /dev/null +++ b/lib/boot/shims/lib/setImmediate/test/browserOnly/tests.js @@ -0,0 +1,45 @@ +"use strict"; +/*global setImmediate: false, specify: false, window: false */ + +function assert(condition) { + if (!condition) { + throw new Error("Assertion failed"); + } +} +assert.strictEqual = function (x, y) { + if (x !== y) { + throw new Error(x + " !== " + y); + } +}; + +specify("Modal dialogs block handlers", function (done) { + // Try to launch the less-annoying self-closing-window modal dialog; if that's not an option, fall back to alert. + var showTheDialog = window.showModalDialog ? + function () { + window.showModalDialog("selfClose.htm"); + } + : function () { + window.alert("Please press OK to continue the test; we needed a modal dialog."); + }; + + var dialogClosed = false; + setImmediate(function () { + showTheDialog(); + dialogClosed = true; + }); + + setImmediate(function () { + assert(dialogClosed); + done(); + }); +}); + +if (typeof window.Worker === "function") { + specify("When inside a web worker context, setImmediate calls the passed handler", function (done) { + var worker = new window.Worker("worker.js"); + worker.addEventListener("message", function (event) { + assert.strictEqual(event.data, "TEST"); + done(); + }, false); + }); +} diff --git a/lib/boot/shims/lib/setImmediate/test/browserOnly/worker.js b/lib/boot/shims/lib/setImmediate/test/browserOnly/worker.js new file mode 100644 index 00000000..68574a59 --- /dev/null +++ b/lib/boot/shims/lib/setImmediate/test/browserOnly/worker.js @@ -0,0 +1,5 @@ +importScripts("../../setImmediate.js"); + +setImmediate(function () { + self.postMessage("TEST"); +}); diff --git a/lib/boot/shims/lib/setImmediate/test/mocha.opts b/lib/boot/shims/lib/setImmediate/test/mocha.opts new file mode 100644 index 00000000..6fb66f73 --- /dev/null +++ b/lib/boot/shims/lib/setImmediate/test/mocha.opts @@ -0,0 +1 @@ +--slow Infinity diff --git a/lib/boot/shims/lib/setImmediate/test/tests.js b/lib/boot/shims/lib/setImmediate/test/tests.js new file mode 100644 index 00000000..24f01482 --- /dev/null +++ b/lib/boot/shims/lib/setImmediate/test/tests.js @@ -0,0 +1,106 @@ +"use strict"; +/*global setImmediate: false, clearImmediate: false, specify: false, window: false */ + +// The Node version of setImmediate does not support string handlers. +var global = Function("return this")(); +var originalGlobalSetImmediate = global.setImmediate; +if (originalGlobalSetImmediate) { + global.setImmediate = function(handler) { + var args = arguments; + if (typeof handler !== "function") { + handler = args[0] = eval.bind(null, "" + handler); + } + return originalGlobalSetImmediate.apply(this, args); + }; +} + +var assert = require("assert"); +require("../setImmediate"); + +specify("Handlers do execute", function (done) { + setImmediate(function () { + done(); + }); +}); + +specify("Handlers do not execute in the same event loop turn as the call to `setImmediate`", function (done) { + var handlerCalled = false; + function handler() { + handlerCalled = true; + done(); + } + + setImmediate(handler); + assert(!handlerCalled); +}); + +specify("Handlers can be strings", function(done) { + var property = "handler$" + Math.random().toString(36).slice(2); + done.called = false; + setImmediate[property] = function () { + delete setImmediate[property]; + + done(); + }; + + setImmediate("setImmediate." + property + ".called = true; setImmediate." + property + "()"); + assert.strictEqual(done.called, false); +}); + +specify("`setImmediate` passes through an argument to the handler", function (done) { + var expectedArg = { expected: true }; + + function handler(actualArg) { + assert.strictEqual(actualArg, expectedArg); + done(); + } + + setImmediate(handler, expectedArg); +}); + +specify("`setImmediate` passes through two arguments to the handler", function (done) { + var expectedArg1 = { arg1: true }; + var expectedArg2 = { arg2: true }; + + function handler(actualArg1, actualArg2) { + assert.strictEqual(actualArg1, expectedArg1); + assert.strictEqual(actualArg2, expectedArg2); + done(); + } + + setImmediate(handler, expectedArg1, expectedArg2); +}); + +specify("`clearImmediate` within the same event loop turn prevents the handler from executing", function (done) { + var handlerCalled = false; + function handler() { + handlerCalled = true; + } + + var handle = setImmediate(handler); + clearImmediate(handle); + + setTimeout(function () { + assert(!handlerCalled); + done(); + }, 100); +}); + +specify("`clearImmediate` does not interfere with handlers other than the one with ID passed to it", function (done) { + var expectedArgs = ["A", "D"]; + var recordedArgs = []; + function handler(arg) { + recordedArgs.push(arg); + } + + setImmediate(handler, "A"); + clearImmediate(setImmediate(handler, "B")); + var handle = setImmediate(handler, "C"); + setImmediate(handler, "D"); + clearImmediate(handle); + + setTimeout(function () { + assert.deepEqual(recordedArgs, expectedArgs); + done(); + }, 100); +}); diff --git a/lib/boot/shims/lib/typedarray/README b/lib/boot/shims/lib/typedarray/README new file mode 100644 index 00000000..3b8715d5 --- /dev/null +++ b/lib/boot/shims/lib/typedarray/README @@ -0,0 +1,3 @@ +typed arrays polyfill +from http://www.calormen.com/polyfill/ + diff --git a/lib/boot/shims/lib/typedarray/typedarray.js b/lib/boot/shims/lib/typedarray/typedarray.js new file mode 100644 index 00000000..1523c096 --- /dev/null +++ b/lib/boot/shims/lib/typedarray/typedarray.js @@ -0,0 +1,1039 @@ +/* + Copyright (c) 2010, Linden Research, Inc. + Copyright (c) 2014, Joshua Bell + + Permission is hereby granted, free of charge, to any person obtaining a copy + of this software and associated documentation files (the "Software"), to deal + in the Software without restriction, including without limitation the rights + to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + copies of the Software, and to permit persons to whom the Software is + furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + THE SOFTWARE. + $/LicenseInfo$ + */ + +// Original can be found at: +// https://bitbucket.org/lindenlab/llsd +// Modifications by Joshua Bell inexorabletash@gmail.com +// https://github.com/inexorabletash/polyfill + +// ES3/ES5 implementation of the Krhonos Typed Array Specification +// Ref: http://www.khronos.org/registry/typedarray/specs/latest/ +// Date: 2011-02-01 +// +// Variations: +// * Allows typed_array.get/set() as alias for subscripts (typed_array[]) +// * Gradually migrating structure from Khronos spec to ES6 spec +(function(global) { + 'use strict'; + var undefined = (void 0); // Paranoia + + // Beyond this value, index getters/setters (i.e. array[0], array[1]) are so slow to + // create, and consume so much memory, that the browser appears frozen. + var MAX_ARRAY_LENGTH = 1e5; + + // Approximations of internal ECMAScript conversion functions + function Type(v) { + switch(typeof v) { + case 'undefined': return 'undefined'; + case 'boolean': return 'boolean'; + case 'number': return 'number'; + case 'string': return 'string'; + default: return v === null ? 'null' : 'object'; + } + } + + // Class returns internal [[Class]] property, used to avoid cross-frame instanceof issues: + function Class(v) { return Object.prototype.toString.call(v).replace(/^\[object *|\]$/g, ''); } + function IsCallable(o) { return typeof o === 'function'; } + function ToObject(v) { + if (v === null || v === undefined) throw TypeError(); + return Object(v); + } + function ToInt32(v) { return v >> 0; } + function ToUint32(v) { return v >>> 0; } + + // Snapshot intrinsics + var LN2 = Math.LN2, + abs = Math.abs, + floor = Math.floor, + log = Math.log, + max = Math.max, + min = Math.min, + pow = Math.pow, + round = Math.round; + + // emulate ES5 getter/setter API using legacy APIs + // http://blogs.msdn.com/b/ie/archive/2010/09/07/transitioning-existing-code-to-the-es5-getter-setter-apis.aspx + // (second clause tests for Object.defineProperty() in IE<9 that only supports extending DOM prototypes, but + // note that IE<9 does not support __defineGetter__ or __defineSetter__ so it just renders the method harmless) + + (function() { + var orig = Object.defineProperty; + var dom_only = !(function(){try{return Object.defineProperty({},'x',{});}catch(_){return false;}}()); + + if (!orig || dom_only) { + Object.defineProperty = function (o, prop, desc) { + // In IE8 try built-in implementation for defining properties on DOM prototypes. + if (orig) + try { return orig(o, prop, desc); } catch (_) {} + if (o !== Object(o)) + throw TypeError('Object.defineProperty called on non-object'); + if (Object.prototype.__defineGetter__ && ('get' in desc)) + Object.prototype.__defineGetter__.call(o, prop, desc.get); + if (Object.prototype.__defineSetter__ && ('set' in desc)) + Object.prototype.__defineSetter__.call(o, prop, desc.set); + if ('value' in desc) + o[prop] = desc.value; + return o; + }; + } + }()); + + // ES5: Make obj[index] an alias for obj._getter(index)/obj._setter(index, value) + // for index in 0 ... obj.length + function makeArrayAccessors(obj) { + if (obj.length > MAX_ARRAY_LENGTH) throw RangeError('Array too large for polyfill'); + + function makeArrayAccessor(index) { + Object.defineProperty(obj, index, { + 'get': function() { return obj._getter(index); }, + 'set': function(v) { obj._setter(index, v); }, + enumerable: true, + configurable: false + }); + } + + var i; + for (i = 0; i < obj.length; i += 1) { + makeArrayAccessor(i); + } + } + + // Internal conversion functions: + // pack() - take a number (interpreted as Type), output a byte array + // unpack() - take a byte array, output a Type-like number + + function as_signed(value, bits) { var s = 32 - bits; return (value << s) >> s; } + function as_unsigned(value, bits) { var s = 32 - bits; return (value << s) >>> s; } + + function packI8(n) { return [n & 0xff]; } + function unpackI8(bytes) { return as_signed(bytes[0], 8); } + + function packU8(n) { return [n & 0xff]; } + function unpackU8(bytes) { return as_unsigned(bytes[0], 8); } + + function packU8Clamped(n) { n = round(Number(n)); return [n < 0 ? 0 : n > 0xff ? 0xff : n & 0xff]; } + + function packI16(n) { return [n & 0xff, (n >> 8) & 0xff]; } + function unpackI16(bytes) { return as_signed(bytes[1] << 8 | bytes[0], 16); } + + function packU16(n) { return [n & 0xff, (n >> 8) & 0xff]; } + function unpackU16(bytes) { return as_unsigned(bytes[1] << 8 | bytes[0], 16); } + + function packI32(n) { return [n & 0xff, (n >> 8) & 0xff, (n >> 16) & 0xff, (n >> 24) & 0xff]; } + function unpackI32(bytes) { return as_signed(bytes[3] << 24 | bytes[2] << 16 | bytes[1] << 8 | bytes[0], 32); } + + function packU32(n) { return [n & 0xff, (n >> 8) & 0xff, (n >> 16) & 0xff, (n >> 24) & 0xff]; } + function unpackU32(bytes) { return as_unsigned(bytes[3] << 24 | bytes[2] << 16 | bytes[1] << 8 | bytes[0], 32); } + + function packIEEE754(v, ebits, fbits) { + + var bias = (1 << (ebits - 1)) - 1, + s, e, f, ln, + i, bits, str, bytes; + + function roundToEven(n) { + var w = floor(n), f = n - w; + if (f < 0.5) + return w; + if (f > 0.5) + return w + 1; + return w % 2 ? w + 1 : w; + } + + // Compute sign, exponent, fraction + if (v !== v) { + // NaN + // http://dev.w3.org/2006/webapi/WebIDL/#es-type-mapping + e = (1 << ebits) - 1; f = pow(2, fbits - 1); s = 0; + } else if (v === Infinity || v === -Infinity) { + e = (1 << ebits) - 1; f = 0; s = (v < 0) ? 1 : 0; + } else if (v === 0) { + e = 0; f = 0; s = (1 / v === -Infinity) ? 1 : 0; + } else { + s = v < 0; + v = abs(v); + + if (v >= pow(2, 1 - bias)) { + e = min(floor(log(v) / LN2), 1023); + var significand = v / pow(2, e); + if (significand < 1) { + e -= 1; + significand *= 2; + } + if (significand >= 2) { + e += 1; + significand /= 2; + } + f = roundToEven(significand * pow(2, fbits)); + if (f / pow(2, fbits) >= 2) { + e = e + 1; + f = 1; + } + if (e > bias) { + // Overflow + e = (1 << ebits) - 1; + f = 0; + } else { + // Normalized + e = e + bias; + f = f - pow(2, fbits); + } + } else { + // Denormalized + e = 0; + f = roundToEven(v / pow(2, 1 - bias - fbits)); + } + } + + // Pack sign, exponent, fraction + bits = []; + for (i = fbits; i; i -= 1) { bits.push(f % 2 ? 1 : 0); f = floor(f / 2); } + for (i = ebits; i; i -= 1) { bits.push(e % 2 ? 1 : 0); e = floor(e / 2); } + bits.push(s ? 1 : 0); + bits.reverse(); + str = bits.join(''); + + // Bits to bytes + bytes = []; + while (str.length) { + bytes.unshift(parseInt(str.substring(0, 8), 2)); + str = str.substring(8); + } + return bytes; + } + + function unpackIEEE754(bytes, ebits, fbits) { + // Bytes to bits + var bits = [], i, j, b, str, + bias, s, e, f; + + for (i = 0; i < bytes.length; ++i) { + b = bytes[i]; + for (j = 8; j; j -= 1) { + bits.push(b % 2 ? 1 : 0); b = b >> 1; + } + } + bits.reverse(); + str = bits.join(''); + + // Unpack sign, exponent, fraction + bias = (1 << (ebits - 1)) - 1; + s = parseInt(str.substring(0, 1), 2) ? -1 : 1; + e = parseInt(str.substring(1, 1 + ebits), 2); + f = parseInt(str.substring(1 + ebits), 2); + + // Produce number + if (e === (1 << ebits) - 1) { + return f !== 0 ? NaN : s * Infinity; + } else if (e > 0) { + // Normalized + return s * pow(2, e - bias) * (1 + f / pow(2, fbits)); + } else if (f !== 0) { + // Denormalized + return s * pow(2, -(bias - 1)) * (f / pow(2, fbits)); + } else { + return s < 0 ? -0 : 0; + } + } + + function unpackF64(b) { return unpackIEEE754(b, 11, 52); } + function packF64(v) { return packIEEE754(v, 11, 52); } + function unpackF32(b) { return unpackIEEE754(b, 8, 23); } + function packF32(v) { return packIEEE754(v, 8, 23); } + + // + // 3 The ArrayBuffer Type + // + + (function() { + + function ArrayBuffer(length) { + length = ToInt32(length); + if (length < 0) throw RangeError('ArrayBuffer size is not a small enough positive integer.'); + Object.defineProperty(this, 'byteLength', {value: length}); + Object.defineProperty(this, '_bytes', {value: Array(length)}); + + for (var i = 0; i < length; i += 1) + this._bytes[i] = 0; + } + + global.ArrayBuffer = global.ArrayBuffer || ArrayBuffer; + + // + // 5 The Typed Array View Types + // + + function $TypedArray$() { + + // %TypedArray% ( length ) + if (!arguments.length || typeof arguments[0] !== 'object') { + return (function(length) { + length = ToInt32(length); + if (length < 0) throw RangeError('length is not a small enough positive integer.'); + Object.defineProperty(this, 'length', {value: length}); + Object.defineProperty(this, 'byteLength', {value: length * this.BYTES_PER_ELEMENT}); + Object.defineProperty(this, 'buffer', {value: new ArrayBuffer(this.byteLength)}); + Object.defineProperty(this, 'byteOffset', {value: 0}); + + }).apply(this, arguments); + } + + // %TypedArray% ( typedArray ) + if (arguments.length >= 1 && + Type(arguments[0]) === 'object' && + arguments[0] instanceof $TypedArray$) { + return (function(typedArray){ + if (this.constructor !== typedArray.constructor) throw TypeError(); + + var byteLength = typedArray.length * this.BYTES_PER_ELEMENT; + Object.defineProperty(this, 'buffer', {value: new ArrayBuffer(byteLength)}); + Object.defineProperty(this, 'byteLength', {value: byteLength}); + Object.defineProperty(this, 'byteOffset', {value: 0}); + Object.defineProperty(this, 'length', {value: typedArray.length}); + + for (var i = 0; i < this.length; i += 1) + this._setter(i, typedArray._getter(i)); + + }).apply(this, arguments); + } + + // %TypedArray% ( array ) + if (arguments.length >= 1 && + Type(arguments[0]) === 'object' && + !(arguments[0] instanceof $TypedArray$) && + !(arguments[0] instanceof ArrayBuffer || Class(arguments[0]) === 'ArrayBuffer')) { + return (function(array) { + + var byteLength = array.length * this.BYTES_PER_ELEMENT; + Object.defineProperty(this, 'buffer', {value: new ArrayBuffer(byteLength)}); + Object.defineProperty(this, 'byteLength', {value: byteLength}); + Object.defineProperty(this, 'byteOffset', {value: 0}); + Object.defineProperty(this, 'length', {value: array.length}); + + for (var i = 0; i < this.length; i += 1) { + var s = array[i]; + this._setter(i, Number(s)); + } + }).apply(this, arguments); + } + + // %TypedArray% ( buffer, byteOffset=0, length=undefined ) + if (arguments.length >= 1 && + Type(arguments[0]) === 'object' && + (arguments[0] instanceof ArrayBuffer || Class(arguments[0]) === 'ArrayBuffer')) { + return (function(buffer, byteOffset, length) { + + byteOffset = ToUint32(byteOffset); + if (byteOffset > buffer.byteLength) + throw RangeError('byteOffset out of range'); + + // The given byteOffset must be a multiple of the element + // size of the specific type, otherwise an exception is raised. + if (byteOffset % this.BYTES_PER_ELEMENT) + throw RangeError('buffer length minus the byteOffset is not a multiple of the element size.'); + + if (length === undefined) { + var byteLength = buffer.byteLength - byteOffset; + if (byteLength % this.BYTES_PER_ELEMENT) + throw RangeError('length of buffer minus byteOffset not a multiple of the element size'); + length = byteLength / this.BYTES_PER_ELEMENT; + + } else { + length = ToUint32(length); + byteLength = length * this.BYTES_PER_ELEMENT; + } + + if ((byteOffset + byteLength) > buffer.byteLength) + throw RangeError('byteOffset and length reference an area beyond the end of the buffer'); + + Object.defineProperty(this, 'buffer', {value: buffer}); + Object.defineProperty(this, 'byteLength', {value: byteLength}); + Object.defineProperty(this, 'byteOffset', {value: byteOffset}); + Object.defineProperty(this, 'length', {value: length}); + + }).apply(this, arguments); + } + + // %TypedArray% ( all other argument combinations ) + throw TypeError(); + } + + // Properties of the %TypedArray Instrinsic Object + + // %TypedArray%.from ( source , mapfn=undefined, thisArg=undefined ) + Object.defineProperty($TypedArray$, 'from', {value: function(iterable) { + return new this(iterable); + }}); + + // %TypedArray%.of ( ...items ) + Object.defineProperty($TypedArray$, 'of', {value: function(/*...items*/) { + return new this(arguments); + }}); + + // %TypedArray%.prototype + var $TypedArrayPrototype$ = {}; + $TypedArray$.prototype = $TypedArrayPrototype$; + + // WebIDL: getter type (unsigned long index); + Object.defineProperty($TypedArray$.prototype, '_getter', {value: function(index) { + if (arguments.length < 1) throw SyntaxError('Not enough arguments'); + + index = ToUint32(index); + if (index >= this.length) + return undefined; + + var bytes = [], i, o; + for (i = 0, o = this.byteOffset + index * this.BYTES_PER_ELEMENT; + i < this.BYTES_PER_ELEMENT; + i += 1, o += 1) { + bytes.push(this.buffer._bytes[o]); + } + return this._unpack(bytes); + }}); + + // NONSTANDARD: convenience alias for getter: type get(unsigned long index); + Object.defineProperty($TypedArray$.prototype, 'get', {value: $TypedArray$.prototype._getter}); + + // WebIDL: setter void (unsigned long index, type value); + Object.defineProperty($TypedArray$.prototype, '_setter', {value: function(index, value) { + if (arguments.length < 2) throw SyntaxError('Not enough arguments'); + + index = ToUint32(index); + if (index >= this.length) + return; + + var bytes = this._pack(value), i, o; + for (i = 0, o = this.byteOffset + index * this.BYTES_PER_ELEMENT; + i < this.BYTES_PER_ELEMENT; + i += 1, o += 1) { + this.buffer._bytes[o] = bytes[i]; + } + }}); + + // get %TypedArray%.prototype.buffer + // get %TypedArray%.prototype.byteLength + // get %TypedArray%.prototype.byteOffset + // -- applied directly to the object in the constructor + + // %TypedArray%.prototype.constructor + Object.defineProperty($TypedArray$.prototype, 'constructor', {value: $TypedArray$}); + + // %TypedArray%.prototype.copyWithin (target, start, end = this.length ) + Object.defineProperty($TypedArray$.prototype, 'copyWithin', {value: function(target, start) { + var end = arguments[2]; + + var o = ToObject(this); + var lenVal = o.length; + var len = ToUint32(lenVal); + len = max(len, 0); + var relativeTarget = ToInt32(target); + var to; + if (relativeTarget < 0) + to = max(len + relativeTarget, 0); + else + to = min(relativeTarget, len); + var relativeStart = ToInt32(start); + var from; + if (relativeStart < 0) + from = max(len + relativeStart, 0); + else + from = min(relativeStart, len); + var relativeEnd; + if (end === undefined) + relativeEnd = len; + else + relativeEnd = ToInt32(end); + var final0; + if (relativeEnd < 0) + final0 = max(len + relativeEnd, 0); + else + final0 = min(relativeEnd, len); + var count = min(final0 - from, len - to); + var direction; + if (from < to && to < from + count) { + direction = -1; + from = from + count - 1; + to = to + count - 1; + } else { + direction = 1; + } + while (count > 0) { + o._setter(to, o._getter(from)); + from = from + direction; + to = to + direction; + count = count - 1; + } + return o; + }}); + + // %TypedArray%.prototype.entries ( ) + // -- defined in es6.js to shim browsers w/ native TypedArrays + + // %TypedArray%.prototype.every ( callbackfn, thisArg = undefined ) + Object.defineProperty($TypedArray$.prototype, 'every', {value: function(callbackfn) { + if (this === undefined || this === null) throw TypeError(); + var t = Object(this); + var len = ToUint32(t.length); + if (!IsCallable(callbackfn)) throw TypeError(); + var thisArg = arguments[1]; + for (var i = 0; i < len; i++) { + if (!callbackfn.call(thisArg, t._getter(i), i, t)) + return false; + } + return true; + }}); + + // %TypedArray%.prototype.fill (value, start = 0, end = this.length ) + Object.defineProperty($TypedArray$.prototype, 'fill', {value: function(value) { + var start = arguments[1], + end = arguments[2]; + + var o = ToObject(this); + var lenVal = o.length; + var len = ToUint32(lenVal); + len = max(len, 0); + var relativeStart = ToInt32(start); + var k; + if (relativeStart < 0) + k = max((len + relativeStart), 0); + else + k = min(relativeStart, len); + var relativeEnd; + if (end === undefined) + relativeEnd = len; + else + relativeEnd = ToInt32(end); + var final0; + if (relativeEnd < 0) + final0 = max((len + relativeEnd), 0); + else + final0 = min(relativeEnd, len); + while (k < final0) { + o._setter(k, value); + k += 1; + } + return o; + }}); + + // %TypedArray%.prototype.filter ( callbackfn, thisArg = undefined ) + Object.defineProperty($TypedArray$.prototype, 'filter', {value: function(callbackfn) { + if (this === undefined || this === null) throw TypeError(); + var t = Object(this); + var len = ToUint32(t.length); + if (!IsCallable(callbackfn)) throw TypeError(); + var res = []; + var thisp = arguments[1]; + for (var i = 0; i < len; i++) { + var val = t._getter(i); // in case fun mutates this + if (callbackfn.call(thisp, val, i, t)) + res.push(val); + } + return new this.constructor(res); + }}); + + // %TypedArray%.prototype.find (predicate, thisArg = undefined) + Object.defineProperty($TypedArray$.prototype, 'find', {value: function(predicate) { + var o = ToObject(this); + var lenValue = o.length; + var len = ToUint32(lenValue); + if (!IsCallable(predicate)) throw TypeError(); + var t = arguments.length > 1 ? arguments[1] : undefined; + var k = 0; + while (k < len) { + var kValue = o._getter(k); + var testResult = predicate.call(t, kValue, k, o); + if (Boolean(testResult)) + return kValue; + ++k; + } + return undefined; + }}); + + // %TypedArray%.prototype.findIndex ( predicate, thisArg = undefined ) + Object.defineProperty($TypedArray$.prototype, 'findIndex', {value: function(predicate) { + var o = ToObject(this); + var lenValue = o.length; + var len = ToUint32(lenValue); + if (!IsCallable(predicate)) throw TypeError(); + var t = arguments.length > 1 ? arguments[1] : undefined; + var k = 0; + while (k < len) { + var kValue = o._getter(k); + var testResult = predicate.call(t, kValue, k, o); + if (Boolean(testResult)) + return k; + ++k; + } + return -1; + }}); + + // %TypedArray%.prototype.forEach ( callbackfn, thisArg = undefined ) + Object.defineProperty($TypedArray$.prototype, 'forEach', {value: function(callbackfn) { + if (this === undefined || this === null) throw TypeError(); + var t = Object(this); + var len = ToUint32(t.length); + if (!IsCallable(callbackfn)) throw TypeError(); + var thisp = arguments[1]; + for (var i = 0; i < len; i++) + callbackfn.call(thisp, t._getter(i), i, t); + }}); + + // %TypedArray%.prototype.indexOf (searchElement, fromIndex = 0 ) + Object.defineProperty($TypedArray$.prototype, 'indexOf', {value: function(searchElement) { + if (this === undefined || this === null) throw TypeError(); + var t = Object(this); + var len = ToUint32(t.length); + if (len === 0) return -1; + var n = 0; + if (arguments.length > 0) { + n = Number(arguments[1]); + if (n !== n) { + n = 0; + } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) { + n = (n > 0 || -1) * floor(abs(n)); + } + } + if (n >= len) return -1; + var k = n >= 0 ? n : max(len - abs(n), 0); + for (; k < len; k++) { + if (t._getter(k) === searchElement) { + return k; + } + } + return -1; + }}); + + // %TypedArray%.prototype.join ( separator ) + Object.defineProperty($TypedArray$.prototype, 'join', {value: function(separator) { + if (this === undefined || this === null) throw TypeError(); + var t = Object(this); + var len = ToUint32(t.length); + var tmp = Array(len); + for (var i = 0; i < len; ++i) + tmp[i] = t._getter(i); + return tmp.join(separator === undefined ? ',' : separator); // Hack for IE7 + }}); + + // %TypedArray%.prototype.keys ( ) + // -- defined in es6.js to shim browsers w/ native TypedArrays + + // %TypedArray%.prototype.lastIndexOf ( searchElement, fromIndex = this.length-1 ) + Object.defineProperty($TypedArray$.prototype, 'lastIndexOf', {value: function(searchElement) { + if (this === undefined || this === null) throw TypeError(); + var t = Object(this); + var len = ToUint32(t.length); + if (len === 0) return -1; + var n = len; + if (arguments.length > 1) { + n = Number(arguments[1]); + if (n !== n) { + n = 0; + } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) { + n = (n > 0 || -1) * floor(abs(n)); + } + } + var k = n >= 0 ? min(n, len - 1) : len - abs(n); + for (; k >= 0; k--) { + if (t._getter(k) === searchElement) + return k; + } + return -1; + }}); + + // get %TypedArray%.prototype.length + // -- applied directly to the object in the constructor + + // %TypedArray%.prototype.map ( callbackfn, thisArg = undefined ) + Object.defineProperty($TypedArray$.prototype, 'map', {value: function(callbackfn) { + if (this === undefined || this === null) throw TypeError(); + var t = Object(this); + var len = ToUint32(t.length); + if (!IsCallable(callbackfn)) throw TypeError(); + var res = []; res.length = len; + var thisp = arguments[1]; + for (var i = 0; i < len; i++) + res[i] = callbackfn.call(thisp, t._getter(i), i, t); + return new this.constructor(res); + }}); + + // %TypedArray%.prototype.reduce ( callbackfn [, initialValue] ) + Object.defineProperty($TypedArray$.prototype, 'reduce', {value: function(callbackfn) { + if (this === undefined || this === null) throw TypeError(); + var t = Object(this); + var len = ToUint32(t.length); + if (!IsCallable(callbackfn)) throw TypeError(); + // no value to return if no initial value and an empty array + if (len === 0 && arguments.length === 1) throw TypeError(); + var k = 0; + var accumulator; + if (arguments.length >= 2) { + accumulator = arguments[1]; + } else { + accumulator = t._getter(k++); + } + while (k < len) { + accumulator = callbackfn.call(undefined, accumulator, t._getter(k), k, t); + k++; + } + return accumulator; + }}); + + // %TypedArray%.prototype.reduceRight ( callbackfn [, initialValue] ) + Object.defineProperty($TypedArray$.prototype, 'reduceRight', {value: function(callbackfn) { + if (this === undefined || this === null) throw TypeError(); + var t = Object(this); + var len = ToUint32(t.length); + if (!IsCallable(callbackfn)) throw TypeError(); + // no value to return if no initial value, empty array + if (len === 0 && arguments.length === 1) throw TypeError(); + var k = len - 1; + var accumulator; + if (arguments.length >= 2) { + accumulator = arguments[1]; + } else { + accumulator = t._getter(k--); + } + while (k >= 0) { + accumulator = callbackfn.call(undefined, accumulator, t._getter(k), k, t); + k--; + } + return accumulator; + }}); + + // %TypedArray%.prototype.reverse ( ) + Object.defineProperty($TypedArray$.prototype, 'reverse', {value: function() { + if (this === undefined || this === null) throw TypeError(); + var t = Object(this); + var len = ToUint32(t.length); + var half = floor(len / 2); + for (var i = 0, j = len - 1; i < half; ++i, --j) { + var tmp = t._getter(i); + t._setter(i, t._getter(j)); + t._setter(j, tmp); + } + return t; + }}); + + // %TypedArray%.prototype.set(array, offset = 0 ) + // %TypedArray%.prototype.set(typedArray, offset = 0 ) + // WebIDL: void set(TypedArray array, optional unsigned long offset); + // WebIDL: void set(sequence array, optional unsigned long offset); + Object.defineProperty($TypedArray$.prototype, 'set', {value: function(index, value) { + if (arguments.length < 1) throw SyntaxError('Not enough arguments'); + var array, sequence, offset, len, + i, s, d, + byteOffset, byteLength, tmp; + + if (typeof arguments[0] === 'object' && arguments[0].constructor === this.constructor) { + // void set(TypedArray array, optional unsigned long offset); + array = arguments[0]; + offset = ToUint32(arguments[1]); + + if (offset + array.length > this.length) { + throw RangeError('Offset plus length of array is out of range'); + } + + byteOffset = this.byteOffset + offset * this.BYTES_PER_ELEMENT; + byteLength = array.length * this.BYTES_PER_ELEMENT; + + if (array.buffer === this.buffer) { + tmp = []; + for (i = 0, s = array.byteOffset; i < byteLength; i += 1, s += 1) { + tmp[i] = array.buffer._bytes[s]; + } + for (i = 0, d = byteOffset; i < byteLength; i += 1, d += 1) { + this.buffer._bytes[d] = tmp[i]; + } + } else { + for (i = 0, s = array.byteOffset, d = byteOffset; + i < byteLength; i += 1, s += 1, d += 1) { + this.buffer._bytes[d] = array.buffer._bytes[s]; + } + } + } else if (typeof arguments[0] === 'object' && typeof arguments[0].length !== 'undefined') { + // void set(sequence array, optional unsigned long offset); + sequence = arguments[0]; + len = ToUint32(sequence.length); + offset = ToUint32(arguments[1]); + + if (offset + len > this.length) { + throw RangeError('Offset plus length of array is out of range'); + } + + for (i = 0; i < len; i += 1) { + s = sequence[i]; + this._setter(offset + i, Number(s)); + } + } else { + throw TypeError('Unexpected argument type(s)'); + } + }}); + + // %TypedArray%.prototype.slice ( start, end ) + Object.defineProperty($TypedArray$.prototype, 'slice', {value: function(start, end) { + var o = ToObject(this); + var lenVal = o.length; + var len = ToUint32(lenVal); + var relativeStart = ToInt32(start); + var k = (relativeStart < 0) ? max(len + relativeStart, 0) : min(relativeStart, len); + var relativeEnd = (end === undefined) ? len : ToInt32(end); + var final0 = (relativeEnd < 0) ? max(len + relativeEnd, 0) : min(relativeEnd, len); + var count = final0 - k; + var c = o.constructor; + var a = new c(count); + var n = 0; + while (k < final0) { + var kValue = o._getter(k); + a._setter(n, kValue); + ++k; + ++n; + } + return a; + }}); + + // %TypedArray%.prototype.some ( callbackfn, thisArg = undefined ) + Object.defineProperty($TypedArray$.prototype, 'some', {value: function(callbackfn) { + if (this === undefined || this === null) throw TypeError(); + var t = Object(this); + var len = ToUint32(t.length); + if (!IsCallable(callbackfn)) throw TypeError(); + var thisp = arguments[1]; + for (var i = 0; i < len; i++) { + if (callbackfn.call(thisp, t._getter(i), i, t)) { + return true; + } + } + return false; + }}); + + // %TypedArray%.prototype.sort ( comparefn ) + Object.defineProperty($TypedArray$.prototype, 'sort', {value: function(comparefn) { + if (this === undefined || this === null) throw TypeError(); + var t = Object(this); + var len = ToUint32(t.length); + var tmp = Array(len); + for (var i = 0; i < len; ++i) + tmp[i] = t._getter(i); + if (comparefn) tmp.sort(comparefn); else tmp.sort(); // Hack for IE8/9 + for (i = 0; i < len; ++i) + t._setter(i, tmp[i]); + return t; + }}); + + // %TypedArray%.prototype.subarray(begin = 0, end = this.length ) + // WebIDL: TypedArray subarray(long begin, optional long end); + Object.defineProperty($TypedArray$.prototype, 'subarray', {value: function(start, end) { + function clamp(v, min, max) { return v < min ? min : v > max ? max : v; } + + start = ToInt32(start); + end = ToInt32(end); + + if (arguments.length < 1) { start = 0; } + if (arguments.length < 2) { end = this.length; } + + if (start < 0) { start = this.length + start; } + if (end < 0) { end = this.length + end; } + + start = clamp(start, 0, this.length); + end = clamp(end, 0, this.length); + + var len = end - start; + if (len < 0) { + len = 0; + } + + return new this.constructor( + this.buffer, this.byteOffset + start * this.BYTES_PER_ELEMENT, len); + }}); + + // %TypedArray%.prototype.toLocaleString ( ) + // %TypedArray%.prototype.toString ( ) + // %TypedArray%.prototype.values ( ) + // %TypedArray%.prototype [ @@iterator ] ( ) + // get %TypedArray%.prototype [ @@toStringTag ] + // -- defined in es6.js to shim browsers w/ native TypedArrays + + function makeTypedArray(elementSize, pack, unpack) { + // Each TypedArray type requires a distinct constructor instance with + // identical logic, which this produces. + var TypedArray = function() { + Object.defineProperty(this, 'constructor', {value: TypedArray}); + $TypedArray$.apply(this, arguments); + makeArrayAccessors(this); + }; + if ('__proto__' in TypedArray) { + TypedArray.__proto__ = $TypedArray$; + } else { + TypedArray.from = $TypedArray$.from; + TypedArray.of = $TypedArray$.of; + } + + TypedArray.BYTES_PER_ELEMENT = elementSize; + + var TypedArrayPrototype = function() {}; + TypedArrayPrototype.prototype = $TypedArrayPrototype$; + + TypedArray.prototype = new TypedArrayPrototype(); + + Object.defineProperty(TypedArray.prototype, 'BYTES_PER_ELEMENT', {value: elementSize}); + Object.defineProperty(TypedArray.prototype, '_pack', {value: pack}); + Object.defineProperty(TypedArray.prototype, '_unpack', {value: unpack}); + + return TypedArray; + } + + var Int8Array = makeTypedArray(1, packI8, unpackI8); + var Uint8Array = makeTypedArray(1, packU8, unpackU8); + var Uint8ClampedArray = makeTypedArray(1, packU8Clamped, unpackU8); + var Int16Array = makeTypedArray(2, packI16, unpackI16); + var Uint16Array = makeTypedArray(2, packU16, unpackU16); + var Int32Array = makeTypedArray(4, packI32, unpackI32); + var Uint32Array = makeTypedArray(4, packU32, unpackU32); + var Float32Array = makeTypedArray(4, packF32, unpackF32); + var Float64Array = makeTypedArray(8, packF64, unpackF64); + + global.Int8Array = global.Int8Array || Int8Array; + global.Uint8Array = global.Uint8Array || Uint8Array; + global.Uint8ClampedArray = global.Uint8ClampedArray || Uint8ClampedArray; + global.Int16Array = global.Int16Array || Int16Array; + global.Uint16Array = global.Uint16Array || Uint16Array; + global.Int32Array = global.Int32Array || Int32Array; + global.Uint32Array = global.Uint32Array || Uint32Array; + global.Float32Array = global.Float32Array || Float32Array; + global.Float64Array = global.Float64Array || Float64Array; + }()); + + // + // 6 The DataView View Type + // + + (function() { + function r(array, index) { + return IsCallable(array.get) ? array.get(index) : array[index]; + } + + var IS_BIG_ENDIAN = (function() { + var u16array = new Uint16Array([0x1234]), + u8array = new Uint8Array(u16array.buffer); + return r(u8array, 0) === 0x12; + }()); + + // DataView(buffer, byteOffset=0, byteLength=undefined) + // WebIDL: Constructor(ArrayBuffer buffer, + // optional unsigned long byteOffset, + // optional unsigned long byteLength) + function DataView(buffer, byteOffset, byteLength) { + if (!(buffer instanceof ArrayBuffer || Class(buffer) === 'ArrayBuffer')) throw TypeError(); + + byteOffset = ToUint32(byteOffset); + if (byteOffset > buffer.byteLength) + throw RangeError('byteOffset out of range'); + + if (byteLength === undefined) + byteLength = buffer.byteLength - byteOffset; + else + byteLength = ToUint32(byteLength); + + if ((byteOffset + byteLength) > buffer.byteLength) + throw RangeError('byteOffset and length reference an area beyond the end of the buffer'); + + Object.defineProperty(this, 'buffer', {value: buffer}); + Object.defineProperty(this, 'byteLength', {value: byteLength}); + Object.defineProperty(this, 'byteOffset', {value: byteOffset}); + }; + + // get DataView.prototype.buffer + // get DataView.prototype.byteLength + // get DataView.prototype.byteOffset + // -- applied directly to instances by the constructor + + function makeGetter(arrayType) { + return function GetViewValue(byteOffset, littleEndian) { + byteOffset = ToUint32(byteOffset); + + if (byteOffset + arrayType.BYTES_PER_ELEMENT > this.byteLength) + throw RangeError('Array index out of range'); + + byteOffset += this.byteOffset; + + var uint8Array = new Uint8Array(this.buffer, byteOffset, arrayType.BYTES_PER_ELEMENT), + bytes = []; + for (var i = 0; i < arrayType.BYTES_PER_ELEMENT; i += 1) + bytes.push(r(uint8Array, i)); + + if (Boolean(littleEndian) === Boolean(IS_BIG_ENDIAN)) + bytes.reverse(); + + return r(new arrayType(new Uint8Array(bytes).buffer), 0); + }; + } + + Object.defineProperty(DataView.prototype, 'getUint8', {value: makeGetter(Uint8Array)}); + Object.defineProperty(DataView.prototype, 'getInt8', {value: makeGetter(Int8Array)}); + Object.defineProperty(DataView.prototype, 'getUint16', {value: makeGetter(Uint16Array)}); + Object.defineProperty(DataView.prototype, 'getInt16', {value: makeGetter(Int16Array)}); + Object.defineProperty(DataView.prototype, 'getUint32', {value: makeGetter(Uint32Array)}); + Object.defineProperty(DataView.prototype, 'getInt32', {value: makeGetter(Int32Array)}); + Object.defineProperty(DataView.prototype, 'getFloat32', {value: makeGetter(Float32Array)}); + Object.defineProperty(DataView.prototype, 'getFloat64', {value: makeGetter(Float64Array)}); + + function makeSetter(arrayType) { + return function SetViewValue(byteOffset, value, littleEndian) { + byteOffset = ToUint32(byteOffset); + if (byteOffset + arrayType.BYTES_PER_ELEMENT > this.byteLength) + throw RangeError('Array index out of range'); + + // Get bytes + var typeArray = new arrayType([value]), + byteArray = new Uint8Array(typeArray.buffer), + bytes = [], i, byteView; + + for (i = 0; i < arrayType.BYTES_PER_ELEMENT; i += 1) + bytes.push(r(byteArray, i)); + + // Flip if necessary + if (Boolean(littleEndian) === Boolean(IS_BIG_ENDIAN)) + bytes.reverse(); + + // Write them + byteView = new Uint8Array(this.buffer, byteOffset, arrayType.BYTES_PER_ELEMENT); + byteView.set(bytes); + }; + } + + Object.defineProperty(DataView.prototype, 'setUint8', {value: makeSetter(Uint8Array)}); + Object.defineProperty(DataView.prototype, 'setInt8', {value: makeSetter(Int8Array)}); + Object.defineProperty(DataView.prototype, 'setUint16', {value: makeSetter(Uint16Array)}); + Object.defineProperty(DataView.prototype, 'setInt16', {value: makeSetter(Int16Array)}); + Object.defineProperty(DataView.prototype, 'setUint32', {value: makeSetter(Uint32Array)}); + Object.defineProperty(DataView.prototype, 'setInt32', {value: makeSetter(Int32Array)}); + Object.defineProperty(DataView.prototype, 'setFloat32', {value: makeSetter(Float32Array)}); + Object.defineProperty(DataView.prototype, 'setFloat64', {value: makeSetter(Float64Array)}); + + global.DataView = global.DataView || DataView; + + }()); + +}(h$getGlobal(this))); diff --git a/lib/boot/shims/old-time.yaml b/lib/boot/shims/old-time.yaml new file mode 100644 index 00000000..bff056e1 --- /dev/null +++ b/lib/boot/shims/old-time.yaml @@ -0,0 +1 @@ +version: 1.1.0.2 .. \ No newline at end of file diff --git a/lib/boot/shims/pkg/base.js b/lib/boot/shims/pkg/base.js new file mode 100644 index 00000000..59895510 --- /dev/null +++ b/lib/boot/shims/pkg/base.js @@ -0,0 +1,646 @@ +#include "HsBaseConfig.h" +#include + +// #define GHCJS_TRACE_IO 1 + +#ifdef GHCJS_TRACE_IO +function h$logIO() { h$log.apply(h$log, arguments); } +#define TRACE_IO(args...) h$logIO(args) +#else +#define TRACE_IO(args...) +#endif + +function h$base_access(file, file_off, mode, c) { + TRACE_IO("base_access"); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.stat(fd, function(err, fs) { + if(err) { + h$handleErrnoC(err, -1, 0, c); + } else { + c(mode & fs.mode); // fixme is this ok? + } + }); + } else +#endif + h$unsupported(-1, c); +} + +function h$base_chmod(file, file_off, mode, c) { + TRACE_IO("base_chmod"); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.chmod(h$decodeUtf8z(file, file_off), mode, function(err) { + h$handleErrnoC(err, -1, 0, c); + }); + } else +#endif + h$unsupported(-1, c); +} + +function h$base_close(fd, c) { + TRACE_IO("base_close"); + var fdo = h$base_fds[fd]; + if(fdo && fdo.close) { + fdo.close(fd, fdo, c); + } else { + h$errno = CONST_EINVAL; + c(-1); + } +} + +function h$base_dup(fd, something, c) { + throw "h$base_dup"; +} + +function h$base_dup2(fd, c) { + throw "h$base_dup2"; +} + +function h$base_fstat(fd, stat, stat_off, c) { + TRACE_IO("base_stat"); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.fstat(fd, function(err, fs) { + if(err) { + h$handlErrnoC(err, -1, 0, c); + } else { + h$base_fillStat(fs, stat, stat_off); + c(0); + } + }); + } else +#endif + h$unsupported(-1, c); +} + +function h$base_isatty(fd) { + TRACE_IO("base_isatty " + fd); +#ifndef GHCJS_BROWSER + if(h$isNode) { + if(fd === 0) return process.stdin.isTTY?1:0; + if(fd === 1) return process.stdout.isTTY?1:0; + if(fd === 2) return process.stderr.isTTY?1:0; + } +#endif + if(fd === 1 || fd === 2) return 1; + return 0; +} + +function h$base_lseek(fd, pos_1, pos_2, whence, c) { + TRACE_IO("base_lseek"); +#ifndef GHCJS_BROWSER + if(h$isNode) { + var p = goog.math.Long.fromBits(pos_2, pos_1), p1; + var o = h$base_fds[fd]; + if(!o) { + h$errno = CONST_BADF; + c(-1,-1); + } else { + switch(whence) { + case 0: /* SET */ + o.pos = p.toNumber(); + c(p.getHighBits(), p.getLowBits()); + break; + case 1: /* CUR */ + o.pos += p.toNumber(); + p1 = goog.math.Long.fromNumber(o.pos); + c(p1.getHighBits(), p1.getLowBits()); + break; + case 2: /* END */ + h$fs.fstat(fd, function(err, fs) { + if(err) { + h$setErrno(err); + c(-1,-1); + } else { + o.pos = fs.size + p.toNumber(); + p1 = goog.math.Long.fromNumber(o.pos); + c(p1.getHighBits(), p1.getLowBits()); + } + }); + break; + default: + h$errno = CONST_EINVAL; + c(-1,-1); + } + } + } else { +#endif + h$unsupported(); + c(-1, -1); +#ifndef GHCJS_BROWSER + } +#endif +} + +function h$base_lstat(file, file_off, stat, stat_off, c) { + TRACE_IO("base_lstat"); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.lstat(h$decodeUtf8z(file, file_off), function(err, fs) { + if(err) { + h$handleErrnoC(err, -1, 0, c); + } else { + h$base_fillStat(fs, stat, stat_off); + c(0); + } + }); + } else +#endif + h$unsupported(-1, c); +} +function h$base_open(file, file_off, how, mode, c) { +#ifndef GHCJS_BROWSER + if(h$isNode) { + var flags, off; + var fp = h$decodeUtf8z(file, file_off); + var acc = how & h$base_o_accmode; + // passing a number lets node.js use it directly as the flags (undocumented) + if(acc === h$base_o_rdonly) { + flags = h$processConstants['fs']['O_RDONLY']; + } else if(acc === h$base_o_wronly) { + flags = h$processConstants['fs']['O_WRONLY']; + } else { // r+w + flags = h$processConstants['fs']['O_RDWR']; + } + off = (how & h$base_o_append) ? -1 : 0; + flags = flags | ((how & h$base_o_trunc) ? h$processConstants['fs']['O_TRUNC'] : 0) + | ((how & h$base_o_creat) ? h$processConstants['fs']['O_CREAT'] : 0) + | ((how & h$base_o_excl) ? h$processConstants['fs']['O_EXCL'] : 0) + | ((how & h$base_o_append) ? h$processConstants['fs']['O_APPEND'] : 0); + h$fs.open(fp, flags, mode, function(err, fd) { + if(err) { + h$handleErrnoC(err, -1, 0, c); + } else { + var f = function(p) { + h$base_fds[fd] = { read: h$base_readFile + , write: h$base_writeFile + , close: h$base_closeFile + , pos: p + }; + c(fd); + } + if(off === -1) { + h$fs.stat(fp, function(err, fs) { + if(err) h$handleErrnoC(err, -1, 0, c); else f(fs.size); + }); + } else { + f(0); + } + } + }); + } else +#endif + h$unsupported(-1, c); +} +function h$base_read(fd, buf, buf_off, n, c) { + TRACE_IO("base_read: " + fd); + var fdo = h$base_fds[fd]; + if(fdo && fdo.read) { + fdo.read(fd, fdo, buf, buf_off, n, c); + } else { + h$errno = CONST_EINVAL; + c(-1); + } +} +function h$base_stat(file, file_off, stat, stat_off, c) { + TRACE_IO("base_stat"); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.stat(h$decodeUtf8z(file, file_off), function(err, fs) { + if(err) { + h$handlErrnoC(err, -1, 0, c); + } else { + h$base_fillStat(fs, stat, stat_off); + c(0); + } + }); + } else +#endif + h$unsupported(-1, c); +} +function h$base_umask(mode) { + TRACE_IO("base_umask: " + mode); +#ifndef GHCJS_BROWSER + if(h$isNode) return process.umask(mode); +#endif + return 0; +} + +function h$base_write(fd, buf, buf_off, n, c) { + TRACE_IO("base_write: " + fd); + var fdo = h$base_fds[fd]; + if(fdo && fdo.write) { + fdo.write(fd, fdo, buf, buf_off, n, c); + } else { + h$errno = CONST_EINVAL; + c(-1); + } +} + +function h$base_ftruncate(fd, pos_1, pos_2, c) { + TRACE_IO("base_ftruncate"); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.ftruncate(fd, goog.math.Long.fromBits(pos_2, pos_1).toNumber(), function(err) { + h$handleErrnoC(err, -1, 0, c); + }); + } else +#endif + h$unsupported(-1, c); +} +function h$base_unlink(file, file_off, c) { + TRACE_IO("base_unlink"); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.unlink(h$decodeUtf8z(file, file_off), function(err) { + h$handleErrnoC(err, -1, 0, c); + }); + } else +#endif + h$unsupported(-1, c); +} +function h$base_getpid() { + TRACE_IO("base_getpid"); +#ifndef GHCJS_BROWSER + if(h$isNode) return process.pid; +#endif + return 0; +} +function h$base_link(file1, file1_off, file2, file2_off, c) { + TRACE_IO("base_link"); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.link(h$decodeUtf8z(file1, file1_off), h$decodeUtf8z(file2, file2_off), function(err) { + h$handleErrnoC(err, -1, 0, c); + }); + } else +#endif + h$unsupported(-1, c); +} +function h$base_mkfifo(file, file_off, mode, c) { + throw "h$base_mkfifo"; +} +function h$base_sigemptyset(sigset, sigset_off) { + return 0; + // throw "h$base_sigemptyset"; +} +function h$base_sigaddset(sigset, sigset_off, sig) { + return 0; + // throw "h$base_sigaddset"; +} +function h$base_sigprocmask(sig, sigset1, sigset1_off, sigset2, sigset2_off) { + return 0; + // throw "h$base_sigprocmask"; +} +function h$base_tcgetattr(attr, termios, termios_off) { + return 0; +} +function h$base_tcsetattr(attr, val, termios, termios_off) { + return 0; +} +function h$base_utime(file, file_off, timbuf, timbuf_off, c) { + TRACE_IO("base_utime"); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.fstat(h$decodeUtf8z(file, file_off), function(err, fs) { + if(err) { + h$handleErrnoC(err, 0, -1, c); // fixme + } else { + var atime = goog.math.Long.fromNumber(fs.atime.getTime()); + var mtime = goog.math.Long.fromNumber(fs.mtime.getTime()); + var ctime = goog.math.Long.fromNumber(fs.ctime.getTime()); + timbuf.i3[0] = atime.getHighBits(); + timbuf.i3[1] = atime.getLowBits(); + timbuf.i3[2] = mtime.getHighBits(); + timbuf.i3[3] = mtime.getLowBits(); + timbuf.i3[4] = ctime.getHighBits(); + timbuf.i3[5] = ctime.getLowBits(); + c(0); + } + }); + } else +#endif + h$unsupported(-1, c); +} +function h$base_waitpid(pid, stat, stat_off, options, c) { + throw "h$base_waitpid"; +} +/** @const */ var h$base_o_rdonly = 0x00000; +/** @const */ var h$base_o_wronly = 0x00001; +/** @const */ var h$base_o_rdwr = 0x00002; +/** @const */ var h$base_o_accmode = 0x00003; +/** @const */ var h$base_o_append = 0x00008; +/** @const */ var h$base_o_creat = 0x00200; +/** @const */ var h$base_o_trunc = 0x00400; +/** @const */ var h$base_o_excl = 0x00800; +/** @const */ var h$base_o_noctty = 0x20000; +/** @const */ var h$base_o_nonblock = 0x00004; +/** @const */ var h$base_o_binary = 0x00000; + +function h$base_c_s_isreg(mode) { + return 1; +} +function h$base_c_s_ischr(mode) { + return 0; +} +function h$base_c_s_isblk(mode) { + return 0; +} +function h$base_c_s_isdir(mode) { + return 0; // fixme +} +function h$base_c_s_isfifo(mode) { + return 0; +} + +#ifndef GHCJS_BROWSER +function h$base_fillStat(fs, b, off) { + if(off%4) throw "h$base_fillStat: not aligned"; + var o = off>>2; + b.i3[o+0] = fs.mode; + var s = goog.math.Long.fromNumber(fs.size); + b.i3[o+1] = s.getHighBits(); + b.i3[o+2] = s.getLowBits(); + b.i3[o+3] = 0; // fixme + b.i3[o+4] = 0; // fixme + b.i3[o+5] = fs.dev; + var i = goog.math.Long.fromNumber(fs.ino); + b.i3[o+6] = i.getHighBits(); + b.i3[o+7] = i.getLowBits(); + b.i3[o+8] = fs.uid; + b.i3[o+9] = fs.gid; +} +#endif + +// [mode,size1,size2,mtime1,mtime2,dev,ino1,ino2,uid,gid] all 32 bit +/** @const */ var h$base_sizeof_stat = 40; + +function h$base_st_mtime(stat, stat_off) { + RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+3], stat.i3[(stat_off>>2)+4]); +} + +function h$base_st_size(stat, stat_off) { + RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+1], stat.i3[(stat_off>>2)+2]); +} + +function h$base_st_mode(stat, stat_off) { + return stat.i3[stat_off>>2]; +} + +function h$base_st_dev(stat, stat_off) { + return stat.i3[(stat_off>>2)+5]; +} + +function h$base_st_ino(stat, stat_off) { + RETURN_UBX_TUP2(stat.i3[(stat_off>>2)+6], stat.i3[(stat_off>>2)+7]); +} + +/** @const */ var h$base_echo = 1; +/** @const */ var h$base_tcsanow = 2; +/** @const */ var h$base_icanon = 4; +/** @const */ var h$base_vmin = 8; +/** @const */ var h$base_vtime = 16; +/** @const */ var h$base_sigttou = 0; +/** @const */ var h$base_sig_block = 0; +/** @const */ var h$base_sig_setmask = 0; +/** @const */ var h$base_f_getfl = 0; +/** @const */ var h$base_f_setfl = 0; +/** @const */ var h$base_f_setfd = 0; +/** @const */ var h$base_fd_cloexec = 0; +/** @const */ var h$base_sizeof_termios = 4; +/** @const */ var h$base_sizeof_sigset_t = 4; + +function h$base_lflag(termios, termios_off) { + return 0; +} + +function h$base_poke_lflag(termios, termios_off, flag) { + return 0; +} + +function h$base_ptr_c_cc(termios, termios_off) { + RETURN_UBX_TUP2(h$newByteArray(8), 0); +} + +/** @const */ var h$base_default_buffer_size = 32768; + +function h$base_c_s_issock(mode) { + return 0; // fixme +} + +/** @const */ var h$base_SEEK_SET = 0; +/** @const */ var h$base_SEEK_CUR = 1; +/** @const */ var h$base_SEEK_END = 2; + +function h$base_set_saved_termios(a, b, c) { + RETURN_UBX_TUP2(null, 0); +} + +function h$base_get_saved_termios(r) { + RETURN_UBX_TUP2(null, 0); +} + +// fixme +function h$lockFile(fd, dev, ino, for_writing) { + TRACE_IO("lockFile:" + fd); + return 0; +} +function h$unlockFile(fd) { + TRACE_IO("unlockFile:" + fd); + return 0; +} + + + +// engine-dependent setup +var h$base_readStdin , h$base_writeStderr, h$base_writeStdout; +var h$base_closeStdin = null, h$base_closeStderr = null, h$base_closeStdout = null; +var h$base_readFile, h$base_writeFile, h$base_closeFile; +#ifndef GHCJS_BROWSER +var h$base_stdin_waiting = new h$Queue(); +var h$base_stdin_chunk = { buf: null + , pos: 0 + , processing: false + }; +var h$base_stdin_eof = false; +var h$base_process_stdin = function() { + var c = h$base_stdin_chunk; + var q = h$base_stdin_waiting; + if(!q.length() || c.processing) return; + c.processing = true; + if(!c.buf) { c.pos = 0; c.buf = process.stdin.read(); } + while(c.buf && q.length()) { + var x = q.dequeue(); + var n = Math.min(c.buf.length - c.pos, x.n); + for(var i=0;i= c.buf.length) c.buf = null; + if(!c.buf && q.length()) { c.pos = 0; c.buf = process.stdin.read(); } + } + while(h$base_stdin_eof && q.length()) q.dequeue().c(0); + c.processing = false; +} + +if(h$isNode) { + h$base_closeFile = function(fd, fdo, c) { + h$fs.close(fd, function(err) { + delete h$base_fds[fd]; + h$handleErrnoC(err, -1, 0, c); + }); + } + + h$base_readFile = function(fd, fdo, buf, buf_offset, n, c) { + var pos = typeof fdo.pos === 'number' ? fdo.pos : null; + TRACE_IO("base_readFile: " + fd + " " + pos + " " + buf_offset + " " + n); + h$fs.read(fd, new Buffer(n), 0, n, pos, function(err, bytesRead, nbuf) { + if(err) { + h$setErrno(err); + c(-1); + } else { + for(var i=bytesRead-1;i>=0;i--) buf.u8[buf_offset+i] = nbuf[i]; + if(typeof fdo.pos === 'number') fdo.pos += bytesRead; + c(bytesRead); + } + }); + } + + h$base_readStdin = function(fd, fdo, buf, buf_offset, n, c) { + TRACE_IO("read stdin"); + h$base_stdin_waiting.enqueue({buf: buf, off: buf_offset, n: n, c: c}); + h$base_process_stdin(); + } + + h$base_closeStdin = function(fd, fdo, c) { + TRACE_IO("close stdin"); + // process.stdin.close(); fixme + c(0); + } + + h$base_writeFile = function(fd, fdo, buf, buf_offset, n, c) { + var pos = typeof fdo.pos === 'number' ? fdo.pos : null; + TRACE_IO("base_writeFile: " + fd + " " + pos + " " + buf_offset + " " + n); + var nbuf = new Buffer(n); + for(var i=0;i + +// translated from bytestring cbits/fpstring.c + +function h$fps_reverse(a_v, a_o, b_v, b_o, n) { + if(n > 0) { + var au8 = a_v.u8, bu8 = b_v.u8; + for(var i=0;i 0) { + var au8 = a_v.u8, bu8 = b_v.u8, dst_o = a_o; + for(var i=0;i 0) { + var au8 = a_v.u8, max = au8[a_o]; + for(var i=1;i max) { max = c; } + } + return max; + } + return 0; +} + +function h$fps_minimum(a_v,a_o,n) { + if(n > 0) { + var au8 = a_v.u8, min = a_v.u8[a_o]; + for(var i=1;i 0) { + var au8 = a_v.u8, count = 0; + for(var i=0;i>>= 4; + } while(x); + + // invert written digits + next_free = ptr--; + while(buf_o < ptr) { + c = bu8[ptr]; + bu8[ptr--] = bu8[buf_o]; + bu8[buf_o++] = c; + } + RETURN_UBX_TUP2(buf_d, next_free); +} + +// unsigned long ints (64 bit words) +function h$_hs_bytestring_long_long_uint_hex(x_a, x_b, buf_d, buf_o) { + // write hex representation in reverse order + var c, ptr = buf_o, next_free; + var bu8 = buf_d.u8; + if(x_a === 0 && x_b === 0) { + bu8[ptr++] = 48; // '0' + } else { + while(x_b !== 0) { + bu8[ptr++] = h$_hs_bytestring_digits[x_b & 0xf]; + x_b >>>= 4; + } + while(x_a !== 0) { + bu8[ptr++] = h$_hs_bytestring_digits[x_a & 0xf]; + x_a >>>= 4; + } + } + + // invert written digits + next_free = ptr--; + while(buf_o < ptr) { + c = bu8[ptr]; + bu8[ptr--] = bu8[buf_o]; + bu8[buf_o++] = c; + } + RETURN_UBX_TUP2(buf_d, next_free); +} + diff --git a/lib/boot/shims/pkg/directory.js b/lib/boot/shims/pkg/directory.js new file mode 100644 index 00000000..f6a63ef6 --- /dev/null +++ b/lib/boot/shims/pkg/directory.js @@ -0,0 +1,343 @@ +#include "HsBaseConfig.h" + +#ifdef GHCJS_TRACE_DIRECTORY +function h$logDirectory() { h$log.apply(h$log,arguments); } +#define TRACE_DIRECTORY(args...) h$logDirectory(args) +#else +#define TRACE_DIRECTORY(args...) +#endif + +// get/set permissions for file +// set errno and return -1 on error +// masks: 1 - read +// 2 - write +// 4 - exe +// 8 - search +function h$directory_getPermissions(file, c) { + TRACE_DIRECTORY("getPermissions: " + file); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.stat(file, function(err, fs) { + if(err) { + h$handleErrnoC(err, -1, 0, c); + } else { + var m = fs.mode; + var r = (m&4) || (m&32) || (m&256); + var w = (m&2) || (m&16) || (m&128); + var x = (m&1) || (m&8) || (m&64); + var exe = x; // fixme? + var search = x; // fixme? + if(process.platform == 'win32') exe = true; + c((r?1:0)|(w?2:0)|(exe?4:0)|(search?8:0)); + } + }); + } else +#endif + h$unsupported(-1, c); +} + +function h$directory_setPermissions(file, perms, c) { + TRACE_DIRECTORY("setPermissions: " + file + " " + perms); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.stat(file, function(err, fs) { + if(err) { + h$handleErrnoC(err, -1, 0, c); + } else { + var r = perms & 1; + var w = perms & 2; + var x = perms & 4; + var search = perms & 8; + var m = fs.mode; + m = r ? (m | 292) : (m & ~292); + m = w ? (m | 146) : (m & ~146); + m = (x || search) ? (m | 73) : (m & ~73); + h$fs.chmod(file, function(err) { + h$handleErrnoC(err, -1, 0, c); + }); + } + }); + } else +#endif + h$unsupported(-1, c); +} + +function h$directory_copyPermissions(file1, file2, c) { + TRACE_DIRECTORY("copyPermissions: " + file1 + " " + file2); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.stat(file1, function(err1, fs) { + if(err1) { + h$handleErrnoC(err1, -1, 0, c); + } else { + h$fs.chmod(file2, fs.mode, function(err2) { + h$handleErrnoC(err2, -1, 0, c); + }); + } + }); + } else +#endif + h$unsupported(-1, c); +} + + +function h$directory_createDirectory(dir, c) { + TRACE_DIRECTORY("createDirectory: " + dir); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.mkdir(dir, function(err) { + h$handleErrnoC(err,-1,0,c); + }); + } else +#endif + h$unsupported(-1, c); +} + +function h$directory_removeDirectory(dir, c) { + TRACE_DIRECTORY("removeDirectory: " + dir); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.rmdir(dir, function(err) { + h$handleErrnoC(err,-1,0,c); + }); + } else +#endif + h$unsupported(-1, c); +} + +function h$directory_removeFile(file, c) { + TRACE_DIRECTORY("removeFile: " + file); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.unlink(file, function(err) { + h$handleErrnoC(err,-1,0,c); + }); + } else +#endif + h$unsupported(-1, c); +} + +function h$directory_renameDirectory(dir1, dir2, c) { + TRACE_DIRECTORY("renameDirectory: " + dir1 + " " + dir2); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.rename(dir1, dir2, function(err) { + h$handleErrnoC(err,-1,0,c); + }); + } else +#endif + h$unsupported(-1, c); +} + +function h$directory_renameFile(file1, file2, c) { + TRACE_DIRECTORY("renameFile: " + file1 + " " + file2); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.rename(file1, file2, function(err) { + h$handleErrnoC(err,-1,0,c); + }); + } else +#endif + h$unsupported(-1, c); +} + +function h$directory_canonicalizePath(path) { + TRACE_DIRECTORY("canonicalizePath: " + path); +#ifndef GHCJS_BROWSER + if(h$isNode) { + return h$path.normalize(path); + } else +#endif + return path; +} + +function h$directory_findExecutables(name, c) { + TRACE_DIRECTORY("findExecutables: " + name); +#ifndef GHCJS_BROWSER + if(h$isNode) { + var result = []; + var pathSep = process.platform === 'win32'?';':':'; + var parts = process.env['PATH'].split(pathSep); + var exts = []; // process.platform === 'win32'?process.env['PATHEXT'].split(pathSep):[]; + exts.push(null); + files = []; + result = []; + for(var i=0;i= files.length) { + c(result); + } else { + TRACE_DIRECTORY("trying: " + files[n]); + h$fs.stat(files[n], function(err, fs) { + if(!err && ((fs.mode & 73) || process.platform === 'win32')) result.push(files[n]); + tryFile(n+1); + }); + } + } + tryFile(0); + } else +#endif + c([]); +} + +function h$directory_getDirectoryContents(dir,c) { + TRACE_DIRECTORY("getDirectoryContents: " + dir); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.readdir(dir, function(err, d) { + h$handleErrnoC(err, null, d, c); + }); + } else +#endif + h$unsupported(null, c); +} + +function h$directory_getCurrentDirectory() { + TRACE_DIRECTORY("getCurrentDirectory"); +#ifndef GHCJS_BROWSER + if(h$isNode) { + return h$handleErrno(null, function() { + return process.cwd(); + }); + } else +#endif + return "/"; +} + +function h$directory_setCurrentDirectory(dir) { + TRACE_DIRECTORY("setCurrentDirectory: " + dir); +#ifndef GHCJS_BROWSER + if(h$isNode) { + return h$handleErrnoS(-1, 0, function() { + return process.chdir(dir); + }); + } else +#endif + return h$unsupported(-1); +} + +function h$directory_getHomeDirectory(dir) { + TRACE_DIRECTORY("getHomeDirectory: " + dir); +#ifndef GHCJS_BROWSER + if(h$isNode) { + return process.env['HOME'] || + process.env['HOMEPATH'] || + process.env['USERPROFILE']; + } else +#endif + return "/" +} + +function h$directory_getAppUserDataDirectory(appName) { + TRACE_DIRECTORY("getAppUserDataDirectory: " + appName); +#ifndef GHCJS_BROWSER + if(h$isNode) { + if(process.env['APPDATA']) + return process.env['APPDATA'] + h$path.sep + appName; + if(process.env['HOME']) + return process.env['HOME'] + h$path.sep + "." + appName; + TRACE_DIRECTORY("getAppUserDataDirectory fallback"); + return "/"; + } else +#endif + return "/"; +} + +function h$directory_getUserDocumentsDirectory(appName) { + TRACE_DIRECTORY("getUserDocumentsDirectory: " + appName); +#ifndef GHCJS_BROWSER + if(h$isNode) { + if(process.env['HOME']) + return process.env['HOME']; + // fixme handle Windows + TRACE_DIRECTORY("getUserDocumentsDirectory fallback"); + return "/"; + } else +#endif + return "/"; +} + +function h$directory_getTemporaryDirectory() { + TRACE_DIRECTORY("getTemporaryDirectory"); +#ifndef GHCJS_BROWSER + if(h$isNode) { + return h$handleErrno(null, function() { + return h$os.tmpdir(); + }); + } else +#endif + return "/"; +} + +function h$directory_exeExtension() { + TRACE_DIRECTORY("exeExtension"); +#ifndef GHCJS_BROWSER + if(h$isNode) { + return (h$os.platform() === 'windows') ? 'exe' : ''; + } else +#endif + return ''; +} + +function h$directory_getFileStatus(file, c) { + TRACE_DIRECTORY("getFileStatus: " + file); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.stat(file, function(err, s) { + h$handleErrnoC(err, null, s, c); + }); + } else +#endif + h$unsupported(null, c); +} + +function h$directory_getFileOrSymlinkStatus(file, c) { + TRACE_DIRECTORY("getFileOrSymlinkStatus: " + file); +#ifndef GHCJS_BROWSER + if(h$isNode) { + h$fs.lstat(file, function(err, s) { + h$handleErrnoC(err, null, s, c); + }); + } else +#endif + h$unsupported(null, c); +} + +function h$directory_getFileStatusAccessTime(fs) { + TRACE_DIRECTORY("getFileStatusAccessTime: " + fs.atime.getTime()); + return fs.atime.getTime(); +} + +function h$directory_getFileStatusModificationTime(fs) { + TRACE_DIRECTORY("getFileStatusModificationTime: " + fs.mtime.getTime()); + return fs.mtime.getTime(); +} + +function h$directory_getFileStatusIsDirectory(fs) { + TRACE_DIRECTORY("getFileStatusIsDirectory: " + fs + " " + fs.isDirectory()); + return fs.isDirectory(); +} + +function h$directory_getFileStatusIsSymbolicLink(fs) { + TRACE_DIRECTORY("getFileStatusIsSymbolicLink: " + fs + " " + fs.isSymbolicLink()); + return fs.isSymbolicLink(); +} + +// fixme this doesn't really belong here +function h$chmod(path_d, path_o, m) { +#ifndef GHCJS_BROWSER + if(h$isNode) { + var path = h$decodeUtf8z(path_d, path_o); + TRACE_DIRECTORY("chmod: " + path + " mode: " + m); + h$fs.chmodSync(path, m); + return 0; + } else +#endif + return h$unsupported(-1); +} + + diff --git a/lib/boot/shims/pkg/filepath.js b/lib/boot/shims/pkg/filepath.js new file mode 100644 index 00000000..f693e9b0 --- /dev/null +++ b/lib/boot/shims/pkg/filepath.js @@ -0,0 +1,6 @@ +function h$filepath_isWindows() { +#ifndef GHCJS_BROWSER + if(h$isNode && process.platform === 'win32') return true; +#endif + return false; +} diff --git a/lib/boot/shims/pkg/ghcjs-canvas.js b/lib/boot/shims/pkg/ghcjs-canvas.js new file mode 100644 index 00000000..c1fcde56 --- /dev/null +++ b/lib/boot/shims/pkg/ghcjs-canvas.js @@ -0,0 +1,15 @@ +function h$ghcjs_setLineDash(arr, ctx) { + if (typeof ctx.setLineDash !== 'undefined' ) { + ctx.setLineDash(arr); + } else if (typeof ctx.mozDash !== 'undefined' ) { + ctx.mozDash = arr; + } +}; + +function h$ghcjs_lineDashOffset(off, ctx) { + if (typeof ctx.setLineDash !== 'undefined' ) { + ctx.lineDashOffset = off; + } else if (typeof ctx.mozDash !== 'undefined' ) { + ctx.mozDashOffset = off; + } +}; diff --git a/lib/boot/shims/pkg/ghcjs-dom.js b/lib/boot/shims/pkg/ghcjs-dom.js new file mode 100644 index 00000000..02bd0169 --- /dev/null +++ b/lib/boot/shims/pkg/ghcjs-dom.js @@ -0,0 +1,7 @@ +function h$ghcjs_currentWindow() { + return window; +}; +function h$ghcjs_currentDocument() { + return document; +}; + diff --git a/lib/boot/shims/pkg/glib.js b/lib/boot/shims/pkg/glib.js new file mode 100644 index 00000000..df2388f7 --- /dev/null +++ b/lib/boot/shims/pkg/glib.js @@ -0,0 +1,37 @@ + +function h$g_object_ref(p, p_2) { + h$ret1 = p_2; + return p; +}; +function h$g_free(p, p_2) { +}; +function h$gtk2hs_g_object_unref_from_mainloop(o, o_2) { +}; +function h$gtk2hs_closure_new(f, f_2) { + h$ret1 = f_2; + return f; +}; +var h$g_known_types = []; +function h$g_get_type(c) { + var n; + for(n=0; n != h$g_known_types.length; n++) { + if(h$g_known_types[n] == c) + return n; + } + h$g_known_types[n] = c; + return n; +}; +function h$g_type_check_instance_is_a(o, x, t) { + return o instanceof h$g_known_types[t] ? 1 : 0; +}; +function h$g_idle_add_full(priority, f, f_2, data, data_2, notify, notify_2) { + setTimeout(function() { + h$run(h$c2(h$ap1_e, f.arr[0], h$mkPtr(data, data_2))); + }, 0); + return 1; +}; +function h$gdk_threads_enter() { +}; +function h$gdk_threads_leave() { +}; + diff --git a/lib/boot/shims/pkg/hashable.js b/lib/boot/shims/pkg/hashable.js new file mode 100644 index 00000000..68cc5cff --- /dev/null +++ b/lib/boot/shims/pkg/hashable.js @@ -0,0 +1,32 @@ +/* FNV-1 hash + * + * The FNV-1 hash description: http://isthe.com/chongo/tech/comp/fnv/ + * The FNV-1 hash is public domain: http://isthe.com/chongo/tech/comp/fnv/#public_domain + */ +function h$hashable_fnv_hash_offset(str_a, o, len, hash) { + return h$hashable_fnv_hash(str_a, o, len, hash); +} + +function h$hashable_fnv_hash(str_d, str_o, len, hash) { + if(len > 0) { + var d = str_d.u8; + for(var i=0;i 0) { + var d = dest_d.u8; + for(var i=0;i=0;i--) { + du8[dst_o+i] = su8[src_o+i]; + } +} + +#define MEMSETADDR(TYPE, SIZE, PROP) \ +function h$hsprimitive_memset_ ## TYPE (p_d, p_o, off, n, x) { \ + var start = (p_o >> SIZE) + off; \ + if(n > 0) { \ + if(p_d.PROP.fill) p_d.PROP.fill(x, start, start + n); \ + else for(var i=start; i 0) { \ + if(p_d.PROP.fill) p_d.PROP.fill(x, off, off + n); \ + else for(var i=off; i> 3) + off; + if(n > 0) { + var pi3 = p_d.i3; + for(var i = 0; i < n; i++) { + var o = (start + i) << 1; + pi3[o] = x_1; + pi3[o+1] = x_2; + } + } +} + +function h$hsprimitive_memset_Ptr(p_d, p_o, off, n, x_1, x_2) { + if(n > 0) { + if(!p_d.arr) p_d.arr = []; + var a = p_d.arr; + for(var i = 0; i < n; i++) { + a[p_o + ((off + i) << 2)] = [x_1, x_2]; + } + } +} diff --git a/lib/boot/shims/pkg/process.js b/lib/boot/shims/pkg/process.js new file mode 100644 index 00000000..579ed1bb --- /dev/null +++ b/lib/boot/shims/pkg/process.js @@ -0,0 +1,290 @@ +#include "HsBaseConfig.h" + +// #ifdef GHCJS_NODE +// only works on node.js + +#ifdef GHCJS_TRACE_PROCESS +function h$logProcess() { h$log.apply(h$log,arguments); } +#define TRACE_PROCESS(args...) h$logProcess(args) +#else +#define TRACE_PROCESS(args...) +#endif + +#ifndef GHCJS_BROWSER +// one-dir pipe +function h$process_pipeFd(pipe, write) { + var fdN = h$base_fdN--, fd = {}; + h$base_fds[fdN] = fd; + TRACE_PROCESS("pipe " + fdN + " opened, writable: " + write); + if(write) { + fd.err = null; + fd.waiting = new h$Queue(); + fd.close = function(fd, fdo, c) { delete h$base_fds[fd]; pipe.end(); c(0); }; + pipe.on('error', function(err) { + fd.err = err; + }); + fd.write = function(fd, fdo, buf, buf_offset, n, c) { + TRACE_PROCESS("pipe " + fd + " write: " + n); + if(fdo.err) { + h$setErrno(fdo.err); + c(-1); + } + var u8 = buf.u8; + var nbuf = new Buffer(n); + // can this be made more efficient? + for(var k=0;k= c.buf.length) c.buf = null; + if(!c.buf && q.length()) { c.pos = 0; c.buf = pipe.read(); } + } + while(fd.eof && q.length()) q.dequeue().c(0); + TRACE_PROCESS("done processing pipe, remaining queue: " + q.length()); + c.processing = false; +} +#endif /* GHCJS_BROWSER */ +function h$process_runInteractiveProcess( cmd, args, workingDir, env + , stdin_fd, stdout_fd, stderr_fd + , closeHandles, createGroup, delegateCtlC) { + TRACE_PROCESS("runInteractiveProcess"); + TRACE_PROCESS("cmd: " + cmd + " args: " + args.join(' ')); + TRACE_PROCESS("workingDir: " + workingDir + " env: " + env); + TRACE_PROCESS("stdin: " + stdin_fd + " stdout: " + stdout_fd + " stderr: " + stderr_fd); + +#ifndef GHCJS_BROWSER + if(h$isNode) { + var stdin_p, stdout_p, stderr_p; + + if(stdin_fd === -1) { + stdin_p = 'pipe'; + } else if(stdin_fd === 0) { + stdin_p = process.stdin; + } else { + throw "runInteractiveProcess: custom stdin unsupported"; + } + + if(stdout_fd === -1) { + stdout_p = 'pipe'; + } else if(stdout_fd === 1) { + stdout_p = process.stdout; + } else { + throw "runInteractiveProcess: custom stdout unsupported"; + } + + if(stderr_fd === -1) { + stderr_p = 'pipe' + } else if(stderr_fd === 2) { + stderr_p = process.stderr; + } else { + throw "runInteractiveProcess: custom stderr unsupported"; + } + + var options = { detached: createGroup + , stdio: [stdin_p, stdout_p, stderr_p] + }; + if(workingDir !== null) options.cwd = workingDir; + if(env !== null) { + var envObj = {}; + for(var i=0;i + +function h$_hs_text_memcpy(dst_v,dst_o2,src_v,src_o2,n) { + return h$memcpy(dst_v,2*dst_o2,src_v,2*src_o2,2*n); +} + +function h$_hs_text_memcmp(a_v,a_o2,b_v,b_o2,n) { + return h$memcmp(a_v,2*a_o2,b_v,2*b_o2,2*n); +} + +// decoder below adapted from cbits/cbits.c in the text package + +#define TEXT_UTF8_ACCEPT 0 +#define TEXT_UTF8_REJECT 12 + +var h$_text_utf8d = + [ + /* + * The first part of the table maps bytes to character classes that + * to reduce the size of the transition table and create bitmasks. + */ + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, + 8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, + 10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8, + + /* + * The second part is a transition table that maps a combination of + * a state of the automaton and a character class to a state. + */ + 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12, + 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12, + 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12, + 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12, + 12,36,12,12,12,12,12,12,12,12,12,12]; + +/* + * A best-effort decoder. Runs until it hits either end of input or + * the start of an invalid byte sequence. + * + * At exit, updates *destoff with the next offset to write to, and + * returns the next source offset to read from. + */ + +function h$_hs_text_decode_utf8_internal ( dest_v + , destoff_v, destoff_o + , src_v, src_o + , src_end_v, src_end_o + , s + ) { + if(src_v === null || src_end_v === null) { + RETURN_UBX_TUP2(null, src_end_o); + } + var dsto = destoff_v.dv.getUint32(destoff_o,true) << 1; + var srco = src_o; + var state = s.state; + var codepoint = s.codepoint; + var ddv = dest_v.dv; + var sdv = src_v.dv; + + function decode(b) { + var type = h$_text_utf8d[b]; + codepoint = (state !== TEXT_UTF8_ACCEPT) ? + (b & 0x3f) | (codepoint << 6) : + (0xff >>> type) & b; + state = h$_text_utf8d[256 + state + type]; + return state; + } + + while (srco < src_end_o) { + if(decode(sdv.getUint8(srco++)) !== TEXT_UTF8_ACCEPT) { + if(state !== TEXT_UTF8_REJECT) { + continue; + } else { + break; + } + } + if (codepoint <= 0xffff) { + ddv.setUint16(dsto,codepoint,true); + dsto += 2; + } else { + ddv.setUint16(dsto,(0xD7C0 + (codepoint >>> 10)),true); + ddv.setUint16(dsto+2,(0xDC00 + (codepoint & 0x3FF)),true); + dsto += 4; + } + s.last = srco; + } + + s.state = state; + s.codepoint = codepoint; + destoff_v.dv.setUint32(destoff_o,dsto>>1,true); + RETURN_UBX_TUP2(src_v, srco); +} + +function h$_hs_text_decode_utf8_state( dest_v + , destoff_v, destoff_o + , src_v, src_o + , srcend_v, srcend_o + , codepoint0_v, codepoint0_o + , state0_v, state0_o + ) { + var s = { state: state0_v.dv.getUint32(state0_o, true) + , codepoint: codepoint0_v.dv.getUint32(codepoint0_o, true) + , last: src_o + }; + var ret, ret1; + CALL_UBX_TUP2( ret + , ret1 + , h$_hs_text_decode_utf8_internal ( dest_v + , destoff_v, destoff_o + , src_v.arr[src_o][0], src_v.arr[src_o][1] + , srcend_v, srcend_o + , s + )); + src_v.arr[src_o][1] = s.last; + state0_v.dv.setUint32(state0_o, s.state, true); + codepoint0_v.dv.setUint32(codepoint0_o, s.codepoint, true); + if(s.state === TEXT_UTF8_REJECT) ret1--; + RETURN_UBX_TUP2(ret, ret1); +} + +function h$_hs_text_decode_utf8( dest_v + , destoff_v, destoff_o + , src_v, src_o + , srcend_v, srcend_o + ) { + /* Back up if we have an incomplete or invalid encoding */ + var s = { state: TEXT_UTF8_ACCEPT + , codepoint: 0 + , last: src_o + }; + var ret, ret1; + CALL_UBX_TUP2( ret + , ret1 + , h$_hs_text_decode_utf8_internal ( dest_v + , destoff_v, destoff_o + , src_v, src_o + , srcend_v, srcend_o + , s + )); + if (s.state !== TEXT_UTF8_ACCEPT) ret1--; + RETURN_UBX_TUP2(ret, ret1); +} + + +/* + * The ISO 8859-1 (aka latin-1) code points correspond exactly to the first 256 unicode + * code-points, therefore we can trivially convert from a latin-1 encoded bytestring to + * an UTF16 array + */ +function h$_hs_text_decode_latin1(dest_d, src_d, src_o, srcend_d, srcend_o) { + var p = src_o; + var d = 0; + var su8 = src_d.u8; + var su3 = src_d.u3; + var du1 = dest_d.u1; + + // consume unaligned prefix + while(p != srcend_o && p & 3) { + du1[d++] = su8[p++]; + } + + // iterate over 32-bit aligned loads + if(su3) { + while (p < srcend_o - 3) { + var w = su3[p>>2]; + du1[d++] = w & 0xff; + du1[d++] = (w >>> 8) & 0xff; + du1[d++] = (w >>> 16) & 0xff; + du1[d++] = (w >>> 32) & 0xff; + p += 4; + } + } + + // handle unaligned suffix + while (p != srcend_o) + du1[d++] = su8[p++]; +} + +function h$_hs_text_encode_utf8(destp_v, destp_o, src_v, srcoff, srclen) { + var dest_v = destp_v.arr[destp_o][0]; + var dest_o = destp_v.arr[destp_o][1]; + var src = srcoff; + var dest = dest_o; + var srcend = src + srclen; + var srcu1 = src_v.u1; + if(!srcu1) throw "h$_hs_text_encode_utf8: invalid alignment for source"; + var srcu3 = src_v.u3; + var destu8 = dest_v.u8; + while(src < srcend) { + // run of (aligned) ascii characters + while(srcu3 && !(src & 1) && srcend - src >= 2) { + var w = srcu3[src>>1]; + if(w & 0xFF80FF80) break; + destu8[dest++] = w & 0xFFFF; + destu8[dest++] = w >>> 16; + src += 2; + } + while(src < srcend) { + var w = srcu1[src++]; + if(w <= 0x7F) { + destu8[dest++] = w; + break; // go back to a stream of ASCII + } else if(w <= 0x7FF) { + destu8[dest++] = (w >> 6) | 0xC0; + destu8[dest++] = (w & 0x3f) | 0x80; + } else if(w < 0xD800 || w > 0xDBFF) { + destu8[dest++] = (w >>> 12) | 0xE0; + destu8[dest++] = ((w >> 6) & 0x3F) | 0x80; + destu8[dest++] = (w & 0x3F) | 0x80; + } else { + var c = ((w - 0xD800) << 10) + (srcu1[src++] - 0xDC00) + 0x10000; + destu8[dest++] = (c >>> 18) | 0xF0; + destu8[dest++] = ((c >> 12) & 0x3F) | 0x80; + destu8[dest++] = ((c >> 6) & 0x3F) | 0x80; + destu8[dest++] = (c & 0x3F) | 0x80; + } + } + } + destp_v.arr[destp_o][1] = dest; +} diff --git a/lib/boot/shims/pkg/threefish_block.js b/lib/boot/shims/pkg/threefish_block.js new file mode 100644 index 00000000..2f0c46da --- /dev/null +++ b/lib/boot/shims/pkg/threefish_block.js @@ -0,0 +1,82 @@ +// generated by generate_threefish_block.hs +var h$Threefish_256_Process_Block; +h$Threefish_256_Process_Block=function(p,q,y,r){var m;m=p.i3;var a;a=q.i3;y=y.i3;var b,g,l,c,d,h,k,e,f,t,u,v,n,w,x;q=m[0];p=m[1];r=m[2];t=m[3];u=m[4];v=m[5];n=m[6];m=m[7];w=q^r^u^n^2851871266;x=p^t^v^m^466688986;b=a[0];g=a[1];c=a[2];d=a[3];h=a[4];k=a[5];e=a[6];f=a[7];a=(b&16777215)+(q&16777215);b=(a>>>24)+(b>>>24)+(q>>>24)+((g&65535)<<8)+((p&65535)<<8);l=((b>>>24)+(g>>>16)+(p>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(r&16777215)+0;b=(a>>>24)+(c>>>24)+(r>>>24)+0+((d&65535)<<8)+((t& +65535)<<8)+0;d=((b>>>24)+(d>>>16)+(t>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(u&16777215)+0;b=(a>>>24)+(h>>>24)+(u>>>24)+0+((k&65535)<<8)+((v&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(v>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(n&16777215);b=(a>>>24)+(e>>>24)+(n>>>24)+((f&65535)<<8)+((m&65535)<<8);f=((b>>>24)+(f>>>16)+(m>>>16)<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>> +16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<14|c>>>18)^l;c=(c<<14|a>>>18)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(f<<16|e>>>16)^k;e=(e<<16|a>>>16)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<20|f>>>12)^l;e=(a<<20|e>>>12)^g;a=(h&16777215)+(c& +16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<25|d>>>7)^k;c=(a<<25|c>>>7)^h;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<23|c>>>9)^l;c=(c<<23|a>>>9)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535); +h=b<<24|a&16777215;a=f;f=(e<<8|f>>>24)^k;e=(a<<8|e>>>24)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(f<<5|e>>>27)^l;e=(e<<5|a>>>27)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<5|d>>>27)^k;c=(a<<5|c>>>27)^h;a=(g&16777215)+(r&16777215);b=(a>>>24)+(g>>>24)+(r>>>24)+ +((l&65535)<<8)+((t&65535)<<8);l=((b>>>24)+(l>>>16)+(t>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(u&16777215)+0;b=(a>>>24)+(c>>>24)+(u>>>24)+0+((d&65535)<<8)+((v&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(v>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(n&16777215)+0;b=(a>>>24)+(h>>>24)+(n>>>24)+0+((k&65535)<<8)+((m&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(m>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(w&16777215)+1;b=(a>>>24)+(e>>>24)+(w>>>24)+0+((f&65535)<<8)+((x& +65535)<<8)+0;f=((b>>>24)+(f>>>16)+(x>>>16)+0<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<25|c>>>7)^l;c=(c<<25|a>>>7)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<1|f>>>31)^k;e=(a<<1|e>>>31)^h;a=(g&16777215)+(e&16777215);b=(a>>> +24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<14|f>>>18)^l;e=(a<<14|e>>>18)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(d<<12|c>>>20)^k;c=(c<<12|a>>>20)^h;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a& +16777215;a=d;d=(c<<26|d>>>6)^l;c=(a<<26|c>>>6)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(f<<22|e>>>10)^k;e=(e<<22|a>>>10)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=e^l;e=a^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8); +k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=c^k;c=a^h;a=(g&16777215)+(u&16777215);b=(a>>>24)+(g>>>24)+(u>>>24)+((l&65535)<<8)+((v&65535)<<8);l=((b>>>24)+(l>>>16)+(v>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(n&16777215)+0;b=(a>>>24)+(c>>>24)+(n>>>24)+0+((d&65535)<<8)+((m&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(m>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(w&16777215)+0;b=(a>>>24)+(h>>>24)+(w>>>24)+0+((k&65535)<<8)+((x&65535)<<8)+0;k=((b>>>24)+ +(k>>>16)+(x>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(q&16777215)+2;b=(a>>>24)+(e>>>24)+(q>>>24)+0+((f&65535)<<8)+((p&65535)<<8)+0;f=((b>>>24)+(f>>>16)+(p>>>16)+0<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<14|c>>>18)^l;c=(c<<14|a>>>18)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8); +k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(f<<16|e>>>16)^k;e=(e<<16|a>>>16)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<20|f>>>12)^l;e=(a<<20|e>>>12)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<25|d>>>7)^k;c=(a<<25|c>>>7)^h;a= +(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<23|c>>>9)^l;c=(c<<23|a>>>9)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<8|f>>>24)^k;e=(a<<8|e>>>24)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<< +16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(f<<5|e>>>27)^l;e=(e<<5|a>>>27)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<5|d>>>27)^k;c=(a<<5|c>>>27)^h;a=(g&16777215)+(n&16777215);b=(a>>>24)+(g>>>24)+(n>>>24)+((l&65535)<<8)+((m&65535)<<8);l=((b>>>24)+(l>>>16)+(m>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(w&16777215)+0;b=(a>>>24)+(c>>>24)+(w>>>24)+0+((d&65535)<<8)+((x& +65535)<<8)+0;d=((b>>>24)+(d>>>16)+(x>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(q&16777215)+0;b=(a>>>24)+(h>>>24)+(q>>>24)+0+((k&65535)<<8)+((p&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(p>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(r&16777215)+3;b=(a>>>24)+(e>>>24)+(r>>>24)+0+((f&65535)<<8)+((t&65535)<<8)+0;f=((b>>>24)+(f>>>16)+(t>>>16)+0<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>> +24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<25|c>>>7)^l;c=(c<<25|a>>>7)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<1|f>>>31)^k;e=(a<<1|e>>>31)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<14|f>>>18)^l;e=(a<<14|e>>>18)^g;a=(h&16777215)+ +(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(d<<12|c>>>20)^k;c=(c<<12|a>>>20)^h;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(c<<26|d>>>6)^l;c=(a<<26|c>>>6)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>> +8&65535);h=b<<24|a&16777215;a=f;f=(f<<22|e>>>10)^k;e=(e<<22|a>>>10)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=e^l;e=a^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=c^k;c=a^h;a=(g&16777215)+(w&16777215);b=(a>>>24)+(g>>>24)+(w>>>24)+((l&65535)<<8)+((x&65535)<<8);l=((b>>> +24)+(l>>>16)+(x>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(q&16777215)+0;b=(a>>>24)+(c>>>24)+(q>>>24)+0+((d&65535)<<8)+((p&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(p>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(r&16777215)+0;b=(a>>>24)+(h>>>24)+(r>>>24)+0+((k&65535)<<8)+((t&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(t>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(u&16777215)+4;b=(a>>>24)+(e>>>24)+(u>>>24)+0+((f&65535)<<8)+((v&65535)<<8)+0;f=((b>>>24)+(f>>>16)+(v>>> +16)+0<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<14|c>>>18)^l;c=(c<<14|a>>>18)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(f<<16|e>>>16)^k;e=(e<<16|a>>>16)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<< +8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<20|f>>>12)^l;e=(a<<20|e>>>12)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<25|d>>>7)^k;c=(a<<25|c>>>7)^h;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<23|c>>>9)^l;c=(c<< +23|a>>>9)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<8|f>>>24)^k;e=(a<<8|e>>>24)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(f<<5|e>>>27)^l;e=(e<<5|a>>>27)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>> +16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<5|d>>>27)^k;c=(a<<5|c>>>27)^h;a=(g&16777215)+(q&16777215);b=(a>>>24)+(g>>>24)+(q>>>24)+((l&65535)<<8)+((p&65535)<<8);l=((b>>>24)+(l>>>16)+(p>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(r&16777215)+0;b=(a>>>24)+(c>>>24)+(r>>>24)+0+((d&65535)<<8)+((t&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(t>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(u&16777215)+0;b=(a>>>24)+(h>>>24)+(u>>>24)+0+((k&65535)<<8)+((v&65535)<<8)+0;k= +((b>>>24)+(k>>>16)+(v>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(n&16777215)+5;b=(a>>>24)+(e>>>24)+(n>>>24)+0+((f&65535)<<8)+((m&65535)<<8)+0;f=((b>>>24)+(f>>>16)+(m>>>16)+0<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<25|c>>>7)^l;c=(c<<25|a>>>7)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<< +8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<1|f>>>31)^k;e=(a<<1|e>>>31)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<14|f>>>18)^l;e=(a<<14|e>>>18)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(d<<12|c>>>20)^k;c=(c<<12|a>>>20)^h; +a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(c<<26|d>>>6)^l;c=(a<<26|c>>>6)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(f<<22|e>>>10)^k;e=(e<<22|a>>>10)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>> +16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=e^l;e=a^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=c^k;c=a^h;a=(g&16777215)+(r&16777215);b=(a>>>24)+(g>>>24)+(r>>>24)+((l&65535)<<8)+((t&65535)<<8);l=((b>>>24)+(l>>>16)+(t>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(u&16777215)+0;b=(a>>>24)+(c>>>24)+(u>>>24)+0+((d&65535)<<8)+((v&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(v>>>16)+ +0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(n&16777215)+0;b=(a>>>24)+(h>>>24)+(n>>>24)+0+((k&65535)<<8)+((m&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(m>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(w&16777215)+6;b=(a>>>24)+(e>>>24)+(w>>>24)+0+((f&65535)<<8)+((x&65535)<<8)+0;f=((b>>>24)+(f>>>16)+(x>>>16)+0<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<< +24|a&16777215;a=d;d=(d<<14|c>>>18)^l;c=(c<<14|a>>>18)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(f<<16|e>>>16)^k;e=(e<<16|a>>>16)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<20|f>>>12)^l;e=(a<<20|e>>>12)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>> +24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<25|d>>>7)^k;c=(a<<25|c>>>7)^h;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<23|c>>>9)^l;c=(c<<23|a>>>9)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<8| +f>>>24)^k;e=(a<<8|e>>>24)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(f<<5|e>>>27)^l;e=(e<<5|a>>>27)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<5|d>>>27)^k;c=(a<<5|c>>>27)^h;a=(g&16777215)+(u&16777215);b=(a>>>24)+(g>>>24)+(u>>>24)+((l&65535)<<8)+((v&65535)<<8); +l=((b>>>24)+(l>>>16)+(v>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(n&16777215)+0;b=(a>>>24)+(c>>>24)+(n>>>24)+0+((d&65535)<<8)+((m&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(m>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(w&16777215)+0;b=(a>>>24)+(h>>>24)+(w>>>24)+0+((k&65535)<<8)+((x&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(x>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(q&16777215)+7;b=(a>>>24)+(e>>>24)+(q>>>24)+0+((f&65535)<<8)+((p&65535)<<8)+0;f=((b>>>24)+(f>>> +16)+(p>>>16)+0<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<25|c>>>7)^l;c=(c<<25|a>>>7)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<1|f>>>31)^k;e=(a<<1|e>>>31)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l& +65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<14|f>>>18)^l;e=(a<<14|e>>>18)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(d<<12|c>>>20)^k;c=(c<<12|a>>>20)^h;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(c<<26|d>>> +6)^l;c=(a<<26|c>>>6)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(f<<22|e>>>10)^k;e=(e<<22|a>>>10)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=e^l;e=a^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>> +16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=c^k;c=a^h;a=(g&16777215)+(n&16777215);b=(a>>>24)+(g>>>24)+(n>>>24)+((l&65535)<<8)+((m&65535)<<8);l=((b>>>24)+(l>>>16)+(m>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(w&16777215)+0;b=(a>>>24)+(c>>>24)+(w>>>24)+0+((d&65535)<<8)+((x&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(x>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(q&16777215)+0;b=(a>>>24)+(h>>>24)+(q>>>24)+0+((k&65535)<<8)+((p&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(p>>>16)+0<<16)+ +(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(r&16777215)+8;b=(a>>>24)+(e>>>24)+(r>>>24)+0+((f&65535)<<8)+((t&65535)<<8)+0;f=((b>>>24)+(f>>>16)+(t>>>16)+0<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<14|c>>>18)^l;c=(c<<14|a>>>18)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>> +16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(f<<16|e>>>16)^k;e=(e<<16|a>>>16)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<20|f>>>12)^l;e=(a<<20|e>>>12)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<25|d>>>7)^k;c=(a<<25|c>>>7)^h;a=(g&16777215)+(c&16777215); +b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<23|c>>>9)^l;c=(c<<23|a>>>9)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<8|f>>>24)^k;e=(a<<8|e>>>24)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24| +a&16777215;a=f;f=(f<<5|e>>>27)^l;e=(e<<5|a>>>27)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<5|d>>>27)^k;c=(a<<5|c>>>27)^h;a=(g&16777215)+(w&16777215);b=(a>>>24)+(g>>>24)+(w>>>24)+((l&65535)<<8)+((x&65535)<<8);l=((b>>>24)+(l>>>16)+(x>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(q&16777215)+0;b=(a>>>24)+(c>>>24)+(q>>>24)+0+((d&65535)<<8)+((p&65535)<<8)+0;d=((b>>>24)+ +(d>>>16)+(p>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(r&16777215)+0;b=(a>>>24)+(h>>>24)+(r>>>24)+0+((k&65535)<<8)+((t&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(t>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(u&16777215)+9;b=(a>>>24)+(e>>>24)+(u>>>24)+0+((f&65535)<<8)+((v&65535)<<8)+0;f=((b>>>24)+(f>>>16)+(v>>>16)+0<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+ +(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<25|c>>>7)^l;c=(c<<25|a>>>7)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<1|f>>>31)^k;e=(a<<1|e>>>31)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<14|f>>>18)^l;e=(a<<14|e>>>18)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+ +(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(d<<12|c>>>20)^k;c=(c<<12|a>>>20)^h;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(c<<26|d>>>6)^l;c=(a<<26|c>>>6)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215; +a=f;f=(f<<22|e>>>10)^k;e=(e<<22|a>>>10)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=e^l;e=a^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=c^k;c=a^h;a=(g&16777215)+(q&16777215);b=(a>>>24)+(g>>>24)+(q>>>24)+((l&65535)<<8)+((p&65535)<<8);l=((b>>>24)+(l>>>16)+(p>>>16)<<16)+ +(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(r&16777215)+0;b=(a>>>24)+(c>>>24)+(r>>>24)+0+((d&65535)<<8)+((t&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(t>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(u&16777215)+0;b=(a>>>24)+(h>>>24)+(u>>>24)+0+((k&65535)<<8)+((v&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(v>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(n&16777215)+10;b=(a>>>24)+(e>>>24)+(n>>>24)+0+((f&65535)<<8)+((m&65535)<<8)+0;f=((b>>>24)+(f>>>16)+(m>>>16)+0<<16)+(b>>8&65535);e= +b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<14|c>>>18)^l;c=(c<<14|a>>>18)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(f<<16|e>>>16)^k;e=(e<<16|a>>>16)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>> +24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<20|f>>>12)^l;e=(a<<20|e>>>12)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<25|d>>>7)^k;c=(a<<25|c>>>7)^h;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<23|c>>>9)^l;c=(c<<23|a>>>9)^g;a=(h&16777215)+ +(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<8|f>>>24)^k;e=(a<<8|e>>>24)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(f<<5|e>>>27)^l;e=(e<<5|a>>>27)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8& +65535);h=b<<24|a&16777215;a=d;d=(c<<5|d>>>27)^k;c=(a<<5|c>>>27)^h;a=(g&16777215)+(r&16777215);b=(a>>>24)+(g>>>24)+(r>>>24)+((l&65535)<<8)+((t&65535)<<8);l=((b>>>24)+(l>>>16)+(t>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(u&16777215)+0;b=(a>>>24)+(c>>>24)+(u>>>24)+0+((d&65535)<<8)+((v&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(v>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(n&16777215)+0;b=(a>>>24)+(h>>>24)+(n>>>24)+0+((k&65535)<<8)+((m&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(m>>> +16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(w&16777215)+11;b=(a>>>24)+(e>>>24)+(w>>>24)+0+((f&65535)<<8)+((x&65535)<<8)+0;f=((b>>>24)+(f>>>16)+(x>>>16)+0<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<25|c>>>7)^l;c=(c<<25|a>>>7)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>> +16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<1|f>>>31)^k;e=(a<<1|e>>>31)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<14|f>>>18)^l;e=(a<<14|e>>>18)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(d<<12|c>>>20)^k;c=(c<<12|a>>>20)^h;a=(g&16777215)+(c&16777215); +b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(c<<26|d>>>6)^l;c=(a<<26|c>>>6)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(f<<22|e>>>10)^k;e=(e<<22|a>>>10)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<< +24|a&16777215;a=f;f=e^l;e=a^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=c^k;c=a^h;a=(g&16777215)+(u&16777215);b=(a>>>24)+(g>>>24)+(u>>>24)+((l&65535)<<8)+((v&65535)<<8);l=((b>>>24)+(l>>>16)+(v>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(n&16777215)+0;b=(a>>>24)+(c>>>24)+(n>>>24)+0+((d&65535)<<8)+((m&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(m>>>16)+0<<16)+(b>>8&65535);c=b<< +24|a&16777215;a=(h&16777215)+(w&16777215)+0;b=(a>>>24)+(h>>>24)+(w>>>24)+0+((k&65535)<<8)+((x&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(x>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(q&16777215)+12;b=(a>>>24)+(e>>>24)+(q>>>24)+0+((f&65535)<<8)+((p&65535)<<8)+0;f=((b>>>24)+(f>>>16)+(p>>>16)+0<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<< +14|c>>>18)^l;c=(c<<14|a>>>18)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(f<<16|e>>>16)^k;e=(e<<16|a>>>16)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<20|f>>>12)^l;e=(a<<20|e>>>12)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<< +8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<25|d>>>7)^k;c=(a<<25|c>>>7)^h;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<23|c>>>9)^l;c=(c<<23|a>>>9)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<8|f>>>24)^k;e=(a<<8|e>>>24)^h;a=(g& +16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(f<<5|e>>>27)^l;e=(e<<5|a>>>27)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<5|d>>>27)^k;c=(a<<5|c>>>27)^h;a=(g&16777215)+(n&16777215);b=(a>>>24)+(g>>>24)+(n>>>24)+((l&65535)<<8)+((m&65535)<<8);l=((b>>>24)+(l>>>16)+(m>>>16)<< +16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(w&16777215)+0;b=(a>>>24)+(c>>>24)+(w>>>24)+0+((d&65535)<<8)+((x&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(x>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(q&16777215)+0;b=(a>>>24)+(h>>>24)+(q>>>24)+0+((k&65535)<<8)+((p&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(p>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(r&16777215)+13;b=(a>>>24)+(e>>>24)+(r>>>24)+0+((f&65535)<<8)+((t&65535)<<8)+0;f=((b>>>24)+(f>>>16)+(t>>>16)+0<<16)+(b>>8&65535); +e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<25|c>>>7)^l;c=(c<<25|a>>>7)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<1|f>>>31)^k;e=(a<<1|e>>>31)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>> +24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<14|f>>>18)^l;e=(a<<14|e>>>18)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(d<<12|c>>>20)^k;c=(c<<12|a>>>20)^h;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(c<<26|d>>>6)^l;c=(a<<26|c>>>6)^g;a=(h&16777215)+ +(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(f<<22|e>>>10)^k;e=(e<<22|a>>>10)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=e^l;e=a^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215; +a=d;d=c^k;c=a^h;a=(g&16777215)+(w&16777215);b=(a>>>24)+(g>>>24)+(w>>>24)+((l&65535)<<8)+((x&65535)<<8);l=((b>>>24)+(l>>>16)+(x>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(q&16777215)+0;b=(a>>>24)+(c>>>24)+(q>>>24)+0+((d&65535)<<8)+((p&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(p>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(r&16777215)+0;b=(a>>>24)+(h>>>24)+(r>>>24)+0+((k&65535)<<8)+((t&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(t>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+ +(u&16777215)+14;b=(a>>>24)+(e>>>24)+(u>>>24)+0+((f&65535)<<8)+((v&65535)<<8)+0;f=((b>>>24)+(f>>>16)+(v>>>16)+0<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<14|c>>>18)^l;c=(c<<14|a>>>18)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f; +f=(f<<16|e>>>16)^k;e=(e<<16|a>>>16)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<20|f>>>12)^l;e=(a<<20|e>>>12)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<25|d>>>7)^k;c=(a<<25|c>>>7)^h;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d& +65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<23|c>>>9)^l;c=(c<<23|a>>>9)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<8|f>>>24)^k;e=(a<<8|e>>>24)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(f<<5|e>>>27)^l;e=(e<<5|a>>>27)^ +g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<5|d>>>27)^k;c=(a<<5|c>>>27)^h;a=(g&16777215)+(q&16777215);b=(a>>>24)+(g>>>24)+(q>>>24)+((l&65535)<<8)+((p&65535)<<8);l=((b>>>24)+(l>>>16)+(p>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(r&16777215)+0;b=(a>>>24)+(c>>>24)+(r>>>24)+0+((d&65535)<<8)+((t&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(t>>>16)+0<<16)+(b>>8&65535);c=b<<24| +a&16777215;a=(h&16777215)+(u&16777215)+0;b=(a>>>24)+(h>>>24)+(u>>>24)+0+((k&65535)<<8)+((v&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(v>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(n&16777215)+15;b=(a>>>24)+(e>>>24)+(n>>>24)+0+((f&65535)<<8)+((m&65535)<<8)+0;f=((b>>>24)+(f>>>16)+(m>>>16)+0<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<25| +c>>>7)^l;c=(c<<25|a>>>7)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<1|f>>>31)^k;e=(a<<1|e>>>31)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<14|f>>>18)^l;e=(a<<14|e>>>18)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<< +8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(d<<12|c>>>20)^k;c=(c<<12|a>>>20)^h;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(c<<26|d>>>6)^l;c=(a<<26|c>>>6)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(f<<22|e>>>10)^k;e=(e<<22|a>>>10)^h; +a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=e^l;e=a^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=c^k;c=a^h;a=(g&16777215)+(r&16777215);b=(a>>>24)+(g>>>24)+(r>>>24)+((l&65535)<<8)+((t&65535)<<8);l=((b>>>24)+(l>>>16)+(t>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+ +(u&16777215)+0;b=(a>>>24)+(c>>>24)+(u>>>24)+0+((d&65535)<<8)+((v&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(v>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(n&16777215)+0;b=(a>>>24)+(h>>>24)+(n>>>24)+0+((k&65535)<<8)+((m&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(m>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(w&16777215)+16;b=(a>>>24)+(e>>>24)+(w>>>24)+0+((f&65535)<<8)+((x&65535)<<8)+0;f=((b>>>24)+(f>>>16)+(x>>>16)+0<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b= +(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<14|c>>>18)^l;c=(c<<14|a>>>18)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(f<<16|e>>>16)^k;e=(e<<16|a>>>16)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<< +24|a&16777215;a=f;f=(e<<20|f>>>12)^l;e=(a<<20|e>>>12)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<25|d>>>7)^k;c=(a<<25|c>>>7)^h;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<23|c>>>9)^l;c=(c<<23|a>>>9)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+ +((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(e<<8|f>>>24)^k;e=(a<<8|e>>>24)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(f<<5|e>>>27)^l;e=(e<<5|a>>>27)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(c<<5|d>>> +27)^k;c=(a<<5|c>>>27)^h;a=(g&16777215)+(u&16777215);b=(a>>>24)+(g>>>24)+(u>>>24)+((l&65535)<<8)+((v&65535)<<8);l=((b>>>24)+(l>>>16)+(v>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(n&16777215)+0;b=(a>>>24)+(c>>>24)+(n>>>24)+0+((d&65535)<<8)+((m&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(m>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(w&16777215)+0;b=(a>>>24)+(h>>>24)+(w>>>24)+0+((k&65535)<<8)+((x&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(x>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215; +a=(e&16777215)+(q&16777215)+17;b=(a>>>24)+(e>>>24)+(q>>>24)+0+((f&65535)<<8)+((p&65535)<<8)+0;f=((b>>>24)+(f>>>16)+(p>>>16)+0<<16)+(b>>8&65535);e=b<<24|a&16777215;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l&65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(d<<25|c>>>7)^l;c=(c<<25|a>>>7)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a& +16777215;a=f;f=(e<<1|f>>>31)^k;e=(a<<1|e>>>31)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=(e<<14|f>>>18)^l;e=(a<<14|e>>>18)^g;a=(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=(d<<12|c>>>20)^k;c=(c<<12|a>>>20)^h;a=(g&16777215)+(c&16777215);b=(a>>>24)+(g>>>24)+(c>>>24)+((l& +65535)<<8)+((d&65535)<<8);l=((b>>>24)+(l>>>16)+(d>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=d;d=(c<<26|d>>>6)^l;c=(a<<26|c>>>6)^g;a=(h&16777215)+(e&16777215);b=(a>>>24)+(h>>>24)+(e>>>24)+((k&65535)<<8)+((f&65535)<<8);k=((b>>>24)+(k>>>16)+(f>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=f;f=(f<<22|e>>>10)^k;e=(e<<22|a>>>10)^h;a=(g&16777215)+(e&16777215);b=(a>>>24)+(g>>>24)+(e>>>24)+((l&65535)<<8)+((f&65535)<<8);l=((b>>>24)+(l>>>16)+(f>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=f;f=e^l;e=a^g;a= +(h&16777215)+(c&16777215);b=(a>>>24)+(h>>>24)+(c>>>24)+((k&65535)<<8)+((d&65535)<<8);k=((b>>>24)+(k>>>16)+(d>>>16)<<16)+(b>>8&65535);h=b<<24|a&16777215;a=d;d=c^k;c=a^h;a=(g&16777215)+(n&16777215);b=(a>>>24)+(g>>>24)+(n>>>24)+((l&65535)<<8)+((m&65535)<<8);l=((b>>>24)+(l>>>16)+(m>>>16)<<16)+(b>>8&65535);g=b<<24|a&16777215;a=(c&16777215)+(w&16777215)+0;b=(a>>>24)+(c>>>24)+(w>>>24)+0+((d&65535)<<8)+((x&65535)<<8)+0;d=((b>>>24)+(d>>>16)+(x>>>16)+0<<16)+(b>>8&65535);c=b<<24|a&16777215;a=(h&16777215)+(q& +16777215)+0;b=(a>>>24)+(h>>>24)+(q>>>24)+0+((k&65535)<<8)+((p&65535)<<8)+0;k=((b>>>24)+(k>>>16)+(p>>>16)+0<<16)+(b>>8&65535);h=b<<24|a&16777215;a=(e&16777215)+(r&16777215)+18;b=(a>>>24)+(e>>>24)+(r>>>24)+0+((f&65535)<<8)+((t&65535)<<8)+0;y[0]=g;y[1]=l;y[2]=c;y[3]=d;y[4]=h;y[5]=k;y[6]=b<<24|a&16777215;y[7]=((b>>>24)+(f>>>16)+(t>>>16)+0<<16)+(b>>8&65535)};"undefined"!==typeof exports&&(exports.h$Threefish_256_Process_Block=h$Threefish_256_Process_Block); diff --git a/lib/boot/shims/pkg/time.js b/lib/boot/shims/pkg/time.js new file mode 100644 index 00000000..f09bab40 --- /dev/null +++ b/lib/boot/shims/pkg/time.js @@ -0,0 +1,29 @@ +function h$get_current_timezone_seconds(t, pdst_v, pdst_o, pname_v, pname_o) { + var d = new Date(t * 1000); + var now = new Date(); + var jan = new Date(now.getFullYear(),0,1); + var jul = new Date(now.getFullYear(),6,1); + var stdOff = Math.max(jan.getTimezoneOffset(), jul.getTimezoneOffset()); + var isDst = d.getTimezoneOffset() < stdOff; + var tzo = d.getTimezoneOffset(); + pdst_v.dv.setInt32(pdst_o, isDst ? 1 : 0, true); + if(!pname_v.arr) pname_v.arr = []; + var offstr = tzo < 0 ? ('+' + (tzo/-60)) : ('' + (tzo/-60)); + pname_v.arr[pname_o] = [h$encodeUtf8("UTC" + offstr), 0]; + return (-60*tzo)|0; +} + +function h$clock_gettime(when, p_d, p_o) { +/* h$log("clock_gettime"); + h$log(when); + h$log(p_d); + h$log(p_o); */ + + var o = p_o >> 2, + t = Date.now ? Date.now() : new Date().getTime(), + tf = Math.floor(t / 1000), + tn = 1000000 * (t - (1000 * tf)); + p_d.i3[o] = tf|0; + p_d.i3[o+1] = tn|0; + return 0; +} diff --git a/lib/boot/shims/pkg/webkit-dom.js b/lib/boot/shims/pkg/webkit-dom.js new file mode 100644 index 00000000..5e544e61 --- /dev/null +++ b/lib/boot/shims/pkg/webkit-dom.js @@ -0,0 +1,13703 @@ +// Graphics.UI.Gtk.WebKit.DOM.Xpath +h$webkit_dom_xpath_result_get_type = (function() + { + return h$g_get_type(XPathResult); + }); +var h$webkit_dom_xpath_result_iterate_next; +h$webkit_dom_xpath_result_iterate_next = (function(self, + self_2) + { + h$ret1 = 0; + return self["iterateNext"](); + }); +var h$webkit_dom_xpath_result_snapshot_item; +h$webkit_dom_xpath_result_snapshot_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["snapshotItem"](index); + }); +var h$webkit_dom_xpath_result_get_result_type; +h$webkit_dom_xpath_result_get_result_type = (function(self, + self_2) + { + return self["resultType"]; + }); +var h$webkit_dom_xpath_result_get_number_value; +h$webkit_dom_xpath_result_get_number_value = (function(self, + self_2) + { + return self["numberValue"]; + }); +var h$webkit_dom_xpath_result_get_string_value; +h$webkit_dom_xpath_result_get_string_value = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["stringValue"]); + }); +var h$webkit_dom_xpath_result_get_boolean_value; +h$webkit_dom_xpath_result_get_boolean_value = (function(self, + self_2) + { + return self["booleanValue"]; + }); +var h$webkit_dom_xpath_result_get_single_node_value; +h$webkit_dom_xpath_result_get_single_node_value = (function(self, + self_2) + { + h$ret1 = 0; + return self["singleNodeValue"]; + }); +var h$webkit_dom_xpath_result_get_invalid_iterator_state; +h$webkit_dom_xpath_result_get_invalid_iterator_state = (function(self, + self_2) + { + return self["invalidIteratorState"]; + }); +var h$webkit_dom_xpath_result_get_snapshot_length; +h$webkit_dom_xpath_result_get_snapshot_length = (function(self, + self_2) + { + return self["snapshotLength"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Xpath +h$webkit_dom_xpath_ns_resolver_get_type = (function() + { + return h$g_get_type(XPathNSResolver); + }); +var h$webkit_dom_xpath_ns_resolver_lookup_namespace_uri; +h$webkit_dom_xpath_ns_resolver_lookup_namespace_uri = (function(self, + self_2, prefix, prefix_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["lookupNamespaceURI"](h$decodeUtf8z(prefix, + prefix_2))); + }); +// Graphics.UI.Gtk.WebKit.DOM.Xpath +h$webkit_dom_xpath_expression_get_type = (function() + { + return h$g_get_type(XPathExpression); + }); +var h$webkit_dom_xpath_expression_evaluate; +h$webkit_dom_xpath_expression_evaluate = (function(self, + self_2, contextNode, + contextNode_2, type, inResult, + inResult_2) + { + h$ret1 = 0; + return self["evaluate"](contextNode, + type, inResult); + }); +// Graphics.UI.Gtk.WebKit.DOM.Xml +h$webkit_dom_xml_http_request_get_type = (function() + { + return h$g_get_type(XMLHttpRequest); + }); +var h$webkit_dom_xml_http_request_set_request_header; +h$webkit_dom_xml_http_request_set_request_header = (function(self, + self_2, header, header_2, + value, value_2) + { + return self["setRequestHeader"](h$decodeUtf8z(header, + header_2), + h$decodeUtf8z(value, + value_2)); + }); +var h$webkit_dom_xml_http_request_abort; +h$webkit_dom_xml_http_request_abort = (function(self, + self_2) + { + return self["abort"](); + }); +var h$webkit_dom_xml_http_request_get_all_response_headers; +h$webkit_dom_xml_http_request_get_all_response_headers = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["getAllResponseHeaders"]()); + }); +var h$webkit_dom_xml_http_request_get_response_header; +h$webkit_dom_xml_http_request_get_response_header = (function(self, + self_2, header, header_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["getResponseHeader"](h$decodeUtf8z(header, + header_2))); + }); +var h$webkit_dom_xml_http_request_override_mime_type; +h$webkit_dom_xml_http_request_override_mime_type = (function(self, + self_2, override, + override_2) + { + return self["overrideMimeType"](h$decodeUtf8z(override, + override_2)); + }); +var h$webkit_dom_xml_http_request_dispatch_event; +h$webkit_dom_xml_http_request_dispatch_event = (function(self, + self_2, evt, evt_2) + { + return self["dispatchEvent"](evt); + }); +var h$webkit_dom_xml_http_request_set_onabort; +h$webkit_dom_xml_http_request_set_onabort = (function(self, + self_2, val, val_2) + { + self["onabort"] = val; + }); +var h$webkit_dom_xml_http_request_get_onabort; +h$webkit_dom_xml_http_request_get_onabort = (function(self, + self_2) + { + h$ret1 = 0; + return self["onabort"]; + }); +var h$webkit_dom_xml_http_request_set_onerror; +h$webkit_dom_xml_http_request_set_onerror = (function(self, + self_2, val, val_2) + { + self["onerror"] = val; + }); +var h$webkit_dom_xml_http_request_get_onerror; +h$webkit_dom_xml_http_request_get_onerror = (function(self, + self_2) + { + h$ret1 = 0; + return self["onerror"]; + }); +var h$webkit_dom_xml_http_request_set_onload; +h$webkit_dom_xml_http_request_set_onload = (function(self, + self_2, val, val_2) + { + self["onload"] = val; + }); +var h$webkit_dom_xml_http_request_get_onload; +h$webkit_dom_xml_http_request_get_onload = (function(self, + self_2) + { + h$ret1 = 0; + return self["onload"]; + }); +var h$webkit_dom_xml_http_request_set_onloadend; +h$webkit_dom_xml_http_request_set_onloadend = (function(self, + self_2, val, val_2) + { + self["onloadend"] = val; + }); +var h$webkit_dom_xml_http_request_get_onloadend; +h$webkit_dom_xml_http_request_get_onloadend = (function(self, + self_2) + { + h$ret1 = 0; + return self["onloadend"]; + }); +var h$webkit_dom_xml_http_request_set_onloadstart; +h$webkit_dom_xml_http_request_set_onloadstart = (function(self, + self_2, val, val_2) + { + self["onloadstart"] = val; + }); +var h$webkit_dom_xml_http_request_get_onloadstart; +h$webkit_dom_xml_http_request_get_onloadstart = (function(self, + self_2) + { + h$ret1 = 0; + return self["onloadstart"]; + }); +var h$webkit_dom_xml_http_request_set_onprogress; +h$webkit_dom_xml_http_request_set_onprogress = (function(self, + self_2, val, val_2) + { + self["onprogress"] = val; + }); +var h$webkit_dom_xml_http_request_get_onprogress; +h$webkit_dom_xml_http_request_get_onprogress = (function(self, + self_2) + { + h$ret1 = 0; + return self["onprogress"]; + }); +var h$webkit_dom_xml_http_request_set_onreadystatechange; +h$webkit_dom_xml_http_request_set_onreadystatechange = (function(self, + self_2, val, val_2) + { + self["onreadystatechange"] = val; + }); +var h$webkit_dom_xml_http_request_get_onreadystatechange; +h$webkit_dom_xml_http_request_get_onreadystatechange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onreadystatechange"]; + }); +var h$webkit_dom_xml_http_request_get_ready_state; +h$webkit_dom_xml_http_request_get_ready_state = (function(self, + self_2) + { + return self["readyState"]; + }); +var h$webkit_dom_xml_http_request_set_with_credentials; +h$webkit_dom_xml_http_request_set_with_credentials = (function(self, + self_2, val) + { + self["withCredentials"] = val; + }); +var h$webkit_dom_xml_http_request_get_with_credentials; +h$webkit_dom_xml_http_request_get_with_credentials = (function(self, + self_2) + { + return self["withCredentials"]; + }); +var h$webkit_dom_xml_http_request_get_upload; +h$webkit_dom_xml_http_request_get_upload = (function(self, + self_2) + { + h$ret1 = 0; + return self["upload"]; + }); +var h$webkit_dom_xml_http_request_get_response_xml; +h$webkit_dom_xml_http_request_get_response_xml = (function(self, + self_2) + { + h$ret1 = 0; + return self["responseXML"]; + }); +var h$webkit_dom_xml_http_request_set_response_type; +h$webkit_dom_xml_http_request_set_response_type = (function(self, + self_2, val, val_2) + { + self["responseType"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_xml_http_request_get_response_type; +h$webkit_dom_xml_http_request_get_response_type = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["responseType"]); + }); +var h$webkit_dom_xml_http_request_get_status; +h$webkit_dom_xml_http_request_get_status = (function(self, + self_2) + { + return self["status"]; + }); +var h$webkit_dom_xml_http_request_get_status_text; +h$webkit_dom_xml_http_request_get_status_text = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["statusText"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Window +h$webkit_dom_webkit_point_get_type = (function() + { + return h$g_get_type(WebKitPoint); + }); +var h$webkit_dom_webkit_point_set_x; +h$webkit_dom_webkit_point_set_x = (function(self, + self_2, val) + { + self["x"] = val; + }); +var h$webkit_dom_webkit_point_get_x; +h$webkit_dom_webkit_point_get_x = (function(self, + self_2) + { + return self["x"]; + }); +var h$webkit_dom_webkit_point_set_y; +h$webkit_dom_webkit_point_set_y = (function(self, + self_2, val) + { + self["y"] = val; + }); +var h$webkit_dom_webkit_point_get_y; +h$webkit_dom_webkit_point_get_y = (function(self, + self_2) + { + return self["y"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_webkit_named_flow_get_type = (function() + { + return h$g_get_type(WebKitNamedFlow); + }); +var h$webkit_dom_webkit_named_flow_get_regions_by_content; +h$webkit_dom_webkit_named_flow_get_regions_by_content = (function(self, + self_2, contentNode, + contentNode_2) + { + h$ret1 = 0; + return self["getRegionsByContent"](contentNode); + }); +var h$webkit_dom_webkit_named_flow_get_regions; +h$webkit_dom_webkit_named_flow_get_regions = (function(self, + self_2) + { + h$ret1 = 0; + return self["getRegions"](); + }); +var h$webkit_dom_webkit_named_flow_get_content; +h$webkit_dom_webkit_named_flow_get_content = (function(self, + self_2) + { + h$ret1 = 0; + return self["getContent"](); + }); +var h$webkit_dom_webkit_named_flow_dispatch_event; +h$webkit_dom_webkit_named_flow_dispatch_event = (function(self, + self_2, event, event_2) + { + return self["dispatchEvent"](event); + }); +var h$webkit_dom_webkit_named_flow_get_name; +h$webkit_dom_webkit_named_flow_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_webkit_named_flow_get_overset; +h$webkit_dom_webkit_named_flow_get_overset = (function(self, + self_2) + { + return self["overset"]; + }); +var h$webkit_dom_webkit_named_flow_get_first_empty_region_index; +h$webkit_dom_webkit_named_flow_get_first_empty_region_index = (function(self, + self_2) + { + return self["firstEmptyRegionIndex"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_webkit_animation_list_get_type = (function() + { + return h$g_get_type(WebKitAnimationList); + }); +var h$webkit_dom_webkit_animation_list_item; +h$webkit_dom_webkit_animation_list_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["item"](index); + }); +var h$webkit_dom_webkit_animation_list_get_length; +h$webkit_dom_webkit_animation_list_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_webkit_animation_get_type = (function() + { + return h$g_get_type(WebKitAnimation); + }); +var h$webkit_dom_webkit_animation_play; +h$webkit_dom_webkit_animation_play = (function(self, + self_2) + { + return self["play"](); + }); +var h$webkit_dom_webkit_animation_pause; +h$webkit_dom_webkit_animation_pause = (function(self, + self_2) + { + return self["pause"](); + }); +var h$webkit_dom_webkit_animation_get_name; +h$webkit_dom_webkit_animation_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_webkit_animation_get_duration; +h$webkit_dom_webkit_animation_get_duration = (function(self, + self_2) + { + return self["duration"]; + }); +var h$webkit_dom_webkit_animation_set_elapsed_time; +h$webkit_dom_webkit_animation_set_elapsed_time = (function(self, + self_2, val) + { + self["elapsedTime"] = val; + }); +var h$webkit_dom_webkit_animation_get_elapsed_time; +h$webkit_dom_webkit_animation_get_elapsed_time = (function(self, + self_2) + { + return self["elapsedTime"]; + }); +var h$webkit_dom_webkit_animation_get_delay; +h$webkit_dom_webkit_animation_get_delay = (function(self, + self_2) + { + return self["delay"]; + }); +var h$webkit_dom_webkit_animation_get_paused; +h$webkit_dom_webkit_animation_get_paused = (function(self, + self_2) + { + return self["paused"]; + }); +var h$webkit_dom_webkit_animation_get_ended; +h$webkit_dom_webkit_animation_get_ended = (function(self, + self_2) + { + return self["ended"]; + }); +var h$webkit_dom_webkit_animation_get_direction; +h$webkit_dom_webkit_animation_get_direction = (function(self, + self_2) + { + return self["direction"]; + }); +var h$webkit_dom_webkit_animation_get_fill_mode; +h$webkit_dom_webkit_animation_get_fill_mode = (function(self, + self_2) + { + return self["fillMode"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Events +h$webkit_dom_ui_event_get_type = (function() + { + return h$g_get_type(UIEvent); + }); +var h$webkit_dom_ui_event_init_ui_event; +h$webkit_dom_ui_event_init_ui_event = (function(self, + self_2, type, type_2, canBubble, + cancelable, view, view_2, + detail) + { + return self["initUIEvent"](h$decodeUtf8z(type, + type_2), canBubble, cancelable, + view, detail); + }); +var h$webkit_dom_ui_event_get_view; +h$webkit_dom_ui_event_get_view = (function(self, + self_2) + { + h$ret1 = 0; + return self["view"]; + }); +var h$webkit_dom_ui_event_get_detail; +h$webkit_dom_ui_event_get_detail = (function(self, + self_2) + { + return self["detail"]; + }); +var h$webkit_dom_ui_event_get_key_code; +h$webkit_dom_ui_event_get_key_code = (function(self, + self_2) + { + return self["keyCode"]; + }); +var h$webkit_dom_ui_event_get_char_code; +h$webkit_dom_ui_event_get_char_code = (function(self, + self_2) + { + return self["charCode"]; + }); +var h$webkit_dom_ui_event_get_layer_x; +h$webkit_dom_ui_event_get_layer_x = (function(self, + self_2) + { + return self["layerX"]; + }); +var h$webkit_dom_ui_event_get_layer_y; +h$webkit_dom_ui_event_get_layer_y = (function(self, + self_2) + { + return self["layerY"]; + }); +var h$webkit_dom_ui_event_get_page_x; +h$webkit_dom_ui_event_get_page_x = (function(self, + self_2) + { + return self["pageX"]; + }); +var h$webkit_dom_ui_event_get_page_y; +h$webkit_dom_ui_event_get_page_y = (function(self, + self_2) + { + return self["pageY"]; + }); +var h$webkit_dom_ui_event_get_which; +h$webkit_dom_ui_event_get_which = (function(self, + self_2) + { + return self["which"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_validity_state_get_type = (function() + { + return h$g_get_type(ValidityState); + }); +var h$webkit_dom_validity_state_get_value_missing; +h$webkit_dom_validity_state_get_value_missing = (function(self, + self_2) + { + return self["valueMissing"]; + }); +var h$webkit_dom_validity_state_get_type_mismatch; +h$webkit_dom_validity_state_get_type_mismatch = (function(self, + self_2) + { + return self["typeMismatch"]; + }); +var h$webkit_dom_validity_state_get_pattern_mismatch; +h$webkit_dom_validity_state_get_pattern_mismatch = (function(self, + self_2) + { + return self["patternMismatch"]; + }); +var h$webkit_dom_validity_state_get_too_long; +h$webkit_dom_validity_state_get_too_long = (function(self, + self_2) + { + return self["tooLong"]; + }); +var h$webkit_dom_validity_state_get_range_underflow; +h$webkit_dom_validity_state_get_range_underflow = (function(self, + self_2) + { + return self["rangeUnderflow"]; + }); +var h$webkit_dom_validity_state_get_range_overflow; +h$webkit_dom_validity_state_get_range_overflow = (function(self, + self_2) + { + return self["rangeOverflow"]; + }); +var h$webkit_dom_validity_state_get_step_mismatch; +h$webkit_dom_validity_state_get_step_mismatch = (function(self, + self_2) + { + return self["stepMismatch"]; + }); +var h$webkit_dom_validity_state_get_custom_error; +h$webkit_dom_validity_state_get_custom_error = (function(self, + self_2) + { + return self["customError"]; + }); +var h$webkit_dom_validity_state_get_valid; +h$webkit_dom_validity_state_get_valid = (function(self, + self_2) + { + return self["valid"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Traversal +h$webkit_dom_tree_walker_get_type = (function() + { + return h$g_get_type(TreeWalker); + }); +var h$webkit_dom_tree_walker_get_root; +h$webkit_dom_tree_walker_get_root = (function(self, + self_2) + { + h$ret1 = 0; + return self["root"]; + }); +var h$webkit_dom_tree_walker_get_what_to_show; +h$webkit_dom_tree_walker_get_what_to_show = (function(self, + self_2) + { + return self["whatToShow"]; + }); +var h$webkit_dom_tree_walker_get_filter; +h$webkit_dom_tree_walker_get_filter = (function(self, + self_2) + { + h$ret1 = 0; + return self["filter"]; + }); +var h$webkit_dom_tree_walker_get_expand_entity_references; +h$webkit_dom_tree_walker_get_expand_entity_references = (function(self, + self_2) + { + return self["expandEntityReferences"]; + }); +var h$webkit_dom_tree_walker_set_current_node; +h$webkit_dom_tree_walker_set_current_node = (function(self, + self_2, val, val_2) + { + self["currentNode"] = val; + }); +var h$webkit_dom_tree_walker_get_current_node; +h$webkit_dom_tree_walker_get_current_node = (function(self, + self_2) + { + h$ret1 = 0; + return self["currentNode"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_time_ranges_get_type = (function() + { + return h$g_get_type(TimeRanges); + }); +var h$webkit_dom_time_ranges_start; +h$webkit_dom_time_ranges_start = (function(self, + self_2, index) + { + return self["start"](index); + }); +var h$webkit_dom_time_ranges_end; +h$webkit_dom_time_ranges_end = (function(self, + self_2, index) + { + return self["end"](index); + }); +var h$webkit_dom_time_ranges_get_length; +h$webkit_dom_time_ranges_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_text_get_type = (function() + { + return h$g_get_type(Text); + }); +var h$webkit_dom_text_split_text; +h$webkit_dom_text_split_text = (function(self, + self_2, offset) + { + h$ret1 = 0; + return self["splitText"](offset); + }); +var h$webkit_dom_text_replace_whole_text; +h$webkit_dom_text_replace_whole_text = (function(self, + self_2, content, content_2) + { + h$ret1 = 0; + return self["replaceWholeText"](h$decodeUtf8z(content, + content_2)); + }); +var h$webkit_dom_text_get_whole_text; +h$webkit_dom_text_get_whole_text = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["wholeText"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Storage +h$webkit_dom_storage_info_get_type = (function() + { + return h$g_get_type(StorageInfo); + }); +// Graphics.UI.Gtk.WebKit.DOM.Storage +h$webkit_dom_storage_get_type = (function() + { + return h$g_get_type(Storage); + }); +var h$webkit_dom_storage_key; +h$webkit_dom_storage_key = (function(self, + self_2, index) + { + h$ret1 = 0; + return h$encodeUtf8(self["key"](index)); + }); +var h$webkit_dom_storage_get_item; +h$webkit_dom_storage_get_item = (function(self, + self_2, key, key_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["getItem"](h$decodeUtf8z(key, + key_2))); + }); +var h$webkit_dom_storage_set_item; +h$webkit_dom_storage_set_item = (function(self, + self_2, key, key_2, data, + data_2) + { + return self["setItem"](h$decodeUtf8z(key, + key_2), h$decodeUtf8z(data, + data_2)); + }); +var h$webkit_dom_storage_remove_item; +h$webkit_dom_storage_remove_item = (function(self, + self_2, key, key_2) + { + return self["removeItem"](h$decodeUtf8z(key, + key_2)); + }); +var h$webkit_dom_storage_clear; +h$webkit_dom_storage_clear = (function(self, + self_2) + { + return self["clear"](); + }); +var h$webkit_dom_storage_get_length; +h$webkit_dom_storage_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Stylesheets +h$webkit_dom_style_sheet_list_get_type = (function() + { + return h$g_get_type(StyleSheetList); + }); +var h$webkit_dom_style_sheet_list_item; +h$webkit_dom_style_sheet_list_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["item"](index); + }); +var h$webkit_dom_style_sheet_list_get_length; +h$webkit_dom_style_sheet_list_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Stylesheets +h$webkit_dom_style_sheet_get_type = (function() + { + return h$g_get_type(StyleSheet); + }); +var h$webkit_dom_style_sheet_set_disabled; +h$webkit_dom_style_sheet_set_disabled = (function(self, + self_2, val) + { + self["disabled"] = val; + }); +var h$webkit_dom_style_sheet_get_disabled; +h$webkit_dom_style_sheet_get_disabled = (function(self, + self_2) + { + return self["disabled"]; + }); +var h$webkit_dom_style_sheet_get_owner_node; +h$webkit_dom_style_sheet_get_owner_node = (function(self, + self_2) + { + h$ret1 = 0; + return self["ownerNode"]; + }); +var h$webkit_dom_style_sheet_get_parent_style_sheet; +h$webkit_dom_style_sheet_get_parent_style_sheet = (function(self, + self_2) + { + h$ret1 = 0; + return self["parentStyleSheet"]; + }); +var h$webkit_dom_style_sheet_get_href; +h$webkit_dom_style_sheet_get_href = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["href"]); + }); +var h$webkit_dom_style_sheet_get_title; +h$webkit_dom_style_sheet_get_title = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["title"]); + }); +var h$webkit_dom_style_sheet_get_media; +h$webkit_dom_style_sheet_get_media = (function(self, + self_2) + { + h$ret1 = 0; + return self["media"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.View +h$webkit_dom_style_media_get_type = (function() + { + return h$g_get_type(StyleMedia); + }); +var h$webkit_dom_style_media_match_medium; +h$webkit_dom_style_media_match_medium = (function(self, + self_2, mediaquery, + mediaquery_2) + { + return self["matchMedium"](h$decodeUtf8z(mediaquery, + mediaquery_2)); + }); +// Graphics.UI.Gtk.WebKit.DOM.Window +h$webkit_dom_screen_get_type = (function() + { + return h$g_get_type(Screen); + }); +var h$webkit_dom_screen_get_height; +h$webkit_dom_screen_get_height = (function(self, + self_2) + { + return self["height"]; + }); +var h$webkit_dom_screen_get_width; +h$webkit_dom_screen_get_width = (function(self, + self_2) + { + return self["width"]; + }); +var h$webkit_dom_screen_get_color_depth; +h$webkit_dom_screen_get_color_depth = (function(self, + self_2) + { + return self["colorDepth"]; + }); +var h$webkit_dom_screen_get_pixel_depth; +h$webkit_dom_screen_get_pixel_depth = (function(self, + self_2) + { + return self["pixelDepth"]; + }); +var h$webkit_dom_screen_get_avail_left; +h$webkit_dom_screen_get_avail_left = (function(self, + self_2) + { + return self["availLeft"]; + }); +var h$webkit_dom_screen_get_avail_top; +h$webkit_dom_screen_get_avail_top = (function(self, + self_2) + { + return self["availTop"]; + }); +var h$webkit_dom_screen_get_avail_height; +h$webkit_dom_screen_get_avail_height = (function(self, + self_2) + { + return self["availHeight"]; + }); +var h$webkit_dom_screen_get_avail_width; +h$webkit_dom_screen_get_avail_width = (function(self, + self_2) + { + return self["availWidth"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Ranges +h$webkit_dom_range_get_type = (function() + { + return h$g_get_type(Range); + }); +var h$webkit_dom_range_set_start; +h$webkit_dom_range_set_start = (function(self, + self_2, refNode, refNode_2, + offset) + { + return self["setStart"](refNode, + offset); + }); +var h$webkit_dom_range_set_end; +h$webkit_dom_range_set_end = (function(self, + self_2, refNode, refNode_2, + offset) + { + return self["setEnd"](refNode, + offset); + }); +var h$webkit_dom_range_set_start_before; +h$webkit_dom_range_set_start_before = (function(self, + self_2, refNode, refNode_2) + { + return self["setStartBefore"](refNode); + }); +var h$webkit_dom_range_set_start_after; +h$webkit_dom_range_set_start_after = (function(self, + self_2, refNode, refNode_2) + { + return self["setStartAfter"](refNode); + }); +var h$webkit_dom_range_set_end_before; +h$webkit_dom_range_set_end_before = (function(self, + self_2, refNode, refNode_2) + { + return self["setEndBefore"](refNode); + }); +var h$webkit_dom_range_set_end_after; +h$webkit_dom_range_set_end_after = (function(self, + self_2, refNode, refNode_2) + { + return self["setEndAfter"](refNode); + }); +var h$webkit_dom_range_collapse; +h$webkit_dom_range_collapse = (function(self, + self_2, toStart) + { + return self["collapse"](toStart); + }); +var h$webkit_dom_range_select_node; +h$webkit_dom_range_select_node = (function(self, + self_2, refNode, refNode_2) + { + return self["selectNode"](refNode); + }); +var h$webkit_dom_range_select_node_contents; +h$webkit_dom_range_select_node_contents = (function(self, + self_2, refNode, refNode_2) + { + return self["selectNodeContents"](refNode); + }); +var h$webkit_dom_range_compare_boundary_points; +h$webkit_dom_range_compare_boundary_points = (function(self, + self_2, how, sourceRange, + sourceRange_2) + { + return self["compareBoundaryPoints"](how, + sourceRange); + }); +var h$webkit_dom_range_delete_contents; +h$webkit_dom_range_delete_contents = (function(self, + self_2) + { + return self["deleteContents"](); + }); +var h$webkit_dom_range_extract_contents; +h$webkit_dom_range_extract_contents = (function(self, + self_2) + { + h$ret1 = 0; + return self["extractContents"](); + }); +var h$webkit_dom_range_clone_contents; +h$webkit_dom_range_clone_contents = (function(self, + self_2) + { + h$ret1 = 0; + return self["cloneContents"](); + }); +var h$webkit_dom_range_insert_node; +h$webkit_dom_range_insert_node = (function(self, + self_2, newNode, newNode_2) + { + return self["insertNode"](newNode); + }); +var h$webkit_dom_range_surround_contents; +h$webkit_dom_range_surround_contents = (function(self, + self_2, newParent, newParent_2) + { + return self["surroundContents"](newParent); + }); +var h$webkit_dom_range_clone_range; +h$webkit_dom_range_clone_range = (function(self, + self_2) + { + h$ret1 = 0; + return self["cloneRange"](); + }); +var h$webkit_dom_range_to_string; +h$webkit_dom_range_to_string = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["toString"]()); + }); +var h$webkit_dom_range_detach; +h$webkit_dom_range_detach = (function(self, + self_2) + { + return self["detach"](); + }); +var h$webkit_dom_range_create_contextual_fragment; +h$webkit_dom_range_create_contextual_fragment = (function(self, + self_2, html, html_2) + { + h$ret1 = 0; + return self["createContextualFragment"](h$decodeUtf8z(html, + html_2)); + }); +var h$webkit_dom_range_intersects_node; +h$webkit_dom_range_intersects_node = (function(self, + self_2, refNode, refNode_2) + { + return self["intersectsNode"](refNode); + }); +var h$webkit_dom_range_compare_node; +h$webkit_dom_range_compare_node = (function(self, + self_2, refNode, refNode_2) + { + return self["compareNode"](refNode); + }); +var h$webkit_dom_range_compare_point; +h$webkit_dom_range_compare_point = (function(self, + self_2, refNode, refNode_2, + offset) + { + return self["comparePoint"](refNode, + offset); + }); +var h$webkit_dom_range_is_point_in_range; +h$webkit_dom_range_is_point_in_range = (function(self, + self_2, refNode, refNode_2, + offset) + { + return self["isPointInRange"](refNode, + offset); + }); +var h$webkit_dom_range_expand; +h$webkit_dom_range_expand = (function(self, + self_2, unit, unit_2) + { + return self["expand"](h$decodeUtf8z(unit, + unit_2)); + }); +var h$webkit_dom_range_get_start_container; +h$webkit_dom_range_get_start_container = (function(self, + self_2) + { + h$ret1 = 0; + return self["startContainer"]; + }); +var h$webkit_dom_range_get_start_offset; +h$webkit_dom_range_get_start_offset = (function(self, + self_2) + { + return self["startOffset"]; + }); +var h$webkit_dom_range_get_end_container; +h$webkit_dom_range_get_end_container = (function(self, + self_2) + { + h$ret1 = 0; + return self["endContainer"]; + }); +var h$webkit_dom_range_get_end_offset; +h$webkit_dom_range_get_end_offset = (function(self, + self_2) + { + return self["endOffset"]; + }); +var h$webkit_dom_range_get_collapsed; +h$webkit_dom_range_get_collapsed = (function(self, + self_2) + { + return self["collapsed"]; + }); +var h$webkit_dom_range_get_common_ancestor_container; +h$webkit_dom_range_get_common_ancestor_container = (function(self, + self_2) + { + h$ret1 = 0; + return self["commonAncestorContainer"]; + }); +var h$webkit_dom_range_get_text; +h$webkit_dom_range_get_text = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["text"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_processing_instruction_get_type = (function() + { + return h$g_get_type(ProcessingInstruction); + }); +var h$webkit_dom_processing_instruction_get_target; +h$webkit_dom_processing_instruction_get_target = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["target"]); + }); +var h$webkit_dom_processing_instruction_set_data; +h$webkit_dom_processing_instruction_set_data = (function(self, + self_2, val, val_2) + { + self["data"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_processing_instruction_get_data; +h$webkit_dom_processing_instruction_get_data = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["data"]); + }); +var h$webkit_dom_processing_instruction_get_sheet; +h$webkit_dom_processing_instruction_get_sheet = (function(self, + self_2) + { + h$ret1 = 0; + return self["sheet"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_notation_get_type = (function() + { + return h$g_get_type(Notation); + }); +var h$webkit_dom_notation_get_public_id; +h$webkit_dom_notation_get_public_id = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["publicId"]); + }); +var h$webkit_dom_notation_get_system_id; +h$webkit_dom_notation_get_system_id = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["systemId"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_node_list_get_type = (function() + { + return h$g_get_type(NodeList); + }); +var h$webkit_dom_node_list_item; +h$webkit_dom_node_list_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["item"](index); + }); +var h$webkit_dom_node_list_get_length; +h$webkit_dom_node_list_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Traversal +h$webkit_dom_node_iterator_get_type = (function() + { + return h$g_get_type(NodeIterator); + }); +var h$webkit_dom_node_iterator_detach; +h$webkit_dom_node_iterator_detach = (function(self, + self_2) + { + return self["detach"](); + }); +var h$webkit_dom_node_iterator_get_root; +h$webkit_dom_node_iterator_get_root = (function(self, + self_2) + { + h$ret1 = 0; + return self["root"]; + }); +var h$webkit_dom_node_iterator_get_what_to_show; +h$webkit_dom_node_iterator_get_what_to_show = (function(self, + self_2) + { + return self["whatToShow"]; + }); +var h$webkit_dom_node_iterator_get_filter; +h$webkit_dom_node_iterator_get_filter = (function(self, + self_2) + { + h$ret1 = 0; + return self["filter"]; + }); +var h$webkit_dom_node_iterator_get_expand_entity_references; +h$webkit_dom_node_iterator_get_expand_entity_references = (function(self, + self_2) + { + return self["expandEntityReferences"]; + }); +var h$webkit_dom_node_iterator_get_reference_node; +h$webkit_dom_node_iterator_get_reference_node = (function(self, + self_2) + { + h$ret1 = 0; + return self["referenceNode"]; + }); +var h$webkit_dom_node_iterator_get_pointer_before_reference_node; +h$webkit_dom_node_iterator_get_pointer_before_reference_node = (function(self, + self_2) + { + return self["pointerBeforeReferenceNode"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Traversal +h$webkit_dom_node_filter_get_type = (function() + { + return h$g_get_type(NodeFilter); + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_node_get_type = (function() + { + return h$g_get_type(Node); + }); +var h$webkit_dom_node_insert_before; +h$webkit_dom_node_insert_before = (function(self, + self_2, newChild, newChild_2, + refChild, refChild_2) + { + h$ret1 = 0; + return self["insertBefore"](newChild, + refChild); + }); +var h$webkit_dom_node_replace_child; +h$webkit_dom_node_replace_child = (function(self, + self_2, newChild, newChild_2, + oldChild, oldChild_2) + { + h$ret1 = 0; + return self["replaceChild"](newChild, + oldChild); + }); +var h$webkit_dom_node_remove_child; +h$webkit_dom_node_remove_child = (function(self, + self_2, oldChild, oldChild_2) + { + h$ret1 = 0; + return self["removeChild"](oldChild); + }); +var h$webkit_dom_node_append_child; +h$webkit_dom_node_append_child = (function(self, + self_2, newChild, newChild_2) + { + h$ret1 = 0; + return self["appendChild"](newChild); + }); +var h$webkit_dom_node_has_child_nodes; +h$webkit_dom_node_has_child_nodes = (function(self, + self_2) + { + return self["hasChildNodes"](); + }); +var h$webkit_dom_node_clone_node; +h$webkit_dom_node_clone_node = (function(self, + self_2, deep) + { + h$ret1 = 0; + return self["cloneNode"](deep); + }); +var h$webkit_dom_node_normalize; +h$webkit_dom_node_normalize = (function(self, + self_2) + { + return self["normalize"](); + }); +var h$webkit_dom_node_is_supported; +h$webkit_dom_node_is_supported = (function(self, + self_2, feature, feature_2, + version, version_2) + { + return self["isSupported"](h$decodeUtf8z(feature, + feature_2), + h$decodeUtf8z(version, + version_2)); + }); +var h$webkit_dom_node_has_attributes; +h$webkit_dom_node_has_attributes = (function(self, + self_2) + { + return self["hasAttributes"](); + }); +var h$webkit_dom_node_is_same_node; +h$webkit_dom_node_is_same_node = (function(self, + self_2, other, other_2) + { + return self["isSameNode"](other); + }); +var h$webkit_dom_node_is_equal_node; +h$webkit_dom_node_is_equal_node = (function(self, + self_2, other, other_2) + { + return self["isEqualNode"](other); + }); +var h$webkit_dom_node_lookup_prefix; +h$webkit_dom_node_lookup_prefix = (function(self, + self_2, namespaceURI, + namespaceURI_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["lookupPrefix"](h$decodeUtf8z(namespaceURI, + namespaceURI_2))); + }); +var h$webkit_dom_node_is_default_namespace; +h$webkit_dom_node_is_default_namespace = (function(self, + self_2, namespaceURI, + namespaceURI_2) + { + return self["isDefaultNamespace"](h$decodeUtf8z(namespaceURI, + namespaceURI_2)); + }); +var h$webkit_dom_node_lookup_namespace_uri; +h$webkit_dom_node_lookup_namespace_uri = (function(self, + self_2, prefix, prefix_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["lookupNamespaceURI"](h$decodeUtf8z(prefix, + prefix_2))); + }); +var h$webkit_dom_node_compare_document_position; +h$webkit_dom_node_compare_document_position = (function(self, + self_2, other, other_2) + { + return self["compareDocumentPosition"](other); + }); +var h$webkit_dom_node_contains; +h$webkit_dom_node_contains = (function(self, + self_2, other, other_2) + { + return self["contains"](other); + }); +var h$webkit_dom_node_dispatch_event; +h$webkit_dom_node_dispatch_event = (function(self, + self_2, event, event_2) + { + return self["dispatchEvent"](event); + }); +var h$webkit_dom_node_get_node_name; +h$webkit_dom_node_get_node_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["nodeName"]); + }); +var h$webkit_dom_node_set_node_value; +h$webkit_dom_node_set_node_value = (function(self, + self_2, val, val_2) + { + self["nodeValue"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_node_get_node_value; +h$webkit_dom_node_get_node_value = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["nodeValue"]); + }); +var h$webkit_dom_node_get_node_type; +h$webkit_dom_node_get_node_type = (function(self, + self_2) + { + return self["nodeType"]; + }); +var h$webkit_dom_node_get_parent_node; +h$webkit_dom_node_get_parent_node = (function(self, + self_2) + { + h$ret1 = 0; + return self["parentNode"]; + }); +var h$webkit_dom_node_get_child_nodes; +h$webkit_dom_node_get_child_nodes = (function(self, + self_2) + { + h$ret1 = 0; + return self["childNodes"]; + }); +var h$webkit_dom_node_get_first_child; +h$webkit_dom_node_get_first_child = (function(self, + self_2) + { + h$ret1 = 0; + return self["firstChild"]; + }); +var h$webkit_dom_node_get_last_child; +h$webkit_dom_node_get_last_child = (function(self, + self_2) + { + h$ret1 = 0; + return self["lastChild"]; + }); +var h$webkit_dom_node_get_previous_sibling; +h$webkit_dom_node_get_previous_sibling = (function(self, + self_2) + { + h$ret1 = 0; + return self["previousSibling"]; + }); +var h$webkit_dom_node_get_next_sibling; +h$webkit_dom_node_get_next_sibling = (function(self, + self_2) + { + h$ret1 = 0; + return self["nextSibling"]; + }); +var h$webkit_dom_node_get_attributes; +h$webkit_dom_node_get_attributes = (function(self, + self_2) + { + h$ret1 = 0; + return self["attributes"]; + }); +var h$webkit_dom_node_get_owner_document; +h$webkit_dom_node_get_owner_document = (function(self, + self_2) + { + h$ret1 = 0; + return self["ownerDocument"]; + }); +var h$webkit_dom_node_get_namespace_uri; +h$webkit_dom_node_get_namespace_uri = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["namespaceURI"]); + }); +var h$webkit_dom_node_set_prefix; +h$webkit_dom_node_set_prefix = (function(self, + self_2, val, val_2) + { + self["prefix"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_node_get_prefix; +h$webkit_dom_node_get_prefix = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["prefix"]); + }); +var h$webkit_dom_node_get_local_name; +h$webkit_dom_node_get_local_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["localName"]); + }); +var h$webkit_dom_node_get_base_uri; +h$webkit_dom_node_get_base_uri = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["baseURI"]); + }); +var h$webkit_dom_node_set_text_content; +h$webkit_dom_node_set_text_content = (function(self, + self_2, val, val_2) + { + self["textContent"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_node_get_text_content; +h$webkit_dom_node_get_text_content = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["textContent"]); + }); +var h$webkit_dom_node_get_parent_element; +h$webkit_dom_node_get_parent_element = (function(self, + self_2) + { + h$ret1 = 0; + return self["parentElement"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Window +h$webkit_dom_navigator_get_type = (function() + { + return h$g_get_type(Navigator); + }); +var h$webkit_dom_navigator_java_enabled; +h$webkit_dom_navigator_java_enabled = (function(self, + self_2) + { + return self["javaEnabled"](); + }); +var h$webkit_dom_navigator_get_storage_updates; +h$webkit_dom_navigator_get_storage_updates = (function(self, + self_2) + { + return self["getStorageUpdates"](); + }); +var h$webkit_dom_navigator_get_app_code_name; +h$webkit_dom_navigator_get_app_code_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["appCodeName"]); + }); +var h$webkit_dom_navigator_get_app_name; +h$webkit_dom_navigator_get_app_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["appName"]); + }); +var h$webkit_dom_navigator_get_app_version; +h$webkit_dom_navigator_get_app_version = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["appVersion"]); + }); +var h$webkit_dom_navigator_get_language; +h$webkit_dom_navigator_get_language = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["language"]); + }); +var h$webkit_dom_navigator_get_user_agent; +h$webkit_dom_navigator_get_user_agent = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["userAgent"]); + }); +var h$webkit_dom_navigator_get_platform; +h$webkit_dom_navigator_get_platform = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["platform"]); + }); +var h$webkit_dom_navigator_get_plugins; +h$webkit_dom_navigator_get_plugins = (function(self, + self_2) + { + h$ret1 = 0; + return self["plugins"]; + }); +var h$webkit_dom_navigator_get_mime_types; +h$webkit_dom_navigator_get_mime_types = (function(self, + self_2) + { + h$ret1 = 0; + return self["mimeTypes"]; + }); +var h$webkit_dom_navigator_get_product; +h$webkit_dom_navigator_get_product = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["product"]); + }); +var h$webkit_dom_navigator_get_product_sub; +h$webkit_dom_navigator_get_product_sub = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["productSub"]); + }); +var h$webkit_dom_navigator_get_vendor; +h$webkit_dom_navigator_get_vendor = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["vendor"]); + }); +var h$webkit_dom_navigator_get_vendor_sub; +h$webkit_dom_navigator_get_vendor_sub = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["vendorSub"]); + }); +var h$webkit_dom_navigator_get_cookie_enabled; +h$webkit_dom_navigator_get_cookie_enabled = (function(self, + self_2) + { + return self["cookieEnabled"]; + }); +var h$webkit_dom_navigator_get_on_line; +h$webkit_dom_navigator_get_on_line = (function(self, + self_2) + { + return self["onLine"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_named_node_map_get_type = (function() + { + return h$g_get_type(NamedNodeMap); + }); +var h$webkit_dom_named_node_map_get_named_item; +h$webkit_dom_named_node_map_get_named_item = (function(self, + self_2, name, name_2) + { + h$ret1 = 0; + return self["getNamedItem"](h$decodeUtf8z(name, + name_2)); + }); +var h$webkit_dom_named_node_map_set_named_item; +h$webkit_dom_named_node_map_set_named_item = (function(self, + self_2, node, node_2) + { + h$ret1 = 0; + return self["setNamedItem"](node); + }); +var h$webkit_dom_named_node_map_remove_named_item; +h$webkit_dom_named_node_map_remove_named_item = (function(self, + self_2, name, name_2) + { + h$ret1 = 0; + return self["removeNamedItem"](h$decodeUtf8z(name, + name_2)); + }); +var h$webkit_dom_named_node_map_item; +h$webkit_dom_named_node_map_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["item"](index); + }); +var h$webkit_dom_named_node_map_get_named_item_ns; +h$webkit_dom_named_node_map_get_named_item_ns = (function(self, + self_2, namespaceURI, + namespaceURI_2, localName, + localName_2) + { + h$ret1 = 0; + return self["getNamedItemNS"](h$decodeUtf8z(namespaceURI, + namespaceURI_2), + h$decodeUtf8z(localName, + localName_2)); + }); +var h$webkit_dom_named_node_map_set_named_item_ns; +h$webkit_dom_named_node_map_set_named_item_ns = (function(self, + self_2, node, node_2) + { + h$ret1 = 0; + return self["setNamedItemNS"](node); + }); +var h$webkit_dom_named_node_map_remove_named_item_ns; +h$webkit_dom_named_node_map_remove_named_item_ns = (function(self, + self_2, namespaceURI, + namespaceURI_2, localName, + localName_2) + { + h$ret1 = 0; + return self["removeNamedItemNS"](h$decodeUtf8z(namespaceURI, + namespaceURI_2), + h$decodeUtf8z(localName, + localName_2)); + }); +var h$webkit_dom_named_node_map_get_length; +h$webkit_dom_named_node_map_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Events +h$webkit_dom_mutation_event_get_type = (function() + { + return h$g_get_type(MutationEvent); + }); +var h$webkit_dom_mutation_event_init_mutation_event; +h$webkit_dom_mutation_event_init_mutation_event = (function(self, + self_2, type, type_2, + canBubble, cancelable, + relatedNode, relatedNode_2, + prevValue, prevValue_2, + newValue, newValue_2, + attrName, attrName_2, + attrChange) + { + return self["initMutationEvent"](h$decodeUtf8z(type, + type_2), canBubble, + cancelable, relatedNode, + h$decodeUtf8z(prevValue, + prevValue_2), + h$decodeUtf8z(newValue, + newValue_2), + h$decodeUtf8z(attrName, + attrName_2), attrChange); + }); +var h$webkit_dom_mutation_event_get_related_node; +h$webkit_dom_mutation_event_get_related_node = (function(self, + self_2) + { + h$ret1 = 0; + return self["relatedNode"]; + }); +var h$webkit_dom_mutation_event_get_prev_value; +h$webkit_dom_mutation_event_get_prev_value = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["prevValue"]); + }); +var h$webkit_dom_mutation_event_get_new_value; +h$webkit_dom_mutation_event_get_new_value = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["newValue"]); + }); +var h$webkit_dom_mutation_event_get_attr_name; +h$webkit_dom_mutation_event_get_attr_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["attrName"]); + }); +var h$webkit_dom_mutation_event_get_attr_change; +h$webkit_dom_mutation_event_get_attr_change = (function(self, + self_2) + { + return self["attrChange"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Events +h$webkit_dom_message_port_get_type = (function() + { + return h$g_get_type(MessagePort); + }); +// Graphics.UI.Gtk.WebKit.DOM.Events +h$webkit_dom_mouse_event_get_type = (function() + { + return h$g_get_type(MouseEvent); + }); +var h$webkit_dom_mouse_event_init_mouse_event; +h$webkit_dom_mouse_event_init_mouse_event = (function(self, + self_2, type, type_2, canBubble, + cancelable, view, view_2, + detail, screenX, screenY, + clientX, clientY, ctrlKey, + altKey, shiftKey, metaKey, + button, relatedTarget, + relatedTarget_2) + { + return self["initMouseEvent"](h$decodeUtf8z(type, + type_2), canBubble, cancelable, + view, detail, screenX, screenY, + clientX, clientY, ctrlKey, + altKey, shiftKey, metaKey, + button, relatedTarget); + }); +var h$webkit_dom_mouse_event_get_screen_x; +h$webkit_dom_mouse_event_get_screen_x = (function(self, + self_2) + { + return self["screenX"]; + }); +var h$webkit_dom_mouse_event_get_screen_y; +h$webkit_dom_mouse_event_get_screen_y = (function(self, + self_2) + { + return self["screenY"]; + }); +var h$webkit_dom_mouse_event_get_client_x; +h$webkit_dom_mouse_event_get_client_x = (function(self, + self_2) + { + return self["clientX"]; + }); +var h$webkit_dom_mouse_event_get_client_y; +h$webkit_dom_mouse_event_get_client_y = (function(self, + self_2) + { + return self["clientY"]; + }); +var h$webkit_dom_mouse_event_get_webkit_movement_x; +h$webkit_dom_mouse_event_get_webkit_movement_x = (function(self, + self_2) + { + return self["webkitMovementX"]; + }); +var h$webkit_dom_mouse_event_get_webkit_movement_y; +h$webkit_dom_mouse_event_get_webkit_movement_y = (function(self, + self_2) + { + return self["webkitMovementY"]; + }); +var h$webkit_dom_mouse_event_get_ctrl_key; +h$webkit_dom_mouse_event_get_ctrl_key = (function(self, + self_2) + { + return self["ctrlKey"]; + }); +var h$webkit_dom_mouse_event_get_shift_key; +h$webkit_dom_mouse_event_get_shift_key = (function(self, + self_2) + { + return self["shiftKey"]; + }); +var h$webkit_dom_mouse_event_get_alt_key; +h$webkit_dom_mouse_event_get_alt_key = (function(self, + self_2) + { + return self["altKey"]; + }); +var h$webkit_dom_mouse_event_get_meta_key; +h$webkit_dom_mouse_event_get_meta_key = (function(self, + self_2) + { + return self["metaKey"]; + }); +var h$webkit_dom_mouse_event_get_button; +h$webkit_dom_mouse_event_get_button = (function(self, + self_2) + { + return self["button"]; + }); +var h$webkit_dom_mouse_event_get_related_target; +h$webkit_dom_mouse_event_get_related_target = (function(self, + self_2) + { + h$ret1 = 0; + return self["relatedTarget"]; + }); +var h$webkit_dom_mouse_event_get_offset_x; +h$webkit_dom_mouse_event_get_offset_x = (function(self, + self_2) + { + return self["offsetX"]; + }); +var h$webkit_dom_mouse_event_get_offset_y; +h$webkit_dom_mouse_event_get_offset_y = (function(self, + self_2) + { + return self["offsetY"]; + }); +var h$webkit_dom_mouse_event_get_x; +h$webkit_dom_mouse_event_get_x = (function(self, + self_2) + { + return self["x"]; + }); +var h$webkit_dom_mouse_event_get_y; +h$webkit_dom_mouse_event_get_y = (function(self, + self_2) + { + return self["y"]; + }); +var h$webkit_dom_mouse_event_get_from_element; +h$webkit_dom_mouse_event_get_from_element = (function(self, + self_2) + { + h$ret1 = 0; + return self["fromElement"]; + }); +var h$webkit_dom_mouse_event_get_to_element; +h$webkit_dom_mouse_event_get_to_element = (function(self, + self_2) + { + h$ret1 = 0; + return self["toElement"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Window +h$webkit_dom_memory_info_get_type = (function() + { + return h$g_get_type(MemoryInfo); + }); +var h$webkit_dom_memory_info_get_total_js_heap_size; +h$webkit_dom_memory_info_get_total_js_heap_size = (function(self, + self_2) + { + return self["totalJSHeapSize"]; + }); +var h$webkit_dom_memory_info_get_used_js_heap_size; +h$webkit_dom_memory_info_get_used_js_heap_size = (function(self, + self_2) + { + return self["usedJSHeapSize"]; + }); +var h$webkit_dom_memory_info_get_js_heap_size_limit; +h$webkit_dom_memory_info_get_js_heap_size_limit = (function(self, + self_2) + { + return self["jsHeapSizeLimit"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.View +h$webkit_dom_media_query_list_get_type = (function() + { + return h$g_get_type(MediaQueryList); + }); +var h$webkit_dom_media_query_list_get_media; +h$webkit_dom_media_query_list_get_media = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["media"]); + }); +var h$webkit_dom_media_query_list_get_matches; +h$webkit_dom_media_query_list_get_matches = (function(self, + self_2) + { + return self["matches"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Stylesheets +h$webkit_dom_media_list_get_type = (function() + { + return h$g_get_type(MediaList); + }); +var h$webkit_dom_media_list_item; +h$webkit_dom_media_list_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return h$encodeUtf8(self["item"](index)); + }); +var h$webkit_dom_media_list_delete_medium; +h$webkit_dom_media_list_delete_medium = (function(self, + self_2, oldMedium, oldMedium_2) + { + return self["deleteMedium"](h$decodeUtf8z(oldMedium, + oldMedium_2)); + }); +var h$webkit_dom_media_list_append_medium; +h$webkit_dom_media_list_append_medium = (function(self, + self_2, newMedium, newMedium_2) + { + return self["appendMedium"](h$decodeUtf8z(newMedium, + newMedium_2)); + }); +var h$webkit_dom_media_list_set_media_text; +h$webkit_dom_media_list_set_media_text = (function(self, + self_2, val, val_2) + { + self["mediaText"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_media_list_get_media_text; +h$webkit_dom_media_list_get_media_text = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["mediaText"]); + }); +var h$webkit_dom_media_list_get_length; +h$webkit_dom_media_list_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_media_error_get_type = (function() + { + return h$g_get_type(MediaError); + }); +var h$webkit_dom_media_error_get_code; +h$webkit_dom_media_error_get_code = (function(self, + self_2) + { + return self["code"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Window +h$webkit_dom_location_get_type = (function() + { + return h$g_get_type(Location); + }); +var h$webkit_dom_location_get_origin; +h$webkit_dom_location_get_origin = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["origin"]); + }); +var h$webkit_dom_location_get_ancestor_origins; +h$webkit_dom_location_get_ancestor_origins = (function(self, + self_2) + { + h$ret1 = 0; + return self["ancestorOrigins"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Events +h$webkit_dom_keyboard_event_get_type = (function() + { + return h$g_get_type(KeyboardEvent); + }); +var h$webkit_dom_keyboard_event_get_modifier_state; +h$webkit_dom_keyboard_event_get_modifier_state = (function(self, + self_2, keyIdentifierArg, + keyIdentifierArg_2) + { + return self["getModifierState"](h$decodeUtf8z(keyIdentifierArg, + keyIdentifierArg_2)); + }); +var h$webkit_dom_keyboard_event_init_keyboard_event; +h$webkit_dom_keyboard_event_init_keyboard_event = (function(self, + self_2, type, type_2, + canBubble, cancelable, view, + view_2, keyIdentifier, + keyIdentifier_2, keyLocation, + ctrlKey, altKey, shiftKey, + metaKey, altGraphKey) + { + return self["initKeyboardEvent"](h$decodeUtf8z(type, + type_2), canBubble, + cancelable, view, + h$decodeUtf8z(keyIdentifier, + keyIdentifier_2), + keyLocation, ctrlKey, + altKey, shiftKey, metaKey, + altGraphKey); + }); +var h$webkit_dom_keyboard_event_init_keyboard_event; +h$webkit_dom_keyboard_event_init_keyboard_event = (function(self, + self_2, type, type_2, + canBubble, cancelable, view, + view_2, keyIdentifier, + keyIdentifier_2, keyLocation, + ctrlKey, altKey, shiftKey, + metaKey) + { + return self["initKeyboardEvent"](h$decodeUtf8z(type, + type_2), canBubble, + cancelable, view, + h$decodeUtf8z(keyIdentifier, + keyIdentifier_2), + keyLocation, ctrlKey, + altKey, shiftKey, metaKey); + }); +var h$webkit_dom_keyboard_event_get_key_identifier; +h$webkit_dom_keyboard_event_get_key_identifier = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["keyIdentifier"]); + }); +var h$webkit_dom_keyboard_event_get_key_location; +h$webkit_dom_keyboard_event_get_key_location = (function(self, + self_2) + { + return self["keyLocation"]; + }); +var h$webkit_dom_keyboard_event_get_ctrl_key; +h$webkit_dom_keyboard_event_get_ctrl_key = (function(self, + self_2) + { + return self["ctrlKey"]; + }); +var h$webkit_dom_keyboard_event_get_shift_key; +h$webkit_dom_keyboard_event_get_shift_key = (function(self, + self_2) + { + return self["shiftKey"]; + }); +var h$webkit_dom_keyboard_event_get_alt_key; +h$webkit_dom_keyboard_event_get_alt_key = (function(self, + self_2) + { + return self["altKey"]; + }); +var h$webkit_dom_keyboard_event_get_meta_key; +h$webkit_dom_keyboard_event_get_meta_key = (function(self, + self_2) + { + return self["metaKey"]; + }); +var h$webkit_dom_keyboard_event_get_alt_graph_key; +h$webkit_dom_keyboard_event_get_alt_graph_key = (function(self, + self_2) + { + return self["altGraphKey"]; + }); +var h$webkit_dom_keyboard_event_get_key_code; +h$webkit_dom_keyboard_event_get_key_code = (function(self, + self_2) + { + return self["keyCode"]; + }); +var h$webkit_dom_keyboard_event_get_char_code; +h$webkit_dom_keyboard_event_get_char_code = (function(self, + self_2) + { + return self["charCode"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_video_element_get_type = (function() + { + return h$g_get_type(HTMLVideoElement); + }); +var h$webkit_dom_html_video_element_webkit_enter_fullscreen; +h$webkit_dom_html_video_element_webkit_enter_fullscreen = (function(self, + self_2) + { + return self["webkitEnterFullscreen"](); + }); +var h$webkit_dom_html_video_element_webkit_exit_fullscreen; +h$webkit_dom_html_video_element_webkit_exit_fullscreen = (function(self, + self_2) + { + return self["webkitExitFullscreen"](); + }); +var h$webkit_dom_html_video_element_webkit_enter_full_screen; +h$webkit_dom_html_video_element_webkit_enter_full_screen = (function(self, + self_2) + { + return self["webkitEnterFullScreen"](); + }); +var h$webkit_dom_html_video_element_webkit_exit_full_screen; +h$webkit_dom_html_video_element_webkit_exit_full_screen = (function(self, + self_2) + { + return self["webkitExitFullScreen"](); + }); +var h$webkit_dom_html_video_element_set_width; +h$webkit_dom_html_video_element_set_width = (function(self, + self_2, val) + { + self["width"] = val; + }); +var h$webkit_dom_html_video_element_get_width; +h$webkit_dom_html_video_element_get_width = (function(self, + self_2) + { + return self["width"]; + }); +var h$webkit_dom_html_video_element_set_height; +h$webkit_dom_html_video_element_set_height = (function(self, + self_2, val) + { + self["height"] = val; + }); +var h$webkit_dom_html_video_element_get_height; +h$webkit_dom_html_video_element_get_height = (function(self, + self_2) + { + return self["height"]; + }); +var h$webkit_dom_html_video_element_get_video_width; +h$webkit_dom_html_video_element_get_video_width = (function(self, + self_2) + { + return self["videoWidth"]; + }); +var h$webkit_dom_html_video_element_get_video_height; +h$webkit_dom_html_video_element_get_video_height = (function(self, + self_2) + { + return self["videoHeight"]; + }); +var h$webkit_dom_html_video_element_set_poster; +h$webkit_dom_html_video_element_set_poster = (function(self, + self_2, val, val_2) + { + self["poster"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_video_element_get_poster; +h$webkit_dom_html_video_element_get_poster = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["poster"]); + }); +var h$webkit_dom_html_video_element_get_webkit_supports_fullscreen; +h$webkit_dom_html_video_element_get_webkit_supports_fullscreen = (function(self, + self_2) + { + return self["webkitSupportsFullscreen"]; + }); +var h$webkit_dom_html_video_element_get_webkit_displaying_fullscreen; +h$webkit_dom_html_video_element_get_webkit_displaying_fullscreen = (function(self, + self_2) + { + return self["webkitDisplayingFullscreen"]; + }); +var h$webkit_dom_html_video_element_get_webkit_decoded_frame_count; +h$webkit_dom_html_video_element_get_webkit_decoded_frame_count = (function(self, + self_2) + { + return self["webkitDecodedFrameCount"]; + }); +var h$webkit_dom_html_video_element_get_webkit_dropped_frame_count; +h$webkit_dom_html_video_element_get_webkit_dropped_frame_count = (function(self, + self_2) + { + return self["webkitDroppedFrameCount"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_htmlu_list_element_get_type = (function() + { + return h$g_get_type(HTMLUListElement); + }); +var h$webkit_dom_htmlu_list_element_set_compact; +h$webkit_dom_htmlu_list_element_set_compact = (function(self, + self_2, val) + { + self["compact"] = val; + }); +var h$webkit_dom_htmlu_list_element_get_compact; +h$webkit_dom_htmlu_list_element_get_compact = (function(self, + self_2) + { + return self["compact"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_title_element_get_type = (function() + { + return h$g_get_type(HTMLTitleElement); + }); +var h$webkit_dom_html_title_element_set_text; +h$webkit_dom_html_title_element_set_text = (function(self, + self_2, val, val_2) + { + self["text"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_title_element_get_text; +h$webkit_dom_html_title_element_get_text = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["text"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_text_area_element_get_type = (function() + { + return h$g_get_type(HTMLTextAreaElement); + }); +var h$webkit_dom_html_text_area_element_check_validity; +h$webkit_dom_html_text_area_element_check_validity = (function(self, + self_2) + { + return self["checkValidity"](); + }); +var h$webkit_dom_html_text_area_element_set_custom_validity; +h$webkit_dom_html_text_area_element_set_custom_validity = (function(self, + self_2, error, + error_2) + { + return self["setCustomValidity"](h$decodeUtf8z(error, + error_2)); + }); +var h$webkit_dom_html_text_area_element_select; +h$webkit_dom_html_text_area_element_select = (function(self, + self_2) + { + return self["select"](); + }); +var h$webkit_dom_html_text_area_element_set_selection_range; +h$webkit_dom_html_text_area_element_set_selection_range = (function(self, + self_2, start, end, + direction, + direction_2) + { + return self["setSelectionRange"](start, + end, + h$decodeUtf8z(direction, + direction_2)); + }); +var h$webkit_dom_html_text_area_element_set_autofocus; +h$webkit_dom_html_text_area_element_set_autofocus = (function(self, + self_2, val) + { + self["autofocus"] = val; + }); +var h$webkit_dom_html_text_area_element_get_autofocus; +h$webkit_dom_html_text_area_element_get_autofocus = (function(self, + self_2) + { + return self["autofocus"]; + }); +var h$webkit_dom_html_text_area_element_set_cols; +h$webkit_dom_html_text_area_element_set_cols = (function(self, + self_2, val) + { + self["cols"] = val; + }); +var h$webkit_dom_html_text_area_element_get_cols; +h$webkit_dom_html_text_area_element_get_cols = (function(self, + self_2) + { + return self["cols"]; + }); +var h$webkit_dom_html_text_area_element_set_dir_name; +h$webkit_dom_html_text_area_element_set_dir_name = (function(self, + self_2, val, val_2) + { + self["dirName"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_text_area_element_get_dir_name; +h$webkit_dom_html_text_area_element_get_dir_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["dirName"]); + }); +var h$webkit_dom_html_text_area_element_set_disabled; +h$webkit_dom_html_text_area_element_set_disabled = (function(self, + self_2, val) + { + self["disabled"] = val; + }); +var h$webkit_dom_html_text_area_element_get_disabled; +h$webkit_dom_html_text_area_element_get_disabled = (function(self, + self_2) + { + return self["disabled"]; + }); +var h$webkit_dom_html_text_area_element_get_form; +h$webkit_dom_html_text_area_element_get_form = (function(self, + self_2) + { + h$ret1 = 0; + return self["form"]; + }); +var h$webkit_dom_html_text_area_element_set_max_length; +h$webkit_dom_html_text_area_element_set_max_length = (function(self, + self_2, val) + { + self["maxLength"] = val; + }); +var h$webkit_dom_html_text_area_element_get_max_length; +h$webkit_dom_html_text_area_element_get_max_length = (function(self, + self_2) + { + return self["maxLength"]; + }); +var h$webkit_dom_html_text_area_element_set_name; +h$webkit_dom_html_text_area_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_text_area_element_get_name; +h$webkit_dom_html_text_area_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_text_area_element_set_placeholder; +h$webkit_dom_html_text_area_element_set_placeholder = (function(self, + self_2, val, val_2) + { + self["placeholder"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_text_area_element_get_placeholder; +h$webkit_dom_html_text_area_element_get_placeholder = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["placeholder"]); + }); +var h$webkit_dom_html_text_area_element_set_read_only; +h$webkit_dom_html_text_area_element_set_read_only = (function(self, + self_2, val) + { + self["readOnly"] = val; + }); +var h$webkit_dom_html_text_area_element_get_read_only; +h$webkit_dom_html_text_area_element_get_read_only = (function(self, + self_2) + { + return self["readOnly"]; + }); +var h$webkit_dom_html_text_area_element_set_required; +h$webkit_dom_html_text_area_element_set_required = (function(self, + self_2, val) + { + self["required"] = val; + }); +var h$webkit_dom_html_text_area_element_get_required; +h$webkit_dom_html_text_area_element_get_required = (function(self, + self_2) + { + return self["required"]; + }); +var h$webkit_dom_html_text_area_element_set_rows; +h$webkit_dom_html_text_area_element_set_rows = (function(self, + self_2, val) + { + self["rows"] = val; + }); +var h$webkit_dom_html_text_area_element_get_rows; +h$webkit_dom_html_text_area_element_get_rows = (function(self, + self_2) + { + return self["rows"]; + }); +var h$webkit_dom_html_text_area_element_set_wrap; +h$webkit_dom_html_text_area_element_set_wrap = (function(self, + self_2, val, val_2) + { + self["wrap"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_text_area_element_get_wrap; +h$webkit_dom_html_text_area_element_get_wrap = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["wrap"]); + }); +var h$webkit_dom_html_text_area_element_set_default_value; +h$webkit_dom_html_text_area_element_set_default_value = (function(self, + self_2, val, val_2) + { + self["defaultValue"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_text_area_element_get_default_value; +h$webkit_dom_html_text_area_element_get_default_value = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["defaultValue"]); + }); +var h$webkit_dom_html_text_area_element_set_value; +h$webkit_dom_html_text_area_element_set_value = (function(self, + self_2, val, val_2) + { + self["value"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_text_area_element_get_value; +h$webkit_dom_html_text_area_element_get_value = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["value"]); + }); +var h$webkit_dom_html_text_area_element_get_text_length; +h$webkit_dom_html_text_area_element_get_text_length = (function(self, + self_2) + { + return self["textLength"]; + }); +var h$webkit_dom_html_text_area_element_get_will_validate; +h$webkit_dom_html_text_area_element_get_will_validate = (function(self, + self_2) + { + return self["willValidate"]; + }); +var h$webkit_dom_html_text_area_element_get_validity; +h$webkit_dom_html_text_area_element_get_validity = (function(self, + self_2) + { + h$ret1 = 0; + return self["validity"]; + }); +var h$webkit_dom_html_text_area_element_get_validation_message; +h$webkit_dom_html_text_area_element_get_validation_message = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["validationMessage"]); + }); +var h$webkit_dom_html_text_area_element_get_labels; +h$webkit_dom_html_text_area_element_get_labels = (function(self, + self_2) + { + h$ret1 = 0; + return self["labels"]; + }); +var h$webkit_dom_html_text_area_element_set_selection_start; +h$webkit_dom_html_text_area_element_set_selection_start = (function(self, + self_2, val) + { + self["selectionStart"] = val; + }); +var h$webkit_dom_html_text_area_element_get_selection_start; +h$webkit_dom_html_text_area_element_get_selection_start = (function(self, + self_2) + { + return self["selectionStart"]; + }); +var h$webkit_dom_html_text_area_element_set_selection_end; +h$webkit_dom_html_text_area_element_set_selection_end = (function(self, + self_2, val) + { + self["selectionEnd"] = val; + }); +var h$webkit_dom_html_text_area_element_get_selection_end; +h$webkit_dom_html_text_area_element_get_selection_end = (function(self, + self_2) + { + return self["selectionEnd"]; + }); +var h$webkit_dom_html_text_area_element_set_selection_direction; +h$webkit_dom_html_text_area_element_set_selection_direction = (function(self, + self_2, val, + val_2) + { + self["selectionDirection"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_text_area_element_get_selection_direction; +h$webkit_dom_html_text_area_element_get_selection_direction = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["selectionDirection"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_table_section_element_get_type = (function() + { + return h$g_get_type(HTMLTableSectionElement); + }); +var h$webkit_dom_html_table_section_element_insert_row; +h$webkit_dom_html_table_section_element_insert_row = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["insertRow"](index); + }); +var h$webkit_dom_html_table_section_element_delete_row; +h$webkit_dom_html_table_section_element_delete_row = (function(self, + self_2, index) + { + return self["deleteRow"](index); + }); +var h$webkit_dom_html_table_section_element_set_align; +h$webkit_dom_html_table_section_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_section_element_get_align; +h$webkit_dom_html_table_section_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +var h$webkit_dom_html_table_section_element_set_ch; +h$webkit_dom_html_table_section_element_set_ch = (function(self, + self_2, val, val_2) + { + self["ch"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_section_element_get_ch; +h$webkit_dom_html_table_section_element_get_ch = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["ch"]); + }); +var h$webkit_dom_html_table_section_element_set_ch_off; +h$webkit_dom_html_table_section_element_set_ch_off = (function(self, + self_2, val, val_2) + { + self["chOff"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_section_element_get_ch_off; +h$webkit_dom_html_table_section_element_get_ch_off = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["chOff"]); + }); +var h$webkit_dom_html_table_section_element_set_v_align; +h$webkit_dom_html_table_section_element_set_v_align = (function(self, + self_2, val, val_2) + { + self["vAlign"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_section_element_get_v_align; +h$webkit_dom_html_table_section_element_get_v_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["vAlign"]); + }); +var h$webkit_dom_html_table_section_element_get_rows; +h$webkit_dom_html_table_section_element_get_rows = (function(self, + self_2) + { + h$ret1 = 0; + return self["rows"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_table_row_element_get_type = (function() + { + return h$g_get_type(HTMLTableRowElement); + }); +var h$webkit_dom_html_table_row_element_insert_cell; +h$webkit_dom_html_table_row_element_insert_cell = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["insertCell"](index); + }); +var h$webkit_dom_html_table_row_element_delete_cell; +h$webkit_dom_html_table_row_element_delete_cell = (function(self, + self_2, index) + { + return self["deleteCell"](index); + }); +var h$webkit_dom_html_table_row_element_get_row_index; +h$webkit_dom_html_table_row_element_get_row_index = (function(self, + self_2) + { + return self["rowIndex"]; + }); +var h$webkit_dom_html_table_row_element_get_section_row_index; +h$webkit_dom_html_table_row_element_get_section_row_index = (function(self, + self_2) + { + return self["sectionRowIndex"]; + }); +var h$webkit_dom_html_table_row_element_get_cells; +h$webkit_dom_html_table_row_element_get_cells = (function(self, + self_2) + { + h$ret1 = 0; + return self["cells"]; + }); +var h$webkit_dom_html_table_row_element_set_align; +h$webkit_dom_html_table_row_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_row_element_get_align; +h$webkit_dom_html_table_row_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +var h$webkit_dom_html_table_row_element_set_bg_color; +h$webkit_dom_html_table_row_element_set_bg_color = (function(self, + self_2, val, val_2) + { + self["bgColor"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_row_element_get_bg_color; +h$webkit_dom_html_table_row_element_get_bg_color = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["bgColor"]); + }); +var h$webkit_dom_html_table_row_element_set_ch; +h$webkit_dom_html_table_row_element_set_ch = (function(self, + self_2, val, val_2) + { + self["ch"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_row_element_get_ch; +h$webkit_dom_html_table_row_element_get_ch = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["ch"]); + }); +var h$webkit_dom_html_table_row_element_set_ch_off; +h$webkit_dom_html_table_row_element_set_ch_off = (function(self, + self_2, val, val_2) + { + self["chOff"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_row_element_get_ch_off; +h$webkit_dom_html_table_row_element_get_ch_off = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["chOff"]); + }); +var h$webkit_dom_html_table_row_element_set_v_align; +h$webkit_dom_html_table_row_element_set_v_align = (function(self, + self_2, val, val_2) + { + self["vAlign"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_row_element_get_v_align; +h$webkit_dom_html_table_row_element_get_v_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["vAlign"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_table_element_get_type = (function() + { + return h$g_get_type(HTMLTableElement); + }); +var h$webkit_dom_html_table_element_create_t_head; +h$webkit_dom_html_table_element_create_t_head = (function(self, + self_2) + { + h$ret1 = 0; + return self["createTHead"](); + }); +var h$webkit_dom_html_table_element_delete_t_head; +h$webkit_dom_html_table_element_delete_t_head = (function(self, + self_2) + { + return self["deleteTHead"](); + }); +var h$webkit_dom_html_table_element_create_t_foot; +h$webkit_dom_html_table_element_create_t_foot = (function(self, + self_2) + { + h$ret1 = 0; + return self["createTFoot"](); + }); +var h$webkit_dom_html_table_element_delete_t_foot; +h$webkit_dom_html_table_element_delete_t_foot = (function(self, + self_2) + { + return self["deleteTFoot"](); + }); +var h$webkit_dom_html_table_element_create_t_body; +h$webkit_dom_html_table_element_create_t_body = (function(self, + self_2) + { + h$ret1 = 0; + return self["createTBody"](); + }); +var h$webkit_dom_html_table_element_create_caption; +h$webkit_dom_html_table_element_create_caption = (function(self, + self_2) + { + h$ret1 = 0; + return self["createCaption"](); + }); +var h$webkit_dom_html_table_element_delete_caption; +h$webkit_dom_html_table_element_delete_caption = (function(self, + self_2) + { + return self["deleteCaption"](); + }); +var h$webkit_dom_html_table_element_insert_row; +h$webkit_dom_html_table_element_insert_row = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["insertRow"](index); + }); +var h$webkit_dom_html_table_element_delete_row; +h$webkit_dom_html_table_element_delete_row = (function(self, + self_2, index) + { + return self["deleteRow"](index); + }); +var h$webkit_dom_html_table_element_set_caption; +h$webkit_dom_html_table_element_set_caption = (function(self, + self_2, val, val_2) + { + self["caption"] = val; + }); +var h$webkit_dom_html_table_element_get_caption; +h$webkit_dom_html_table_element_get_caption = (function(self, + self_2) + { + h$ret1 = 0; + return self["caption"]; + }); +var h$webkit_dom_html_table_element_set_t_head; +h$webkit_dom_html_table_element_set_t_head = (function(self, + self_2, val, val_2) + { + self["tHead"] = val; + }); +var h$webkit_dom_html_table_element_get_t_head; +h$webkit_dom_html_table_element_get_t_head = (function(self, + self_2) + { + h$ret1 = 0; + return self["tHead"]; + }); +var h$webkit_dom_html_table_element_set_t_foot; +h$webkit_dom_html_table_element_set_t_foot = (function(self, + self_2, val, val_2) + { + self["tFoot"] = val; + }); +var h$webkit_dom_html_table_element_get_t_foot; +h$webkit_dom_html_table_element_get_t_foot = (function(self, + self_2) + { + h$ret1 = 0; + return self["tFoot"]; + }); +var h$webkit_dom_html_table_element_get_rows; +h$webkit_dom_html_table_element_get_rows = (function(self, + self_2) + { + h$ret1 = 0; + return self["rows"]; + }); +var h$webkit_dom_html_table_element_get_t_bodies; +h$webkit_dom_html_table_element_get_t_bodies = (function(self, + self_2) + { + h$ret1 = 0; + return self["tBodies"]; + }); +var h$webkit_dom_html_table_element_set_align; +h$webkit_dom_html_table_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_element_get_align; +h$webkit_dom_html_table_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +var h$webkit_dom_html_table_element_set_bg_color; +h$webkit_dom_html_table_element_set_bg_color = (function(self, + self_2, val, val_2) + { + self["bgColor"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_element_get_bg_color; +h$webkit_dom_html_table_element_get_bg_color = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["bgColor"]); + }); +var h$webkit_dom_html_table_element_set_border; +h$webkit_dom_html_table_element_set_border = (function(self, + self_2, val, val_2) + { + self["border"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_element_get_border; +h$webkit_dom_html_table_element_get_border = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["border"]); + }); +var h$webkit_dom_html_table_element_set_cell_padding; +h$webkit_dom_html_table_element_set_cell_padding = (function(self, + self_2, val, val_2) + { + self["cellPadding"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_element_get_cell_padding; +h$webkit_dom_html_table_element_get_cell_padding = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["cellPadding"]); + }); +var h$webkit_dom_html_table_element_set_cell_spacing; +h$webkit_dom_html_table_element_set_cell_spacing = (function(self, + self_2, val, val_2) + { + self["cellSpacing"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_element_get_cell_spacing; +h$webkit_dom_html_table_element_get_cell_spacing = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["cellSpacing"]); + }); +var h$webkit_dom_html_table_element_set_frame; +h$webkit_dom_html_table_element_set_frame = (function(self, + self_2, val, val_2) + { + self["frame"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_element_get_frame; +h$webkit_dom_html_table_element_get_frame = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["frame"]); + }); +var h$webkit_dom_html_table_element_set_rules; +h$webkit_dom_html_table_element_set_rules = (function(self, + self_2, val, val_2) + { + self["rules"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_element_get_rules; +h$webkit_dom_html_table_element_get_rules = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["rules"]); + }); +var h$webkit_dom_html_table_element_set_summary; +h$webkit_dom_html_table_element_set_summary = (function(self, + self_2, val, val_2) + { + self["summary"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_element_get_summary; +h$webkit_dom_html_table_element_get_summary = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["summary"]); + }); +var h$webkit_dom_html_table_element_set_width; +h$webkit_dom_html_table_element_set_width = (function(self, + self_2, val, val_2) + { + self["width"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_element_get_width; +h$webkit_dom_html_table_element_get_width = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["width"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_table_col_element_get_type = (function() + { + return h$g_get_type(HTMLTableColElement); + }); +var h$webkit_dom_html_table_col_element_set_align; +h$webkit_dom_html_table_col_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_col_element_get_align; +h$webkit_dom_html_table_col_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +var h$webkit_dom_html_table_col_element_set_ch; +h$webkit_dom_html_table_col_element_set_ch = (function(self, + self_2, val, val_2) + { + self["ch"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_col_element_get_ch; +h$webkit_dom_html_table_col_element_get_ch = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["ch"]); + }); +var h$webkit_dom_html_table_col_element_set_ch_off; +h$webkit_dom_html_table_col_element_set_ch_off = (function(self, + self_2, val, val_2) + { + self["chOff"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_col_element_get_ch_off; +h$webkit_dom_html_table_col_element_get_ch_off = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["chOff"]); + }); +var h$webkit_dom_html_table_col_element_set_span; +h$webkit_dom_html_table_col_element_set_span = (function(self, + self_2, val) + { + self["span"] = val; + }); +var h$webkit_dom_html_table_col_element_get_span; +h$webkit_dom_html_table_col_element_get_span = (function(self, + self_2) + { + return self["span"]; + }); +var h$webkit_dom_html_table_col_element_set_v_align; +h$webkit_dom_html_table_col_element_set_v_align = (function(self, + self_2, val, val_2) + { + self["vAlign"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_col_element_get_v_align; +h$webkit_dom_html_table_col_element_get_v_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["vAlign"]); + }); +var h$webkit_dom_html_table_col_element_set_width; +h$webkit_dom_html_table_col_element_set_width = (function(self, + self_2, val, val_2) + { + self["width"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_col_element_get_width; +h$webkit_dom_html_table_col_element_get_width = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["width"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_table_cell_element_get_type = (function() + { + return h$g_get_type(HTMLTableCellElement); + }); +var h$webkit_dom_html_table_cell_element_get_cell_index; +h$webkit_dom_html_table_cell_element_get_cell_index = (function(self, + self_2) + { + return self["cellIndex"]; + }); +var h$webkit_dom_html_table_cell_element_set_abbr; +h$webkit_dom_html_table_cell_element_set_abbr = (function(self, + self_2, val, val_2) + { + self["abbr"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_cell_element_get_abbr; +h$webkit_dom_html_table_cell_element_get_abbr = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["abbr"]); + }); +var h$webkit_dom_html_table_cell_element_set_align; +h$webkit_dom_html_table_cell_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_cell_element_get_align; +h$webkit_dom_html_table_cell_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +var h$webkit_dom_html_table_cell_element_set_axis; +h$webkit_dom_html_table_cell_element_set_axis = (function(self, + self_2, val, val_2) + { + self["axis"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_cell_element_get_axis; +h$webkit_dom_html_table_cell_element_get_axis = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["axis"]); + }); +var h$webkit_dom_html_table_cell_element_set_bg_color; +h$webkit_dom_html_table_cell_element_set_bg_color = (function(self, + self_2, val, val_2) + { + self["bgColor"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_cell_element_get_bg_color; +h$webkit_dom_html_table_cell_element_get_bg_color = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["bgColor"]); + }); +var h$webkit_dom_html_table_cell_element_set_ch; +h$webkit_dom_html_table_cell_element_set_ch = (function(self, + self_2, val, val_2) + { + self["ch"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_cell_element_get_ch; +h$webkit_dom_html_table_cell_element_get_ch = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["ch"]); + }); +var h$webkit_dom_html_table_cell_element_set_ch_off; +h$webkit_dom_html_table_cell_element_set_ch_off = (function(self, + self_2, val, val_2) + { + self["chOff"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_cell_element_get_ch_off; +h$webkit_dom_html_table_cell_element_get_ch_off = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["chOff"]); + }); +var h$webkit_dom_html_table_cell_element_set_col_span; +h$webkit_dom_html_table_cell_element_set_col_span = (function(self, + self_2, val) + { + self["colSpan"] = val; + }); +var h$webkit_dom_html_table_cell_element_get_col_span; +h$webkit_dom_html_table_cell_element_get_col_span = (function(self, + self_2) + { + return self["colSpan"]; + }); +var h$webkit_dom_html_table_cell_element_set_headers; +h$webkit_dom_html_table_cell_element_set_headers = (function(self, + self_2, val, val_2) + { + self["headers"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_cell_element_get_headers; +h$webkit_dom_html_table_cell_element_get_headers = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["headers"]); + }); +var h$webkit_dom_html_table_cell_element_set_height; +h$webkit_dom_html_table_cell_element_set_height = (function(self, + self_2, val, val_2) + { + self["height"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_cell_element_get_height; +h$webkit_dom_html_table_cell_element_get_height = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["height"]); + }); +var h$webkit_dom_html_table_cell_element_set_no_wrap; +h$webkit_dom_html_table_cell_element_set_no_wrap = (function(self, + self_2, val) + { + self["noWrap"] = val; + }); +var h$webkit_dom_html_table_cell_element_get_no_wrap; +h$webkit_dom_html_table_cell_element_get_no_wrap = (function(self, + self_2) + { + return self["noWrap"]; + }); +var h$webkit_dom_html_table_cell_element_set_row_span; +h$webkit_dom_html_table_cell_element_set_row_span = (function(self, + self_2, val) + { + self["rowSpan"] = val; + }); +var h$webkit_dom_html_table_cell_element_get_row_span; +h$webkit_dom_html_table_cell_element_get_row_span = (function(self, + self_2) + { + return self["rowSpan"]; + }); +var h$webkit_dom_html_table_cell_element_set_scope; +h$webkit_dom_html_table_cell_element_set_scope = (function(self, + self_2, val, val_2) + { + self["scope"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_cell_element_get_scope; +h$webkit_dom_html_table_cell_element_get_scope = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["scope"]); + }); +var h$webkit_dom_html_table_cell_element_set_v_align; +h$webkit_dom_html_table_cell_element_set_v_align = (function(self, + self_2, val, val_2) + { + self["vAlign"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_cell_element_get_v_align; +h$webkit_dom_html_table_cell_element_get_v_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["vAlign"]); + }); +var h$webkit_dom_html_table_cell_element_set_width; +h$webkit_dom_html_table_cell_element_set_width = (function(self, + self_2, val, val_2) + { + self["width"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_cell_element_get_width; +h$webkit_dom_html_table_cell_element_get_width = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["width"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_table_caption_element_get_type = (function() + { + return h$g_get_type(HTMLTableCaptionElement); + }); +var h$webkit_dom_html_table_caption_element_set_align; +h$webkit_dom_html_table_caption_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_table_caption_element_get_align; +h$webkit_dom_html_table_caption_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_style_element_get_type = (function() + { + return h$g_get_type(HTMLStyleElement); + }); +var h$webkit_dom_html_style_element_set_disabled; +h$webkit_dom_html_style_element_set_disabled = (function(self, + self_2, val) + { + self["disabled"] = val; + }); +var h$webkit_dom_html_style_element_get_disabled; +h$webkit_dom_html_style_element_get_disabled = (function(self, + self_2) + { + return self["disabled"]; + }); +var h$webkit_dom_html_style_element_set_scoped; +h$webkit_dom_html_style_element_set_scoped = (function(self, + self_2, val) + { + self["scoped"] = val; + }); +var h$webkit_dom_html_style_element_get_scoped; +h$webkit_dom_html_style_element_get_scoped = (function(self, + self_2) + { + return self["scoped"]; + }); +var h$webkit_dom_html_style_element_set_media; +h$webkit_dom_html_style_element_set_media = (function(self, + self_2, val, val_2) + { + self["media"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_style_element_get_media; +h$webkit_dom_html_style_element_get_media = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["media"]); + }); +var h$webkit_dom_html_style_element_get_sheet; +h$webkit_dom_html_style_element_get_sheet = (function(self, + self_2) + { + h$ret1 = 0; + return self["sheet"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_select_element_get_type = (function() + { + return h$g_get_type(HTMLSelectElement); + }); +var h$webkit_dom_html_select_element_item; +h$webkit_dom_html_select_element_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["item"](index); + }); +var h$webkit_dom_html_select_element_named_item; +h$webkit_dom_html_select_element_named_item = (function(self, + self_2, name, name_2) + { + h$ret1 = 0; + return self["namedItem"](h$decodeUtf8z(name, + name_2)); + }); +var h$webkit_dom_html_select_element_add; +h$webkit_dom_html_select_element_add = (function(self, + self_2, element, element_2, + before, before_2) + { + return self["add"](element, + before); + }); +var h$webkit_dom_html_select_element_remove; +h$webkit_dom_html_select_element_remove = (function(self, + self_2, index) + { + return self["remove"](index); + }); +var h$webkit_dom_html_select_element_check_validity; +h$webkit_dom_html_select_element_check_validity = (function(self, + self_2) + { + return self["checkValidity"](); + }); +var h$webkit_dom_html_select_element_set_custom_validity; +h$webkit_dom_html_select_element_set_custom_validity = (function(self, + self_2, error, error_2) + { + return self["setCustomValidity"](h$decodeUtf8z(error, + error_2)); + }); +var h$webkit_dom_html_select_element_set_autofocus; +h$webkit_dom_html_select_element_set_autofocus = (function(self, + self_2, val) + { + self["autofocus"] = val; + }); +var h$webkit_dom_html_select_element_get_autofocus; +h$webkit_dom_html_select_element_get_autofocus = (function(self, + self_2) + { + return self["autofocus"]; + }); +var h$webkit_dom_html_select_element_set_disabled; +h$webkit_dom_html_select_element_set_disabled = (function(self, + self_2, val) + { + self["disabled"] = val; + }); +var h$webkit_dom_html_select_element_get_disabled; +h$webkit_dom_html_select_element_get_disabled = (function(self, + self_2) + { + return self["disabled"]; + }); +var h$webkit_dom_html_select_element_get_form; +h$webkit_dom_html_select_element_get_form = (function(self, + self_2) + { + h$ret1 = 0; + return self["form"]; + }); +var h$webkit_dom_html_select_element_set_multiple; +h$webkit_dom_html_select_element_set_multiple = (function(self, + self_2, val) + { + self["multiple"] = val; + }); +var h$webkit_dom_html_select_element_get_multiple; +h$webkit_dom_html_select_element_get_multiple = (function(self, + self_2) + { + return self["multiple"]; + }); +var h$webkit_dom_html_select_element_set_name; +h$webkit_dom_html_select_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_select_element_get_name; +h$webkit_dom_html_select_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_select_element_set_required; +h$webkit_dom_html_select_element_set_required = (function(self, + self_2, val) + { + self["required"] = val; + }); +var h$webkit_dom_html_select_element_get_required; +h$webkit_dom_html_select_element_get_required = (function(self, + self_2) + { + return self["required"]; + }); +var h$webkit_dom_html_select_element_set_size; +h$webkit_dom_html_select_element_set_size = (function(self, + self_2, val) + { + self["size"] = val; + }); +var h$webkit_dom_html_select_element_get_size; +h$webkit_dom_html_select_element_get_size = (function(self, + self_2) + { + return self["size"]; + }); +var h$webkit_dom_html_select_element_get_options; +h$webkit_dom_html_select_element_get_options = (function(self, + self_2) + { + h$ret1 = 0; + return self["options"]; + }); +var h$webkit_dom_html_select_element_set_length; +h$webkit_dom_html_select_element_set_length = (function(self, + self_2, val) + { + self["length"] = val; + }); +var h$webkit_dom_html_select_element_get_length; +h$webkit_dom_html_select_element_get_length = (function(self, + self_2) + { + return self["length"]; + }); +var h$webkit_dom_html_select_element_get_selected_options; +h$webkit_dom_html_select_element_get_selected_options = (function(self, + self_2) + { + h$ret1 = 0; + return self["selectedOptions"]; + }); +var h$webkit_dom_html_select_element_set_selected_index; +h$webkit_dom_html_select_element_set_selected_index = (function(self, + self_2, val) + { + self["selectedIndex"] = val; + }); +var h$webkit_dom_html_select_element_get_selected_index; +h$webkit_dom_html_select_element_get_selected_index = (function(self, + self_2) + { + return self["selectedIndex"]; + }); +var h$webkit_dom_html_select_element_set_value; +h$webkit_dom_html_select_element_set_value = (function(self, + self_2, val, val_2) + { + self["value"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_select_element_get_value; +h$webkit_dom_html_select_element_get_value = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["value"]); + }); +var h$webkit_dom_html_select_element_get_will_validate; +h$webkit_dom_html_select_element_get_will_validate = (function(self, + self_2) + { + return self["willValidate"]; + }); +var h$webkit_dom_html_select_element_get_validity; +h$webkit_dom_html_select_element_get_validity = (function(self, + self_2) + { + h$ret1 = 0; + return self["validity"]; + }); +var h$webkit_dom_html_select_element_get_validation_message; +h$webkit_dom_html_select_element_get_validation_message = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["validationMessage"]); + }); +var h$webkit_dom_html_select_element_get_labels; +h$webkit_dom_html_select_element_get_labels = (function(self, + self_2) + { + h$ret1 = 0; + return self["labels"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_script_element_get_type = (function() + { + return h$g_get_type(HTMLScriptElement); + }); +var h$webkit_dom_html_script_element_set_text; +h$webkit_dom_html_script_element_set_text = (function(self, + self_2, val, val_2) + { + self["text"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_script_element_get_text; +h$webkit_dom_html_script_element_get_text = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["text"]); + }); +var h$webkit_dom_html_script_element_set_html_for; +h$webkit_dom_html_script_element_set_html_for = (function(self, + self_2, val, val_2) + { + self["htmlFor"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_script_element_get_html_for; +h$webkit_dom_html_script_element_get_html_for = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["htmlFor"]); + }); +var h$webkit_dom_html_script_element_set_event; +h$webkit_dom_html_script_element_set_event = (function(self, + self_2, val, val_2) + { + self["event"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_script_element_get_event; +h$webkit_dom_html_script_element_get_event = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["event"]); + }); +var h$webkit_dom_html_script_element_set_charset; +h$webkit_dom_html_script_element_set_charset = (function(self, + self_2, val, val_2) + { + self["charset"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_script_element_get_charset; +h$webkit_dom_html_script_element_get_charset = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["charset"]); + }); +var h$webkit_dom_html_script_element_set_async; +h$webkit_dom_html_script_element_set_async = (function(self, + self_2, val) + { + self["async"] = val; + }); +var h$webkit_dom_html_script_element_get_async; +h$webkit_dom_html_script_element_get_async = (function(self, + self_2) + { + return self["async"]; + }); +var h$webkit_dom_html_script_element_set_defer; +h$webkit_dom_html_script_element_set_defer = (function(self, + self_2, val) + { + self["defer"] = val; + }); +var h$webkit_dom_html_script_element_get_defer; +h$webkit_dom_html_script_element_get_defer = (function(self, + self_2) + { + return self["defer"]; + }); +var h$webkit_dom_html_script_element_set_src; +h$webkit_dom_html_script_element_set_src = (function(self, + self_2, val, val_2) + { + self["src"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_script_element_get_src; +h$webkit_dom_html_script_element_get_src = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["src"]); + }); +var h$webkit_dom_html_script_element_set_cross_origin; +h$webkit_dom_html_script_element_set_cross_origin = (function(self, + self_2, val, val_2) + { + self["crossOrigin"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_script_element_get_cross_origin; +h$webkit_dom_html_script_element_get_cross_origin = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["crossOrigin"]); + }); +var h$webkit_dom_html_script_element_set_nonce; +h$webkit_dom_html_script_element_set_nonce = (function(self, + self_2, val, val_2) + { + self["nonce"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_script_element_get_nonce; +h$webkit_dom_html_script_element_get_nonce = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["nonce"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_quote_element_get_type = (function() + { + return h$g_get_type(HTMLQuoteElement); + }); +var h$webkit_dom_html_quote_element_set_cite; +h$webkit_dom_html_quote_element_set_cite = (function(self, + self_2, val, val_2) + { + self["cite"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_quote_element_get_cite; +h$webkit_dom_html_quote_element_get_cite = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["cite"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_pre_element_get_type = (function() + { + return h$g_get_type(HTMLPreElement); + }); +var h$webkit_dom_html_pre_element_set_width; +h$webkit_dom_html_pre_element_set_width = (function(self, + self_2, val) + { + self["width"] = val; + }); +var h$webkit_dom_html_pre_element_get_width; +h$webkit_dom_html_pre_element_get_width = (function(self, + self_2) + { + return self["width"]; + }); +var h$webkit_dom_html_pre_element_set_wrap; +h$webkit_dom_html_pre_element_set_wrap = (function(self, + self_2, val) + { + self["wrap"] = val; + }); +var h$webkit_dom_html_pre_element_get_wrap; +h$webkit_dom_html_pre_element_get_wrap = (function(self, + self_2) + { + return self["wrap"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_param_element_get_type = (function() + { + return h$g_get_type(HTMLParamElement); + }); +var h$webkit_dom_html_param_element_set_name; +h$webkit_dom_html_param_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_param_element_get_name; +h$webkit_dom_html_param_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_param_element_set_value; +h$webkit_dom_html_param_element_set_value = (function(self, + self_2, val, val_2) + { + self["value"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_param_element_get_value; +h$webkit_dom_html_param_element_get_value = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["value"]); + }); +var h$webkit_dom_html_param_element_set_value_type; +h$webkit_dom_html_param_element_set_value_type = (function(self, + self_2, val, val_2) + { + self["valueType"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_param_element_get_value_type; +h$webkit_dom_html_param_element_get_value_type = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["valueType"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_paragraph_element_get_type = (function() + { + return h$g_get_type(HTMLParagraphElement); + }); +var h$webkit_dom_html_paragraph_element_set_align; +h$webkit_dom_html_paragraph_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_paragraph_element_get_align; +h$webkit_dom_html_paragraph_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_options_collection_get_type = (function() + { + return h$g_get_type(HTMLOptionsCollection); + }); +var h$webkit_dom_html_options_collection_set_selected_index; +h$webkit_dom_html_options_collection_set_selected_index = (function(self, + self_2, val) + { + self["selectedIndex"] = val; + }); +var h$webkit_dom_html_options_collection_get_selected_index; +h$webkit_dom_html_options_collection_get_selected_index = (function(self, + self_2) + { + return self["selectedIndex"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_option_element_get_type = (function() + { + return h$g_get_type(HTMLOptionElement); + }); +var h$webkit_dom_html_option_element_set_disabled; +h$webkit_dom_html_option_element_set_disabled = (function(self, + self_2, val) + { + self["disabled"] = val; + }); +var h$webkit_dom_html_option_element_get_disabled; +h$webkit_dom_html_option_element_get_disabled = (function(self, + self_2) + { + return self["disabled"]; + }); +var h$webkit_dom_html_option_element_get_form; +h$webkit_dom_html_option_element_get_form = (function(self, + self_2) + { + h$ret1 = 0; + return self["form"]; + }); +var h$webkit_dom_html_option_element_set_label; +h$webkit_dom_html_option_element_set_label = (function(self, + self_2, val, val_2) + { + self["label"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_option_element_get_label; +h$webkit_dom_html_option_element_get_label = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["label"]); + }); +var h$webkit_dom_html_option_element_set_default_selected; +h$webkit_dom_html_option_element_set_default_selected = (function(self, + self_2, val) + { + self["defaultSelected"] = val; + }); +var h$webkit_dom_html_option_element_get_default_selected; +h$webkit_dom_html_option_element_get_default_selected = (function(self, + self_2) + { + return self["defaultSelected"]; + }); +var h$webkit_dom_html_option_element_set_selected; +h$webkit_dom_html_option_element_set_selected = (function(self, + self_2, val) + { + self["selected"] = val; + }); +var h$webkit_dom_html_option_element_get_selected; +h$webkit_dom_html_option_element_get_selected = (function(self, + self_2) + { + return self["selected"]; + }); +var h$webkit_dom_html_option_element_set_value; +h$webkit_dom_html_option_element_set_value = (function(self, + self_2, val, val_2) + { + self["value"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_option_element_get_value; +h$webkit_dom_html_option_element_get_value = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["value"]); + }); +var h$webkit_dom_html_option_element_get_text; +h$webkit_dom_html_option_element_get_text = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["text"]); + }); +var h$webkit_dom_html_option_element_get_index; +h$webkit_dom_html_option_element_get_index = (function(self, + self_2) + { + return self["index"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_opt_group_element_get_type = (function() + { + return h$g_get_type(HTMLOptGroupElement); + }); +var h$webkit_dom_html_opt_group_element_set_disabled; +h$webkit_dom_html_opt_group_element_set_disabled = (function(self, + self_2, val) + { + self["disabled"] = val; + }); +var h$webkit_dom_html_opt_group_element_get_disabled; +h$webkit_dom_html_opt_group_element_get_disabled = (function(self, + self_2) + { + return self["disabled"]; + }); +var h$webkit_dom_html_opt_group_element_set_label; +h$webkit_dom_html_opt_group_element_set_label = (function(self, + self_2, val, val_2) + { + self["label"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_opt_group_element_get_label; +h$webkit_dom_html_opt_group_element_get_label = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["label"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_htmlo_list_element_get_type = (function() + { + return h$g_get_type(HTMLOListElement); + }); +var h$webkit_dom_htmlo_list_element_set_compact; +h$webkit_dom_htmlo_list_element_set_compact = (function(self, + self_2, val) + { + self["compact"] = val; + }); +var h$webkit_dom_htmlo_list_element_get_compact; +h$webkit_dom_htmlo_list_element_get_compact = (function(self, + self_2) + { + return self["compact"]; + }); +var h$webkit_dom_htmlo_list_element_set_start; +h$webkit_dom_htmlo_list_element_set_start = (function(self, + self_2, val) + { + self["start"] = val; + }); +var h$webkit_dom_htmlo_list_element_get_start; +h$webkit_dom_htmlo_list_element_get_start = (function(self, + self_2) + { + return self["start"]; + }); +var h$webkit_dom_htmlo_list_element_set_reversed; +h$webkit_dom_htmlo_list_element_set_reversed = (function(self, + self_2, val) + { + self["reversed"] = val; + }); +var h$webkit_dom_htmlo_list_element_get_reversed; +h$webkit_dom_htmlo_list_element_get_reversed = (function(self, + self_2) + { + return self["reversed"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_object_element_get_type = (function() + { + return h$g_get_type(HTMLObjectElement); + }); +var h$webkit_dom_html_object_element_check_validity; +h$webkit_dom_html_object_element_check_validity = (function(self, + self_2) + { + return self["checkValidity"](); + }); +var h$webkit_dom_html_object_element_set_custom_validity; +h$webkit_dom_html_object_element_set_custom_validity = (function(self, + self_2, error, error_2) + { + return self["setCustomValidity"](h$decodeUtf8z(error, + error_2)); + }); +var h$webkit_dom_html_object_element_get_form; +h$webkit_dom_html_object_element_get_form = (function(self, + self_2) + { + h$ret1 = 0; + return self["form"]; + }); +var h$webkit_dom_html_object_element_set_code; +h$webkit_dom_html_object_element_set_code = (function(self, + self_2, val, val_2) + { + self["code"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_object_element_get_code; +h$webkit_dom_html_object_element_get_code = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["code"]); + }); +var h$webkit_dom_html_object_element_set_align; +h$webkit_dom_html_object_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_object_element_get_align; +h$webkit_dom_html_object_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +var h$webkit_dom_html_object_element_set_archive; +h$webkit_dom_html_object_element_set_archive = (function(self, + self_2, val, val_2) + { + self["archive"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_object_element_get_archive; +h$webkit_dom_html_object_element_get_archive = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["archive"]); + }); +var h$webkit_dom_html_object_element_set_border; +h$webkit_dom_html_object_element_set_border = (function(self, + self_2, val, val_2) + { + self["border"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_object_element_get_border; +h$webkit_dom_html_object_element_get_border = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["border"]); + }); +var h$webkit_dom_html_object_element_set_code_base; +h$webkit_dom_html_object_element_set_code_base = (function(self, + self_2, val, val_2) + { + self["codeBase"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_object_element_get_code_base; +h$webkit_dom_html_object_element_get_code_base = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["codeBase"]); + }); +var h$webkit_dom_html_object_element_set_code_type; +h$webkit_dom_html_object_element_set_code_type = (function(self, + self_2, val, val_2) + { + self["codeType"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_object_element_get_code_type; +h$webkit_dom_html_object_element_get_code_type = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["codeType"]); + }); +var h$webkit_dom_html_object_element_set_data; +h$webkit_dom_html_object_element_set_data = (function(self, + self_2, val, val_2) + { + self["data"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_object_element_get_data; +h$webkit_dom_html_object_element_get_data = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["data"]); + }); +var h$webkit_dom_html_object_element_set_declare; +h$webkit_dom_html_object_element_set_declare = (function(self, + self_2, val) + { + self["declare"] = val; + }); +var h$webkit_dom_html_object_element_get_declare; +h$webkit_dom_html_object_element_get_declare = (function(self, + self_2) + { + return self["declare"]; + }); +var h$webkit_dom_html_object_element_set_height; +h$webkit_dom_html_object_element_set_height = (function(self, + self_2, val, val_2) + { + self["height"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_object_element_get_height; +h$webkit_dom_html_object_element_get_height = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["height"]); + }); +var h$webkit_dom_html_object_element_set_hspace; +h$webkit_dom_html_object_element_set_hspace = (function(self, + self_2, val) + { + self["hspace"] = val; + }); +var h$webkit_dom_html_object_element_get_hspace; +h$webkit_dom_html_object_element_get_hspace = (function(self, + self_2) + { + return self["hspace"]; + }); +var h$webkit_dom_html_object_element_set_name; +h$webkit_dom_html_object_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_object_element_get_name; +h$webkit_dom_html_object_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_object_element_set_standby; +h$webkit_dom_html_object_element_set_standby = (function(self, + self_2, val, val_2) + { + self["standby"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_object_element_get_standby; +h$webkit_dom_html_object_element_get_standby = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["standby"]); + }); +var h$webkit_dom_html_object_element_set_use_map; +h$webkit_dom_html_object_element_set_use_map = (function(self, + self_2, val, val_2) + { + self["useMap"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_object_element_get_use_map; +h$webkit_dom_html_object_element_get_use_map = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["useMap"]); + }); +var h$webkit_dom_html_object_element_set_vspace; +h$webkit_dom_html_object_element_set_vspace = (function(self, + self_2, val) + { + self["vspace"] = val; + }); +var h$webkit_dom_html_object_element_get_vspace; +h$webkit_dom_html_object_element_get_vspace = (function(self, + self_2) + { + return self["vspace"]; + }); +var h$webkit_dom_html_object_element_set_width; +h$webkit_dom_html_object_element_set_width = (function(self, + self_2, val, val_2) + { + self["width"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_object_element_get_width; +h$webkit_dom_html_object_element_get_width = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["width"]); + }); +var h$webkit_dom_html_object_element_get_will_validate; +h$webkit_dom_html_object_element_get_will_validate = (function(self, + self_2) + { + return self["willValidate"]; + }); +var h$webkit_dom_html_object_element_get_validity; +h$webkit_dom_html_object_element_get_validity = (function(self, + self_2) + { + h$ret1 = 0; + return self["validity"]; + }); +var h$webkit_dom_html_object_element_get_validation_message; +h$webkit_dom_html_object_element_get_validation_message = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["validationMessage"]); + }); +var h$webkit_dom_html_object_element_get_content_document; +h$webkit_dom_html_object_element_get_content_document = (function(self, + self_2) + { + h$ret1 = 0; + return self["contentDocument"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_mod_element_get_type = (function() + { + return h$g_get_type(HTMLModElement); + }); +var h$webkit_dom_html_mod_element_set_cite; +h$webkit_dom_html_mod_element_set_cite = (function(self, + self_2, val, val_2) + { + self["cite"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_mod_element_get_cite; +h$webkit_dom_html_mod_element_get_cite = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["cite"]); + }); +var h$webkit_dom_html_mod_element_set_date_time; +h$webkit_dom_html_mod_element_set_date_time = (function(self, + self_2, val, val_2) + { + self["dateTime"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_mod_element_get_date_time; +h$webkit_dom_html_mod_element_get_date_time = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["dateTime"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_meta_element_get_type = (function() + { + return h$g_get_type(HTMLMetaElement); + }); +var h$webkit_dom_html_meta_element_set_content; +h$webkit_dom_html_meta_element_set_content = (function(self, + self_2, val, val_2) + { + self["content"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_meta_element_get_content; +h$webkit_dom_html_meta_element_get_content = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["content"]); + }); +var h$webkit_dom_html_meta_element_set_http_equiv; +h$webkit_dom_html_meta_element_set_http_equiv = (function(self, + self_2, val, val_2) + { + self["httpEquiv"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_meta_element_get_http_equiv; +h$webkit_dom_html_meta_element_get_http_equiv = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["httpEquiv"]); + }); +var h$webkit_dom_html_meta_element_set_name; +h$webkit_dom_html_meta_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_meta_element_get_name; +h$webkit_dom_html_meta_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_meta_element_set_scheme; +h$webkit_dom_html_meta_element_set_scheme = (function(self, + self_2, val, val_2) + { + self["scheme"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_meta_element_get_scheme; +h$webkit_dom_html_meta_element_get_scheme = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["scheme"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_menu_element_get_type = (function() + { + return h$g_get_type(HTMLMenuElement); + }); +var h$webkit_dom_html_menu_element_set_compact; +h$webkit_dom_html_menu_element_set_compact = (function(self, + self_2, val) + { + self["compact"] = val; + }); +var h$webkit_dom_html_menu_element_get_compact; +h$webkit_dom_html_menu_element_get_compact = (function(self, + self_2) + { + return self["compact"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_audio_element_get_type = (function() + { + return h$g_get_type(HTMLAudioElement); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_media_element_get_type = (function() + { + return h$g_get_type(HTMLMediaElement); + }); +var h$webkit_dom_html_media_element_load; +h$webkit_dom_html_media_element_load = (function(self, + self_2) + { + return self["load"](); + }); +var h$webkit_dom_html_media_element_can_play_type; +h$webkit_dom_html_media_element_can_play_type = (function(self, + self_2, type, type_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["canPlayType"](h$decodeUtf8z(type, + type_2))); + }); +var h$webkit_dom_html_media_element_play; +h$webkit_dom_html_media_element_play = (function(self, + self_2) + { + return self["play"](); + }); +var h$webkit_dom_html_media_element_pause; +h$webkit_dom_html_media_element_pause = (function(self, + self_2) + { + return self["pause"](); + }); +var h$webkit_dom_html_media_element_get_error; +h$webkit_dom_html_media_element_get_error = (function(self, + self_2) + { + h$ret1 = 0; + return self["error"]; + }); +var h$webkit_dom_html_media_element_set_src; +h$webkit_dom_html_media_element_set_src = (function(self, + self_2, val, val_2) + { + self["src"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_media_element_get_src; +h$webkit_dom_html_media_element_get_src = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["src"]); + }); +var h$webkit_dom_html_media_element_get_current_src; +h$webkit_dom_html_media_element_get_current_src = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["currentSrc"]); + }); +var h$webkit_dom_html_media_element_get_network_state; +h$webkit_dom_html_media_element_get_network_state = (function(self, + self_2) + { + return self["networkState"]; + }); +var h$webkit_dom_html_media_element_set_preload; +h$webkit_dom_html_media_element_set_preload = (function(self, + self_2, val, val_2) + { + self["preload"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_media_element_get_preload; +h$webkit_dom_html_media_element_get_preload = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["preload"]); + }); +var h$webkit_dom_html_media_element_get_buffered; +h$webkit_dom_html_media_element_get_buffered = (function(self, + self_2) + { + h$ret1 = 0; + return self["buffered"]; + }); +var h$webkit_dom_html_media_element_get_ready_state; +h$webkit_dom_html_media_element_get_ready_state = (function(self, + self_2) + { + return self["readyState"]; + }); +var h$webkit_dom_html_media_element_get_seeking; +h$webkit_dom_html_media_element_get_seeking = (function(self, + self_2) + { + return self["seeking"]; + }); +var h$webkit_dom_html_media_element_set_current_time; +h$webkit_dom_html_media_element_set_current_time = (function(self, + self_2, val) + { + self["currentTime"] = val; + }); +var h$webkit_dom_html_media_element_get_current_time; +h$webkit_dom_html_media_element_get_current_time = (function(self, + self_2) + { + return self["currentTime"]; + }); +var h$webkit_dom_html_media_element_get_initial_time; +h$webkit_dom_html_media_element_get_initial_time = (function(self, + self_2) + { + return self["initialTime"]; + }); +var h$webkit_dom_html_media_element_get_start_time; +h$webkit_dom_html_media_element_get_start_time = (function(self, + self_2) + { + return self["startTime"]; + }); +var h$webkit_dom_html_media_element_get_duration; +h$webkit_dom_html_media_element_get_duration = (function(self, + self_2) + { + return self["duration"]; + }); +var h$webkit_dom_html_media_element_get_paused; +h$webkit_dom_html_media_element_get_paused = (function(self, + self_2) + { + return self["paused"]; + }); +var h$webkit_dom_html_media_element_set_default_playback_rate; +h$webkit_dom_html_media_element_set_default_playback_rate = (function(self, + self_2, val) + { + self["defaultPlaybackRate"] = val; + }); +var h$webkit_dom_html_media_element_get_default_playback_rate; +h$webkit_dom_html_media_element_get_default_playback_rate = (function(self, + self_2) + { + return self["defaultPlaybackRate"]; + }); +var h$webkit_dom_html_media_element_set_playback_rate; +h$webkit_dom_html_media_element_set_playback_rate = (function(self, + self_2, val) + { + self["playbackRate"] = val; + }); +var h$webkit_dom_html_media_element_get_playback_rate; +h$webkit_dom_html_media_element_get_playback_rate = (function(self, + self_2) + { + return self["playbackRate"]; + }); +var h$webkit_dom_html_media_element_get_played; +h$webkit_dom_html_media_element_get_played = (function(self, + self_2) + { + h$ret1 = 0; + return self["played"]; + }); +var h$webkit_dom_html_media_element_get_seekable; +h$webkit_dom_html_media_element_get_seekable = (function(self, + self_2) + { + h$ret1 = 0; + return self["seekable"]; + }); +var h$webkit_dom_html_media_element_get_ended; +h$webkit_dom_html_media_element_get_ended = (function(self, + self_2) + { + return self["ended"]; + }); +var h$webkit_dom_html_media_element_set_autoplay; +h$webkit_dom_html_media_element_set_autoplay = (function(self, + self_2, val) + { + self["autoplay"] = val; + }); +var h$webkit_dom_html_media_element_get_autoplay; +h$webkit_dom_html_media_element_get_autoplay = (function(self, + self_2) + { + return self["autoplay"]; + }); +var h$webkit_dom_html_media_element_set_loop; +h$webkit_dom_html_media_element_set_loop = (function(self, + self_2, val) + { + self["loop"] = val; + }); +var h$webkit_dom_html_media_element_get_loop; +h$webkit_dom_html_media_element_get_loop = (function(self, + self_2) + { + return self["loop"]; + }); +var h$webkit_dom_html_media_element_set_controls; +h$webkit_dom_html_media_element_set_controls = (function(self, + self_2, val) + { + self["controls"] = val; + }); +var h$webkit_dom_html_media_element_get_controls; +h$webkit_dom_html_media_element_get_controls = (function(self, + self_2) + { + return self["controls"]; + }); +var h$webkit_dom_html_media_element_set_volume; +h$webkit_dom_html_media_element_set_volume = (function(self, + self_2, val) + { + self["volume"] = val; + }); +var h$webkit_dom_html_media_element_get_volume; +h$webkit_dom_html_media_element_get_volume = (function(self, + self_2) + { + return self["volume"]; + }); +var h$webkit_dom_html_media_element_set_muted; +h$webkit_dom_html_media_element_set_muted = (function(self, + self_2, val) + { + self["muted"] = val; + }); +var h$webkit_dom_html_media_element_get_muted; +h$webkit_dom_html_media_element_get_muted = (function(self, + self_2) + { + return self["muted"]; + }); +var h$webkit_dom_html_media_element_set_default_muted; +h$webkit_dom_html_media_element_set_default_muted = (function(self, + self_2, val) + { + self["defaultMuted"] = val; + }); +var h$webkit_dom_html_media_element_get_default_muted; +h$webkit_dom_html_media_element_get_default_muted = (function(self, + self_2) + { + return self["defaultMuted"]; + }); +var h$webkit_dom_html_media_element_set_webkit_preserves_pitch; +h$webkit_dom_html_media_element_set_webkit_preserves_pitch = (function(self, + self_2, val) + { + self["webkitPreservesPitch"] = val; + }); +var h$webkit_dom_html_media_element_get_webkit_preserves_pitch; +h$webkit_dom_html_media_element_get_webkit_preserves_pitch = (function(self, + self_2) + { + return self["webkitPreservesPitch"]; + }); +var h$webkit_dom_html_media_element_get_webkit_has_closed_captions; +h$webkit_dom_html_media_element_get_webkit_has_closed_captions = (function(self, + self_2) + { + return self["webkitHasClosedCaptions"]; + }); +var h$webkit_dom_html_media_element_set_webkit_closed_captions_visible; +h$webkit_dom_html_media_element_set_webkit_closed_captions_visible = (function(self, + self_2, + val) + { + self["webkitClosedCaptionsVisible"] = val; + }); +var h$webkit_dom_html_media_element_get_webkit_closed_captions_visible; +h$webkit_dom_html_media_element_get_webkit_closed_captions_visible = (function(self, + self_2) + { + return self["webkitClosedCaptionsVisible"]; + }); +var h$webkit_dom_html_media_element_get_webkit_audio_decoded_byte_count; +h$webkit_dom_html_media_element_get_webkit_audio_decoded_byte_count = (function(self, + self_2) + { + return self["webkitAudioDecodedByteCount"]; + }); +var h$webkit_dom_html_media_element_get_webkit_video_decoded_byte_count; +h$webkit_dom_html_media_element_get_webkit_video_decoded_byte_count = (function(self, + self_2) + { + return self["webkitVideoDecodedByteCount"]; + }); +var h$webkit_dom_html_media_element_set_media_group; +h$webkit_dom_html_media_element_set_media_group = (function(self, + self_2, val, val_2) + { + self["mediaGroup"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_media_element_get_media_group; +h$webkit_dom_html_media_element_get_media_group = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["mediaGroup"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_marquee_element_get_type = (function() + { + return h$g_get_type(HTMLMarqueeElement); + }); +var h$webkit_dom_html_marquee_element_start; +h$webkit_dom_html_marquee_element_start = (function(self, + self_2) + { + return self["start"](); + }); +var h$webkit_dom_html_marquee_element_stop; +h$webkit_dom_html_marquee_element_stop = (function(self, + self_2) + { + return self["stop"](); + }); +var h$webkit_dom_html_marquee_element_set_behavior; +h$webkit_dom_html_marquee_element_set_behavior = (function(self, + self_2, val, val_2) + { + self["behavior"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_marquee_element_get_behavior; +h$webkit_dom_html_marquee_element_get_behavior = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["behavior"]); + }); +var h$webkit_dom_html_marquee_element_set_bg_color; +h$webkit_dom_html_marquee_element_set_bg_color = (function(self, + self_2, val, val_2) + { + self["bgColor"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_marquee_element_get_bg_color; +h$webkit_dom_html_marquee_element_get_bg_color = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["bgColor"]); + }); +var h$webkit_dom_html_marquee_element_set_direction; +h$webkit_dom_html_marquee_element_set_direction = (function(self, + self_2, val, val_2) + { + self["direction"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_marquee_element_get_direction; +h$webkit_dom_html_marquee_element_get_direction = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["direction"]); + }); +var h$webkit_dom_html_marquee_element_set_height; +h$webkit_dom_html_marquee_element_set_height = (function(self, + self_2, val, val_2) + { + self["height"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_marquee_element_get_height; +h$webkit_dom_html_marquee_element_get_height = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["height"]); + }); +var h$webkit_dom_html_marquee_element_set_hspace; +h$webkit_dom_html_marquee_element_set_hspace = (function(self, + self_2, val) + { + self["hspace"] = val; + }); +var h$webkit_dom_html_marquee_element_get_hspace; +h$webkit_dom_html_marquee_element_get_hspace = (function(self, + self_2) + { + return self["hspace"]; + }); +var h$webkit_dom_html_marquee_element_set_loop; +h$webkit_dom_html_marquee_element_set_loop = (function(self, + self_2, val) + { + self["loop"] = val; + }); +var h$webkit_dom_html_marquee_element_get_loop; +h$webkit_dom_html_marquee_element_get_loop = (function(self, + self_2) + { + return self["loop"]; + }); +var h$webkit_dom_html_marquee_element_set_scroll_amount; +h$webkit_dom_html_marquee_element_set_scroll_amount = (function(self, + self_2, val) + { + self["scrollAmount"] = val; + }); +var h$webkit_dom_html_marquee_element_get_scroll_amount; +h$webkit_dom_html_marquee_element_get_scroll_amount = (function(self, + self_2) + { + return self["scrollAmount"]; + }); +var h$webkit_dom_html_marquee_element_set_scroll_delay; +h$webkit_dom_html_marquee_element_set_scroll_delay = (function(self, + self_2, val) + { + self["scrollDelay"] = val; + }); +var h$webkit_dom_html_marquee_element_get_scroll_delay; +h$webkit_dom_html_marquee_element_get_scroll_delay = (function(self, + self_2) + { + return self["scrollDelay"]; + }); +var h$webkit_dom_html_marquee_element_set_true_speed; +h$webkit_dom_html_marquee_element_set_true_speed = (function(self, + self_2, val) + { + self["trueSpeed"] = val; + }); +var h$webkit_dom_html_marquee_element_get_true_speed; +h$webkit_dom_html_marquee_element_get_true_speed = (function(self, + self_2) + { + return self["trueSpeed"]; + }); +var h$webkit_dom_html_marquee_element_set_vspace; +h$webkit_dom_html_marquee_element_set_vspace = (function(self, + self_2, val) + { + self["vspace"] = val; + }); +var h$webkit_dom_html_marquee_element_get_vspace; +h$webkit_dom_html_marquee_element_get_vspace = (function(self, + self_2) + { + return self["vspace"]; + }); +var h$webkit_dom_html_marquee_element_set_width; +h$webkit_dom_html_marquee_element_set_width = (function(self, + self_2, val, val_2) + { + self["width"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_marquee_element_get_width; +h$webkit_dom_html_marquee_element_get_width = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["width"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_map_element_get_type = (function() + { + return h$g_get_type(HTMLMapElement); + }); +var h$webkit_dom_html_map_element_get_areas; +h$webkit_dom_html_map_element_get_areas = (function(self, + self_2) + { + h$ret1 = 0; + return self["areas"]; + }); +var h$webkit_dom_html_map_element_set_name; +h$webkit_dom_html_map_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_map_element_get_name; +h$webkit_dom_html_map_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_link_element_get_type = (function() + { + return h$g_get_type(HTMLLinkElement); + }); +var h$webkit_dom_html_link_element_set_disabled; +h$webkit_dom_html_link_element_set_disabled = (function(self, + self_2, val) + { + self["disabled"] = val; + }); +var h$webkit_dom_html_link_element_get_disabled; +h$webkit_dom_html_link_element_get_disabled = (function(self, + self_2) + { + return self["disabled"]; + }); +var h$webkit_dom_html_link_element_set_charset; +h$webkit_dom_html_link_element_set_charset = (function(self, + self_2, val, val_2) + { + self["charset"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_link_element_get_charset; +h$webkit_dom_html_link_element_get_charset = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["charset"]); + }); +var h$webkit_dom_html_link_element_set_href; +h$webkit_dom_html_link_element_set_href = (function(self, + self_2, val, val_2) + { + self["href"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_link_element_get_href; +h$webkit_dom_html_link_element_get_href = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["href"]); + }); +var h$webkit_dom_html_link_element_set_hreflang; +h$webkit_dom_html_link_element_set_hreflang = (function(self, + self_2, val, val_2) + { + self["hreflang"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_link_element_get_hreflang; +h$webkit_dom_html_link_element_get_hreflang = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["hreflang"]); + }); +var h$webkit_dom_html_link_element_set_media; +h$webkit_dom_html_link_element_set_media = (function(self, + self_2, val, val_2) + { + self["media"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_link_element_get_media; +h$webkit_dom_html_link_element_get_media = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["media"]); + }); +var h$webkit_dom_html_link_element_set_rel; +h$webkit_dom_html_link_element_set_rel = (function(self, + self_2, val, val_2) + { + self["rel"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_link_element_get_rel; +h$webkit_dom_html_link_element_get_rel = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["rel"]); + }); +var h$webkit_dom_html_link_element_set_rev; +h$webkit_dom_html_link_element_set_rev = (function(self, + self_2, val, val_2) + { + self["rev"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_link_element_get_rev; +h$webkit_dom_html_link_element_get_rev = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["rev"]); + }); +var h$webkit_dom_html_link_element_set_target; +h$webkit_dom_html_link_element_set_target = (function(self, + self_2, val, val_2) + { + self["target"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_link_element_get_target; +h$webkit_dom_html_link_element_get_target = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["target"]); + }); +var h$webkit_dom_html_link_element_get_sheet; +h$webkit_dom_html_link_element_get_sheet = (function(self, + self_2) + { + h$ret1 = 0; + return self["sheet"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_htmlli_element_get_type = (function() + { + return h$g_get_type(HTMLLIElement); + }); +var h$webkit_dom_htmlli_element_set_value; +h$webkit_dom_htmlli_element_set_value = (function(self, + self_2, val) + { + self["value"] = val; + }); +var h$webkit_dom_htmlli_element_get_value; +h$webkit_dom_htmlli_element_get_value = (function(self, + self_2) + { + return self["value"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_legend_element_get_type = (function() + { + return h$g_get_type(HTMLLegendElement); + }); +var h$webkit_dom_html_legend_element_get_form; +h$webkit_dom_html_legend_element_get_form = (function(self, + self_2) + { + h$ret1 = 0; + return self["form"]; + }); +var h$webkit_dom_html_legend_element_set_align; +h$webkit_dom_html_legend_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_legend_element_get_align; +h$webkit_dom_html_legend_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_label_element_get_type = (function() + { + return h$g_get_type(HTMLLabelElement); + }); +var h$webkit_dom_html_label_element_get_form; +h$webkit_dom_html_label_element_get_form = (function(self, + self_2) + { + h$ret1 = 0; + return self["form"]; + }); +var h$webkit_dom_html_label_element_set_html_for; +h$webkit_dom_html_label_element_set_html_for = (function(self, + self_2, val, val_2) + { + self["htmlFor"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_label_element_get_html_for; +h$webkit_dom_html_label_element_get_html_for = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["htmlFor"]); + }); +var h$webkit_dom_html_label_element_get_control; +h$webkit_dom_html_label_element_get_control = (function(self, + self_2) + { + h$ret1 = 0; + return self["control"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_keygen_element_get_type = (function() + { + return h$g_get_type(HTMLKeygenElement); + }); +var h$webkit_dom_html_keygen_element_check_validity; +h$webkit_dom_html_keygen_element_check_validity = (function(self, + self_2) + { + return self["checkValidity"](); + }); +var h$webkit_dom_html_keygen_element_set_custom_validity; +h$webkit_dom_html_keygen_element_set_custom_validity = (function(self, + self_2, error, error_2) + { + return self["setCustomValidity"](h$decodeUtf8z(error, + error_2)); + }); +var h$webkit_dom_html_keygen_element_set_autofocus; +h$webkit_dom_html_keygen_element_set_autofocus = (function(self, + self_2, val) + { + self["autofocus"] = val; + }); +var h$webkit_dom_html_keygen_element_get_autofocus; +h$webkit_dom_html_keygen_element_get_autofocus = (function(self, + self_2) + { + return self["autofocus"]; + }); +var h$webkit_dom_html_keygen_element_set_challenge; +h$webkit_dom_html_keygen_element_set_challenge = (function(self, + self_2, val, val_2) + { + self["challenge"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_keygen_element_get_challenge; +h$webkit_dom_html_keygen_element_get_challenge = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["challenge"]); + }); +var h$webkit_dom_html_keygen_element_set_disabled; +h$webkit_dom_html_keygen_element_set_disabled = (function(self, + self_2, val) + { + self["disabled"] = val; + }); +var h$webkit_dom_html_keygen_element_get_disabled; +h$webkit_dom_html_keygen_element_get_disabled = (function(self, + self_2) + { + return self["disabled"]; + }); +var h$webkit_dom_html_keygen_element_get_form; +h$webkit_dom_html_keygen_element_get_form = (function(self, + self_2) + { + h$ret1 = 0; + return self["form"]; + }); +var h$webkit_dom_html_keygen_element_set_keytype; +h$webkit_dom_html_keygen_element_set_keytype = (function(self, + self_2, val, val_2) + { + self["keytype"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_keygen_element_get_keytype; +h$webkit_dom_html_keygen_element_get_keytype = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["keytype"]); + }); +var h$webkit_dom_html_keygen_element_set_name; +h$webkit_dom_html_keygen_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_keygen_element_get_name; +h$webkit_dom_html_keygen_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_keygen_element_get_will_validate; +h$webkit_dom_html_keygen_element_get_will_validate = (function(self, + self_2) + { + return self["willValidate"]; + }); +var h$webkit_dom_html_keygen_element_get_validity; +h$webkit_dom_html_keygen_element_get_validity = (function(self, + self_2) + { + h$ret1 = 0; + return self["validity"]; + }); +var h$webkit_dom_html_keygen_element_get_validation_message; +h$webkit_dom_html_keygen_element_get_validation_message = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["validationMessage"]); + }); +var h$webkit_dom_html_keygen_element_get_labels; +h$webkit_dom_html_keygen_element_get_labels = (function(self, + self_2) + { + h$ret1 = 0; + return self["labels"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_input_element_get_type = (function() + { + return h$g_get_type(HTMLInputElement); + }); +var h$webkit_dom_html_input_element_step_up; +h$webkit_dom_html_input_element_step_up = (function(self, + self_2, n) + { + return self["stepUp"](n); + }); +var h$webkit_dom_html_input_element_step_down; +h$webkit_dom_html_input_element_step_down = (function(self, + self_2, n) + { + return self["stepDown"](n); + }); +var h$webkit_dom_html_input_element_check_validity; +h$webkit_dom_html_input_element_check_validity = (function(self, + self_2) + { + return self["checkValidity"](); + }); +var h$webkit_dom_html_input_element_set_custom_validity; +h$webkit_dom_html_input_element_set_custom_validity = (function(self, + self_2, error, error_2) + { + return self["setCustomValidity"](h$decodeUtf8z(error, + error_2)); + }); +var h$webkit_dom_html_input_element_select; +h$webkit_dom_html_input_element_select = (function(self, + self_2) + { + return self["select"](); + }); +var h$webkit_dom_html_input_element_set_value_for_user; +h$webkit_dom_html_input_element_set_value_for_user = (function(self, + self_2, value, value_2) + { + return self["setValueForUser"](h$decodeUtf8z(value, + value_2)); + }); +var h$webkit_dom_html_input_element_set_accept; +h$webkit_dom_html_input_element_set_accept = (function(self, + self_2, val, val_2) + { + self["accept"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_accept; +h$webkit_dom_html_input_element_get_accept = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["accept"]); + }); +var h$webkit_dom_html_input_element_set_alt; +h$webkit_dom_html_input_element_set_alt = (function(self, + self_2, val, val_2) + { + self["alt"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_alt; +h$webkit_dom_html_input_element_get_alt = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["alt"]); + }); +var h$webkit_dom_html_input_element_set_autocomplete; +h$webkit_dom_html_input_element_set_autocomplete = (function(self, + self_2, val, val_2) + { + self["autocomplete"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_autocomplete; +h$webkit_dom_html_input_element_get_autocomplete = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["autocomplete"]); + }); +var h$webkit_dom_html_input_element_set_autofocus; +h$webkit_dom_html_input_element_set_autofocus = (function(self, + self_2, val) + { + self["autofocus"] = val; + }); +var h$webkit_dom_html_input_element_get_autofocus; +h$webkit_dom_html_input_element_get_autofocus = (function(self, + self_2) + { + return self["autofocus"]; + }); +var h$webkit_dom_html_input_element_set_default_checked; +h$webkit_dom_html_input_element_set_default_checked = (function(self, + self_2, val) + { + self["defaultChecked"] = val; + }); +var h$webkit_dom_html_input_element_get_default_checked; +h$webkit_dom_html_input_element_get_default_checked = (function(self, + self_2) + { + return self["defaultChecked"]; + }); +var h$webkit_dom_html_input_element_set_checked; +h$webkit_dom_html_input_element_set_checked = (function(self, + self_2, val) + { + self["checked"] = val; + }); +var h$webkit_dom_html_input_element_get_checked; +h$webkit_dom_html_input_element_get_checked = (function(self, + self_2) + { + return self["checked"]; + }); +var h$webkit_dom_html_input_element_set_dir_name; +h$webkit_dom_html_input_element_set_dir_name = (function(self, + self_2, val, val_2) + { + self["dirName"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_dir_name; +h$webkit_dom_html_input_element_get_dir_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["dirName"]); + }); +var h$webkit_dom_html_input_element_set_disabled; +h$webkit_dom_html_input_element_set_disabled = (function(self, + self_2, val) + { + self["disabled"] = val; + }); +var h$webkit_dom_html_input_element_get_disabled; +h$webkit_dom_html_input_element_get_disabled = (function(self, + self_2) + { + return self["disabled"]; + }); +var h$webkit_dom_html_input_element_get_form; +h$webkit_dom_html_input_element_get_form = (function(self, + self_2) + { + h$ret1 = 0; + return self["form"]; + }); +var h$webkit_dom_html_input_element_set_files; +h$webkit_dom_html_input_element_set_files = (function(self, + self_2, val, val_2) + { + self["files"] = val; + }); +var h$webkit_dom_html_input_element_get_files; +h$webkit_dom_html_input_element_get_files = (function(self, + self_2) + { + h$ret1 = 0; + return self["files"]; + }); +var h$webkit_dom_html_input_element_set_form_action; +h$webkit_dom_html_input_element_set_form_action = (function(self, + self_2, val, val_2) + { + self["formAction"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_form_action; +h$webkit_dom_html_input_element_get_form_action = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["formAction"]); + }); +var h$webkit_dom_html_input_element_set_form_enctype; +h$webkit_dom_html_input_element_set_form_enctype = (function(self, + self_2, val, val_2) + { + self["formEnctype"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_form_enctype; +h$webkit_dom_html_input_element_get_form_enctype = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["formEnctype"]); + }); +var h$webkit_dom_html_input_element_set_form_method; +h$webkit_dom_html_input_element_set_form_method = (function(self, + self_2, val, val_2) + { + self["formMethod"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_form_method; +h$webkit_dom_html_input_element_get_form_method = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["formMethod"]); + }); +var h$webkit_dom_html_input_element_set_form_no_validate; +h$webkit_dom_html_input_element_set_form_no_validate = (function(self, + self_2, val) + { + self["formNoValidate"] = val; + }); +var h$webkit_dom_html_input_element_get_form_no_validate; +h$webkit_dom_html_input_element_get_form_no_validate = (function(self, + self_2) + { + return self["formNoValidate"]; + }); +var h$webkit_dom_html_input_element_set_form_target; +h$webkit_dom_html_input_element_set_form_target = (function(self, + self_2, val, val_2) + { + self["formTarget"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_form_target; +h$webkit_dom_html_input_element_get_form_target = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["formTarget"]); + }); +var h$webkit_dom_html_input_element_set_height; +h$webkit_dom_html_input_element_set_height = (function(self, + self_2, val) + { + self["height"] = val; + }); +var h$webkit_dom_html_input_element_get_height; +h$webkit_dom_html_input_element_get_height = (function(self, + self_2) + { + return self["height"]; + }); +var h$webkit_dom_html_input_element_set_indeterminate; +h$webkit_dom_html_input_element_set_indeterminate = (function(self, + self_2, val) + { + self["indeterminate"] = val; + }); +var h$webkit_dom_html_input_element_get_indeterminate; +h$webkit_dom_html_input_element_get_indeterminate = (function(self, + self_2) + { + return self["indeterminate"]; + }); +var h$webkit_dom_html_input_element_get_list; +h$webkit_dom_html_input_element_get_list = (function(self, + self_2) + { + h$ret1 = 0; + return self["list"]; + }); +var h$webkit_dom_html_input_element_set_max; +h$webkit_dom_html_input_element_set_max = (function(self, + self_2, val, val_2) + { + self["max"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_max; +h$webkit_dom_html_input_element_get_max = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["max"]); + }); +var h$webkit_dom_html_input_element_set_max_length; +h$webkit_dom_html_input_element_set_max_length = (function(self, + self_2, val) + { + self["maxLength"] = val; + }); +var h$webkit_dom_html_input_element_get_max_length; +h$webkit_dom_html_input_element_get_max_length = (function(self, + self_2) + { + return self["maxLength"]; + }); +var h$webkit_dom_html_input_element_set_min; +h$webkit_dom_html_input_element_set_min = (function(self, + self_2, val, val_2) + { + self["min"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_min; +h$webkit_dom_html_input_element_get_min = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["min"]); + }); +var h$webkit_dom_html_input_element_set_multiple; +h$webkit_dom_html_input_element_set_multiple = (function(self, + self_2, val) + { + self["multiple"] = val; + }); +var h$webkit_dom_html_input_element_get_multiple; +h$webkit_dom_html_input_element_get_multiple = (function(self, + self_2) + { + return self["multiple"]; + }); +var h$webkit_dom_html_input_element_set_name; +h$webkit_dom_html_input_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_name; +h$webkit_dom_html_input_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_input_element_set_pattern; +h$webkit_dom_html_input_element_set_pattern = (function(self, + self_2, val, val_2) + { + self["pattern"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_pattern; +h$webkit_dom_html_input_element_get_pattern = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["pattern"]); + }); +var h$webkit_dom_html_input_element_set_placeholder; +h$webkit_dom_html_input_element_set_placeholder = (function(self, + self_2, val, val_2) + { + self["placeholder"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_placeholder; +h$webkit_dom_html_input_element_get_placeholder = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["placeholder"]); + }); +var h$webkit_dom_html_input_element_set_read_only; +h$webkit_dom_html_input_element_set_read_only = (function(self, + self_2, val) + { + self["readOnly"] = val; + }); +var h$webkit_dom_html_input_element_get_read_only; +h$webkit_dom_html_input_element_get_read_only = (function(self, + self_2) + { + return self["readOnly"]; + }); +var h$webkit_dom_html_input_element_set_required; +h$webkit_dom_html_input_element_set_required = (function(self, + self_2, val) + { + self["required"] = val; + }); +var h$webkit_dom_html_input_element_get_required; +h$webkit_dom_html_input_element_get_required = (function(self, + self_2) + { + return self["required"]; + }); +var h$webkit_dom_html_input_element_set_size; +h$webkit_dom_html_input_element_set_size = (function(self, + self_2, val) + { + self["size"] = val; + }); +var h$webkit_dom_html_input_element_get_size; +h$webkit_dom_html_input_element_get_size = (function(self, + self_2) + { + return self["size"]; + }); +var h$webkit_dom_html_input_element_set_src; +h$webkit_dom_html_input_element_set_src = (function(self, + self_2, val, val_2) + { + self["src"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_src; +h$webkit_dom_html_input_element_get_src = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["src"]); + }); +var h$webkit_dom_html_input_element_set_step; +h$webkit_dom_html_input_element_set_step = (function(self, + self_2, val, val_2) + { + self["step"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_step; +h$webkit_dom_html_input_element_get_step = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["step"]); + }); +var h$webkit_dom_html_input_element_set_default_value; +h$webkit_dom_html_input_element_set_default_value = (function(self, + self_2, val, val_2) + { + self["defaultValue"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_default_value; +h$webkit_dom_html_input_element_get_default_value = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["defaultValue"]); + }); +var h$webkit_dom_html_input_element_set_value; +h$webkit_dom_html_input_element_set_value = (function(self, + self_2, val, val_2) + { + self["value"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_value; +h$webkit_dom_html_input_element_get_value = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["value"]); + }); +var h$webkit_dom_html_input_element_set_value_as_number; +h$webkit_dom_html_input_element_set_value_as_number = (function(self, + self_2, val) + { + self["valueAsNumber"] = val; + }); +var h$webkit_dom_html_input_element_get_value_as_number; +h$webkit_dom_html_input_element_get_value_as_number = (function(self, + self_2) + { + return self["valueAsNumber"]; + }); +var h$webkit_dom_html_input_element_set_width; +h$webkit_dom_html_input_element_set_width = (function(self, + self_2, val) + { + self["width"] = val; + }); +var h$webkit_dom_html_input_element_get_width; +h$webkit_dom_html_input_element_get_width = (function(self, + self_2) + { + return self["width"]; + }); +var h$webkit_dom_html_input_element_get_will_validate; +h$webkit_dom_html_input_element_get_will_validate = (function(self, + self_2) + { + return self["willValidate"]; + }); +var h$webkit_dom_html_input_element_get_validity; +h$webkit_dom_html_input_element_get_validity = (function(self, + self_2) + { + h$ret1 = 0; + return self["validity"]; + }); +var h$webkit_dom_html_input_element_get_validation_message; +h$webkit_dom_html_input_element_get_validation_message = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["validationMessage"]); + }); +var h$webkit_dom_html_input_element_get_labels; +h$webkit_dom_html_input_element_get_labels = (function(self, + self_2) + { + h$ret1 = 0; + return self["labels"]; + }); +var h$webkit_dom_html_input_element_set_align; +h$webkit_dom_html_input_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_align; +h$webkit_dom_html_input_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +var h$webkit_dom_html_input_element_set_webkitdirectory; +h$webkit_dom_html_input_element_set_webkitdirectory = (function(self, + self_2, val) + { + self["webkitdirectory"] = val; + }); +var h$webkit_dom_html_input_element_get_webkitdirectory; +h$webkit_dom_html_input_element_get_webkitdirectory = (function(self, + self_2) + { + return self["webkitdirectory"]; + }); +var h$webkit_dom_html_input_element_set_use_map; +h$webkit_dom_html_input_element_set_use_map = (function(self, + self_2, val, val_2) + { + self["useMap"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_use_map; +h$webkit_dom_html_input_element_get_use_map = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["useMap"]); + }); +var h$webkit_dom_html_input_element_set_incremental; +h$webkit_dom_html_input_element_set_incremental = (function(self, + self_2, val) + { + self["incremental"] = val; + }); +var h$webkit_dom_html_input_element_get_incremental; +h$webkit_dom_html_input_element_get_incremental = (function(self, + self_2) + { + return self["incremental"]; + }); +var h$webkit_dom_html_input_element_set_webkit_speech; +h$webkit_dom_html_input_element_set_webkit_speech = (function(self, + self_2, val) + { + self["webkitSpeech"] = val; + }); +var h$webkit_dom_html_input_element_get_webkit_speech; +h$webkit_dom_html_input_element_get_webkit_speech = (function(self, + self_2) + { + return self["webkitSpeech"]; + }); +var h$webkit_dom_html_input_element_set_webkit_grammar; +h$webkit_dom_html_input_element_set_webkit_grammar = (function(self, + self_2, val) + { + self["webkitGrammar"] = val; + }); +var h$webkit_dom_html_input_element_get_webkit_grammar; +h$webkit_dom_html_input_element_get_webkit_grammar = (function(self, + self_2) + { + return self["webkitGrammar"]; + }); +var h$webkit_dom_html_input_element_set_onwebkitspeechchange; +h$webkit_dom_html_input_element_set_onwebkitspeechchange = (function(self, + self_2, val, val_2) + { + self["onwebkitspeechchange"] = val; + }); +var h$webkit_dom_html_input_element_get_onwebkitspeechchange; +h$webkit_dom_html_input_element_get_onwebkitspeechchange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onwebkitspeechchange"]; + }); +var h$webkit_dom_html_input_element_set_capture; +h$webkit_dom_html_input_element_set_capture = (function(self, + self_2, val, val_2) + { + self["capture"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_input_element_get_capture; +h$webkit_dom_html_input_element_get_capture = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["capture"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_image_element_get_type = (function() + { + return h$g_get_type(HTMLImageElement); + }); +var h$webkit_dom_html_image_element_set_name; +h$webkit_dom_html_image_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_image_element_get_name; +h$webkit_dom_html_image_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_image_element_set_align; +h$webkit_dom_html_image_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_image_element_get_align; +h$webkit_dom_html_image_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +var h$webkit_dom_html_image_element_set_alt; +h$webkit_dom_html_image_element_set_alt = (function(self, + self_2, val, val_2) + { + self["alt"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_image_element_get_alt; +h$webkit_dom_html_image_element_get_alt = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["alt"]); + }); +var h$webkit_dom_html_image_element_set_border; +h$webkit_dom_html_image_element_set_border = (function(self, + self_2, val, val_2) + { + self["border"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_image_element_get_border; +h$webkit_dom_html_image_element_get_border = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["border"]); + }); +var h$webkit_dom_html_image_element_set_cross_origin; +h$webkit_dom_html_image_element_set_cross_origin = (function(self, + self_2, val, val_2) + { + self["crossOrigin"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_image_element_get_cross_origin; +h$webkit_dom_html_image_element_get_cross_origin = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["crossOrigin"]); + }); +var h$webkit_dom_html_image_element_set_height; +h$webkit_dom_html_image_element_set_height = (function(self, + self_2, val) + { + self["height"] = val; + }); +var h$webkit_dom_html_image_element_get_height; +h$webkit_dom_html_image_element_get_height = (function(self, + self_2) + { + return self["height"]; + }); +var h$webkit_dom_html_image_element_set_hspace; +h$webkit_dom_html_image_element_set_hspace = (function(self, + self_2, val) + { + self["hspace"] = val; + }); +var h$webkit_dom_html_image_element_get_hspace; +h$webkit_dom_html_image_element_get_hspace = (function(self, + self_2) + { + return self["hspace"]; + }); +var h$webkit_dom_html_image_element_set_is_map; +h$webkit_dom_html_image_element_set_is_map = (function(self, + self_2, val) + { + self["isMap"] = val; + }); +var h$webkit_dom_html_image_element_get_is_map; +h$webkit_dom_html_image_element_get_is_map = (function(self, + self_2) + { + return self["isMap"]; + }); +var h$webkit_dom_html_image_element_set_long_desc; +h$webkit_dom_html_image_element_set_long_desc = (function(self, + self_2, val, val_2) + { + self["longDesc"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_image_element_get_long_desc; +h$webkit_dom_html_image_element_get_long_desc = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["longDesc"]); + }); +var h$webkit_dom_html_image_element_set_src; +h$webkit_dom_html_image_element_set_src = (function(self, + self_2, val, val_2) + { + self["src"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_image_element_get_src; +h$webkit_dom_html_image_element_get_src = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["src"]); + }); +var h$webkit_dom_html_image_element_set_use_map; +h$webkit_dom_html_image_element_set_use_map = (function(self, + self_2, val, val_2) + { + self["useMap"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_image_element_get_use_map; +h$webkit_dom_html_image_element_get_use_map = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["useMap"]); + }); +var h$webkit_dom_html_image_element_set_vspace; +h$webkit_dom_html_image_element_set_vspace = (function(self, + self_2, val) + { + self["vspace"] = val; + }); +var h$webkit_dom_html_image_element_get_vspace; +h$webkit_dom_html_image_element_get_vspace = (function(self, + self_2) + { + return self["vspace"]; + }); +var h$webkit_dom_html_image_element_set_width; +h$webkit_dom_html_image_element_set_width = (function(self, + self_2, val) + { + self["width"] = val; + }); +var h$webkit_dom_html_image_element_get_width; +h$webkit_dom_html_image_element_get_width = (function(self, + self_2) + { + return self["width"]; + }); +var h$webkit_dom_html_image_element_get_complete; +h$webkit_dom_html_image_element_get_complete = (function(self, + self_2) + { + return self["complete"]; + }); +var h$webkit_dom_html_image_element_set_lowsrc; +h$webkit_dom_html_image_element_set_lowsrc = (function(self, + self_2, val, val_2) + { + self["lowsrc"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_image_element_get_lowsrc; +h$webkit_dom_html_image_element_get_lowsrc = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["lowsrc"]); + }); +var h$webkit_dom_html_image_element_get_natural_height; +h$webkit_dom_html_image_element_get_natural_height = (function(self, + self_2) + { + return self["naturalHeight"]; + }); +var h$webkit_dom_html_image_element_get_natural_width; +h$webkit_dom_html_image_element_get_natural_width = (function(self, + self_2) + { + return self["naturalWidth"]; + }); +var h$webkit_dom_html_image_element_get_x; +h$webkit_dom_html_image_element_get_x = (function(self, + self_2) + { + return self["x"]; + }); +var h$webkit_dom_html_image_element_get_y; +h$webkit_dom_html_image_element_get_y = (function(self, + self_2) + { + return self["y"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_iframe_element_get_type = (function() + { + return h$g_get_type(HTMLIFrameElement); + }); +var h$webkit_dom_html_iframe_element_set_align; +h$webkit_dom_html_iframe_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_iframe_element_get_align; +h$webkit_dom_html_iframe_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +var h$webkit_dom_html_iframe_element_set_frame_border; +h$webkit_dom_html_iframe_element_set_frame_border = (function(self, + self_2, val, val_2) + { + self["frameBorder"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_iframe_element_get_frame_border; +h$webkit_dom_html_iframe_element_get_frame_border = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["frameBorder"]); + }); +var h$webkit_dom_html_iframe_element_set_height; +h$webkit_dom_html_iframe_element_set_height = (function(self, + self_2, val, val_2) + { + self["height"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_iframe_element_get_height; +h$webkit_dom_html_iframe_element_get_height = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["height"]); + }); +var h$webkit_dom_html_iframe_element_set_long_desc; +h$webkit_dom_html_iframe_element_set_long_desc = (function(self, + self_2, val, val_2) + { + self["longDesc"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_iframe_element_get_long_desc; +h$webkit_dom_html_iframe_element_get_long_desc = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["longDesc"]); + }); +var h$webkit_dom_html_iframe_element_set_margin_height; +h$webkit_dom_html_iframe_element_set_margin_height = (function(self, + self_2, val, val_2) + { + self["marginHeight"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_iframe_element_get_margin_height; +h$webkit_dom_html_iframe_element_get_margin_height = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["marginHeight"]); + }); +var h$webkit_dom_html_iframe_element_set_margin_width; +h$webkit_dom_html_iframe_element_set_margin_width = (function(self, + self_2, val, val_2) + { + self["marginWidth"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_iframe_element_get_margin_width; +h$webkit_dom_html_iframe_element_get_margin_width = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["marginWidth"]); + }); +var h$webkit_dom_html_iframe_element_set_name; +h$webkit_dom_html_iframe_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_iframe_element_get_name; +h$webkit_dom_html_iframe_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_iframe_element_set_sandbox; +h$webkit_dom_html_iframe_element_set_sandbox = (function(self, + self_2, val, val_2) + { + self["sandbox"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_iframe_element_get_sandbox; +h$webkit_dom_html_iframe_element_get_sandbox = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["sandbox"]); + }); +var h$webkit_dom_html_iframe_element_set_seamless; +h$webkit_dom_html_iframe_element_set_seamless = (function(self, + self_2, val) + { + self["seamless"] = val; + }); +var h$webkit_dom_html_iframe_element_get_seamless; +h$webkit_dom_html_iframe_element_get_seamless = (function(self, + self_2) + { + return self["seamless"]; + }); +var h$webkit_dom_html_iframe_element_set_scrolling; +h$webkit_dom_html_iframe_element_set_scrolling = (function(self, + self_2, val, val_2) + { + self["scrolling"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_iframe_element_get_scrolling; +h$webkit_dom_html_iframe_element_get_scrolling = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["scrolling"]); + }); +var h$webkit_dom_html_iframe_element_set_src; +h$webkit_dom_html_iframe_element_set_src = (function(self, + self_2, val, val_2) + { + self["src"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_iframe_element_get_src; +h$webkit_dom_html_iframe_element_get_src = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["src"]); + }); +var h$webkit_dom_html_iframe_element_set_srcdoc; +h$webkit_dom_html_iframe_element_set_srcdoc = (function(self, + self_2, val, val_2) + { + self["srcdoc"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_iframe_element_get_srcdoc; +h$webkit_dom_html_iframe_element_get_srcdoc = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["srcdoc"]); + }); +var h$webkit_dom_html_iframe_element_set_width; +h$webkit_dom_html_iframe_element_set_width = (function(self, + self_2, val, val_2) + { + self["width"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_iframe_element_get_width; +h$webkit_dom_html_iframe_element_get_width = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["width"]); + }); +var h$webkit_dom_html_iframe_element_get_content_document; +h$webkit_dom_html_iframe_element_get_content_document = (function(self, + self_2) + { + h$ret1 = 0; + return self["contentDocument"]; + }); +var h$webkit_dom_html_iframe_element_get_content_window; +h$webkit_dom_html_iframe_element_get_content_window = (function(self, + self_2) + { + h$ret1 = 0; + return self["contentWindow"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_html_element_get_type = (function() + { + return h$g_get_type(HTMLHtmlElement); + }); +var h$webkit_dom_html_html_element_set_version; +h$webkit_dom_html_html_element_set_version = (function(self, + self_2, val, val_2) + { + self["version"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_html_element_get_version; +h$webkit_dom_html_html_element_get_version = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["version"]); + }); +var h$webkit_dom_html_html_element_set_manifest; +h$webkit_dom_html_html_element_set_manifest = (function(self, + self_2, val, val_2) + { + self["manifest"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_html_element_get_manifest; +h$webkit_dom_html_html_element_get_manifest = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["manifest"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_htmlhr_element_get_type = (function() + { + return h$g_get_type(HTMLHRElement); + }); +var h$webkit_dom_htmlhr_element_set_align; +h$webkit_dom_htmlhr_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_htmlhr_element_get_align; +h$webkit_dom_htmlhr_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +var h$webkit_dom_htmlhr_element_set_no_shade; +h$webkit_dom_htmlhr_element_set_no_shade = (function(self, + self_2, val) + { + self["noShade"] = val; + }); +var h$webkit_dom_htmlhr_element_get_no_shade; +h$webkit_dom_htmlhr_element_get_no_shade = (function(self, + self_2) + { + return self["noShade"]; + }); +var h$webkit_dom_htmlhr_element_set_size; +h$webkit_dom_htmlhr_element_set_size = (function(self, + self_2, val, val_2) + { + self["size"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_htmlhr_element_get_size; +h$webkit_dom_htmlhr_element_get_size = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["size"]); + }); +var h$webkit_dom_htmlhr_element_set_width; +h$webkit_dom_htmlhr_element_set_width = (function(self, + self_2, val, val_2) + { + self["width"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_htmlhr_element_get_width; +h$webkit_dom_htmlhr_element_get_width = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["width"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_heading_element_get_type = (function() + { + return h$g_get_type(HTMLHeadingElement); + }); +var h$webkit_dom_html_heading_element_set_align; +h$webkit_dom_html_heading_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_heading_element_get_align; +h$webkit_dom_html_heading_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_head_element_get_type = (function() + { + return h$g_get_type(HTMLHeadElement); + }); +var h$webkit_dom_html_head_element_set_profile; +h$webkit_dom_html_head_element_set_profile = (function(self, + self_2, val, val_2) + { + self["profile"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_head_element_get_profile; +h$webkit_dom_html_head_element_get_profile = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["profile"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_frame_set_element_get_type = (function() + { + return h$g_get_type(HTMLFrameSetElement); + }); +var h$webkit_dom_html_frame_set_element_set_cols; +h$webkit_dom_html_frame_set_element_set_cols = (function(self, + self_2, val, val_2) + { + self["cols"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_frame_set_element_get_cols; +h$webkit_dom_html_frame_set_element_get_cols = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["cols"]); + }); +var h$webkit_dom_html_frame_set_element_set_rows; +h$webkit_dom_html_frame_set_element_set_rows = (function(self, + self_2, val, val_2) + { + self["rows"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_frame_set_element_get_rows; +h$webkit_dom_html_frame_set_element_get_rows = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["rows"]); + }); +var h$webkit_dom_html_frame_set_element_set_onbeforeunload; +h$webkit_dom_html_frame_set_element_set_onbeforeunload = (function(self, + self_2, val, val_2) + { + self["onbeforeunload"] = val; + }); +var h$webkit_dom_html_frame_set_element_get_onbeforeunload; +h$webkit_dom_html_frame_set_element_get_onbeforeunload = (function(self, + self_2) + { + h$ret1 = 0; + return self["onbeforeunload"]; + }); +var h$webkit_dom_html_frame_set_element_set_onhashchange; +h$webkit_dom_html_frame_set_element_set_onhashchange = (function(self, + self_2, val, val_2) + { + self["onhashchange"] = val; + }); +var h$webkit_dom_html_frame_set_element_get_onhashchange; +h$webkit_dom_html_frame_set_element_get_onhashchange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onhashchange"]; + }); +var h$webkit_dom_html_frame_set_element_set_onmessage; +h$webkit_dom_html_frame_set_element_set_onmessage = (function(self, + self_2, val, val_2) + { + self["onmessage"] = val; + }); +var h$webkit_dom_html_frame_set_element_get_onmessage; +h$webkit_dom_html_frame_set_element_get_onmessage = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmessage"]; + }); +var h$webkit_dom_html_frame_set_element_set_onoffline; +h$webkit_dom_html_frame_set_element_set_onoffline = (function(self, + self_2, val, val_2) + { + self["onoffline"] = val; + }); +var h$webkit_dom_html_frame_set_element_get_onoffline; +h$webkit_dom_html_frame_set_element_get_onoffline = (function(self, + self_2) + { + h$ret1 = 0; + return self["onoffline"]; + }); +var h$webkit_dom_html_frame_set_element_set_ononline; +h$webkit_dom_html_frame_set_element_set_ononline = (function(self, + self_2, val, val_2) + { + self["ononline"] = val; + }); +var h$webkit_dom_html_frame_set_element_get_ononline; +h$webkit_dom_html_frame_set_element_get_ononline = (function(self, + self_2) + { + h$ret1 = 0; + return self["ononline"]; + }); +var h$webkit_dom_html_frame_set_element_set_onpopstate; +h$webkit_dom_html_frame_set_element_set_onpopstate = (function(self, + self_2, val, val_2) + { + self["onpopstate"] = val; + }); +var h$webkit_dom_html_frame_set_element_get_onpopstate; +h$webkit_dom_html_frame_set_element_get_onpopstate = (function(self, + self_2) + { + h$ret1 = 0; + return self["onpopstate"]; + }); +var h$webkit_dom_html_frame_set_element_set_onresize; +h$webkit_dom_html_frame_set_element_set_onresize = (function(self, + self_2, val, val_2) + { + self["onresize"] = val; + }); +var h$webkit_dom_html_frame_set_element_get_onresize; +h$webkit_dom_html_frame_set_element_get_onresize = (function(self, + self_2) + { + h$ret1 = 0; + return self["onresize"]; + }); +var h$webkit_dom_html_frame_set_element_set_onstorage; +h$webkit_dom_html_frame_set_element_set_onstorage = (function(self, + self_2, val, val_2) + { + self["onstorage"] = val; + }); +var h$webkit_dom_html_frame_set_element_get_onstorage; +h$webkit_dom_html_frame_set_element_get_onstorage = (function(self, + self_2) + { + h$ret1 = 0; + return self["onstorage"]; + }); +var h$webkit_dom_html_frame_set_element_set_onunload; +h$webkit_dom_html_frame_set_element_set_onunload = (function(self, + self_2, val, val_2) + { + self["onunload"] = val; + }); +var h$webkit_dom_html_frame_set_element_get_onunload; +h$webkit_dom_html_frame_set_element_get_onunload = (function(self, + self_2) + { + h$ret1 = 0; + return self["onunload"]; + }); +var h$webkit_dom_html_frame_set_element_set_onorientationchange; +h$webkit_dom_html_frame_set_element_set_onorientationchange = (function(self, + self_2, val, + val_2) + { + self["onorientationchange"] = val; + }); +var h$webkit_dom_html_frame_set_element_get_onorientationchange; +h$webkit_dom_html_frame_set_element_get_onorientationchange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onorientationchange"]; + }); +var h$webkit_dom_html_frame_set_element_set_onblur; +h$webkit_dom_html_frame_set_element_set_onblur = (function(self, + self_2, val, val_2) + { + self["onblur"] = val; + }); +var h$webkit_dom_html_frame_set_element_get_onblur; +h$webkit_dom_html_frame_set_element_get_onblur = (function(self, + self_2) + { + h$ret1 = 0; + return self["onblur"]; + }); +var h$webkit_dom_html_frame_set_element_set_onerror; +h$webkit_dom_html_frame_set_element_set_onerror = (function(self, + self_2, val, val_2) + { + self["onerror"] = val; + }); +var h$webkit_dom_html_frame_set_element_get_onerror; +h$webkit_dom_html_frame_set_element_get_onerror = (function(self, + self_2) + { + h$ret1 = 0; + return self["onerror"]; + }); +var h$webkit_dom_html_frame_set_element_set_onfocus; +h$webkit_dom_html_frame_set_element_set_onfocus = (function(self, + self_2, val, val_2) + { + self["onfocus"] = val; + }); +var h$webkit_dom_html_frame_set_element_get_onfocus; +h$webkit_dom_html_frame_set_element_get_onfocus = (function(self, + self_2) + { + h$ret1 = 0; + return self["onfocus"]; + }); +var h$webkit_dom_html_frame_set_element_set_onload; +h$webkit_dom_html_frame_set_element_set_onload = (function(self, + self_2, val, val_2) + { + self["onload"] = val; + }); +var h$webkit_dom_html_frame_set_element_get_onload; +h$webkit_dom_html_frame_set_element_get_onload = (function(self, + self_2) + { + h$ret1 = 0; + return self["onload"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_frame_element_get_type = (function() + { + return h$g_get_type(HTMLFrameElement); + }); +var h$webkit_dom_html_frame_element_set_frame_border; +h$webkit_dom_html_frame_element_set_frame_border = (function(self, + self_2, val, val_2) + { + self["frameBorder"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_frame_element_get_frame_border; +h$webkit_dom_html_frame_element_get_frame_border = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["frameBorder"]); + }); +var h$webkit_dom_html_frame_element_set_long_desc; +h$webkit_dom_html_frame_element_set_long_desc = (function(self, + self_2, val, val_2) + { + self["longDesc"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_frame_element_get_long_desc; +h$webkit_dom_html_frame_element_get_long_desc = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["longDesc"]); + }); +var h$webkit_dom_html_frame_element_set_margin_height; +h$webkit_dom_html_frame_element_set_margin_height = (function(self, + self_2, val, val_2) + { + self["marginHeight"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_frame_element_get_margin_height; +h$webkit_dom_html_frame_element_get_margin_height = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["marginHeight"]); + }); +var h$webkit_dom_html_frame_element_set_margin_width; +h$webkit_dom_html_frame_element_set_margin_width = (function(self, + self_2, val, val_2) + { + self["marginWidth"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_frame_element_get_margin_width; +h$webkit_dom_html_frame_element_get_margin_width = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["marginWidth"]); + }); +var h$webkit_dom_html_frame_element_set_name; +h$webkit_dom_html_frame_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_frame_element_get_name; +h$webkit_dom_html_frame_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_frame_element_set_no_resize; +h$webkit_dom_html_frame_element_set_no_resize = (function(self, + self_2, val) + { + self["noResize"] = val; + }); +var h$webkit_dom_html_frame_element_get_no_resize; +h$webkit_dom_html_frame_element_get_no_resize = (function(self, + self_2) + { + return self["noResize"]; + }); +var h$webkit_dom_html_frame_element_set_scrolling; +h$webkit_dom_html_frame_element_set_scrolling = (function(self, + self_2, val, val_2) + { + self["scrolling"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_frame_element_get_scrolling; +h$webkit_dom_html_frame_element_get_scrolling = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["scrolling"]); + }); +var h$webkit_dom_html_frame_element_set_src; +h$webkit_dom_html_frame_element_set_src = (function(self, + self_2, val, val_2) + { + self["src"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_frame_element_get_src; +h$webkit_dom_html_frame_element_get_src = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["src"]); + }); +var h$webkit_dom_html_frame_element_get_content_document; +h$webkit_dom_html_frame_element_get_content_document = (function(self, + self_2) + { + h$ret1 = 0; + return self["contentDocument"]; + }); +var h$webkit_dom_html_frame_element_get_content_window; +h$webkit_dom_html_frame_element_get_content_window = (function(self, + self_2) + { + h$ret1 = 0; + return self["contentWindow"]; + }); +var h$webkit_dom_html_frame_element_get_width; +h$webkit_dom_html_frame_element_get_width = (function(self, + self_2) + { + return self["width"]; + }); +var h$webkit_dom_html_frame_element_get_height; +h$webkit_dom_html_frame_element_get_height = (function(self, + self_2) + { + return self["height"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_form_element_get_type = (function() + { + return h$g_get_type(HTMLFormElement); + }); +var h$webkit_dom_html_form_element_submit; +h$webkit_dom_html_form_element_submit = (function(self, + self_2) + { + return self["submit"](); + }); +var h$webkit_dom_html_form_element_reset; +h$webkit_dom_html_form_element_reset = (function(self, + self_2) + { + return self["reset"](); + }); +var h$webkit_dom_html_form_element_check_validity; +h$webkit_dom_html_form_element_check_validity = (function(self, + self_2) + { + return self["checkValidity"](); + }); +var h$webkit_dom_html_form_element_set_accept_charset; +h$webkit_dom_html_form_element_set_accept_charset = (function(self, + self_2, val, val_2) + { + self["acceptCharset"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_form_element_get_accept_charset; +h$webkit_dom_html_form_element_get_accept_charset = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["acceptCharset"]); + }); +var h$webkit_dom_html_form_element_set_action; +h$webkit_dom_html_form_element_set_action = (function(self, + self_2, val, val_2) + { + self["action"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_form_element_get_action; +h$webkit_dom_html_form_element_get_action = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["action"]); + }); +var h$webkit_dom_html_form_element_set_autocomplete; +h$webkit_dom_html_form_element_set_autocomplete = (function(self, + self_2, val, val_2) + { + self["autocomplete"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_form_element_get_autocomplete; +h$webkit_dom_html_form_element_get_autocomplete = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["autocomplete"]); + }); +var h$webkit_dom_html_form_element_set_enctype; +h$webkit_dom_html_form_element_set_enctype = (function(self, + self_2, val, val_2) + { + self["enctype"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_form_element_get_enctype; +h$webkit_dom_html_form_element_get_enctype = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["enctype"]); + }); +var h$webkit_dom_html_form_element_set_encoding; +h$webkit_dom_html_form_element_set_encoding = (function(self, + self_2, val, val_2) + { + self["encoding"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_form_element_get_encoding; +h$webkit_dom_html_form_element_get_encoding = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["encoding"]); + }); +var h$webkit_dom_html_form_element_set_method; +h$webkit_dom_html_form_element_set_method = (function(self, + self_2, val, val_2) + { + self["method"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_form_element_get_method; +h$webkit_dom_html_form_element_get_method = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["method"]); + }); +var h$webkit_dom_html_form_element_set_name; +h$webkit_dom_html_form_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_form_element_get_name; +h$webkit_dom_html_form_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_form_element_set_no_validate; +h$webkit_dom_html_form_element_set_no_validate = (function(self, + self_2, val) + { + self["noValidate"] = val; + }); +var h$webkit_dom_html_form_element_get_no_validate; +h$webkit_dom_html_form_element_get_no_validate = (function(self, + self_2) + { + return self["noValidate"]; + }); +var h$webkit_dom_html_form_element_set_target; +h$webkit_dom_html_form_element_set_target = (function(self, + self_2, val, val_2) + { + self["target"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_form_element_get_target; +h$webkit_dom_html_form_element_get_target = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["target"]); + }); +var h$webkit_dom_html_form_element_get_elements; +h$webkit_dom_html_form_element_get_elements = (function(self, + self_2) + { + h$ret1 = 0; + return self["elements"]; + }); +var h$webkit_dom_html_form_element_get_length; +h$webkit_dom_html_form_element_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_font_element_get_type = (function() + { + return h$g_get_type(HTMLFontElement); + }); +var h$webkit_dom_html_font_element_set_color; +h$webkit_dom_html_font_element_set_color = (function(self, + self_2, val, val_2) + { + self["color"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_font_element_get_color; +h$webkit_dom_html_font_element_get_color = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["color"]); + }); +var h$webkit_dom_html_font_element_set_face; +h$webkit_dom_html_font_element_set_face = (function(self, + self_2, val, val_2) + { + self["face"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_font_element_get_face; +h$webkit_dom_html_font_element_get_face = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["face"]); + }); +var h$webkit_dom_html_font_element_set_size; +h$webkit_dom_html_font_element_set_size = (function(self, + self_2, val, val_2) + { + self["size"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_font_element_get_size; +h$webkit_dom_html_font_element_get_size = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["size"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_field_set_element_get_type = (function() + { + return h$g_get_type(HTMLFieldSetElement); + }); +var h$webkit_dom_html_field_set_element_check_validity; +h$webkit_dom_html_field_set_element_check_validity = (function(self, + self_2) + { + return self["checkValidity"](); + }); +var h$webkit_dom_html_field_set_element_set_custom_validity; +h$webkit_dom_html_field_set_element_set_custom_validity = (function(self, + self_2, error, + error_2) + { + return self["setCustomValidity"](h$decodeUtf8z(error, + error_2)); + }); +var h$webkit_dom_html_field_set_element_set_disabled; +h$webkit_dom_html_field_set_element_set_disabled = (function(self, + self_2, val) + { + self["disabled"] = val; + }); +var h$webkit_dom_html_field_set_element_get_disabled; +h$webkit_dom_html_field_set_element_get_disabled = (function(self, + self_2) + { + return self["disabled"]; + }); +var h$webkit_dom_html_field_set_element_get_form; +h$webkit_dom_html_field_set_element_get_form = (function(self, + self_2) + { + h$ret1 = 0; + return self["form"]; + }); +var h$webkit_dom_html_field_set_element_set_name; +h$webkit_dom_html_field_set_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_field_set_element_get_name; +h$webkit_dom_html_field_set_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_field_set_element_get_elements; +h$webkit_dom_html_field_set_element_get_elements = (function(self, + self_2) + { + h$ret1 = 0; + return self["elements"]; + }); +var h$webkit_dom_html_field_set_element_get_will_validate; +h$webkit_dom_html_field_set_element_get_will_validate = (function(self, + self_2) + { + return self["willValidate"]; + }); +var h$webkit_dom_html_field_set_element_get_validity; +h$webkit_dom_html_field_set_element_get_validity = (function(self, + self_2) + { + h$ret1 = 0; + return self["validity"]; + }); +var h$webkit_dom_html_field_set_element_get_validation_message; +h$webkit_dom_html_field_set_element_get_validation_message = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["validationMessage"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_embed_element_get_type = (function() + { + return h$g_get_type(HTMLEmbedElement); + }); +var h$webkit_dom_html_embed_element_set_align; +h$webkit_dom_html_embed_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_embed_element_get_align; +h$webkit_dom_html_embed_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +var h$webkit_dom_html_embed_element_set_height; +h$webkit_dom_html_embed_element_set_height = (function(self, + self_2, val) + { + self["height"] = val; + }); +var h$webkit_dom_html_embed_element_get_height; +h$webkit_dom_html_embed_element_get_height = (function(self, + self_2) + { + return self["height"]; + }); +var h$webkit_dom_html_embed_element_set_name; +h$webkit_dom_html_embed_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_embed_element_get_name; +h$webkit_dom_html_embed_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_embed_element_set_src; +h$webkit_dom_html_embed_element_set_src = (function(self, + self_2, val, val_2) + { + self["src"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_embed_element_get_src; +h$webkit_dom_html_embed_element_get_src = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["src"]); + }); +var h$webkit_dom_html_embed_element_set_width; +h$webkit_dom_html_embed_element_set_width = (function(self, + self_2, val) + { + self["width"] = val; + }); +var h$webkit_dom_html_embed_element_get_width; +h$webkit_dom_html_embed_element_get_width = (function(self, + self_2) + { + return self["width"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_element_get_type = (function() + { + return h$g_get_type(HTMLElement); + }); +var h$webkit_dom_html_element_insert_adjacent_element; +h$webkit_dom_html_element_insert_adjacent_element = (function(self, + self_2, where, where_2, + element, element_2) + { + h$ret1 = 0; + return self["insertAdjacentElement"](h$decodeUtf8z(where, + where_2), element); + }); +var h$webkit_dom_html_element_insert_adjacent_html; +h$webkit_dom_html_element_insert_adjacent_html = (function(self, + self_2, where, where_2, html, + html_2) + { + return self["insertAdjacentHTML"](h$decodeUtf8z(where, + where_2), + h$decodeUtf8z(html, + html_2)); + }); +var h$webkit_dom_html_element_insert_adjacent_text; +h$webkit_dom_html_element_insert_adjacent_text = (function(self, + self_2, where, where_2, text, + text_2) + { + return self["insertAdjacentText"](h$decodeUtf8z(where, + where_2), + h$decodeUtf8z(text, + text_2)); + }); +var h$webkit_dom_html_element_click; +h$webkit_dom_html_element_click = (function(self, + self_2) + { + return self["click"](); + }); +var h$webkit_dom_html_element_set_id; +h$webkit_dom_html_element_set_id = (function(self, + self_2, val, val_2) + { + self["id"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_element_get_id; +h$webkit_dom_html_element_get_id = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["id"]); + }); +var h$webkit_dom_html_element_set_title; +h$webkit_dom_html_element_set_title = (function(self, + self_2, val, val_2) + { + self["title"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_element_get_title; +h$webkit_dom_html_element_get_title = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["title"]); + }); +var h$webkit_dom_html_element_set_lang; +h$webkit_dom_html_element_set_lang = (function(self, + self_2, val, val_2) + { + self["lang"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_element_get_lang; +h$webkit_dom_html_element_get_lang = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["lang"]); + }); +var h$webkit_dom_html_element_set_translate; +h$webkit_dom_html_element_set_translate = (function(self, + self_2, val) + { + self["translate"] = val; + }); +var h$webkit_dom_html_element_get_translate; +h$webkit_dom_html_element_get_translate = (function(self, + self_2) + { + return self["translate"]; + }); +var h$webkit_dom_html_element_set_dir; +h$webkit_dom_html_element_set_dir = (function(self, + self_2, val, val_2) + { + self["dir"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_element_get_dir; +h$webkit_dom_html_element_get_dir = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["dir"]); + }); +var h$webkit_dom_html_element_set_tab_index; +h$webkit_dom_html_element_set_tab_index = (function(self, + self_2, val) + { + self["tabIndex"] = val; + }); +var h$webkit_dom_html_element_get_tab_index; +h$webkit_dom_html_element_get_tab_index = (function(self, + self_2) + { + return self["tabIndex"]; + }); +var h$webkit_dom_html_element_set_draggable; +h$webkit_dom_html_element_set_draggable = (function(self, + self_2, val) + { + self["draggable"] = val; + }); +var h$webkit_dom_html_element_get_draggable; +h$webkit_dom_html_element_get_draggable = (function(self, + self_2) + { + return self["draggable"]; + }); +var h$webkit_dom_html_element_set_webkitdropzone; +h$webkit_dom_html_element_set_webkitdropzone = (function(self, + self_2, val, val_2) + { + self["webkitdropzone"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_element_get_webkitdropzone; +h$webkit_dom_html_element_get_webkitdropzone = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["webkitdropzone"]); + }); +var h$webkit_dom_html_element_set_hidden; +h$webkit_dom_html_element_set_hidden = (function(self, + self_2, val) + { + self["hidden"] = val; + }); +var h$webkit_dom_html_element_get_hidden; +h$webkit_dom_html_element_get_hidden = (function(self, + self_2) + { + return self["hidden"]; + }); +var h$webkit_dom_html_element_set_access_key; +h$webkit_dom_html_element_set_access_key = (function(self, + self_2, val, val_2) + { + self["accessKey"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_element_get_access_key; +h$webkit_dom_html_element_get_access_key = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["accessKey"]); + }); +var h$webkit_dom_html_element_set_inner_html; +h$webkit_dom_html_element_set_inner_html = (function(self, + self_2, val, val_2) + { + self["innerHTML"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_element_get_inner_html; +h$webkit_dom_html_element_get_inner_html = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["innerHTML"]); + }); +var h$webkit_dom_html_element_set_inner_text; +h$webkit_dom_html_element_set_inner_text = (function(self, + self_2, val, val_2) + { + self["innerText"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_element_get_inner_text; +h$webkit_dom_html_element_get_inner_text = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["innerText"]); + }); +var h$webkit_dom_html_element_set_outer_html; +h$webkit_dom_html_element_set_outer_html = (function(self, + self_2, val, val_2) + { + self["outerHTML"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_element_get_outer_html; +h$webkit_dom_html_element_get_outer_html = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["outerHTML"]); + }); +var h$webkit_dom_html_element_set_outer_text; +h$webkit_dom_html_element_set_outer_text = (function(self, + self_2, val, val_2) + { + self["outerText"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_element_get_outer_text; +h$webkit_dom_html_element_get_outer_text = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["outerText"]); + }); +var h$webkit_dom_html_element_get_children; +h$webkit_dom_html_element_get_children = (function(self, + self_2) + { + h$ret1 = 0; + return self["children"]; + }); +var h$webkit_dom_html_element_set_content_editable; +h$webkit_dom_html_element_set_content_editable = (function(self, + self_2, val, val_2) + { + self["contentEditable"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_element_get_content_editable; +h$webkit_dom_html_element_get_content_editable = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["contentEditable"]); + }); +var h$webkit_dom_html_element_get_is_content_editable; +h$webkit_dom_html_element_get_is_content_editable = (function(self, + self_2) + { + return self["isContentEditable"]; + }); +var h$webkit_dom_html_element_set_spellcheck; +h$webkit_dom_html_element_set_spellcheck = (function(self, + self_2, val) + { + self["spellcheck"] = val; + }); +var h$webkit_dom_html_element_get_spellcheck; +h$webkit_dom_html_element_get_spellcheck = (function(self, + self_2) + { + return self["spellcheck"]; + }); +var h$webkit_dom_html_element_set_item_scope; +h$webkit_dom_html_element_set_item_scope = (function(self, + self_2, val) + { + self["itemScope"] = val; + }); +var h$webkit_dom_html_element_get_item_scope; +h$webkit_dom_html_element_get_item_scope = (function(self, + self_2) + { + return self["itemScope"]; + }); +var h$webkit_dom_html_element_get_item_type; +h$webkit_dom_html_element_get_item_type = (function(self, + self_2) + { + h$ret1 = 0; + return self["itemType"]; + }); +var h$webkit_dom_html_element_set_item_id; +h$webkit_dom_html_element_set_item_id = (function(self, + self_2, val, val_2) + { + self["itemId"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_element_get_item_id; +h$webkit_dom_html_element_get_item_id = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["itemId"]); + }); +var h$webkit_dom_html_element_get_item_ref; +h$webkit_dom_html_element_get_item_ref = (function(self, + self_2) + { + h$ret1 = 0; + return self["itemRef"]; + }); +var h$webkit_dom_html_element_get_item_prop; +h$webkit_dom_html_element_get_item_prop = (function(self, + self_2) + { + h$ret1 = 0; + return self["itemProp"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_document_get_type = (function() + { + return h$g_get_type(HTMLDocument); + }); +var h$webkit_dom_html_document_open; +h$webkit_dom_html_document_open = (function(self, + self_2) + { + return self["open"](); + }); +var h$webkit_dom_html_document_close; +h$webkit_dom_html_document_close = (function(self, + self_2) + { + return self["close"](); + }); +var h$webkit_dom_html_document_clear; +h$webkit_dom_html_document_clear = (function(self, + self_2) + { + return self["clear"](); + }); +var h$webkit_dom_html_document_capture_events; +h$webkit_dom_html_document_capture_events = (function(self, + self_2) + { + return self["captureEvents"](); + }); +var h$webkit_dom_html_document_release_events; +h$webkit_dom_html_document_release_events = (function(self, + self_2) + { + return self["releaseEvents"](); + }); +var h$webkit_dom_html_document_has_focus; +h$webkit_dom_html_document_has_focus = (function(self, + self_2) + { + return self["hasFocus"](); + }); +var h$webkit_dom_html_document_get_embeds; +h$webkit_dom_html_document_get_embeds = (function(self, + self_2) + { + h$ret1 = 0; + return self["embeds"]; + }); +var h$webkit_dom_html_document_get_plugins; +h$webkit_dom_html_document_get_plugins = (function(self, + self_2) + { + h$ret1 = 0; + return self["plugins"]; + }); +var h$webkit_dom_html_document_get_scripts; +h$webkit_dom_html_document_get_scripts = (function(self, + self_2) + { + h$ret1 = 0; + return self["scripts"]; + }); +var h$webkit_dom_html_document_get_width; +h$webkit_dom_html_document_get_width = (function(self, + self_2) + { + return self["width"]; + }); +var h$webkit_dom_html_document_get_height; +h$webkit_dom_html_document_get_height = (function(self, + self_2) + { + return self["height"]; + }); +var h$webkit_dom_html_document_set_dir; +h$webkit_dom_html_document_set_dir = (function(self, + self_2, val, val_2) + { + self["dir"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_document_get_dir; +h$webkit_dom_html_document_get_dir = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["dir"]); + }); +var h$webkit_dom_html_document_set_design_mode; +h$webkit_dom_html_document_set_design_mode = (function(self, + self_2, val, val_2) + { + self["designMode"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_document_get_design_mode; +h$webkit_dom_html_document_get_design_mode = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["designMode"]); + }); +var h$webkit_dom_html_document_get_compat_mode; +h$webkit_dom_html_document_get_compat_mode = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["compatMode"]); + }); +var h$webkit_dom_html_document_get_active_element; +h$webkit_dom_html_document_get_active_element = (function(self, + self_2) + { + h$ret1 = 0; + return self["activeElement"]; + }); +var h$webkit_dom_html_document_set_bg_color; +h$webkit_dom_html_document_set_bg_color = (function(self, + self_2, val, val_2) + { + self["bgColor"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_document_get_bg_color; +h$webkit_dom_html_document_get_bg_color = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["bgColor"]); + }); +var h$webkit_dom_html_document_set_fg_color; +h$webkit_dom_html_document_set_fg_color = (function(self, + self_2, val, val_2) + { + self["fgColor"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_document_get_fg_color; +h$webkit_dom_html_document_get_fg_color = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["fgColor"]); + }); +var h$webkit_dom_html_document_set_alink_color; +h$webkit_dom_html_document_set_alink_color = (function(self, + self_2, val, val_2) + { + self["alinkColor"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_document_get_alink_color; +h$webkit_dom_html_document_get_alink_color = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["alinkColor"]); + }); +var h$webkit_dom_html_document_set_link_color; +h$webkit_dom_html_document_set_link_color = (function(self, + self_2, val, val_2) + { + self["linkColor"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_document_get_link_color; +h$webkit_dom_html_document_get_link_color = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["linkColor"]); + }); +var h$webkit_dom_html_document_set_vlink_color; +h$webkit_dom_html_document_set_vlink_color = (function(self, + self_2, val, val_2) + { + self["vlinkColor"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_document_get_vlink_color; +h$webkit_dom_html_document_get_vlink_color = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["vlinkColor"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_htmld_list_element_get_type = (function() + { + return h$g_get_type(HTMLDListElement); + }); +var h$webkit_dom_htmld_list_element_set_compact; +h$webkit_dom_htmld_list_element_set_compact = (function(self, + self_2, val) + { + self["compact"] = val; + }); +var h$webkit_dom_htmld_list_element_get_compact; +h$webkit_dom_htmld_list_element_get_compact = (function(self, + self_2) + { + return self["compact"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_div_element_get_type = (function() + { + return h$g_get_type(HTMLDivElement); + }); +var h$webkit_dom_html_div_element_set_align; +h$webkit_dom_html_div_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_div_element_get_align; +h$webkit_dom_html_div_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_directory_element_get_type = (function() + { + return h$g_get_type(HTMLDirectoryElement); + }); +var h$webkit_dom_html_directory_element_set_compact; +h$webkit_dom_html_directory_element_set_compact = (function(self, + self_2, val) + { + self["compact"] = val; + }); +var h$webkit_dom_html_directory_element_get_compact; +h$webkit_dom_html_directory_element_get_compact = (function(self, + self_2) + { + return self["compact"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_details_element_get_type = (function() + { + return h$g_get_type(HTMLDetailsElement); + }); +var h$webkit_dom_html_details_element_set_open; +h$webkit_dom_html_details_element_set_open = (function(self, + self_2, val) + { + self["open"] = val; + }); +var h$webkit_dom_html_details_element_get_open; +h$webkit_dom_html_details_element_get_open = (function(self, + self_2) + { + return self["open"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_collection_get_type = (function() + { + return h$g_get_type(HTMLCollection); + }); +var h$webkit_dom_html_collection_item; +h$webkit_dom_html_collection_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["item"](index); + }); +var h$webkit_dom_html_collection_get_length; +h$webkit_dom_html_collection_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_canvas_element_get_type = (function() + { + return h$g_get_type(HTMLCanvasElement); + }); +var h$webkit_dom_html_canvas_element_set_width; +h$webkit_dom_html_canvas_element_set_width = (function(self, + self_2, val) + { + self["width"] = val; + }); +var h$webkit_dom_html_canvas_element_get_width; +h$webkit_dom_html_canvas_element_get_width = (function(self, + self_2) + { + return self["width"]; + }); +var h$webkit_dom_html_canvas_element_set_height; +h$webkit_dom_html_canvas_element_set_height = (function(self, + self_2, val) + { + self["height"] = val; + }); +var h$webkit_dom_html_canvas_element_get_height; +h$webkit_dom_html_canvas_element_get_height = (function(self, + self_2) + { + return self["height"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_button_element_get_type = (function() + { + return h$g_get_type(HTMLButtonElement); + }); +var h$webkit_dom_html_button_element_check_validity; +h$webkit_dom_html_button_element_check_validity = (function(self, + self_2) + { + return self["checkValidity"](); + }); +var h$webkit_dom_html_button_element_set_custom_validity; +h$webkit_dom_html_button_element_set_custom_validity = (function(self, + self_2, error, error_2) + { + return self["setCustomValidity"](h$decodeUtf8z(error, + error_2)); + }); +var h$webkit_dom_html_button_element_set_autofocus; +h$webkit_dom_html_button_element_set_autofocus = (function(self, + self_2, val) + { + self["autofocus"] = val; + }); +var h$webkit_dom_html_button_element_get_autofocus; +h$webkit_dom_html_button_element_get_autofocus = (function(self, + self_2) + { + return self["autofocus"]; + }); +var h$webkit_dom_html_button_element_set_disabled; +h$webkit_dom_html_button_element_set_disabled = (function(self, + self_2, val) + { + self["disabled"] = val; + }); +var h$webkit_dom_html_button_element_get_disabled; +h$webkit_dom_html_button_element_get_disabled = (function(self, + self_2) + { + return self["disabled"]; + }); +var h$webkit_dom_html_button_element_get_form; +h$webkit_dom_html_button_element_get_form = (function(self, + self_2) + { + h$ret1 = 0; + return self["form"]; + }); +var h$webkit_dom_html_button_element_set_form_action; +h$webkit_dom_html_button_element_set_form_action = (function(self, + self_2, val, val_2) + { + self["formAction"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_button_element_get_form_action; +h$webkit_dom_html_button_element_get_form_action = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["formAction"]); + }); +var h$webkit_dom_html_button_element_set_form_enctype; +h$webkit_dom_html_button_element_set_form_enctype = (function(self, + self_2, val, val_2) + { + self["formEnctype"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_button_element_get_form_enctype; +h$webkit_dom_html_button_element_get_form_enctype = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["formEnctype"]); + }); +var h$webkit_dom_html_button_element_set_form_method; +h$webkit_dom_html_button_element_set_form_method = (function(self, + self_2, val, val_2) + { + self["formMethod"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_button_element_get_form_method; +h$webkit_dom_html_button_element_get_form_method = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["formMethod"]); + }); +var h$webkit_dom_html_button_element_set_form_no_validate; +h$webkit_dom_html_button_element_set_form_no_validate = (function(self, + self_2, val) + { + self["formNoValidate"] = val; + }); +var h$webkit_dom_html_button_element_get_form_no_validate; +h$webkit_dom_html_button_element_get_form_no_validate = (function(self, + self_2) + { + return self["formNoValidate"]; + }); +var h$webkit_dom_html_button_element_set_form_target; +h$webkit_dom_html_button_element_set_form_target = (function(self, + self_2, val, val_2) + { + self["formTarget"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_button_element_get_form_target; +h$webkit_dom_html_button_element_get_form_target = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["formTarget"]); + }); +var h$webkit_dom_html_button_element_set_name; +h$webkit_dom_html_button_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_button_element_get_name; +h$webkit_dom_html_button_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_button_element_set_value; +h$webkit_dom_html_button_element_set_value = (function(self, + self_2, val, val_2) + { + self["value"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_button_element_get_value; +h$webkit_dom_html_button_element_get_value = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["value"]); + }); +var h$webkit_dom_html_button_element_get_will_validate; +h$webkit_dom_html_button_element_get_will_validate = (function(self, + self_2) + { + return self["willValidate"]; + }); +var h$webkit_dom_html_button_element_get_validity; +h$webkit_dom_html_button_element_get_validity = (function(self, + self_2) + { + h$ret1 = 0; + return self["validity"]; + }); +var h$webkit_dom_html_button_element_get_validation_message; +h$webkit_dom_html_button_element_get_validation_message = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["validationMessage"]); + }); +var h$webkit_dom_html_button_element_get_labels; +h$webkit_dom_html_button_element_get_labels = (function(self, + self_2) + { + h$ret1 = 0; + return self["labels"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_htmlbr_element_get_type = (function() + { + return h$g_get_type(HTMLBRElement); + }); +var h$webkit_dom_htmlbr_element_set_clear; +h$webkit_dom_htmlbr_element_set_clear = (function(self, + self_2, val, val_2) + { + self["clear"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_htmlbr_element_get_clear; +h$webkit_dom_htmlbr_element_get_clear = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["clear"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_body_element_get_type = (function() + { + return h$g_get_type(HTMLBodyElement); + }); +var h$webkit_dom_html_body_element_set_a_link; +h$webkit_dom_html_body_element_set_a_link = (function(self, + self_2, val, val_2) + { + self["aLink"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_body_element_get_a_link; +h$webkit_dom_html_body_element_get_a_link = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["aLink"]); + }); +var h$webkit_dom_html_body_element_set_background; +h$webkit_dom_html_body_element_set_background = (function(self, + self_2, val, val_2) + { + self["background"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_body_element_get_background; +h$webkit_dom_html_body_element_get_background = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["background"]); + }); +var h$webkit_dom_html_body_element_set_bg_color; +h$webkit_dom_html_body_element_set_bg_color = (function(self, + self_2, val, val_2) + { + self["bgColor"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_body_element_get_bg_color; +h$webkit_dom_html_body_element_get_bg_color = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["bgColor"]); + }); +var h$webkit_dom_html_body_element_set_link; +h$webkit_dom_html_body_element_set_link = (function(self, + self_2, val, val_2) + { + self["link"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_body_element_get_link; +h$webkit_dom_html_body_element_get_link = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["link"]); + }); +var h$webkit_dom_html_body_element_set_text; +h$webkit_dom_html_body_element_set_text = (function(self, + self_2, val, val_2) + { + self["text"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_body_element_get_text; +h$webkit_dom_html_body_element_get_text = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["text"]); + }); +var h$webkit_dom_html_body_element_set_v_link; +h$webkit_dom_html_body_element_set_v_link = (function(self, + self_2, val, val_2) + { + self["vLink"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_body_element_get_v_link; +h$webkit_dom_html_body_element_get_v_link = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["vLink"]); + }); +var h$webkit_dom_html_body_element_set_onbeforeunload; +h$webkit_dom_html_body_element_set_onbeforeunload = (function(self, + self_2, val, val_2) + { + self["onbeforeunload"] = val; + }); +var h$webkit_dom_html_body_element_get_onbeforeunload; +h$webkit_dom_html_body_element_get_onbeforeunload = (function(self, + self_2) + { + h$ret1 = 0; + return self["onbeforeunload"]; + }); +var h$webkit_dom_html_body_element_set_onhashchange; +h$webkit_dom_html_body_element_set_onhashchange = (function(self, + self_2, val, val_2) + { + self["onhashchange"] = val; + }); +var h$webkit_dom_html_body_element_get_onhashchange; +h$webkit_dom_html_body_element_get_onhashchange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onhashchange"]; + }); +var h$webkit_dom_html_body_element_set_onmessage; +h$webkit_dom_html_body_element_set_onmessage = (function(self, + self_2, val, val_2) + { + self["onmessage"] = val; + }); +var h$webkit_dom_html_body_element_get_onmessage; +h$webkit_dom_html_body_element_get_onmessage = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmessage"]; + }); +var h$webkit_dom_html_body_element_set_onoffline; +h$webkit_dom_html_body_element_set_onoffline = (function(self, + self_2, val, val_2) + { + self["onoffline"] = val; + }); +var h$webkit_dom_html_body_element_get_onoffline; +h$webkit_dom_html_body_element_get_onoffline = (function(self, + self_2) + { + h$ret1 = 0; + return self["onoffline"]; + }); +var h$webkit_dom_html_body_element_set_ononline; +h$webkit_dom_html_body_element_set_ononline = (function(self, + self_2, val, val_2) + { + self["ononline"] = val; + }); +var h$webkit_dom_html_body_element_get_ononline; +h$webkit_dom_html_body_element_get_ononline = (function(self, + self_2) + { + h$ret1 = 0; + return self["ononline"]; + }); +var h$webkit_dom_html_body_element_set_onpopstate; +h$webkit_dom_html_body_element_set_onpopstate = (function(self, + self_2, val, val_2) + { + self["onpopstate"] = val; + }); +var h$webkit_dom_html_body_element_get_onpopstate; +h$webkit_dom_html_body_element_get_onpopstate = (function(self, + self_2) + { + h$ret1 = 0; + return self["onpopstate"]; + }); +var h$webkit_dom_html_body_element_set_onresize; +h$webkit_dom_html_body_element_set_onresize = (function(self, + self_2, val, val_2) + { + self["onresize"] = val; + }); +var h$webkit_dom_html_body_element_get_onresize; +h$webkit_dom_html_body_element_get_onresize = (function(self, + self_2) + { + h$ret1 = 0; + return self["onresize"]; + }); +var h$webkit_dom_html_body_element_set_onstorage; +h$webkit_dom_html_body_element_set_onstorage = (function(self, + self_2, val, val_2) + { + self["onstorage"] = val; + }); +var h$webkit_dom_html_body_element_get_onstorage; +h$webkit_dom_html_body_element_get_onstorage = (function(self, + self_2) + { + h$ret1 = 0; + return self["onstorage"]; + }); +var h$webkit_dom_html_body_element_set_onunload; +h$webkit_dom_html_body_element_set_onunload = (function(self, + self_2, val, val_2) + { + self["onunload"] = val; + }); +var h$webkit_dom_html_body_element_get_onunload; +h$webkit_dom_html_body_element_get_onunload = (function(self, + self_2) + { + h$ret1 = 0; + return self["onunload"]; + }); +var h$webkit_dom_html_body_element_set_onorientationchange; +h$webkit_dom_html_body_element_set_onorientationchange = (function(self, + self_2, val, val_2) + { + self["onorientationchange"] = val; + }); +var h$webkit_dom_html_body_element_get_onorientationchange; +h$webkit_dom_html_body_element_get_onorientationchange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onorientationchange"]; + }); +var h$webkit_dom_html_body_element_set_onblur; +h$webkit_dom_html_body_element_set_onblur = (function(self, + self_2, val, val_2) + { + self["onblur"] = val; + }); +var h$webkit_dom_html_body_element_get_onblur; +h$webkit_dom_html_body_element_get_onblur = (function(self, + self_2) + { + h$ret1 = 0; + return self["onblur"]; + }); +var h$webkit_dom_html_body_element_set_onerror; +h$webkit_dom_html_body_element_set_onerror = (function(self, + self_2, val, val_2) + { + self["onerror"] = val; + }); +var h$webkit_dom_html_body_element_get_onerror; +h$webkit_dom_html_body_element_get_onerror = (function(self, + self_2) + { + h$ret1 = 0; + return self["onerror"]; + }); +var h$webkit_dom_html_body_element_set_onfocus; +h$webkit_dom_html_body_element_set_onfocus = (function(self, + self_2, val, val_2) + { + self["onfocus"] = val; + }); +var h$webkit_dom_html_body_element_get_onfocus; +h$webkit_dom_html_body_element_get_onfocus = (function(self, + self_2) + { + h$ret1 = 0; + return self["onfocus"]; + }); +var h$webkit_dom_html_body_element_set_onload; +h$webkit_dom_html_body_element_set_onload = (function(self, + self_2, val, val_2) + { + self["onload"] = val; + }); +var h$webkit_dom_html_body_element_get_onload; +h$webkit_dom_html_body_element_get_onload = (function(self, + self_2) + { + h$ret1 = 0; + return self["onload"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_base_font_element_get_type = (function() + { + return h$g_get_type(HTMLBaseFontElement); + }); +var h$webkit_dom_html_base_font_element_set_color; +h$webkit_dom_html_base_font_element_set_color = (function(self, + self_2, val, val_2) + { + self["color"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_base_font_element_get_color; +h$webkit_dom_html_base_font_element_get_color = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["color"]); + }); +var h$webkit_dom_html_base_font_element_set_face; +h$webkit_dom_html_base_font_element_set_face = (function(self, + self_2, val, val_2) + { + self["face"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_base_font_element_get_face; +h$webkit_dom_html_base_font_element_get_face = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["face"]); + }); +var h$webkit_dom_html_base_font_element_set_size; +h$webkit_dom_html_base_font_element_set_size = (function(self, + self_2, val) + { + self["size"] = val; + }); +var h$webkit_dom_html_base_font_element_get_size; +h$webkit_dom_html_base_font_element_get_size = (function(self, + self_2) + { + return self["size"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_base_element_get_type = (function() + { + return h$g_get_type(HTMLBaseElement); + }); +var h$webkit_dom_html_base_element_set_href; +h$webkit_dom_html_base_element_set_href = (function(self, + self_2, val, val_2) + { + self["href"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_base_element_get_href; +h$webkit_dom_html_base_element_get_href = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["href"]); + }); +var h$webkit_dom_html_base_element_set_target; +h$webkit_dom_html_base_element_set_target = (function(self, + self_2, val, val_2) + { + self["target"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_base_element_get_target; +h$webkit_dom_html_base_element_get_target = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["target"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_area_element_get_type = (function() + { + return h$g_get_type(HTMLAreaElement); + }); +var h$webkit_dom_html_area_element_set_alt; +h$webkit_dom_html_area_element_set_alt = (function(self, + self_2, val, val_2) + { + self["alt"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_area_element_get_alt; +h$webkit_dom_html_area_element_get_alt = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["alt"]); + }); +var h$webkit_dom_html_area_element_set_coords; +h$webkit_dom_html_area_element_set_coords = (function(self, + self_2, val, val_2) + { + self["coords"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_area_element_get_coords; +h$webkit_dom_html_area_element_get_coords = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["coords"]); + }); +var h$webkit_dom_html_area_element_set_href; +h$webkit_dom_html_area_element_set_href = (function(self, + self_2, val, val_2) + { + self["href"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_area_element_get_href; +h$webkit_dom_html_area_element_get_href = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["href"]); + }); +var h$webkit_dom_html_area_element_set_no_href; +h$webkit_dom_html_area_element_set_no_href = (function(self, + self_2, val) + { + self["noHref"] = val; + }); +var h$webkit_dom_html_area_element_get_no_href; +h$webkit_dom_html_area_element_get_no_href = (function(self, + self_2) + { + return self["noHref"]; + }); +var h$webkit_dom_html_area_element_set_ping; +h$webkit_dom_html_area_element_set_ping = (function(self, + self_2, val, val_2) + { + self["ping"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_area_element_get_ping; +h$webkit_dom_html_area_element_get_ping = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["ping"]); + }); +var h$webkit_dom_html_area_element_set_shape; +h$webkit_dom_html_area_element_set_shape = (function(self, + self_2, val, val_2) + { + self["shape"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_area_element_get_shape; +h$webkit_dom_html_area_element_get_shape = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["shape"]); + }); +var h$webkit_dom_html_area_element_set_target; +h$webkit_dom_html_area_element_set_target = (function(self, + self_2, val, val_2) + { + self["target"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_area_element_get_target; +h$webkit_dom_html_area_element_get_target = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["target"]); + }); +var h$webkit_dom_html_area_element_get_hash; +h$webkit_dom_html_area_element_get_hash = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["hash"]); + }); +var h$webkit_dom_html_area_element_get_host; +h$webkit_dom_html_area_element_get_host = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["host"]); + }); +var h$webkit_dom_html_area_element_get_hostname; +h$webkit_dom_html_area_element_get_hostname = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["hostname"]); + }); +var h$webkit_dom_html_area_element_get_pathname; +h$webkit_dom_html_area_element_get_pathname = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["pathname"]); + }); +var h$webkit_dom_html_area_element_get_port; +h$webkit_dom_html_area_element_get_port = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["port"]); + }); +var h$webkit_dom_html_area_element_get_protocol; +h$webkit_dom_html_area_element_get_protocol = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["protocol"]); + }); +var h$webkit_dom_html_area_element_get_search; +h$webkit_dom_html_area_element_get_search = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["search"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_applet_element_get_type = (function() + { + return h$g_get_type(HTMLAppletElement); + }); +var h$webkit_dom_html_applet_element_set_align; +h$webkit_dom_html_applet_element_set_align = (function(self, + self_2, val, val_2) + { + self["align"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_applet_element_get_align; +h$webkit_dom_html_applet_element_get_align = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["align"]); + }); +var h$webkit_dom_html_applet_element_set_alt; +h$webkit_dom_html_applet_element_set_alt = (function(self, + self_2, val, val_2) + { + self["alt"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_applet_element_get_alt; +h$webkit_dom_html_applet_element_get_alt = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["alt"]); + }); +var h$webkit_dom_html_applet_element_set_archive; +h$webkit_dom_html_applet_element_set_archive = (function(self, + self_2, val, val_2) + { + self["archive"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_applet_element_get_archive; +h$webkit_dom_html_applet_element_get_archive = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["archive"]); + }); +var h$webkit_dom_html_applet_element_set_code; +h$webkit_dom_html_applet_element_set_code = (function(self, + self_2, val, val_2) + { + self["code"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_applet_element_get_code; +h$webkit_dom_html_applet_element_get_code = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["code"]); + }); +var h$webkit_dom_html_applet_element_set_code_base; +h$webkit_dom_html_applet_element_set_code_base = (function(self, + self_2, val, val_2) + { + self["codeBase"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_applet_element_get_code_base; +h$webkit_dom_html_applet_element_get_code_base = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["codeBase"]); + }); +var h$webkit_dom_html_applet_element_set_height; +h$webkit_dom_html_applet_element_set_height = (function(self, + self_2, val, val_2) + { + self["height"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_applet_element_get_height; +h$webkit_dom_html_applet_element_get_height = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["height"]); + }); +var h$webkit_dom_html_applet_element_set_hspace; +h$webkit_dom_html_applet_element_set_hspace = (function(self, + self_2, val) + { + self["hspace"] = val; + }); +var h$webkit_dom_html_applet_element_get_hspace; +h$webkit_dom_html_applet_element_get_hspace = (function(self, + self_2) + { + return self["hspace"]; + }); +var h$webkit_dom_html_applet_element_set_name; +h$webkit_dom_html_applet_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_applet_element_get_name; +h$webkit_dom_html_applet_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_applet_element_set_object; +h$webkit_dom_html_applet_element_set_object = (function(self, + self_2, val, val_2) + { + self["object"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_applet_element_get_object; +h$webkit_dom_html_applet_element_get_object = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["object"]); + }); +var h$webkit_dom_html_applet_element_set_vspace; +h$webkit_dom_html_applet_element_set_vspace = (function(self, + self_2, val) + { + self["vspace"] = val; + }); +var h$webkit_dom_html_applet_element_get_vspace; +h$webkit_dom_html_applet_element_get_vspace = (function(self, + self_2) + { + return self["vspace"]; + }); +var h$webkit_dom_html_applet_element_set_width; +h$webkit_dom_html_applet_element_set_width = (function(self, + self_2, val, val_2) + { + self["width"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_applet_element_get_width; +h$webkit_dom_html_applet_element_get_width = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["width"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_html_anchor_element_get_type = (function() + { + return h$g_get_type(HTMLAnchorElement); + }); +var h$webkit_dom_html_anchor_element_set_charset; +h$webkit_dom_html_anchor_element_set_charset = (function(self, + self_2, val, val_2) + { + self["charset"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_charset; +h$webkit_dom_html_anchor_element_get_charset = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["charset"]); + }); +var h$webkit_dom_html_anchor_element_set_coords; +h$webkit_dom_html_anchor_element_set_coords = (function(self, + self_2, val, val_2) + { + self["coords"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_coords; +h$webkit_dom_html_anchor_element_get_coords = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["coords"]); + }); +var h$webkit_dom_html_anchor_element_set_download; +h$webkit_dom_html_anchor_element_set_download = (function(self, + self_2, val, val_2) + { + self["download"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_download; +h$webkit_dom_html_anchor_element_get_download = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["download"]); + }); +var h$webkit_dom_html_anchor_element_set_href; +h$webkit_dom_html_anchor_element_set_href = (function(self, + self_2, val, val_2) + { + self["href"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_href; +h$webkit_dom_html_anchor_element_get_href = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["href"]); + }); +var h$webkit_dom_html_anchor_element_set_hreflang; +h$webkit_dom_html_anchor_element_set_hreflang = (function(self, + self_2, val, val_2) + { + self["hreflang"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_hreflang; +h$webkit_dom_html_anchor_element_get_hreflang = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["hreflang"]); + }); +var h$webkit_dom_html_anchor_element_set_name; +h$webkit_dom_html_anchor_element_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_name; +h$webkit_dom_html_anchor_element_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_html_anchor_element_set_ping; +h$webkit_dom_html_anchor_element_set_ping = (function(self, + self_2, val, val_2) + { + self["ping"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_ping; +h$webkit_dom_html_anchor_element_get_ping = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["ping"]); + }); +var h$webkit_dom_html_anchor_element_set_rel; +h$webkit_dom_html_anchor_element_set_rel = (function(self, + self_2, val, val_2) + { + self["rel"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_rel; +h$webkit_dom_html_anchor_element_get_rel = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["rel"]); + }); +var h$webkit_dom_html_anchor_element_set_rev; +h$webkit_dom_html_anchor_element_set_rev = (function(self, + self_2, val, val_2) + { + self["rev"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_rev; +h$webkit_dom_html_anchor_element_get_rev = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["rev"]); + }); +var h$webkit_dom_html_anchor_element_set_shape; +h$webkit_dom_html_anchor_element_set_shape = (function(self, + self_2, val, val_2) + { + self["shape"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_shape; +h$webkit_dom_html_anchor_element_get_shape = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["shape"]); + }); +var h$webkit_dom_html_anchor_element_set_target; +h$webkit_dom_html_anchor_element_set_target = (function(self, + self_2, val, val_2) + { + self["target"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_target; +h$webkit_dom_html_anchor_element_get_target = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["target"]); + }); +var h$webkit_dom_html_anchor_element_set_hash; +h$webkit_dom_html_anchor_element_set_hash = (function(self, + self_2, val, val_2) + { + self["hash"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_hash; +h$webkit_dom_html_anchor_element_get_hash = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["hash"]); + }); +var h$webkit_dom_html_anchor_element_set_host; +h$webkit_dom_html_anchor_element_set_host = (function(self, + self_2, val, val_2) + { + self["host"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_host; +h$webkit_dom_html_anchor_element_get_host = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["host"]); + }); +var h$webkit_dom_html_anchor_element_set_hostname; +h$webkit_dom_html_anchor_element_set_hostname = (function(self, + self_2, val, val_2) + { + self["hostname"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_hostname; +h$webkit_dom_html_anchor_element_get_hostname = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["hostname"]); + }); +var h$webkit_dom_html_anchor_element_set_pathname; +h$webkit_dom_html_anchor_element_set_pathname = (function(self, + self_2, val, val_2) + { + self["pathname"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_pathname; +h$webkit_dom_html_anchor_element_get_pathname = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["pathname"]); + }); +var h$webkit_dom_html_anchor_element_set_port; +h$webkit_dom_html_anchor_element_set_port = (function(self, + self_2, val, val_2) + { + self["port"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_port; +h$webkit_dom_html_anchor_element_get_port = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["port"]); + }); +var h$webkit_dom_html_anchor_element_set_protocol; +h$webkit_dom_html_anchor_element_set_protocol = (function(self, + self_2, val, val_2) + { + self["protocol"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_protocol; +h$webkit_dom_html_anchor_element_get_protocol = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["protocol"]); + }); +var h$webkit_dom_html_anchor_element_set_search; +h$webkit_dom_html_anchor_element_set_search = (function(self, + self_2, val, val_2) + { + self["search"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_html_anchor_element_get_search; +h$webkit_dom_html_anchor_element_get_search = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["search"]); + }); +var h$webkit_dom_html_anchor_element_get_origin; +h$webkit_dom_html_anchor_element_get_origin = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["origin"]); + }); +var h$webkit_dom_html_anchor_element_get_text; +h$webkit_dom_html_anchor_element_get_text = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["text"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Window +h$webkit_dom_history_get_type = (function() + { + return h$g_get_type(History); + }); +var h$webkit_dom_history_get_length; +h$webkit_dom_history_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_geolocation_get_type = (function() + { + return h$g_get_type(Geolocation); + }); +var h$webkit_dom_geolocation_clear_watch; +h$webkit_dom_geolocation_clear_watch = (function(self, + self_2, watchId) + { + return self["clearWatch"](watchId); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_file_list_get_type = (function() + { + return h$g_get_type(FileList); + }); +var h$webkit_dom_file_list_item; +h$webkit_dom_file_list_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["item"](index); + }); +var h$webkit_dom_file_list_get_length; +h$webkit_dom_file_list_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_file_get_type = (function() + { + return h$g_get_type(File); + }); +var h$webkit_dom_file_get_name; +h$webkit_dom_file_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Events +h$webkit_dom_event_target_get_type = (function() + { + return h$g_get_type(EventTarget); + }); +var h$webkit_dom_event_target_dispatch_event; +h$webkit_dom_event_target_dispatch_event = (function(self, + self_2, event, event_2) + { + return self["dispatchEvent"](event); + }); +// Graphics.UI.Gtk.WebKit.DOM.Events +h$webkit_dom_event_get_type = (function() + { + return h$g_get_type(Event); + }); +var h$webkit_dom_event_stop_propagation; +h$webkit_dom_event_stop_propagation = (function(self, + self_2) + { + return self["stopPropagation"](); + }); +var h$webkit_dom_event_prevent_default; +h$webkit_dom_event_prevent_default = (function(self, + self_2) + { + return self["preventDefault"](); + }); +var h$webkit_dom_event_init_event; +h$webkit_dom_event_init_event = (function(self, + self_2, eventTypeArg, + eventTypeArg_2, canBubbleArg, + cancelableArg) + { + return self["initEvent"](h$decodeUtf8z(eventTypeArg, + eventTypeArg_2), canBubbleArg, + cancelableArg); + }); +var h$webkit_dom_event_stop_immediate_propagation; +h$webkit_dom_event_stop_immediate_propagation = (function(self, + self_2) + { + return self["stopImmediatePropagation"](); + }); +var h$webkit_dom_event_get_target; +h$webkit_dom_event_get_target = (function(self, + self_2) + { + h$ret1 = 0; + return self["target"]; + }); +var h$webkit_dom_event_get_current_target; +h$webkit_dom_event_get_current_target = (function(self, + self_2) + { + h$ret1 = 0; + return self["currentTarget"]; + }); +var h$webkit_dom_event_get_event_phase; +h$webkit_dom_event_get_event_phase = (function(self, + self_2) + { + return self["eventPhase"]; + }); +var h$webkit_dom_event_get_bubbles; +h$webkit_dom_event_get_bubbles = (function(self, + self_2) + { + return self["bubbles"]; + }); +var h$webkit_dom_event_get_cancelable; +h$webkit_dom_event_get_cancelable = (function(self, + self_2) + { + return self["cancelable"]; + }); +var h$webkit_dom_event_get_time_stamp; +h$webkit_dom_event_get_time_stamp = (function(self, + self_2) + { + return self["timeStamp"]; + }); +var h$webkit_dom_event_get_default_prevented; +h$webkit_dom_event_get_default_prevented = (function(self, + self_2) + { + return self["defaultPrevented"]; + }); +var h$webkit_dom_event_get_src_element; +h$webkit_dom_event_get_src_element = (function(self, + self_2) + { + h$ret1 = 0; + return self["srcElement"]; + }); +var h$webkit_dom_event_set_return_value; +h$webkit_dom_event_set_return_value = (function(self, + self_2, val) + { + self["returnValue"] = val; + }); +var h$webkit_dom_event_get_return_value; +h$webkit_dom_event_get_return_value = (function(self, + self_2) + { + return self["returnValue"]; + }); +var h$webkit_dom_event_set_cancel_bubble; +h$webkit_dom_event_set_cancel_bubble = (function(self, + self_2, val) + { + self["cancelBubble"] = val; + }); +var h$webkit_dom_event_get_cancel_bubble; +h$webkit_dom_event_get_cancel_bubble = (function(self, + self_2) + { + return self["cancelBubble"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_entity_reference_get_type = (function() + { + return h$g_get_type(EntityReference); + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_element_get_type = (function() + { + return h$g_get_type(Element); + }); +var h$webkit_dom_element_get_attribute; +h$webkit_dom_element_get_attribute = (function(self, + self_2, name, name_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["getAttribute"](h$decodeUtf8z(name, + name_2))); + }); +var h$webkit_dom_element_set_attribute; +h$webkit_dom_element_set_attribute = (function(self, + self_2, name, name_2, value, + value_2) + { + return self["setAttribute"](h$decodeUtf8z(name, + name_2), h$decodeUtf8z(value, + value_2)); + }); +var h$webkit_dom_element_remove_attribute; +h$webkit_dom_element_remove_attribute = (function(self, + self_2, name, name_2) + { + return self["removeAttribute"](h$decodeUtf8z(name, + name_2)); + }); +var h$webkit_dom_element_get_attribute_node; +h$webkit_dom_element_get_attribute_node = (function(self, + self_2, name, name_2) + { + h$ret1 = 0; + return self["getAttributeNode"](h$decodeUtf8z(name, + name_2)); + }); +var h$webkit_dom_element_set_attribute_node; +h$webkit_dom_element_set_attribute_node = (function(self, + self_2, newAttr, newAttr_2) + { + h$ret1 = 0; + return self["setAttributeNode"](newAttr); + }); +var h$webkit_dom_element_remove_attribute_node; +h$webkit_dom_element_remove_attribute_node = (function(self, + self_2, oldAttr, oldAttr_2) + { + h$ret1 = 0; + return self["removeAttributeNode"](oldAttr); + }); +var h$webkit_dom_element_get_elements_by_tag_name; +h$webkit_dom_element_get_elements_by_tag_name = (function(self, + self_2, name, name_2) + { + h$ret1 = 0; + return self["getElementsByTagName"](h$decodeUtf8z(name, + name_2)); + }); +var h$webkit_dom_element_get_attribute_ns; +h$webkit_dom_element_get_attribute_ns = (function(self, + self_2, namespaceURI, + namespaceURI_2, localName, + localName_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["getAttributeNS"](h$decodeUtf8z(namespaceURI, + namespaceURI_2), + h$decodeUtf8z(localName, + localName_2))); + }); +var h$webkit_dom_element_set_attribute_ns; +h$webkit_dom_element_set_attribute_ns = (function(self, + self_2, namespaceURI, + namespaceURI_2, qualifiedName, + qualifiedName_2, value, value_2) + { + return self["setAttributeNS"](h$decodeUtf8z(namespaceURI, + namespaceURI_2), + h$decodeUtf8z(qualifiedName, + qualifiedName_2), + h$decodeUtf8z(value, value_2)); + }); +var h$webkit_dom_element_remove_attribute_ns; +h$webkit_dom_element_remove_attribute_ns = (function(self, + self_2, namespaceURI, + namespaceURI_2, localName, + localName_2) + { + return self["removeAttributeNS"](h$decodeUtf8z(namespaceURI, + namespaceURI_2), + h$decodeUtf8z(localName, + localName_2)); + }); +var h$webkit_dom_element_get_elements_by_tag_name_ns; +h$webkit_dom_element_get_elements_by_tag_name_ns = (function(self, + self_2, namespaceURI, + namespaceURI_2, localName, + localName_2) + { + h$ret1 = 0; + return self["getElementsByTagNameNS"](h$decodeUtf8z(namespaceURI, + namespaceURI_2), + h$decodeUtf8z(localName, + localName_2)); + }); +var h$webkit_dom_element_get_attribute_node_ns; +h$webkit_dom_element_get_attribute_node_ns = (function(self, + self_2, namespaceURI, + namespaceURI_2, localName, + localName_2) + { + h$ret1 = 0; + return self["getAttributeNodeNS"](h$decodeUtf8z(namespaceURI, + namespaceURI_2), + h$decodeUtf8z(localName, + localName_2)); + }); +var h$webkit_dom_element_set_attribute_node_ns; +h$webkit_dom_element_set_attribute_node_ns = (function(self, + self_2, newAttr, newAttr_2) + { + h$ret1 = 0; + return self["setAttributeNodeNS"](newAttr); + }); +var h$webkit_dom_element_has_attribute; +h$webkit_dom_element_has_attribute = (function(self, + self_2, name, name_2) + { + return self["hasAttribute"](h$decodeUtf8z(name, + name_2)); + }); +var h$webkit_dom_element_has_attribute_ns; +h$webkit_dom_element_has_attribute_ns = (function(self, + self_2, namespaceURI, + namespaceURI_2, localName, + localName_2) + { + return self["hasAttributeNS"](h$decodeUtf8z(namespaceURI, + namespaceURI_2), + h$decodeUtf8z(localName, + localName_2)); + }); +var h$webkit_dom_element_focus; +h$webkit_dom_element_focus = (function(self, + self_2) + { + return self["focus"](); + }); +var h$webkit_dom_element_blur; +h$webkit_dom_element_blur = (function(self, + self_2) + { + return self["blur"](); + }); +var h$webkit_dom_element_scroll_into_view; +h$webkit_dom_element_scroll_into_view = (function(self, + self_2, alignWithTop) + { + return self["scrollIntoView"](alignWithTop); + }); +var h$webkit_dom_element_scroll_into_view_if_needed; +h$webkit_dom_element_scroll_into_view_if_needed = (function(self, + self_2, centerIfNeeded) + { + return self["scrollIntoViewIfNeeded"](centerIfNeeded); + }); +var h$webkit_dom_element_scroll_by_lines; +h$webkit_dom_element_scroll_by_lines = (function(self, + self_2, lines) + { + return self["scrollByLines"](lines); + }); +var h$webkit_dom_element_scroll_by_pages; +h$webkit_dom_element_scroll_by_pages = (function(self, + self_2, pages) + { + return self["scrollByPages"](pages); + }); +var h$webkit_dom_element_get_elements_by_class_name; +h$webkit_dom_element_get_elements_by_class_name = (function(self, + self_2, name, name_2) + { + h$ret1 = 0; + return self["getElementsByClassName"](h$decodeUtf8z(name, + name_2)); + }); +var h$webkit_dom_element_query_selector; +h$webkit_dom_element_query_selector = (function(self, + self_2, selectors, selectors_2) + { + h$ret1 = 0; + return self["querySelector"](h$decodeUtf8z(selectors, + selectors_2)); + }); +var h$webkit_dom_element_query_selector_all; +h$webkit_dom_element_query_selector_all = (function(self, + self_2, selectors, selectors_2) + { + h$ret1 = 0; + return self["querySelectorAll"](h$decodeUtf8z(selectors, + selectors_2)); + }); +var h$webkit_dom_element_webkit_matches_selector; +h$webkit_dom_element_webkit_matches_selector = (function(self, + self_2, selectors, selectors_2) + { + return self["webkitMatchesSelector"](h$decodeUtf8z(selectors, + selectors_2)); + }); +var h$webkit_dom_element_get_tag_name; +h$webkit_dom_element_get_tag_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["tagName"]); + }); +var h$webkit_dom_element_get_style; +h$webkit_dom_element_get_style = (function(self, + self_2) + { + h$ret1 = 0; + return self["style"]; + }); +var h$webkit_dom_element_get_offset_left; +h$webkit_dom_element_get_offset_left = (function(self, + self_2) + { + return self["offsetLeft"]; + }); +var h$webkit_dom_element_get_offset_top; +h$webkit_dom_element_get_offset_top = (function(self, + self_2) + { + return self["offsetTop"]; + }); +var h$webkit_dom_element_get_offset_width; +h$webkit_dom_element_get_offset_width = (function(self, + self_2) + { + return self["offsetWidth"]; + }); +var h$webkit_dom_element_get_offset_height; +h$webkit_dom_element_get_offset_height = (function(self, + self_2) + { + return self["offsetHeight"]; + }); +var h$webkit_dom_element_get_offset_parent; +h$webkit_dom_element_get_offset_parent = (function(self, + self_2) + { + h$ret1 = 0; + return self["offsetParent"]; + }); +var h$webkit_dom_element_get_client_left; +h$webkit_dom_element_get_client_left = (function(self, + self_2) + { + return self["clientLeft"]; + }); +var h$webkit_dom_element_get_client_top; +h$webkit_dom_element_get_client_top = (function(self, + self_2) + { + return self["clientTop"]; + }); +var h$webkit_dom_element_get_client_width; +h$webkit_dom_element_get_client_width = (function(self, + self_2) + { + return self["clientWidth"]; + }); +var h$webkit_dom_element_get_client_height; +h$webkit_dom_element_get_client_height = (function(self, + self_2) + { + return self["clientHeight"]; + }); +var h$webkit_dom_element_set_scroll_left; +h$webkit_dom_element_set_scroll_left = (function(self, + self_2, val) + { + self["scrollLeft"] = val; + }); +var h$webkit_dom_element_get_scroll_left; +h$webkit_dom_element_get_scroll_left = (function(self, + self_2) + { + return self["scrollLeft"]; + }); +var h$webkit_dom_element_set_scroll_top; +h$webkit_dom_element_set_scroll_top = (function(self, + self_2, val) + { + self["scrollTop"] = val; + }); +var h$webkit_dom_element_get_scroll_top; +h$webkit_dom_element_get_scroll_top = (function(self, + self_2) + { + return self["scrollTop"]; + }); +var h$webkit_dom_element_get_scroll_width; +h$webkit_dom_element_get_scroll_width = (function(self, + self_2) + { + return self["scrollWidth"]; + }); +var h$webkit_dom_element_get_scroll_height; +h$webkit_dom_element_get_scroll_height = (function(self, + self_2) + { + return self["scrollHeight"]; + }); +var h$webkit_dom_element_set_class_name; +h$webkit_dom_element_set_class_name = (function(self, + self_2, val, val_2) + { + self["className"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_element_get_class_name; +h$webkit_dom_element_get_class_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["className"]); + }); +var h$webkit_dom_element_get_class_list; +h$webkit_dom_element_get_class_list = (function(self, + self_2) + { + h$ret1 = 0; + return self["classList"]; + }); +var h$webkit_dom_element_get_first_element_child; +h$webkit_dom_element_get_first_element_child = (function(self, + self_2) + { + h$ret1 = 0; + return self["firstElementChild"]; + }); +var h$webkit_dom_element_get_last_element_child; +h$webkit_dom_element_get_last_element_child = (function(self, + self_2) + { + h$ret1 = 0; + return self["lastElementChild"]; + }); +var h$webkit_dom_element_get_previous_element_sibling; +h$webkit_dom_element_get_previous_element_sibling = (function(self, + self_2) + { + h$ret1 = 0; + return self["previousElementSibling"]; + }); +var h$webkit_dom_element_get_next_element_sibling; +h$webkit_dom_element_get_next_element_sibling = (function(self, + self_2) + { + h$ret1 = 0; + return self["nextElementSibling"]; + }); +var h$webkit_dom_element_get_child_element_count; +h$webkit_dom_element_get_child_element_count = (function(self, + self_2) + { + return self["childElementCount"]; + }); +var h$webkit_dom_element_get_webkit_region_overset; +h$webkit_dom_element_get_webkit_region_overset = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["webkitRegionOverset"]); + }); +var h$webkit_dom_element_set_onabort; +h$webkit_dom_element_set_onabort = (function(self, + self_2, val, val_2) + { + self["onabort"] = val; + }); +var h$webkit_dom_element_get_onabort; +h$webkit_dom_element_get_onabort = (function(self, + self_2) + { + h$ret1 = 0; + return self["onabort"]; + }); +var h$webkit_dom_element_set_onblur; +h$webkit_dom_element_set_onblur = (function(self, + self_2, val, val_2) + { + self["onblur"] = val; + }); +var h$webkit_dom_element_get_onblur; +h$webkit_dom_element_get_onblur = (function(self, + self_2) + { + h$ret1 = 0; + return self["onblur"]; + }); +var h$webkit_dom_element_set_onchange; +h$webkit_dom_element_set_onchange = (function(self, + self_2, val, val_2) + { + self["onchange"] = val; + }); +var h$webkit_dom_element_get_onchange; +h$webkit_dom_element_get_onchange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onchange"]; + }); +var h$webkit_dom_element_set_onclick; +h$webkit_dom_element_set_onclick = (function(self, + self_2, val, val_2) + { + self["onclick"] = val; + }); +var h$webkit_dom_element_get_onclick; +h$webkit_dom_element_get_onclick = (function(self, + self_2) + { + h$ret1 = 0; + return self["onclick"]; + }); +var h$webkit_dom_element_set_oncontextmenu; +h$webkit_dom_element_set_oncontextmenu = (function(self, + self_2, val, val_2) + { + self["oncontextmenu"] = val; + }); +var h$webkit_dom_element_get_oncontextmenu; +h$webkit_dom_element_get_oncontextmenu = (function(self, + self_2) + { + h$ret1 = 0; + return self["oncontextmenu"]; + }); +var h$webkit_dom_element_set_ondblclick; +h$webkit_dom_element_set_ondblclick = (function(self, + self_2, val, val_2) + { + self["ondblclick"] = val; + }); +var h$webkit_dom_element_get_ondblclick; +h$webkit_dom_element_get_ondblclick = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondblclick"]; + }); +var h$webkit_dom_element_set_ondrag; +h$webkit_dom_element_set_ondrag = (function(self, + self_2, val, val_2) + { + self["ondrag"] = val; + }); +var h$webkit_dom_element_get_ondrag; +h$webkit_dom_element_get_ondrag = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondrag"]; + }); +var h$webkit_dom_element_set_ondragend; +h$webkit_dom_element_set_ondragend = (function(self, + self_2, val, val_2) + { + self["ondragend"] = val; + }); +var h$webkit_dom_element_get_ondragend; +h$webkit_dom_element_get_ondragend = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondragend"]; + }); +var h$webkit_dom_element_set_ondragenter; +h$webkit_dom_element_set_ondragenter = (function(self, + self_2, val, val_2) + { + self["ondragenter"] = val; + }); +var h$webkit_dom_element_get_ondragenter; +h$webkit_dom_element_get_ondragenter = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondragenter"]; + }); +var h$webkit_dom_element_set_ondragleave; +h$webkit_dom_element_set_ondragleave = (function(self, + self_2, val, val_2) + { + self["ondragleave"] = val; + }); +var h$webkit_dom_element_get_ondragleave; +h$webkit_dom_element_get_ondragleave = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondragleave"]; + }); +var h$webkit_dom_element_set_ondragover; +h$webkit_dom_element_set_ondragover = (function(self, + self_2, val, val_2) + { + self["ondragover"] = val; + }); +var h$webkit_dom_element_get_ondragover; +h$webkit_dom_element_get_ondragover = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondragover"]; + }); +var h$webkit_dom_element_set_ondragstart; +h$webkit_dom_element_set_ondragstart = (function(self, + self_2, val, val_2) + { + self["ondragstart"] = val; + }); +var h$webkit_dom_element_get_ondragstart; +h$webkit_dom_element_get_ondragstart = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondragstart"]; + }); +var h$webkit_dom_element_set_ondrop; +h$webkit_dom_element_set_ondrop = (function(self, + self_2, val, val_2) + { + self["ondrop"] = val; + }); +var h$webkit_dom_element_get_ondrop; +h$webkit_dom_element_get_ondrop = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondrop"]; + }); +var h$webkit_dom_element_set_onerror; +h$webkit_dom_element_set_onerror = (function(self, + self_2, val, val_2) + { + self["onerror"] = val; + }); +var h$webkit_dom_element_get_onerror; +h$webkit_dom_element_get_onerror = (function(self, + self_2) + { + h$ret1 = 0; + return self["onerror"]; + }); +var h$webkit_dom_element_set_onfocus; +h$webkit_dom_element_set_onfocus = (function(self, + self_2, val, val_2) + { + self["onfocus"] = val; + }); +var h$webkit_dom_element_get_onfocus; +h$webkit_dom_element_get_onfocus = (function(self, + self_2) + { + h$ret1 = 0; + return self["onfocus"]; + }); +var h$webkit_dom_element_set_oninput; +h$webkit_dom_element_set_oninput = (function(self, + self_2, val, val_2) + { + self["oninput"] = val; + }); +var h$webkit_dom_element_get_oninput; +h$webkit_dom_element_get_oninput = (function(self, + self_2) + { + h$ret1 = 0; + return self["oninput"]; + }); +var h$webkit_dom_element_set_oninvalid; +h$webkit_dom_element_set_oninvalid = (function(self, + self_2, val, val_2) + { + self["oninvalid"] = val; + }); +var h$webkit_dom_element_get_oninvalid; +h$webkit_dom_element_get_oninvalid = (function(self, + self_2) + { + h$ret1 = 0; + return self["oninvalid"]; + }); +var h$webkit_dom_element_set_onkeydown; +h$webkit_dom_element_set_onkeydown = (function(self, + self_2, val, val_2) + { + self["onkeydown"] = val; + }); +var h$webkit_dom_element_get_onkeydown; +h$webkit_dom_element_get_onkeydown = (function(self, + self_2) + { + h$ret1 = 0; + return self["onkeydown"]; + }); +var h$webkit_dom_element_set_onkeypress; +h$webkit_dom_element_set_onkeypress = (function(self, + self_2, val, val_2) + { + self["onkeypress"] = val; + }); +var h$webkit_dom_element_get_onkeypress; +h$webkit_dom_element_get_onkeypress = (function(self, + self_2) + { + h$ret1 = 0; + return self["onkeypress"]; + }); +var h$webkit_dom_element_set_onkeyup; +h$webkit_dom_element_set_onkeyup = (function(self, + self_2, val, val_2) + { + self["onkeyup"] = val; + }); +var h$webkit_dom_element_get_onkeyup; +h$webkit_dom_element_get_onkeyup = (function(self, + self_2) + { + h$ret1 = 0; + return self["onkeyup"]; + }); +var h$webkit_dom_element_set_onload; +h$webkit_dom_element_set_onload = (function(self, + self_2, val, val_2) + { + self["onload"] = val; + }); +var h$webkit_dom_element_get_onload; +h$webkit_dom_element_get_onload = (function(self, + self_2) + { + h$ret1 = 0; + return self["onload"]; + }); +var h$webkit_dom_element_set_onmousedown; +h$webkit_dom_element_set_onmousedown = (function(self, + self_2, val, val_2) + { + self["onmousedown"] = val; + }); +var h$webkit_dom_element_get_onmousedown; +h$webkit_dom_element_get_onmousedown = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmousedown"]; + }); +var h$webkit_dom_element_set_onmousemove; +h$webkit_dom_element_set_onmousemove = (function(self, + self_2, val, val_2) + { + self["onmousemove"] = val; + }); +var h$webkit_dom_element_get_onmousemove; +h$webkit_dom_element_get_onmousemove = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmousemove"]; + }); +var h$webkit_dom_element_set_onmouseout; +h$webkit_dom_element_set_onmouseout = (function(self, + self_2, val, val_2) + { + self["onmouseout"] = val; + }); +var h$webkit_dom_element_get_onmouseout; +h$webkit_dom_element_get_onmouseout = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmouseout"]; + }); +var h$webkit_dom_element_set_onmouseover; +h$webkit_dom_element_set_onmouseover = (function(self, + self_2, val, val_2) + { + self["onmouseover"] = val; + }); +var h$webkit_dom_element_get_onmouseover; +h$webkit_dom_element_get_onmouseover = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmouseover"]; + }); +var h$webkit_dom_element_set_onmouseup; +h$webkit_dom_element_set_onmouseup = (function(self, + self_2, val, val_2) + { + self["onmouseup"] = val; + }); +var h$webkit_dom_element_get_onmouseup; +h$webkit_dom_element_get_onmouseup = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmouseup"]; + }); +var h$webkit_dom_element_set_onmousewheel; +h$webkit_dom_element_set_onmousewheel = (function(self, + self_2, val, val_2) + { + self["onmousewheel"] = val; + }); +var h$webkit_dom_element_get_onmousewheel; +h$webkit_dom_element_get_onmousewheel = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmousewheel"]; + }); +var h$webkit_dom_element_set_onscroll; +h$webkit_dom_element_set_onscroll = (function(self, + self_2, val, val_2) + { + self["onscroll"] = val; + }); +var h$webkit_dom_element_get_onscroll; +h$webkit_dom_element_get_onscroll = (function(self, + self_2) + { + h$ret1 = 0; + return self["onscroll"]; + }); +var h$webkit_dom_element_set_onselect; +h$webkit_dom_element_set_onselect = (function(self, + self_2, val, val_2) + { + self["onselect"] = val; + }); +var h$webkit_dom_element_get_onselect; +h$webkit_dom_element_get_onselect = (function(self, + self_2) + { + h$ret1 = 0; + return self["onselect"]; + }); +var h$webkit_dom_element_set_onsubmit; +h$webkit_dom_element_set_onsubmit = (function(self, + self_2, val, val_2) + { + self["onsubmit"] = val; + }); +var h$webkit_dom_element_get_onsubmit; +h$webkit_dom_element_get_onsubmit = (function(self, + self_2) + { + h$ret1 = 0; + return self["onsubmit"]; + }); +var h$webkit_dom_element_set_onbeforecut; +h$webkit_dom_element_set_onbeforecut = (function(self, + self_2, val, val_2) + { + self["onbeforecut"] = val; + }); +var h$webkit_dom_element_get_onbeforecut; +h$webkit_dom_element_get_onbeforecut = (function(self, + self_2) + { + h$ret1 = 0; + return self["onbeforecut"]; + }); +var h$webkit_dom_element_set_oncut; +h$webkit_dom_element_set_oncut = (function(self, + self_2, val, val_2) + { + self["oncut"] = val; + }); +var h$webkit_dom_element_get_oncut; +h$webkit_dom_element_get_oncut = (function(self, + self_2) + { + h$ret1 = 0; + return self["oncut"]; + }); +var h$webkit_dom_element_set_onbeforecopy; +h$webkit_dom_element_set_onbeforecopy = (function(self, + self_2, val, val_2) + { + self["onbeforecopy"] = val; + }); +var h$webkit_dom_element_get_onbeforecopy; +h$webkit_dom_element_get_onbeforecopy = (function(self, + self_2) + { + h$ret1 = 0; + return self["onbeforecopy"]; + }); +var h$webkit_dom_element_set_oncopy; +h$webkit_dom_element_set_oncopy = (function(self, + self_2, val, val_2) + { + self["oncopy"] = val; + }); +var h$webkit_dom_element_get_oncopy; +h$webkit_dom_element_get_oncopy = (function(self, + self_2) + { + h$ret1 = 0; + return self["oncopy"]; + }); +var h$webkit_dom_element_set_onbeforepaste; +h$webkit_dom_element_set_onbeforepaste = (function(self, + self_2, val, val_2) + { + self["onbeforepaste"] = val; + }); +var h$webkit_dom_element_get_onbeforepaste; +h$webkit_dom_element_get_onbeforepaste = (function(self, + self_2) + { + h$ret1 = 0; + return self["onbeforepaste"]; + }); +var h$webkit_dom_element_set_onpaste; +h$webkit_dom_element_set_onpaste = (function(self, + self_2, val, val_2) + { + self["onpaste"] = val; + }); +var h$webkit_dom_element_get_onpaste; +h$webkit_dom_element_get_onpaste = (function(self, + self_2) + { + h$ret1 = 0; + return self["onpaste"]; + }); +var h$webkit_dom_element_set_onreset; +h$webkit_dom_element_set_onreset = (function(self, + self_2, val, val_2) + { + self["onreset"] = val; + }); +var h$webkit_dom_element_get_onreset; +h$webkit_dom_element_get_onreset = (function(self, + self_2) + { + h$ret1 = 0; + return self["onreset"]; + }); +var h$webkit_dom_element_set_onsearch; +h$webkit_dom_element_set_onsearch = (function(self, + self_2, val, val_2) + { + self["onsearch"] = val; + }); +var h$webkit_dom_element_get_onsearch; +h$webkit_dom_element_get_onsearch = (function(self, + self_2) + { + h$ret1 = 0; + return self["onsearch"]; + }); +var h$webkit_dom_element_set_onselectstart; +h$webkit_dom_element_set_onselectstart = (function(self, + self_2, val, val_2) + { + self["onselectstart"] = val; + }); +var h$webkit_dom_element_get_onselectstart; +h$webkit_dom_element_get_onselectstart = (function(self, + self_2) + { + h$ret1 = 0; + return self["onselectstart"]; + }); +var h$webkit_dom_element_set_ontouchstart; +h$webkit_dom_element_set_ontouchstart = (function(self, + self_2, val, val_2) + { + self["ontouchstart"] = val; + }); +var h$webkit_dom_element_get_ontouchstart; +h$webkit_dom_element_get_ontouchstart = (function(self, + self_2) + { + h$ret1 = 0; + return self["ontouchstart"]; + }); +var h$webkit_dom_element_set_ontouchmove; +h$webkit_dom_element_set_ontouchmove = (function(self, + self_2, val, val_2) + { + self["ontouchmove"] = val; + }); +var h$webkit_dom_element_get_ontouchmove; +h$webkit_dom_element_get_ontouchmove = (function(self, + self_2) + { + h$ret1 = 0; + return self["ontouchmove"]; + }); +var h$webkit_dom_element_set_ontouchend; +h$webkit_dom_element_set_ontouchend = (function(self, + self_2, val, val_2) + { + self["ontouchend"] = val; + }); +var h$webkit_dom_element_get_ontouchend; +h$webkit_dom_element_get_ontouchend = (function(self, + self_2) + { + h$ret1 = 0; + return self["ontouchend"]; + }); +var h$webkit_dom_element_set_ontouchcancel; +h$webkit_dom_element_set_ontouchcancel = (function(self, + self_2, val, val_2) + { + self["ontouchcancel"] = val; + }); +var h$webkit_dom_element_get_ontouchcancel; +h$webkit_dom_element_get_ontouchcancel = (function(self, + self_2) + { + h$ret1 = 0; + return self["ontouchcancel"]; + }); +var h$webkit_dom_element_set_onwebkitfullscreenchange; +h$webkit_dom_element_set_onwebkitfullscreenchange = (function(self, + self_2, val, val_2) + { + self["onwebkitfullscreenchange"] = val; + }); +var h$webkit_dom_element_get_onwebkitfullscreenchange; +h$webkit_dom_element_get_onwebkitfullscreenchange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onwebkitfullscreenchange"]; + }); +var h$webkit_dom_element_set_onwebkitfullscreenerror; +h$webkit_dom_element_set_onwebkitfullscreenerror = (function(self, + self_2, val, val_2) + { + self["onwebkitfullscreenerror"] = val; + }); +var h$webkit_dom_element_get_onwebkitfullscreenerror; +h$webkit_dom_element_get_onwebkitfullscreenerror = (function(self, + self_2) + { + h$ret1 = 0; + return self["onwebkitfullscreenerror"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Window +h$webkit_dom_dom_window_get_type = (function() + { + return h$g_get_type(Window); + }); +var h$webkit_dom_dom_window_get_selection; +h$webkit_dom_dom_window_get_selection = (function(self, + self_2) + { + h$ret1 = 0; + return self["getSelection"](); + }); +var h$webkit_dom_dom_window_blur; +h$webkit_dom_dom_window_blur = (function(self, + self_2) + { + return self["blur"](); + }); +var h$webkit_dom_dom_window_print; +h$webkit_dom_dom_window_print = (function(self, + self_2) + { + return self["print"](); + }); +var h$webkit_dom_dom_window_stop; +h$webkit_dom_dom_window_stop = (function(self, + self_2) + { + return self["stop"](); + }); +var h$webkit_dom_dom_window_alert; +h$webkit_dom_dom_window_alert = (function(self, + self_2, message, message_2) + { + return self["alert"](h$decodeUtf8z(message, + message_2)); + }); +var h$webkit_dom_dom_window_confirm; +h$webkit_dom_dom_window_confirm = (function(self, + self_2, message, message_2) + { + return self["confirm"](h$decodeUtf8z(message, + message_2)); + }); +var h$webkit_dom_dom_window_prompt; +h$webkit_dom_dom_window_prompt = (function(self, + self_2, message, message_2, + defaultValue, defaultValue_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["prompt"](h$decodeUtf8z(message, + message_2), + h$decodeUtf8z(defaultValue, + defaultValue_2))); + }); +var h$webkit_dom_dom_window_find; +h$webkit_dom_dom_window_find = (function(self, + self_2, string, string_2, + caseSensitive, backwards, wrap, + wholeWord, searchInFrames, + showDialog) + { + return self["find"](h$decodeUtf8z(string, + string_2), caseSensitive, + backwards, wrap, wholeWord, + searchInFrames, showDialog); + }); +var h$webkit_dom_dom_window_scroll_by; +h$webkit_dom_dom_window_scroll_by = (function(self, + self_2, x, y) + { + return self["scrollBy"](x, y); + }); +var h$webkit_dom_dom_window_scroll_to; +h$webkit_dom_dom_window_scroll_to = (function(self, + self_2, x, y) + { + return self["scrollTo"](x, y); + }); +var h$webkit_dom_dom_window_scroll; +h$webkit_dom_dom_window_scroll = (function(self, + self_2, x, y) + { + return self["scroll"](x, y); + }); +var h$webkit_dom_dom_window_move_by; +h$webkit_dom_dom_window_move_by = (function(self, + self_2, x, y) + { + return self["moveBy"](x, y); + }); +var h$webkit_dom_dom_window_move_to; +h$webkit_dom_dom_window_move_to = (function(self, + self_2, x, y) + { + return self["moveTo"](x, y); + }); +var h$webkit_dom_dom_window_resize_by; +h$webkit_dom_dom_window_resize_by = (function(self, + self_2, x, y) + { + return self["resizeBy"](x, y); + }); +var h$webkit_dom_dom_window_resize_to; +h$webkit_dom_dom_window_resize_to = (function(self, + self_2, width, height) + { + return self["resizeTo"](width, + height); + }); +var h$webkit_dom_dom_window_match_media; +h$webkit_dom_dom_window_match_media = (function(self, + self_2, query, query_2) + { + h$ret1 = 0; + return self["matchMedia"](h$decodeUtf8z(query, + query_2)); + }); +var h$webkit_dom_dom_window_get_computed_style; +h$webkit_dom_dom_window_get_computed_style = (function(self, + self_2, element, element_2, + pseudoElement, pseudoElement_2) + { + h$ret1 = 0; + return self["getComputedStyle"](element, + h$decodeUtf8z(pseudoElement, + pseudoElement_2)); + }); +var h$webkit_dom_dom_window_webkit_convert_point_from_page_to_node; +h$webkit_dom_dom_window_webkit_convert_point_from_page_to_node = (function(self, + self_2, node, + node_2, p, + p_2) + { + h$ret1 = 0; + return self["webkitConvertPointFromPageToNode"](node, + p); + }); +var h$webkit_dom_dom_window_webkit_convert_point_from_node_to_page; +h$webkit_dom_dom_window_webkit_convert_point_from_node_to_page = (function(self, + self_2, node, + node_2, p, + p_2) + { + h$ret1 = 0; + return self["webkitConvertPointFromNodeToPage"](node, + p); + }); +var h$webkit_dom_dom_window_clear_timeout; +h$webkit_dom_dom_window_clear_timeout = (function(self, + self_2, handle) + { + return self["clearTimeout"](handle); + }); +var h$webkit_dom_dom_window_clear_interval; +h$webkit_dom_dom_window_clear_interval = (function(self, + self_2, handle) + { + return self["clearInterval"](handle); + }); +var h$webkit_dom_dom_window_atob; +h$webkit_dom_dom_window_atob = (function(self, + self_2, string, string_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["atob"](h$decodeUtf8z(string, + string_2))); + }); +var h$webkit_dom_dom_window_btoa; +h$webkit_dom_dom_window_btoa = (function(self, + self_2, string, string_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["btoa"](h$decodeUtf8z(string, + string_2))); + }); +var h$webkit_dom_dom_window_dispatch_event; +h$webkit_dom_dom_window_dispatch_event = (function(self, + self_2, evt, evt_2) + { + return self["dispatchEvent"](evt); + }); +var h$webkit_dom_dom_window_capture_events; +h$webkit_dom_dom_window_capture_events = (function(self, + self_2) + { + return self["captureEvents"](); + }); +var h$webkit_dom_dom_window_release_events; +h$webkit_dom_dom_window_release_events = (function(self, + self_2) + { + return self["releaseEvents"](); + }); +var h$webkit_dom_dom_window_get_screen; +h$webkit_dom_dom_window_get_screen = (function(self, + self_2) + { + h$ret1 = 0; + return self["screen"]; + }); +var h$webkit_dom_dom_window_get_history; +h$webkit_dom_dom_window_get_history = (function(self, + self_2) + { + h$ret1 = 0; + return self["history"]; + }); +var h$webkit_dom_dom_window_get_locationbar; +h$webkit_dom_dom_window_get_locationbar = (function(self, + self_2) + { + h$ret1 = 0; + return self["locationbar"]; + }); +var h$webkit_dom_dom_window_get_menubar; +h$webkit_dom_dom_window_get_menubar = (function(self, + self_2) + { + h$ret1 = 0; + return self["menubar"]; + }); +var h$webkit_dom_dom_window_get_personalbar; +h$webkit_dom_dom_window_get_personalbar = (function(self, + self_2) + { + h$ret1 = 0; + return self["personalbar"]; + }); +var h$webkit_dom_dom_window_get_scrollbars; +h$webkit_dom_dom_window_get_scrollbars = (function(self, + self_2) + { + h$ret1 = 0; + return self["scrollbars"]; + }); +var h$webkit_dom_dom_window_get_statusbar; +h$webkit_dom_dom_window_get_statusbar = (function(self, + self_2) + { + h$ret1 = 0; + return self["statusbar"]; + }); +var h$webkit_dom_dom_window_get_toolbar; +h$webkit_dom_dom_window_get_toolbar = (function(self, + self_2) + { + h$ret1 = 0; + return self["toolbar"]; + }); +var h$webkit_dom_dom_window_get_navigator; +h$webkit_dom_dom_window_get_navigator = (function(self, + self_2) + { + h$ret1 = 0; + return self["navigator"]; + }); +var h$webkit_dom_dom_window_get_client_information; +h$webkit_dom_dom_window_get_client_information = (function(self, + self_2) + { + h$ret1 = 0; + return self["clientInformation"]; + }); +var h$webkit_dom_dom_window_get_frame_element; +h$webkit_dom_dom_window_get_frame_element = (function(self, + self_2) + { + h$ret1 = 0; + return self["frameElement"]; + }); +var h$webkit_dom_dom_window_get_offscreen_buffering; +h$webkit_dom_dom_window_get_offscreen_buffering = (function(self, + self_2) + { + return self["offscreenBuffering"]; + }); +var h$webkit_dom_dom_window_get_outer_height; +h$webkit_dom_dom_window_get_outer_height = (function(self, + self_2) + { + return self["outerHeight"]; + }); +var h$webkit_dom_dom_window_get_outer_width; +h$webkit_dom_dom_window_get_outer_width = (function(self, + self_2) + { + return self["outerWidth"]; + }); +var h$webkit_dom_dom_window_get_inner_height; +h$webkit_dom_dom_window_get_inner_height = (function(self, + self_2) + { + return self["innerHeight"]; + }); +var h$webkit_dom_dom_window_get_inner_width; +h$webkit_dom_dom_window_get_inner_width = (function(self, + self_2) + { + return self["innerWidth"]; + }); +var h$webkit_dom_dom_window_get_screen_x; +h$webkit_dom_dom_window_get_screen_x = (function(self, + self_2) + { + return self["screenX"]; + }); +var h$webkit_dom_dom_window_get_screen_y; +h$webkit_dom_dom_window_get_screen_y = (function(self, + self_2) + { + return self["screenY"]; + }); +var h$webkit_dom_dom_window_get_screen_left; +h$webkit_dom_dom_window_get_screen_left = (function(self, + self_2) + { + return self["screenLeft"]; + }); +var h$webkit_dom_dom_window_get_screen_top; +h$webkit_dom_dom_window_get_screen_top = (function(self, + self_2) + { + return self["screenTop"]; + }); +var h$webkit_dom_dom_window_get_scroll_x; +h$webkit_dom_dom_window_get_scroll_x = (function(self, + self_2) + { + return self["scrollX"]; + }); +var h$webkit_dom_dom_window_get_scroll_y; +h$webkit_dom_dom_window_get_scroll_y = (function(self, + self_2) + { + return self["scrollY"]; + }); +var h$webkit_dom_dom_window_get_page_x_offset; +h$webkit_dom_dom_window_get_page_x_offset = (function(self, + self_2) + { + return self["pageXOffset"]; + }); +var h$webkit_dom_dom_window_get_page_y_offset; +h$webkit_dom_dom_window_get_page_y_offset = (function(self, + self_2) + { + return self["pageYOffset"]; + }); +var h$webkit_dom_dom_window_get_closed; +h$webkit_dom_dom_window_get_closed = (function(self, + self_2) + { + return self["closed"]; + }); +var h$webkit_dom_dom_window_get_length; +h$webkit_dom_dom_window_get_length = (function(self, + self_2) + { + return self["length"]; + }); +var h$webkit_dom_dom_window_set_name; +h$webkit_dom_dom_window_set_name = (function(self, + self_2, val, val_2) + { + self["name"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_dom_window_get_name; +h$webkit_dom_dom_window_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_dom_window_set_status; +h$webkit_dom_dom_window_set_status = (function(self, + self_2, val, val_2) + { + self["status"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_dom_window_get_status; +h$webkit_dom_dom_window_get_status = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["status"]); + }); +var h$webkit_dom_dom_window_set_default_status; +h$webkit_dom_dom_window_set_default_status = (function(self, + self_2, val, val_2) + { + self["defaultStatus"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_dom_window_get_default_status; +h$webkit_dom_dom_window_get_default_status = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["defaultStatus"]); + }); +var h$webkit_dom_dom_window_get_self; +h$webkit_dom_dom_window_get_self = (function(self, + self_2) + { + h$ret1 = 0; + return self["self"]; + }); +var h$webkit_dom_dom_window_get_window; +h$webkit_dom_dom_window_get_window = (function(self, + self_2) + { + h$ret1 = 0; + return self["window"]; + }); +var h$webkit_dom_dom_window_get_frames; +h$webkit_dom_dom_window_get_frames = (function(self, + self_2) + { + h$ret1 = 0; + return self["frames"]; + }); +var h$webkit_dom_dom_window_get_opener; +h$webkit_dom_dom_window_get_opener = (function(self, + self_2) + { + h$ret1 = 0; + return self["opener"]; + }); +var h$webkit_dom_dom_window_get_parent; +h$webkit_dom_dom_window_get_parent = (function(self, + self_2) + { + h$ret1 = 0; + return self["parent"]; + }); +var h$webkit_dom_dom_window_get_top; +h$webkit_dom_dom_window_get_top = (function(self, + self_2) + { + h$ret1 = 0; + return self["top"]; + }); +var h$webkit_dom_dom_window_get_document; +h$webkit_dom_dom_window_get_document = (function(self, + self_2) + { + h$ret1 = 0; + return self["document"]; + }); +var h$webkit_dom_dom_window_get_style_media; +h$webkit_dom_dom_window_get_style_media = (function(self, + self_2) + { + h$ret1 = 0; + return self["styleMedia"]; + }); +var h$webkit_dom_dom_window_get_device_pixel_ratio; +h$webkit_dom_dom_window_get_device_pixel_ratio = (function(self, + self_2) + { + return self["devicePixelRatio"]; + }); +var h$webkit_dom_dom_window_get_application_cache; +h$webkit_dom_dom_window_get_application_cache = (function(self, + self_2) + { + h$ret1 = 0; + return self["applicationCache"]; + }); +var h$webkit_dom_dom_window_get_session_storage; +h$webkit_dom_dom_window_get_session_storage = (function(self, + self_2) + { + h$ret1 = 0; + return self["sessionStorage"]; + }); +var h$webkit_dom_dom_window_get_local_storage; +h$webkit_dom_dom_window_get_local_storage = (function(self, + self_2) + { + h$ret1 = 0; + return self["localStorage"]; + }); +var h$webkit_dom_dom_window_get_console; +h$webkit_dom_dom_window_get_console = (function(self, + self_2) + { + h$ret1 = 0; + return self["console"]; + }); +var h$webkit_dom_dom_window_set_onabort; +h$webkit_dom_dom_window_set_onabort = (function(self, + self_2, val, val_2) + { + self["onabort"] = val; + }); +var h$webkit_dom_dom_window_get_onabort; +h$webkit_dom_dom_window_get_onabort = (function(self, + self_2) + { + h$ret1 = 0; + return self["onabort"]; + }); +var h$webkit_dom_dom_window_set_onbeforeunload; +h$webkit_dom_dom_window_set_onbeforeunload = (function(self, + self_2, val, val_2) + { + self["onbeforeunload"] = val; + }); +var h$webkit_dom_dom_window_get_onbeforeunload; +h$webkit_dom_dom_window_get_onbeforeunload = (function(self, + self_2) + { + h$ret1 = 0; + return self["onbeforeunload"]; + }); +var h$webkit_dom_dom_window_set_onblur; +h$webkit_dom_dom_window_set_onblur = (function(self, + self_2, val, val_2) + { + self["onblur"] = val; + }); +var h$webkit_dom_dom_window_get_onblur; +h$webkit_dom_dom_window_get_onblur = (function(self, + self_2) + { + h$ret1 = 0; + return self["onblur"]; + }); +var h$webkit_dom_dom_window_set_oncanplay; +h$webkit_dom_dom_window_set_oncanplay = (function(self, + self_2, val, val_2) + { + self["oncanplay"] = val; + }); +var h$webkit_dom_dom_window_get_oncanplay; +h$webkit_dom_dom_window_get_oncanplay = (function(self, + self_2) + { + h$ret1 = 0; + return self["oncanplay"]; + }); +var h$webkit_dom_dom_window_set_oncanplaythrough; +h$webkit_dom_dom_window_set_oncanplaythrough = (function(self, + self_2, val, val_2) + { + self["oncanplaythrough"] = val; + }); +var h$webkit_dom_dom_window_get_oncanplaythrough; +h$webkit_dom_dom_window_get_oncanplaythrough = (function(self, + self_2) + { + h$ret1 = 0; + return self["oncanplaythrough"]; + }); +var h$webkit_dom_dom_window_set_onchange; +h$webkit_dom_dom_window_set_onchange = (function(self, + self_2, val, val_2) + { + self["onchange"] = val; + }); +var h$webkit_dom_dom_window_get_onchange; +h$webkit_dom_dom_window_get_onchange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onchange"]; + }); +var h$webkit_dom_dom_window_set_onclick; +h$webkit_dom_dom_window_set_onclick = (function(self, + self_2, val, val_2) + { + self["onclick"] = val; + }); +var h$webkit_dom_dom_window_get_onclick; +h$webkit_dom_dom_window_get_onclick = (function(self, + self_2) + { + h$ret1 = 0; + return self["onclick"]; + }); +var h$webkit_dom_dom_window_set_oncontextmenu; +h$webkit_dom_dom_window_set_oncontextmenu = (function(self, + self_2, val, val_2) + { + self["oncontextmenu"] = val; + }); +var h$webkit_dom_dom_window_get_oncontextmenu; +h$webkit_dom_dom_window_get_oncontextmenu = (function(self, + self_2) + { + h$ret1 = 0; + return self["oncontextmenu"]; + }); +var h$webkit_dom_dom_window_set_ondblclick; +h$webkit_dom_dom_window_set_ondblclick = (function(self, + self_2, val, val_2) + { + self["ondblclick"] = val; + }); +var h$webkit_dom_dom_window_get_ondblclick; +h$webkit_dom_dom_window_get_ondblclick = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondblclick"]; + }); +var h$webkit_dom_dom_window_set_ondrag; +h$webkit_dom_dom_window_set_ondrag = (function(self, + self_2, val, val_2) + { + self["ondrag"] = val; + }); +var h$webkit_dom_dom_window_get_ondrag; +h$webkit_dom_dom_window_get_ondrag = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondrag"]; + }); +var h$webkit_dom_dom_window_set_ondragend; +h$webkit_dom_dom_window_set_ondragend = (function(self, + self_2, val, val_2) + { + self["ondragend"] = val; + }); +var h$webkit_dom_dom_window_get_ondragend; +h$webkit_dom_dom_window_get_ondragend = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondragend"]; + }); +var h$webkit_dom_dom_window_set_ondragenter; +h$webkit_dom_dom_window_set_ondragenter = (function(self, + self_2, val, val_2) + { + self["ondragenter"] = val; + }); +var h$webkit_dom_dom_window_get_ondragenter; +h$webkit_dom_dom_window_get_ondragenter = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondragenter"]; + }); +var h$webkit_dom_dom_window_set_ondragleave; +h$webkit_dom_dom_window_set_ondragleave = (function(self, + self_2, val, val_2) + { + self["ondragleave"] = val; + }); +var h$webkit_dom_dom_window_get_ondragleave; +h$webkit_dom_dom_window_get_ondragleave = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondragleave"]; + }); +var h$webkit_dom_dom_window_set_ondragover; +h$webkit_dom_dom_window_set_ondragover = (function(self, + self_2, val, val_2) + { + self["ondragover"] = val; + }); +var h$webkit_dom_dom_window_get_ondragover; +h$webkit_dom_dom_window_get_ondragover = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondragover"]; + }); +var h$webkit_dom_dom_window_set_ondragstart; +h$webkit_dom_dom_window_set_ondragstart = (function(self, + self_2, val, val_2) + { + self["ondragstart"] = val; + }); +var h$webkit_dom_dom_window_get_ondragstart; +h$webkit_dom_dom_window_get_ondragstart = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondragstart"]; + }); +var h$webkit_dom_dom_window_set_ondrop; +h$webkit_dom_dom_window_set_ondrop = (function(self, + self_2, val, val_2) + { + self["ondrop"] = val; + }); +var h$webkit_dom_dom_window_get_ondrop; +h$webkit_dom_dom_window_get_ondrop = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondrop"]; + }); +var h$webkit_dom_dom_window_set_ondurationchange; +h$webkit_dom_dom_window_set_ondurationchange = (function(self, + self_2, val, val_2) + { + self["ondurationchange"] = val; + }); +var h$webkit_dom_dom_window_get_ondurationchange; +h$webkit_dom_dom_window_get_ondurationchange = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondurationchange"]; + }); +var h$webkit_dom_dom_window_set_onemptied; +h$webkit_dom_dom_window_set_onemptied = (function(self, + self_2, val, val_2) + { + self["onemptied"] = val; + }); +var h$webkit_dom_dom_window_get_onemptied; +h$webkit_dom_dom_window_get_onemptied = (function(self, + self_2) + { + h$ret1 = 0; + return self["onemptied"]; + }); +var h$webkit_dom_dom_window_set_onended; +h$webkit_dom_dom_window_set_onended = (function(self, + self_2, val, val_2) + { + self["onended"] = val; + }); +var h$webkit_dom_dom_window_get_onended; +h$webkit_dom_dom_window_get_onended = (function(self, + self_2) + { + h$ret1 = 0; + return self["onended"]; + }); +var h$webkit_dom_dom_window_set_onerror; +h$webkit_dom_dom_window_set_onerror = (function(self, + self_2, val, val_2) + { + self["onerror"] = val; + }); +var h$webkit_dom_dom_window_get_onerror; +h$webkit_dom_dom_window_get_onerror = (function(self, + self_2) + { + h$ret1 = 0; + return self["onerror"]; + }); +var h$webkit_dom_dom_window_set_onfocus; +h$webkit_dom_dom_window_set_onfocus = (function(self, + self_2, val, val_2) + { + self["onfocus"] = val; + }); +var h$webkit_dom_dom_window_get_onfocus; +h$webkit_dom_dom_window_get_onfocus = (function(self, + self_2) + { + h$ret1 = 0; + return self["onfocus"]; + }); +var h$webkit_dom_dom_window_set_onhashchange; +h$webkit_dom_dom_window_set_onhashchange = (function(self, + self_2, val, val_2) + { + self["onhashchange"] = val; + }); +var h$webkit_dom_dom_window_get_onhashchange; +h$webkit_dom_dom_window_get_onhashchange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onhashchange"]; + }); +var h$webkit_dom_dom_window_set_oninput; +h$webkit_dom_dom_window_set_oninput = (function(self, + self_2, val, val_2) + { + self["oninput"] = val; + }); +var h$webkit_dom_dom_window_get_oninput; +h$webkit_dom_dom_window_get_oninput = (function(self, + self_2) + { + h$ret1 = 0; + return self["oninput"]; + }); +var h$webkit_dom_dom_window_set_oninvalid; +h$webkit_dom_dom_window_set_oninvalid = (function(self, + self_2, val, val_2) + { + self["oninvalid"] = val; + }); +var h$webkit_dom_dom_window_get_oninvalid; +h$webkit_dom_dom_window_get_oninvalid = (function(self, + self_2) + { + h$ret1 = 0; + return self["oninvalid"]; + }); +var h$webkit_dom_dom_window_set_onkeydown; +h$webkit_dom_dom_window_set_onkeydown = (function(self, + self_2, val, val_2) + { + self["onkeydown"] = val; + }); +var h$webkit_dom_dom_window_get_onkeydown; +h$webkit_dom_dom_window_get_onkeydown = (function(self, + self_2) + { + h$ret1 = 0; + return self["onkeydown"]; + }); +var h$webkit_dom_dom_window_set_onkeypress; +h$webkit_dom_dom_window_set_onkeypress = (function(self, + self_2, val, val_2) + { + self["onkeypress"] = val; + }); +var h$webkit_dom_dom_window_get_onkeypress; +h$webkit_dom_dom_window_get_onkeypress = (function(self, + self_2) + { + h$ret1 = 0; + return self["onkeypress"]; + }); +var h$webkit_dom_dom_window_set_onkeyup; +h$webkit_dom_dom_window_set_onkeyup = (function(self, + self_2, val, val_2) + { + self["onkeyup"] = val; + }); +var h$webkit_dom_dom_window_get_onkeyup; +h$webkit_dom_dom_window_get_onkeyup = (function(self, + self_2) + { + h$ret1 = 0; + return self["onkeyup"]; + }); +var h$webkit_dom_dom_window_set_onload; +h$webkit_dom_dom_window_set_onload = (function(self, + self_2, val, val_2) + { + self["onload"] = val; + }); +var h$webkit_dom_dom_window_get_onload; +h$webkit_dom_dom_window_get_onload = (function(self, + self_2) + { + h$ret1 = 0; + return self["onload"]; + }); +var h$webkit_dom_dom_window_set_onloadeddata; +h$webkit_dom_dom_window_set_onloadeddata = (function(self, + self_2, val, val_2) + { + self["onloadeddata"] = val; + }); +var h$webkit_dom_dom_window_get_onloadeddata; +h$webkit_dom_dom_window_get_onloadeddata = (function(self, + self_2) + { + h$ret1 = 0; + return self["onloadeddata"]; + }); +var h$webkit_dom_dom_window_set_onloadedmetadata; +h$webkit_dom_dom_window_set_onloadedmetadata = (function(self, + self_2, val, val_2) + { + self["onloadedmetadata"] = val; + }); +var h$webkit_dom_dom_window_get_onloadedmetadata; +h$webkit_dom_dom_window_get_onloadedmetadata = (function(self, + self_2) + { + h$ret1 = 0; + return self["onloadedmetadata"]; + }); +var h$webkit_dom_dom_window_set_onloadstart; +h$webkit_dom_dom_window_set_onloadstart = (function(self, + self_2, val, val_2) + { + self["onloadstart"] = val; + }); +var h$webkit_dom_dom_window_get_onloadstart; +h$webkit_dom_dom_window_get_onloadstart = (function(self, + self_2) + { + h$ret1 = 0; + return self["onloadstart"]; + }); +var h$webkit_dom_dom_window_set_onmessage; +h$webkit_dom_dom_window_set_onmessage = (function(self, + self_2, val, val_2) + { + self["onmessage"] = val; + }); +var h$webkit_dom_dom_window_get_onmessage; +h$webkit_dom_dom_window_get_onmessage = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmessage"]; + }); +var h$webkit_dom_dom_window_set_onmousedown; +h$webkit_dom_dom_window_set_onmousedown = (function(self, + self_2, val, val_2) + { + self["onmousedown"] = val; + }); +var h$webkit_dom_dom_window_get_onmousedown; +h$webkit_dom_dom_window_get_onmousedown = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmousedown"]; + }); +var h$webkit_dom_dom_window_set_onmousemove; +h$webkit_dom_dom_window_set_onmousemove = (function(self, + self_2, val, val_2) + { + self["onmousemove"] = val; + }); +var h$webkit_dom_dom_window_get_onmousemove; +h$webkit_dom_dom_window_get_onmousemove = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmousemove"]; + }); +var h$webkit_dom_dom_window_set_onmouseout; +h$webkit_dom_dom_window_set_onmouseout = (function(self, + self_2, val, val_2) + { + self["onmouseout"] = val; + }); +var h$webkit_dom_dom_window_get_onmouseout; +h$webkit_dom_dom_window_get_onmouseout = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmouseout"]; + }); +var h$webkit_dom_dom_window_set_onmouseover; +h$webkit_dom_dom_window_set_onmouseover = (function(self, + self_2, val, val_2) + { + self["onmouseover"] = val; + }); +var h$webkit_dom_dom_window_get_onmouseover; +h$webkit_dom_dom_window_get_onmouseover = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmouseover"]; + }); +var h$webkit_dom_dom_window_set_onmouseup; +h$webkit_dom_dom_window_set_onmouseup = (function(self, + self_2, val, val_2) + { + self["onmouseup"] = val; + }); +var h$webkit_dom_dom_window_get_onmouseup; +h$webkit_dom_dom_window_get_onmouseup = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmouseup"]; + }); +var h$webkit_dom_dom_window_set_onmousewheel; +h$webkit_dom_dom_window_set_onmousewheel = (function(self, + self_2, val, val_2) + { + self["onmousewheel"] = val; + }); +var h$webkit_dom_dom_window_get_onmousewheel; +h$webkit_dom_dom_window_get_onmousewheel = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmousewheel"]; + }); +var h$webkit_dom_dom_window_set_onoffline; +h$webkit_dom_dom_window_set_onoffline = (function(self, + self_2, val, val_2) + { + self["onoffline"] = val; + }); +var h$webkit_dom_dom_window_get_onoffline; +h$webkit_dom_dom_window_get_onoffline = (function(self, + self_2) + { + h$ret1 = 0; + return self["onoffline"]; + }); +var h$webkit_dom_dom_window_set_ononline; +h$webkit_dom_dom_window_set_ononline = (function(self, + self_2, val, val_2) + { + self["ononline"] = val; + }); +var h$webkit_dom_dom_window_get_ononline; +h$webkit_dom_dom_window_get_ononline = (function(self, + self_2) + { + h$ret1 = 0; + return self["ononline"]; + }); +var h$webkit_dom_dom_window_set_onpagehide; +h$webkit_dom_dom_window_set_onpagehide = (function(self, + self_2, val, val_2) + { + self["onpagehide"] = val; + }); +var h$webkit_dom_dom_window_get_onpagehide; +h$webkit_dom_dom_window_get_onpagehide = (function(self, + self_2) + { + h$ret1 = 0; + return self["onpagehide"]; + }); +var h$webkit_dom_dom_window_set_onpageshow; +h$webkit_dom_dom_window_set_onpageshow = (function(self, + self_2, val, val_2) + { + self["onpageshow"] = val; + }); +var h$webkit_dom_dom_window_get_onpageshow; +h$webkit_dom_dom_window_get_onpageshow = (function(self, + self_2) + { + h$ret1 = 0; + return self["onpageshow"]; + }); +var h$webkit_dom_dom_window_set_onpause; +h$webkit_dom_dom_window_set_onpause = (function(self, + self_2, val, val_2) + { + self["onpause"] = val; + }); +var h$webkit_dom_dom_window_get_onpause; +h$webkit_dom_dom_window_get_onpause = (function(self, + self_2) + { + h$ret1 = 0; + return self["onpause"]; + }); +var h$webkit_dom_dom_window_set_onplay; +h$webkit_dom_dom_window_set_onplay = (function(self, + self_2, val, val_2) + { + self["onplay"] = val; + }); +var h$webkit_dom_dom_window_get_onplay; +h$webkit_dom_dom_window_get_onplay = (function(self, + self_2) + { + h$ret1 = 0; + return self["onplay"]; + }); +var h$webkit_dom_dom_window_set_onplaying; +h$webkit_dom_dom_window_set_onplaying = (function(self, + self_2, val, val_2) + { + self["onplaying"] = val; + }); +var h$webkit_dom_dom_window_get_onplaying; +h$webkit_dom_dom_window_get_onplaying = (function(self, + self_2) + { + h$ret1 = 0; + return self["onplaying"]; + }); +var h$webkit_dom_dom_window_set_onpopstate; +h$webkit_dom_dom_window_set_onpopstate = (function(self, + self_2, val, val_2) + { + self["onpopstate"] = val; + }); +var h$webkit_dom_dom_window_get_onpopstate; +h$webkit_dom_dom_window_get_onpopstate = (function(self, + self_2) + { + h$ret1 = 0; + return self["onpopstate"]; + }); +var h$webkit_dom_dom_window_set_onprogress; +h$webkit_dom_dom_window_set_onprogress = (function(self, + self_2, val, val_2) + { + self["onprogress"] = val; + }); +var h$webkit_dom_dom_window_get_onprogress; +h$webkit_dom_dom_window_get_onprogress = (function(self, + self_2) + { + h$ret1 = 0; + return self["onprogress"]; + }); +var h$webkit_dom_dom_window_set_onratechange; +h$webkit_dom_dom_window_set_onratechange = (function(self, + self_2, val, val_2) + { + self["onratechange"] = val; + }); +var h$webkit_dom_dom_window_get_onratechange; +h$webkit_dom_dom_window_get_onratechange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onratechange"]; + }); +var h$webkit_dom_dom_window_set_onresize; +h$webkit_dom_dom_window_set_onresize = (function(self, + self_2, val, val_2) + { + self["onresize"] = val; + }); +var h$webkit_dom_dom_window_get_onresize; +h$webkit_dom_dom_window_get_onresize = (function(self, + self_2) + { + h$ret1 = 0; + return self["onresize"]; + }); +var h$webkit_dom_dom_window_set_onscroll; +h$webkit_dom_dom_window_set_onscroll = (function(self, + self_2, val, val_2) + { + self["onscroll"] = val; + }); +var h$webkit_dom_dom_window_get_onscroll; +h$webkit_dom_dom_window_get_onscroll = (function(self, + self_2) + { + h$ret1 = 0; + return self["onscroll"]; + }); +var h$webkit_dom_dom_window_set_onseeked; +h$webkit_dom_dom_window_set_onseeked = (function(self, + self_2, val, val_2) + { + self["onseeked"] = val; + }); +var h$webkit_dom_dom_window_get_onseeked; +h$webkit_dom_dom_window_get_onseeked = (function(self, + self_2) + { + h$ret1 = 0; + return self["onseeked"]; + }); +var h$webkit_dom_dom_window_set_onseeking; +h$webkit_dom_dom_window_set_onseeking = (function(self, + self_2, val, val_2) + { + self["onseeking"] = val; + }); +var h$webkit_dom_dom_window_get_onseeking; +h$webkit_dom_dom_window_get_onseeking = (function(self, + self_2) + { + h$ret1 = 0; + return self["onseeking"]; + }); +var h$webkit_dom_dom_window_set_onselect; +h$webkit_dom_dom_window_set_onselect = (function(self, + self_2, val, val_2) + { + self["onselect"] = val; + }); +var h$webkit_dom_dom_window_get_onselect; +h$webkit_dom_dom_window_get_onselect = (function(self, + self_2) + { + h$ret1 = 0; + return self["onselect"]; + }); +var h$webkit_dom_dom_window_set_onstalled; +h$webkit_dom_dom_window_set_onstalled = (function(self, + self_2, val, val_2) + { + self["onstalled"] = val; + }); +var h$webkit_dom_dom_window_get_onstalled; +h$webkit_dom_dom_window_get_onstalled = (function(self, + self_2) + { + h$ret1 = 0; + return self["onstalled"]; + }); +var h$webkit_dom_dom_window_set_onstorage; +h$webkit_dom_dom_window_set_onstorage = (function(self, + self_2, val, val_2) + { + self["onstorage"] = val; + }); +var h$webkit_dom_dom_window_get_onstorage; +h$webkit_dom_dom_window_get_onstorage = (function(self, + self_2) + { + h$ret1 = 0; + return self["onstorage"]; + }); +var h$webkit_dom_dom_window_set_onsubmit; +h$webkit_dom_dom_window_set_onsubmit = (function(self, + self_2, val, val_2) + { + self["onsubmit"] = val; + }); +var h$webkit_dom_dom_window_get_onsubmit; +h$webkit_dom_dom_window_get_onsubmit = (function(self, + self_2) + { + h$ret1 = 0; + return self["onsubmit"]; + }); +var h$webkit_dom_dom_window_set_onsuspend; +h$webkit_dom_dom_window_set_onsuspend = (function(self, + self_2, val, val_2) + { + self["onsuspend"] = val; + }); +var h$webkit_dom_dom_window_get_onsuspend; +h$webkit_dom_dom_window_get_onsuspend = (function(self, + self_2) + { + h$ret1 = 0; + return self["onsuspend"]; + }); +var h$webkit_dom_dom_window_set_ontimeupdate; +h$webkit_dom_dom_window_set_ontimeupdate = (function(self, + self_2, val, val_2) + { + self["ontimeupdate"] = val; + }); +var h$webkit_dom_dom_window_get_ontimeupdate; +h$webkit_dom_dom_window_get_ontimeupdate = (function(self, + self_2) + { + h$ret1 = 0; + return self["ontimeupdate"]; + }); +var h$webkit_dom_dom_window_set_onunload; +h$webkit_dom_dom_window_set_onunload = (function(self, + self_2, val, val_2) + { + self["onunload"] = val; + }); +var h$webkit_dom_dom_window_get_onunload; +h$webkit_dom_dom_window_get_onunload = (function(self, + self_2) + { + h$ret1 = 0; + return self["onunload"]; + }); +var h$webkit_dom_dom_window_set_onvolumechange; +h$webkit_dom_dom_window_set_onvolumechange = (function(self, + self_2, val, val_2) + { + self["onvolumechange"] = val; + }); +var h$webkit_dom_dom_window_get_onvolumechange; +h$webkit_dom_dom_window_get_onvolumechange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onvolumechange"]; + }); +var h$webkit_dom_dom_window_set_onwaiting; +h$webkit_dom_dom_window_set_onwaiting = (function(self, + self_2, val, val_2) + { + self["onwaiting"] = val; + }); +var h$webkit_dom_dom_window_get_onwaiting; +h$webkit_dom_dom_window_get_onwaiting = (function(self, + self_2) + { + h$ret1 = 0; + return self["onwaiting"]; + }); +var h$webkit_dom_dom_window_set_onreset; +h$webkit_dom_dom_window_set_onreset = (function(self, + self_2, val, val_2) + { + self["onreset"] = val; + }); +var h$webkit_dom_dom_window_get_onreset; +h$webkit_dom_dom_window_get_onreset = (function(self, + self_2) + { + h$ret1 = 0; + return self["onreset"]; + }); +var h$webkit_dom_dom_window_set_onsearch; +h$webkit_dom_dom_window_set_onsearch = (function(self, + self_2, val, val_2) + { + self["onsearch"] = val; + }); +var h$webkit_dom_dom_window_get_onsearch; +h$webkit_dom_dom_window_get_onsearch = (function(self, + self_2) + { + h$ret1 = 0; + return self["onsearch"]; + }); +var h$webkit_dom_dom_window_set_onwebkitanimationend; +h$webkit_dom_dom_window_set_onwebkitanimationend = (function(self, + self_2, val, val_2) + { + self["onwebkitanimationend"] = val; + }); +var h$webkit_dom_dom_window_get_onwebkitanimationend; +h$webkit_dom_dom_window_get_onwebkitanimationend = (function(self, + self_2) + { + h$ret1 = 0; + return self["onwebkitanimationend"]; + }); +var h$webkit_dom_dom_window_set_onwebkitanimationiteration; +h$webkit_dom_dom_window_set_onwebkitanimationiteration = (function(self, + self_2, val, val_2) + { + self["onwebkitanimationiteration"] = val; + }); +var h$webkit_dom_dom_window_get_onwebkitanimationiteration; +h$webkit_dom_dom_window_get_onwebkitanimationiteration = (function(self, + self_2) + { + h$ret1 = 0; + return self["onwebkitanimationiteration"]; + }); +var h$webkit_dom_dom_window_set_onwebkitanimationstart; +h$webkit_dom_dom_window_set_onwebkitanimationstart = (function(self, + self_2, val, val_2) + { + self["onwebkitanimationstart"] = val; + }); +var h$webkit_dom_dom_window_get_onwebkitanimationstart; +h$webkit_dom_dom_window_get_onwebkitanimationstart = (function(self, + self_2) + { + h$ret1 = 0; + return self["onwebkitanimationstart"]; + }); +var h$webkit_dom_dom_window_set_onwebkittransitionend; +h$webkit_dom_dom_window_set_onwebkittransitionend = (function(self, + self_2, val, val_2) + { + self["onwebkittransitionend"] = val; + }); +var h$webkit_dom_dom_window_get_onwebkittransitionend; +h$webkit_dom_dom_window_get_onwebkittransitionend = (function(self, + self_2) + { + h$ret1 = 0; + return self["onwebkittransitionend"]; + }); +var h$webkit_dom_dom_window_set_ontouchstart; +h$webkit_dom_dom_window_set_ontouchstart = (function(self, + self_2, val, val_2) + { + self["ontouchstart"] = val; + }); +var h$webkit_dom_dom_window_get_ontouchstart; +h$webkit_dom_dom_window_get_ontouchstart = (function(self, + self_2) + { + h$ret1 = 0; + return self["ontouchstart"]; + }); +var h$webkit_dom_dom_window_set_ontouchmove; +h$webkit_dom_dom_window_set_ontouchmove = (function(self, + self_2, val, val_2) + { + self["ontouchmove"] = val; + }); +var h$webkit_dom_dom_window_get_ontouchmove; +h$webkit_dom_dom_window_get_ontouchmove = (function(self, + self_2) + { + h$ret1 = 0; + return self["ontouchmove"]; + }); +var h$webkit_dom_dom_window_set_ontouchend; +h$webkit_dom_dom_window_set_ontouchend = (function(self, + self_2, val, val_2) + { + self["ontouchend"] = val; + }); +var h$webkit_dom_dom_window_get_ontouchend; +h$webkit_dom_dom_window_get_ontouchend = (function(self, + self_2) + { + h$ret1 = 0; + return self["ontouchend"]; + }); +var h$webkit_dom_dom_window_set_ontouchcancel; +h$webkit_dom_dom_window_set_ontouchcancel = (function(self, + self_2, val, val_2) + { + self["ontouchcancel"] = val; + }); +var h$webkit_dom_dom_window_get_ontouchcancel; +h$webkit_dom_dom_window_get_ontouchcancel = (function(self, + self_2) + { + h$ret1 = 0; + return self["ontouchcancel"]; + }); +var h$webkit_dom_dom_window_set_ondevicemotion; +h$webkit_dom_dom_window_set_ondevicemotion = (function(self, + self_2, val, val_2) + { + self["ondevicemotion"] = val; + }); +var h$webkit_dom_dom_window_get_ondevicemotion; +h$webkit_dom_dom_window_get_ondevicemotion = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondevicemotion"]; + }); +var h$webkit_dom_dom_window_set_ondeviceorientation; +h$webkit_dom_dom_window_set_ondeviceorientation = (function(self, + self_2, val, val_2) + { + self["ondeviceorientation"] = val; + }); +var h$webkit_dom_dom_window_get_ondeviceorientation; +h$webkit_dom_dom_window_get_ondeviceorientation = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondeviceorientation"]; + }); +var h$webkit_dom_dom_window_set_onwebkitdeviceproximity; +h$webkit_dom_dom_window_set_onwebkitdeviceproximity = (function(self, + self_2, val, val_2) + { + self["onwebkitdeviceproximity"] = val; + }); +var h$webkit_dom_dom_window_get_onwebkitdeviceproximity; +h$webkit_dom_dom_window_get_onwebkitdeviceproximity = (function(self, + self_2) + { + h$ret1 = 0; + return self["onwebkitdeviceproximity"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_dom_token_list_get_type = (function() + { + return h$g_get_type(DOMTokenList); + }); +var h$webkit_dom_dom_token_list_item; +h$webkit_dom_dom_token_list_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return h$encodeUtf8(self["item"](index)); + }); +var h$webkit_dom_dom_token_list_contains; +h$webkit_dom_dom_token_list_contains = (function(self, + self_2, token, token_2) + { + return self["contains"](h$decodeUtf8z(token, + token_2)); + }); +var h$webkit_dom_dom_token_list_add; +h$webkit_dom_dom_token_list_add = (function(self, + self_2, token, token_2) + { + return self["add"](h$decodeUtf8z(token, + token_2)); + }); +var h$webkit_dom_dom_token_list_remove; +h$webkit_dom_dom_token_list_remove = (function(self, + self_2, token, token_2) + { + return self["remove"](h$decodeUtf8z(token, + token_2)); + }); +var h$webkit_dom_dom_token_list_toggle; +h$webkit_dom_dom_token_list_toggle = (function(self, + self_2, token, token_2) + { + return self["toggle"](h$decodeUtf8z(token, + token_2)); + }); +var h$webkit_dom_dom_token_list_get_length; +h$webkit_dom_dom_token_list_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_dom_string_list_get_type = (function() + { + return h$g_get_type(DOMStringList); + }); +var h$webkit_dom_dom_string_list_item; +h$webkit_dom_dom_string_list_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return h$encodeUtf8(self["item"](index)); + }); +var h$webkit_dom_dom_string_list_contains; +h$webkit_dom_dom_string_list_contains = (function(self, + self_2, string, string_2) + { + return self["contains"](h$decodeUtf8z(string, + string_2)); + }); +var h$webkit_dom_dom_string_list_get_length; +h$webkit_dom_dom_string_list_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_dom_settable_token_list_get_type = (function() + { + return h$g_get_type(DOMSettableTokenList); + }); +var h$webkit_dom_dom_settable_token_list_set_value; +h$webkit_dom_dom_settable_token_list_set_value = (function(self, + self_2, val, val_2) + { + self["value"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_dom_settable_token_list_get_value; +h$webkit_dom_dom_settable_token_list_get_value = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["value"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Window +h$webkit_dom_dom_selection_get_type = (function() + { + return h$g_get_type(DOMSelection); + }); +var h$webkit_dom_dom_selection_collapse; +h$webkit_dom_dom_selection_collapse = (function(self, + self_2, node, node_2, index) + { + return self["collapse"](node, + index); + }); +var h$webkit_dom_dom_selection_collapse_to_end; +h$webkit_dom_dom_selection_collapse_to_end = (function(self, + self_2) + { + return self["collapseToEnd"](); + }); +var h$webkit_dom_dom_selection_collapse_to_start; +h$webkit_dom_dom_selection_collapse_to_start = (function(self, + self_2) + { + return self["collapseToStart"](); + }); +var h$webkit_dom_dom_selection_delete_from_document; +h$webkit_dom_dom_selection_delete_from_document = (function(self, + self_2) + { + return self["deleteFromDocument"](); + }); +var h$webkit_dom_dom_selection_contains_node; +h$webkit_dom_dom_selection_contains_node = (function(self, + self_2, node, node_2, + allowPartial) + { + return self["containsNode"](node, + allowPartial); + }); +var h$webkit_dom_dom_selection_select_all_children; +h$webkit_dom_dom_selection_select_all_children = (function(self, + self_2, node, node_2) + { + return self["selectAllChildren"](node); + }); +var h$webkit_dom_dom_selection_extend; +h$webkit_dom_dom_selection_extend = (function(self, + self_2, node, node_2, offset) + { + return self["extend"](node, + offset); + }); +var h$webkit_dom_dom_selection_get_range_at; +h$webkit_dom_dom_selection_get_range_at = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["getRangeAt"](index); + }); +var h$webkit_dom_dom_selection_remove_all_ranges; +h$webkit_dom_dom_selection_remove_all_ranges = (function(self, + self_2) + { + return self["removeAllRanges"](); + }); +var h$webkit_dom_dom_selection_add_range; +h$webkit_dom_dom_selection_add_range = (function(self, + self_2, range, range_2) + { + return self["addRange"](range); + }); +var h$webkit_dom_dom_selection_modify; +h$webkit_dom_dom_selection_modify = (function(self, + self_2, alter, alter_2, + direction, direction_2, + granularity, granularity_2) + { + return self["modify"](h$decodeUtf8z(alter, + alter_2), + h$decodeUtf8z(direction, + direction_2), + h$decodeUtf8z(granularity, + granularity_2)); + }); +var h$webkit_dom_dom_selection_set_base_and_extent; +h$webkit_dom_dom_selection_set_base_and_extent = (function(self, + self_2, baseNode, baseNode_2, + baseOffset, extentNode, + extentNode_2, extentOffset) + { + return self["setBaseAndExtent"](baseNode, + baseOffset, extentNode, + extentOffset); + }); +var h$webkit_dom_dom_selection_set_position; +h$webkit_dom_dom_selection_set_position = (function(self, + self_2, node, node_2, offset) + { + return self["setPosition"](node, + offset); + }); +var h$webkit_dom_dom_selection_empty; +h$webkit_dom_dom_selection_empty = (function(self, + self_2) + { + return self["empty"](); + }); +var h$webkit_dom_dom_selection_get_anchor_node; +h$webkit_dom_dom_selection_get_anchor_node = (function(self, + self_2) + { + h$ret1 = 0; + return self["anchorNode"]; + }); +var h$webkit_dom_dom_selection_get_anchor_offset; +h$webkit_dom_dom_selection_get_anchor_offset = (function(self, + self_2) + { + return self["anchorOffset"]; + }); +var h$webkit_dom_dom_selection_get_focus_node; +h$webkit_dom_dom_selection_get_focus_node = (function(self, + self_2) + { + h$ret1 = 0; + return self["focusNode"]; + }); +var h$webkit_dom_dom_selection_get_focus_offset; +h$webkit_dom_dom_selection_get_focus_offset = (function(self, + self_2) + { + return self["focusOffset"]; + }); +var h$webkit_dom_dom_selection_get_is_collapsed; +h$webkit_dom_dom_selection_get_is_collapsed = (function(self, + self_2) + { + return self["isCollapsed"]; + }); +var h$webkit_dom_dom_selection_get_range_count; +h$webkit_dom_dom_selection_get_range_count = (function(self, + self_2) + { + return self["rangeCount"]; + }); +var h$webkit_dom_dom_selection_get_base_node; +h$webkit_dom_dom_selection_get_base_node = (function(self, + self_2) + { + h$ret1 = 0; + return self["baseNode"]; + }); +var h$webkit_dom_dom_selection_get_base_offset; +h$webkit_dom_dom_selection_get_base_offset = (function(self, + self_2) + { + return self["baseOffset"]; + }); +var h$webkit_dom_dom_selection_get_extent_node; +h$webkit_dom_dom_selection_get_extent_node = (function(self, + self_2) + { + h$ret1 = 0; + return self["extentNode"]; + }); +var h$webkit_dom_dom_selection_get_extent_offset; +h$webkit_dom_dom_selection_get_extent_offset = (function(self, + self_2) + { + return self["extentOffset"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_dom_security_policy_get_type = (function() + { + return h$g_get_type(DOMSecurityPolicy); + }); +var h$webkit_dom_dom_security_policy_is_active; +h$webkit_dom_dom_security_policy_is_active = (function(self, + self_2) + { + return self["isActive"](); + }); +var h$webkit_dom_dom_security_policy_allows_connection_to; +h$webkit_dom_dom_security_policy_allows_connection_to = (function(self, + self_2, url, url_2) + { + return self["allowsConnectionTo"](h$decodeUtf8z(url, + url_2)); + }); +var h$webkit_dom_dom_security_policy_allows_font_from; +h$webkit_dom_dom_security_policy_allows_font_from = (function(self, + self_2, url, url_2) + { + return self["allowsFontFrom"](h$decodeUtf8z(url, + url_2)); + }); +var h$webkit_dom_dom_security_policy_allows_form_action; +h$webkit_dom_dom_security_policy_allows_form_action = (function(self, + self_2, url, url_2) + { + return self["allowsFormAction"](h$decodeUtf8z(url, + url_2)); + }); +var h$webkit_dom_dom_security_policy_allows_frame_from; +h$webkit_dom_dom_security_policy_allows_frame_from = (function(self, + self_2, url, url_2) + { + return self["allowsFrameFrom"](h$decodeUtf8z(url, + url_2)); + }); +var h$webkit_dom_dom_security_policy_allows_image_from; +h$webkit_dom_dom_security_policy_allows_image_from = (function(self, + self_2, url, url_2) + { + return self["allowsImageFrom"](h$decodeUtf8z(url, + url_2)); + }); +var h$webkit_dom_dom_security_policy_allows_media_from; +h$webkit_dom_dom_security_policy_allows_media_from = (function(self, + self_2, url, url_2) + { + return self["allowsMediaFrom"](h$decodeUtf8z(url, + url_2)); + }); +var h$webkit_dom_dom_security_policy_allows_object_from; +h$webkit_dom_dom_security_policy_allows_object_from = (function(self, + self_2, url, url_2) + { + return self["allowsObjectFrom"](h$decodeUtf8z(url, + url_2)); + }); +var h$webkit_dom_dom_security_policy_allows_plugin_type; +h$webkit_dom_dom_security_policy_allows_plugin_type = (function(self, + self_2, type, type_2) + { + return self["allowsPluginType"](h$decodeUtf8z(type, + type_2)); + }); +var h$webkit_dom_dom_security_policy_allows_script_from; +h$webkit_dom_dom_security_policy_allows_script_from = (function(self, + self_2, url, url_2) + { + return self["allowsScriptFrom"](h$decodeUtf8z(url, + url_2)); + }); +var h$webkit_dom_dom_security_policy_allows_style_from; +h$webkit_dom_dom_security_policy_allows_style_from = (function(self, + self_2, url, url_2) + { + return self["allowsStyleFrom"](h$decodeUtf8z(url, + url_2)); + }); +var h$webkit_dom_dom_security_policy_allows_eval; +h$webkit_dom_dom_security_policy_allows_eval = (function(self, + self_2) + { + return self["allowsEval"](); + }); +var h$webkit_dom_dom_security_policy_allows_inline_script; +h$webkit_dom_dom_security_policy_allows_inline_script = (function(self, + self_2) + { + return self["allowsInlineScript"](); + }); +var h$webkit_dom_dom_security_policy_allows_inline_style; +h$webkit_dom_dom_security_policy_allows_inline_style = (function(self, + self_2) + { + return self["allowsInlineStyle"](); + }); +var h$webkit_dom_dom_security_policy_get_report_ur_is; +h$webkit_dom_dom_security_policy_get_report_ur_is = (function(self, + self_2) + { + h$ret1 = 0; + return self["reportURIs"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Window +h$webkit_dom_dom_plugin_array_get_type = (function() + { + return h$g_get_type(DOMPluginArray); + }); +var h$webkit_dom_dom_plugin_array_item; +h$webkit_dom_dom_plugin_array_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["item"](index); + }); +var h$webkit_dom_dom_plugin_array_named_item; +h$webkit_dom_dom_plugin_array_named_item = (function(self, + self_2, name, name_2) + { + h$ret1 = 0; + return self["namedItem"](h$decodeUtf8z(name, + name_2)); + }); +var h$webkit_dom_dom_plugin_array_refresh; +h$webkit_dom_dom_plugin_array_refresh = (function(self, + self_2, reload) + { + return self["refresh"](reload); + }); +var h$webkit_dom_dom_plugin_array_get_length; +h$webkit_dom_dom_plugin_array_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Window +h$webkit_dom_dom_plugin_get_type = (function() + { + return h$g_get_type(DOMPlugin); + }); +var h$webkit_dom_dom_plugin_item; +h$webkit_dom_dom_plugin_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["item"](index); + }); +var h$webkit_dom_dom_plugin_named_item; +h$webkit_dom_dom_plugin_named_item = (function(self, + self_2, name, name_2) + { + h$ret1 = 0; + return self["namedItem"](h$decodeUtf8z(name, + name_2)); + }); +var h$webkit_dom_dom_plugin_get_name; +h$webkit_dom_dom_plugin_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_dom_plugin_get_filename; +h$webkit_dom_dom_plugin_get_filename = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["filename"]); + }); +var h$webkit_dom_dom_plugin_get_description; +h$webkit_dom_dom_plugin_get_description = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["description"]); + }); +var h$webkit_dom_dom_plugin_get_length; +h$webkit_dom_dom_plugin_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Window +h$webkit_dom_dom_mime_type_array_get_type = (function() + { + return h$g_get_type(DOMMimeTypeArray); + }); +var h$webkit_dom_dom_mime_type_array_item; +h$webkit_dom_dom_mime_type_array_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["item"](index); + }); +var h$webkit_dom_dom_mime_type_array_named_item; +h$webkit_dom_dom_mime_type_array_named_item = (function(self, + self_2, name, name_2) + { + h$ret1 = 0; + return self["namedItem"](h$decodeUtf8z(name, + name_2)); + }); +var h$webkit_dom_dom_mime_type_array_get_length; +h$webkit_dom_dom_mime_type_array_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Window +h$webkit_dom_dom_mime_type_get_type = (function() + { + return h$g_get_type(DOMMimeType); + }); +var h$webkit_dom_dom_mime_type_get_suffixes; +h$webkit_dom_dom_mime_type_get_suffixes = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["suffixes"]); + }); +var h$webkit_dom_dom_mime_type_get_description; +h$webkit_dom_dom_mime_type_get_description = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["description"]); + }); +var h$webkit_dom_dom_mime_type_get_enabled_plugin; +h$webkit_dom_dom_mime_type_get_enabled_plugin = (function(self, + self_2) + { + h$ret1 = 0; + return self["enabledPlugin"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_dom_implementation_get_type = (function() + { + return h$g_get_type(DOMImplementation); + }); +var h$webkit_dom_dom_implementation_has_feature; +h$webkit_dom_dom_implementation_has_feature = (function(self, + self_2, feature, feature_2, + version, version_2) + { + return self["hasFeature"](h$decodeUtf8z(feature, + feature_2), + h$decodeUtf8z(version, + version_2)); + }); +var h$webkit_dom_dom_implementation_create_document_type; +h$webkit_dom_dom_implementation_create_document_type = (function(self, + self_2, qualifiedName, + qualifiedName_2, + publicId, publicId_2, + systemId, systemId_2) + { + h$ret1 = 0; + return self["createDocumentType"](h$decodeUtf8z(qualifiedName, + qualifiedName_2), + h$decodeUtf8z(publicId, + publicId_2), + h$decodeUtf8z(systemId, + systemId_2)); + }); +var h$webkit_dom_dom_implementation_create_document; +h$webkit_dom_dom_implementation_create_document = (function(self, + self_2, namespaceURI, + namespaceURI_2, + qualifiedName, + qualifiedName_2, doctype, + doctype_2) + { + h$ret1 = 0; + return self["createDocument"](h$decodeUtf8z(namespaceURI, + namespaceURI_2), + h$decodeUtf8z(qualifiedName, + qualifiedName_2), doctype); + }); +var h$webkit_dom_dom_implementation_create_css_style_sheet; +h$webkit_dom_dom_implementation_create_css_style_sheet = (function(self, + self_2, title, + title_2, media, + media_2) + { + h$ret1 = 0; + return self["createCSSStyleSheet"](h$decodeUtf8z(title, + title_2), + h$decodeUtf8z(media, + media_2)); + }); +var h$webkit_dom_dom_implementation_create_html_document; +h$webkit_dom_dom_implementation_create_html_document = (function(self, + self_2, title, title_2) + { + h$ret1 = 0; + return self["createHTMLDocument"](h$decodeUtf8z(title, + title_2)); + }); +// Graphics.UI.Gtk.WebKit.DOM.Offline +h$webkit_dom_dom_application_cache_get_type = (function() + { + return h$g_get_type(DOMApplicationCache); + }); +var h$webkit_dom_dom_application_cache_update; +h$webkit_dom_dom_application_cache_update = (function(self, + self_2) + { + return self["update"](); + }); +var h$webkit_dom_dom_application_cache_swap_cache; +h$webkit_dom_dom_application_cache_swap_cache = (function(self, + self_2) + { + return self["swapCache"](); + }); +var h$webkit_dom_dom_application_cache_abort; +h$webkit_dom_dom_application_cache_abort = (function(self, + self_2) + { + return self["abort"](); + }); +var h$webkit_dom_dom_application_cache_dispatch_event; +h$webkit_dom_dom_application_cache_dispatch_event = (function(self, + self_2, evt, evt_2) + { + return self["dispatchEvent"](evt); + }); +var h$webkit_dom_dom_application_cache_get_status; +h$webkit_dom_dom_application_cache_get_status = (function(self, + self_2) + { + return self["status"]; + }); +var h$webkit_dom_dom_application_cache_set_onchecking; +h$webkit_dom_dom_application_cache_set_onchecking = (function(self, + self_2, val, val_2) + { + self["onchecking"] = val; + }); +var h$webkit_dom_dom_application_cache_get_onchecking; +h$webkit_dom_dom_application_cache_get_onchecking = (function(self, + self_2) + { + h$ret1 = 0; + return self["onchecking"]; + }); +var h$webkit_dom_dom_application_cache_set_onerror; +h$webkit_dom_dom_application_cache_set_onerror = (function(self, + self_2, val, val_2) + { + self["onerror"] = val; + }); +var h$webkit_dom_dom_application_cache_get_onerror; +h$webkit_dom_dom_application_cache_get_onerror = (function(self, + self_2) + { + h$ret1 = 0; + return self["onerror"]; + }); +var h$webkit_dom_dom_application_cache_set_onnoupdate; +h$webkit_dom_dom_application_cache_set_onnoupdate = (function(self, + self_2, val, val_2) + { + self["onnoupdate"] = val; + }); +var h$webkit_dom_dom_application_cache_get_onnoupdate; +h$webkit_dom_dom_application_cache_get_onnoupdate = (function(self, + self_2) + { + h$ret1 = 0; + return self["onnoupdate"]; + }); +var h$webkit_dom_dom_application_cache_set_ondownloading; +h$webkit_dom_dom_application_cache_set_ondownloading = (function(self, + self_2, val, val_2) + { + self["ondownloading"] = val; + }); +var h$webkit_dom_dom_application_cache_get_ondownloading; +h$webkit_dom_dom_application_cache_get_ondownloading = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondownloading"]; + }); +var h$webkit_dom_dom_application_cache_set_onprogress; +h$webkit_dom_dom_application_cache_set_onprogress = (function(self, + self_2, val, val_2) + { + self["onprogress"] = val; + }); +var h$webkit_dom_dom_application_cache_get_onprogress; +h$webkit_dom_dom_application_cache_get_onprogress = (function(self, + self_2) + { + h$ret1 = 0; + return self["onprogress"]; + }); +var h$webkit_dom_dom_application_cache_set_onupdateready; +h$webkit_dom_dom_application_cache_set_onupdateready = (function(self, + self_2, val, val_2) + { + self["onupdateready"] = val; + }); +var h$webkit_dom_dom_application_cache_get_onupdateready; +h$webkit_dom_dom_application_cache_get_onupdateready = (function(self, + self_2) + { + h$ret1 = 0; + return self["onupdateready"]; + }); +var h$webkit_dom_dom_application_cache_set_oncached; +h$webkit_dom_dom_application_cache_set_oncached = (function(self, + self_2, val, val_2) + { + self["oncached"] = val; + }); +var h$webkit_dom_dom_application_cache_get_oncached; +h$webkit_dom_dom_application_cache_get_oncached = (function(self, + self_2) + { + h$ret1 = 0; + return self["oncached"]; + }); +var h$webkit_dom_dom_application_cache_set_onobsolete; +h$webkit_dom_dom_application_cache_set_onobsolete = (function(self, + self_2, val, val_2) + { + self["onobsolete"] = val; + }); +var h$webkit_dom_dom_application_cache_get_onobsolete; +h$webkit_dom_dom_application_cache_get_onobsolete = (function(self, + self_2) + { + h$ret1 = 0; + return self["onobsolete"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_document_type_get_type = (function() + { + return h$g_get_type(DocumentType); + }); +var h$webkit_dom_document_type_get_name; +h$webkit_dom_document_type_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_document_type_get_entities; +h$webkit_dom_document_type_get_entities = (function(self, + self_2) + { + h$ret1 = 0; + return self["entities"]; + }); +var h$webkit_dom_document_type_get_notations; +h$webkit_dom_document_type_get_notations = (function(self, + self_2) + { + h$ret1 = 0; + return self["notations"]; + }); +var h$webkit_dom_document_type_get_public_id; +h$webkit_dom_document_type_get_public_id = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["publicId"]); + }); +var h$webkit_dom_document_type_get_system_id; +h$webkit_dom_document_type_get_system_id = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["systemId"]); + }); +var h$webkit_dom_document_type_get_internal_subset; +h$webkit_dom_document_type_get_internal_subset = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["internalSubset"]); + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_document_fragment_get_type = (function() + { + return h$g_get_type(DocumentFragment); + }); +var h$webkit_dom_document_fragment_query_selector; +h$webkit_dom_document_fragment_query_selector = (function(self, + self_2, selectors, selectors_2) + { + h$ret1 = 0; + return self["querySelector"](h$decodeUtf8z(selectors, + selectors_2)); + }); +var h$webkit_dom_document_fragment_query_selector_all; +h$webkit_dom_document_fragment_query_selector_all = (function(self, + self_2, selectors, + selectors_2) + { + h$ret1 = 0; + return self["querySelectorAll"](h$decodeUtf8z(selectors, + selectors_2)); + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_document_get_type = (function() + { + return h$g_get_type(Document); + }); +var h$webkit_dom_document_create_element; +h$webkit_dom_document_create_element = (function(self, + self_2, tagName, tagName_2) + { + h$ret1 = 0; + return self["createElement"](h$decodeUtf8z(tagName, + tagName_2)); + }); +var h$webkit_dom_document_create_document_fragment; +h$webkit_dom_document_create_document_fragment = (function(self, + self_2) + { + h$ret1 = 0; + return self["createDocumentFragment"](); + }); +var h$webkit_dom_document_create_text_node; +h$webkit_dom_document_create_text_node = (function(self, + self_2, data, data_2) + { + h$ret1 = 0; + return self["createTextNode"](h$decodeUtf8z(data, + data_2)); + }); +var h$webkit_dom_document_create_comment; +h$webkit_dom_document_create_comment = (function(self, + self_2, data, data_2) + { + h$ret1 = 0; + return self["createComment"](h$decodeUtf8z(data, + data_2)); + }); +var h$webkit_dom_document_create_cdata_section; +h$webkit_dom_document_create_cdata_section = (function(self, + self_2, data, data_2) + { + h$ret1 = 0; + return self["createCDATASection"](h$decodeUtf8z(data, + data_2)); + }); +var h$webkit_dom_document_create_processing_instruction; +h$webkit_dom_document_create_processing_instruction = (function(self, + self_2, target, target_2, + data, data_2) + { + h$ret1 = 0; + return self["createProcessingInstruction"](h$decodeUtf8z(target, + target_2), + h$decodeUtf8z(data, + data_2)); + }); +var h$webkit_dom_document_create_attribute; +h$webkit_dom_document_create_attribute = (function(self, + self_2, name, name_2) + { + h$ret1 = 0; + return self["createAttribute"](h$decodeUtf8z(name, + name_2)); + }); +var h$webkit_dom_document_create_entity_reference; +h$webkit_dom_document_create_entity_reference = (function(self, + self_2, name, name_2) + { + h$ret1 = 0; + return self["createEntityReference"](h$decodeUtf8z(name, + name_2)); + }); +var h$webkit_dom_document_get_elements_by_tag_name; +h$webkit_dom_document_get_elements_by_tag_name = (function(self, + self_2, tagname, tagname_2) + { + h$ret1 = 0; + return self["getElementsByTagName"](h$decodeUtf8z(tagname, + tagname_2)); + }); +var h$webkit_dom_document_import_node; +h$webkit_dom_document_import_node = (function(self, + self_2, importedNode, + importedNode_2, deep) + { + h$ret1 = 0; + return self["importNode"](importedNode, + deep); + }); +var h$webkit_dom_document_create_element_ns; +h$webkit_dom_document_create_element_ns = (function(self, + self_2, namespaceURI, + namespaceURI_2, qualifiedName, + qualifiedName_2) + { + h$ret1 = 0; + return self["createElementNS"](h$decodeUtf8z(namespaceURI, + namespaceURI_2), + h$decodeUtf8z(qualifiedName, + qualifiedName_2)); + }); +var h$webkit_dom_document_create_attribute_ns; +h$webkit_dom_document_create_attribute_ns = (function(self, + self_2, namespaceURI, + namespaceURI_2, qualifiedName, + qualifiedName_2) + { + h$ret1 = 0; + return self["createAttributeNS"](h$decodeUtf8z(namespaceURI, + namespaceURI_2), + h$decodeUtf8z(qualifiedName, + qualifiedName_2)); + }); +var h$webkit_dom_document_get_elements_by_tag_name_ns; +h$webkit_dom_document_get_elements_by_tag_name_ns = (function(self, + self_2, namespaceURI, + namespaceURI_2, localName, + localName_2) + { + h$ret1 = 0; + return self["getElementsByTagNameNS"](h$decodeUtf8z(namespaceURI, + namespaceURI_2), + h$decodeUtf8z(localName, + localName_2)); + }); +var h$webkit_dom_document_get_element_by_id; +h$webkit_dom_document_get_element_by_id = (function(self, + self_2, elementId, elementId_2) + { + h$ret1 = 0; + return self["getElementById"](h$decodeUtf8z(elementId, + elementId_2)); + }); +var h$webkit_dom_document_adopt_node; +h$webkit_dom_document_adopt_node = (function(self, + self_2, source, source_2) + { + h$ret1 = 0; + return self["adoptNode"](source); + }); +var h$webkit_dom_document_create_event; +h$webkit_dom_document_create_event = (function(self, + self_2, eventType, eventType_2) + { + h$ret1 = 0; + return self["createEvent"](h$decodeUtf8z(eventType, + eventType_2)); + }); +var h$webkit_dom_document_create_range; +h$webkit_dom_document_create_range = (function(self, + self_2) + { + h$ret1 = 0; + return self["createRange"](); + }); +var h$webkit_dom_document_create_node_iterator; +h$webkit_dom_document_create_node_iterator = (function(self, + self_2, root, root_2, + whatToShow, filter, filter_2, + expandEntityReferences) + { + h$ret1 = 0; + return self["createNodeIterator"](root, + whatToShow, filter, + expandEntityReferences); + }); +var h$webkit_dom_document_create_tree_walker; +h$webkit_dom_document_create_tree_walker = (function(self, + self_2, root, root_2, + whatToShow, filter, filter_2, + expandEntityReferences) + { + h$ret1 = 0; + return self["createTreeWalker"](root, + whatToShow, filter, + expandEntityReferences); + }); +var h$webkit_dom_document_get_override_style; +h$webkit_dom_document_get_override_style = (function(self, + self_2, element, element_2, + pseudoElement, pseudoElement_2) + { + h$ret1 = 0; + return self["getOverrideStyle"](element, + h$decodeUtf8z(pseudoElement, + pseudoElement_2)); + }); +var h$webkit_dom_document_create_expression; +h$webkit_dom_document_create_expression = (function(self, + self_2, expression, + expression_2, resolver, + resolver_2) + { + h$ret1 = 0; + return self["createExpression"](h$decodeUtf8z(expression, + expression_2), resolver); + }); +var h$webkit_dom_document_create_ns_resolver; +h$webkit_dom_document_create_ns_resolver = (function(self, + self_2, nodeResolver, + nodeResolver_2) + { + h$ret1 = 0; + return self["createNSResolver"](nodeResolver); + }); +var h$webkit_dom_document_evaluate; +h$webkit_dom_document_evaluate = (function(self, + self_2, expression, + expression_2, contextNode, + contextNode_2, resolver, + resolver_2, type, inResult, + inResult_2) + { + h$ret1 = 0; + return self["evaluate"](h$decodeUtf8z(expression, + expression_2), contextNode, + resolver, type, inResult); + }); +var h$webkit_dom_document_exec_command; +h$webkit_dom_document_exec_command = (function(self, + self_2, command, command_2, + userInterface, value, value_2) + { + return self["execCommand"](h$decodeUtf8z(command, + command_2), userInterface, + h$decodeUtf8z(value, value_2)); + }); +var h$webkit_dom_document_query_command_enabled; +h$webkit_dom_document_query_command_enabled = (function(self, + self_2, command, command_2) + { + return self["queryCommandEnabled"](h$decodeUtf8z(command, + command_2)); + }); +var h$webkit_dom_document_query_command_indeterm; +h$webkit_dom_document_query_command_indeterm = (function(self, + self_2, command, command_2) + { + return self["queryCommandIndeterm"](h$decodeUtf8z(command, + command_2)); + }); +var h$webkit_dom_document_query_command_state; +h$webkit_dom_document_query_command_state = (function(self, + self_2, command, command_2) + { + return self["queryCommandState"](h$decodeUtf8z(command, + command_2)); + }); +var h$webkit_dom_document_query_command_supported; +h$webkit_dom_document_query_command_supported = (function(self, + self_2, command, command_2) + { + return self["queryCommandSupported"](h$decodeUtf8z(command, + command_2)); + }); +var h$webkit_dom_document_query_command_value; +h$webkit_dom_document_query_command_value = (function(self, + self_2, command, command_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["queryCommandValue"](h$decodeUtf8z(command, + command_2))); + }); +var h$webkit_dom_document_get_elements_by_name; +h$webkit_dom_document_get_elements_by_name = (function(self, + self_2, elementName, + elementName_2) + { + h$ret1 = 0; + return self["getElementsByName"](h$decodeUtf8z(elementName, + elementName_2)); + }); +var h$webkit_dom_document_element_from_point; +h$webkit_dom_document_element_from_point = (function(self, + self_2, x, y) + { + h$ret1 = 0; + return self["elementFromPoint"](x, + y); + }); +var h$webkit_dom_document_caret_range_from_point; +h$webkit_dom_document_caret_range_from_point = (function(self, + self_2, x, y) + { + h$ret1 = 0; + return self["caretRangeFromPoint"](x, + y); + }); +var h$webkit_dom_document_create_css_style_declaration; +h$webkit_dom_document_create_css_style_declaration = (function(self, + self_2) + { + h$ret1 = 0; + return self["createCSSStyleDeclaration"](); + }); +var h$webkit_dom_document_get_elements_by_class_name; +h$webkit_dom_document_get_elements_by_class_name = (function(self, + self_2, tagname, tagname_2) + { + h$ret1 = 0; + return self["getElementsByClassName"](h$decodeUtf8z(tagname, + tagname_2)); + }); +var h$webkit_dom_document_query_selector; +h$webkit_dom_document_query_selector = (function(self, + self_2, selectors, selectors_2) + { + h$ret1 = 0; + return self["querySelector"](h$decodeUtf8z(selectors, + selectors_2)); + }); +var h$webkit_dom_document_query_selector_all; +h$webkit_dom_document_query_selector_all = (function(self, + self_2, selectors, selectors_2) + { + h$ret1 = 0; + return self["querySelectorAll"](h$decodeUtf8z(selectors, + selectors_2)); + }); +var h$webkit_dom_document_get_doctype; +h$webkit_dom_document_get_doctype = (function(self, + self_2) + { + h$ret1 = 0; + return self["doctype"]; + }); +var h$webkit_dom_document_get_implementation; +h$webkit_dom_document_get_implementation = (function(self, + self_2) + { + h$ret1 = 0; + return self["implementation"]; + }); +var h$webkit_dom_document_get_document_element; +h$webkit_dom_document_get_document_element = (function(self, + self_2) + { + h$ret1 = 0; + return self["documentElement"]; + }); +var h$webkit_dom_document_get_input_encoding; +h$webkit_dom_document_get_input_encoding = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["inputEncoding"]); + }); +var h$webkit_dom_document_get_xml_encoding; +h$webkit_dom_document_get_xml_encoding = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["xmlEncoding"]); + }); +var h$webkit_dom_document_set_xml_version; +h$webkit_dom_document_set_xml_version = (function(self, + self_2, val, val_2) + { + self["xmlVersion"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_document_get_xml_version; +h$webkit_dom_document_get_xml_version = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["xmlVersion"]); + }); +var h$webkit_dom_document_set_xml_standalone; +h$webkit_dom_document_set_xml_standalone = (function(self, + self_2, val) + { + self["xmlStandalone"] = val; + }); +var h$webkit_dom_document_get_xml_standalone; +h$webkit_dom_document_get_xml_standalone = (function(self, + self_2) + { + return self["xmlStandalone"]; + }); +var h$webkit_dom_document_set_document_uri; +h$webkit_dom_document_set_document_uri = (function(self, + self_2, val, val_2) + { + self["documentURI"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_document_get_document_uri; +h$webkit_dom_document_get_document_uri = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["documentURI"]); + }); +var h$webkit_dom_document_get_default_view; +h$webkit_dom_document_get_default_view = (function(self, + self_2) + { + h$ret1 = 0; + return self["defaultView"]; + }); +var h$webkit_dom_document_get_style_sheets; +h$webkit_dom_document_get_style_sheets = (function(self, + self_2) + { + h$ret1 = 0; + return self["styleSheets"]; + }); +var h$webkit_dom_document_set_title; +h$webkit_dom_document_set_title = (function(self, + self_2, val, val_2) + { + self["title"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_document_get_title; +h$webkit_dom_document_get_title = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["title"]); + }); +var h$webkit_dom_document_get_referrer; +h$webkit_dom_document_get_referrer = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["referrer"]); + }); +var h$webkit_dom_document_get_domain; +h$webkit_dom_document_get_domain = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["domain"]); + }); +var h$webkit_dom_document_set_cookie; +h$webkit_dom_document_set_cookie = (function(self, + self_2, val, val_2) + { + self["cookie"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_document_get_cookie; +h$webkit_dom_document_get_cookie = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["cookie"]); + }); +var h$webkit_dom_document_set_body; +h$webkit_dom_document_set_body = (function(self, + self_2, val, val_2) + { + self["body"] = val; + }); +var h$webkit_dom_document_get_body; +h$webkit_dom_document_get_body = (function(self, + self_2) + { + h$ret1 = 0; + return self["body"]; + }); +var h$webkit_dom_document_get_head; +h$webkit_dom_document_get_head = (function(self, + self_2) + { + h$ret1 = 0; + return self["head"]; + }); +var h$webkit_dom_document_get_images; +h$webkit_dom_document_get_images = (function(self, + self_2) + { + h$ret1 = 0; + return self["images"]; + }); +var h$webkit_dom_document_get_applets; +h$webkit_dom_document_get_applets = (function(self, + self_2) + { + h$ret1 = 0; + return self["applets"]; + }); +var h$webkit_dom_document_get_links; +h$webkit_dom_document_get_links = (function(self, + self_2) + { + h$ret1 = 0; + return self["links"]; + }); +var h$webkit_dom_document_get_forms; +h$webkit_dom_document_get_forms = (function(self, + self_2) + { + h$ret1 = 0; + return self["forms"]; + }); +var h$webkit_dom_document_get_anchors; +h$webkit_dom_document_get_anchors = (function(self, + self_2) + { + h$ret1 = 0; + return self["anchors"]; + }); +var h$webkit_dom_document_get_last_modified; +h$webkit_dom_document_get_last_modified = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["lastModified"]); + }); +var h$webkit_dom_document_set_charset; +h$webkit_dom_document_set_charset = (function(self, + self_2, val, val_2) + { + self["charset"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_document_get_charset; +h$webkit_dom_document_get_charset = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["charset"]); + }); +var h$webkit_dom_document_get_default_charset; +h$webkit_dom_document_get_default_charset = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["defaultCharset"]); + }); +var h$webkit_dom_document_get_ready_state; +h$webkit_dom_document_get_ready_state = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["readyState"]); + }); +var h$webkit_dom_document_get_character_set; +h$webkit_dom_document_get_character_set = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["characterSet"]); + }); +var h$webkit_dom_document_get_preferred_stylesheet_set; +h$webkit_dom_document_get_preferred_stylesheet_set = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["preferredStylesheetSet"]); + }); +var h$webkit_dom_document_set_selected_stylesheet_set; +h$webkit_dom_document_set_selected_stylesheet_set = (function(self, + self_2, val, val_2) + { + self["selectedStylesheetSet"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_document_get_selected_stylesheet_set; +h$webkit_dom_document_get_selected_stylesheet_set = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["selectedStylesheetSet"]); + }); +var h$webkit_dom_document_get_compat_mode; +h$webkit_dom_document_get_compat_mode = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["compatMode"]); + }); +var h$webkit_dom_document_get_webkit_pointer_lock_element; +h$webkit_dom_document_get_webkit_pointer_lock_element = (function(self, + self_2) + { + h$ret1 = 0; + return self["webkitPointerLockElement"]; + }); +var h$webkit_dom_document_set_onabort; +h$webkit_dom_document_set_onabort = (function(self, + self_2, val, val_2) + { + self["onabort"] = val; + }); +var h$webkit_dom_document_get_onabort; +h$webkit_dom_document_get_onabort = (function(self, + self_2) + { + h$ret1 = 0; + return self["onabort"]; + }); +var h$webkit_dom_document_set_onblur; +h$webkit_dom_document_set_onblur = (function(self, + self_2, val, val_2) + { + self["onblur"] = val; + }); +var h$webkit_dom_document_get_onblur; +h$webkit_dom_document_get_onblur = (function(self, + self_2) + { + h$ret1 = 0; + return self["onblur"]; + }); +var h$webkit_dom_document_set_onchange; +h$webkit_dom_document_set_onchange = (function(self, + self_2, val, val_2) + { + self["onchange"] = val; + }); +var h$webkit_dom_document_get_onchange; +h$webkit_dom_document_get_onchange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onchange"]; + }); +var h$webkit_dom_document_set_onclick; +h$webkit_dom_document_set_onclick = (function(self, + self_2, val, val_2) + { + self["onclick"] = val; + }); +var h$webkit_dom_document_get_onclick; +h$webkit_dom_document_get_onclick = (function(self, + self_2) + { + h$ret1 = 0; + return self["onclick"]; + }); +var h$webkit_dom_document_set_oncontextmenu; +h$webkit_dom_document_set_oncontextmenu = (function(self, + self_2, val, val_2) + { + self["oncontextmenu"] = val; + }); +var h$webkit_dom_document_get_oncontextmenu; +h$webkit_dom_document_get_oncontextmenu = (function(self, + self_2) + { + h$ret1 = 0; + return self["oncontextmenu"]; + }); +var h$webkit_dom_document_set_ondblclick; +h$webkit_dom_document_set_ondblclick = (function(self, + self_2, val, val_2) + { + self["ondblclick"] = val; + }); +var h$webkit_dom_document_get_ondblclick; +h$webkit_dom_document_get_ondblclick = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondblclick"]; + }); +var h$webkit_dom_document_set_ondrag; +h$webkit_dom_document_set_ondrag = (function(self, + self_2, val, val_2) + { + self["ondrag"] = val; + }); +var h$webkit_dom_document_get_ondrag; +h$webkit_dom_document_get_ondrag = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondrag"]; + }); +var h$webkit_dom_document_set_ondragend; +h$webkit_dom_document_set_ondragend = (function(self, + self_2, val, val_2) + { + self["ondragend"] = val; + }); +var h$webkit_dom_document_get_ondragend; +h$webkit_dom_document_get_ondragend = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondragend"]; + }); +var h$webkit_dom_document_set_ondragenter; +h$webkit_dom_document_set_ondragenter = (function(self, + self_2, val, val_2) + { + self["ondragenter"] = val; + }); +var h$webkit_dom_document_get_ondragenter; +h$webkit_dom_document_get_ondragenter = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondragenter"]; + }); +var h$webkit_dom_document_set_ondragleave; +h$webkit_dom_document_set_ondragleave = (function(self, + self_2, val, val_2) + { + self["ondragleave"] = val; + }); +var h$webkit_dom_document_get_ondragleave; +h$webkit_dom_document_get_ondragleave = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondragleave"]; + }); +var h$webkit_dom_document_set_ondragover; +h$webkit_dom_document_set_ondragover = (function(self, + self_2, val, val_2) + { + self["ondragover"] = val; + }); +var h$webkit_dom_document_get_ondragover; +h$webkit_dom_document_get_ondragover = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondragover"]; + }); +var h$webkit_dom_document_set_ondragstart; +h$webkit_dom_document_set_ondragstart = (function(self, + self_2, val, val_2) + { + self["ondragstart"] = val; + }); +var h$webkit_dom_document_get_ondragstart; +h$webkit_dom_document_get_ondragstart = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondragstart"]; + }); +var h$webkit_dom_document_set_ondrop; +h$webkit_dom_document_set_ondrop = (function(self, + self_2, val, val_2) + { + self["ondrop"] = val; + }); +var h$webkit_dom_document_get_ondrop; +h$webkit_dom_document_get_ondrop = (function(self, + self_2) + { + h$ret1 = 0; + return self["ondrop"]; + }); +var h$webkit_dom_document_set_onerror; +h$webkit_dom_document_set_onerror = (function(self, + self_2, val, val_2) + { + self["onerror"] = val; + }); +var h$webkit_dom_document_get_onerror; +h$webkit_dom_document_get_onerror = (function(self, + self_2) + { + h$ret1 = 0; + return self["onerror"]; + }); +var h$webkit_dom_document_set_onfocus; +h$webkit_dom_document_set_onfocus = (function(self, + self_2, val, val_2) + { + self["onfocus"] = val; + }); +var h$webkit_dom_document_get_onfocus; +h$webkit_dom_document_get_onfocus = (function(self, + self_2) + { + h$ret1 = 0; + return self["onfocus"]; + }); +var h$webkit_dom_document_set_oninput; +h$webkit_dom_document_set_oninput = (function(self, + self_2, val, val_2) + { + self["oninput"] = val; + }); +var h$webkit_dom_document_get_oninput; +h$webkit_dom_document_get_oninput = (function(self, + self_2) + { + h$ret1 = 0; + return self["oninput"]; + }); +var h$webkit_dom_document_set_oninvalid; +h$webkit_dom_document_set_oninvalid = (function(self, + self_2, val, val_2) + { + self["oninvalid"] = val; + }); +var h$webkit_dom_document_get_oninvalid; +h$webkit_dom_document_get_oninvalid = (function(self, + self_2) + { + h$ret1 = 0; + return self["oninvalid"]; + }); +var h$webkit_dom_document_set_onkeydown; +h$webkit_dom_document_set_onkeydown = (function(self, + self_2, val, val_2) + { + self["onkeydown"] = val; + }); +var h$webkit_dom_document_get_onkeydown; +h$webkit_dom_document_get_onkeydown = (function(self, + self_2) + { + h$ret1 = 0; + return self["onkeydown"]; + }); +var h$webkit_dom_document_set_onkeypress; +h$webkit_dom_document_set_onkeypress = (function(self, + self_2, val, val_2) + { + self["onkeypress"] = val; + }); +var h$webkit_dom_document_get_onkeypress; +h$webkit_dom_document_get_onkeypress = (function(self, + self_2) + { + h$ret1 = 0; + return self["onkeypress"]; + }); +var h$webkit_dom_document_set_onkeyup; +h$webkit_dom_document_set_onkeyup = (function(self, + self_2, val, val_2) + { + self["onkeyup"] = val; + }); +var h$webkit_dom_document_get_onkeyup; +h$webkit_dom_document_get_onkeyup = (function(self, + self_2) + { + h$ret1 = 0; + return self["onkeyup"]; + }); +var h$webkit_dom_document_set_onload; +h$webkit_dom_document_set_onload = (function(self, + self_2, val, val_2) + { + self["onload"] = val; + }); +var h$webkit_dom_document_get_onload; +h$webkit_dom_document_get_onload = (function(self, + self_2) + { + h$ret1 = 0; + return self["onload"]; + }); +var h$webkit_dom_document_set_onmousedown; +h$webkit_dom_document_set_onmousedown = (function(self, + self_2, val, val_2) + { + self["onmousedown"] = val; + }); +var h$webkit_dom_document_get_onmousedown; +h$webkit_dom_document_get_onmousedown = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmousedown"]; + }); +var h$webkit_dom_document_set_onmousemove; +h$webkit_dom_document_set_onmousemove = (function(self, + self_2, val, val_2) + { + self["onmousemove"] = val; + }); +var h$webkit_dom_document_get_onmousemove; +h$webkit_dom_document_get_onmousemove = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmousemove"]; + }); +var h$webkit_dom_document_set_onmouseout; +h$webkit_dom_document_set_onmouseout = (function(self, + self_2, val, val_2) + { + self["onmouseout"] = val; + }); +var h$webkit_dom_document_get_onmouseout; +h$webkit_dom_document_get_onmouseout = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmouseout"]; + }); +var h$webkit_dom_document_set_onmouseover; +h$webkit_dom_document_set_onmouseover = (function(self, + self_2, val, val_2) + { + self["onmouseover"] = val; + }); +var h$webkit_dom_document_get_onmouseover; +h$webkit_dom_document_get_onmouseover = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmouseover"]; + }); +var h$webkit_dom_document_set_onmouseup; +h$webkit_dom_document_set_onmouseup = (function(self, + self_2, val, val_2) + { + self["onmouseup"] = val; + }); +var h$webkit_dom_document_get_onmouseup; +h$webkit_dom_document_get_onmouseup = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmouseup"]; + }); +var h$webkit_dom_document_set_onmousewheel; +h$webkit_dom_document_set_onmousewheel = (function(self, + self_2, val, val_2) + { + self["onmousewheel"] = val; + }); +var h$webkit_dom_document_get_onmousewheel; +h$webkit_dom_document_get_onmousewheel = (function(self, + self_2) + { + h$ret1 = 0; + return self["onmousewheel"]; + }); +var h$webkit_dom_document_set_onreadystatechange; +h$webkit_dom_document_set_onreadystatechange = (function(self, + self_2, val, val_2) + { + self["onreadystatechange"] = val; + }); +var h$webkit_dom_document_get_onreadystatechange; +h$webkit_dom_document_get_onreadystatechange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onreadystatechange"]; + }); +var h$webkit_dom_document_set_onscroll; +h$webkit_dom_document_set_onscroll = (function(self, + self_2, val, val_2) + { + self["onscroll"] = val; + }); +var h$webkit_dom_document_get_onscroll; +h$webkit_dom_document_get_onscroll = (function(self, + self_2) + { + h$ret1 = 0; + return self["onscroll"]; + }); +var h$webkit_dom_document_set_onselect; +h$webkit_dom_document_set_onselect = (function(self, + self_2, val, val_2) + { + self["onselect"] = val; + }); +var h$webkit_dom_document_get_onselect; +h$webkit_dom_document_get_onselect = (function(self, + self_2) + { + h$ret1 = 0; + return self["onselect"]; + }); +var h$webkit_dom_document_set_onsubmit; +h$webkit_dom_document_set_onsubmit = (function(self, + self_2, val, val_2) + { + self["onsubmit"] = val; + }); +var h$webkit_dom_document_get_onsubmit; +h$webkit_dom_document_get_onsubmit = (function(self, + self_2) + { + h$ret1 = 0; + return self["onsubmit"]; + }); +var h$webkit_dom_document_set_onbeforecut; +h$webkit_dom_document_set_onbeforecut = (function(self, + self_2, val, val_2) + { + self["onbeforecut"] = val; + }); +var h$webkit_dom_document_get_onbeforecut; +h$webkit_dom_document_get_onbeforecut = (function(self, + self_2) + { + h$ret1 = 0; + return self["onbeforecut"]; + }); +var h$webkit_dom_document_set_oncut; +h$webkit_dom_document_set_oncut = (function(self, + self_2, val, val_2) + { + self["oncut"] = val; + }); +var h$webkit_dom_document_get_oncut; +h$webkit_dom_document_get_oncut = (function(self, + self_2) + { + h$ret1 = 0; + return self["oncut"]; + }); +var h$webkit_dom_document_set_onbeforecopy; +h$webkit_dom_document_set_onbeforecopy = (function(self, + self_2, val, val_2) + { + self["onbeforecopy"] = val; + }); +var h$webkit_dom_document_get_onbeforecopy; +h$webkit_dom_document_get_onbeforecopy = (function(self, + self_2) + { + h$ret1 = 0; + return self["onbeforecopy"]; + }); +var h$webkit_dom_document_set_oncopy; +h$webkit_dom_document_set_oncopy = (function(self, + self_2, val, val_2) + { + self["oncopy"] = val; + }); +var h$webkit_dom_document_get_oncopy; +h$webkit_dom_document_get_oncopy = (function(self, + self_2) + { + h$ret1 = 0; + return self["oncopy"]; + }); +var h$webkit_dom_document_set_onbeforepaste; +h$webkit_dom_document_set_onbeforepaste = (function(self, + self_2, val, val_2) + { + self["onbeforepaste"] = val; + }); +var h$webkit_dom_document_get_onbeforepaste; +h$webkit_dom_document_get_onbeforepaste = (function(self, + self_2) + { + h$ret1 = 0; + return self["onbeforepaste"]; + }); +var h$webkit_dom_document_set_onpaste; +h$webkit_dom_document_set_onpaste = (function(self, + self_2, val, val_2) + { + self["onpaste"] = val; + }); +var h$webkit_dom_document_get_onpaste; +h$webkit_dom_document_get_onpaste = (function(self, + self_2) + { + h$ret1 = 0; + return self["onpaste"]; + }); +var h$webkit_dom_document_set_onreset; +h$webkit_dom_document_set_onreset = (function(self, + self_2, val, val_2) + { + self["onreset"] = val; + }); +var h$webkit_dom_document_get_onreset; +h$webkit_dom_document_get_onreset = (function(self, + self_2) + { + h$ret1 = 0; + return self["onreset"]; + }); +var h$webkit_dom_document_set_onsearch; +h$webkit_dom_document_set_onsearch = (function(self, + self_2, val, val_2) + { + self["onsearch"] = val; + }); +var h$webkit_dom_document_get_onsearch; +h$webkit_dom_document_get_onsearch = (function(self, + self_2) + { + h$ret1 = 0; + return self["onsearch"]; + }); +var h$webkit_dom_document_set_onselectstart; +h$webkit_dom_document_set_onselectstart = (function(self, + self_2, val, val_2) + { + self["onselectstart"] = val; + }); +var h$webkit_dom_document_get_onselectstart; +h$webkit_dom_document_get_onselectstart = (function(self, + self_2) + { + h$ret1 = 0; + return self["onselectstart"]; + }); +var h$webkit_dom_document_set_onselectionchange; +h$webkit_dom_document_set_onselectionchange = (function(self, + self_2, val, val_2) + { + self["onselectionchange"] = val; + }); +var h$webkit_dom_document_get_onselectionchange; +h$webkit_dom_document_get_onselectionchange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onselectionchange"]; + }); +var h$webkit_dom_document_set_ontouchstart; +h$webkit_dom_document_set_ontouchstart = (function(self, + self_2, val, val_2) + { + self["ontouchstart"] = val; + }); +var h$webkit_dom_document_get_ontouchstart; +h$webkit_dom_document_get_ontouchstart = (function(self, + self_2) + { + h$ret1 = 0; + return self["ontouchstart"]; + }); +var h$webkit_dom_document_set_ontouchmove; +h$webkit_dom_document_set_ontouchmove = (function(self, + self_2, val, val_2) + { + self["ontouchmove"] = val; + }); +var h$webkit_dom_document_get_ontouchmove; +h$webkit_dom_document_get_ontouchmove = (function(self, + self_2) + { + h$ret1 = 0; + return self["ontouchmove"]; + }); +var h$webkit_dom_document_set_ontouchend; +h$webkit_dom_document_set_ontouchend = (function(self, + self_2, val, val_2) + { + self["ontouchend"] = val; + }); +var h$webkit_dom_document_get_ontouchend; +h$webkit_dom_document_get_ontouchend = (function(self, + self_2) + { + h$ret1 = 0; + return self["ontouchend"]; + }); +var h$webkit_dom_document_set_ontouchcancel; +h$webkit_dom_document_set_ontouchcancel = (function(self, + self_2, val, val_2) + { + self["ontouchcancel"] = val; + }); +var h$webkit_dom_document_get_ontouchcancel; +h$webkit_dom_document_get_ontouchcancel = (function(self, + self_2) + { + h$ret1 = 0; + return self["ontouchcancel"]; + }); +var h$webkit_dom_document_set_onwebkitfullscreenchange; +h$webkit_dom_document_set_onwebkitfullscreenchange = (function(self, + self_2, val, val_2) + { + self["onwebkitfullscreenchange"] = val; + }); +var h$webkit_dom_document_get_onwebkitfullscreenchange; +h$webkit_dom_document_get_onwebkitfullscreenchange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onwebkitfullscreenchange"]; + }); +var h$webkit_dom_document_set_onwebkitfullscreenerror; +h$webkit_dom_document_set_onwebkitfullscreenerror = (function(self, + self_2, val, val_2) + { + self["onwebkitfullscreenerror"] = val; + }); +var h$webkit_dom_document_get_onwebkitfullscreenerror; +h$webkit_dom_document_get_onwebkitfullscreenerror = (function(self, + self_2) + { + h$ret1 = 0; + return self["onwebkitfullscreenerror"]; + }); +var h$webkit_dom_document_set_onwebkitpointerlockchange; +h$webkit_dom_document_set_onwebkitpointerlockchange = (function(self, + self_2, val, val_2) + { + self["onwebkitpointerlockchange"] = val; + }); +var h$webkit_dom_document_get_onwebkitpointerlockchange; +h$webkit_dom_document_get_onwebkitpointerlockchange = (function(self, + self_2) + { + h$ret1 = 0; + return self["onwebkitpointerlockchange"]; + }); +var h$webkit_dom_document_set_onwebkitpointerlockerror; +h$webkit_dom_document_set_onwebkitpointerlockerror = (function(self, + self_2, val, val_2) + { + self["onwebkitpointerlockerror"] = val; + }); +var h$webkit_dom_document_get_onwebkitpointerlockerror; +h$webkit_dom_document_get_onwebkitpointerlockerror = (function(self, + self_2) + { + h$ret1 = 0; + return self["onwebkitpointerlockerror"]; + }); +var h$webkit_dom_document_get_webkit_visibility_state; +h$webkit_dom_document_get_webkit_visibility_state = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["webkitVisibilityState"]); + }); +var h$webkit_dom_document_get_webkit_hidden; +h$webkit_dom_document_get_webkit_hidden = (function(self, + self_2) + { + return self["webkitHidden"]; + }); +var h$webkit_dom_document_get_security_policy; +h$webkit_dom_document_get_security_policy = (function(self, + self_2) + { + h$ret1 = 0; + return self["SecurityPolicy"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Css +h$webkit_dom_css_value_get_type = (function() + { + return h$g_get_type(CSSValue); + }); +var h$webkit_dom_css_value_set_css_text; +h$webkit_dom_css_value_set_css_text = (function(self, + self_2, val, val_2) + { + self["cssText"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_css_value_get_css_text; +h$webkit_dom_css_value_get_css_text = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["cssText"]); + }); +var h$webkit_dom_css_value_get_css_value_type; +h$webkit_dom_css_value_get_css_value_type = (function(self, + self_2) + { + return self["cssValueType"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Css +h$webkit_dom_css_style_sheet_get_type = (function() + { + return h$g_get_type(CSSStyleSheet); + }); +var h$webkit_dom_css_style_sheet_insert_rule; +h$webkit_dom_css_style_sheet_insert_rule = (function(self, + self_2, rule, rule_2, index) + { + return self["insertRule"](h$decodeUtf8z(rule, + rule_2), index); + }); +var h$webkit_dom_css_style_sheet_delete_rule; +h$webkit_dom_css_style_sheet_delete_rule = (function(self, + self_2, index) + { + return self["deleteRule"](index); + }); +var h$webkit_dom_css_style_sheet_add_rule; +h$webkit_dom_css_style_sheet_add_rule = (function(self, + self_2, selector, selector_2, + style, style_2, index) + { + return self["addRule"](h$decodeUtf8z(selector, + selector_2), + h$decodeUtf8z(style, style_2), + index); + }); +var h$webkit_dom_css_style_sheet_remove_rule; +h$webkit_dom_css_style_sheet_remove_rule = (function(self, + self_2, index) + { + return self["removeRule"](index); + }); +var h$webkit_dom_css_style_sheet_get_owner_rule; +h$webkit_dom_css_style_sheet_get_owner_rule = (function(self, + self_2) + { + h$ret1 = 0; + return self["ownerRule"]; + }); +var h$webkit_dom_css_style_sheet_get_css_rules; +h$webkit_dom_css_style_sheet_get_css_rules = (function(self, + self_2) + { + h$ret1 = 0; + return self["cssRules"]; + }); +var h$webkit_dom_css_style_sheet_get_rules; +h$webkit_dom_css_style_sheet_get_rules = (function(self, + self_2) + { + h$ret1 = 0; + return self["rules"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Css +h$webkit_dom_css_style_declaration_get_type = (function() + { + return h$g_get_type(CSSStyleDeclaration); + }); +var h$webkit_dom_css_style_declaration_get_property_value; +h$webkit_dom_css_style_declaration_get_property_value = (function(self, + self_2, propertyName, + propertyName_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["getPropertyValue"](h$decodeUtf8z(propertyName, + propertyName_2))); + }); +var h$webkit_dom_css_style_declaration_get_property_css_value; +h$webkit_dom_css_style_declaration_get_property_css_value = (function(self, + self_2, + propertyName, + propertyName_2) + { + h$ret1 = 0; + return self["getPropertyCSSValue"](h$decodeUtf8z(propertyName, + propertyName_2)); + }); +var h$webkit_dom_css_style_declaration_remove_property; +h$webkit_dom_css_style_declaration_remove_property = (function(self, + self_2, propertyName, + propertyName_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["removeProperty"](h$decodeUtf8z(propertyName, + propertyName_2))); + }); +var h$webkit_dom_css_style_declaration_get_property_priority; +h$webkit_dom_css_style_declaration_get_property_priority = (function(self, + self_2, + propertyName, + propertyName_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["getPropertyPriority"](h$decodeUtf8z(propertyName, + propertyName_2))); + }); +var h$webkit_dom_css_style_declaration_set_property; +h$webkit_dom_css_style_declaration_set_property = (function(self, + self_2, propertyName, + propertyName_2, value, + value_2, priority, + priority_2) + { + return self["setProperty"](h$decodeUtf8z(propertyName, + propertyName_2), + h$decodeUtf8z(value, + value_2), + h$decodeUtf8z(priority, + priority_2)); + }); +var h$webkit_dom_css_style_declaration_item; +h$webkit_dom_css_style_declaration_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return h$encodeUtf8(self["item"](index)); + }); +var h$webkit_dom_css_style_declaration_get_property_shorthand; +h$webkit_dom_css_style_declaration_get_property_shorthand = (function(self, + self_2, + propertyName, + propertyName_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["getPropertyShorthand"](h$decodeUtf8z(propertyName, + propertyName_2))); + }); +var h$webkit_dom_css_style_declaration_is_property_implicit; +h$webkit_dom_css_style_declaration_is_property_implicit = (function(self, + self_2, propertyName, + propertyName_2) + { + return self["isPropertyImplicit"](h$decodeUtf8z(propertyName, + propertyName_2)); + }); +var h$webkit_dom_css_style_declaration_set_css_text; +h$webkit_dom_css_style_declaration_set_css_text = (function(self, + self_2, val, val_2) + { + self["cssText"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_css_style_declaration_get_css_text; +h$webkit_dom_css_style_declaration_get_css_text = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["cssText"]); + }); +var h$webkit_dom_css_style_declaration_get_length; +h$webkit_dom_css_style_declaration_get_length = (function(self, + self_2) + { + return self["length"]; + }); +var h$webkit_dom_css_style_declaration_get_parent_rule; +h$webkit_dom_css_style_declaration_get_parent_rule = (function(self, + self_2) + { + h$ret1 = 0; + return self["parentRule"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Css +h$webkit_dom_css_rule_list_get_type = (function() + { + return h$g_get_type(CSSRuleList); + }); +var h$webkit_dom_css_rule_list_item; +h$webkit_dom_css_rule_list_item = (function(self, + self_2, index) + { + h$ret1 = 0; + return self["item"](index); + }); +var h$webkit_dom_css_rule_list_get_length; +h$webkit_dom_css_rule_list_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Css +h$webkit_dom_css_rule_get_type = (function() + { + return h$g_get_type(CSSRule); + }); +var h$webkit_dom_css_rule_set_css_text; +h$webkit_dom_css_rule_set_css_text = (function(self, + self_2, val, val_2) + { + self["cssText"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_css_rule_get_css_text; +h$webkit_dom_css_rule_get_css_text = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["cssText"]); + }); +var h$webkit_dom_css_rule_get_parent_style_sheet; +h$webkit_dom_css_rule_get_parent_style_sheet = (function(self, + self_2) + { + h$ret1 = 0; + return self["parentStyleSheet"]; + }); +var h$webkit_dom_css_rule_get_parent_rule; +h$webkit_dom_css_rule_get_parent_rule = (function(self, + self_2) + { + h$ret1 = 0; + return self["parentRule"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Window +h$webkit_dom_console_get_type = (function() + { + return h$g_get_type(Console); + }); +var h$webkit_dom_console_time; +h$webkit_dom_console_time = (function(self, + self_2, title, title_2) + { + return self["time"](h$decodeUtf8z(title, + title_2)); + }); +var h$webkit_dom_console_group_end; +h$webkit_dom_console_group_end = (function(self, + self_2) + { + return self["groupEnd"](); + }); +var h$webkit_dom_console_get_memory; +h$webkit_dom_console_get_memory = (function(self, + self_2) + { + h$ret1 = 0; + return self["memory"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_comment_get_type = (function() + { + return h$g_get_type(Comment); + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_character_data_get_type = (function() + { + return h$g_get_type(CharacterData); + }); +var h$webkit_dom_character_data_substring_data; +h$webkit_dom_character_data_substring_data = (function(self, + self_2, offset, length) + { + h$ret1 = 0; + return h$encodeUtf8(self["substringData"](offset, + length)); + }); +var h$webkit_dom_character_data_append_data; +h$webkit_dom_character_data_append_data = (function(self, + self_2, data, data_2) + { + return self["appendData"](h$decodeUtf8z(data, + data_2)); + }); +var h$webkit_dom_character_data_insert_data; +h$webkit_dom_character_data_insert_data = (function(self, + self_2, offset, data, data_2) + { + return self["insertData"](offset, + h$decodeUtf8z(data, data_2)); + }); +var h$webkit_dom_character_data_delete_data; +h$webkit_dom_character_data_delete_data = (function(self, + self_2, offset, length) + { + return self["deleteData"](offset, + length); + }); +var h$webkit_dom_character_data_replace_data; +h$webkit_dom_character_data_replace_data = (function(self, + self_2, offset, length, data, + data_2) + { + return self["replaceData"](offset, + length, h$decodeUtf8z(data, + data_2)); + }); +var h$webkit_dom_character_data_set_data; +h$webkit_dom_character_data_set_data = (function(self, + self_2, val, val_2) + { + self["data"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_character_data_get_data; +h$webkit_dom_character_data_get_data = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["data"]); + }); +var h$webkit_dom_character_data_get_length; +h$webkit_dom_character_data_get_length = (function(self, + self_2) + { + return self["length"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_cdata_section_get_type = (function() + { + return h$g_get_type(CDATASection); + }); +// Graphics.UI.Gtk.WebKit.DOM.Html +h$webkit_dom_blob_get_type = (function() + { + return h$g_get_type(Blob); + }); +var h$webkit_dom_blob_get_size; +h$webkit_dom_blob_get_size = (function(self, + self_2) + { + return self["size"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Window +h$webkit_dom_bar_info_get_type = (function() + { + return h$g_get_type(BarInfo); + }); +var h$webkit_dom_bar_info_get_visible; +h$webkit_dom_bar_info_get_visible = (function(self, + self_2) + { + return self["visible"]; + }); +// Graphics.UI.Gtk.WebKit.DOM.Core +h$webkit_dom_attr_get_type = (function() + { + return h$g_get_type(Attr); + }); +var h$webkit_dom_attr_get_name; +h$webkit_dom_attr_get_name = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["name"]); + }); +var h$webkit_dom_attr_get_specified; +h$webkit_dom_attr_get_specified = (function(self, + self_2) + { + return self["specified"]; + }); +var h$webkit_dom_attr_set_value; +h$webkit_dom_attr_set_value = (function(self, + self_2, val, val_2) + { + self["value"] = h$decodeUtf8z(val, + val_2); + }); +var h$webkit_dom_attr_get_value; +h$webkit_dom_attr_get_value = (function(self, + self_2) + { + h$ret1 = 0; + return h$encodeUtf8(self["value"]); + }); +var h$webkit_dom_attr_get_owner_element; +h$webkit_dom_attr_get_owner_element = (function(self, + self_2) + { + h$ret1 = 0; + return self["ownerElement"]; + }); +var h$webkit_dom_attr_get_is_id; +h$webkit_dom_attr_get_is_id = (function(self, + self_2) + { + return self["isId"]; + }); diff --git a/lib/boot/shims/pkg/webkit-javascriptcore.js b/lib/boot/shims/pkg/webkit-javascriptcore.js new file mode 100644 index 00000000..0e231081 --- /dev/null +++ b/lib/boot/shims/pkg/webkit-javascriptcore.js @@ -0,0 +1,210 @@ +h$SystemziGlibziMainLoop_df30 = function () {} +h$LanguageziJavascriptziJSCziObject_dbwE = function () {} +h$LanguageziJavascriptziJSCziObject_dnMr = function () {}; +h$LanguageziJavascriptziJSCziObject_dnMu = function () {}; + +function h$JSContextGetGlobalObject(ctx) { + return ctx; +}; +function h$JSObjectGetProperty(ctx, ctx_2, this_, this_2, name, name_2, pexception, pexception_2) { + try { + return this_[name]; + } + catch(e) { + pexception.arr[pexception_2] = [e, 0]; + } +}; +function h$JSObjectGetPropertyAtIndex(ctx, ctx_2, this_, this_2, n, pexception, pexception_2) { + try { + return this_[n]; + } + catch(e) { + pexception.arr[pexception_2] = [e, 0]; + } +}; +function h$JSObjectSetProperty(ctx, ctx_2, this_, this_2, name, name_2, value, value_2, attrs, attrs_2, pexception, pexception_2) { + try { + this_[name] = value; + } + catch(e) { + pexception.arr[pexception_2] = [e, 0]; + } +}; +function h$JSObjectSetPropertyAtIndex(ctx, ctx_2, this_, this_2, n, value, value_2, attrs, attrs_2, pexception, pexception_2) { + try { + this_[n] = value; + } + catch(e) { + pexception.arr[pexception_2] = [e, 0]; + } +}; +function h$JSObjectMakeFunctionWithCallback(ctx, ctx_2, name, name_2, callback, callback_2) { + var f = function() { + var argv = h$malloc(arguments.length<<2); + argv.arr = []; + for(var i = 0; i != arguments.length; ++i) + argv.arr[i<<2] = [arguments[i],0]; + var ex = h$malloc(4); + ex.arr = [[null,0]]; + h$runSync(h$c3(h$ap2_e, + h$c6(h$pap_4, + callback.arr[callback_2], + 2, + h$mkPtr(ctx, ctx_2), + h$mkPtr(f, 0), + h$mkPtr(this, 0), + arguments.length), + h$mkPtr(argv,0), + h$mkPtr(ex,0)), true); + var e = ex.arr[0][0]; + if(e !== null) throw e; + } + + return f; +}; +function h$JSObjectCallAsFunction(ctx, ctx_2, f, f_2, this_, this_2, argc, argv, argv_2, pexception, pexception_2) { + try { + var a = []; + for(var i = 0; i != argc; i++) { + a[i] = argv.arr[argv_2+(i<<2)][0]; + } + return f.apply(this_, a); + } + catch(e) { + pexception.arr[pexception_2] = [e, 0]; + } +}; +function h$JSObjectCallAsConstructor(ctx, ctx_2, f, f_2, argc, argv, argv_2, pexception, pexception_2) { + try { + var a = []; + for(var i = 0; i != argc; i++) { + a[i] = argv.arr[argv_2+(i<<2)][0]; + } + switch(argc) { + case 0 : return new f();break; + case 1 : return new f(a[0]);break; + case 2 : return new f(a[0],a[1]);break; + case 3 : return new f(a[0],a[1],a[2]);break; + case 4 : return new f(a[0],a[1],a[2],a[3]);break; + case 5 : return new f(a[0],a[1],a[2],a[3],a[4]);break; + case 6 : return new f(a[0],a[1],a[2],a[3],a[4],a[5]);break; + case 7 : return new f(a[0],a[1],a[2],a[3],a[4],a[5],a[6]);break; + default: + var ret; + var temp = function() { + ret = f.apply(this, a.slice(0, argc)); + }; + temp.prototype = f.prototype; + var instance = new temp(); + if (ret instanceof Object) + return ret; + instance.constructor = f; + return instance; + } + } + catch(e) { + pexception.arr[pexception_2] = [e, 0]; + } +}; +function h$JSObjectMakeArray(ctx, ctx_2, l, p, p_2, pexception, pexception_2) { + try { + var a = []; + for(var i = 0; i != l; i++) { + a[i] = p.arr[p_2+(i<<2)][0]; + } + return a; + } + catch(e) { + pexception.arr[pexception_2] = [e, 0]; + } +}; +function h$JSValueGetType(ctx, ctx_2, v, v_2) { + if(v === undefined) return 0; + if(v === null) return 1; + if(typeof v === "boolean") return 2; + if(typeof v === "number") return 3; + if(typeof v === "string") return 4; + if(typeof v === "object") return 5; +}; +function h$JSStringCreateWithCharacters(p, p_2, len) { + return h$decodeUtf16l(p, len << 1, p_2); +}; +function h$JSStringCreateWithUTF8CString(p) { + return h$decodeUtf8z(p, p_2); +}; +function h$JSValueMakeBoolean(ctx, b) { + return b !== 0; +}; +function h$JSValueMakeFromJSONString(ctx, ctx_2, string, string_2) { + try { + return ctx.JSON.parse(string); + } + catch(e) { + return null; + } +}; +function h$JSValueMakeNull(ctx, ctx_2) { + return null; +}; +function h$JSValueMakeNumber(ctx, ctx_2, n) { + return n; +}; +function h$JSValueMakeString(ctx, ctx_2, s, s_2) { + return s; +}; +function h$JSValueMakeUndefined(ctx, ctx_2) { + return undefined; +}; +function h$JSValueProtect(ctx, ctx_2, v, v_2) { +}; +function h$JSValueUnprotect(ctx, ctx_2, v, v_2) { +}; +function h$JSValueToBoolean(ctx, ctx_2, v, v_2) { + return v?1:0; +}; +function h$JSValueToBoolean(ctx, ctx_2, v, v_2) { + return v?1:0; +}; +function h$JSValueToNumber(ctx, ctx_2, v, v_2, e, e_2) { + return Number(v); +}; +function h$JSValueToObject(ctx, ctx_2, v, v_2, e, e_2) { + return v; +}; +function h$JSValueToStringCopy(ctx, ctx_2, v, v_2, e, e_2) { + return v.toString(); +}; +function h$JSStringIsEqual(a, a_2, b, b_2) { + return a == b?1:0; +}; +function h$JSStringIsStrictEqual(a, a_2, b, b_2) { + return a === b?1:0; +}; +function h$JSStringGetLength(s, s_2) { + return s.length; +}; +function h$JSStringGetCharactersPtr(s, s_2) { + return h$encodeUtf16(s); +}; +function h$JSEvaluateScript(ctx, ctx_2, script, script_2, thisObject, thisObject_2, sourceURL, sourceURL_2, startingLineNumber, exception, exception_2) { + return eval(script); +}; +function h$JSValueIsUndefined(ctx, v) { + return v === undefined?1:0; +}; +function h$JSValueIsNull(ctx, v) { + return v === null?1:0; +}; +function h$JSValueIsBoolean(ctx, v) { + return typeof v === "boolean"?1:0; +}; +function h$JSValueIsNumber(ctx, v) { + return typeof v === "number"?1:0; +}; +function h$JSValueIsString(ctx, v) { + return typeof v === "string"?1:0; +}; +function h$JSValueIsObject(ctx, v) { + return typeof v === "object"?1:0; +}; + diff --git a/lib/boot/shims/pkg/webkit.js b/lib/boot/shims/pkg/webkit.js new file mode 100644 index 00000000..6e8746e3 --- /dev/null +++ b/lib/boot/shims/pkg/webkit.js @@ -0,0 +1,19 @@ +function h$webkit_web_view_get_dom_document(w, w_2) { + h$ret1 = 0 + return w.document; +}; +function h$webkit_web_view_get_main_frame(w, w_2) { + h$ret1 = 0; + return w; +}; +function h$webkit_web_frame_get_global_context(f, f_2) { + h$ret1 = 0; + return f; +}; +function h$webkit_dom_event_target_add_event_listener_closure(obj, obj_2, eventName, eventName_2, f, f_2, bubble) { + obj.addEventListener(h$decodeUtf8z(eventName, eventName_2), function(e) { + h$run(h$c3(h$ap2_e, f.arr[0], h$mkPtr(obj, obj_2), h$mkPtr(e,0))); + }); + return 1; +}; + diff --git a/lib/boot/shims/primitive.yaml b/lib/boot/shims/primitive.yaml new file mode 100644 index 00000000..fea3e977 --- /dev/null +++ b/lib/boot/shims/primitive.yaml @@ -0,0 +1,2 @@ +js: + - pkg/primitive.js \ No newline at end of file diff --git a/lib/boot/shims/process.yaml b/lib/boot/shims/process.yaml new file mode 100644 index 00000000..9435482a --- /dev/null +++ b/lib/boot/shims/process.yaml @@ -0,0 +1,3 @@ +version: 1.2.0.0 .. +js: + - pkg/process.js diff --git a/lib/boot/shims/rts.yaml b/lib/boot/shims/rts.yaml new file mode 100644 index 00000000..18392166 --- /dev/null +++ b/lib/boot/shims/rts.yaml @@ -0,0 +1,21 @@ +js: + - src/platform.js + - src/goog.js + - lib/typedarray/typedarray.js + - lib/setImmediate/setImmediate.js + - lib/closure-library/closure/goog/math/long.js + - src/structs.js + - src/mem.js + - src/gc.js + - src/errno.js + - src/md5.js + - src/arith.js + - src/unicode.js + - src/string.js + - src/environment.js + - src/enum.js + - src/weak.js + - src/thread.js + - src/stm.js + - src/staticpointer.js + - src/hscore.js diff --git a/lib/boot/shims/rts_js_debug_p.yaml b/lib/boot/shims/rts_js_debug_p.yaml new file mode 100644 index 00000000..9560c03e --- /dev/null +++ b/lib/boot/shims/rts_js_debug_p.yaml @@ -0,0 +1,2 @@ +js: + - src/profiling.js diff --git a/lib/boot/shims/rts_js_p.yaml b/lib/boot/shims/rts_js_p.yaml new file mode 100644 index 00000000..9560c03e --- /dev/null +++ b/lib/boot/shims/rts_js_p.yaml @@ -0,0 +1,2 @@ +js: + - src/profiling.js diff --git a/lib/boot/shims/src/arith.js b/lib/boot/shims/src/arith.js new file mode 100644 index 00000000..c10679fd --- /dev/null +++ b/lib/boot/shims/src/arith.js @@ -0,0 +1,569 @@ +#include + +// #define GHCJS_TRACE_ARITH 1 + +#ifdef GHCJS_TRACE_ARITH +function h$logArith() { h$log.apply(h$log,arguments); } +#define TRACE_ARITH(args...) h$logArith(args) +#else +#define TRACE_ARITH(args...) +#endif + +function h$hs_eqWord64(a1,a2,b1,b2) { + return (a1===b1 && a2===b2) ? 1 : 0; +} + +function h$hs_neWord64(a1,a2,b1,b2) { + return (a1 !== b1 || a2 !== b2) ? 1 : 0; +} + +function h$hs_word64ToWord(a1,a2) { + return a2; +} + +function h$hs_wordToWord64(w) { + RETURN_UBX_TUP2(0, w); +} + +function h$hs_intToInt64(a) { + RETURN_UBX_TUP2((a < 0) ? -1 : 0, a); +} + +function h$hs_int64ToWord64(a1,a2) { + RETURN_UBX_TUP2(a1, a2); +} + +function h$hs_word64ToInt64(a1,a2) { + RETURN_UBX_TUP2(a1, a2); +} + +function h$hs_int64ToInt(a1,a2) { + return a2; +} + +function h$hs_negateInt64(a1,a2) { + var c = goog.math.Long.fromBits(a2,a1).negate(); + RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits()); +} + +function h$hs_not64(a1,a2) { + RETURN_UBX_TUP2(~a1, ~a2); +} + +function h$hs_xor64(a1,a2,b1,b2) { + RETURN_UBX_TUP2(a1 ^ b1, a2 ^ b2); +} + +function h$hs_and64(a1,a2,b1,b2) { + RETURN_UBX_TUP2(a1 & b1, a2 & b2); +} + +function h$hs_or64(a1,a2,b1,b2) { + RETURN_UBX_TUP2(a1 | b1, a2 | b2); +} + +function h$hs_eqInt64(a1,a2,b1,b2) { + return (a1 === b1 && a2 === b2) ? 1 : 0; +} + +function h$hs_neInt64(a1,a2,b1,b2) { + return (a1 !== b1 || a2 !== b2) ? 1 : 0; +} + +function h$hs_leInt64(a1,a2,b1,b2) { + if(a1 === b1) { + var a2s = a2 >>> 1; + var b2s = b2 >>> 1; + return (a2s < b2s || (a2s === b2s && ((a2&1) <= (b2&1)))) ? 1 : 0; + } else { + return (a1 < b1) ? 1 : 0; + } +} + +function h$hs_ltInt64(a1,a2,b1,b2) { + if(a1 === b1) { + var a2s = a2 >>> 1; + var b2s = b2 >>> 1; + return (a2s < b2s || (a2s === b2s && ((a2&1) < (b2&1)))) ? 1 : 0; + } else { + return (a1 < b1) ? 1 : 0; + } +} + +function h$hs_geInt64(a1,a2,b1,b2) { + if(a1 === b1) { + var a2s = a2 >>> 1; + var b2s = b2 >>> 1; + return (a2s > b2s || (a2s === b2s && ((a2&1) >= (b2&1)))) ? 1 : 0; + } else { + return (a1 > b1) ? 1 : 0; + } +} + +function h$hs_gtInt64(a1,a2,b1,b2) { + if(a1 === b1) { + var a2s = a2 >>> 1; + var b2s = b2 >>> 1; + return (a2s > b2s || (a2s === b2s && ((a2&1) > (b2&1)))) ? 1 : 0; + } else { + return (a1 > b1) ? 1 : 0; + } +} + +function h$hs_quotWord64(a1,a2,b1,b2) { + // var a = h$ghcjsbn_mkBigNat_ww(a1,a2); // bigFromWord64(a1,a2); + // var b = h$ghcjsbn_mkBigNat_ww(b1,b2); // bigFromWord64(b1,b2); + var q = h$ghcjsbn_quot_bb(h$ghcjsbn_mkBigNat_ww(a1,a2), + h$ghcjsbn_mkBigNat_ww(b1,b2)); + return h$ghcjsbn_toWord64_b(q); // this should return the tuple + //RETURN_UBX_TUP2(h$ghcjsbn_toWord_b(h$ghcjsbn_shr_b(q, 32)) + // a.divide(b); + // RETURN_UBX_TUP2(c.shiftRight(32).intValue(), c.intValue()); +} + +function h$hs_timesInt64(a1,a2,b1,b2) { + var c = goog.math.Long.fromBits(a2,a1).multiply(goog.math.Long.fromBits(b2,b1)); + RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits()); +} + +function h$hs_quotInt64(a1,a2,b1,b2) { + var c = goog.math.Long.fromBits(a2,a1).div(goog.math.Long.fromBits(b2,b1)); + RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits()); +} + +function h$hs_remInt64(a1,a2,b1,b2) { + var c = goog.math.Long.fromBits(a2,a1).modulo(goog.math.Long.fromBits(b2,b1)); + RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits()); +} + +function h$hs_plusInt64(a1,a2,b1,b2) { + var c = goog.math.Long.fromBits(a2,a1).add(goog.math.Long.fromBits(b2,b1)); + RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits()); +} + +function h$hs_minusInt64(a1,a2,b1,b2) { + var c = goog.math.Long.fromBits(a2,a1).subtract(goog.math.Long.fromBits(b2,b1)); + RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits()); +} + +function h$hs_leWord64(a1,a2,b1,b2) { + if(a1 === b1) { + var a2s = a2 >>> 1; + var b2s = b2 >>> 1; + return (a2s < b2s || (a2s === b2s && ((a2&1) <= (b2&1)))) ? 1 : 0; + } else { + var a1s = a1 >>> 1; + var b1s = b1 >>> 1; + return (a1s < b1s || (a1s === b1s && ((a1&1) <= (b1&1)))) ? 1 : 0; + } +} + +function h$hs_ltWord64(a1,a2,b1,b2) { + if(a1 === b1) { + var a2s = a2 >>> 1; + var b2s = b2 >>> 1; + return (a2s < b2s || (a2s === b2s && ((a2&1) < (b2&1)))) ? 1 : 0; + } else { + var a1s = a1 >>> 1; + var b1s = b1 >>> 1; + return (a1s < b1s || (a1s === b1s && ((a1&1) < (b1&1)))) ? 1 : 0; + } +} + +function h$hs_geWord64(a1,a2,b1,b2) { + if(a1 === b1) { + var a2s = a2 >>> 1; + var b2s = b2 >>> 1; + return (a2s > b2s || (a2s === b2s && ((a2&1) >= (b2&1)))) ? 1 : 0; + } else { + var a1s = a1 >>> 1; + var b1s = b1 >>> 1; + return (a1s > b1s || (a1s === b1s && ((a1&1) >= (b1&1)))) ? 1 : 0; + } +} + +function h$hs_gtWord64(a1,a2,b1,b2) { + if(a1 === b1) { + var a2s = a2 >>> 1; + var b2s = b2 >>> 1; + return (a2s > b2s || (a2s === b2s && ((a2&1) > (b2&1)))) ? 1 : 0; + } else { + var a1s = a1 >>> 1; + var b1s = b1 >>> 1; + return (a1s > b1s || (a1s === b1s && ((a1&1) > (b1&1)))) ? 1 : 0; + } +} + +function h$hs_remWord64(a1,a2,b1,b2) { + /* var a = h$bigFromWord64(a1,a2); + var b = h$bigFromWord64(b1,b2); + var c = a.mod(b); */ + var r = h$ghcjsbn_rem_bb(h$ghcjsbn_mkBigNat_ww(a1,a2) + ,h$ghcjsbn_mkBigNat_ww(b1,b2)); + return h$ghcjsbn_toWord64_b(r); + // RETURN_UBX_TUP2(c.shiftRight(32).intValue(), c.intValue()); +} + +function h$hs_uncheckedIShiftL64(a1,a2,n) { + TRACE_ARITH("hs_uncheckedIShiftL64 " + a1 + " " + a2 + " " + n); + var num = new goog.math.Long(a2,a1).shiftLeft(n); + TRACE_ARITH("hs_uncheckedIShiftL64 result " + num.getHighBits() + " " + num.getLowBits()); + RETURN_UBX_TUP2(num.getHighBits(), num.getLowBits()); +} + +function h$hs_uncheckedIShiftRA64(a1,a2,n) { + TRACE_ARITH("hs_uncheckedShiftRA64 " + a1 + " " + a2 + " " + n); + var num = new goog.math.Long(a2,a1).shiftRight(n); + RETURN_UBX_TUP2(num.getHighBits(), num.getLowBits()); +} + +// always nonnegative n? +function h$hs_uncheckedShiftL64(a1,a2,n) { + TRACE_ARITH("hs_uncheckedShiftL64 " + a1 + " " + a2 + " " + n); + n &= 63; + TRACE_ARITH("hs_uncheckedShiftL64 n " + n); + if(n == 0) { + TRACE_ARITH("hs_uncheckedShiftL64 zero"); + RETURN_UBX_TUP2(a1, a2); + } else if(n < 32) { + TRACE_ARITH("hs_uncheckedShiftL64 sm32"); + RETURN_UBX_TUP2((a1 << n) | (a2 >>> (32-n)), a2 << n); + } else { + TRACE_ARITH("hs_uncheckedShiftL64 result " + ((a2 << (n-32))|0) + " " + 0); + RETURN_UBX_TUP2(((a2 << (n-32))|0), 0); + } +} + +function h$hs_uncheckedShiftRL64(a1,a2,n) { + TRACE_ARITH("hs_uncheckedShiftRL64 " + a1 + " " + a2 + " " + n); + n &= 63; + if(n == 0) { + RETURN_UBX_TUP2(a1, a2); + } else if(n < 32) { + RETURN_UBX_TUP2(a1 >>> n, (a2 >>> n ) | (a1 << (32-n))); + } else { + RETURN_UBX_TUP2(0, (a1 >>> (n-32))|0); + } +} + +// fixme this function appears to deoptimize a lot due to smallint overflows +function h$imul_shim(a, b) { + var ah = (a >>> 16) & 0xffff; + var al = a & 0xffff; + var bh = (b >>> 16) & 0xffff; + var bl = b & 0xffff; + // the shift by 0 fixes the sign on the high part + // the final |0 converts the unsigned value into a signed value + return (((al * bl)|0) + (((ah * bl + al * bh) << 16) >>> 0)|0); +} + +var h$mulInt32 = Math.imul ? Math.imul : h$imul_shim; + +// function h$mulInt32(a,b) { +// return goog.math.Long.fromInt(a).multiply(goog.math.Long.fromInt(b)).getLowBits(); +// } +// var hs_mulInt32 = h$mulInt32; + +function h$mulWord32(a,b) { + return goog.math.Long.fromBits(a,0).multiply(goog.math.Long.fromBits(b,0)).getLowBits(); +} + +function h$mul2Word32(a,b) { + var c = goog.math.Long.fromBits(a,0).multiply(goog.math.Long.fromBits(b,0)); + RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits()); +} + +function h$quotWord32(a,b) { + return goog.math.Long.fromBits(a,0).div(goog.math.Long.fromBits(b,0)).getLowBits(); +} + +function h$remWord32(a,b) { + return goog.math.Long.fromBits(a,0).modulo(goog.math.Long.fromBits(b,0)).getLowBits(); +} + +function h$quotRem2Word32(a1,a2,b) { +/* var a = h$bigFromWord64(a1,a2); + var b = h$bigFromWord(b); + var d = a.divide(b); */ + /* var a = h$ghcjsbn_mkBigNat_ww(a1,a2); + var b = h$ghcjsbn_mkBigNat_w(b); */ + var q = [], r = []; + h$ghcjsbn_quotRem_bb(q,r,h$ghcjsbn_mkBigNat_ww(a1,a2),h$ghcjsbn_mkBigNat_w(b)); + RETURN_UBX_TUP2(h$ghcjsbn_toWord_b(q), h$ghcjsbn_toWord_b(r)); + // RETURN_UBX_TUP2(d.intValue(), a.subtract(b.multiply(d)).intValue()); +} + +function h$wordAdd2(a,b) { + var c = goog.math.Long.fromBits(a,0).add(goog.math.Long.fromBits(b,0)); + RETURN_UBX_TUP2(c.getHighBits(), c.getLowBits()); +} + +// this does an unsigned shift, is that ok? +function h$uncheckedShiftRL64(a1,a2,n) { + if(n < 0) throw "unexpected right shift"; + n &= 63; + if(n == 0) { + RETURN_UBX_TUP2(a1, a2); + } else if(n < 32) { + RETURN_UBX_TUP2((a1 >>> n), (a2 >>> n) | (a1 << (32 - n))); + } else { + RETURN_UBX_TUP2(0, a2 >>> (n - 32)); + } +} + +function h$isDoubleNegativeZero(d) { + TRACE_ARITH("isDoubleNegativeZero: " + d); + return (d===0 && (1/d) === -Infinity) ? 1 : 0; +} + +function h$isFloatNegativeZero(d) { + TRACE_ARITH("isFloatNegativeZero: " + d); + return (d===0 && (1/d) === -Infinity) ? 1 : 0; +} + +function h$isDoubleInfinite(d) { + return (d === Number.NEGATIVE_INFINITY || d === Number.POSITIVE_INFINITY) ? 1 : 0; +} + +function h$isFloatInfinite(d) { + return (d === Number.NEGATIVE_INFINITY || d === Number.POSITIVE_INFINITY) ? 1 : 0; +} + +function h$isFloatFinite(d) { + return (d !== Number.NEGATIVE_INFINITY && d !== Number.POSITIVE_INFINITY && !isNaN(d)) ? 1 : 0; +} + +function h$isDoubleFinite(d) { + return (d !== Number.NEGATIVE_INFINITY && d !== Number.POSITIVE_INFINITY && !isNaN(d)) ? 1 : 0; +} + +function h$isDoubleNaN(d) { + return (isNaN(d)) ? 1 : 0; +} + +function h$isFloatNaN(d) { + return (isNaN(d)) ? 1 : 0; +} + +function h$isDoubleDenormalized(d) { + return (d !== 0 && Math.abs(d) < 2.2250738585072014e-308) ? 1 : 0; +} + +function h$isFloatDenormalized(d) { + return (d !== 0 && Math.abs(d) < 2.2250738585072014e-308) ? 1 : 0; +} + +var h$convertBuffer = new ArrayBuffer(8); +var h$convertDouble = new Float64Array(h$convertBuffer); +var h$convertFloat = new Float32Array(h$convertBuffer); +var h$convertInt = new Int32Array(h$convertBuffer); + +// use direct inspection through typed array for decoding floating point numbers if this test gives +// the expected answer. fixme: does this test catch all non-ieee or weird endianness situations? +h$convertFloat[0] = 0.75; +// h$convertFloat[0] = 1/0; // to force using fallbacks +var h$decodeFloatInt = h$convertInt[0] === 1061158912 ? h$decodeFloatIntArray : h$decodeFloatIntFallback; +var h$decodeDouble2Int = h$convertInt[0] === 1061158912 ? h$decodeDouble2IntArray : h$decodeDouble2IntFallback; + +function h$decodeFloatIntArray(d) { + TRACE_ARITH("decodeFloatIntArray: " + d); + if(isNaN(d)) { + RETURN_UBX_TUP2(-12582912, 105); + } + h$convertFloat[0] = d; + var i = h$convertInt[0]; + var exp = (i >> 23) & 0xff; + var sgn = 2 * (i >> 31) + 1; + var s = i&8388607; + if(exp === 0) { // zero or denormal + if(s === 0) { + TRACE_ARITH("decodeFloatIntArray s: 0 e: 0"); + RETURN_UBX_TUP2(0, 0); + } else { + h$convertFloat[0] = d*8388608; + i = h$convertInt[0]; + TRACE_ARITH("decodeFloatIntArray s: " + (sgn * (i&8388607)) + " e: " + ((i&2139095040) >> 23) - 173); + RETURN_UBX_TUP2(sgn*(i&8388607), ((i&2139095040) >> 23) - 173) + } + } else { + TRACE_ARITH("decodeFloatIntArray s: " + (sgn * (s|8388608)) + " e: " + (exp-150)); + RETURN_UBX_TUP2(sgn * (s|8388608), exp - 150); + } +} + +function h$decodeFloatIntFallback(d) { + TRACE_ARITH("decodeFloatIntFallback: " + d); + if(isNaN(d)) { + RETURN_UBX_TUP2(-12582912, 105); + } + var ret0, ret1; + CALL_UBX_TUP2(ret0, ret1, h$integer_cmm_decodeDoublezhFallback(d)); + var exponent = ret0 + 29; + var significand = ret1.shiftRight(28).add(h$bigOne).shiftRight(1).intValue(); + if(exponent > 105) { + exponent = 105; + significand = d > 0 ? 8388608 : -8388608; + } else if(exponent < -151 || significand === 0) { + significand = 0; + exponent = 0; + } + TRACE_ARITH("decodeFloatIntFallback s: " + significand + " e: " + exponent); + RETURN_UBX_TUP2(significand, exponent); +} + +function h$decodeDouble2IntArray(d) { + TRACE_ARITH("decodeDouble2IntArray: " + d); + if(isNaN(d)) { + RETURN_UBX_TUP4(1, -1572864, 0, 972); + } + h$convertDouble[0] = d; + TRACE_ARITH("decodeDouble2IntArray binary: " + h$convertInt[0].toString(2) + " " + h$convertInt[1].toString(2)); + var i1 = h$convertInt[1]; + var ret1, ret2 = h$convertInt[0], ret3; + var exp = (i1&2146435072)>>>20; + if(exp === 0) { // denormal or zero + if((i1&2147483647) === 0 && ret2 === 0) { + ret1 = 0; + ret3 = 0; + } else { + h$convertDouble[0] = d*9007199254740992; + i1 = h$convertInt[1]; + ret1 = (i1&1048575)|1048576; + ret2 = h$convertInt[0]; + ret3 = ((i1&2146435072)>>>20)-1128; + } + } else { + ret3 = exp-1075; + ret1 = (i1&1048575)|1048576; + } + TRACE_ARITH("decodeDouble2IntArray: exp: " + ret3 + " significand: " + ret1 + " " + ret2); + RETURN_UBX_TUP4(i1<0?-1:1,ret1,ret2,ret3); +} + +function h$decodeDouble2IntFallback(d) { + TRACE_ARITH("decodeDouble2IntFallback: " + d); + if(isNaN(d)) { + RETURN_UBX_TUP4(1,-1572864,0,972); + } + var exponent, significand; + CALL_UBX_TUP2(exponent, significand, h$integer_cmm_decodeDoublezhFallback(d)); + var sign = d<0?-1:1; + var s = significand.abs(); + var ret1 = s.shiftRight(32).intValue(); + var ret2 = s.intValue(); + var ret3 = exponent; + TRACE_ARITH("decodeDouble2IntFallback: exp: " + ret3 + " significand: " + ret1 + " " + ret2); + RETURN_UBX_TUP4(sign, ret1, ret2, ret3); +} + +// round .5 to nearest even number +function h$rintDouble(a) { + var rounda = Math.round(a); + if(a >= 0) { + if(a%1===0.5 && rounda%2===1) { // tie + return rounda-1; + } else { + return rounda; + } + } else { + if(a%1===-0.5 && rounda%2===-1) { // tie + return rounda-1; + } else { + return rounda; + } + } +} +var h$rintFloat = h$rintDouble; + +function h$acos(d) { return Math.acos(d); } +function h$acosf(f) { return Math.acos(f); } + +function h$asin(d) { return Math.asin(d); } +function h$asinf(f) { return Math.asin(f); } + +function h$atan(d) { return Math.atan(d); } +function h$atanf(f) { return Math.atan(f); } + +function h$atan2(x,y) { return Math.atan2(x,y); } +function h$atan2f(x,y) { return Math.atan2(x,y); } + +function h$cos(d) { return Math.cos(d); } +function h$cosf(f) { return Math.cos(f); } + +function h$sin(d) { return Math.sin(d); } +function h$sinf(f) { return Math.sin(f); } + +function h$tan(d) { return Math.tan(d); } +function h$tanf(f) { return Math.tan(f); } + +function h$cosh(d) { return (Math.exp(d)+Math.exp(-d))/2; } +function h$coshf(f) { return h$cosh(f); } + +function h$sinh(d) { return (Math.exp(d)-Math.exp(-d))/2; } +function h$sinhf(f) { return h$sinh(f); } + +function h$tanh(d) { return (Math.exp(2*d)-1)/(Math.exp(2*d)+1); } +function h$tanhf(f) { return h$tanh(f); } + +var h$popCntTab = + [0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5, + 1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6, + 1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6, + 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7, + 1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6, + 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7, + 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7, + 3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,4,5,5,6,5,6,6,7,5,6,6,7,6,7,7,8]; + +function h$popCnt32(x) { + return h$popCntTab[x&0xFF] + + h$popCntTab[(x>>>8)&0xFF] + + h$popCntTab[(x>>>16)&0xFF] + + h$popCntTab[(x>>>24)&0xFF]; +} + +function h$popCnt64(x1,x2) { + return h$popCntTab[x1&0xFF] + + h$popCntTab[(x1>>>8)&0xFF] + + h$popCntTab[(x1>>>16)&0xFF] + + h$popCntTab[(x1>>>24)&0xFF] + + h$popCntTab[x2&0xFF] + + h$popCntTab[(x2>>>8)&0xFF] + + h$popCntTab[(x2>>>16)&0xFF] + + h$popCntTab[(x2>>>24)&0xFF]; +} + +function h$bswap64(x1,x2) { + RETURN_UBX_TUP2((x2 >>> 24) | (x2 << 24) | ((x2 & 0xFF00) << 8) | ((x2 & 0xFF0000) >> 8) + ,(x1 >>> 24) | (x1 << 24) | ((x1 & 0xFF00) << 8) | ((x1 & 0xFF0000) >> 8)); +} + +var h$clz32 = Math.clz32 || function(x) { + if (x < 0) return 0; + if (x === 0) return 32; + return 31 - ((Math.log(x) / Math.LN2) | 0); +} +function h$clz8(x) { + return h$clz32(x&255)-24; +} +function h$clz16(x) { + return h$clz32(x&65535)-16; +} + +function h$clz64(x1,x2) { + return (x1 === 0) ? 32 + h$clz32(x2) : h$clz32(x1); +} + +var h$ctz32tbl = [32,0,1,26,2,23,27,0,3,16,24,30,28,11,0,13,4,7,17,0,25,22,31,15,29,10,12,6,0,21,14,9,5,20,8,19,18,0,0,0,0,0,31]; +function h$ctz32(x) { + return h$ctz32tbl[((x&-x)%37)&63]; +} +function h$ctz16(x) { + return h$ctz32(x|65536); +} +function h$ctz8(x) { + return h$ctz32(x|256); +} +function h$ctz64(x1,x2) { + return (x2 === 0) ? 32 + h$ctz32(x1) : h$ctz32(x2); +} diff --git a/lib/boot/shims/src/enum.js b/lib/boot/shims/src/enum.js new file mode 100644 index 00000000..e83434a7 --- /dev/null +++ b/lib/boot/shims/src/enum.js @@ -0,0 +1,36 @@ +// some Enum conversion things + +// an array of generic enums +var h$enums = []; +function h$initEnums() { + for(var i=0;i<256;i++) { + h$enums[i] = h$makeEnum(i); + } +} +h$initStatic.push(h$initEnums); + +function h$makeEnum(tag) { + var f = function() { + return h$stack[h$sp]; + } + h$setObjInfo(f, 2, "Enum", [], tag+1, 0, [1], null); +#ifdef GHCJS_PROF + return h$c0(f, h$CCS_SYSTEM); +#else + return h$c0(f); +#endif +} + +// used for all non-Bool enums +function h$tagToEnum(tag) { + if(tag >= h$enums.length) { + return h$makeEnum(tag); + } else { + return h$enums[tag]; + } +} + +function h$dataTag(e) { + return (e===true)?1:((typeof e !== 'object')?0:(e.f.a-1)); +} + diff --git a/lib/boot/shims/src/environment.js b/lib/boot/shims/src/environment.js new file mode 100644 index 00000000..2ed62e7e --- /dev/null +++ b/lib/boot/shims/src/environment.js @@ -0,0 +1,282 @@ +#include + +#ifdef GHCJS_TRACE_ENV +function h$logEnv() { h$log.apply(h$log,arguments); } +#define TRACE_ENV(args...) h$logEnv(args) +#else +#define TRACE_ENV(args...) +#endif + +// set up debug logging for the current JS environment/engine +// browser also logs to
if jquery is detected +// the various debug tracing options use h$log +#ifndef GHCJS_BROWSER +var h$glbl; +function h$getGlbl() { h$glbl = this; } +h$getGlbl(); +#endif +#ifdef GHCJS_LOG_BUFFER +var h$logBufferSize = 6000; +var h$logBufferShrink = 1000; +var h$logBuffer = []; +#endif +function h$log() { +#ifdef GHCJS_LOG_BUFFER + if(!h$logBuffer) return; + var s = ''; + for(var i=0;i h$logBufferSize) h$logBuffer = h$logBuffer.slice(h$logBufferShrink); +#else + try { +#ifndef GHCJS_BROWSER + if(h$glbl) { + if(h$glbl.console && h$glbl.console.log) { + h$glbl.console.log.apply(h$glbl.console,arguments); + } else { + h$glbl.print.apply(this,arguments); + } + } else { + if(typeof console !== 'undefined') { +#endif + console.log.apply(console, arguments); +#ifndef GHCJS_BROWSER + } else if(typeof print !== 'undefined') { + print.apply(null, arguments); + } + } +#endif + } catch(ex) { + // ignore console.log exceptions (for example for IE9 when console is closed) + } +#endif +#ifdef GHCJS_LOG_JQUERY + // if we have jquery, add to
element + if(typeof(jQuery) !== 'undefined') { + var x = ''; + for(var i=0;i
"); + xd.text(x); + jQuery('#output').append(xd); + } +#endif +} + +function h$collectProps(o) { + var props = []; + for(var p in o) { props.push(p); } + return("{"+props.join(",")+"}"); +} + + + +// load the command line arguments in h$programArgs +// the first element is the program name +var h$programArgs; +#ifdef GHCJS_BROWSER +h$programArgs = [ "a.js" ]; +#else +if(h$isNode) { + h$programArgs = process.argv.slice(1); +} else if(h$isJvm) { + h$programArgs = h$getGlobal(this).arguments.slice(0); + h$programArgs.unshift("a.js"); +} else if(h$isJsShell && typeof h$getGlobal(this).scriptArgs !== 'undefined') { + h$programArgs = h$getGlobal(this).scriptArgs.slice(0); + h$programArgs.unshift("a.js"); +} else if((h$isJsShell || h$isJsCore) && typeof h$getGlobal(this).arguments !== 'undefined') { + h$programArgs = h$getGlobal(this).arguments.slice(0); + h$programArgs.unshift("a.js"); +} else { + h$programArgs = [ "a.js" ]; +} +#endif + +function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) { + TRACE_ENV("getProgArgV"); + var c = h$programArgs.length; + if(c === 0) { + argc_v.dv.setInt32(argc_off, 0, true); + } else { + argc_v.dv.setInt32(argc_off, c, true); + var argv = h$newByteArray(4*c); + argv.arr = []; + for(var i=0;i= tv_o + 12) { + tv_v.dv.setInt32(tv_o + 8, ((now % 1000) * 1000)|0, true); + } + return 0; +} + +function h$traceEvent(ev_v,ev_o) { + h$errorMsg(h$decodeUtf8z(ev_v, ev_o)); +} + +function h$traceMarker(ev_v,ev_o) { + h$errorMsg(h$decodeUtf8z(ev_v, ev_o)); +} + +var h$__hscore_gettimeofday = h$gettimeofday; + +var h$myTimeZone = h$encodeUtf8("UTC"); +function h$localtime_r(timep_v, timep_o, result_v, result_o) { + var t = timep_v.i3[timep_o]; + var d = new Date(t * 1000); + result_v.dv.setInt32(result_o , d.getSeconds(), true); + result_v.dv.setInt32(result_o + 4 , d.getMinutes(), true); + result_v.dv.setInt32(result_o + 8 , d.getHours(), true); + result_v.dv.setInt32(result_o + 12, d.getDate(), true); + result_v.dv.setInt32(result_o + 16, d.getMonth(), true); + result_v.dv.setInt32(result_o + 20, d.getFullYear()-1900, true); + result_v.dv.setInt32(result_o + 24, d.getDay(), true); + result_v.dv.setInt32(result_o + 28, 0, true); // fixme yday 1-365 (366?) + result_v.dv.setInt32(result_o + 32, -1, true); // dst information unknown + result_v.dv.setInt32(result_o + 40, 0, true); // gmtoff? + if(!result_v.arr) result_v.arr = []; + result_v.arr[result_o + 40] = [h$myTimeZone, 0]; + result_v.arr[result_o + 48] = [h$myTimeZone, 0]; + RETURN_UBX_TUP2(result_v, result_o); +} +var h$__hscore_localtime_r = h$localtime_r; diff --git a/lib/boot/shims/src/errno.js b/lib/boot/shims/src/errno.js new file mode 100644 index 00000000..1e4636e3 --- /dev/null +++ b/lib/boot/shims/src/errno.js @@ -0,0 +1,96 @@ +#include + +#include "HsBaseConfig.h" + +#ifdef GHCJS_TRACE_ERRNO +function h$logErrno() { h$log.apply(h$log,arguments); } +#define TRACE_ERRNO(args...) h$logErrno(args) +#else +#define TRACE_ERRNO(args...) +#endif + +var h$errno = 0; + +function h$__hscore_get_errno() { + TRACE_ERRNO("hscore_get_errno: " + h$errno); + return h$errno; +} + +function h$unsupported(status, c) { + h$errno = 12456; + if(c) c(status); + return status; +} + +function h$strerror(err) { + if(err === 12456) { + RETURN_UBX_TUP2(h$encodeUtf8("operation unsupported on this platform"), 0); + } +#ifdef GHCJS_BROWSER + RETURN_UBX_TUP2(h$encodeUtf8("unknown error"), 0); +#else + RETURN_UBX_TUP2(h$encodeUtf8(h$errorStrs[err] || "unknown error"), 0); +#endif +} + +#ifndef GHCJS_BROWSER +function h$setErrno(e) { + TRACE_ERRNO("setErrno: " + e); + var es = e.toString(); + var getErr = function() { + if(es.indexOf('ENOTDIR') !== -1) return CONST_ENOTDIR; + if(es.indexOf('ENOENT') !== -1) return CONST_ENOENT; + if(es.indexOf('EEXIST') !== -1) return CONST_EEXIST; + if(es.indexOf('ENETUNREACH') !== -1) return CONST_EINVAL; // fixme + if(es.indexOf('EPERM') !== -1) return CONST_EPERM; + if(es.indexOf('EMFILE') !== -1) return CONST_EMFILE; + if(es.indexOf('EPIPE') !== -1) return CONST_EPIPE; + if(es.indexOf('EAGAIN') !== -1) return CONST_EAGAIN; + if(es.indexOf('Bad argument') !== -1) return CONST_ENOENT; // fixme? + throw ("setErrno not yet implemented: " + e); + + } + h$errno = getErr(); +} + +var h$errorStrs = { CONST_E2BIG: "too big" + , CONST_EACCESS: "no access" + , CONST_EINVAL: "invalid" + , CONST_EBADF: "bad file descriptor" + , CONST_ENOTDIR: "not a directory" + , CONST_ENOENT: "no such file or directory" + , CONST_EPERM: "operation not permitted" + , CONST_EEXIST: "file exists" + , CONST_EMFILE: "too many open files" + , CONST_EPIPE: "broken pipe" + , CONST_EAGAIN: "resource temporarily unavailable" + } + +function h$handleErrno(r_err, f) { + try { + return f(); + } catch(e) { + h$setErrno(e); + return r_err; + } +} + +function h$handleErrnoS(r_err, r_success, f) { + try { + f(); + return r_success; + } catch(e) { + h$setErrno(e); + return r_err; + } +} + +function h$handleErrnoC(err, r_err, r_success, c) { + if(err) { + h$setErrno(err); + c(r_err); + } else { + c(r_success); + } +} +#endif diff --git a/lib/boot/shims/src/gc.js b/lib/boot/shims/src/gc.js new file mode 100644 index 00000000..384cd77a --- /dev/null +++ b/lib/boot/shims/src/gc.js @@ -0,0 +1,627 @@ +/* + Do garbage collection where the JavaScript GC doesn't suffice or needs some help: + + - run finalizers for weak references + - find unreferenced CAFs and reset them (unless h$retainCAFs is set) + - shorten stacks that are mostly empty + - reset unused parts of stacks to null + - reset registers to null + - reset return variables to null + - throw exceptions to threads that are blocked on an unreachable MVar/STM transaction + - drop unnecessary references for selector thunks + + The gc uses the .m field to store its mark in all the objects it marks. for heap objects, + the .m field is also used for other things, like stable names, the gc only changes + the two least significant bits for these. + + The gc starts with all threads as roots in addition to callbacks passed to JavaScript + that that are retained. If you have custom JavaScript data structures that contain + Haskell heap object references, you can use extensible retention to find these + references and add thm to the work queue. h$registerExtensibleRetensionRoot(f) calls + f(currentMark) at the start of every gc, h$registerExtensibleRetention(f) calls f(o, currentMark) + for every unknown object found on the Haskell heap. + + Extensible retention is a low-level mechanism and should typically only be used by + bindings that guarantee that the shape of the JS objects exactly matches what + the scanner expects. Care should be taken to make sure that the objects never + escape the reach of the scanner. + + Having correct reachability information is important, even if you choose to turn off + features like weak references and deallocating CAFs in production, since it helps + debugging by providing the profiler with accurate data and by properly raising + exceptions when threads become blocked indefinitely, usually indicating a bug or + memory leak. + + assumptions: + - all threads suspended, no active registers + - h$currentThread == null or at least unused: + 1. all reachable threads must be in h$threads or h$blocked + 2. no registers contain any usable value + notes: + - gc() may replace the stack of any thread, make sure to reload h$stack after gc() +*/ + +/* + fixme, todo: + - mark posted exceptions to thread +*/ + +#include + +#ifdef GHCJS_TRACE_GC +function h$traceGC() { h$log.apply(h$log, arguments); } +#define TRACE_GC(args...) h$traceGC(args) +#else +#define TRACE_GC(args...) +#endif + +// these macros use a local mark variable +#define IS_MARKED(obj) ((typeof obj.m === 'number' && (obj.m & 3) === mark) || (typeof obj.m === 'object' && ((obj.m.m & 3) === mark))) +#define IS_MARKED_M(obj) ((obj.m & 3) === mark) +#define MARK_OBJ(obj) if(typeof obj.m === 'number') obj.m = (obj.m&-4)|mark; else obj.m.m = (obj.m.m & -4)|mark; + +var h$gcMark = 2; // 2 or 3 (objects initialized with 0) + +#ifdef GHCJS_TRACE_GC +var h$gcTime = 0; +#endif + +#ifdef GHCJS_RETAIN_CAFS +var h$retainCAFs = true; +#else +var h$retainCAFs = false; +#endif +var h$CAFs = []; +var h$CAFsReset = []; + +// +var h$extensibleRetentionRoots = []; +var h$extensibleRetentionCallbacks = []; + + +/* + after registering an extensible extension root f, + f(currentMark) is called at the start of each gc invocation and is + expected to return an array with Haskell heap objects + to be treated as extra roots. + */ +function h$registerExtensibleRetentionRoot(f) { + h$extensibleRetentionRoots.push(f); +} + +function h$unregisterExtensibleRetentionRoot(f) { + h$extensibleRetentionRoots = h$extensibleRetentionRoots.filter(function(g) { return f !== g; }); +} + +/* + after registering an extensible retention callback f, + f(o, currentMark) is called for every unknown object encountered on the + Haskell heap. f should return an array with found objects. If no objects + are found, f should return a boolean indicating whether the gc should skip + processing the objects with other extensible retention callbacks. + + The gc may encounter the same object multiple times during the same scan, + so a callback should attempt to quickly return if the object has been scanned + already. + + return value: + - array scan objects contained in array, do not call other extension callbacks + - true do not call other extension callbacks with this object + - false call other extension callbacks with this object + + Use -DGHCJS_TRACE_GC_UNKNOWN to find the JavaScript objects reachable + (through JSVal) on the Haskell heap for which none of the registered + extensible retention callbacks has returned true or an array. + */ +function h$registerExtensibleRetention(f) { + h$extensibleRetentionCallbacks.push(f); +} + +function h$unregisterExtensibleRetention(f) { + h$extensibleRetentionCallbacks = h$extensibleRetentionCallbacks.filter(function(g) { return f !== g; }); +} + +// check whether the object is marked by the latest gc +function h$isMarked(obj) { + return (typeof obj === 'object' || typeof obj === 'function') && + ((typeof obj.m === 'number' && (obj.m & 3) === h$gcMark) || (obj.m && typeof obj.m === 'object' && obj.m.m === h$gcMark)); +} + +// do a quick gc of a thread: +// - reset the stack (possibly shrinking storage for it) +// - reset all global data +// checks all known threads if t is null, but not h$currentThread +function h$gcQuick(t) { +#ifdef GHCJS_DISABLE_GC + return; +#endif + if(h$currentThread !== null) throw "h$gcQuick: GC can only run when no thread is running"; +#ifdef GHCJS_TRACE_GC + var start = Date.now(); +#endif + h$resetRegisters(); + h$resetResultVars(); + var i; + if(t !== null) { // reset specified threads + if(t instanceof h$Thread) { // only thread t + h$resetThread(t); + } else { // assume it's an array + for(var i=0;i=0;i--) { + var a = h$extensibleRetentionRoots[i](h$gcMark); + if(a) h$follow(a, a.length-1); + } + TRACE_GC("scanning threads, runnable: " + h$threads.length() + " blocked: " + h$blocked.size() + " t: " + t); + + // mark al runnable threads and the running thread + if(t !== null) { + h$markThread(t); + h$resetThread(t); + } + var nt, runnable = h$threads.iter(); + while((nt = runnable()) !== null) { + h$markThread(nt); + h$resetThread(nt); + } + + // some blocked threads are always considered reachable, mark them + // - delayed threads + // - threads blocked on async FFI + var iter = h$blocked.iter(); + while((nt = iter.next()) !== null) { + if(nt.delayed || + (nt.blockedOn instanceof h$MVar && nt.stack && nt.stack[nt.sp] === h$unboxFFIResult)) { + h$markThread(nt); + } + h$resetThread(nt); + } + TRACE_GC("scanning permanent retention roots"); + iter = h$extraRoots.iter(); + while((nt = iter.next()) !== null) h$follow(nt.root); + + // clean up threads waiting on unreachable synchronization primitives + h$resolveDeadlocks(); + + // clean up unreachable weak refs + var toFinalize = h$markRetained(); + h$finalizeWeaks(toFinalize); + + h$finalizeCAFs(); // restore all unreachable CAFs to unevaluated state + + var now = Date.now(); + h$lastGc = now; +#ifdef GHCJS_TRACE_GC + var time = now - start; + h$gcTime += time; + TRACE_GC("time: " + time + "ms"); + TRACE_GC("time (total): " + h$gcTime + "ms"); + TRACE_GC("marked objects: " + h$marked); +#endif +} + +function h$markWeaks() { + var i, w, marked, mark = h$gcMark; + do { + marked = false; + for (i = 0; i < h$weakPointerList.length; ++i) { + w = h$weakPointerList[i]; + if (IS_MARKED_M(w.keym)) { + if (w.val !== null && !IS_MARKED(w.val)) { + h$follow(w.val); + marked = true; + } + if (w.finalizer !== null && !IS_MARKED(w.finalizer)) { + h$follow(w.finalizer); + marked = true; + } + } + } + } while(marked); +} + + +function h$markRetained() { + var iter, marked, w, i, mark = h$gcMark; + var newList = []; + var toFinalize = []; + + /* + 2. Scan the Weak Pointer List. If a weak pointer object has a key that is + marked (i.e. reachable), then mark all heap reachable from its value + or its finalizer, and move the weak pointer object to a new list + */ + do { + TRACE_GC("mark retained iteration 1/2"); + marked = false; + + for (i = 0; i < h$weakPointerList.length; ++i) { + w = h$weakPointerList[i]; + if (w === null) { + // don't handle items deleted in earlier iteration + continue; + } + if (IS_MARKED_M(w.keym)) { + if (w.val !== null && !IS_MARKED(w.val)) { + h$follow(w.val); + } + + if (w.finalizer !== null && !IS_MARKED(w.finalizer)) { + h$follow(w.finalizer); + } + + newList.push(w); + // instead of removing the item from the h$weakpointerList + // we set it to null if we push it to newList. + h$weakPointerList[i] = null; + + marked = true; + } + } + + /* + 3. Repeat from step (2), until a complete scan of Weak Pointer List finds + no weak pointer object with a marked keym. + */ + } while(marked); + + + /* + 4. Scan the Weak Pointer List again. If the weak pointer object is reachable + then tombstone it. If the weak pointer object has a finalizer then move + it to the Finalization Pending List, and mark all the heap reachable + from the finalizer. If the finalizer refers to the key (and/or value), + this step will "resurrect" it. + */ + + for (i = 0; i < h$weakPointerList.length; ++i) { + w = h$weakPointerList[i]; + if (w === null) { + // don't handle items deleted in step 2 + continue; + } + + TRACE_GC("mark retained iteration 2/2"); + if(w.val !== null) { + w.val = null; + } + + if(w.finalizer !== null) { + if(!IS_MARKED(w.finalizer)) { + TRACE_GC("following finalizer"); + h$follow(w.finalizer); + } + toFinalize.push(w); + } + } + + /* + 5. The list accumulated in step (3) becomes the new Weak Pointer List. + Mark any unreachable weak pointer objects on this list as reachable. + */ + h$weakPointerList = newList; + + // marking the weak pointer objects as reachable is not necessary + + return toFinalize; +} + +function h$markThread(t) { + var mark = h$gcMark; + TRACE_GC("marking thread: " + h$threadString(t)); + if(IS_MARKED(t)) return; + h$follow(t); +} + +#define ADDW(x) work[w++] = x; +#define ADDW2(x,y) { work[w++] = x; work[w++] = y; } +#define ADDW3(x,y,z) { work[w++] = x; work[w++] = y; work[w++] = z; } +#define ADDW4(x,y,z,v) { work[w++] = x; work[w++] = y; work[w++] = z; work[w++] = v; } + +// big object, not handled by 0..7 cases +// keep out of h$follow to prevent deopt +function h$followObjGen(c, work, w) { + ADDW(c.d1); + var d = c.d2; + for(var x in d) { +// if(d.hasOwnProperty(x)) { + ADDW(d[x]); +// } + } + return w; +} + +// follow all references in the object obj and mark them with the current mark +// if sp is a number, obj is assumed to be an array for which indices [0..sp] need +// to be followed (used for thread stacks) +function h$follow(obj, sp) { + var i, ii, iter, c, work, w; +#ifdef GHCJS_TRACE_GC + var start = Date.now(); +#endif + TRACE_GC("following"); + var work, mark = h$gcMark; + if(typeof sp === 'number') { + work = obj.slice(0, sp+1); + w = sp + 1; + } else { + work = [obj]; + w = 1; + } + while(w > 0) { + TRACE_GC("work length: " + work.length + " w: " + w); + c = work[--w]; + TRACE_GC("[" + work.length + "] mark step: " + typeof c); +#ifdef GHCJS_TRACE_GC + if(typeof c === 'object') { + if(c !== null) { + TRACE_GC("object: " + c.toString()); + TRACE_GC("object props: " + h$collectProps(c)); + TRACE_GC("object mark: " + c.m + " (" + typeof(c.m) + ") (current: " + mark + ")"); + } else { + TRACE_GC("object: " + c); + } + } +#endif + if(c !== null && c !== undefined && typeof c === 'object' && ((typeof c.m === 'number' && (c.m&3) !== mark) || (typeof c.m === 'object' && c.m !== null && typeof c.m.m === 'number' && (c.m.m&3) !== mark))) { + var doMark = false; + var cf = c.f; + TRACE_GC("first accepted"); + if(typeof cf === 'function' && (typeof c.m === 'number' || typeof c.m === 'object')) { + TRACE_GC("marking heap object: " + c.f.n + " size: " + c.f.size); + // only change the two least significant bits for heap objects + MARK_OBJ(c); + // dynamic references + var d = c.d2; + switch(cf.size) { + case 0: break; + case 1: ADDW(c.d1); break; + case 2: ADDW2(c.d1, d); break; + case 3: var d3=c.d2; ADDW3(c.d1, d3.d1, d3.d2); break; + case 4: var d4=c.d2; ADDW4(c.d1, d4.d1, d4.d2, d4.d3); break; + case 5: var d5=c.d2; ADDW4(c.d1, d5.d1, d5.d2, d5.d3); ADDW(d5.d4); break; + case 6: var d6=c.d2; ADDW4(c.d1, d6.d1, d6.d2, d6.d3); ADDW2(d6.d4, d6.d5); break; + case 7: var d7=c.d2; ADDW4(c.d1, d7.d1, d7.d2, d7.d3); ADDW3(d7.d4, d7.d5, d7.d6); break; + case 8: var d8=c.d2; ADDW4(c.d1, d8.d1, d8.d2, d8.d3); ADDW4(d8.d4, d8.d5, d8.d6, d8.d7); break; + case 9: var d9=c.d2; ADDW4(c.d1, d9.d1, d9.d2, d9.d3); ADDW4(d9.d4, d9.d5, d9.d6, d9.d7); ADDW(d9.d8); break; + case 10: var d10=c.d2; ADDW4(c.d1, d10.d1, d10.d2, d10.d3); ADDW4(d10.d4, d10.d5, d10.d6, d10.d7); ADDW2(d10.d8, d10.d9); break; + case 11: var d11=c.d2; ADDW4(c.d1, d11.d1, d11.d2, d11.d3); ADDW4(d11.d4, d11.d5, d11.d6, d11.d7); ADDW3(d11.d8, d11.d9, d11.d10); break; + case 12: var d12=c.d2; ADDW4(c.d1, d12.d1, d12.d2, d12.d3); ADDW4(d12.d4, d12.d5, d12.d6, d12.d7); ADDW4(d12.d8, d12.d9, d12.d10, d12.d11); break; + default: w = h$followObjGen(c,work,w); + } + // static references + var s = cf.s; + if(s !== null) { + TRACE_GC("adding static marks"); + for(var i=0;i=0;i--) { + ADDW(c.waiters[i]); + } + } + if(c.val !== null && !IS_MARKED(c.val)) ADDW(c.val); + } else if(c instanceof h$MutVar) { + TRACE_GC("marking MutVar"); + MARK_OBJ(c); + ADDW(c.val); + } else if(c instanceof h$TVar) { + TRACE_GC("marking TVar"); + MARK_OBJ(c); + ADDW(c.val); + iter = c.blocked.iter(); + while((ii = iter.next()) !== null) { + ADDW(ii); + } + if(c.invariants) { + iter = c.invariants.iter(); + while((ii = iter.next()) !== null) { + ADDW(ii); + } + } + } else if(c instanceof h$Thread) { + TRACE_GC("marking Thread"); + MARK_OBJ(c); + if(c.stack) { + for(i=c.sp;i>=0;i--) { + ADDW(c.stack[i]); + } + } + for(i=0;i=0;i--) { + ADDW(c.invariants[i].action); + } + ADDW(c.action); + iter = c.tvars.iter(); + while((ii = iter.nextVal()) !== null) { + ADDW(ii.val); + } + } else if(c instanceof Array && c.__ghcjsArray) { + // only for Haskell arrays with lifted values + MARK_OBJ(c); + TRACE_GC("marking array"); + for(i=0;i=0;i--) { + var x = h$extensibleRetentionCallbacks[i](c, mark); + if(x === false) continue; +#ifdef GHCJS_TRACE_GC_UNKNOWN + extensibleMatched = true; +#endif + if(x !== true) { + for(j=x.length-1;j>=0;j--) { + ADDW(x[j]); + } + } + break; + } +#ifdef GHCJS_TRACE_GC_UNKNOWN + if(!extensibleMatched) { + TRACE_GC("unknown object: " + h$collectProps(c)); + } +#endif + } // otherwise: not an object, no followable values + } + } + TRACE_GC("h$follow: " + (Date.now()-start) + "ms"); +} + +// resetThread clears the stack above the stack pointer +// and shortens the stack array if there is too much +// unused space +function h$resetThread(t) { +#ifdef GHCJS_TRACE_GC + var start = Date.now(); +#endif + var stack = t.stack; + if(!stack) return; + var sp = t.sp; + if(stack.length - sp > sp && stack.length > 100) { + t.stack = t.stack.slice(0,sp+1); + } else { + for(var i=sp+1;i + +#ifdef GHCJS_TRACE_HSCORE +function h$logHscore() { h$log.apply(h$log,arguments); } +#define TRACE_HSCORE(args...) h$logHscore(args) +#else +#define TRACE_HSCORE(args...) +#endif + +function h$__hscore_sizeof_termios() { + TRACE_HSCORE("hscore_sizeof_termios"); + return 4; +} + +function h$tcgetattr(x, y, z) { + TRACE_HSCORE("tcgetattr: " + x + " " + y + " " + z); + return 0; +} + +function h$__hscore_get_saved_termios(r) { + TRACE_HSCORE("hscore_get_saved_termios: " + r); + RETURN_UBX_TUP2(null, 0); +} + +function h$__hscore_set_saved_termios(a, b, c) { + TRACE_HSCORE("hscore_set_saved_termios: " + a + " " + b + " " + c); + RETURN_UBX_TUP2(null, 0); +} + +function h$__hscore_sizeof_sigset_t() { + TRACE_HSCORE("hscore_sizeof_sigset_t"); + return 4; +} + +function h$sigemptyset(a, b) { + TRACE_HSCORE("sigemptyset: " + a + " " + b); + RETURN_UBX_TUP2(null, 0); +} + +function h$__hscore_sigttou() { + TRACE_HSCORE("hscore_sigttou"); + return 0; +} + +function h$sigaddset(a, b, c) { + TRACE_HSCORE("sigaddset: " + a + " " + b + " " + c); + return 0; +} + +function h$__hscore_sig_block() { + TRACE_HSCORE("hscore_sig_block"); + return 0; +} + +function h$sigprocmask(a,b,c,d,e) { + TRACE_HSCORE("sigprocmask: " + a + " " + b + " " + c + " " + d + " " + e); + RETURN_UBX_TUP2(0, 0); +} + +function h$__hscore_lflag(a,b) { + TRACE_HSCORE("hscore_lflag: " + a + " " + b); + return 0; +} + +function h$__hscore_icanon() { + TRACE_HSCORE("hscore_icanon"); + return 0; +} + +function h$__hscore_poke_lflag(a, b, c) { + TRACE_HSCORE("hscore_poke_lflag: " + a + " " + b + " " + c); + return 0; +} + +function h$__hscore_ptr_c_cc(a, b) { + TRACE_HSCORE("hscore_ptr_c_cc: " + a + " " + b); + RETURN_UBX_TUP2(h$newByteArray(8), 0); // null; +} + +function h$__hscore_vmin() { + TRACE_HSCORE("hscore_vmin"); + RETURN_UBX_TUP2(h$newByteArray(8), 0); // null; +} + +function h$__hscore_vtime() { + TRACE_HSCORE("hscore_vtime"); + return 0; +} + +function h$__hscore_tcsanow() { + TRACE_HSCORE("hscore_tcsanow"); + return 0; +} + +function h$tcsetattr(a,b,c,d) { + TRACE_HSCORE("tcsetattr: " + a + " " + b + " " + c + " " + d); + return 0; +} + +function h$__hscore_sig_setmask() { + TRACE_HSCORE("hscore_sig_setmask"); + return 0; +} + diff --git a/lib/boot/shims/src/integer.js b/lib/boot/shims/src/integer.js new file mode 100644 index 00000000..fc60a349 --- /dev/null +++ b/lib/boot/shims/src/integer.js @@ -0,0 +1,572 @@ +#include + +/* + Integer and integer-gmp support + partial GMP emulation + + note: sign behaves different from real gmp sign, + value is always zero, don't use it for comparisons +*/ + +#ifdef GHCJS_TRACE_INTEGER +function h$logInteger() { h$log.apply(h$log,arguments); } +#define TRACE_INTEGER(args...) h$logInteger(args) +#else +#define TRACE_INTEGER(args...) +#endif + +var h$bigZero = h$nbv(0); +var h$bigOne = h$nbv(1); +var h$bigCache = []; +(function() { + for(var i=0;i<=100;i++) { + h$bigCache.push(h$nbv(i)); + } +})(); + +// convert a value to a BigInt +function h$bigFromInt(v) { + TRACE_INTEGER("h$bigFromInt: " + v); + var v0 = v|0; + if(v0 >= 0) { + if(v0 <= 100) { + return h$bigCache[v0]; + } else if(v0 < 268435456) { // 67108864) { // guaranteed to fit in one digit + return h$nbv(v0); + } + var r1 = h$nbv(v0 >>> 16); + var r2 = h$nbi(); + r1.lShiftTo(16,r2); + r1.fromInt(v0 & 0xffff); + var r3 = r1.or(r2); + TRACE_INTEGER("h$bigFromInt result: " + r3.toString()); + return r3; + } else { + v0 = -v0; + if(v0 < 268435456) { // 67108864) { + return h$nbv(v0).negate(); + } + var r1 = h$nbv(v0 >>> 16); + var r2 = h$nbi(); + r1.lShiftTo(16,r2); + r1.fromInt(v0 & 0xffff); + var r3 = r1.or(r2); + BigInteger.ZERO.subTo(r3,r2); + TRACE_INTEGER("h$bigFromInt result: " + r2.toString()); + return r2; + } +} + +function h$bigFromWord(v) { + var v0 = v|0; + if(v0 >= 0) { + if(v0 <= 100) { + return h$bigCache[v0]; + } else if(v0 < 268435456) { // 67108864) { // guaranteed to fit in one digit + return h$nbv(v0); + } + } + var r1 = h$nbv(v0 >>> 16); + var r2 = h$nbv(0); + r1.lShiftTo(16,r2); + r1.fromInt(v0 & 0xffff); + return r1.or(r2); +} + +function h$bigFromInt64(v1,v2) { + TRACE_INTEGER("h$bigFromInt64: " + v1 + " " + v2); + var v10 = v1|0; + var v20 = v2|0; + var r = new BigInteger([ v10 >> 24, (v10 & 0xff0000) >> 16, (v10 & 0xff00) >> 8, v10 & 0xff + , v20 >>> 24, (v20 & 0xff0000) >> 16, (v20 & 0xff00) >> 8, v20 & 0xff + ]); + TRACE_INTEGER("h$bigFromInt64 result: " + r.toString()); + return r; +} + +function h$bigFromWord64(v1,v2) { + TRACE_INTEGER("h$bigFromWord64: " + v1 + " " + v2); + var v10 = v1|0; + var v20 = v2|0; + var arr = [ 0, v10 >>> 24, (v10 & 0xff0000) >> 16, (v10 & 0xff00) >> 8, v10 & 0xff + , v20 >>> 24, (v20 & 0xff0000) >> 16, (v20 & 0xff00) >> 8, v20 & 0xff + ]; + TRACE_INTEGER(arr); + var r = new BigInteger([ 0, v10 >>> 24, (v10 & 0xff0000) >> 16, (v10 & 0xff00) >> 8, v10 & 0xff + , v20 >>> 24, (v20 & 0xff0000) >> 16, (v20 & 0xff00) >> 8, v20 & 0xff + ]); + TRACE_INTEGER("h$bigFromWord64 result: " + r.toString()); + return r; +} + +function h$bigFromNumber(n) { + var ra = []; + var s = 0; + if(n < 0) { + n = -n; + s = -1; + } + var b = 1; + while(n >= b) { + ra.unshift((n/b)&0xff); + b *= 256; + } + ra.unshift(s); + return new BigInteger(ra); +} + +function h$encodeNumber(big,e) { + var m = Math.pow(2,e); + if(m === Infinity) { + switch(big.signum()) { + case 1: return Infinity; + case 0: return 0; + default: return -Infinity; + } + } + var b = big.toByteArray(); + var l = b.length; + var r = 0; + TRACE_INTEGER("h$encodeNumber", b); + for(var i=l-1;i>=1;i--) { + TRACE_INTEGER("h$encodeNumber i: " + i + " b[i] " + b[i]); + r += m * Math.pow(2,(l-i-1)*8) * (b[i] & 0xff); + TRACE_INTEGER(r); + } + // last one signed + if(b[0] != 0) { + r += m * Math.pow(2,(l-1)*8) * b[0]; + } + TRACE_INTEGER("h$encodeNumber result: " + r); + return r; +} + +function h$integer_cmm_cmpIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("cmpInteger: " + abits + " " + bbits); + var c = abits.compareTo(bbits); + return c == 0 ? 0 : c > 0 ? 1 : -1; +} + +function h$integer_cmm_cmpIntegerIntzh(sa, abits, b) { + TRACE_INTEGER("cmpIntegerInt: " + abits + " " + b); + var c = abits.compareTo(h$bigFromInt(b)); + return c == 0 ? 0 : c > 0 ? 1 : -1; +} + +function h$integer_cmm_plusIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("plusInteger: " + abits + " " + bbits); + return abits.add(bbits); +} + +function h$integer_cmm_plusIntegerIntzh(sa, abits, b) { + TRACE_INTEGER("plusIntegerInt: " + abits + " " + b); + return abits.add(h$bigFromInt(b)); +} + +function h$integer_cmm_minusIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("minusInteger: " + abits + " " + bbits); + return abits.subtract(bbits); +} + +function h$integer_cmm_minusIntegerIntzh(sa, abits, b) { + TRACE_INTEGER("minusIntegerInt: " + abits + " " + b); + return abits.subtract(h$bigFromInt(b)); +} + +function h$integer_cmm_timesIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("timesInteger: " + abits + " " + bbits); + return abits.multiply(bbits); +} + +function h$integer_cmm_timesIntegerIntzh(sa, abits, b) { + TRACE_INTEGER("timesIntegerInt: " + abits + " " + b); + return abits.multiply(h$bigFromInt(b)); +} + +// fixme make more efficient, divideRemainder +function h$integer_cmm_quotRemIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("quotRemInteger: " + abits + " " + bbits); + var q = abits.divide(bbits); + TRACE_INTEGER("quotRemInteger q: " + q.toString()); + var r = abits.subtract(q.multiply(bbits)); + TRACE_INTEGER("quotRemInteger r: " + r.toString()); + RETURN_UBX_TUP2(q, r); +} + +function h$integer_cmm_quotRemIntegerWordzh(sa, abits, b) { + var bbits = h$bigFromWord(b); + TRACE_INTEGER("quotRemIntegerWord: " + abits + " " + b); + var q = abits.divide(bbits); + RETURN_UBX_TUP2(q, abits.subtract(q.multiply(bbits))); +} + +function h$integer_cmm_quotIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("quotInteger: " + abits + " " + bbits); + return abits.divide(bbits); +} + +function h$integer_cmm_quotIntegerWordzh(sa, abits, b) { + TRACE_INTEGER("quotIntegerWord: " + abits + " " + b); + return abits.divide(h$bigFromWord(b)); +} + +function h$integer_cmm_remIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("remInteger: " + abits + " " + bbits); + return abits.subtract(bbits.multiply(abits.divide(bbits))); +} + +function h$integer_cmm_remIntegerWordzh(sa, abits, b) { + TRACE_INTEGER("remIntegerWord: " + abits + " " + b); + var bbits = h$bigFromWord(b); + return abits.subtract(bbits.multiply(abits.divide(bbits))); +} + +function h$integer_cmm_divModIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("divModInteger: " + abits + " " + bbits); + var d = abits.divide(bbits); + var m = abits.subtract(d.multiply(bbits)); + TRACE_INTEGER("signums: " + abits.signum() + " " + bbits.signum() + " " + m.signum()); + if(abits.signum()!==bbits.signum() && m.signum() !== 0) { + d = d.subtract(h$bigOne); + m.addTo(bbits, m); + } + RETURN_UBX_TUP2(d, m); +} + +function h$integer_cmm_divModIntegerWordzh(sa, abits, b) { + TRACE_INTEGER("divModIntegerWord: " + abits + " " + b); + return h$integer_cmm_divModIntegerzh(sa, abits, 0, h$bigFromWord(b)); +} + +function h$integer_cmm_divIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("divInteger " + abits + " " + bbits); + var d = abits.divide(bbits); + var m = abits.subtract(d.multiply(bbits)); + TRACE_INTEGER("signums: " + abits.signum() + " " + bbits.signum() + " " + m.signum()); + if(abits.signum()!==bbits.signum() && m.signum() !== 0) { + TRACE_INTEGER("subtracting"); + d = d.subtract(h$bigOne); + } + TRACE_INTEGER("divInteger result " + d); + return d; +} + +function h$integer_cmm_divIntegerWordzh(sa, abits, b) { + TRACE_INTEGER("divIntegerWord " + abits + " " + b); + return h$integer_cmm_divIntegerzh(sa, abits, 0, h$bigFromWord(b)); +} + +function h$integer_cmm_modIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("modInteger " + abits + " " + bbits); + var d = abits.divide(bbits); + var m = abits.subtract(d.multiply(bbits)); + if(abits.signum()!==bbits.signum() && m.signum() !== 0) { + m.addTo(bbits, m); + } + return m; +} + +function h$integer_cmm_modIntegerWordzh(sa, abits, b) { + TRACE_INTEGER("modIntegerWord " + abits + " " + b); + return h$integer_cmm_modIntegerzh(sa, abits, 0, h$bigFromWord(b)); +} + +function h$integer_cmm_divExactIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("divExactInteger " + abits + " " + bbits); + return abits.divide(bbits); +} + +function h$integer_cmm_divExactIntegerWordzh(sa, abits, b) { + TRACE_INTEGER("divExactIntegerWord " + abits + " " + b); + return abits.divide(h$bigFromWord(b)); +} + +function h$gcd(a, b) { + var x = a.abs(); + var y = b.abs(); + var big, small; + if(x.compareTo(y) < 0) { + small = x; + big = y; + } else { + small = y; + big = x; + } + while(small.signum() !== 0) { + var q = big.divide(small); + var r = big.subtract(q.multiply(small)); + big = small; + small = r; + } + return big; +} + +function h$integer_cmm_gcdIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("gcdInteger " + abits + " " + bbits); + return h$gcd(abits, bbits); +} + +function h$integer_cmm_gcdIntegerIntzh(sa, abits, b) { + TRACE_INTEGER("gcdIntegerInt " + abits + " " + b); + var r = h$gcd(abits, h$bigFromInt(b)); + return r.intValue(); +} + +function h$integer_cmm_gcdIntzh(a, b) { + var x = a<0 ? -a : a; + var y = b<0 ? -b : b; + var big, small; + if(x= 0) { + return abits.pow(b); + } else { + return abits.pow(b + 2147483648); + } +} + +// (a ^ b) % c +function h$integer_cmm_powModIntegerzh(sa, abits, sb, bbits, sc, cbits) { + TRACE_INTEGER("powModInteger " + abits + " " + bbits + " " + cbits); + return abits.modPow(bbits, cbits); +} + +// warning, there is no protection against side-channel attacks here +function h$integer_cmm_powModSecIntegerzh(sa, abits, sb, bbits, sc, cbits) { + TRACE_INTEGER("powModSecInteger " + abits + " " + bbits + " " + cbits); + return h$integer_cmm_powModIntegerzh(sa, abits, sb, bbits, sc, cbits); +} + +function h$integer_cmm_recipModIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("recipModInteger " + abits + " " + bbits); + return abits.modInverse(bbits); +} + +function h$integer_cmm_nextPrimeIntegerzh(sa, abits) { + TRACE_INTEGER("nextPrimeInteger " + abits); + var n = abits.add(BigInteger.ONE); + while(true) { + if(n.isProbablePrime(50)) return n; + n.addTo(BigInteger.ONE, n); + } +} + +function h$integer_cmm_testPrimeIntegerzh(sa, abits, b) { + TRACE_INTEGER("testPrimeInteger " + abits + " " + b); + return abits.isProbablePrime(b) ? 1 : 0; +} + +function h$integer_cmm_sizeInBasezh(sa, abits, b) { + TRACE_INTEGER("sizeInBase " + abits); + return Math.ceil(abits.bitLength() * Math.log(2) / Math.log(b)); +} + +var h$oneOverLog2 = 1 / Math.log(2); + +function h$integer_cmm_decodeDoublezh(x) { + TRACE_INTEGER("integer_cmm_decodeDouble " + x); + var sgn, ret1, ret2, ret3; + CALL_UBX_TUP4(sgn, ret1, ret2, ret3, h$decodeDouble2Int(x)); + var b = h$bigFromInt(ret1).shiftLeft(32).add(h$bigFromWord(ret2)); + ret1 = (!isNaN(x) && sgn < 0) ? b.negate() : b; + // var ret3 = h$ret3; + TRACE_INTEGER("integer_cmm_decodeDouble s: " + ret1 + " e: " + ret3); + RETURN_UBX_TUP2(ret3, ret1); +} + +function h$integer_cmm_decodeDoublezhFallback(x) { + TRACE_INTEGER("integer_cmm_decodeDouble fallback " + x); + if(isNaN(x)) { + RETURN_UBX_TUP2(972, h$bigFromInt(3).shiftLeft(51).negate()); + } + if( x < 0 ) { + var result, ret1; + CALL_UBX_TUP2(result, ret1, h$integer_cmm_decodeDoublezh(-x)); + RETURN_UBX_TUP2(result, ret1.negate()); + } + if(x === Number.POSITIVE_INFINITY) { + RETURN_UBX_TUP2(972, h$bigOne.shiftLeft(52)); + } + var exponent = (Math.floor(Math.log(x) * h$oneOverLog2)-52)|0; + var n; + // prevent overflow + if(exponent < -1000) { + n = x * Math.pow(2,-exponent-128) * Math.pow(2,128); + } else if(exponent > 900) { + n = x * Math.pow(2,-exponent+128) * Math.pow(2,-128); + } else { + n = x * Math.pow(2,-exponent); + } + // fixup precision, do we also need the other way (exponent++) ? + if(Math.abs(n - Math.floor(n) - 0.5) < 0.0001) { + exponent--; + n *= 2; + } + var ret1 = h$bigFromNumber(n); + TRACE_INTEGER("integer_cmm_decodeDoubleFallback s: " + h$ret1 + " e: " + exponent); + RETURN_UBX_TUP2(exponent, ret1); +} + +function h$integer_cmm_int2Integerzh(i) { + TRACE_INTEGER("int2Integer " + i); + RETURN_UBX_TUP2(0, h$bigFromInt(i)); +} + +function h$integer_cmm_word2Integerzh(i) { + TRACE_INTEGER("word2Integer " + i); + RETURN_UBX_TUP2(0, h$bigFromWord(i)); +} + +function h$integer_cmm_andIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("andInteger " + abits + " " + bbits); + return abits.and(bbits); +} + +function h$integer_cmm_orIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("orInteger " + abits + " " + bbits); + return abits.or(bbits); +} + +function h$integer_cmm_xorIntegerzh(sa, abits, sb, bbits) { + TRACE_INTEGER("xorInteger " + abits + " " + bbits); + return abits.xor(bbits); +} + +function h$integer_cmm_testBitIntegerzh(sa, abits, bit) { + return abits.testBit(bit)?1:0; +} + +function h$integer_cmm_mul2ExpIntegerzh(sa, abits, b) { + TRACE_INTEGER("mul2ExpInteger " + abits + " " + b); + return abits.shiftLeft(b); +} + +function h$integer_cmm_fdivQ2ExpIntegerzh(sa, abits, b) { + TRACE_INTEGER("fdivQ2ExpInteger " + abits + " " + b); + return abits.shiftRight(b); +} + +function h$integer_cmm_complementIntegerzh(sa, abits) { + TRACE_INTEGER("complementInteger " + abits); + return abits.not(); +} + +function h$integer_cmm_int64ToIntegerzh(a0, a1) { + TRACE_INTEGER("int64ToInteger " + a0 + " " + a1); + RETURN_UBX_TUP2(0, h$bigFromInt64(a0,a1)); +} + +function h$integer_cmm_word64ToIntegerzh(a0, a1) { + TRACE_INTEGER("word64ToInteger " + a0 + " " + a1); + RETURN_UBX_TUP2(0, h$bigFromWord64(a0,a1)) +} + +function h$hs_integerToInt64(as, abits) { + TRACE_INTEGER("integerToInt64 " + abits); + RETURN_UBX_TUP2(abits.shiftRight(32).intValue(), abits.intValue()); +} + +function h$hs_integerToWord64(as, abits) { + TRACE_INTEGER("integerToWord64 " + abits); + RETURN_UBX_TUP2(abits.shiftRight(32).intValue(), abits.intValue()); +} + +function h$integer_cmm_integer2Intzh(as, abits) { + TRACE_INTEGER("integer2Int " + abits); + return abits.intValue(); +} + +function h$integer_cbits_encodeDouble(as,abits,e) { + TRACE_INTEGER("encodeDouble " + abits + " " + e); + return h$encodeNumber(abits,e); +} + +function h$integer_cbits_encodeFloat(as,abits,e) { + TRACE_INTEGER("integerToInt64 " + abits + " " + e); + return h$encodeNumber(abits,e); +} + +function h$__int_encodeDouble(i,e) { + return i * Math.pow(2,e); +} + +function h$__int_encodeFloat(i,e) { + return i * Math.pow(2,e); +} + +function h$integer_wordLog2(w) { + TRACE_INTEGER("integer_wordLog2 " + w); + return 31 - h$clz32(w); +} + +function h$integer_integerLog2(i) { + TRACE_INTEGER("integer_integerLog2 " + i + " -> " + (i.bitLength()-1)); + return i.bitLength()-1; +} + +function h$integer_integerLog2IsPowerOf2(i) { + TRACE_INTEGER("integer_integerLog2IsPowerOf2 " + i); + var b = i.bitLength(); + var ret1 = (b === 0 || i.getLowestSetBit() !== b) ? 1 : 0; + TRACE_INTEGER("integer_integerLog2IsPowerOf2 result" + ret1 + " " + (b-1)); + RETURN_UBX_TUP2(b-1, ret1); +} + +function h$integer_intLog2IsPowerOf2(i) { + TRACE_INTEGER("integer_intLog2IsPowerOf2 " + i); + var l = 31 - h$clz32(i); + var ret1 = (i !== (1 << l)) ? 1 : 0; + TRACE_INTEGER("integer_intLog2IsPowerOf2 result " + ret1 + " " + l); + RETURN_UBX_TUP2(l, ret1); +} + +function h$integer_roundingMode(i,j) { + TRACE_INTEGER("integer_roundingMode"); + return 1; // round to even, is that correct? +} + +function h$integer_smartJ(i) { + TRACE_INTEGER("integer_smartJ"); + if(i.bitLength() >= 32) return MK_INTEGER_J(i); + return MK_INTEGER_S(i.intValue()|0); +} + +function h$integer_mpzToInteger(i) { + TRACE_INTEGER("integer_mpzToInteger"); + if(typeof i === 'number') return MK_INTEGER_S(i); + return h$integer_smartJ(i); +} + +var h$integer_negTwoThirtyOne = MK_INTEGER_J(h$bigFromInt(-2147483648).negate()); +function h$integer_mpzNeg(i) { + TRACE_INTEGER("integer_mpzNeg: " + i + " " + typeof i); + if(typeof i === 'number') { + return (i === -2147483648) ? h$integer_negTwoThirtyOne : -i; + } + return i.negate(); +} + +function h$integer_absInteger(i) { + TRACE_INTEGER("integer_absInteger"); + return i.abs(); +} + +function h$integer_negateInteger(i) { + TRACE_INTEGER("integer_negateInteger: " + i + " -> " + i.negate()); + return i.negate(); +} diff --git a/lib/boot/shims/src/md5.js b/lib/boot/shims/src/md5.js new file mode 100644 index 00000000..d1208d96 --- /dev/null +++ b/lib/boot/shims/src/md5.js @@ -0,0 +1,20 @@ + +function h$MD5Init(ctx, ctx_off) { + if(!ctx.arr) { ctx.arr = []; } + ctx.arr[ctx_off] = new goog.crypt.Md5(); +} +var h$__hsbase_MD5Init = h$MD5Init; + +function h$MD5Update(ctx, ctx_off, data, data_off, len) { + var arr = new Uint8Array(data.buf, data_off); + ctx.arr[ctx_off].update(arr, len); +} +var h$__hsbase_MD5Update = h$MD5Update; + +function h$MD5Final(dst, dst_off, ctx, ctx_off) { + var digest = ctx.arr[ctx_off].digest(); + for(var i=0;i<16;i++) { + dst.u8[dst_off+i] = digest[i]; + } +} +var h$__hsbase_MD5Final = h$MD5Final; diff --git a/lib/boot/shims/src/mem.js b/lib/boot/shims/src/mem.js new file mode 100644 index 00000000..f2a26ba4 --- /dev/null +++ b/lib/boot/shims/src/mem.js @@ -0,0 +1,1238 @@ +#include + +// #define GHCJS_TRACE_META 1 + +#ifdef GHCJS_TRACE_META +function h$logMeta(args) { h$log.apply(h$log,arguments); } +#define TRACE_META(args...) h$logMeta(args) +#else +#define TRACE_META(args...) +#endif +// memory management and pointer emulation + +// static init, non-caf +#ifdef GHCJS_PROF +function h$sti(i,c,xs,ccs) { +#else +function h$sti(i,c,xs) { +#endif + i.f = c; +#ifdef GHCJS_PROF + i.cc = ccs; +#endif + h$init_closure(i,xs); +} + +// static init, caf +#ifdef GHCJS_PROF +function h$stc(i,c,xs,ccs) { +#else +function h$stc(i,c,xs) { +#endif + i.f = c; +#ifdef GHCJS_PROF + i.cc = ccs; +#endif + h$init_closure(i,xs); + h$addCAF(i); +} + +#ifdef GHCJS_PROF +function h$stl(o, xs, t, ccs) { +#else +function h$stl(o, xs, t) { +#endif + var r = t ? t : h$ghczmprimZCGHCziTypesziZMZN; + var x; + if(xs.length > 0) { + for(var i=xs.length-1;i>=0;i--) { + x = xs[i]; + if(!x && x !== false && x !== 0) throw "h$toHsList: invalid element"; + r = MK_CONS_CC(x, r, ccs); + } + } + // fixme direct object manip + o.f = r.f; + o.d1 = r.d1; + o.d2 = r.d2; + o.m = r.m; +#ifdef GHCJS_PROF + o.cc = ccs; +#endif +} + +// some utilities for constructing common objects from JS in the RTS or foreign code. +// when profiling, the current ccs is assigned + +// #ifdef GHCJS_PROF +// var h$nil = h$c(h$ghczmprimZCGHCziTypesziZMZN_con_e, h$CCS_SYSTEM); +// #else +// var h$nil = h$c(h$ghczmprimZCGHCziTypesziZMZN_con_e); +// #endif + +// #ifdef GHCJS_PROF +// var h$nothing = h$c(h$baseZCGHCziBaseziNothing_con_e, h$CCS_SYSTEM); +// #else +//var h$nothing = h$c(h$baseZCGHCziBaseziNothing_con_e); +// #endif + +// delayed init for top-level closures +var h$staticDelayed = []; +function h$d() { +#ifdef GHCJS_PROF + // pass a temporary CCS that won't make assertions in h$cN family alert + var c = h$c(null, h$CCS_SYSTEM); +#else + var c = h$c(null); +#endif + h$staticDelayed.push(c); + return c; +} + +var h$allocN = 0; +function h$traceAlloc(x) { + h$log("allocating: " + (++h$allocN)); + x.alloc = h$allocN; +} + +// fixme remove this when we have a better way to immediately init these things +function h$di(c) { + h$staticDelayed.push(c); +} + +// initialize global object to primitive value +function h$p(x) { + h$staticDelayed.push(x); + return x; +} + +var h$entriesStack = []; +var h$staticsStack = []; +var h$labelsStack = []; + +function h$scheduleInit(entries, objs, lbls, infos, statics) { + var d = h$entriesStack.length; + h$entriesStack.push(entries); + h$staticsStack.push(objs); + h$labelsStack.push(lbls); + h$initStatic.push(function() { + h$initInfoTables(d, entries, objs, lbls, infos, statics); + }); +} + +function h$runInitStatic() { + if(h$initStatic.length > 0) { + for(var i=h$initStatic.length - 1;i>=0;i--) { + h$initStatic[i](); + } + h$initStatic = []; + } + // free the references to the temporary tables used for + // initialising all our static data + h$entriesStack = null; + h$staticsStack = null; +} + +// initialize packed info tables +// see Gen2.Compactor for how the data is encoded +function h$initInfoTables ( depth // depth in the base chain + , funcs // array with all entry functions + , objects // array with all the global heap objects + , lbls // array with non-haskell labels + , infoMeta // packed info + , infoStatic + ) { + TRACE_META("decoding info tables"); + var n, i, j, o, pos = 0, info; + function code(c) { + if(c < 34) return c - 32; + if(c < 92) return c - 33; + return c - 34; + } + function next() { + var c = info.charCodeAt(pos); + if(c < 124) { + TRACE_META("pos: " + pos + " decoded: " + code(c)); + pos++; + return code(c); + } + if(c === 124) { + pos+=3; + var r = 90 + 90 * code(info.charCodeAt(pos-2)) + + code(info.charCodeAt(pos-1)); + TRACE_META("pos: " + (pos-3) + " decoded: " + r); + return r; + } + if(c === 125) { + pos+=4; + var r = 8190 + 8100 * code(info.charCodeAt(pos-3)) + + 90 * code(info.charCodeAt(pos-2)) + + code(info.charCodeAt(pos-1)); + TRACE_META("pos: " + (pos-4) + " decoded: " + r); + return r; + } + throw ("h$initInfoTables: invalid code in info table: " + c + " at " + pos) + } + function nextCh() { + return next(); // fixme map readable chars + } + function nextInt() { + var n = next(); + var r; + if(n === 0) { + var n1 = next(); + var n2 = next(); + r = n1 << 16 | n2; + } else { + r = n - 12; + } + TRACE_META("decoded int: " + r); + return r; + } + function nextSignificand() { + var n = next(); + var n1, n2, n3, n4, n5; + var r; + if(n < 2) { + n1 = next(); + n2 = next(); + n3 = next(); + n4 = next(); + n5 = n1 * 281474976710656 + n2 * 4294967296 + n3 * 65536 + n4; + r = n === 0 ? -n5 : n5; + } else { + r = n - 12; + } + TRACE_META("decoded significand:" + r); + return r; + } + function nextEntry(o) { return nextIndexed("nextEntry", h$entriesStack, o); } + function nextObj(o) { return nextIndexed("nextObj", h$staticsStack, o); } + function nextLabel(o) { return nextIndexed("nextLabel", h$labelsStack, o); } + function nextIndexed(msg, stack, o) { + var n = (o === undefined) ? next() : o; + var i = depth; + while(n > stack[i].length) { + n -= stack[i].length; + i--; + if(i < 0) throw (msg + ": cannot find item " + n + ", stack length: " + stack.length + " depth: " + depth); + } + return stack[i][n]; + } + function nextArg() { + var o = next(); + var n, n1, n2, d0, d1, d2, d3; + var isString = false; + switch(o) { + case 0: + TRACE_META("bool arg: false"); + return false; + case 1: + TRACE_META("bool arg: true"); + return true; + case 2: + TRACE_META("int constant: 0"); + return 0; + case 3: + TRACE_META("int constant: 1"); + return 1; + case 4: + TRACE_META("int arg"); + return nextInt(); + case 5: + TRACE_META("literal arg: null"); + return null; + case 6: + TRACE_META("double arg"); + n = next(); + switch(n) { + case 0: + return -0.0; + case 1: + return 0.0; + case 2: + return 1/0; + case 3: + return -1/0; + case 4: + return 0/0; + case 5: + n1 = nextInt(); + var ns = nextSignificand(); + if(n1 > 600) { + return ns * Math.pow(2,n1-600) * Math.pow(2,600); + } else if(n1 < -600) { + return ns * Math.pow(2,n1+600) * Math.pow(2,-600); + } else { + return ns * Math.pow(2, n1); + } + default: + n1 = n - 36; + return nextSignificand() * Math.pow(2, n1); + } + case 7: + TRACE_META("string arg"); + isString = true; + // no break, strings are null temrinated UTF8 encoded binary with + case 8: + TRACE_META("binary arg"); + n = next(); + var ba = h$newByteArray(isString ? (n+1) : n); + var b8 = ba.u8; + if(isString) b8[n] = 0; + var p = 0; + while(n > 0) { + switch(n) { + case 1: + d0 = next(); + d1 = next(); + b8[p] = ((d0 << 2) | (d1 >> 4)); + break; + case 2: + d0 = next(); + d1 = next(); + d2 = next(); + b8[p++] = ((d0 << 2) | (d1 >> 4)); + b8[p] = ((d1 << 4) | (d2 >> 2)); + break; + default: + d0 = next(); + d1 = next(); + d2 = next(); + d3 = next(); + b8[p++] = ((d0 << 2) | (d1 >> 4)); + b8[p++] = ((d1 << 4) | (d2 >> 2)); + b8[p++] = ((d2 << 6) | d3); + break; + } + n -= 3; + } + return ba; + case 9: + var isFun = next() === 1; + var lbl = nextLabel(); + return h$initPtrLbl(isFun, lbl); + case 10: + var c = { f: nextEntry(), d1: null, d2: null, m: 0 }; + var n = next(); + var args = []; + while(n--) { + args.push(nextArg()); + } + return h$init_closure(c, args); + default: + TRACE_META("object arg: " + (o-11)); + return nextObj(o-11); + } + } + info = infoMeta; pos = 0; + for(i=0;i>> 1; + oregs = (regs << 8) | skip; + oa = arity + ((regs-1+skip) << 8); + break; + case 2: // con + ot = 2; + oa = next(); + break; + case 3: // stack frame + ot = -1; + oa = 0; + oregs = next() - 1; + if(oregs !== -1) oregs = ((oregs >>> 1) << 8) | (oregs & 1); + break; + default: throw ("h$initInfoTables: invalid closure type") + } + var size = next() - 1; + var nsrts = next(); + var srt = null; + if(nsrts > 0) { + srt = []; + for(var j=0;jn;j++) { + b.u8[j] = next(); + } + break; + case 8: // staticEmptyList + TRACE_META("staticEmptyList"); + o.f = HS_NIL_CON; + break; + case 9: // staticList + TRACE_META("staticList"); + n = next(); + var hasTail = next(); + var c = (hasTail === 1) ? nextObj() : HS_NIL; + TRACE_META("list length: " + n); + while(n--) { + c = MK_CONS(nextArg(), c); + } + o.f = c.f; + o.d1 = c.d1; + o.d2 = c.d2; + break; + case 10: // staticData n args + TRACE_META("staticData"); + n = next(); + TRACE_META("args: " + n); + o.f = nextEntry(); + for(j=0;j ByteArray# copy + var dst = arguments[0]; + var src = arguments[1]; + var n = arguments[2]; + for(var i=n-1;i>=0;i--) { + dst.u8[i] = src.u8[i]; + } + RETURN_UBX_TUP2(dst, 0); + } else if(arguments.length === 5) { // Addr# -> Addr# copy + var dst = arguments[0]; + var dst_off = arguments[1] + var src = arguments[2]; + var src_off = arguments[3]; + var n = arguments[4]; + for(var i=n-1;i>=0;i--) { + dst.u8[i+dst_off] = src.u8[i+src_off]; + } + RETURN_UBX_TUP2(dst, dst_off); + } else { + throw "h$memcpy: unexpected argument"; + } +} + +// note: only works for objects bigger than two! +function h$setField(o,n,v) { + if(n > 0 && !o.d2) o.d2 = {}; + switch(n) { + case 0: + o.d1 = v; + return; + case 1: + o.d2.d1 = v; + return; + case 2: + o.d2.d2 = v; + return; + case 3: + o.d2.d3 = v; + return; + case 4: + o.d2.d4 = v; + return; + case 5: + o.d2.d5 = v; + return; + case 6: + o.d2.d6 = v; + return; + case 7: + o.d2.d7 = v; + return; + case 8: + o.d2.d8 = v; + return; + case 9: + o.d2.d9 = v; + return; + case 10: + o.d2.d10 = v; + return; + case 11: + o.d2.d11 = v; + return; + case 12: + o.d2.d12 = v; + return; + case 13: + o.d2.d13 = v; + return; + case 14: + o.d2.d14 = v; + return; + case 15: + o.d2.d15 = v; + return; + case 16: + o.d2.d16 = v; + return; + case 17: + o.d2.d17 = v; + return; + case 18: + o.d2.d18 = v; + return; + case 19: + o.d2.d19 = v; + return; + case 20: + o.d2.d20 = v; + return; + case 21: + o.d2.d21 = v; + return; + case 22: + o.d2.d22 = v; + return; + case 23: + o.d2.d23 = v; + return; + case 24: + o.d2.d24 = v; + return; + case 25: + o.d2.d25 = v; + return; + case 26: + o.d2.d26 = v; + return; + case 27: + o.d2.d27 = v; + return; + case 28: + o.d2.d28 = v; + return; + case 29: + o.d2.d29 = v; + return; + case 30: + o.d2.d30 = v; + return; + case 31: + o.d2.d31 = v; + return; + case 32: + o.d2.d32 = v; + return; + case 33: + o.d2.d33 = v; + return; + case 34: + o.d2.d34 = v; + return; + case 35: + o.d2.d35 = v; + return; + case 36: + o.d2.d36 = v; + return; + case 37: + o.d2.d37 = v; + return; + case 38: + o.d2.d38 = v; + return; + case 39: + o.d2.d39 = v; + return; + case 40: + o.d2.d40 = v; + return; + case 41: + o.d2.d41 = v; + return; + case 42: + o.d2.d42 = v; + return; + case 43: + o.d2.d43 = v; + return; + case 44: + o.d2.d44 = v; + return; + case 45: + o.d2.d45 = v; + return; + case 45: + o.d2.d45 = v; + return; + case 46: + o.d2.d46 = v; + return; + case 47: + o.d2.d47 = v; + return; + case 48: + o.d2.d48 = v; + return; + case 49: + o.d2.d49 = v; + return; + case 50: + o.d2.d50 = v; + return; + case 51: + o.d2.d51 = v; + return; + case 52: + o.d2.d52 = v; + return; + case 53: + o.d2.d53 = v; + return; + case 54: + o.d2.d54 = v; + return; + case 55: + o.d2.d55 = v; + return; + case 56: + o.d2.d56 = v; + return; + case 57: + o.d2.d57 = v; + return; + case 58: + o.d2.d58 = v; + return; + case 59: + o.d2.d59 = v; + return; + case 60: + o.d2.d60 = v; + return; + case 61: + o.d2.d61 = v; + return; + case 62: + o.d2.d62 = v; + return; + case 63: + o.d2.d63 = v; + return; + case 64: + o.d2.d64 = v; + return; + case 65: + o.d2.d65 = v; + return; + case 66: + o.d2.d66 = v; + return; + case 67: + o.d2.d67 = v; + return; + case 68: + o.d2.d68 = v; + return; + case 69: + o.d2.d69 = v; + return; + case 70: + o.d2.d70 = v; + return; + case 71: + o.d2.d71 = v; + return; + case 72: + o.d2.d72 = v; + return; + case 73: + o.d2.d73 = v; + return; + case 74: + o.d2.d74 = v; + return; + case 75: + o.d2.d75 = v; + return; + case 76: + o.d2.d76 = v; + return; + case 77: + o.d2.d77 = v; + return; + case 78: + o.d2.d78 = v; + return; + case 79: + o.d2.d79 = v; + return; + case 80: + o.d2.d80 = v; + return; + case 81: + o.d2.d81 = v; + return; + case 82: + o.d2.d82 = v; + return; + case 83: + o.d2.d83 = v; + return; + case 84: + o.d2.d84 = v; + return; + case 85: + o.d2.d85 = v; + return; + case 86: + o.d2.d86 = v; + return; + case 87: + o.d2.d87 = v; + return; + case 88: + o.d2.d88 = v; + return; + case 89: + o.d2.d89 = v; + return; + case 90: + o.d2.d90 = v; + return; + case 91: + o.d2.d91 = v; + return; + case 92: + o.d2.d92 = v; + return; + case 93: + o.d2.d93 = v; + return; + case 94: + o.d2.d94 = v; + return; + case 95: + o.d2.d95 = v; + return; + case 96: + o.d2.d96 = v; + return; + case 97: + o.d2.d97 = v; + return; + case 98: + o.d2.d98 = v; + return; + case 99: + o.d2.d99 = v; + return; + case 100: + o.d2.d100 = v; + return; + case 101: + o.d2.d101 = v; + return; + case 102: + o.d2.d102 = v; + return; + case 103: + o.d2.d103 = v; + return; + case 104: + o.d2.d104 = v; + return; + case 105: + o.d2.d105 = v; + return; + case 106: + o.d2.d106 = v; + return; + case 107: + o.d2.d107 = v; + return; + default: + throw ("h$setField: setter not implemented for field: " + n); + } +} + + +function h$mkExportDyn(t, f) { + h$log("making dynamic export: " + t); + h$log("haskell fun: " + f + " " + h$collectProps(f)); + + // fixme register things, global static data + var ff = function() { + h$log("running some haskell for you"); + return 12; + }; + return h$mkPtr(ff, 0); +} + +function h$memchr(a_v, a_o, c, n) { + for(var i=0;i *, you cannot return IO ByteArray# + from a foreign import, even with the UnliftedFFITypes + extension. Return a JSVal instead and use unsafeCoerce + to convert it to a Data.Primitive.ByteArray.ByteArray or + Data.Primitive.ByteArray.MutableByteArray (primitive package) + and pattern match on the constructor to get the + primitive value out. + + These types have the same runtime representation (a data + constructor with one regular (one JavaScript variable) + field) as a JSVal, so the conversion is safe, as long + as everything is fully evaluated. +*/ +function h$wrapBuffer(buf, unalignedOk, offset, length) { + if(!unalignedOk && offset && offset % 8 !== 0) { + throw ("h$wrapBuffer: offset not aligned:" + offset); + } + if(!buf || !(buf instanceof ArrayBuffer)) + throw "h$wrapBuffer: not an ArrayBuffer" + if(!offset) { offset = 0; } + if(!length || length < 0) { length = buf.byteLength - offset; } + return { buf: buf + , len: length + , i3: (offset%4) ? null : new Int32Array(buf, offset, length >> 2) + , u8: new Uint8Array(buf, offset, length) + , u1: (offset%2) ? null : new Uint16Array(buf, offset, length >> 1) + , f3: (offset%4) ? null : new Float32Array(buf, offset, length >> 2) + , f6: (offset%8) ? null : new Float64Array(buf, offset, length >> 3) + , dv: new DataView(buf, offset, length) + }; +} + +var h$arrayBufferCounter = 0; + +function h$arrayBufferId(a) { + if (a.__ghcjsArrayBufferId === undefined) + a.__ghcjsArrayBufferId = h$arrayBufferCounter++; + return a.__ghcjsArrayBufferId; +} + +function h$comparePointer(a1,o1,a2,o2) { + var i1 = h$arrayBufferId(a1.buf); + var i2 = h$arrayBufferId(a2.buf); + if (i1 === i2) { + var bo1 = a1.dv.byteOffset + o1; + var bo2 = a2.dv.byteOffset + o2; + return bo1 === bo2 ? 0 : (bo1 < bo2 ? -1 : 1); + } + else + return i1 < i2 ? -1 : 1; +} + +/* + A StableName is represented as either a h$StableName object (for most heap objects) + or a number (for heap objects with unboxed representation) + + Holding on to a StableName does not keep the original object alive. + */ +var h$stableNameN = 1; +/** @constructor */ +function h$StableName(m) { + this.m = m; + this.s = null; +} + +function h$makeStableName(x) { + if(typeof x === 'number') { + return x; + } else if(IS_WRAPPED_NUMBER(x)) { + return UNWRAP_NUMBER(x); + } else if(typeof x === 'object') { + if(typeof x.m !== 'object') { + x.m = new h$StableName(x.m); + } + return x.m; + } else { + throw new Error("h$makeStableName: invalid argument"); + } +} + +function h$stableNameInt(s) { + if(typeof s === 'number') { + if(s!=s) return 999999; // NaN + var s0 = s|0; + if(s0 === s) return s0; + h$convertDouble[0] = s; + return h$convertInt[0] ^ h$convertInt[1]; + } else { + var x = s.s; + if(x === null) { + x = s.s = h$stableNameN = (h$stableNameN+1)|0; + } + return x; + } +} + +function h$eqStableName(s1o,s2o) { + if(s1o!=s1o && s2o!=s2o) return 1; // NaN + return s1o === s2o ? 1 : 0; +} + +function h$makeStablePtr(v) { + var buf = h$newByteArray(4); + buf.arr = [v]; + RETURN_UBX_TUP2(buf, 0); +} + +function h$hs_free_stable_ptr(stable) { + +} + +function h$malloc(n) { + RETURN_UBX_TUP2(h$newByteArray(n), 0); +} + +function h$free() { + +} + +function h$memset() { + var buf_v, buf_off, chr, n; + buf_v = arguments[0]; + if(arguments.length == 4) { // Addr# + buf_off = arguments[1]; + chr = arguments[2]; + n = arguments[3]; + } else if(arguments.length == 3) { // ByteString# + buf_off = 0; + chr = arguments[1]; + n = arguments[2]; + } else { + throw("h$memset: unexpected argument") + } + var end = buf_off + n; + for(var i=buf_off;i 0) { + var tmp = new Uint8Array(b_v.buf.slice(b_o,b_o+n)); + for(var i=0;i= addr_d.len) { + addr_d.buf = null; + addr_d.i3 = null; + addr_d.u8 = null; + addr_d.u1 = null; + addr_d.f3 = null; + addr_d.f6 = null; + addr_d.dv = null; + } + return 0; +} diff --git a/lib/boot/shims/src/node-exports.js b/lib/boot/shims/src/node-exports.js new file mode 100644 index 00000000..a8d2db82 --- /dev/null +++ b/lib/boot/shims/src/node-exports.js @@ -0,0 +1,19 @@ +// add exported things to global again, run this after all node modules +/* +var h$glbl = this; +for(p in exports) { +// console.log("exporting: " + p); +// console.log("type: " + (typeof this[p])); + if(typeof this[p] === 'undefined') { + h$glbl[p] = exports[p]; + } +} +*/ +if(typeof exports !== 'undefined') { + if(typeof WeakMap === 'undefined' && typeof global !== 'undefined') { + global.WeakMap = exports.WeakMap; + } +// var Map = exports.Map; +// var Set = exports.Set; +} + diff --git a/lib/boot/shims/src/object.js b/lib/boot/shims/src/object.js new file mode 100644 index 00000000..9979a0a5 --- /dev/null +++ b/lib/boot/shims/src/object.js @@ -0,0 +1,102 @@ +#include + +// JS Objects stuff + +function h$isFloat (n) { + return n===+n && n!==(n|0); +} + +function h$isInteger (n) { + return n===+n && n===(n|0); +} + +/* + -- 0 - null, 1 - integer, + -- 2 - float, 3 - bool, + -- 4 - string, 5 - array + -- 6 - object +*/ +function h$typeOf(o) { + if (!(o instanceof Object)) { + if (o == null) { + return 0; + } else if (typeof o == 'number') { + if (h$isInteger(o)) { + return 1; + } else { + return 2; + } + } else if (typeof o == 'boolean') { + return 3; + } else { + return 4; + } + } else { + if (Object.prototype.toString.call(o) == '[object Array]') { + // it's an array + return 5; + } else if (!o) { + // null + return 0; + } else { + // it's an object + return 6; + } + } +} + +function h$flattenObj(o) { + var l = [], i = 0; + for (var prop in o) { + l[i++] = [prop, o[prop]]; + } + return l; +} + +/* + + build an object from key/value pairs: + var obj = h$buildObject(key1, val1, key2, val2, ...); + + note: magic name: + invocations of this function are replaced by object literals wherever + possible + + */ +function h$buildObject() { + var r = {}, l = arguments.length; + for(var i = 0; i < l; i += 2) { + var k = arguments[i], v = arguments[i+1]; + r[k] = v; + } + return r; +} + +// same as above, but from a list: [k1,v1,k2,v2,...] +function h$buildObjectFromList(xs) { + var r = {}, k, v, t; + while(IS_CONS(xs)) { + xs = CONS_TAIL(xs); + t = CONS_TAIL(xs); + if(IS_CONS(t)) { + k = CONS_HEAD(xs); + v = CONS_HEAD(t); + xs = CONS_TAIL(t); + r[k] = v; + } else { + return r; + } + } + return r; +} + +// same as above, but from a list of tuples [(k1,v1),(k2,v2),...] +function h$buildObjectFromTupList(xs) { + var r = {}; + while(IS_CONS(xs)) { + var h = CONS_HEAD(xs); + xs = CONS_TAIL(xs); + r[JSVAL_VAL(TUP2_1(h))] = JSVAL_VAL(TUP2_2(h)); + } + return r; +} diff --git a/lib/boot/shims/src/platform.js b/lib/boot/shims/src/platform.js new file mode 100644 index 00000000..f8f64c02 --- /dev/null +++ b/lib/boot/shims/src/platform.js @@ -0,0 +1,89 @@ + +/* platform-specific setup */ + +// top-level debug initialization needs this. declare it in case we aren't in the same file as out.js +function h$ghcjszmprimZCGHCJSziPrimziJSVal_con_e() { return h$stack[h$sp]; }; + +/* + if browser mode is active (GHCJS_BROWSER is defined), all the runtime platform + detection code should be removed by the preprocessor. The h$isPlatform variables + are undeclared. + + in non-browser mode, use h$isNode, h$isJsShell, h$isBrowser to find the current + platform. + + more platforms should be added here in the future +*/ +#ifndef GHCJS_BROWSER +var h$isNode = false; // runtime is node.js +var h$isJvm = false; // runtime is JVM +var h$isJsShell = false; // runtime is SpiderMonkey jsshell +var h$isJsCore = false; // runtime is JavaScriptCore jsc +var h$isBrowser = false; // running in browser or everything else + +var h$isGHCJSi = false; // Code is GHCJSi (browser or node) + +// load all required node.js modules +if(typeof process !== 'undefined' && (typeof h$TH !== 'undefined' || (typeof require !== 'undefined' && typeof module !== 'undefined' && module.exports))) { + h$isNode = true; + // we have to use these names for the closure compiler externs to work + var fs = require('fs'); + var path = require('path'); + var os = require('os'); + var child_process = require('child_process'); + var h$fs = fs; + var h$path = path; + var h$os = os; + var h$child = child_process; + var h$process = process; + function h$getProcessConstants() { + // this is a non-public API, but we need these values for things like file access modes + var cs = process['binding']('constants'); + if(typeof cs.os === 'object' && typeof cs.fs === 'object') { + return cs; + } else { + // earlier node.js versions (4.x and older) have all constants directly in the constants object + // construct something that resembles the hierarchy of the object in new versions: + return { 'fs': cs + , 'crypto': cs + , 'os': { 'UV_UDP_REUSEADDR': cs['UV_UDP_REUSEADDR'] + , 'errno': cs + , 'signals': cs + } + }; + } + } + var h$processConstants = h$getProcessConstants(); +} else if(typeof Java !== 'undefined') { + h$isJvm = true; + this.console = { + log: function(s) { + java.lang.System.out.print(s); + } + }; +} else if(typeof snarf !== 'undefined' && typeof print !== 'undefined' && typeof quit !== 'undefined') { + h$isJsShell = true; + this.console = { log: this.print }; +} else if(typeof numberOfDFGCompiles !== 'undefined' && typeof jscStack !== 'undefined') { + h$isJsCore = true; +} else { + h$isBrowser = true; +} +if(typeof global !== 'undefined' && global.h$GHCJSi) { + h$isGHCJSi = true; +} +#endif + +function h$getGlobal(that) { + if(typeof global !== 'undefined') return global; + return that; +} + +#ifdef GHCJS_BROWSER +// IE 8 doesn't support Date.now(), shim it +if (!Date.now) { + Date.now = function now() { + return +(new Date); + }; +} +#endif diff --git a/lib/boot/shims/src/profiling.js b/lib/boot/shims/src/profiling.js new file mode 100644 index 00000000..19f17931 --- /dev/null +++ b/lib/boot/shims/src/profiling.js @@ -0,0 +1,327 @@ +// Used definitions: GHCJS_TRACE_PROF and GHCJS_ASSERT_PROF + +#ifdef GHCJS_ASSERT_PROF +function assert(condition, message) { + if (!condition) { + console.trace(message || "Assertion failed"); + } +} +#define ASSERT(args...) assert(args) +#else +#define ASSERT(args...) +#endif + +#ifdef GHCJS_TRACE_PROF +#define TRACE(args...) h$log(args) +#else +#define TRACE(args...) +#endif + +/* + install the ghcjs-profiling package from /utils/ghcjs-node-profiling + to collect cost centre stack information with the node.js profiler + */ +var h$registerCC = null, h$registerCCS = null, h$setCCS = null; +var h$runProf = function(f) { + f(); +} +if(h$isNode) { + (function() { + try { + var p = require('ghcjs-profiling'); + if(p.isProfiling()) { + h$registerCC = p.registerCC; + h$registerCCS = p.registerCCS; + h$setCCS = p.setCCS; + h$runProf = p.runCC; + } + } catch(e) {} + })(); +} + +var h$cachedCurrentCcs = -1; +function h$reportCurrentCcs() { + if(h$setCCS) { + if(h$currentThread) { + var ccsKey = h$currentThread.ccs._key; + if(h$cachedCurrentCcs !== ccsKey) { + h$cachedCurrentCcs = ccsKey; + h$setCCS(ccsKey); + } + } else if(h$cachedCurrentCcs !== -1) { + h$cachedCurrentCcs = -1; + h$setCCS(2147483647); // set to invalid CCS + } + } +} + + +var h$ccList = []; +var h$ccsList = []; + +var h$CCUnique = 0; +/** @constructor */ +function h$CC(label, module, srcloc, isCaf) { + //TRACE("h$CC(", label, ", ", module, ", ", srcloc, ", ", isCaf, ")"); + this.label = label; + this.module = module; + this.srcloc = srcloc; + this.isCaf = isCaf; + this._key = h$CCUnique++; + this.memAlloc = 0; + this.timeTicks = 0; + if(h$registerCC) h$registerCC(this._key, label, module + ' ' + srcloc, -1,-1); + h$ccList.push(this); +} + + +var h$CCSUnique = 0; +/** @constructor */ +function h$CCS(parent, cc) { + //TRACE("h$mkCCS(", parent, cc, ")"); + if (parent !== null && parent.consed.has(cc)) { + return (parent.consed.get(cc)); + } + this.consed = new h$Map(); + this.cc = cc; + this._key = h$CCSUnique++; + if (parent) { + this.root = parent.root; + this.depth = parent.depth + 1; + this.prevStack = parent; + parent.consed.put(cc,this); + } else { + this.root = this; + this.depth = 0; + this.prevStack = null; + } + this.prevStack = parent; + this.sccCount = 0; + this.timeTicks = 0; + this.memAlloc = 0; + this.inheritedTicks = 0; + this.inheritedAlloc = 0; + if(h$registerCCS) { + var x = this, stack = []; + while(x) { stack.push(x.cc._key); x = x.prevStack; } + h$registerCCS(this._key, stack); + } + h$ccsList.push(this); /* we need all ccs for statistics, not just the root ones */ +} + + +// +// Built-in cost-centres and stacks +// + +var h$CC_MAIN = new h$CC("MAIN", "MAIN", "", false); +var h$CC_SYSTEM = new h$CC("SYSTEM", "SYSTEM", "", false); +var h$CC_GC = new h$CC("GC", "GC", "", false); +var h$CC_OVERHEAD = new h$CC("OVERHEAD_of", "PROFILING", "", false); +var h$CC_DONT_CARE = new h$CC("DONT_CARE", "MAIN", "", false); +var h$CC_PINNED = new h$CC("PINNED", "SYSTEM", "", false); +var h$CC_IDLE = new h$CC("IDLE", "IDLE", "", false); +var h$CAF_cc = new h$CC("CAF", "CAF", "", false); + +var h$CCS_MAIN = new h$CCS(null, h$CC_MAIN); + +var h$CCS_SYSTEM = new h$CCS(h$CCS_MAIN, h$CC_SYSTEM); +var h$CCS_GC = new h$CCS(h$CCS_MAIN, h$CC_GC); +var h$CCS_OVERHEAD = new h$CCS(h$CCS_MAIN, h$CC_OVERHEAD); +var h$CCS_DONT_CARE = new h$CCS(h$CCS_MAIN, h$CC_DONT_CARE); +var h$CCS_PINNED = new h$CCS(h$CCS_MAIN, h$CC_PINNED); +var h$CCS_IDLE = new h$CCS(h$CCS_MAIN, h$CC_IDLE); +var h$CAF = new h$CCS(h$CCS_MAIN, h$CAF_cc); + + +// +// Cost-centre entries, SCC +// + +#ifdef GHCJS_TRACE_PROF +function h$ccsString(ccs) { + var labels = []; + do { + labels.push(ccs.cc.module+'.'+ccs.cc.label+' '+ccs.cc.srcloc); + ccs = ccs.prevStack; + } while (ccs !== null); + return '[' + labels.reverse().join(', ') + ']'; +} +#endif + +function h$pushRestoreCCS() { + TRACE("push restoreccs:" + h$ccsString(h$currentThread.ccs)); + if(h$stack[h$sp] !== h$setCcs_e) { + h$sp += 2; + h$stack[h$sp-1] = h$currentThread.ccs; + h$stack[h$sp] = h$setCcs_e; + } +} + +function h$restoreCCS(ccs) { + TRACE("restoreccs from:", h$ccsString(h$currentThread.ccs)); + TRACE(" to:", h$ccsString(ccs)); + h$currentThread.ccs = ccs; + h$reportCurrentCcs(); +} + +function h$enterThunkCCS(ccsthunk) { + ASSERT(ccsthunk !== null && ccsthunk !== undefined, "ccsthunk is null or undefined"); + TRACE("entering ccsthunk:", h$ccsString(ccsthunk)); + h$currentThread.ccs = ccsthunk; + h$reportCurrentCcs(); +} + +function h$enterFunCCS(ccsapp, // stack at call site + ccsfn // stack of function + ) { + ASSERT(ccsapp !== null && ccsapp !== undefined, "ccsapp is null or undefined"); + ASSERT(ccsfn !== null && ccsfn !== undefined, "ccsfn is null or undefined"); + TRACE("ccsapp:", h$ccsString(ccsapp)); + TRACE("ccsfn:", h$ccsString(ccsfn)); + + // common case 1: both stacks are the same + if (ccsapp === ccsfn) { + return; + } + + // common case 2: the function stack is empty, or just CAF + if (ccsfn.prevStack === h$CCS_MAIN) { + return; + } + + // FIXME: do we need this? + h$currentThread.ccs = h$CCS_OVERHEAD; + + // common case 3: the stacks are completely different (e.g. one is a + // descendent of MAIN and the other of a CAF): we append the whole + // of the function stack to the current CCS. + if (ccsfn.root !== ccsapp.root) { + h$currentThread.ccs = h$appendCCS(ccsapp, ccsfn); + h$reportCurrentCcs(); + return; + } + + // uncommon case 4: ccsapp is deeper than ccsfn + if (ccsapp.depth > ccsfn.depth) { + var tmp = ccsapp; + var dif = ccsapp.depth - ccsfn.depth; + for (var i = 0; i < dif; i++) { + tmp = tmp.prevStack; + } + h$currentThread.ccs = h$enterFunEqualStacks(ccsapp, tmp, ccsfn); + h$reportCurrentCcs(); + return; + } + + // uncommon case 5: ccsfn is deeper than CCCS + if (ccsfn.depth > ccsapp.depth) { + h$currentThread.ccs = h$enterFunCurShorter(ccsapp, ccsfn, ccsfn.depth - ccsapp.depth); + h$reportCurrentCcs(); + return; + } + + // uncommon case 6: stacks are equal depth, but different + h$currentThread.ccs = h$enterFunEqualStacks(ccsapp, ccsapp, ccsfn); + h$reportCurrentCcs(); +} + +function h$appendCCS(ccs1, ccs2) { + if (ccs1 === ccs2) { + return ccs1; + } + + if (ccs2 === h$CCS_MAIN || ccs2.cc.isCaf) { + // stop at a CAF element + return ccs1; + } + + return h$pushCostCentre(h$appendCCS(ccs1, ccs2.prevStack), ccs2.cc); +} + +function h$enterFunCurShorter(ccsapp, ccsfn, n) { + if (n === 0) { + ASSERT(ccsapp.length === ccsfn.length, "ccsapp.length !== ccsfn.length"); + return h$enterFunEqualStacks(ccsapp, ccsapp, ccsfn); + } else { + ASSERT(ccsfn.depth > ccsapp.depth, "ccsfn.depth <= ccsapp.depth"); + return h$pushCostCentre(h$enterFunCurShorter(ccsapp, ccsfn.prevStack, n-1), ccsfn.cc); + } +} + +function h$enterFunEqualStacks(ccs0, ccsapp, ccsfn) { + ASSERT(ccsapp.depth === ccsfn.depth, "ccsapp.depth !== ccsfn.depth"); + if (ccsapp === ccsfn) return ccs0; + return h$pushCostCentre(h$enterFunEqualStacks(ccs0, ccsapp.prevStack, ccsfn.prevStack), ccsfn.cc); +} + +function h$pushCostCentre(ccs, cc) { + TRACE("pushing cost centre", cc.label, "to", h$ccsString(ccs)); + if (ccs === null) { + // when is ccs null? + return new h$CCS(ccs, cc); + } + + if (ccs.cc === cc) { + return ccs; + } else { + var temp_ccs = h$checkLoop(ccs, cc); + if (temp_ccs !== null) { + return temp_ccs; + } + return new h$CCS(ccs, cc); + } +} + +function h$checkLoop(ccs, cc) { + while (ccs !== null) { + if (ccs.cc === cc) + return ccs; + ccs = ccs.prevStack; + } + return null; +} + +// +// Emulating pointers for cost-centres and cost-centre stacks +// + +var h$ccsCC_offset = 4; // ccs->cc +var h$ccsPrevStackOffset = 8; // ccs->prevStack + +var h$ccLabel_offset = 4; // cc->label +var h$ccModule_offset = 8; // cc->module +var h$ccsrcloc_offset = 12; // cc->srcloc + +function h$buildCCPtr(o) { + // last used offset is 12, so we need to allocate 20 bytes + ASSERT(o !== null); + var cc = h$newByteArray(20); +#ifdef GHCJS_TRACE_PROF + cc.myTag = "cc pointer"; +#endif + cc.arr = []; + cc.arr[h$ccLabel_offset] = [h$encodeUtf8(o.label), 0]; + cc.arr[h$ccModule_offset] = [h$encodeUtf8(o.module), 0]; + cc.arr[h$ccsrcloc_offset] = [h$encodeUtf8(o.srcloc), 0]; + return cc; +} + +function h$buildCCSPtr(o) { + ASSERT(o !== null); + // last used offset is 8, allocate 16 bytes + var ccs = h$newByteArray(16); +#ifdef GHCJS_TRACE_PROF + ccs.myTag = "ccs pointer"; +#endif + ccs.arr = []; + if (o.prevStack !== null) { + ccs.arr[h$ccsPrevStackOffset] = [h$buildCCSPtr(o.prevStack), 0]; + } + // FIXME: we may need this part: + // else { + // ccs.arr[h$ccsPrevStackOffset] = [null, 0]; + // } + ccs.arr[h$ccsCC_offset] = [h$buildCCPtr(o.cc), 0]; + return ccs; +} diff --git a/lib/boot/shims/src/staticpointer.js b/lib/boot/shims/src/staticpointer.js new file mode 100644 index 00000000..26c60621 --- /dev/null +++ b/lib/boot/shims/src/staticpointer.js @@ -0,0 +1,51 @@ +#include + +// static pointers +var h$static_pointer_table = null; +var h$static_pointer_table_keys = null; + +function h$hs_spt_insert(key1,key2,key3,key4,ref) { + // h$log("hs_spt_insert: " + key1 + " " + key2 + " " + key3 + " " + key4 + " -> " + h$collectProps(ref)); + if(!h$static_pointer_table) { + h$static_pointer_table = []; + h$static_pointer_table_keys = []; + } + if(!h$hs_spt_lookup_key(key1,key2,key3,key4)) { + var ba = h$newByteArray(16); + ba.i3[0] = key1; + ba.i3[1] = key2; + ba.i3[2] = key3; + ba.i3[3] = key4; + h$static_pointer_table_keys.push([ba,0]); + h$retain({ root: ref, _key: -1 }); + } + var s = h$static_pointer_table; + if(!s[key1]) s[key1] = []; + if(!s[key1][key2]) s[key1][key2] = []; + if(!s[key1][key2][key3]) s[key1][key2][key3] = []; + s[key1][key2][key3][key4] = ref; +} + +function h$hs_spt_key_count() { + return h$static_pointer_table_keys ? + h$static_pointer_table_keys.length : 0; +} + +function h$hs_spt_keys(tgt_d, tgt_o, n) { + var ks = h$static_pointer_table_keys; + if(!tgt_d.arr) tgt_d.arr = []; + for(var i=0;(i> 2; + RETURN_UBX_TUP2(h$hs_spt_lookup_key(i3[o],i3[o+1],i3[o+2],i3[o+3]), 0); +} + +function h$hs_spt_lookup_key(key1,key2,key3,key4) { + var s = h$static_pointer_table; + if(s && s[key1] && s[key1][key2] && s[key1][key2][key3] && + s[key1][key2][key3][key4]) return s[key1][key2][key3][key4]; + return null; +} diff --git a/lib/boot/shims/src/stm.js b/lib/boot/shims/src/stm.js new file mode 100644 index 00000000..bc740f2b --- /dev/null +++ b/lib/boot/shims/src/stm.js @@ -0,0 +1,318 @@ +// software transactional memory + +#ifdef GHCJS_TRACE_STM +function h$logStm() { if(arguments.length == 1) { + h$log("stm: " + arguments[0]); + } else { + h$log.apply(h$log,arguments); + } + } +#define TRACE_STM(args...) h$logStm(args) +#else +#define TRACE_STM(args...) +#endif + + +var h$stmTransactionActive = 0; +var h$stmTransactionWaiting = 4; +/** @constructor */ +function h$Transaction(o, parent) { + TRACE_STM("h$Transaction: " + o + " -> " + parent); + this.action = o; + // h$TVar -> h$WrittenTVar, transaction-local changed values + this.tvars = new h$Map(); + // h$TVar -> h$LocalTVar, all local tvars accessed anywhere in the transaction + this.accessed = parent===null?new h$Map():parent.accessed; + // nonnull while running a check, contains read variables in this part of the transaction + this.checkRead = parent===null?null:parent.checkRead; + this.parent = parent; + this.state = h$stmTransactionActive; + this.invariants = []; // invariants added in this transaction + this.m = 0; // gc mark +} + +var h$stmInvariantN = 0; +/** @constructor */ +function h$StmInvariant(a) { + this.action = a; + this._key = ++h$stmInvariantN; +} +/** @constructor */ +function h$WrittenTVar(tv,v) { + this.tvar = tv; + this.val = v; +} + +var h$TVarN = 0; +/** @constructor */ +function h$TVar(v) { + TRACE_STM("creating TVar, value: " + h$collectProps(v)); + this.val = v; // current value + this.blocked = new h$Set(); // threads that get woken up if this TVar is updated + this.invariants = null; // invariants that use this TVar (h$Set) + this.m = 0; // gc mark + this._key = ++h$TVarN; // for storing in h$Map/h$Set +} + +/** @constructor */ +function h$TVarsWaiting(s) { + this.tvars = s; // h$Set of TVars we're waiting on +} + +/** @constructor */ +function h$LocalInvariant(o) { + this.action = o; + this.dependencies = new h$Set(); +} + +// local view of a TVar +/** @constructor */ +function h$LocalTVar(v) { + TRACE_STM("creating TVar view for: " + h$collectProps(v)); + this.readVal = v.val; // the value when read from environment + this.val = v.val; // the current uncommitted value + this.tvar = v; +} + +function h$atomically(o) { + h$p3(o, h$atomically_e, h$checkInvariants_e); + return h$stmStartTransaction(o); +} + +function h$stmStartTransaction(o) { + TRACE_STM("starting transaction: " + h$collectProps(o)); + var t = new h$Transaction(o, null); + h$currentThread.transaction = t; + h$r1 = o; + return h$ap_1_0_fast(); +} + +function h$stmUpdateInvariantDependencies(inv) { + var ii, iter = h$currentThread.transaction.checkRead.iter(); + if(inv instanceof h$LocalInvariant) { + while((ii = iter.next()) !== null) inv.dependencies.add(ii); + } else { + while((ii = iter.next()) !== null) h$stmAddTVarInvariant(ii, inv); + } +} + +function h$stmAddTVarInvariant(tv, inv) { + if(tv.invariants === null) tv.invariants = new h$Set(); + tv.invariants.add(inv); +} + +// commit current transaction, +// if it's top-level, commit the TVars, otherwise commit to parent +function h$stmCommitTransaction() { + var t = h$currentThread.transaction; + var tvs = t.tvars; + var wtv, i = tvs.iter(); + if(t.parent === null) { // top-level commit + TRACE_STM("committing top-level transaction"); + // write new value to TVars and collect blocked threads + var thread, threadi, blockedThreads = new h$Set(); + while((wtv = i.nextVal()) !== null) { + h$stmCommitTVar(wtv.tvar, wtv.val, blockedThreads); + } + // wake up all blocked threads + threadi = blockedThreads.iter(); + while((thread = threadi.next()) !== null) { + h$stmRemoveBlockedThread(thread.blockedOn, thread); + h$wakeupThread(thread); + } + // commit our new invariants + for(var j=0;j 0) { + var f = h$stack[h$sp]; + if(f === h$atomically_e || f === h$stmCatchRetry_e) { + break; + } + var size; + if(f === h$ap_gen) { + size = ((h$stack[h$sp-1] >> 8) + 2); + } else { + var tag = f.gtag; + if(tag < 0) { // dynamic size + size = h$stack[h$sp-1]; + } else { + size = (tag & 0xff) + 1; + } + } + h$sp -= size; + } + // either h$sp == 0 or at a handler + if(h$sp > 0) { + if(f === h$atomically_e) { + return h$stmSuspendRetry(); + } else { // h$stmCatchRetry_e + var b = h$stack[h$sp-1]; + h$stmAbortTransaction(); + h$sp -= 2; + h$r1 = b; + return h$ap_1_0_fast(); + } + } else { + throw "h$stmRetry: STM retry outside a transaction"; + } +} + +function h$stmSuspendRetry() { + var tv, i = h$currentThread.transaction.accessed.iter(); + var tvs = new h$Set(); + while((tv = i.next()) !== null) { + TRACE_STM("h$stmSuspendRetry, accessed: " + h$collectProps(tv)); + tv.blocked.add(h$currentThread); + tvs.add(tv); + } + var waiting = new h$TVarsWaiting(tvs); + h$currentThread.interruptible = true; + h$p2(waiting, h$stmResumeRetry_e); + return h$blockThread(h$currentThread, waiting); +} + +function h$stmCatchRetry(a,b) { + h$currentThread.transaction = new h$Transaction(b, h$currentThread.transaction); + h$p2(b, h$stmCatchRetry_e); + h$r1 = a; + return h$ap_1_0_fast(); +} + +function h$catchStm(a,handler) { + h$p4(h$currentThread.transaction, h$currentThread.mask, handler, h$catchStm_e); + h$r1 = a; + return h$ap_1_0_fast(); +} + +function h$newTVar(v) { + return new h$TVar(v); +} + +function h$readTVar(tv) { + return h$readLocalTVar(h$currentThread.transaction,tv); +} + +function h$readTVarIO(tv) { + return tv.val; +} + +function h$writeTVar(tv, v) { + h$setLocalTVar(h$currentThread.transaction, tv, v); +} + +function h$sameTVar(tv1, tv2) { + return tv1 === tv2; +} + +// get the local value of the TVar in the transaction t +// tvar is added to the read set +function h$readLocalTVar(t, tv) { + if(t.checkRead !== null) { + t.checkRead.add(tv); + } + var t0 = t; + while(t0 !== null) { + var v = t0.tvars.get(tv); + if(v !== null) { + TRACE_STM("h$readLocalTVar: found locally modified value: " + h$collectProps(v)); + return v.val; + } + t0 = t0.parent; + } + var lv = t.accessed.get(tv); + if(lv !== null) { + TRACE_STM("h$readLocalTVar: found TVar value: " + h$collectProps(lv)); + return lv.val; + } else { + TRACE_STM("h$readLocalTVar: TVar value not found, adding: " + h$collectProps(tv)); + t.accessed.put(tv, new h$LocalTVar(tv)); + return tv.val; + } +} + +function h$setLocalTVar(t, tv, v) { + if(!t.accessed.has(tv)) t.accessed.put(tv, new h$LocalTVar(tv)); + if(t.tvars.has(tv)) { + t.tvars.get(tv).val = v; + } else { + t.tvars.put(tv, new h$WrittenTVar(tv, v)); + } +} + +function h$stmCheckInvariants() { + var t = h$currentThread.transaction; + function addCheck(inv) { + h$p5(inv, h$stmCheckInvariantResult_e, t, inv, h$stmCheckInvariantStart_e); + } + h$p2(h$r1, h$return); + var wtv, i = t.tvars.iter(); + while((wtv = i.nextVal()) !== null) { + TRACE_STM("h$stmCheckInvariants: checking: " + h$collectProps(wtv)); + var ii = wtv.tvar.invariants; + if(ii) { + var iv, iii = ii.iter(); + while((iv = iii.next()) !== null) addCheck(iv); + } + } + for(var j=0;j + +// encode a string constant +function h$str(s) { + var enc = null; + return function() { + if(enc === null) { + enc = h$encodeModifiedUtf8(s); + } + return enc; + } +} + +// encode a packed string +// since \0 is used to separate strings (and a common occurrence) +// we add the following mapping: +// - \0 -> \cz\0 +// - \cz -> \cz\cz +// +// decoding to bytes, the following is produced: +// - \cz\0 -> C0 80 +// - \cz\cz -> 1A + +function h$pstr(s) { + var enc = null; + return function() { + if(enc === null) { + enc = h$encodePackedUtf8(s); + } + return enc; + } +} +// encode a raw string from bytes +function h$rstr(d) { + var enc = null; + return function() { + if(enc === null) { + enc = h$rawStringData(d); + } + return enc; + } +} + +// these aren't added to the CAFs, so the list stays in mem indefinitely, is that a problem? +#ifdef GHCJS_PROF +function h$strt(str, cc) { return MK_LAZY_CC(function() { return h$toHsString(str, cc); }, cc); } +function h$strta(str, cc) { return MK_LAZY_CC(function() { return h$toHsStringA(str, cc); }, cc); } +function h$strtb(arr, cc) { return MK_LAZY_CC(function() { return h$toHsStringMU8(arr, cc); }, cc); } +#else +function h$strt(str) { return MK_LAZY(function() { return h$toHsString(str); }); } +function h$strta(str) { return MK_LAZY(function() { return h$toHsStringA(str); }); } +function h$strtb(arr) { return MK_LAZY(function() { return h$toHsStringMU8(arr); }); } +#endif + +// unpack strings without thunks +#ifdef GHCJS_PROF +function h$ustra(str, cc) { return h$toHsStringA(str, cc); } +function h$ustr(str, cc) { return h$toHsString(str, cc); } // utf8 string, string argument +function h$urstra(arr, cc) { return h$toHsList(arr, cc); } // ascii string, array of codepoints argument +function h$urstr(arr, cc) { return h$toHsStringMU8(arr, cc); } // utf8 string, array of bytes argumnt +#else +function h$ustra(str) { return h$toHsStringA(str); } +function h$ustr(str) { return h$toHsString(str); } +function h$urstra(arr) { return h$toHsList(arr); } +function h$urstr(arr) { return h$toHsStringMU8(arr); } +#endif + +function h$caseMapping(x) { + return (x%2)?-((x+1)>>1):(x>>1); +} + +var h$toUpper = null; +function h$u_towupper(ch) { + if(h$toUpper == null) { h$toUpper = h$decodeMapping(h$toUpperMapping, h$caseMapping); } + return ch+(h$toUpper[ch]|0); +} + +var h$toLower = null; +function h$u_towlower(ch) { + if(h$toLower == null) { h$toLower = h$decodeMapping(h$toLowerMapping, h$caseMapping); } + return ch+(h$toLower[ch]|0); +} + +var h$alpha = null; +function h$u_iswalpha(a) { + if(h$alpha == null) { h$alpha = h$decodeRLE(h$alphaRanges); } + return h$alpha[a]|0; +} + +var h$alnum = null; +function h$u_iswalnum(a) { + if(h$alnum == null) { h$alnum = h$decodeRLE(h$alnumRanges); } + return h$alnum[a] == 1 ? 1 : 0; +} + +// var h$spaceChars = [9,10,11,12,13,32,160,5760,8192,8193,8194,8195,8196,8197,8198,8199,8200,8201,8202,8239,8287,12288]; +function h$isSpace(a) { + if(a<5760) return a===32||(a>=9&&a<=13)||a===160; + return (a>=8192&&a<=8202)||a===5760||a===8239||a===8287||a===12288; +} + +function h$u_iswspace(a) { + return h$isSpace(a)?1:0; +} + +var h$lower = null; +function h$u_iswlower(a) { + if(h$lower == null) { h$lower = h$decodeRLE(h$lowerRanges); } + if(a < 0x30000) return h$lower[a]|0; + if(a < 0xE0000) return 0; + return h$lower[a-0xB0000]|0; +} + +var h$upper = null; +function h$u_iswupper(a) { + if(h$upper == null) { h$upper = h$decodeRLE(h$upperRanges); } + if(a < 0x30000) return h$upper[a]|0; + if(a < 0xE0000) return 0; + return h$upper[a-0xB0000]|0; +} + + +var h$cntrlChars = [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159]; +var h$cntrl = null; +function h$u_iswcntrl(a) { + if(h$cntrl === null) { + h$cntrl = []; + for(var i=0;i<=159;i++) h$cntrl[i] = (h$cntrlChars.indexOf(i) !== -1) ? 1 : 0; + } + return a <= 159 ? h$cntrl[a] : 0; +} + +var h$print = null; +function h$u_iswprint(a) { + if(h$print == null) { h$print = h$decodeRLE(h$printRanges); } + if(a < 0x30000) return h$print[a]|0; + if(a < 0xE0000) return 0; + return h$print[a-0xB0000]|0; +} + +// decode a packed string (Compactor encoding method) to an array of numbers +function h$decodePacked(s) { + function f(o) { + var c = s.charCodeAt(o); + return c<34?c-32:c<92?c-33:c-34; + } + var r=[], i=0; + while(i < s.length) { + var c = s.charCodeAt(i); + if(c < 124) r.push(f(i++)); + else if(c === 124) { + i += 3; r.push(90+90*f(i-2)+f(i-1)); + } else if(c === 125) { + i += 4; + r.push(8190+8100*f(i-3)+90*f(i-2)+f(i-1)); + } else throw ("h$decodePacked: invalid: " + c); + } + return r; +} + +// decode string with encoded character ranges +function h$decodeRLE(str) { + var r = [], x = 0, i = 0, j = 0, v, k, a = h$decodePacked(str); + while(i < a.length) { + v = a[i++]; + if(v === 0) { // alternating + k = a[i++]; + while(k--) { + r[j++] = x; + r[j++] = 1-x; + } + } else { + if(v <= 2) { + k = (a[i]<<16)+a[i+1]; + i+=2; + } else k = (v-1)>>1; + if(v%2) { + r[j++] = x; + x = 1-x; + } + while(k--) r[j++] = x; + x = 1-x; + } + } + r.shift(); + return r; +} + +function h$decodeMapping(str, f) { + var r = [], i = 0, j = 0, k, v, v2, a = h$decodePacked(str); + while(i < a.length) { + v = a[i++]; + if(v === 0) { // alternating + k = a[i]; + v = f(a[i+1]); + v2 = f(a[i+2]); + while(k--) { + r[j++] = v; + r[j++] = v2; + } + i+=3; + } else { + if(v === 2) { + k = (a[i] << 16) + a[i+1]; + v = a[i+2]; + i += 3; + } else if(v%2) { + k = 1; + v = v>>1; + } else { + k = (v>>1)-1; + v = a[i++]; + } + v = f(v); + while(k--) r[j++] = v; + } + } + return r; +} + +var h$unicodeCat = null; +function h$u_gencat(a) { + if(h$unicodeCat == null) h$unicodeCat = h$decodeMapping(h$catMapping, function(x) { return x; }); + // private use + if(a >= 0xE000 && a <= 0xF8FF || a >= 0xF0000 & a <= 0xFFFFD || a >= 0x100000 && a <= 0x10FFFD) return 28; + var c = a < 0x30000 ? (h$unicodeCat[a]|0) : + (a < 0xE0000 ? 0 : (h$unicodeCat[a-0xB0000]|0)); + return c?c-1:29; +} + +function h$localeEncoding() { + // h$log("### localeEncoding"); + RETURN_UBX_TUP2(h$encodeUtf8("UTF-8"), 0); // offset 0 +} + +function h$rawStringData(str) { + var v = h$newByteArray(str.length+1); + var u8 = v.u8; + for(var i=0;i> 6) | 0xC0; + u8[n+1] = (c & 0x3F) | 0x80; + n+=2; + } else if(c <= 0xFFFF) { + u8[n] = (c >> 12) | 0xE0; + u8[n+1] = ((c >> 6) & 0x3F) | 0x80; + u8[n+2] = (c & 0x3F) | 0x80; + n+=3; + } else if(c <= 0x1FFFFF) { + u8[n] = (c >> 18) | 0xF0; + u8[n+1] = ((c >> 12) & 0x3F) | 0x80; + u8[n+2] = ((c >> 6) & 0x3F) | 0x80; + u8[n+3] = (c & 0x3F) | 0x80; + n+=4; + } else if(c <= 0x3FFFFFF) { + u8[n] = (c >> 24) | 0xF8; + u8[n+1] = ((c >> 18) & 0x3F) | 0x80; + u8[n+2] = ((c >> 12) & 0x3F) | 0x80; + u8[n+3] = ((c >> 6) & 0x3F) | 0x80; + u8[n+4] = (c & 0x3F) | 0x80; + n+=5; + } else { + u8[n] = (c >>> 30) | 0xFC; + u8[n+1] = ((c >> 24) & 0x3F) | 0x80; + u8[n+2] = ((c >> 18) & 0x3F) | 0x80; + u8[n+3] = ((c >> 12) & 0x3F) | 0x80; + u8[n+4] = ((c >> 6) & 0x3F) | 0x80; + u8[n+5] = (c & 0x3F) | 0x80; + n+=6; + } + } + u8[v.len-1] = 0; // terminator +// h$log("### encodeUtf8: " + str); +// h$log(v); + return v; +} +*/ +// modified: encode \0 -> 192 128 +// packed: encode \cz\cz -> 26 +// \cz\0 -> 192 128 +function h$encodeUtf8Internal(str, modified, packed) { + var i, low; + var n = 0; + var czescape = false; + for(i=0;i 26 + n-=1; + } else if(c === 0) { // \cz\0 -> 192 128 + // no adjustments needed + } else { + throw new Error("invalid cz escaped character: " + c); + } + czescape = false; + } else { + czescape = c === 26; + } + } + } + var v = h$newByteArray(n+1); + var u8 = v.u8; + n = 0; + for(i=0;i> 6) | 0xC0; + u8[n+1] = (c & 0x3F) | 0x80; + n+=2; + } else if(c <= 0xFFFF) { + u8[n] = (c >> 12) | 0xE0; + u8[n+1] = ((c >> 6) & 0x3F) | 0x80; + u8[n+2] = (c & 0x3F) | 0x80; + n+=3; + } else if(c <= 0x1FFFFF) { + u8[n] = (c >> 18) | 0xF0; + u8[n+1] = ((c >> 12) & 0x3F) | 0x80; + u8[n+2] = ((c >> 6) & 0x3F) | 0x80; + u8[n+3] = (c & 0x3F) | 0x80; + n+=4; + } else if(c <= 0x3FFFFFF) { + u8[n] = (c >> 24) | 0xF8; + u8[n+1] = ((c >> 18) & 0x3F) | 0x80; + u8[n+2] = ((c >> 12) & 0x3F) | 0x80; + u8[n+3] = ((c >> 6) & 0x3F) | 0x80; + u8[n+4] = (c & 0x3F) | 0x80; + n+=5; + } else { + u8[n] = (c >>> 30) | 0xFC; + u8[n+1] = ((c >> 24) & 0x3F) | 0x80; + u8[n+2] = ((c >> 18) & 0x3F) | 0x80; + u8[n+3] = ((c >> 12) & 0x3F) | 0x80; + u8[n+4] = ((c >> 6) & 0x3F) | 0x80; + u8[n+5] = (c & 0x3F) | 0x80; + n+=6; + } + } + u8[v.len-1] = 0; // terminator +// h$log("### encodeUtf8: " + str); +// h$log(v); + return v; +} + + +// encode a javascript string to a zero terminated utf16 byte array +function h$encodeUtf16(str) { + var n = 0; + var i; + for(i=0;i> 10, true); + dv.setUint16(n+2, c0 & 0x3FF, true); + n+=4; + } + } + dv.setUint8(v.len-1,0); // terminator + return v; +} + + +/* +function h$encodeUtf16(str) { + var b = new DataView(new ArrayBuffer(str.length * 2)); + for(var i=str.length-1;i>=0;i--) { + b.setUint16(i<<1, str.charCodeAt(i)); + } + h$ret1 = 0; + return b; +} +var h$eU16 = h$encodeUtf16; + +function h$decodeUtf16(v,start) { + return h$decodeUtf16(v, v.byteLength - start, start); +} + +function h$decodeUtf16z(v,start) { + var len = v.byteLength - start; + for(var i=start;i>1] = v.dv.getUint16(i+start,true); + } + return h$charCodeArrayToString(arr); +} +var h$dU16 = h$decodeUtf16; + +// decode a buffer with UTF-8 chars to a JS string +// stop at the first zero +function h$decodeUtf8z(v,start) { +// h$log("h$decodeUtf8z"); + var n = start; + var max = v.len; + while(n < max) { +// h$log("### " + n + " got char: " + v.u8[n]); + if(v.u8[n] === 0) { break; } + n++; + } + return h$decodeUtf8(v,n,start); +} + +// decode a buffer with Utf8 chars to a JS string +// invalid characters are ignored +function h$decodeUtf8(v,n0,start) { +// h$log("### decodeUtf8"); +// h$log(v); + var n = n0 || v.len; + var arr = []; + var i = start || 0; + var code; + var u8 = v.u8; +// h$log("### decoding, starting at: " + i); + while(i < n) { + var c = u8[i]; + while((c & 0xC0) === 0x80) { + c = u8[++i]; + } +// h$log("### lead char: " + c); + if((c & 0x80) === 0) { + code = (c & 0x7F); + i++; + } else if((c & 0xE0) === 0xC0) { + code = ( ((c & 0x1F) << 6) + | (u8[i+1] & 0x3F) + ); + i+=2; + } else if((c & 0xF0) === 0xE0) { + code = ( ((c & 0x0F) << 12) + | ((u8[i+1] & 0x3F) << 6) + | (u8[i+2] & 0x3F) + ); + i+=3; + } else if ((c & 0xF8) === 0xF0) { + code = ( ((c & 0x07) << 18) + | ((u8[i+1] & 0x3F) << 12) + | ((u8[i+2] & 0x3F) << 6) + | (u8[i+3] & 0x3F) + ); + i+=4; + } else if((c & 0xFC) === 0xF8) { + code = ( ((c & 0x03) << 24) + | ((u8[i+1] & 0x3F) << 18) + | ((u8[i+2] & 0x3F) << 12) + | ((u8[i+3] & 0x3F) << 6) + | (u8[i+4] & 0x3F) + ); + i+=5; + } else { + code = ( ((c & 0x01) << 30) + | ((u8[i+1] & 0x3F) << 24) + | ((u8[i+2] & 0x3F) << 18) + | ((u8[i+3] & 0x3F) << 12) + | ((u8[i+4] & 0x3F) << 6) + | (u8[i+5] & 0x3F) + ); + i+=6; + } + // h$log("### decoded codePoint: " + code + " - " + String.fromCharCode(code)); // String.fromCodePoint(code)); + // need to deal with surrogate pairs + if(code > 0xFFFF) { + var offset = code - 0x10000; + arr.push(0xD800 + (offset >> 10), 0xDC00 + (offset & 0x3FF)); + } else { + arr.push(code); + } + } + return h$charCodeArrayToString(arr); +} + +// fixme what if terminator, then we read past end +function h$decodeUtf16(v) { + var n = v.len; + var arr = []; + var dv = v.dv; + for(var i=0;i " + toStr); +// return 1; // fixme? +} + +function h$hs_iconv_close(iconv) { + return 0; +} + +// ptr* -> ptr (array) +function h$derefPtrA(ptr, ptr_off) { + return ptr.arr[ptr_off][0]; +} +// ptr* -> ptr (offset) +function h$derefPtrO(ptr, ptr_off) { + return ptr.arr[ptr_off][1]; +} + +// word** -> word ptr[x][y] +function h$readPtrPtrU32(ptr, ptr_off, x, y) { + x = x || 0; + y = y || 0; + var arr = ptr.arr[ptr_off + 4 * x]; + return arr[0].dv.getInt32(arr[1] + 4 * y, true); +} + +// char** -> char ptr[x][y] +function h$readPtrPtrU8(ptr, ptr_off, x, y) { + x = x || 0; + y = y || 0; + var arr = ptr.arr[ptr_off + 4 * x]; + return arr[0].dv.getUint8(arr[1] + y); +} + +// word** ptr[x][y] = v +function h$writePtrPtrU32(ptr, ptr_off, v, x, y) { + x = x || 0; + y = y || 0; + var arr = ptr.arr[ptr_off + 4 * x]; + arr[0].dv.putInt32(arr[1] + y, v); +} + +// unsigned char** ptr[x][y] = v +function h$writePtrPtrU8(ptr, ptr_off, v, x, y) { + x = x || 0; + y = y || 0; + var arr = ptr.arr[ptr_off+ 4 * x]; + arr[0].dv.putUint8(arr[1] + y, v); +} + +// convert JavaScript String to a Haskell String +#ifdef GHCJS_PROF +function h$toHsString(str, cc) { +#else +function h$toHsString(str) { +#endif + if(typeof str !== 'string') return HS_NIL; + var i = str.length - 1; + var r = HS_NIL; + while(i>=0) { + var cp = str.charCodeAt(i); + if(cp >= 0xDC00 && cp <= 0xDFFF && i > 0) { + --i; + cp = (cp - 0xDC00) + (str.charCodeAt(i) - 0xD800) * 1024 + 0x10000; + } + r = MK_CONS_CC(cp, r, cc); + --i; + } + return r; +} + +// string must have been completely forced first +function h$fromHsString(str) { + var xs = ''; + while(IS_CONS(str)) { + var h = CONS_HEAD(str); + xs += String.fromCharCode(UNWRAP_NUMBER(h)); + str = CONS_TAIL(str); + } + return xs; +} + +// list of JSVal to array, list must have been completely forced first +function h$fromHsListJSVal(xs) { + var arr = []; + while(IS_CONS(xs)) { + arr.push(JSVAL_VAL(CONS_HEAD(xs))); + xs = CONS_TAIL(xs); + } + return arr; +} + +// ascii only version of the above +#ifdef GHCJS_PROF +function h$toHsStringA(str, cc) { +#else +function h$toHsStringA(str) { +#endif + if(typeof str !== 'string') return HS_NIL; + var i = str.length - 1; + var r = HS_NIL; + while(i>=0) { + r = MK_CONS_CC(str.charCodeAt(i), r, cc); + --i; + } + return r; +} + +// convert array with modified UTF-8 encoded text +#ifdef GHCJS_PROF +function h$toHsStringMU8(arr, cc) { +#else +function h$toHsStringMU8(arr) { +#endif + var accept = false, b, n = 0, cp = 0, r = HS_NIL; + while(i >= 0) { + b = arr[i]; + if(!(b & 128)) { + cp = b; + accept = true; + } else if((b & 192) === 128) { + cp += (b & 32) * Math.pow(64, n) + } else { + cp += (b&((1<<(6-n))-1)) * Math.pow(64, n); + accept = true; + } + if(accept) { + r = MK_CONS_CC(cp, r, cc); + cp = 0 + n = 0; + } else { + n++; + } + accept = false; + i--; + } + return r; +} + +#ifdef GHCJS_PROF +function h$toHsList(arr, cc) { +#else +function h$toHsList(arr) { +#endif + var r = HS_NIL; + for(var i=arr.length-1;i>=0;i--) { + r = MK_CONS_CC(arr[i], r, cc); + } + return r; +} + +// array of JS values to Haskell list of JSVal +#ifdef GHCJS_PROF +function h$toHsListJSVal(arr, cc) { +#else +function h$toHsListJSVal(arr) { +#endif + var r = HS_NIL; + for(var i=arr.length-1;i>=0;i--) { + r = MK_CONS_CC(MK_JSVAL(arr[i]), r, cc); + } + return r; +} + +// unpack ascii string, append to existing Haskell string +#ifdef GHCJS_PROF +function h$appendToHsStringA(str, appendTo, cc) { +#else +function h$appendToHsStringA(str, appendTo) { +#endif + var i = str.length - 1; + var r = appendTo; + while(i>=0) { + r = MK_CONS_CC(str.charCodeAt(i), r, cc); + --i; + } + return r; +} + +// throw e wrapped in a GHCJS.Prim.JSException in the current thread +function h$throwJSException(e) { + // create a JSException object and wrap it in a SomeException + // adding the Exception dictionary + var someE = MK_SOMEEXCEPTION(HS_JSEXCEPTION_EXCEPTION, +#ifdef GHCJS_PROF + MK_JSEXCEPTION(MK_JSVAL(e), h$toHsString(e.toString(), h$CCS_SYSTEM)) +#else + MK_JSEXCEPTION(MK_JSVAL(e), h$toHsString(e.toString())) +#endif + ); + return h$throw(someE, true); +} diff --git a/lib/boot/shims/src/structs.js b/lib/boot/shims/src/structs.js new file mode 100644 index 00000000..32b8e47f --- /dev/null +++ b/lib/boot/shims/src/structs.js @@ -0,0 +1,462 @@ +/* + simple set with reasonably fast iteration though an array, which may contain nulls + elements must be objects that have a unique _key property + collections are expected to be homogeneous + + when iterating over a set with an iterator, the following operations are safe: + + - adding an element to the set (the existing iterator will iterate over the new elements) + - removing the last returned element through the iterator + + behaviour for deleting elements is unpredictable and unsafe +*/ + +/** @constructor */ +function h$Set(s) { + this._vals = []; + this._keys = []; + this._size = 0; +} + +h$Set.prototype.size = function() { + return this._size; +} + +h$Set.prototype.add = function(o) { +#ifdef GHCJS_STRUCTS_ASSERTS + if((typeof o !== 'object' && typeof o !== 'function') || typeof o._key !== 'number') throw ("h$Set.add: invalid element: " + o); + if(this._size > 0) { +// if(this._storedProto !== o.prototype) throw ("h$Set.add: unexpected element prototype: " + o) + } else { + this._storedProto = o.prototype; + } + if(this._keys[o._key] !== undefined && this._vals[this._keys[o._key]] !== o) throw ("h$Set.add: duplicate key: " + o); +#endif + var k = this._keys, v = this._vals; + if(k[o._key] === undefined) { + k[o._key] = this._size; + v[this._size++] = o; + } +} + +h$Set.prototype.remove = function(o) { + if(this._size === 0) return; + var k = this._keys, v = this._vals, x = k[o._key]; + if(x !== undefined) { + delete k[o._key]; + var ls = --this._size; + if(ls !== x) { + var l = v[ls]; + v[x] = l; + k[l._key] = x; + } + v[ls] = null; + if(v.length > 10 && 2 * v.length > 3 * ls) this._vals = v.slice(0, ls); + } +} + +h$Set.prototype.has = function(o) { + return this._keys[o._key] !== undefined; +} + +h$Set.prototype.clear = function() { + if(this._size > 0) { + this._keys = []; + this._vals = []; + this._size = 0; + } +} + +h$Set.prototype.iter = function() { + return new h$SetIter(this); +} + +// returns an array with all values, might contain additional nulls at the end +h$Set.prototype.values = function() { + return this._vals; +} + +/** @constructor */ +function h$SetIter(s) { + this._n = 0; + this._s = s; + this._r = true; +} + +h$SetIter.prototype.next = function() { + if(this._n < this._s._size) { + this._r = false; + return this._s._vals[this._n++]; + } else { + this._r = true; + return null; + } +} + +h$SetIter.prototype.peek = function() { + if(this._n < this._s._size) { + return this._s.vals[this._n]; + } else { + return null; + } +} + +// remove the last element returned +h$SetIter.prototype.remove = function() { + if(!this._r) { + this._s.remove(this._s._vals[--this._n]); + this._r = true; + } +} + +/* + map, iteration restrictions are the same as for set + keys need to be objects with a unique _key property + + keys are expected to have the same prototype + + values may be anything (but note that the values array might have additional nulls) +*/ + +/** @constructor */ +function h$Map() { + this._pairsKeys = []; + this._pairsValues = []; + this._keys = []; + this._size = 0; +} + +h$Map.prototype.size = function() { + return this._size; +} + +h$Map.prototype.put = function(k,v) { +#ifdef GHCJS_STRUCTS_ASSERTS + if((typeof k !== 'object' && typeof k !== 'function') || typeof k._key !== 'number') throw ("h$Map.add: invalid key: " + k); + if(this._size > 0) { + if(this._storedProto !== k.prototype) throw ("h$Map.add: unexpected key prototype: " + k) + } else { + this._storedProto = k.prototype; + } + if(this._keys[k._key] !== undefined && this._pairsKeys[this._keys[k._key]] !== k) throw ("h$Map.add: duplicate key: " + k); +#endif + var ks = this._keys, pk = this._pairsKeys, pv = this._pairsValues, x = ks[k._key]; + if(x === undefined) { + var n = this._size++; + ks[k._key] = n; + pk[n] = k; + pv[n] = v; + } else { + pv[x] = v; + } +} + +h$Map.prototype.remove = function(k) { + var kk = k._key, ks = this._keys, pk = this._pairsKeys, pv = this._pairsValues, x = ks[kk]; + if(x !== undefined) { + delete ks[kk]; + var ss = --this._size; + if(ss !== x) { + pks = pk[ss]; + pk[x] = pks; + pv[x] = pv[ss]; + ks[pks._key] = x; + } + pv[ss] = null; + pk[ss] = null; + + if(pk.length > 10 && 2 * pk.length > 3 * this._size) { + this._pairsKeys = pk.slice(0,ss); + this._pairsValues = pv.slice(0,ss); + } + } +} + +h$Map.prototype.has = function(k) { + return this._keys[k._key] !== undefined; +} + +h$Map.prototype.get = function(k) { + var n = this._keys[k._key]; + if(n !== undefined) { + return this._pairsValues[n]; + } else { + return null; + } +} + +h$Map.prototype.iter = function() { + return new h$MapIter(this); +} + +// returned array might have some trailing nulls +h$Map.prototype.keys = function () { + return this._pairsKeys; +} + +// returned array might have some trailing nulls +h$Map.prototype.values = function() { + return this._pairsValues; +} + +/** @constructor */ +function h$MapIter(m) { + this._n = 0; + this._m = m; +} + +h$MapIter.prototype.next = function() { + return this._n < this._m._size ? this._m._pairsKeys[this._n++] : null; +} + +h$MapIter.prototype.nextVal = function() { + return this._n < this._m._size ? this._m._pairsValues[this._n++] : null; +} + +h$MapIter.prototype.peek = function() { + return this._n < this._m._size ? this._m._pairsKeys[this._n] : null; +} + +h$MapIter.prototype.peekVal = function() { + return this._n < this._m._size ? this._m._pairsValues[this._n] : null; +} + +/* + simple queue, returns null when empty + it's safe to enqueue new items while iterating, not safe to dequeue + (new items will not be iterated over) +*/ +#ifndef GHCJS_QUEUE_BLOCK_SIZE +#define GHCJS_QUEUE_BLOCK_SIZE 1000 +#endif + +/** @constructor */ +function h$Queue() { + var b = { b: [], n: null }; + this._blocks = 1; + this._first = b; + this._fp = 0; + this._last = b; + this._lp = 0; +} + +h$Queue.prototype.length = function() { + return GHCJS_QUEUE_BLOCK_SIZE * (this._blocks - 1) + this._lp - this._fp; +} + +h$Queue.prototype.isEmpty = function() { + return this._blocks === 1 && this._lp >= this._fp; +} + +h$Queue.prototype.enqueue = function(o) { + if(this._lp === GHCJS_QUEUE_BLOCK_SIZE) { + var newBlock = { b: [o], n: null }; + this._blocks++; + this._last.n = newBlock; + this._last = newBlock; + this._lp = 1; + } else { + this._last.b[this._lp++] = o; + } +} + +h$Queue.prototype.dequeue = function() { + if(this._blocks === 1 && this._fp >= this._lp) { + return null; + } else { + var qfb = this._first.b, r = qfb[this._fp]; + qfb[this._fp] = null; + if(++this._fp === GHCJS_QUEUE_BLOCK_SIZE) { + if(this._blocks === 1) { + this._lp = 0; + } else { + this._blocks--; + this._first = this._first.n; + } + this._fp = 0; + } else if(this._blocks === 1 && this._fp >= this._lp) { + this._lp = this._fp = 0; + } + return r; + } +} + +h$Queue.prototype.peek = function() { + if(this._blocks === 0 || (this._blocks === 1 && this._fp >= this._lp)) { + return null; + } else { + return this._first.b[this._fp]; + } +} + +h$Queue.prototype.iter = function() { + var b = this._first, bp = this._fp, lb = this._last, lp = this._lp; + return function() { + if(b === null || (b === lb && bp >= lp)) { + return null; + } else { + var r = b.b[bp]; + if(++bp === GHCJS_QUEUE_BLOCK_SIZE) { + b = b.n; + bp = 0; + if(b === null) lb = null; + } + return r; + } + } +} + +/* + binary min-heap / set + - iteration is not in order of priority + - values can be removed, need to have the ._key property +*/ + +/** @constructor */ +function h$HeapSet() { + this._keys = []; + this._prios = []; + this._vals = []; + this._size = 0; +} + +h$HeapSet.prototype.size = function() { + return this._size; +} + +// add a node, if it already exists, it's moved to the new priority +h$HeapSet.prototype.add = function(op,o) { +#ifdef GHCJS_STRUCTS_ASSERTS + if((typeof o !== 'object' && typeof o !== 'function') || typeof o._key !== 'number') throw ("h$HeapSet.add: invalid element: " + o); + if(this._size > 0) { + if(this._storedProto !== o.prototype) throw ("h$HeapSet.add: unexpected element prototype: " + o) + } else { + this._storedProto = o.prototype; + } + if(this._keys[o._key] !== undefined && this._vals[this._keys[o._key]] !== o) throw ("h$Set.add: duplicate key: " + o); +#endif + var p = this._prios, k = this._keys, v = this._vals, x = k[o._key]; + if(x !== undefined) { // adjust node + var oop = p[x]; + if(oop !== op) { + p[x] = op; + if(op < oop) { + this._upHeap(x); + } else { + this._downHeap(x); + } + } + } else { // new node + var s = this._size++; + k[o._key] = s; + p[s] = op; + v[s] = o; + this._upHeap(s); + } +} + +h$HeapSet.prototype.has = function(o) { + return this._keys[o._key] !== undefined; +} + +h$HeapSet.prototype.prio = function(o) { + var x = this._keys[o._key]; + if(x !== undefined) { + return this._prios[x]; + } else { + return null; + } +} + +h$HeapSet.prototype.peekPrio = function() { + return this._size > 0 ? this._prios[0] : null; +} + +h$HeapSet.prototype.peek = function() { + return this._size > 0 ? this._vals[0] : null; +} + +h$HeapSet.prototype.pop = function() { + if(this._size > 0) { + var v = this._vals[0]; + this._removeNode(0); + return v; + } else { + return null; + } +} + +h$HeapSet.prototype.remove = function(o) { + var x = this._keys[o._key]; + if(x !== undefined) this._removeNode(x); +} + +h$HeapSet.prototype.iter = function() { + var n = 0, v = this._vals, s = this._size; + return function() { + return n < s ? v[n++] : null; + } +} + +// may be longer than this.size(), remainder is filled with nulls +h$HeapSet.prototype.values = function() { + return this._vals; +} + +h$HeapSet.prototype._removeNode = function(i) { + var p = this._prios, v = this._vals, s = --this._size, k = this._keys; + delete k[v[i]._key]; + if(i !== s) { + v[i] = v[s]; + p[i] = p[s]; + k[v[i]._key] = i; + } + v[s] = null; + p[s] = null; + this._downHeap(i,s); +} + +h$HeapSet.prototype._downHeap = function(i,s) { + var p = this._prios, v = this._vals, k = this._keys; + var j,l,r,ti,tj; + while(true) { + j = i, r = 2*(i+1), l = r-1; + if(l < s && p[l] < p[i]) i = l; + if(r < s && p[r] < p[i]) i = r; + if(i !== j) { + ti = v[i]; + tj = v[j]; + v[j] = ti; + v[i] = tj; + k[ti._key] = j; + k[tj._key] = i; + ti = p[i]; + p[i] = p[j]; + p[j] = ti; + } else { + break; + } + } +} + +h$HeapSet.prototype._upHeap = function(i) { + var ti, tj, j, p = this._prios, v = this._vals, k = this._keys; + while(i !== 0) { + j = (i-1) >> 1; + if(p[i] < p[j]) { + ti = v[i]; + tj = v[j]; + v[j] = ti; + v[i] = tj; + k[ti._key] = j; + k[tj._key] = i; + ti = p[i]; + p[i] = p[j]; + p[j] = ti; + i = j; + } else { + break; + } + } +} + diff --git a/lib/boot/shims/src/thread.js b/lib/boot/shims/src/thread.js new file mode 100644 index 00000000..6b4e6f2b --- /dev/null +++ b/lib/boot/shims/src/thread.js @@ -0,0 +1,1381 @@ +#include +// preemptive threading support + +// run gc when this much time has passed (ms) +#ifndef GHCJS_GC_INTERVAL +#define GHCJS_GC_INTERVAL 1000 +#endif + +// preempt threads after the scheduling quantum (ms) +#ifndef GHCJS_SCHED_QUANTUM +#define GHCJS_SCHED_QUANTUM 25 +#endif + +// check sched quantum after 10*GHCJS_SCHED_CHECK calls +#ifndef GHCJS_SCHED_CHECK +#define GHCJS_SCHED_CHECK 1000 +#endif + +// yield to js after running haskell for GHCJS_BUSY_YIELD ms +#ifndef GHCJS_BUSY_YIELD +#define GHCJS_BUSY_YIELD 500 +#endif + +#ifdef GHCJS_TRACE_SCHEDULER +function h$logSched() { if(arguments.length == 1) { + if(h$currentThread != null) { + h$log((Date.now()/1000) + " sched: " + h$threadString(h$currentThread) + + "[" + h$currentThread.mask + "," + + (h$currentThread.interruptible?1:0) + "," + + h$currentThread.excep.length + + "] -> " + arguments[0]); + } else { + h$log("sched: " + h$threadString(h$currentThread) + " -> " + arguments[0]); + } + } else { + h$log.apply(log,arguments); + } + } +#define TRACE_SCHEDULER(args...) h$logSched(args) +#else +#define TRACE_SCHEDULER(args...) +#endif + +#ifdef GHCJS_TRACE_CALLS +// print function to be called from trampoline and first few registers +function h$logCall(c) { + var f = c; + if(c && c.n) { + f = c.n; + } else { + f = c.toString().substring(0,20); // h$collectProps(c); + } + h$log(h$threadString(h$currentThread) + ":" + h$sp + " calling: " + f + " " + JSON.stringify([h$printReg(h$r1), h$printReg(h$r2), h$printReg(h$r3), h$printReg(h$r4), h$printReg(h$r5)])); + h$checkStack(c); +} +#endif + +var h$threadIdN = 0; + +// all threads except h$currentThread +// that are not finished/died can be found here +var h$threads = new h$Queue(); +var h$blocked = new h$Set(); + +/** @constructor */ +function h$Thread() { + this.tid = ++h$threadIdN; + this.status = THREAD_RUNNING; + this.stack = [h$done, 0, h$baseZCGHCziConcziSynczireportError, h$catch_e]; + this.sp = 3; + this.mask = 0; // async exceptions masked (0 unmasked, 1: uninterruptible, 2: interruptible) + this.interruptible = false; // currently in an interruptible operation + this.excep = []; // async exceptions waiting for unmask of this thread + this.delayed = false; // waiting for threadDelay + this.blockedOn = null; // object on which thread is blocked + this.retryInterrupted = null; // how to retry blocking operation when interrupted + this.transaction = null; // for STM + this.noPreemption = false; + this.isSynchronous = false; + this.continueAsync = false; + this.m = 0; // gc mark + this.result = null; // result value (used for GHCJS.Foreign.Callback) + this.resultIsException = false; +#ifdef GHCJS_PROF + this.ccs = h$CCS_SYSTEM; // cost-centre stack +#endif + this._key = this.tid; // for storing in h$Set / h$Map +} + +function h$rts_getThreadId(t) { + return t.tid; +} + +function h$cmp_thread(t1,t2) { + if(t1.tid < t2.tid) return -1; + if(t1.tid > t2.tid) return 1; + return 0; +} + +// description of the thread, if unlabeled then just the thread id +function h$threadString(t) { + if(t === null) { + return ""; + } else if(t.label) { + var str = h$decodeUtf8z(t.label[0], t.label[1]); + return str + " (" + t.tid + ")"; + } else { + return (""+t.tid); + } +} + +function h$fork(a, inherit) { + h$r1 = h$forkThread(a, inherit); + return h$yield(); +} + +function h$forkThread(a, inherit) { + var t = new h$Thread(); + TRACE_SCHEDULER("sched: forking: " + h$threadString(t)); + if(inherit && h$currentThread) { + t.mask = h$currentThread.mask; + } +#ifdef GHCJS_PROF + t.ccs = h$CCS_MAIN; +#endif + // TRACE_SCHEDULER("sched: action forked: " + a.f.n); + t.stack[4] = h$ap_1_0; + t.stack[5] = a; + t.stack[6] = h$return; + t.sp = 6; + h$wakeupThread(t); + return t; +} + +function h$threadStatus(t) { + // status, capability, locked + RETURN_UBX_TUP3(t.status, 1, 0); +} + +function h$waitRead(fd) { + h$fds[fd].waitRead.push(h$currentThread); + h$currentThread.interruptible = true; + return h$blockThread(h$currentThread,fd,[h$waitRead,fd]); +} + +function h$waitWrite(fd) { + h$fds[fd].waitWrite.push(h$currentThread); + h$currentThread.interruptible = true; + return h$blockThread(h$currentThread,fd,[h$waitWrite,fd]); +} + +// threadDelay support: +var h$delayed = new h$HeapSet(); +function h$wakeupDelayed(now) { + while(h$delayed.size() > 0 && h$delayed.peekPrio() < now) { + var t = h$delayed.pop(); + TRACE_SCHEDULER("delay timeout expired: " + t.tid); + // might have been woken up early, don't wake up again in that case + if(t.delayed) { + t.delayed = false; + h$wakeupThread(t); + } + } +} + +function h$delayThread(time) { + var now = Date.now(); + var ms = time/1000; // we have no microseconds in JS + TRACE_SCHEDULER("delaying " + h$threadString(h$currentThread) + " " + ms + "ms (" + (now+ms) + ")"); + h$delayed.add(now+ms, h$currentThread); + h$currentThread.delayed = true; + return h$blockThread(h$currentThread, h$delayed,[h$resumeDelayThread]); +} + +function h$resumeDelayThread() { + h$r1 = false; + return h$rs(); // stack[h$sp]; +} + +function h$yield() { + if(h$currentThread.isSynchronous) { + return h$stack[h$sp]; + } else { + h$sp += 2; + h$stack[h$sp-1] = h$r1; + h$stack[h$sp] = h$return; + h$currentThread.sp = h$sp; + return h$reschedule; + } +} + +// raise the async exception in the thread if not masked +function h$killThread(t, ex) { + TRACE_SCHEDULER("killThread: " + h$threadString(t)); + if(t === h$currentThread) { + // if target is self, then throw even if masked + h$sp += 2; + h$stack[h$sp-1] = h$r1; + h$stack[h$sp] = h$return; + return h$throw(ex,true); + } else { + TRACE_SCHEDULER("killThread mask: " + t.mask); + if(t.mask === 0 || (t.mask === 2 && t.interruptible)) { + if(t.stack) { // finished threads don't have a stack anymore + h$forceWakeupThread(t); + t.sp += 2; + t.stack[t.sp-1] = ex; + t.stack[t.sp] = h$raiseAsync_frame; + } + return h$stack ? h$stack[h$sp] : null; + } else { + t.excep.push([h$currentThread,ex]); + h$currentThread.interruptible = true; + h$sp += 2; + h$stack[h$sp-1] = h$r1; + h$stack[h$sp] = h$return; + return h$blockThread(h$currentThread,t,null); + } + } +} + +function h$maskStatus() { + TRACE_SCHEDULER("mask status: " + h$currentThread.mask); + return h$currentThread.mask; +} + +function h$maskAsync(a) { + TRACE_SCHEDULER("mask: thread " + h$threadString(h$currentThread)); + if(h$currentThread.mask !== 2) { + if(h$currentThread.mask === 0 && h$stack[h$sp] !== h$maskFrame && h$stack[h$sp] !== h$maskUnintFrame) { + h$stack[++h$sp] = h$unmaskFrame; + } + if(h$currentThread.mask === 1) { + h$stack[++h$sp] = h$maskUnintFrame; + } + h$currentThread.mask = 2; + } + h$r1 = a; + return h$ap_1_0_fast(); +} + +function h$maskUnintAsync(a) { + TRACE_SCHEDULER("mask unint: thread " + h$threadString(h$currentThread)); + if(h$currentThread.mask !== 1) { + if(h$currentThread.mask === 2) { + h$stack[++h$sp] = h$maskFrame; + } else { + h$stack[++h$sp] = h$unmaskFrame; + } + h$currentThread.mask = 1; + } + h$r1 = a; + return h$ap_1_0_fast(); +} + +function h$unmaskAsync(a) { + TRACE_SCHEDULER("unmask: " + h$threadString(h$currentThread)); + if(h$currentThread.excep.length > 0) { + h$currentThread.mask = 0; + h$sp += 3; + h$stack[h$sp-2] = h$ap_1_0; + h$stack[h$sp-1] = a; + h$stack[h$sp] = h$return; + return h$reschedule; + } + if(h$currentThread.mask !== 0) { + if(h$stack[h$sp] !== h$unmaskFrame) { + if(h$currentThread.mask === 2) { + h$stack[++h$sp] = h$maskFrame; + } else { + h$stack[++h$sp] = h$maskUnintFrame; + } + } + h$currentThread.mask = 0; + } + h$r1 = a; + return h$ap_1_0_fast(); +} + +function h$pendingAsync() { + var t = h$currentThread; + return (t.excep.length > 0 && (t.mask === 0 || (t.mask === 2 && t.interruptible))); +} + +// post the first of the queued async exceptions to +// this thread, restore frame is in thread if alreadySuspended + +function h$postAsync(alreadySuspended,next) { + var t = h$currentThread; + var v = t.excep.shift(); + TRACE_SCHEDULER("posting async to " + h$threadString(t) + " mask status: " + t.mask + " remaining exceptions: " + t.excep.length); + var tposter = v[0]; // posting thread, blocked + var ex = v[1]; // the exception + if(v !== null && tposter !== null) { + h$wakeupThread(tposter); + } + if(!alreadySuspended) { + h$suspendCurrentThread(next); + } + h$sp += 2; + h$stack[h$sp-1] = ex; + h$stack[h$sp] = h$raiseAsync_frame; + t.sp = h$sp; +} + +// wakeup thread, thread has already been removed +// from any queues it was blocked on +function h$wakeupThread(t) { + TRACE_SCHEDULER("sched: waking up: " + h$threadString(t)); + if(t.status === THREAD_BLOCKED) { + t.blockedOn = null; + t.status = THREAD_RUNNING; + h$blocked.remove(t); + } + t.interruptible = false; + t.retryInterrupted = null; + h$threads.enqueue(t); + h$startMainLoop(); +} + +// force wakeup, remove this thread from any +// queue it's blocked on +function h$forceWakeupThread(t) { + TRACE_SCHEDULER("forcing wakeup of: " + h$threadString(t)); + if(t.status === THREAD_BLOCKED) { + h$removeThreadBlock(t); + h$wakeupThread(t); + } +} + +function h$removeThreadBlock(t) { + var i; + if(t.status === THREAD_BLOCKED) { + var o = t.blockedOn; + if(o === null || o === undefined) { + throw ("h$removeThreadBlock: blocked on null or undefined: " + h$threadString(t)); + } else if(o === h$delayed) { + // thread delayed + h$delayed.remove(t); + t.delayed = false; + } else if(o instanceof h$MVar) { + TRACE_SCHEDULER("blocked on MVar"); + TRACE_SCHEDULER("MVar before: " + o.readers.length() + " " + o.writers.length() + " " + o.waiters.length); + // fixme this is rather inefficient + var r, rq = new h$Queue(); + while((r = o.readers.dequeue()) !== null) { + if(r !== t) rq.enqueue(r); + } + var w, wq = new h$Queue(); + while ((w = o.writers.dequeue()) !== null) { + if(w[0] !== t) wq.enqueue(w); + } + o.readers = rq; + o.writers = wq; + if(o.waiters) { + var wa = [], wat; + for(i=0;i h$gcInterval) { + // save active data for the thread on its stack + if(next !== h$reschedule && next !== null) { + h$suspendCurrentThread(next); + next = h$stack[h$sp]; + } + var ct = h$currentThread; + h$currentThread = null; +#ifdef GHCJS_PROF + h$reportCurrentCcs(); +#endif + h$gc(ct); + h$currentThread = ct; +#ifdef GHCJS_PROF + h$reportCurrentCcs(); +#endif + // gc might replace the stack of a thread, so reload it + h$stack = h$currentThread.stack; + h$sp = h$currentThread.sp + } + TRACE_SCHEDULER("sched: continuing: " + h$threadString(h$currentThread)); + return (next===h$reschedule || next === null)?h$stack[h$sp]:next; // just continue + } else { + TRACE_SCHEDULER("sched: pausing"); + h$currentThread = null; +#ifdef GHCJS_PROF + h$reportCurrentCcs(); +#endif + // We could set a timer here so we do a gc even if Haskell pauses for a long time. + // However, currently this isn't necessary because h$mainLoop always sets a timer + // before it pauses. + if(now - h$lastGc > h$gcInterval) + h$gc(null); + return null; // pause the haskell runner + } + } else { // runnable thread in t, switch to it + TRACE_SCHEDULER("sched: switching to: " + h$threadString(t)); + if(h$currentThread !== null) { + if(h$currentThread.status === THREAD_RUNNING) { + h$threads.enqueue(h$currentThread); + } + // if h$reschedule called, thread takes care of suspend + if(next !== h$reschedule && next !== null) { + TRACE_SCHEDULER("sched: suspending: " + h$threadString(h$currentThread)); + // suspend thread: push h$restoreThread stack frame + h$suspendCurrentThread(next); + } else { + TRACE_SCHEDULER("sched: no suspend needed, reschedule called from: " + h$threadString(h$currentThread)); + h$currentThread.sp = h$sp; + } + if(h$pendingAsync()) h$postAsync(true, next); + } else { + TRACE_SCHEDULER("sched: no suspend needed, no running thread"); + } + // gc if needed + if(now - h$lastGc > h$gcInterval) { + h$currentThread = null; +#ifdef GHCJS_PROF + h$reportCurrentCcs(); +#endif + h$gc(t); + } + // schedule new one + h$currentThread = t; + h$stack = t.stack; + h$sp = t.sp; +#ifdef GHCJS_PROF + h$reportCurrentCcs(); +#endif + TRACE_SCHEDULER("sched: scheduling " + h$threadString(t) + " sp: " + h$sp); + // TRACE_SCHEDULER("sp thing: " + h$stack[h$sp].n); + // h$dumpStackTop(h$stack,0,h$sp); + return h$stack[h$sp]; + } +} + +function h$scheduleMainLoop() { + TRACE_SCHEDULER("scheduling next main loop wakeup"); + if(h$mainLoopImmediate) return; + h$clearScheduleMainLoop(); + if(h$delayed.size() === 0) { +#ifndef GHCJS_BROWSER + if(typeof setTimeout !== 'undefined') { +#endif + TRACE_SCHEDULER("scheduling main loop wakeup in " + h$gcInterval + "ms"); + h$mainLoopTimeout = setTimeout(h$mainLoop, h$gcInterval); +#ifndef GHCJS_BROWSER + } +#endif + return; + } + var now = Date.now(); + var delay = Math.min(Math.max(h$delayed.peekPrio()-now, 0), h$gcInterval); +#ifndef GHCJS_BROWSER + if(typeof setTimeout !== 'undefined') { +#endif + if(delay >= 1) { + TRACE_SCHEDULER("scheduling main loop wakeup in " + delay + "ms"); + // node.js 0.10.30 has trouble with non-integral delays + h$mainLoopTimeout = setTimeout(h$mainLoop, Math.round(delay)); + } else { + h$mainLoopImmediate = setImmediate(h$mainLoop); + } +#ifndef GHCJS_BROWSER + } +#endif +} + +var h$animationFrameMainLoop = false; +#ifdef GHCJS_ANIMATIONFRAME_MAINLOOP +h$animationFrameMainLoop = true; +#endif + +function h$clearScheduleMainLoop() { + if(h$mainLoopTimeout) { + clearTimeout(h$mainLoopTimeout); + h$mainLoopTimeout = null; + } + if(h$mainLoopImmediate) { + clearImmediate(h$mainLoopImmediate); + h$mainLoopImmediate = null; + } + if(h$mainLoopFrame) { + cancelAnimationFrame(h$mainLoopFrame); + h$mainLoopFrame = null; + } +} + +function h$startMainLoop() { + TRACE_SCHEDULER("start main loop: " + h$running); + if(h$running) return; +#ifndef GHCJS_BROWSER + if(typeof setTimeout !== 'undefined') { +#endif + if(!h$mainLoopImmediate) { + h$clearScheduleMainLoop(); + h$mainLoopImmediate = setImmediate(h$mainLoop); + } +#ifndef GHCJS_BROWSER + } else { + while(true) { + // the try/catch block appears to prevent a crash with + // Safari on iOS 10, even though this path is never taken + // in a browser. + try { + h$mainLoop(); + } catch(e) { + throw e; + } + } + } +#endif +} + +#if defined(GHCJS_TRACE_CALLS) || defined(GHCJS_TRACE_STACK) +var h$traceCallsTicks = 0; +#ifndef GHCJS_TRACE_CALLS_DELAY +#define GHCJS_TRACE_CALLS_DELAY 0 +#endif +var h$traceCallsDelay = GHCJS_TRACE_CALLS_DELAY; +#endif + +var h$busyYield = GHCJS_BUSY_YIELD; +var h$schedQuantum = GHCJS_SCHED_QUANTUM; + +var h$mainLoopImmediate = null; // immediate id if main loop has been scheduled immediately +var h$mainLoopTimeout = null; // timeout id if main loop has been scheduled with a timeout +var h$mainLoopFrame = null; // timeout id if main loop has been scheduled with an animation frame +var h$running = false; +var h$nextThread = null; +function h$mainLoop() { +#ifdef GHCJS_PROF + h$runProf(h$actualMainLoop); +} +function h$actualMainLoop() { +#endif + if(h$running) return; + h$clearScheduleMainLoop(); + if(h$currentThread) { + h$scheduleMainLoop(); + return; + } + h$running = true; + h$runInitStatic(); + h$currentThread = h$nextThread; +#ifdef GHCJS_PROF + h$reportCurrentCcs(); +#endif + if(h$nextThread !== null) { + h$stack = h$currentThread.stack; + h$sp = h$currentThread.sp; + } + var c = null; + var start = Date.now(); + do { + c = h$scheduler(c); + if(c === null) { // no running threads + h$nextThread = null; + h$running = false; + h$currentThread = null; +#ifdef GHCJS_PROF + h$reportCurrentCcs(); +#endif + h$scheduleMainLoop(); + return; + } + // yield to js after h$busyYield (default value GHCJS_BUSY_YIELD) + if(!h$currentThread.isSynchronous && Date.now() - start > h$busyYield) { + TRACE_SCHEDULER("yielding to js"); + if(c !== h$reschedule) h$suspendCurrentThread(c); + h$nextThread = h$currentThread; + h$currentThread = null; +#ifdef GHCJS_PROF + h$reportCurrentCcs(); +#endif + h$running = false; + if(h$animationFrameMainLoop) { + h$mainLoopFrame = requestAnimationFrame(h$mainLoop); + } else { + h$mainLoopImmediate = setImmediate(h$mainLoop); + } + return; + } +#ifdef GHCJS_NO_CATCH_MAINLOOP + // for debugging purposes only, may leave threads in inconsistent state! + c = h$runThreadSlice(c); +#else + c = h$runThreadSliceCatch(c); +#endif + } while(true); +} + +function h$runThreadSliceCatch(c) { + try { + return h$runThreadSlice(c); + } catch(e) { + // uncaught exception in haskell code, kill thread +#ifdef GHCJS_PROF + h$reportCurrentCcs(); +#endif + c = null; + if(h$stack && h$stack[0] === h$doneMain_e) { + h$stack = null; + h$reportMainLoopException(e, true); + h$doneMain_e(); + } else { + h$stack = null; + h$reportMainLoopException(e, false); + } + h$finishThread(h$currentThread); + h$currentThread.status = THREAD_DIED; + h$currentThread = null; + } + return h$reschedule; +} + +/* + run thread h$currentThread for a single time slice + + - c: the next function to call from the trampoline + + returns: + the next function to call in this thread + + preconditions: + h$currentThread is the thread to run + h$stack is the stack of this thread + h$sp is the stack pointer + + any global variables needed to pass arguments have been set + the caller has to update the thread state object + */ +function h$runThreadSlice(c) { + var count, scheduled = Date.now(); + while(c !== h$reschedule && + (h$currentThread.noPreemption || h$currentThread.isSynchronous || + (Date.now() - scheduled < h$schedQuantum))) { + count = 0; + while(c !== h$reschedule && ++count < GHCJS_SCHED_CHECK) { +#if defined(GHCJS_TRACE_CALLS) || defined(GHCJS_TRACE_STACK) + h$traceCallsTicks++; + if(h$traceCallsTicks % 1000000 === 0) h$log("ticks: " + h$traceCallsTicks); +#endif +#ifdef GHCJS_TRACE_CALLS + if(h$traceCallsDelay >= 0 && h$traceCallsTicks >= h$traceCallsDelay) h$logCall(c); +#endif +#ifdef GHCJS_TRACE_STACK + if(h$traceCallsDelay >= 0 && h$traceCallsTicks >= h$traceCallsDelay) h$logStack(c); +#endif + c = c(); +#if !defined(GHCJS_TRACE_CALLS) && !defined(GHCJS_TRACE_STACK) && !defined(GHCJS_SCHED_DEBUG) + c = c(); + c = c(); + c = c(); + c = c(); + c = c(); + c = c(); + c = c(); + c = c(); + c = c(); +#endif + } + if(c === h$reschedule && + (h$currentThread.noPreemption || h$currentThread.isSynchronous) && + h$currentThread.status === THREAD_BLOCKED) { + c = h$handleBlockedSyncThread(c); + } + } + return c; +} + +function h$reportMainLoopException(e, isMainThread) { + if(e instanceof h$ThreadAbortedError) return; + var main = isMainThread ? " main" : ""; + h$log("uncaught exception in Haskell" + main + " thread: " + e.toString()); + if(e.stack) h$log(e.stack); +} + + +function h$handleBlockedSyncThread(c) { + TRACE_SCHEDULER("handling blocked sync thread"); + /* + if we have a blocked synchronous/non-preemptible thread, + and it's blocked on a black hole, first try to clear + it. + */ + var bo = h$currentThread.blockedOn; + if(h$currentThread.status === THREAD_BLOCKED && + IS_BLACKHOLE(bo) && + h$runBlackholeThreadSync(bo)) { + TRACE_SCHEDULER("blackhole succesfully removed"); + c = h$stack[h$sp]; + } + /* + if still blocked, then either fall back to async, + or throw a WouldBlock exception + */ + if(h$currentThread.isSynchronous && h$currentThread.status === THREAD_BLOCKED) { + if(h$currentThread.continueAsync) { + h$currentThread.isSynchronous = false; + h$currentThread.continueAsync = false; + } else if(h$currentThread.isSynchronous) { + TRACE_SCHEDULER("blocking synchronous thread: exception"); + h$sp += 2; + h$currentThread.sp = h$sp; + h$stack[h$sp-1] = h$ghcjszmprimZCGHCJSziPrimziInternalziwouldBlock; + h$stack[h$sp] = h$raiseAsync_frame; + h$forceWakeupThread(h$currentThread); + c = h$raiseAsync_frame; + } // otherwise a non-preemptible thread, keep it in the same state + } + return c; +} + +// run the supplied IO action in a new thread +// returns immediately, thread is started in background +function h$run(a) { + TRACE_SCHEDULER("sched: starting thread"); + var t = h$forkThread(a, false); + h$startMainLoop(); + return t; +} + +/** @constructor */ +function h$WouldBlock() { + +} + +h$WouldBlock.prototype.toString = function() { + return "Haskell Operation would block"; +} + +/** @constructor */ +function h$HaskellException(msg) { + this._msg = msg; +} + +h$HaskellException.prototype.toString = function() { + return this._msg; +} + +function h$setCurrentThreadResultWouldBlock() { + h$currentThread.result = new h$WouldBlock(); + h$currentThread.resultIsException = true; +} + +function h$setCurrentThreadResultJSException(e) { + h$currentThread.result = e; + h$currentThread.resultIsException = true; +} + +function h$setCurrentThreadResultHaskellException(msg) { + h$currentThread.result = new h$HaskellException(msg); + h$currentThread.resultIsException = true; +} + +function h$setCurrentThreadResultValue(v) { + h$currentThread.result = v; + h$currentThread.resultIsException = false; +} + +/* + run a Haskell (IO JSVal) action synchronously, returning + the result. Uncaught Haskell exceptions are thrown as a + h$HaskellException. If the action could not finish due to + blocking, a h$WouldBlock exception is thrown instead. + + - a: the (IO JSVal) action + - cont: continue async if blocked + (the call to h$runSyncReturn would still throw h$WouldBlock, + since there would be no return value) + + returns: the result of the IO action + */ +function h$runSyncReturn(a, cont) { + var t = new h$Thread(); + TRACE_SCHEDULER("h$runSyncReturn created thread: " + h$threadString(t)); + var aa = MK_AP1(h$ghcjszmprimZCGHCJSziPrimziInternalzisetCurrentThreadResultValue, a); + h$runSyncAction(t, aa, cont); + if(t.status === THREAD_FINISHED) { + if(t.resultIsException) { + throw t.result; + } else { + return t.result; + } + } else if(t.status === THREAD_BLOCKED) { + throw new h$WouldBlock(); + } else { + throw new Error("h$runSyncReturn: Unexpected thread status: " + t.status); + } +} + +/* + run a Haskell IO action synchronously, ignoring the result + or any exception in the Haskell code + + - a: the IO action + - cont: continue async if blocked + + returns: true if the action ran to completion, false otherwise + + throws: any uncaught Haskell or JS exception except WouldBlock + */ +function h$runSync(a, cont) { + var t = new h$Thread(); + TRACE_SCHEDULER("h$runSync created thread: " + h$threadString(t)); + h$runSyncAction(t, a, cont); + if(t.resultIsException) { + if(t.result instanceof h$WouldBlock) { + return false; + } else { + throw t.result; + } + } + return t.status === THREAD_FINISHED; +} + +function h$runSyncAction(t, a, cont) { + h$runInitStatic(); + var c = h$return; + t.stack[2] = h$ghcjszmprimZCGHCJSziPrimziInternalzisetCurrentThreadResultException; + t.stack[4] = h$ap_1_0; + t.stack[5] = a; + t.stack[6] = h$return; + t.sp = 6; + t.status = THREAD_RUNNING; +#ifdef GHCJS_PROF + // fixme this looks wrong + // t.ccs = h$currentThread.ccs; // TODO: not sure about this +#endif + t.isSynchronous = true; + t.continueAsync = cont; + var ct = h$currentThread; + var csp = h$sp; + var cr1 = h$r1; // do we need to save more than this? + var caught = false, excep = null; + h$currentThread = t; + h$stack = t.stack; + h$sp = t.sp; +#ifdef GHCJS_PROF + h$reportCurrentCcs(); +#endif + try { + c = h$runThreadSlice(c); + if(c !== h$reschedule) { + throw new Error("h$runSyncAction: h$reschedule expected"); + } + } catch(e) { + h$finishThread(h$currentThread); + h$currentThread.status = THREAD_DIED; + caught = true; + excep = e; + } + if(ct !== null) { + h$currentThread = ct; + h$stack = ct.stack; + h$sp = csp; + h$r1 = cr1; + } else { + h$currentThread = null; + h$stack = null; + } +#ifdef GHCJS_PROF + // fixme? + h$reportCurrentCcs(); +#endif + if(t.status !== THREAD_FINISHED && !cont) { + h$removeThreadBlock(t); + h$finishThread(t); + } + if(caught) throw excep; +} + +// run other threads synchronously until the blackhole is 'freed' +// returns true for success, false for failure, a thread blocks +function h$runBlackholeThreadSync(bh) { + TRACE_SCHEDULER("trying to remove black hole"); + var ct = h$currentThread; + var sp = h$sp; + var success = false; + var bhs = []; + var currentBh = bh; + // we don't handle async exceptions here, + // don't run threads with pending exceptions + if(BLACKHOLE_TID(bh).excep.length > 0) { + TRACE_SCHEDULER("aborting due to queued async exceptions"); + return false; + } + h$currentThread = BLACKHOLE_TID(bh); + h$stack = h$currentThread.stack; + h$sp = h$currentThread.sp; +#ifdef GHCJS_PROF + h$reportCurrentCcs(); +#endif + var c = (h$currentThread.status === THREAD_RUNNING)?h$stack[h$sp]:h$reschedule; + TRACE_SCHEDULER("switched thread status running: " + (h$currentThread.status === THREAD_RUNNING)); + try { + while(true) { + while(c !== h$reschedule && IS_BLACKHOLE(currentBh)) { + c = c(); + c = c(); + c = c(); + c = c(); + c = c(); + } + if(c === h$reschedule) { + // perhaps new blackhole, then continue with that thread, + // otherwise fail + if(IS_BLACKHOLE(h$currentThread.blockedOn)) { + TRACE_SCHEDULER("following another black hole"); + bhs.push(currentBh); + currentBh = h$currentThread.blockedOn; + h$currentThread = BLACKHOLE_TID(h$currentThread.blockedOn); + if(h$currentThread.excep.length > 0) { + break; + } + h$stack = h$currentThread.stack; + h$sp = h$currentThread.sp; +#ifdef GHCJS_PROF + h$reportCurrentCcs(); +#endif + c = (h$currentThread.status === THREAD_RUNNING)?h$stack[h$sp]:h$reschedule; + } else { + TRACE_SCHEDULER("thread blocked on something that's not a black hole, failing"); + break; + } + } else { // blackhole updated: suspend thread and pick up the old one + TRACE_SCHEDULER("blackhole updated, switching back (" + h$sp + ")"); + TRACE_SCHEDULER("next: " + c.toString()); + h$suspendCurrentThread(c); + if(bhs.length > 0) { + TRACE_SCHEDULER("to next black hole"); + currentBh = bhs.pop(); + h$currentThread = BLACKHOLE_TID(currentBh); + h$stack = h$currentThread.stack; + h$sp = h$currentThread.sp; +#ifdef GHCJS_PROF + h$reportCurrentCcs(); +#endif + } else { + TRACE_SCHEDULER("last blackhole removed, success!"); + success = true; + break; + } + } + } + } catch(e) { } + // switch back to original thread + h$sp = sp; + h$stack = ct.stack; + h$currentThread = ct; +#ifdef GHCJS_PROF + h$reportCurrentCcs(); +#endif + return success; +} + +function h$syncThreadState(tid) { + return (tid.isSynchronous ? 1 : 0) | + ((tid.continueAsync || !tid.isSynchronous) ? 2 : 0) | + ((tid.noPreemption || tid.isSynchronous) ? 4 : 0); +} + +// run the supplied IO action in a main thread +// (program exits when this thread finishes) +function h$main(a) { + var t = new h$Thread(); +#ifdef GHCJS_PROF + t.ccs = a.cc; +#endif + //TRACE_SCHEDULER("sched: starting main thread"); + t.stack[0] = h$doneMain_e; +#ifndef GHCJS_BROWSER + if(!h$isBrowser && !h$isGHCJSi) { + t.stack[2] = h$baseZCGHCziTopHandlerzitopHandler; + } +#endif + t.stack[4] = h$ap_1_0; + t.stack[5] = h$flushStdout; + t.stack[6] = h$return; + t.stack[7] = h$ap_1_0; + t.stack[8] = a; + t.stack[9] = h$return; + t.sp = 9; + t.label = [h$encodeUtf8("main"), 0]; + h$wakeupThread(t); + h$startMainLoop(); + return t; +} + +function h$doneMain() { +#ifndef GHCJS_BROWSER + if(h$isGHCJSi) { + if(h$currentThread.stack) { + global.h$GHCJSi.done(h$currentThread); + } + } else { +#endif + h$exitProcess(0); +#ifndef GHCJS_BROWSER + } +#endif + h$finishThread(h$currentThread); + return h$reschedule; +} + +/** @constructor */ +function h$ThreadAbortedError(code) { + this.code = code; +} + +h$ThreadAbortedError.prototype.toString = function() { + return "Thread aborted, exit code: " + this.code; +} + +function h$exitProcess(code) { +#ifndef GHCJS_BROWSER + if(h$isNode) { + process.exit(code); + } else if(h$isJvm) { + java.lang.System.exit(code); + } else if(h$isJsShell) { + quit(code); + } else if(h$isJsCore) { + if(h$base_stdoutLeftover.val !== null) print(h$base_stdoutLeftover.val); + if(h$base_stderrLeftover.val !== null) debug(h$base_stderrLeftover.val); + // jsc does not support returning a nonzero value, print it instead + if(code !== 0) debug("GHCJS JSC exit status: " + code); + quit(); + } else { +#endif + if(h$currentThread) { + h$finishThread(h$currentThread); + h$stack = null; + throw new h$ThreadAbortedError(code); + } +#ifndef GHCJS_BROWSER + } +#endif +} + +// MVar support +var h$mvarId = 0; +/** @constructor */ +function h$MVar() { + TRACE_SCHEDULER("h$MVar constructor"); + this.val = null; + this.readers = new h$Queue(); + this.writers = new h$Queue(); + this.waiters = null; // waiting for a value in the MVar with ReadMVar + this.m = 0; // gc mark + this.id = ++h$mvarId; +} + +// set the MVar to empty unless there are writers +function h$notifyMVarEmpty(mv) { + var w = mv.writers.dequeue(); + if(w !== null) { + var thread = w[0]; + var val = w[1]; + TRACE_SCHEDULER("notifyMVarEmpty(" + mv.id + "): writer ready: " + h$threadString(thread)); + mv.val = val; + // thread is null if some JavaScript outside Haskell wrote to the MVar + if(thread !== null) { + h$wakeupThread(thread); + } + } else { + TRACE_SCHEDULER("notifyMVarEmpty(" + mv.id + "): no writers"); + mv.val = null; + } + TRACE_SCHEDULER("notifyMVarEmpty(" + mv.id + "): " + mv.val); +} + +// set the MVar to val unless there are readers +function h$notifyMVarFull(mv,val) { + if(mv.waiters && mv.waiters.length > 0) { + for(var i=0;i + +var h$weakPointerList = []; + +#ifdef GHCJS_TRACE_WEAK +function h$traceWeak() { h$log.apply(h$log, arguments) } +#define TRACE_WEAK(args...) h$traceWeak(args) +#else +#define TRACE_WEAK(args...) +#endif + +// called by the GC after marking the heap +function h$finalizeWeaks(toFinalize) { + var mark = h$gcMark; + var i, w; + + TRACE_WEAK("to finalize: " + toFinalize.length); + // start a finalizer thread if any finalizers need to be run + if(toFinalize.length > 0) { + var t = new h$Thread(); + for(i=0;i threefish_block.in.js +echo "// generated by generate_threefish_block.hs" > threefish_block.js + +# beautify: +# uglifyjs threefish_block.in.js -b >> threefish_block.js + +# minify +# uglifyjs threefish_block.in.js -c -m >> threefish_block.js + +# minify (closure) +ccjs threefish_block.in.js >> threefish_block.js + +cat threefish_block.js test_threefish_block.js > test.js + diff --git a/lib/boot/shims/utils/threefish/generate_threefish_block.hs b/lib/boot/shims/utils/threefish/generate_threefish_block.hs new file mode 100644 index 00000000..8aedafe9 --- /dev/null +++ b/lib/boot/shims/utils/threefish/generate_threefish_block.hs @@ -0,0 +1,437 @@ +{-# LANGUAGE QuasiQuotes #-} +{- + Generator for a JavaScript implementation of the Skein block function. + Based on the public domain C implementation by Doug Whiting. + + Code size is ~1.7kB zipped after minification when fully unrolled + performance ~ 50MB/s on v8 and SpiderMonkey + + author: Luite Stegeman - 2014 + -} + +module Main where + +import Data.Bits +import Data.Maybe +import Data.Monoid + +import System.IO + +import Language.Javascript.JMacro +import Text.PrettyPrint.Leijen.Text (renderPretty, displayIO) + +-------------------------------------------------------------------------------- +-- configuration + +-- number of rounds +nRounds :: Int +nRounds = 72 + +-- arguments are byte arrays, no separate offsets +byteArray :: Bool +byteArray = True + +-- completely unroll all rounds, eliminating the loop +unroll :: Bool +unroll = True + +-- store w in local variables instead of an array +localW :: Bool +localW = True + +-- store kw (ks and ts) in local variables (only for unrolled loop!) +localKw :: Bool +localKw = True + +-- inline the 64 bit addition calls +inlineAdd :: Bool +inlineAdd = True + +-------------------------------------------------------------------------------- +-- constants + +-- key schedule parity +skein_ks_parity_a, skein_ks_parity_b :: Integer +skein_ks_parity_a = 0xA9FC1A22 +skein_ks_parity_b = 0x1BD11BDA + +-- rotation constants for each round +threefish_rotation :: [(Int,Int)] +threefish_rotation = + [ (14,16), (52,57), (23,40), (5,37) + , (25,33), (46,12), (58,22), (32,32) + ] + +-------------------------------------------------------------------------------- +-- yep we have to emulate 64 bit arithmetic + +data JInt64 + = JInt64Var Ident Ident + | JInt64Arr Ident Int (Maybe JExpr) + | JInt64Val Integer + deriving Show + +val :: Integer -> JInt64 +val = JInt64Val + +var :: Ident -> JExpr +var = ValExpr . JVar + +-- expressions +eA, eB :: JInt64 -> JExpr +eA (JInt64Var a _) = var a +eA (JInt64Arr a n me) = [jmacroE| `var a`[`arrE (2*n) me`] |] +eA (JInt64Val n) = toJExpr (n .&. 0xFFFFFFFF) + +eB (JInt64Var _ b) = var b +eB (JInt64Arr a n me) = [jmacroE| `var a`[`arrE (2*n+1) me`] |] +eB (JInt64Val n) = toJExpr $ (n `shiftR` 32) .&. 0xFFFFFFFF + +arrE :: Int -> Maybe JExpr -> JExpr +arrE 0 me = fromMaybe (toJExpr (0::Integer)) me +arrE n me = case me of + Nothing -> toJExpr n + Just e -> [jmacroE| `n`+2*`e` |] + +-- lvalues +lvA, lvB :: JInt64 -> JExpr +lvA j@(JInt64Val{}) = error ("not an lvalue: " ++ show j) +lvA j = eA j +lvB j@(JInt64Val{}) = error ("not an lvalue: " ++ show j) +lvB j = eB j + +x :: Int -> JInt64 +x n + | n >=0 && n <= 3 = JInt64Var (StrI $ 'x':show n++"a") (StrI $ 'x':show n++"b") + | otherwise = error ("x out of range: " ++ show n) + + +declI64 :: String -> JStat +declI64 name = DeclStat (StrI $ name ++ "a") Nothing <> + DeclStat (StrI $ name ++ "b") Nothing + +declWGlobal, declWLocal :: JStat +declWGlobal + | localW = mempty + | otherwise = [jmacro| var !h$Threefish_w = new Int32Array(8); |] +declWLocal + | localW = mconcat $ map (declI64.(('w':).show)) [0..3] + | otherwise = [jmacro| var !_w = $Threefish_w; |] + +w :: Int -> JInt64 +w n | n < 0 || n > 3 = error "w: out of range" + | localW = JInt64Var (StrI $ "w" ++ show n ++ "a") (StrI $ "w" ++ show n ++ "b") + | otherwise = JInt64Arr (StrI "_w") n Nothing + +declKwGlobal, declKwLocal :: JStat +declKwGlobal + | localKw && unroll = mempty + | localKw = error "localKw is only available when unrolled" + | otherwise = + let n = if unroll then 16 else 16 + nRounds * 4 + in [jmacro| var !h$Threefish_kw = new Int32Array(`n`); |] +declKwLocal + | localKw && unroll = mconcat $ map (declI64.(("kw"++).show)) [0..7] + | localKw = error "localKw is only available when unrolled" + | otherwise = [jmacro| var !_kw = $Threefish_kw; |] + +kw :: Int -> Maybe JExpr -> JInt64 +kw n e + | localKw && isJust e = error "dynamic offset with localKw" + | localKw = JInt64Var (StrI $ "kw" ++ show n ++ "a") (StrI $ "kw" ++ show n ++ "b") + | otherwise = JInt64Arr (StrI "_kw") n e + +kw_key_base, kw_twk_base :: Int +kw_key_base = 3 +kw_twk_base = 0 + +ks, ts :: Int -> JInt64 +ks n = kw (n + kw_key_base) Nothing +ts n = kw (n + kw_twk_base) Nothing + +ks', ts' :: Int -> JExpr -> JInt64 +ks' n e = kw (n + kw_key_base) (Just e) +ts' n e = kw (n + kw_twk_base) (Just e) + +-- x = y + z +add_64 :: JInt64 -> JInt64 -> JInt64 -> JStat +add_64 x y z = jadd64 (eA x) (eB x) (eA y) (eB y) (eA z) (eB z) + +-- x = y + z + w +add3_64 :: JInt64 -> JInt64 -> JInt64 -> JInt64 -> JStat +add3_64 x y z w = + jadd3_64 (eA x) (eB x) (eA y) (eB y) (eA z) (eB z) (eA w) (eB w) + +-- x += y +addTo_64 :: JInt64 -> JInt64 -> JStat +addTo_64 x y = jadd64 (eA x) (eB x) (eA x) (eB x) (eA y) (eB y) + +-- x += y + z +addTo2_64 :: JInt64 -> JInt64 -> JInt64 -> JStat +addTo2_64 x y z = + jadd3_64 (eA x) (eB x) (eA x) (eB x) (eA y) (eB y) (eA z) (eB z) + +-- x += y + c (c must be in [0,2^31-1] ) +addTo2_64_c :: JInt64 -> JInt64 -> Int -> JStat +addTo2_64_c x y 0 = addTo_64 x y +addTo2_64_c x y c = + jadd3_64 (eA x) (eB x) (eA x) (eB x) (eA y) (eB y) (toJExpr c) (toJExpr (0::Int)) + +-- add a regular JS number to an int64, must be small! +addNumTo_64 :: JInt64 -> Int -> Maybe JExpr -> JStat +addNumTo_64 x 0 Nothing = mempty +addNumTo_64 x n me = + let n' = toJExpr n + e = maybe n' (\ee -> [jmacroE| `n'`+`ee` |]) me + in jadd64 (eA x) (eB x) (eA x) (eB x) e [jmacroE| 0 |] + +-- x ^= y +xorTo_64 :: JInt64 -> JInt64 -> JStat +xorTo_64 x y = [jmacro| `eA x` ^= `eA y`; + `eB x` ^= `eB y`; + |] + +-- x = y + z +jadd64 :: JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +jadd64 xa xb ya yb za zb + | inlineAdd = add64Body (Just xa) xb ya yb za zb + | otherwise = [jmacro| + `xa` = add64(`ya`,`yb`,`za`,`zb`); + `xb` = add64_ret1; +|] + +-- x = y + z + w +jadd3_64 :: JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +jadd3_64 xa xb ya yb za zb wa wb + | inlineAdd = add3_64Body (Just xa) xb ya yb za zb wa wb + | otherwise = [jmacro| + `xa` = add3_64(`ya`,`yb`,`za`,`zb`, `wa`, `wb`); + `xb` = add64_ret1; +|] + +add64Decl :: JStat +add64Decl + | inlineAdd = add64LocalDecl + | otherwise = [jmacro| var !add64_ret1; + function !add64(xa,xb,ya,yb) { + `add64LocalDecl`; + `add64Body Nothing add64_ret1 xa xb ya yb`; + } + function !add3_64(xa,xb,ya,yb,za,zb) { + `add64LocalDecl`; + `add3_64Body Nothing add64_ret1 xa xb ya yb za zb`; + } + + |] + +add64LocalDecl = + [jmacro| var !c1, !c0; |] + +add64Body :: Maybe JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> JStat +add64Body ta tb xa xb ya yb = [jmacro| + c0 = (`xa` & 0xFFFFFF) + (`ya` & 0xFFFFFF); + c1 = (c0 >>> 24) + (`xa` >>> 24) + (`ya` >>> 24) + + ((`xb` & 0xFFFF)<<8) + ((`yb` & 0xFFFF) << 8); + `tb` = (((c1 >>> 24) + (`xb` >>> 16) + (`yb` >>> 16)) << 16) + + ((c1 >> 8) & 0xFFFF); + `r`; +|] where + r = let v = [jmacroE| (c1 << 24) | (c0 & 0xFFFFFF) |] + in case ta of + Nothing -> [jmacro| return `v`; |] + Just e -> [jmacro| `e` = `v`; |] + +add3_64Body :: Maybe JExpr -> JExpr -> JExpr -> JExpr -> JExpr -> JExpr + -> JExpr -> JExpr -> JStat +add3_64Body ta tb xa xb ya yb za zb = [jmacro| + c0 = (`xa` & 0xFFFFFF) + (`ya` & 0xFFFFFF) + (`za` & 0xFFFFFF); + c1 = (c0 >>> 24) + (`xa` >>> 24) + (`ya` >>> 24) + (`za` >>> 24) + + ((`xb` & 0xFFFF)<<8) + ((`yb` & 0xFFFF) << 8) + ((`zb` & 0xFFFF)<<8); + `tb` = (((c1 >>> 24) + (`xb` >>> 16) + (`yb` >>> 16) + (`zb` >>> 16)) << 16) + + ((c1 >> 8) & 0xFFFF); + `r`; +|] where + r = let v = [jmacroE| (c1 << 24) | (c0 & 0xFFFFFF) |] + in case ta of + Nothing -> [jmacro| return `v`; |] + Just e -> [jmacro| `e` = `v`; |] + +-- x = rotl(x,r) +-- uses tmp1 +rotL_64 :: JInt64 -> Int -> JStat +rotL_64 x r + | r > 63 || r < 0 = error ("rotL: invalid argument: " ++ show r) + | r == 0 = mempty + | r == 32 = [jmacro| tmp1 = `eB x`; + `eB x` = `eA x`; + `eA x` = tmp1; + |] + | r < 32 = [jmacro| tmp1 = `eB x`; + `eB x` = (`eB x` << `r`) | (`eA x` >>> `32-r`); + `eA x` = (`eA x` << `r`) | (tmp1 >>> `32-r`); + |] + | otherwise = [jmacro| tmp1 = `eB x`; + `eB x` = (`eA x` << `r-32`) | (`eB x` >>> `64-r`); + `eA x` = (tmp1 << `r-32`) | (`eA x` >>> `64-r`); + |] + +-- x = rotl(x,r) ^ y +-- uses tmp1 +rotL_64_xor :: JInt64 -> Int -> JInt64 -> JStat +rotL_64_xor x r y + | r > 63 || r < 0 = error ("rotL: invalid argument: " ++ show r) + | r == 0 = [jmacro| `eA x` ^= `eA y`; + `eB x` ^= `eB y`; + |] + | r == 32 = [jmacro| tmp1 = `eB x`; + `eB x` = `eA x` ^ `eB y`; + `eA x` = tmp1 ^ `eA y`; + |] + | r < 32 = [jmacro| tmp1 = `eB x`; + `eB x` = ((`eB x` << `r`) | (`eA x` >>> `32-r`)) ^ `eB y`; + `eA x` = ((`eA x` << `r`) | (tmp1 >>> `32-r`)) ^ `eA y`; + |] + | otherwise = [jmacro| tmp1 = `eB x`; + `eB x` = ((`eA x` << `r-32`) | (`eB x` >>> `64-r`)) ^ `eB y`; + `eA x` = ((tmp1 << `r-32`) | (`eA x` >>> `64-r`)) ^ `eA y`; + |] + +(.=) :: JInt64 -> JInt64 -> JStat +x .= y = [jmacro| `lvA x` = `eA y`; + `lvB x` = `eB y`; + |] + +u32Ptr :: String -> Int -> JInt64 +u32Ptr name n + | byteArray = JInt64Arr (StrI name) n Nothing + | otherwise = JInt64Arr (StrI name) n (Just $ ValExpr . JVar . StrI $ name ++ "_o") + +keyPtr, blkPtr, cryptPtr :: Int -> JInt64 +keyPtr = u32Ptr "keyPtrI3" +blkPtr = u32Ptr "blkPtrI3" +cryptPtr = u32Ptr "cryptPtrI3" + +-------------------------------------------------------------------------------- +-- the algorithm + +rounds :: JStat +rounds + | unroll = mconcat $ map round8u [0..nRounds `div` 8-1] + | otherwise = [jmacro| var rnd; + for(rnd=1;rnd<=`2*div nRounds 8`;rnd+=2) { + `round8l rnd`; + } + |] + +-- loop variant +round8l :: JExpr -> JStat +round8l rnd = round4a <> i256l rnd 0 <> round4b <> i256l rnd 1 + +i256l :: JExpr -> Int -> JStat +i256l rnd r = addTo_64 (x 0) (ks' r rnd) <> + addTo2_64 (x 1) (ks' (r+1) rnd) (ts' r rnd) <> + addTo2_64 (x 2) (ks' (r+2) rnd) (ts' (r+1) rnd) <> + addTo_64 (x 3) (ks' (r+3) rnd) <> + addNumTo_64 (x 3) r (Just rnd) <> + ks' (r+4) rnd .= ks' (r-1) rnd <> + ts' (r+2) rnd .= ts' (r-1) rnd + +-- unrolled variant +round8u :: Int -> JStat +round8u n = round4a <> i256u (2*n) <> round4b <> i256u (2*n+1) + +i256u :: Int -> JStat +i256u r = addTo_64 (x 0) (ks ((r+1)`mod`5)) <> + addTo2_64 (x 1) (ks ((r+2)`mod`5)) (ts ((r+1)`mod`3)) <> + addTo2_64 (x 2) (ks ((r+3)`mod`5)) (ts ((r+2)`mod`3)) <> + addTo2_64_c (x 3) (ks ((r+4)`mod`5)) (r+1) + +-- common to both loop and unrolled +r256 :: Int -> Int -> Int -> Int -> Int -> JStat +r256 r p0 p1 p2 p3 = addTo_64 (x p0) (x p1) <> + rotL_64_xor (x p1) rot1 (x p0) <> + addTo_64 (x p2) (x p3) <> + rotL_64_xor (x p3) rot2 (x p2) + where + (rot1, rot2) = threefish_rotation !! (r-1) + + +round4a, round4b :: JStat +round4a = r256 1 0 1 2 3 <> + r256 2 0 3 2 1 <> + r256 3 0 1 2 3 <> + r256 4 0 3 2 1 +round4b = r256 5 0 1 2 3 <> + r256 6 0 3 2 1 <> + r256 7 0 1 2 3 <> + r256 8 0 3 2 1 + +processBlock + | byteArray = + [jmacro| + function !h$Threefish_256_Process_Block(keyPtr_d, blkPtr_d, cryptPtr_d, w32out) { + var !keyPtrI3 = keyPtr_d.i3; + var !blkPtrI3 = blkPtr_d.i3; + var !cryptPtrI3 = cryptPtr_d.i3; + `body w32out`; + } + |] + | otherwise = + [jmacro| + function !h$Threefish_256_Process_Block(keyPtr_d, keyPtr_o, blkPtr_d, blkPtr_o, cryptPtr_d, cryptPtr_o, w32out) { + if(keyPtr_o & 3 || blkPtr_o & 3 || cryptPtr_o & 3) + throw new Error("h$Threefish_256_Process_Block: unaligned pointer"); + var !keyPtrI3 = keyPtr_d.i3, !keyPtrI3_o = keyPtr_o >> 2; + var !blkPtrI3 = blkPtr_d.i3, !blkPtrI3_o = blkPtr_o >> 2; + var !cryptPtrI3 = cryptPtr_d.i3, !cryptPtrI3_o = cryptPtr_o >> 2; + `body w32out`; + } + |] + where + -- todo: implement word swapping for w32out + body w32out = [jmacro| + `add64Decl`; + // context vars + var !x0a,!x0b,!x1a,!x1b,!x2a,!x2b,!x3a,!x3b; + var !tmp1; + `declWLocal`; + `declKwLocal`; + + `ks 0 .= keyPtr 0`; + `ks 1 .= keyPtr 1`; + `ks 2 .= keyPtr 2`; + `ks 3 .= keyPtr 3`; + + // ks[4] = ks[0] ^ ks[1] ^ ks[2] ^ ks[3] ^ SKEIN_KS_PARITY; + `lvA (ks 4)` = `eA (ks 0)` ^ `eA (ks 1)` ^ `eA (ks 2)` ^ `eA (ks 3)` ^ `skein_ks_parity_a`; + `lvB (ks 4)` = `eB (ks 0)` ^ `eB (ks 1)` ^ `eB (ks 2)` ^ `eB (ks 3)` ^ `skein_ks_parity_b`; + + `ts 0 .= val 0`; + `ts 1 .= val 0`; + `ts 2 .= val 0`; + + `w 0 .= blkPtr 0`; + `w 1 .= blkPtr 1`; + `w 2 .= blkPtr 2`; + `w 3 .= blkPtr 3`; + + `add_64 (x 0) (w 0) (ks 0)`; + `add3_64 (x 1) (w 1) (ks 1) (ts 0)`; + `add3_64 (x 2) (w 2) (ks 2) (ts 1)`; + `add_64 (x 3) (w 3) (ks 3)`; + + `rounds`; + + `cryptPtr 0 .= x 0`; + `cryptPtr 1 .= x 1`; + `cryptPtr 2 .= x 2`; + `cryptPtr 3 .= x 3`; + +|] +main = displayIO stdout . renderPretty 0.8 120 . renderJs $ + declWGlobal <> declKwGlobal <> processBlock <> + [jmacro| + if(typeof exports !== 'undefined') + exports.h$Threefish_256_Process_Block = h$Threefish_256_Process_Block; + |] + diff --git a/lib/boot/shims/utils/threefish/test_threefish_block.js b/lib/boot/shims/utils/threefish/test_threefish_block.js new file mode 100644 index 00000000..5900f25a --- /dev/null +++ b/lib/boot/shims/utils/threefish/test_threefish_block.js @@ -0,0 +1,83 @@ + +function output(x) { + if(typeof document !== 'undefined') { + document.write(x); + } else if(typeof console !== 'undefined') { + console.log(x); + } else { + print(x); + } +} + +function bufObj(n) { + var b = new ArrayBuffer(n); + return { buf: b + , u8: new Uint8Array(b) + , i3: new Int32Array(b) + }; +} + +function dumpData(r, n, key, blk1, blk2) { + function dispArr(a) { + var x = []; + for(var i=0;i<32;i++) { + var v = a[i]; + if(v < 10) x.push(' ' + v); + else if(v < 100) x.push(' ' + v); + else x.push('' + v); + } + return '[' + x.join(',') + ']'; + } + output(r+':'+n+' key ' + dispArr(key.u8)); + output(r+':'+n+' blk1 ' + dispArr(blk1.u8)); + output(r+':'+n+' blk2 ' + dispArr(blk2.u8)); +} + +var expected1 = [ 12,161,149,108,169, 43, 44,165 + , 54,238,255, 84, 12, 57,128, 73 + ,129,209,145, 8,175, 91,196,187 + ,206,146, 2, 51, 17, 15, 28,178] + +var expected2 = [218,149,102, 61, 87,125,181,112 + , 57,152,185,201,198, 6,219, 19 + ,111,131,255,166, 33,252, 53, 27 + ,164, 46,117,219, 81,182,159, 48]; + +function test_threefish_process_block() { + var start, end, i, key = bufObj(32), blk1 = bufObj(32), blk2 = bufObj(32); + var benchIter = 4000000; + var mb = 64*benchIter/1000000; + for(i=0;i<32;i++) { + blk1.u8[i] = 1; + key.u8[i] = 128 + i; + } + dumpData(0, 0, key, blk1, blk2); + for(i=1;i<=5;i++) { + h$Threefish_256_Process_Block(key, blk1, blk2, false); + dumpData(i, 1, key, blk1, blk2); + h$Threefish_256_Process_Block(key, blk2, blk1, false); + dumpData(i, 2, key, blk1, blk2); + } + for(i=0;i<32;i++) { + if(blk1.u8[i] !== expected1[i] || blk2.u8[i] !== expected2[i]) + throw("unexpected value: " + i + " - " + blk1.u8[i] + ': ' + expected1[i] + + " " + blk2.u8[i] + ': ' + expected2[i]); + } + // benchmark + // warmup + for(i=0;i<50000;i++) { + h$Threefish_256_Process_Block(key, blk1, blk2, false); + h$Threefish_256_Process_Block(key, blk2, blk1, false); + } + start = Date.now(); + for(i=0;i=1.10 + +Flag ghci + Description: Build GHCi support. + Default: True + Manual: True + +Flag stage1 + Description: Is this stage 1? + Default: False + Manual: True + +Flag stage2 + Description: Is this stage 2? + Default: True + Manual: True + +Flag stage3 + Description: Is this stage 3? + Default: False + Manual: True + +Library + Default-Language: Haskell2010 + Exposed: False + + Build-Depends: base >= 4 && < 5, +-- directory >= 1 && < 1.3, +-- process >= 1 && < 1.5, +-- bytestring >= 0.9 && < 0.11, +-- binary == 0.8.*, +-- time >= 1.4 && < 1.7, +-- containers >= 0.5 && < 0.6, +-- array >= 0.1 && < 0.6, +-- filepath >= 1 && < 1.5, +-- template-haskell == 2.11.*, +-- hpc == 0.6.*, +-- transformers == 0.5.*, + ghc-boot == @GhcVersion@ +-- , +-- hoopl >= 3.10.2 && < 3.11 + +-- if os(windows) +-- Build-Depends: Win32 == 2.3.* +-- else +-- Build-Depends: unix == 2.7.* + +-- if flag(ghci) +-- Build-Depends: ghci == 8.0.1 + + GHC-Options: -Wall -fno-warn-name-shadowing + + if flag(ghci) + CPP-Options: -DGHCI +-- Include-Dirs: ../rts/dist/build + + Other-Extensions: + BangPatterns + CPP + DataKinds + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveTraversable + DisambiguateRecordFields + ExplicitForAll + FlexibleContexts + FlexibleInstances + GADTs + GeneralizedNewtypeDeriving + MagicHash + MultiParamTypeClasses + NamedFieldPuns + NondecreasingIndentation + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + Trustworthy + TupleSections + TypeFamilies + TypeSynonymInstances + UnboxedTuples + UndecidableInstances + +-- Include-Dirs: . parser utils + + -- We need to set the unit id to ghc (without a version number) + -- as it's magic. But we can't set it for old versions of GHC (e.g. + -- when bootstrapping) because those versions of GHC don't understand + -- that GHC is wired-in. + if impl ( ghc >= 7.11 ) + GHC-Options: -this-unit-id ghc + else + if impl( ghc >= 7.9 ) + GHC-Options: -this-package-key ghc + + -- if flag(stage1) + -- Include-Dirs: stage1 + -- else + -- if flag(stage2) + -- Include-Dirs: stage2 + -- else + -- if flag(stage3) + -- Include-Dirs: stage2 + +-- Install-Includes: HsVersions.h, ghc_boot_platform.h + +-- c-sources: +-- parser/cutils.c +-- ghci/keepCAFsForGHCi.c +-- cbits/genSym.c + + hs-source-dirs: +-- basicTypes +-- cmm +-- codeGen +-- coreSyn +-- deSugar +-- ghci +-- hsSyn +-- iface +-- llvmGen + main +-- nativeGen +-- parser +-- prelude +-- profiling +-- rename +-- simplCore +-- simplStg +-- specialise +-- stgSyn +-- stranal +-- typecheck +-- types +-- utils +-- vectorise + + Exposed-Modules: +-- Avail +-- BasicTypes +-- ConLike +-- DataCon +-- PatSyn +-- Demand +-- Debug +-- Exception +-- FieldLabel +-- GhcMonad +-- Hooks +-- Id +-- IdInfo +-- Lexeme +-- Literal +-- Llvm +-- Llvm.AbsSyn +-- Llvm.MetaData +-- Llvm.PpLlvm +-- Llvm.Types +-- LlvmCodeGen +-- LlvmCodeGen.Base +-- LlvmCodeGen.CodeGen +-- LlvmCodeGen.Data +-- LlvmCodeGen.Ppr +-- LlvmCodeGen.Regs +-- LlvmMangler +-- MkId +-- Module +-- Name +-- NameEnv +-- NameSet +-- OccName +-- RdrName +-- SrcLoc +-- UniqSupply +-- Unique +-- Var +-- VarEnv +-- VarSet +-- UnVarGraph +-- BlockId +-- CLabel +-- Cmm +-- CmmBuildInfoTables +-- CmmPipeline +-- CmmCallConv +-- CmmCommonBlockElim +-- CmmImplementSwitchPlans +-- CmmContFlowOpt +-- CmmExpr +-- CmmInfo +-- CmmLex +-- CmmLint +-- CmmLive +-- CmmMachOp +-- CmmSwitch +-- CmmNode +-- CmmOpt +-- CmmParse +-- CmmProcPoint +-- CmmSink +-- CmmType +-- CmmUtils +-- CmmLayoutStack +-- MkGraph +-- PprBase +-- PprC +-- PprCmm +-- PprCmmDecl +-- PprCmmExpr +-- Bitmap +-- CodeGen.Platform +-- CodeGen.Platform.ARM +-- CodeGen.Platform.ARM64 +-- CodeGen.Platform.NoRegs +-- CodeGen.Platform.PPC +-- CodeGen.Platform.PPC_Darwin +-- CodeGen.Platform.SPARC +-- CodeGen.Platform.X86 +-- CodeGen.Platform.X86_64 +-- CgUtils +-- StgCmm +-- StgCmmBind +-- StgCmmClosure +-- StgCmmCon +-- StgCmmEnv +-- StgCmmExpr +-- StgCmmForeign +-- StgCmmHeap +-- StgCmmHpc +-- StgCmmArgRep +-- StgCmmLayout +-- StgCmmMonad +-- StgCmmPrim +-- StgCmmProf +-- StgCmmTicky +-- StgCmmUtils +-- StgCmmExtCode +-- SMRep +-- CoreArity +-- CoreFVs +-- CoreLint +-- CorePrep +-- CoreSubst +-- CoreSyn +-- TrieMap +-- CoreTidy +-- CoreUnfold +-- CoreUtils +-- CoreSeq +-- CoreStats +-- MkCore +-- PprCore +-- PmExpr +-- TmOracle +-- Check +-- Coverage +-- Desugar +-- DsArrows +-- DsBinds +-- DsCCall +-- DsExpr +-- DsForeign +-- DsGRHSs +-- DsListComp +-- DsMonad +-- DsUtils +-- Match +-- MatchCon +-- MatchLit +-- HsBinds +-- HsDecls +-- HsDoc +-- HsExpr +-- HsImpExp +-- HsLit +-- PlaceHolder +-- HsPat +-- HsSyn +-- HsTypes +-- HsUtils +-- BinIface +-- BuildTyCl +-- IfaceEnv +-- IfaceSyn +-- IfaceType +-- LoadIface +-- MkIface +-- TcIface +-- FlagChecker +-- Annotations +-- CmdLineParser +-- CodeOutput +-- Config +-- Constants +-- DriverMkDepend +-- DriverPhases +-- PipelineMonad +-- DriverPipeline +-- DynFlags +-- ErrUtils +-- Finder +-- GHC +-- GhcMake +-- GhcPlugins +-- DynamicLoading +-- HeaderInfo +-- HscMain +-- HscStats +-- HscTypes +-- InteractiveEval +-- InteractiveEvalTypes +-- PackageConfig +-- Packages +-- PlatformConstants + Plugins +-- TcPluginM +-- PprTyThing +-- StaticFlags +-- StaticPtrTable +-- SysTools +-- Elf +-- TidyPgm +-- Ctype +-- HaddockUtils +-- Lexer +-- OptCoercion +-- Parser +-- RdrHsSyn +-- ApiAnnotation +-- ForeignCall +-- PrelInfo +-- PrelNames +-- PrelRules +-- PrimOp +-- TysPrim +-- TysWiredIn +-- CostCentre +-- ProfInit +-- SCCfinal +-- RnBinds +-- RnEnv +-- RnExpr +-- RnHsDoc +-- RnNames +-- RnPat +-- RnSource +-- RnSplice +-- RnTypes +-- CoreMonad +-- CSE +-- FloatIn +-- FloatOut +-- LiberateCase +-- OccurAnal +-- SAT +-- SetLevels +-- SimplCore +-- SimplEnv +-- SimplMonad +-- SimplUtils +-- Simplify +-- SimplStg +-- StgStats +-- UnariseStg +-- Rules +-- SpecConstr +-- Specialise +-- CoreToStg +-- StgLint +-- StgSyn +-- CallArity +-- DmdAnal +-- WorkWrap +-- WwLib +-- FamInst +-- Inst +-- TcAnnotations +-- TcArrows +-- TcBinds +-- TcClassDcl +-- TcDefaults +-- TcDeriv +-- TcEnv +-- TcExpr +-- TcForeign +-- TcGenDeriv +-- TcGenGenerics +-- TcHsSyn +-- TcHsType +-- TcInstDcls +-- TcMType +-- TcValidity +-- TcMatches +-- TcPat +-- TcPatSyn +-- TcRnDriver +-- TcRnMonad +-- TcRnTypes +-- TcRules +-- TcSimplify +-- TcErrors +-- TcTyClsDecls +-- TcTyDecls +-- TcTypeable +-- TcType +-- TcEvidence +-- TcUnify +-- TcInteract +-- TcCanonical +-- TcFlatten +-- TcSMonad +-- TcTypeNats +-- TcSplice +-- Class +-- Coercion +-- DsMeta +-- THNames +-- FamInstEnv +-- FunDeps +-- InstEnv +-- TyCon +-- CoAxiom +-- Kind +-- Type +-- TyCoRep +-- Unify +-- Bag +-- Binary +-- BooleanFormula +-- BufWrite +-- Digraph +-- Encoding +-- FastFunctions +-- FastMutInt +-- FastString +-- FastStringEnv +-- Fingerprint +-- FiniteMap +-- FV +-- GraphBase +-- GraphColor +-- GraphOps +-- GraphPpr +-- IOEnv +-- ListSetOps +-- Maybes +-- MonadUtils +-- OrdList +-- Outputable +-- Pair +-- Panic +-- Pretty +-- State +-- Stream +-- StringBuffer +-- UniqDFM +-- UniqDSet +-- UniqFM +-- UniqSet +-- Util +-- Vectorise.Builtins.Base +-- Vectorise.Builtins.Initialise +-- Vectorise.Builtins +-- Vectorise.Monad.Base +-- Vectorise.Monad.Naming +-- Vectorise.Monad.Local +-- Vectorise.Monad.Global +-- Vectorise.Monad.InstEnv +-- Vectorise.Monad +-- Vectorise.Utils.Base +-- Vectorise.Utils.Closure +-- Vectorise.Utils.Hoisting +-- Vectorise.Utils.PADict +-- Vectorise.Utils.Poly +-- Vectorise.Utils +-- Vectorise.Generic.Description +-- Vectorise.Generic.PAMethods +-- Vectorise.Generic.PADict +-- Vectorise.Generic.PData +-- Vectorise.Type.Env +-- Vectorise.Type.Type +-- Vectorise.Type.TyConDecl +-- Vectorise.Type.Classify +-- Vectorise.Convert +-- Vectorise.Vect +-- Vectorise.Var +-- Vectorise.Env +-- Vectorise.Exp +-- Vectorise +-- Hoopl.Dataflow +-- Hoopl +-- CgInfoTbls used in ghci/DebuggerUtils +-- CgHeapery mkVirtHeapOffsets used in ghci + + Exposed-Modules: +-- AsmCodeGen +-- TargetReg +-- NCGMonad +-- Instruction +-- Format +-- Reg +-- RegClass +-- PIC +-- Platform +-- CPrim +-- X86.Regs +-- X86.RegInfo +-- X86.Instr +-- X86.Cond +-- X86.Ppr +-- X86.CodeGen +-- PPC.Regs +-- PPC.RegInfo +-- PPC.Instr +-- PPC.Cond +-- PPC.Ppr +-- PPC.CodeGen +-- SPARC.Base +-- SPARC.Regs +-- SPARC.Imm +-- SPARC.AddrMode +-- SPARC.Cond +-- SPARC.Instr +-- SPARC.Stack +-- SPARC.ShortcutJump +-- SPARC.Ppr +-- SPARC.CodeGen +-- SPARC.CodeGen.Amode +-- SPARC.CodeGen.Base +-- SPARC.CodeGen.CondCode +-- SPARC.CodeGen.Gen32 +-- SPARC.CodeGen.Gen64 +-- SPARC.CodeGen.Sanity +-- SPARC.CodeGen.Expand +-- RegAlloc.Liveness +-- RegAlloc.Graph.Main +-- RegAlloc.Graph.Stats +-- RegAlloc.Graph.ArchBase +-- RegAlloc.Graph.ArchX86 +-- RegAlloc.Graph.Coalesce +-- RegAlloc.Graph.Spill +-- RegAlloc.Graph.SpillClean +-- RegAlloc.Graph.SpillCost +-- RegAlloc.Graph.TrivColorable +-- RegAlloc.Linear.Main +-- RegAlloc.Linear.JoinToTargets +-- RegAlloc.Linear.State +-- RegAlloc.Linear.Stats +-- RegAlloc.Linear.FreeRegs +-- RegAlloc.Linear.StackMap +-- RegAlloc.Linear.Base +-- RegAlloc.Linear.X86.FreeRegs +-- RegAlloc.Linear.X86_64.FreeRegs +-- RegAlloc.Linear.PPC.FreeRegs +-- RegAlloc.Linear.SPARC.FreeRegs +-- Dwarf +-- Dwarf.Types +-- Dwarf.Constants + + if !flag(stage1) + -- ghc:Serialized moved to ghc-boot:GHC.Serialized. So for + -- compatibility with GHC 7.10 and earlier, we reexport it + -- under the old name. + reexported-modules: + ghc-boot:GHC.Serialized as Serialized + +-- if flag(ghci) +-- Exposed-Modules: +-- Convert +-- ByteCodeTypes +-- ByteCodeAsm +-- ByteCodeGen +-- ByteCodeInstr +-- ByteCodeItbls +-- ByteCodeLink +-- Debugger +-- Linker +-- RtClosureInspect +-- DebuggerUtils +-- GHCi diff --git a/lib/ghc/main/Plugins.hs b/lib/ghc/main/Plugins.hs new file mode 100644 index 00000000..6e7a2d33 --- /dev/null +++ b/lib/ghc/main/Plugins.hs @@ -0,0 +1,53 @@ +module Plugins ( + FrontendPlugin(..), defaultFrontendPlugin, + Plugin(..), CommandLineOption, + defaultPlugin + ) where + +-- import CoreMonad ( CoreToDo, CoreM ) +-- import TcRnTypes ( TcPlugin ) +-- import GhcMonad +-- import DriverPhases + +type CoreM a = Maybe a +type Ghc a = Maybe a +type CoreToDo = Int +type Phase = Int +type TcPlugin = Int + +-- | Command line options gathered from the -PModule.Name:stuff syntax +-- are given to you as this type +type CommandLineOption = String + +-- | 'Plugin' is the core compiler plugin data type. Try to avoid +-- constructing one of these directly, and just modify some fields of +-- 'defaultPlugin' instead: this is to try and preserve source-code +-- compatability when we add fields to this. +-- +-- Nonetheless, this API is preliminary and highly likely to change in +-- the future. +data Plugin = Plugin { + installCoreToDos :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] + -- ^ Modify the Core pipeline that will be used for compilation. + -- This is called as the Core pipeline is built for every module + -- being compiled, and plugins get the opportunity to modify the + -- pipeline in a nondeterministic order. + , tcPlugin :: [CommandLineOption] -> Maybe TcPlugin + -- ^ An optional typechecker plugin, which may modify the + -- behaviour of the constraint solver. + } + +-- | Default plugin: does nothing at all! For compatability reasons +-- you should base all your plugin definitions on this default value. +defaultPlugin :: Plugin +defaultPlugin = Plugin { + installCoreToDos = const return + , tcPlugin = const Nothing + } + +type FrontendPluginAction = [String] -> [(String, Maybe Phase)] -> Ghc () +data FrontendPlugin = FrontendPlugin { + frontend :: FrontendPluginAction + } +defaultFrontendPlugin :: FrontendPlugin +defaultFrontendPlugin = FrontendPlugin { frontend = \_ _ -> return () } diff --git a/lib/ghcjs-prim/GHCJS/Prim/Internal/Build.hs b/lib/ghcjs-prim/GHCJS/Prim/Internal/Build.hs index cd8b2cfd..37d85f4b 100644 --- a/lib/ghcjs-prim/GHCJS/Prim/Internal/Build.hs +++ b/lib/ghcjs-prim/GHCJS/Prim/Internal/Build.hs @@ -142,6 +142,7 @@ module GHCJS.Prim.Internal.Build import GHCJS.Prim import GHC.Prim +import GHC.Exts import Unsafe.Coerce import System.IO.Unsafe diff --git a/lib/ghcjs-prim/ghcjs-prim.cabal b/lib/ghcjs-prim/ghcjs-prim.cabal index b19f3696..97c7757e 100644 --- a/lib/ghcjs-prim/ghcjs-prim.cabal +++ b/lib/ghcjs-prim/ghcjs-prim.cabal @@ -15,9 +15,7 @@ library c-sources: cbits/ghcjs-prim.c build-depends: base >= 4 && < 5, - ghc-prim, - primitive + ghc-prim default-language: Haskell2010 ghc-options: -O2 cpp-options: -DBOOTING_PACKAGE=ghcjs-prim - diff --git a/lib/ghcjs-th/GHCJS/Prim/TH/Eval.hs b/lib/ghcjs-th/GHCJS/Prim/TH/Eval.hs old mode 100755 new mode 100644 index 4c1d8460..8404a2ed --- a/lib/ghcjs-th/GHCJS/Prim/TH/Eval.hs +++ b/lib/ghcjs-th/GHCJS/Prim/TH/Eval.hs @@ -21,7 +21,7 @@ import GHCJS.Prim.TH.Types import Control.Applicative import qualified Control.Exception as E import Control.Monad -import qualified Control.Monad.Fail as Fail +import Control.Monad.Fail import Data.Binary import Data.Binary.Get @@ -40,14 +40,15 @@ import qualified Data.Map as M import Data.Maybe import Data.Monoid ((<>)) import Data.Typeable -import Data.Typeable.Internal import Data.Word import Foreign.C import Foreign.Ptr import GHC.Prim +import GHC.Exts import GHC.Desugar +import GHC.Fingerprint.Type import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH @@ -95,9 +96,8 @@ instance Monad GHCJSQ where (a, s'') <- runGHCJSQ (f m') s' return (a, s'') return = pure - fail = Fail.fail -instance Fail.MonadFail GHCJSQ where +instance MonadFail GHCJSQ where fail err = GHCJSQ $ \s -> E.throw (GHCJSQException s Nothing err) getState :: GHCJSQ QState @@ -141,11 +141,21 @@ instance TH.Quasi GHCJSQ where qReifyModule m = do ReifyModule' mi <- sendRequestQ (ReifyModule m) return mi -#if MIN_VERSION_template_haskell(2,11,0) qReifyFixity m = do ReifyFixity' mi <- sendRequestQ (ReifyFixity m) return mi -#endif + qReifyConStrictness name = do + ReifyConStrictness' ss <- sendRequestQ (ReifyConStrictness name) + return ss + qAddForeignFile lang contents = do + AddForeignFile' <- sendRequestQ (AddForeignFile lang contents) + return () + qIsExtEnabled ext = do + IsExtEnabled' b <- sendRequestQ (IsExtEnabled ext) + return b + qExtsEnabled = do + ExtsEnabled' exts <- sendRequestQ ExtsEnabled + return exts qLocation = fromMaybe noLoc . qsLocation <$> getState qRunIO m = GHCJSQ $ \s -> fmap (,s) m qAddDependentFile file = do @@ -165,14 +175,26 @@ instance TH.Quasi GHCJSQ where makeAnnPayload :: forall a. Data a => a -> ByteString makeAnnPayload x = +#if __GLASGOW_HASKELL__ >= 711 + let Fingerprint w1 w2 = typeRepFingerprint (typeOf (undefined :: a)) +#elif __GLASGOW_HASKELL__ >= 709 let TypeRep (Fingerprint w1 w2) _ _ _ = typeOf (undefined :: a) +#else + let TypeRep (Fingerprint w1 w2) _ _ = typeOf (undefined :: a) +#endif fp = runPut (putWord64be w1 >> putWord64be w2) in BL.toStrict $ fp <> BL.pack (serializeWithData x) convertAnnPayloads :: forall a. Data a => [ByteString] -> [a] convertAnnPayloads bs = catMaybes (map convert bs) where +#if __GLASGOW_HASKELL__ >= 711 + Fingerprint w1 w2 = typeRepFingerprint (typeOf (undefined :: a)) +#elif __GLASGOW_HASKELL__ >= 709 TypeRep (Fingerprint w1 w2) _ _ _ = typeOf (undefined :: a) +#else + TypeRep (Fingerprint w1 w2) _ _ = typeOf (undefined :: a) +#endif getFp b = runGet ((,) <$> getWord64be <*> getWord64be) $ BL.fromStrict (B.take 16 b) convert b | (bw1,bw2) <- getFp b, bw1 == w1, bw2 == w2 = Just (deserializeWithData . B.unpack . B.drop 16 $ b) @@ -194,11 +216,9 @@ runTHServer = do a <- TH.qRunIO (loadCode code) runTH t a loc server - FinishTH endProcess -> do + FinishTH -> do runModFinalizers - mu <- TH.qRunIO $ js_getMemoryUsage - TH.qRunIO $ sendResult (FinishTH' mu) - when (not endProcess) server + TH.qRunIO $ sendResult FinishTH' _ -> error "runTHServer: unexpected message type" {-# NOINLINE runTH #-} @@ -269,9 +289,6 @@ foreign import javascript unsafe "h$TH.bufSize($1_1, $1_2)" foreign import javascript unsafe "h$TH.loadCode($1_1,$1_2,$2)" js_loadCode :: Ptr Word8 -> Int -> IO Double -foreign import javascript unsafe "$r = h$TH.getMemoryUsage();" - js_getMemoryUsage :: IO Int - -- | only safe in JS fromBs :: ByteString -> IO (Ptr Word8) fromBs bs = BU.unsafeUseAsCString bs (return . castPtr) diff --git a/lib/ghcjs-th/GHCJS/Prim/TH/Serialized.hs b/lib/ghcjs-th/GHCJS/Prim/TH/Serialized.hs index f2998299..d8cd4735 100644 --- a/lib/ghcjs-th/GHCJS/Prim/TH/Serialized.hs +++ b/lib/ghcjs-th/GHCJS/Prim/TH/Serialized.hs @@ -17,7 +17,7 @@ import Data.Binary import Data.Bits import Data.Data import Data.Typeable -import Data.Typeable.Internal +-- import Data.Typeable.Internal import Data.Word -- | Represents a serialized value of a particular type. Attempts can be made to deserialize it at certain types @@ -28,16 +28,6 @@ instance Binary Serialized where put the_type >> put bytes get = Serialized <$> get <*> get -instance Binary TyCon where - put tc = put (tyConPackage tc) >> put (tyConModule tc) >> put (tyConName tc) - get = mkTyCon3 <$> get <*> get <*> get - -instance Binary TypeRep where - put type_rep = - let (ty_con, child_type_reps) = splitTyConApp type_rep - in put ty_con >> put child_type_reps - get = mkTyConApp <$> get <*> get - -- | Put a Typeable value that we are able to actually turn into bytes into a 'Serialized' value ready for deserialization later toSerialized :: Typeable a => (a -> [Word8]) -> a -> Serialized toSerialized serialize what = Serialized (typeOf what) (serialize what) diff --git a/lib/ghcjs-th/GHCJS/Prim/TH/Types.hs b/lib/ghcjs-th/GHCJS/Prim/TH/Types.hs index 11187e3e..61fa9ef6 100755 --- a/lib/ghcjs-th/GHCJS/Prim/TH/Types.hs +++ b/lib/ghcjs-th/GHCJS/Prim/TH/Types.hs @@ -1,5 +1,14 @@ {-# OPTIONS_GHC -O0 #-} -{-# LANGUAGE CPP, DeriveGeneric, DeriveDataTypeable, LambdaCase, MagicHash, StandaloneDeriving #-} +{-# LANGUAGE CPP, + DeriveGeneric, + DeriveDataTypeable, + LambdaCase, + MagicHash, + StandaloneDeriving + #-} +#ifndef __GHCJS__ +{-# LANGUAGE PackageImports #-} +#endif {- | Communication between the compiler (GHCJS) and runtime (on node.js) for @@ -23,8 +32,13 @@ import GHC.Exts import GHCJS.Prim.TH.Serialized import GHCi.TH.Binary +#ifdef __GHCJS__ import qualified Language.Haskell.TH as TH import qualified Language.Haskell.TH.Syntax as TH +#else +import qualified "template-haskell-ghcjs" Language.Haskell.TH as TH +import qualified "template-haskell-ghcjs" Language.Haskell.TH.Syntax as TH +#endif data THResultType = THExp | THPat | THType | THDec | THAnnWrapper deriving (Enum, Show, Data, Generic) @@ -32,34 +46,42 @@ data THResultType = THExp | THPat | THType | THDec | THAnnWrapper data Message -- | compiler to node requests = RunTH THResultType ByteString (Maybe TH.Loc) - | FinishTH Bool -- ^ also stop runner (False to just clean up at end of module) + | FinishTH -- | node to compiler responses | RunTH' ByteString -- ^ serialized result - | FinishTH' Int -- ^ memory consumption + | FinishTH' -- | node to compiler requests - | NewName String - | Report Bool String - | LookupName Bool String - | Reify TH.Name - | ReifyInstances TH.Name [TH.Type] - | ReifyRoles TH.Name - | ReifyAnnotations TH.AnnLookup - | ReifyModule TH.Module - | ReifyFixity TH.Name - | AddDependentFile FilePath - | AddTopDecls [TH.Dec] + | NewName String + | Report Bool String + | LookupName Bool String + | Reify TH.Name + | ReifyInstances TH.Name [TH.Type] + | ReifyRoles TH.Name + | ReifyAnnotations TH.AnnLookup + | ReifyModule TH.Module + | ReifyFixity TH.Name + | ReifyConStrictness TH.Name + | AddForeignFile TH.ForeignSrcLang String + | AddDependentFile FilePath + | AddTopDecls [TH.Dec] + | IsExtEnabled TH.Extension + | ExtsEnabled -- | compiler to node responses - | NewName' TH.Name + | NewName' TH.Name | Report' - | LookupName' (Maybe TH.Name) - | Reify' TH.Info - | ReifyInstances' [TH.Dec] - | ReifyRoles' [TH.Role] - | ReifyAnnotations' [ByteString] - | ReifyModule' TH.ModuleInfo - | ReifyFixity' (Maybe TH.Fixity) + | LookupName' (Maybe TH.Name) + | Reify' TH.Info + | ReifyInstances' [TH.Dec] + | ReifyRoles' [TH.Role] + | ReifyAnnotations' [ByteString] + | ReifyModule' TH.ModuleInfo + | ReifyFixity' (Maybe TH.Fixity) + | ReifyConStrictness' [TH.DecidedStrictness] + | AddForeignFile' | AddDependentFile' | AddTopDecls' + | IsExtEnabled' Bool + | ExtsEnabled' [TH.Extension] | QFail' | QCompilerException' Int String -- ^ exception id and result of showing the exception -- | error recovery @@ -71,16 +93,23 @@ data Message | QFail String -- ^ monadic fail called | QUserException String -- ^ exception in user code | QCompilerException Int -- ^ exception originated on compiler side - deriving (Data, Generic) + deriving (Generic) + + +-- deriving instance Generic TH.ForeignSrcLang + +instance Binary TH.Extension +instance Binary TH.ForeignSrcLang instance Binary THResultType instance Binary Message -#if MIN_VERSION_template_haskell(2,12,0) -#error "unsupported template-haskell version" -#elif MIN_VERSION_template_haskell(2,9,0) +-- #if MIN_VERSION_template_haskell(2,13,0) +-- #error "unsupported template-haskell version" +-- #elif MIN_VERSION_template_haskell(2,9,0) -#if !MIN_VERSION_template_haskell(2,10,0) +-- #if !MIN_VERSION_template_haskell(2,10,0) +{- deriving instance Generic TH.Pred deriving instance Generic TH.Loc @@ -123,19 +152,19 @@ deriving instance Generic TH.Con deriving instance Generic TH.AnnLookup deriving instance Generic TH.ModuleInfo deriving instance Generic TH.Clause -#endif +-- #endif -#if !MIN_VERSION_template_haskell(2,10,0) +-- #if !MIN_VERSION_template_haskell(2,10,0) instance Binary TH.Pred -#endif +-- #endif -#if !MIN_VERSION_template_haskell(2,11,0) +-- #if !MIN_VERSION_template_haskell(2,11,0) instance Binary TH.Loc instance Binary TH.Name instance Binary TH.ModName -#if MIN_VERSION_template_haskell(2,10,0) +-- #if MIN_VERSION_template_haskell(2,10,0) instance Binary TH.NameFlavour -#else +-- #else instance Binary TH.NameFlavour where put TH.NameS = putWord8 1 put (TH.NameQ mn) = putWord8 2 >> put mn @@ -149,7 +178,7 @@ instance Binary TH.NameFlavour where 4 -> (\(I# i) -> TH.NameL i) <$> get 5 -> TH.NameG <$> get <*> get <*> get _ -> error "get Name: invalid tag" -#endif +-- #endif instance Binary TH.PkgName instance Binary TH.NameSpace @@ -188,19 +217,19 @@ instance Binary TH.AnnLookup instance Binary TH.ModuleInfo instance Binary TH.Clause -#if MIN_VERSION_template_haskell(2,11,0) +-- #if MIN_VERSION_template_haskell(2,11,0) instance Binary TH.InjectivityAnn instance Binary TH.FamilyResultSig instance Binary TH.Bang instance Binary TH.SourceUnpackedness instance Binary TH.SourceStrictness instance Binary TH.TypeFamilyHead -#else +-- #else instance Binary TH.Strict -#endif +-- #endif -#endif - -#else -#error "unsupported template-haskell version" -#endif +-- #endif +-} +-- #else +-- #error "unsupported template-haskell version" +-- #endif diff --git a/lib/ghcjs-th/ghcjs-th.cabal b/lib/ghcjs-th/ghcjs-th.cabal index 6caa2f15..a1fde8e4 100644 --- a/lib/ghcjs-th/ghcjs-th.cabal +++ b/lib/ghcjs-th/ghcjs-th.cabal @@ -14,14 +14,17 @@ library GHCJS.Prim.TH.Types build-depends: base >= 4 && < 5, - template-haskell >= 2.9 && < 2.12, - ghci, ghc-prim, - primitive, binary, bytestring, containers + if impl(ghcjs) + build-depends: template-haskell >= 2.12 && < 2.13, + ghci + else + build-depends: template-haskell-ghcjs, + ghci-ghcjs + default-language: Haskell2010 ghc-options: -O2 cpp-options: -DBOOTING_PACKAGE=ghcjs-th - diff --git a/lib/cache/shims.tar b/lib/patches/Win32.patch similarity index 100% rename from lib/cache/shims.tar rename to lib/patches/Win32.patch diff --git a/lib/patches/base.patch b/lib/patches/base.patch new file mode 100644 index 00000000..9d59b86f --- /dev/null +++ b/lib/patches/base.patch @@ -0,0 +1,857 @@ +diff -Nru upstream/pkg/base/base.cabal boot/pkg/base/base.cabal +--- upstream/pkg/base/base.cabal 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/base.cabal 2018-01-09 08:27:50.750813861 +0000 +@@ -50,7 +50,7 @@ + Flag integer-gmp + Description: Use integer-gmp + Manual: True +- Default: False ++ Default: True + + Library + default-language: Haskell2010 +@@ -343,7 +343,7 @@ + consUtils.h + + -- OS Specific +- if os(windows) ++ if os(windows) && !impl(ghcjs) + -- Windows requires some extra libraries for linking because the RTS + -- is no longer re-exporting them. + -- msvcrt: standard C library. The RTS will automatically include this, +@@ -361,27 +361,29 @@ + other-modules: + System.CPUTime.Windows + else +- exposed-modules: +- GHC.Event ++ if !impl(ghcjs) ++ exposed-modules: ++ GHC.Event ++ other-modules: ++ GHC.Event.Arr ++ GHC.Event.Array ++ GHC.Event.Clock ++ GHC.Event.Control ++ GHC.Event.EPoll ++ GHC.Event.IntTable ++ GHC.Event.Internal ++ GHC.Event.KQueue ++ GHC.Event.Manager ++ GHC.Event.PSQ ++ GHC.Event.Poll ++ GHC.Event.Thread ++ GHC.Event.TimerManager ++ GHC.Event.Unique ++ ++ System.CPUTime.Posix.ClockGetTime ++ System.CPUTime.Posix.Times ++ System.CPUTime.Posix.RUsage + other-modules: +- GHC.Event.Arr +- GHC.Event.Array +- GHC.Event.Clock +- GHC.Event.Control +- GHC.Event.EPoll +- GHC.Event.IntTable +- GHC.Event.Internal +- GHC.Event.KQueue +- GHC.Event.Manager +- GHC.Event.PSQ +- GHC.Event.Poll +- GHC.Event.Thread +- GHC.Event.TimerManager +- GHC.Event.Unique +- +- System.CPUTime.Posix.ClockGetTime +- System.CPUTime.Posix.Times +- System.CPUTime.Posix.RUsage + System.CPUTime.Unsupported + + -- We need to set the unit id to base (without a version number) +diff -Nru upstream/pkg/base/Data/Semigroup.hs boot/pkg/base/Data/Semigroup.hs +--- upstream/pkg/base/Data/Semigroup.hs 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/Data/Semigroup.hs 2018-01-09 08:27:50.750813861 +0000 +@@ -84,7 +84,7 @@ + import Data.Monoid (Alt (..)) + import qualified Data.Monoid as Monoid + import Data.Void +-#ifndef mingw32_HOST_OS ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + import GHC.Event (Event, Lifetime) + #endif + import GHC.Generics +@@ -719,7 +719,7 @@ + instance Semigroup a => Semigroup (IO a) where + (<>) = liftA2 (<>) + +-#ifndef mingw32_HOST_OS ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + -- | @since 4.10.0.0 + instance Semigroup Event where + (<>) = mappend +diff -Nru upstream/pkg/base/GHC/Conc/IO.hs boot/pkg/base/GHC/Conc/IO.hs +--- upstream/pkg/base/GHC/Conc/IO.hs 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/GHC/Conc/IO.hs 2018-01-09 08:27:50.750813861 +0000 +@@ -59,24 +59,26 @@ + import GHC.Real ( fromIntegral ) + import System.Posix.Types + +-#ifdef mingw32_HOST_OS ++#if defined(mingw32_HOST_OS) + import qualified GHC.Conc.Windows as Windows + import GHC.Conc.Windows (asyncRead, asyncWrite, asyncDoProc, asyncReadBA, + asyncWriteBA, ConsoleEvent(..), win32ConsoleHandler, + toWin32ConsoleEvent) +-#else ++#elif !defined(ghcjs_HOST_OS) + import qualified GHC.Event.Thread as Event + #endif + + ensureIOManagerIsRunning :: IO () +-#ifndef mingw32_HOST_OS +-ensureIOManagerIsRunning = Event.ensureIOManagerIsRunning +-#else ++#if defined(mingw32_HOST_OS) + ensureIOManagerIsRunning = Windows.ensureIOManagerIsRunning ++#elif defined(ghcjs_HOST_OS) ++ensureIOManagerIsRunning = return () ++#else ++ensureIOManagerIsRunning = Event.ensureIOManagerIsRunning + #endif + + ioManagerCapabilitiesChanged :: IO () +-#ifndef mingw32_HOST_OS ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + ioManagerCapabilitiesChanged = Event.ioManagerCapabilitiesChanged + #else + ioManagerCapabilitiesChanged = return () +@@ -90,7 +92,7 @@ + -- that has been used with 'threadWaitRead', use 'closeFdWith'. + threadWaitRead :: Fd -> IO () + threadWaitRead fd +-#ifndef mingw32_HOST_OS ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + | threaded = Event.threadWaitRead fd + #endif + | otherwise = IO $ \s -> +@@ -106,7 +108,7 @@ + -- that has been used with 'threadWaitWrite', use 'closeFdWith'. + threadWaitWrite :: Fd -> IO () + threadWaitWrite fd +-#ifndef mingw32_HOST_OS ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + | threaded = Event.threadWaitWrite fd + #endif + | otherwise = IO $ \s -> +@@ -120,7 +122,7 @@ + -- in the file descriptor. + threadWaitReadSTM :: Fd -> IO (Sync.STM (), IO ()) + threadWaitReadSTM fd +-#ifndef mingw32_HOST_OS ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + | threaded = Event.threadWaitReadSTM fd + #endif + | otherwise = do +@@ -139,7 +141,7 @@ + -- in the file descriptor. + threadWaitWriteSTM :: Fd -> IO (Sync.STM (), IO ()) + threadWaitWriteSTM fd +-#ifndef mingw32_HOST_OS ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + | threaded = Event.threadWaitWriteSTM fd + #endif + | otherwise = do +@@ -164,7 +166,7 @@ + -> Fd -- ^ File descriptor to close. + -> IO () + closeFdWith close fd +-#ifndef mingw32_HOST_OS ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + | threaded = Event.closeFdWith close fd + #endif + | otherwise = close fd +@@ -178,9 +180,9 @@ + -- + threadDelay :: Int -> IO () + threadDelay time +-#ifdef mingw32_HOST_OS ++#if defined(mingw32_HOST_OS) + | threaded = Windows.threadDelay time +-#else ++#elif !defined(ghcjs_HOST_OS) + | threaded = Event.threadDelay time + #endif + | otherwise = IO $ \s -> +@@ -193,9 +195,9 @@ + -- + registerDelay :: Int -> IO (TVar Bool) + registerDelay usecs +-#ifdef mingw32_HOST_OS ++#if defined(mingw32_HOST_OS) + | threaded = Windows.registerDelay usecs +-#else ++#elif !defined(ghcjs_HOST_OS) + | threaded = Event.registerDelay usecs + #endif + | otherwise = errorWithoutStackTrace "registerDelay: requires -threaded" +diff -Nru upstream/pkg/base/GHC/Conc/Windows.hs boot/pkg/base/GHC/Conc/Windows.hs +--- upstream/pkg/base/GHC/Conc/Windows.hs 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/GHC/Conc/Windows.hs 2018-01-09 08:27:50.750813861 +0000 +@@ -19,6 +19,9 @@ + + -- #not-home + module GHC.Conc.Windows ++#ifdef ghcjs_HOST_OS ++ () where ++#else + ( ensureIOManagerIsRunning + + -- * Waiting +@@ -335,3 +338,4 @@ + foreign import WINDOWS_CCONV "WaitForSingleObject" + c_WaitForSingleObject :: HANDLE -> DWORD -> IO DWORD + ++#endif +diff -Nru upstream/pkg/base/GHC/Conc.hs boot/pkg/base/GHC/Conc.hs +--- upstream/pkg/base/GHC/Conc.hs 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/GHC/Conc.hs 2018-01-09 08:27:50.750813861 +0000 +@@ -95,7 +95,7 @@ + , asyncWriteBA + #endif + +-#ifndef mingw32_HOST_OS ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + , Signal, HandlerFun, setHandler, runHandlers + #endif + +@@ -116,6 +116,6 @@ + import GHC.Conc.IO + import GHC.Conc.Sync + +-#ifndef mingw32_HOST_OS ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + import GHC.Conc.Signal + #endif +diff -Nru upstream/pkg/base/GHC/Event/Manager.hs boot/pkg/base/GHC/Event/Manager.hs +--- upstream/pkg/base/GHC/Event/Manager.hs 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/GHC/Event/Manager.hs 2018-01-09 08:27:50.750813861 +0000 +@@ -19,6 +19,9 @@ + -- polling if available. Otherwise we use multi-shot polling. + + module GHC.Event.Manager ++#ifdef ghcjs_HOST_OS ++ () where ++#else + ( -- * Types + EventManager + +@@ -518,3 +521,6 @@ + + unless :: Monad m => Bool -> m () -> m () + unless p = when (not p) ++ ++#endif ++ +diff -Nru upstream/pkg/base/GHC/Event/Thread.hs boot/pkg/base/GHC/Event/Thread.hs +--- upstream/pkg/base/GHC/Event/Thread.hs 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/GHC/Event/Thread.hs 2018-01-09 08:27:50.758812985 +0000 +@@ -1,7 +1,11 @@ + {-# LANGUAGE Trustworthy #-} + {-# LANGUAGE BangPatterns, NoImplicitPrelude #-} ++{-# LANGUAGE CPP #-} + + module GHC.Event.Thread ++#ifdef ghcjs_HOST_OS ++ ( ) where ++#else + ( getSystemEventManager + , getSystemTimerManager + , ensureIOManagerIsRunning +@@ -360,3 +364,6 @@ + + foreign import ccall unsafe "setTimerManagerControlFd" + c_setTimerManagerControlFd :: CInt -> IO () ++ ++#endif ++ +diff -Nru upstream/pkg/base/GHC/Event/TimerManager.hs boot/pkg/base/GHC/Event/TimerManager.hs +--- upstream/pkg/base/GHC/Event/TimerManager.hs 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/GHC/Event/TimerManager.hs 2018-01-09 08:27:50.758812985 +0000 +@@ -8,6 +8,9 @@ + #-} + + module GHC.Event.TimerManager ++#ifdef ghcjs_HOST_OS ++ () where ++#else + ( -- * Types + TimerManager + +@@ -241,3 +244,4 @@ + editTimeouts :: TimerManager -> TimeoutEdit -> IO () + editTimeouts mgr g = atomicModifyIORef' (emTimeouts mgr) $ \tq -> (g tq, ()) + ++#endif +diff -Nru upstream/pkg/base/GHC/Event.hs boot/pkg/base/GHC/Event.hs +--- upstream/pkg/base/GHC/Event.hs 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/GHC/Event.hs 2018-01-09 08:27:50.758812985 +0000 +@@ -1,5 +1,6 @@ + {-# LANGUAGE Trustworthy #-} + {-# LANGUAGE NoImplicitPrelude #-} ++{-# LANGUAGE CPP #-} + + -- ---------------------------------------------------------------------------- + -- | This module provides scalable event notification for file +@@ -10,6 +11,9 @@ + -- ---------------------------------------------------------------------------- + + module GHC.Event ++#ifdef ghcjs_HOST_OS ++ ( ) where ++#else + ( -- * Types + EventManager + , TimerManager +@@ -44,3 +48,4 @@ + updateTimeout, unregisterTimeout, TimerManager) + import GHC.Event.Thread (getSystemEventManager, getSystemTimerManager) + ++#endif +diff -Nru upstream/pkg/base/GHC/IO/Encoding/CodePage/API.hs boot/pkg/base/GHC/IO/Encoding/CodePage/API.hs +--- upstream/pkg/base/GHC/IO/Encoding/CodePage/API.hs 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/GHC/IO/Encoding/CodePage/API.hs 2018-01-09 08:27:50.758812985 +0000 +@@ -29,6 +29,7 @@ + + import System.Posix.Internals + ++#ifndef ghcjs_HOST_OS + + c_DEBUG_DUMP :: Bool + c_DEBUG_DUMP = False +@@ -427,3 +428,8 @@ + -- Must have interpreted all given bytes successfully + -- We need to iterate until we have consumed the complete contents of the buffer + Right wrote_elts -> go (bufferRemove n ibuf) (obuf { bufR = bufR obuf + wrote_elts }) ++ ++#else ++mkCodePageEncoding :: String ++mkCodePageEncoding = "" ++#endif +diff -Nru upstream/pkg/base/GHC/IO/Encoding.hs boot/pkg/base/GHC/IO/Encoding.hs +--- upstream/pkg/base/GHC/IO/Encoding.hs 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/GHC/IO/Encoding.hs 2018-01-09 08:27:50.758812985 +0000 +@@ -140,8 +140,11 @@ + + -- | @since 4.5.0.0 + initLocaleEncoding, initFileSystemEncoding, initForeignEncoding :: TextEncoding +- +-#if !defined(mingw32_HOST_OS) ++#if defined(ghcjs_HOST_OS) ++initLocaleEncoding = utf8 ++initFileSystemEncoding = utf8 ++initForeignEncoding = utf8 ++#elif !defined(mingw32_HOST_OS) + -- It is rather important that we don't just call Iconv.mkIconvEncoding here + -- because some iconvs (in particular GNU iconv) will brokenly UTF-8 encode + -- lone surrogates without complaint. +diff -Nru upstream/pkg/base/GHC/IO/FD.hs boot/pkg/base/GHC/IO/FD.hs +--- upstream/pkg/base/GHC/IO/FD.hs 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/GHC/IO/FD.hs 2018-01-09 08:27:50.758812985 +0000 +@@ -501,6 +501,10 @@ + + readRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int + readRawBufferPtr loc !fd !buf !off !len ++#ifdef ghcjs_HOST_OS ++ = fmap fromIntegral . uninterruptibleMask_ $ ++ throwErrnoIfMinus1 loc (c_read (fdFD fd) (buf `plusPtr` off) len) ++#else + | isNonBlocking fd = unsafe_read -- unsafe is ok, it can't block + | otherwise = do r <- throwErrnoIfMinus1 loc + (unsafe_fdReady (fdFD fd) 0 0 0) +@@ -514,10 +518,19 @@ + read = if threaded then safe_read else unsafe_read + unsafe_read = do_read (c_read (fdFD fd) (buf `plusPtr` off) len) + safe_read = do_read (c_safe_read (fdFD fd) (buf `plusPtr` off) len) ++#endif + + -- return: -1 indicates EOF, >=0 is bytes read + readRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int + readRawBufferPtrNoBlock loc !fd !buf !off !len ++#ifdef ghcjs_HOST_OS ++ = uninterruptibleMask_ $ do ++ r <- throwErrnoIfMinus1 loc (c_read (fdFD fd) (buf `plusPtr` off) len) ++ case r of ++ (-1) -> return 0 ++ 0 -> return (-1) ++ n -> return (fromIntegral n) ++#else + | isNonBlocking fd = unsafe_read -- unsafe is ok, it can't block + | otherwise = do r <- unsafe_fdReady (fdFD fd) 0 0 0 + if r /= 0 then safe_read +@@ -531,9 +544,14 @@ + n -> return (fromIntegral n) + unsafe_read = do_read (c_read (fdFD fd) (buf `plusPtr` off) len) + safe_read = do_read (c_safe_read (fdFD fd) (buf `plusPtr` off) len) ++#endif + + writeRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt + writeRawBufferPtr loc !fd !buf !off !len ++#ifdef ghcjs_HOST_OS ++ = fmap fromIntegral . uninterruptibleMask_ $ ++ throwErrnoIfMinus1 loc (c_write (fdFD fd) (buf `plusPtr` off) len) ++#else + | isNonBlocking fd = unsafe_write -- unsafe is ok, it can't block + | otherwise = do r <- unsafe_fdReady (fdFD fd) 1 0 0 + if r /= 0 +@@ -546,9 +564,17 @@ + write = if threaded then safe_write else unsafe_write + unsafe_write = do_write (c_write (fdFD fd) (buf `plusPtr` off) len) + safe_write = do_write (c_safe_write (fdFD fd) (buf `plusPtr` off) len) ++#endif + + writeRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt + writeRawBufferPtrNoBlock loc !fd !buf !off !len ++#ifdef ghcjs_HOST_OS ++ = uninterruptibleMask_ $ do ++ r <- throwErrnoIfMinus1 loc (c_write (fdFD fd) (buf `plusPtr` off) len) ++ case r of ++ (-1) -> return 0 ++ n -> return (fromIntegral n) ++#else + | isNonBlocking fd = unsafe_write -- unsafe is ok, it can't block + | otherwise = do r <- unsafe_fdReady (fdFD fd) 1 0 0 + if r /= 0 then write +@@ -561,9 +587,14 @@ + write = if threaded then safe_write else unsafe_write + unsafe_write = do_write (c_write (fdFD fd) (buf `plusPtr` off) len) + safe_write = do_write (c_safe_write (fdFD fd) (buf `plusPtr` off) len) ++#endif + + isNonBlocking :: FD -> Bool ++#ifdef ghcjs_HOST_OS ++isNonBlocking _ = True ++#else + isNonBlocking fd = fdIsNonBlocking fd /= 0 ++#endif + + foreign import ccall unsafe "fdReady" + unsafe_fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt +@@ -647,7 +678,7 @@ + -- ----------------------------------------------------------------------------- + -- utils + +-#ifndef mingw32_HOST_OS ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + throwErrnoIfMinus1RetryOnBlock :: String -> IO CSsize -> IO CSsize -> IO CSsize + throwErrnoIfMinus1RetryOnBlock loc f on_block = + do +diff -Nru upstream/pkg/base/GHC/Stack/CCS.hsc boot/pkg/base/GHC/Stack/CCS.hsc +--- upstream/pkg/base/GHC/Stack/CCS.hsc 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/GHC/Stack/CCS.hsc 2018-01-09 08:27:50.758812985 +0000 +@@ -15,7 +15,7 @@ + -- @since 4.5.0.0 + ----------------------------------------------------------------------------- + +-{-# LANGUAGE UnboxedTuples, MagicHash, NoImplicitPrelude #-} ++{-# LANGUAGE UnboxedTuples, MagicHash, NoImplicitPrelude, CPP #-} + module GHC.Stack.CCS ( + -- * Call stacks + currentCallStack, +@@ -64,6 +64,22 @@ + clearCCS :: IO a -> IO a + clearCCS (IO m) = IO $ \s -> clearCCS## m s + ++##ifdef ghcjs_HOST_OS ++ccsCC :: Ptr CostCentreStack -> IO (Ptr CostCentre) ++ccsCC p = peekByteOff p 4 ++ ++ccsParent :: Ptr CostCentreStack -> IO (Ptr CostCentreStack) ++ccsParent p = peekByteOff p 8 ++ ++ccLabel :: Ptr CostCentre -> IO CString ++ccLabel p = peekByteOff p 4 ++ ++ccModule :: Ptr CostCentre -> IO CString ++ccModule p = peekByteOff p 8 ++ ++ccSrcSpan :: Ptr CostCentre -> IO CString ++ccSrcSpan p = peekByteOff p 12 ++##else + ccsCC :: Ptr CostCentreStack -> IO (Ptr CostCentre) + ccsCC p = (# peek CostCentreStack, cc) p + +@@ -78,6 +94,7 @@ + + ccSrcSpan :: Ptr CostCentre -> IO CString + ccSrcSpan p = (# peek CostCentre, srcloc) p ++##endif + + -- | Returns a @[String]@ representing the current call stack. This + -- can be useful for debugging. +diff -Nru upstream/pkg/base/GHC/Stats.hsc boot/pkg/base/GHC/Stats.hsc +--- upstream/pkg/base/GHC/Stats.hsc 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/GHC/Stats.hsc 2018-01-09 08:27:50.758812985 +0000 +@@ -1,3 +1,4 @@ ++{-# LANGUAGE CPP #-} + {-# LANGUAGE Trustworthy #-} + {-# LANGUAGE NoImplicitPrelude #-} + {-# LANGUAGE RecordWildCards #-} +diff -Nru upstream/pkg/base/GHC/TopHandler.hs boot/pkg/base/GHC/TopHandler.hs +--- upstream/pkg/base/GHC/TopHandler.hs 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/GHC/TopHandler.hs 2018-01-09 08:27:50.762812547 +0000 +@@ -94,7 +94,9 @@ + topHandler + + install_interrupt_handler :: IO () -> IO () +-#ifdef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++install_interrupt_handler _ = return () ++#elif defined(mingw32_HOST_OS) + install_interrupt_handler handler = do + _ <- GHC.ConsoleHandler.installHandler $ + Catch $ \event -> +@@ -244,7 +246,7 @@ + unreachable = fail "If you can read this, shutdownHaskellAndExit did not exit." + + exitHelper :: CInt -> Int -> IO a +-#ifdef mingw32_HOST_OS ++#if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS) + exitHelper exitKind r = + shutdownHaskellAndExit (fromIntegral r) exitKind >> unreachable + #else +@@ -266,7 +268,7 @@ + + exitInterrupted :: IO a + exitInterrupted = +-#ifdef mingw32_HOST_OS ++#if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS) + safeExit 252 + #else + -- we must exit via the default action for SIGINT, so that the +diff -Nru upstream/pkg/base/GHC/Windows.hs boot/pkg/base/GHC/Windows.hs +--- upstream/pkg/base/GHC/Windows.hs 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/GHC/Windows.hs 2018-01-09 08:27:50.762812547 +0000 +@@ -21,6 +21,10 @@ + ----------------------------------------------------------------------------- + + module GHC.Windows ( ++#ifdef ghcjs_HOST_OS ++ ) where ++ ++#else + -- * Types + BOOL, + LPBOOL, +@@ -194,3 +198,5 @@ + -- | Get the last system error produced in the current thread. + foreign import WINDOWS_CCONV unsafe "windows.h GetLastError" + getLastError :: IO ErrCode ++ ++#endif +diff -Nru upstream/pkg/base/System/CPUTime.hsc boot/pkg/base/System/CPUTime.hsc +--- upstream/pkg/base/System/CPUTime.hsc 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/System/CPUTime.hsc 2018-01-09 08:27:50.762812547 +0000 +@@ -31,6 +31,10 @@ + import System.IO.Unsafe (unsafePerformIO) + + -- Here is where we decide which backend to use ++##if defined(ghcjs_HOST_OS) ++import qualified System.CPUTime.Unsupported as I ++##else ++ + #if defined(mingw32_HOST_OS) + import qualified System.CPUTime.Windows as I + +@@ -53,6 +57,8 @@ + import qualified System.CPUTime.Unsupported as I + #endif + ++##endif ++ + -- | The 'cpuTimePrecision' constant is the smallest measurable difference + -- in CPU time that the implementation can record, and is given as an + -- integral number of picoseconds. +diff -Nru upstream/pkg/base/System/Environment/ExecutablePath.hsc boot/pkg/base/System/Environment/ExecutablePath.hsc +--- upstream/pkg/base/System/Environment/ExecutablePath.hsc 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/System/Environment/ExecutablePath.hsc 2018-01-09 08:27:50.762812547 +0000 +@@ -18,6 +18,13 @@ + + module System.Environment.ExecutablePath ( getExecutablePath ) where + ++##if defined(ghcjs_HOST_OS) ++ ++getExecutablePath :: IO FilePath ++getExecutablePath = return "a.jsexe" ++ ++##else ++ + -- The imports are purposely kept completely disjoint to prevent edits + -- to one OS implementation from breaking another. + +@@ -173,3 +180,5 @@ + -------------------------------------------------------------------------------- + + #endif ++ ++##endif +\ No newline at end of file +diff -Nru upstream/pkg/base/System/Posix/Internals.hs boot/pkg/base/System/Posix/Internals.hs +--- upstream/pkg/base/System/Posix/Internals.hs 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/System/Posix/Internals.hs 2018-01-09 08:27:50.762812547 +0000 +@@ -1,6 +1,9 @@ + {-# LANGUAGE Trustworthy #-} + {-# LANGUAGE CPP, NoImplicitPrelude, CApiFFI #-} + {-# OPTIONS_HADDOCK hide #-} ++#ifdef ghcjs_HOST_OS ++{-# LANGUAGE JavaScriptFFI #-} ++#endif + + ----------------------------------------------------------------------------- + -- | +@@ -134,7 +137,7 @@ + Nothing + + fdGetMode :: FD -> IO IOMode +-#if defined(mingw32_HOST_OS) ++#if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS) + fdGetMode _ = do + -- We don't have a way of finding out which flags are set on FDs + -- on Windows, so make a handle that thinks that anything goes. +@@ -314,7 +317,7 @@ + -- Turning on non-blocking for a file descriptor + + setNonBlockingFD :: FD -> Bool -> IO () +-#if !defined(mingw32_HOST_OS) ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + setNonBlockingFD fd set = do + flags <- throwErrnoIfMinus1Retry "setNonBlockingFD" + (c_fcntl_read fd const_f_getfl) +@@ -336,7 +339,7 @@ + -- ----------------------------------------------------------------------------- + -- Set close-on-exec for a file descriptor + +-#if !defined(mingw32_HOST_OS) ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + setCloseOnExec :: FD -> IO () + setCloseOnExec fd = do + throwErrnoIfMinus1_ "setCloseOnExec" $ +@@ -352,6 +355,7 @@ + type CFilePath = CWString + #endif + ++#if !defined(ghcjs_HOST_OS) + foreign import ccall unsafe "HsBase.h __hscore_open" + c_open :: CFilePath -> CInt -> CMode -> IO CInt + +@@ -363,6 +367,7 @@ + + foreign import ccall unsafe "HsBase.h __hscore_lstat" + lstat :: CFilePath -> Ptr CStat -> IO CInt ++#endif + + {- Note: Win32 POSIX functions + Functions that are not part of the POSIX standards were +@@ -382,6 +387,140 @@ + However since we can't hope to get people to support Windows + packages we should support the deprecated names. See #12497 + -} ++#ifdef ghcjs_HOST_OS ++ ++foreign import javascript interruptible "h$base_access($1_1,$1_2,$2,$c);" ++ c_access :: CString -> CInt -> IO CInt ++foreign import javascript interruptible "h$base_chmod($1_1,$1_2,$2,$c);" ++ c_chmod :: CString -> CMode -> IO CInt ++foreign import javascript interruptible "h$base_close($1,$c);" ++ c_close :: CInt -> IO CInt ++foreign import javascript interruptible "h$base_creat($1,$c);" ++ c_creat :: CString -> CMode -> IO CInt ++foreign import javascript interruptible "h$base_dup($1,$c);" ++ c_dup :: CInt -> IO CInt ++foreign import javascript interruptible "h$base_dup2($1,$2,$c);" ++ c_dup2 :: CInt -> CInt -> IO CInt ++foreign import javascript interruptible "h$base_fstat($1,$2_1,$2_2,$c);" -- fixme wrong type ++ c_fstat :: CInt -> Ptr CStat -> IO CInt ++foreign import javascript unsafe "$r = h$base_isatty($1);" ++ c_isatty :: CInt -> IO CInt ++foreign import javascript interruptible "h$base_lseek($1,$2_1,$2_2,$3,$c);" ++ c_lseek :: CInt -> Int64 -> CInt -> IO Int64 ++foreign import javascript interruptible "h$base_lstat($1_1,$1_2,$2_1,$2_2,$c);" -- fixme wrong type ++ lstat :: CFilePath -> Ptr CStat -> IO CInt ++foreign import javascript interruptible "h$base_open($1_1,$1_2,$2,$3,$c);" ++ c_open :: CFilePath -> CInt -> CMode -> IO CInt ++foreign import javascript interruptible "h$base_open($1_1,$1_2,$2,$3,$c);" ++ c_safe_open :: CFilePath -> CInt -> CMode -> IO CInt ++foreign import javascript interruptible "h$base_read($1,$2_1,$2_2,$3,$c);" ++ c_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize ++foreign import javascript interruptible "h$base_read($1,$2_1,$2_2,$3,$c);" ++ c_safe_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize ++foreign import javascript interruptible "h$base_stat($1_1,$1_2,$2_1,$2_2,$c);" -- fixme wrong type ++ c_stat :: CFilePath -> Ptr CStat -> IO CInt ++foreign import javascript unsafe "$r = h$base_umask($1);" ++ c_umask :: CMode -> IO CMode ++foreign import javascript interruptible "h$base_write($1,$2_1,$2_2,$3,$c);" ++ c_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize ++foreign import javascript interruptible "h$base_write($1,$2_1,$2_2,$3,$c);" ++ c_safe_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize ++foreign import javascript interruptible "h$base_ftruncate($1,$2_1,$2_2,$c);" -- fixme COff ++ c_ftruncate :: CInt -> Int64 -> IO CInt ++foreign import javascript interruptible "h$base_unlink($1_1,$1_2,$c);" ++ c_unlink :: CString -> IO CInt ++foreign import javascript unsafe "$r = h$base_getpid();" ++ c_getpid :: IO CPid ++-- foreign import ccall unsafe "HsBase.h fork" ++-- c_fork :: IO CPid ++foreign import javascript interruptible "h$base_link($1_1,$1_2,$2_1,$2_2,$c);" ++ c_link :: CString -> CString -> IO CInt ++foreign import javascript interruptible "h$base_mkfifo($1_1,$1_2,$2,$c);" ++ c_mkfifo :: CString -> CMode -> IO CInt ++-- foreign import javascript interruptible "h$base_pipe($1_1,$1_2,$c);" ++-- c_pipe :: Ptr CInt -> IO CInt ++foreign import javascript unsafe "$r = h$base_sigemptyset($1_1,$1_2);" ++ c_sigemptyset :: Ptr CSigset -> IO CInt ++foreign import javascript unsafe "$r = h$base_sigaddset($1_1,$1_2,$2);" ++ c_sigaddset :: Ptr CSigset -> CInt -> IO CInt ++foreign import javascript unsafe "$r = h$base_sigprocmask($1,$2_1,$2_2,$3_1,$3_2);" ++ c_sigprocmask :: CInt -> Ptr CSigset -> Ptr CSigset -> IO CInt ++foreign import javascript unsafe "$r = h$base_tcgetattr($1,$2_1,$2_2);" ++ c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt ++foreign import javascript unsafe "$r = h$base_tcsetattr($1,$2,$3_1,$3_2);" ++ c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt ++foreign import javascript unsafe "$r = h$base_utime($1_1,$1_2,$2_1,$2_2);" -- should this be async? ++ c_utime :: CString -> Ptr CUtimbuf -> IO CInt ++foreign import javascript interruptible "h$base_waitpid($1,$2_1,$2_2,$3,$c);" ++ c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid ++ ++foreign import javascript unsafe "$r = h$base_o_rdonly;" o_RDONLY :: CInt ++foreign import javascript unsafe "$r = h$base_o_wronly;" o_WRONLY :: CInt ++foreign import javascript unsafe "$r = h$base_o_rdwr;" o_RDWR :: CInt ++foreign import javascript unsafe "$r = h$base_o_append;" o_APPEND :: CInt ++foreign import javascript unsafe "$r = h$base_o_creat;" o_CREAT :: CInt ++foreign import javascript unsafe "$r = h$base_o_excl;" o_EXCL :: CInt ++foreign import javascript unsafe "$r = h$base_o_trunc;" o_TRUNC :: CInt ++foreign import javascript unsafe "$r = h$base_o_noctty;" o_NOCTTY :: CInt ++foreign import javascript unsafe "$r = h$base_o_nonblock;" o_NONBLOCK :: CInt ++foreign import javascript unsafe "$r = h$base_o_binary;" o_BINARY :: CInt ++ ++foreign import javascript unsafe "$r = h$base_c_s_isreg($1);" c_s_isreg :: CMode -> CInt ++foreign import javascript unsafe "$r = h$base_c_s_ischr($1);" c_s_ischr :: CMode -> CInt ++foreign import javascript unsafe "$r = h$base_c_s_isblk($1);" c_s_isblk :: CMode -> CInt ++foreign import javascript unsafe "$r = h$base_c_s_isdir($1);" c_s_isdir :: CMode -> CInt ++foreign import javascript unsafe "$r = h$base_c_s_isfifo($1);" c_s_isfifo :: CMode -> CInt ++ ++s_isreg :: CMode -> Bool ++s_isreg cm = c_s_isreg cm /= 0 ++s_ischr :: CMode -> Bool ++s_ischr cm = c_s_ischr cm /= 0 ++s_isblk :: CMode -> Bool ++s_isblk cm = c_s_isblk cm /= 0 ++s_isdir :: CMode -> Bool ++s_isdir cm = c_s_isdir cm /= 0 ++s_isfifo :: CMode -> Bool ++s_isfifo cm = c_s_isfifo cm /= 0 ++ ++foreign import javascript unsafe "$r = h$base_sizeof_stat;" sizeof_stat :: Int ++foreign import javascript unsafe "h$base_st_mtime($1_1,$1_2)" st_mtime :: Ptr CStat -> IO CTime ++foreign import javascript unsafe "$r1 = h$base_st_size($1_1,$1_2); $r2 = h$ret1;" st_size :: Ptr CStat -> IO Int64 ++foreign import javascript unsafe "$r = h$base_st_mode($1_1,$1_2);" st_mode :: Ptr CStat -> IO CMode ++foreign import javascript unsafe "$r = h$base_st_dev($1_1,$1_2);" st_dev :: Ptr CStat -> IO CDev ++foreign import javascript unsafe "$r1 = h$base_st_ino($1_1,$1_2); $r2 = h$ret1;" st_ino :: Ptr CStat -> IO CIno ++ ++foreign import javascript unsafe "$r = h$base_echo;" const_echo :: CInt ++foreign import javascript unsafe "$r = h$base_tcsanow;" const_tcsanow :: CInt ++foreign import javascript unsafe "$r = h$base_icanon;" const_icanon :: CInt ++foreign import javascript unsafe "$r = h$base_vmin;" const_vmin :: CInt ++foreign import javascript unsafe "$r = h$base_vtime;" const_vtime :: CInt ++foreign import javascript unsafe "$r = h$base_sigttou;" const_sigttou :: CInt ++foreign import javascript unsafe "$r = h$base_sig_block;" const_sig_block :: CInt ++foreign import javascript unsafe "$r = h$base_sig_setmask;" const_sig_setmask :: CInt ++foreign import javascript unsafe "$r = h$base_f_getfl;" const_f_getfl :: CInt ++foreign import javascript unsafe "$r = h$base_f_setfl;" const_f_setfl :: CInt ++foreign import javascript unsafe "$r = h$base_f_setfd;" const_f_setfd :: CInt ++foreign import javascript unsafe "$r = h$base_fd_cloexec;" const_fd_cloexec :: CLong ++foreign import javascript unsafe "$r = h$base_sizeof_termios;" sizeof_termios :: Int ++foreign import javascript unsafe "$r = h$base_sizeof_sigset_t;" sizeof_sigset_t :: Int ++foreign import javascript unsafe "$r = h$base_lflag($1_1,$1_2);" c_lflag :: Ptr CTermios -> IO CTcflag ++foreign import javascript unsafe "h$base_poke_lflag($1_1,$1_2,$2);" poke_c_lflag :: Ptr CTermios -> CTcflag -> IO () ++foreign import javascript unsafe "$r1 = h$base_ptr_c_cc($1_1,$1_2); $r2 = h$ret_1;" ptr_c_cc :: Ptr CTermios -> IO (Ptr Word8) ++s_issock :: CMode -> Bool ++s_issock cmode = c_s_issock cmode /= 0 ++foreign import javascript unsafe "h$base_c_s_issock($1)" c_s_issock :: CMode -> CInt ++foreign import javascript unsafe "$r = h$base_default_buffer_size;" dEFAULT_BUFFER_SIZE :: Int ++foreign import javascript unsafe "$r = h$base_SEEK_CUR;" sEEK_CUR :: CInt ++foreign import javascript unsafe "$r = h$base_SEEK_SET;" sEEK_SET :: CInt ++foreign import javascript unsafe "$r = h$base_SEEK_END" sEEK_END :: CInt ++ ++-- fixme, unclear if these can be supported, remove? ++foreign import javascript unsafe "$r = h$base_c_fcntl_read($1,$2)" c_fcntl_read :: CInt -> CInt -> IO CInt ++foreign import javascript unsafe "$r = h$base_c_fcntl_write($1,$2,$3);" c_fcntl_write :: CInt -> CInt -> CLong -> IO CInt ++foreign import javascript unsafe "$r = h$base_c_fcntl_lock($1,$2,$3_1,$3_2);" c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt ++ ++#else ++ + foreign import capi unsafe "unistd.h lseek" + c_lseek :: CInt -> COff -> CInt -> IO COff + +@@ -465,13 +604,15 @@ + foreign import ccall unsafe "HsBase.h getpid" + c_getpid :: IO CPid + ++#if !defined(ghcjs_HOST_OS) + foreign import ccall unsafe "HsBase.h __hscore_stat" + c_stat :: CFilePath -> Ptr CStat -> IO CInt + + foreign import ccall unsafe "HsBase.h __hscore_ftruncate" + c_ftruncate :: CInt -> COff -> IO CInt ++#endif + +-#if !defined(mingw32_HOST_OS) ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + foreign import capi unsafe "HsBase.h fcntl" + c_fcntl_read :: CInt -> CInt -> IO CInt + +@@ -512,6 +653,7 @@ + c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid + #endif + ++#if !defined(ghcjs_HOST_OS) + -- POSIX flags only: + foreign import ccall unsafe "HsBase.h __hscore_o_rdonly" o_RDONLY :: CInt + foreign import ccall unsafe "HsBase.h __hscore_o_wronly" o_WRONLY :: CInt +@@ -588,6 +730,10 @@ + foreign import capi unsafe "stdio.h value SEEK_CUR" sEEK_CUR :: CInt + foreign import capi unsafe "stdio.h value SEEK_SET" sEEK_SET :: CInt + foreign import capi unsafe "stdio.h value SEEK_END" sEEK_END :: CInt ++#endif ++ ++#endif ++ + + {- + Note: Windows types +@@ -599,4 +745,3 @@ + c_safe_read, c_write and c_safe_write have different Haskell types depending on + the OS. + -} +- +diff -Nru upstream/pkg/base/System/Timeout.hs boot/pkg/base/System/Timeout.hs +--- upstream/pkg/base/System/Timeout.hs 2018-01-09 08:27:50.000000000 +0000 ++++ boot/pkg/base/System/Timeout.hs 2018-01-09 08:27:50.762812547 +0000 +@@ -18,7 +18,7 @@ + + module System.Timeout ( timeout ) where + +-#ifndef mingw32_HOST_OS ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + import Control.Monad + import GHC.Event (getSystemTimerManager, + registerTimeout, unregisterTimeout) +@@ -80,7 +80,7 @@ + timeout n f + | n < 0 = fmap Just f + | n == 0 = return Nothing +-#ifndef mingw32_HOST_OS ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + | rtsSupportsBoundThreads = do + -- In the threaded RTS, we use the Timer Manager to delay the + -- (fairly expensive) 'forkIO' call until the timeout has expired. diff --git a/lib/patches/directory.patch b/lib/patches/directory.patch new file mode 100644 index 00000000..9d19579e --- /dev/null +++ b/lib/patches/directory.patch @@ -0,0 +1,541 @@ +diff -Nru upstream/pkg/directory/directory.cabal boot/pkg/directory/directory.cabal +--- upstream/pkg/directory/directory.cabal 2018-01-09 08:27:52.000000000 +0000 ++++ boot/pkg/directory/directory.cabal 2018-01-09 08:27:52.198658973 +0000 +@@ -57,6 +57,8 @@ + base >= 4.5 && < 4.11, + time >= 1.4 && < 1.9, + filepath >= 1.3 && < 1.5 ++ if impl(ghcjs) ++ build-depends: ghcjs-prim + if os(windows) + build-depends: Win32 >= 2.2.2 && < 2.6 + else +diff -Nru upstream/pkg/directory/System/Directory/Internal/Config.hs boot/pkg/directory/System/Directory/Internal/Config.hs +--- upstream/pkg/directory/System/Directory/Internal/Config.hs 2018-01-09 08:27:52.000000000 +0000 ++++ boot/pkg/directory/System/Directory/Internal/Config.hs 2018-01-09 08:27:52.198658973 +0000 +@@ -1,13 +1,27 @@ + {-# LANGUAGE CPP #-} ++#if defined(ghcjs_HOST_OS) ++{-# LANGUAGE JavaScriptFFI, GHCForeignImportPrim #-} ++#else + #include ++#endif + module System.Directory.Internal.Config where + ++#if defined(ghcjs_HOST_OS) ++import GHCJS.Prim ++#endif ++ + -- | Filename extension for executable files (including the dot if any) + -- (usually @\"\"@ on POSIX systems and @\".exe\"@ on Windows or OS\/2). + -- + -- @since 1.2.4.0 + exeExtension :: String ++#if defined(ghcjs_HOST_OS) ++exeExtension = fromJSString js_exeExtension ++ ++foreign import javascript unsafe "h$directory_exeExtension()" js_exeExtension :: JSVal ++#else + exeExtension = EXE_EXTENSION ++#endif + -- We avoid using #const_str from hsc because it breaks cross-compilation + -- builds, so we use this ugly workaround where we simply paste the C string + -- literal directly in here. This will probably break if the EXE_EXTENSION +diff -Nru upstream/pkg/directory/System/Directory.hs boot/pkg/directory/System/Directory.hs +--- upstream/pkg/directory/System/Directory.hs 2018-01-09 08:27:52.000000000 +0000 ++++ boot/pkg/directory/System/Directory.hs 2018-01-09 08:27:52.198658973 +0000 +@@ -1,9 +1,17 @@ + {-# LANGUAGE CPP #-} ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) ++#define posix_OS 1 ++#else ++#undef posix_OS ++#endif + + #if !(MIN_VERSION_base(4,8,0)) + -- In base-4.8.0 the Foreign module became Safe + {-# LANGUAGE Trustworthy #-} + #endif ++#ifdef __GHCJS__ ++{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI, UnliftedFFITypes, MagicHash #-} ++#endif + + ----------------------------------------------------------------------------- + -- | +@@ -122,6 +130,54 @@ + import qualified System.Posix as Posix + #endif + ++#ifdef ghcjs_HOST_OS ++ ++import Data.Maybe (listToMaybe) ++import Data.Bits ++import GHCJS.Prim ++import Foreign.C.Error ++ ++type JSObject = JSVal ++type JSString = JSVal ++type JSArray = JSVal ++ ++throwErrnoIfJSNull :: String -> IO JSVal -> IO JSVal ++throwErrnoIfJSNull msg m = do ++ r <- m ++ if isNull r then throwErrno msg ++ else return r ++ ++-------------------------------------------------------------- ++ ++foreign import javascript interruptible "h$directory_getPermissions($1,$c);" js_getPermissions :: JSString -> IO Int ++foreign import javascript interruptible "h$directory_setPermissions($1,$2,$c);" js_setPermissions :: JSString -> Int -> IO Int ++foreign import javascript interruptible "h$directory_copyPermissions($1,$2,$c);" js_copyPermissions :: JSString -> JSString -> IO Int ++foreign import javascript interruptible "h$directory_createDirectory($1,$c);" js_createDirectory :: JSString -> IO Int ++foreign import javascript interruptible "h$directory_removeDirectory($1,$c);" js_removeDirectory :: JSString -> IO Int ++foreign import javascript interruptible "h$directory_removeFile($1,$c);" js_removeFile :: JSString -> IO Int ++foreign import javascript interruptible "h$directory_renameDirectory($1,$2,$c);" js_renameDirectory :: JSString -> JSString -> IO Int ++foreign import javascript interruptible "h$directory_renameFile($1,$2,$c);" js_renameFile :: JSString -> JSString -> IO Int ++foreign import javascript unsafe "h$directory_canonicalizePath($1)" js_canonicalizePath :: JSString -> IO JSString ++foreign import javascript interruptible "h$directory_findExecutables($1,$c);" js_findExecutables :: JSString -> IO JSArray ++foreign import javascript interruptible "h$directory_getDirectoryContents($1,$c);" js_getDirectoryContents :: JSString -> IO JSArray ++foreign import javascript interruptible "h$directory_copyFileWithMetadata($1,$2,$c);" js_copyFileWithMetadata :: JSString -> JSString -> IO () ++foreign import javascript unsafe "h$directory_getCurrentDirectory()" js_getCurrentDirectory :: IO JSString ++foreign import javascript unsafe "h$directory_setCurrentDirectory($1)" js_setCurrentDirectory :: JSString -> IO Int ++foreign import javascript unsafe "h$directory_getHomeDirectory()" js_getHomeDirectory :: IO JSString ++foreign import javascript unsafe "h$directory_getAppUserDataDirectory($1)" js_getAppUserDataDirectory :: JSString -> IO JSString ++foreign import javascript unsafe "h$directory_getUserDocumentsDirectory()" js_getUserDocumentsDirectory :: IO JSString ++foreign import javascript unsafe "h$directory_getTemporaryDirectory()" js_getTemporaryDirectory :: IO JSString ++foreign import javascript unsafe "h$directory_exeExtension()" js_exeExtension :: JSString ++foreign import javascript interruptible "h$directory_getFileStatus($1,$c);" js_getFileStatus :: JSString -> IO JSObject ++foreign import javascript interruptible "h$directory_getFileOrSymlinkStatus($1,$c);" js_getFileOrSymlinkStatus :: JSString -> IO JSObject ++foreign import javascript unsafe "h$directory_getFileStatusModificationTime($1)" js_getFileStatusModificationTime :: JSObject -> IO Double ++foreign import javascript unsafe "h$directory_getFileStatusAccessTime($1)" js_getFileStatusAccessTime :: JSObject -> IO Double ++foreign import javascript unsafe "h$directory_getFileStatusIsDirectory($1)" js_getFileStatusIsDirectory :: JSObject -> IO Bool ++foreign import javascript unsafe "h$directory_getFileStatusIsSymbolicLink($1)" js_getFileStatusIsSymbolicLink :: JSObject -> IO Bool ++#endif ++ ++ ++ + {- $intro + A directory contains a series of entries, each of which is a named + reference to a file system object (file, directory etc.). Some +@@ -200,7 +256,15 @@ + + getPermissions :: FilePath -> IO Permissions + getPermissions name = +-#ifdef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++ do ++ perms <- throwErrnoIfMinus1 "getPermissions" $ js_getPermissions (toJSString name) ++ return (Permissions { readable = testBit perms 0 ++ , writable = testBit perms 1 ++ , executable = testBit perms 2 ++ , searchable = testBit perms 3 ++ }) ++#elif defined(mingw32_HOST_OS) + -- issue #9: Windows doesn't like trailing path separators + withFilePath (dropTrailingPathSeparator name) $ \s -> + -- stat() does a better job of guessing the permissions on Windows +@@ -255,7 +319,12 @@ + + setPermissions :: FilePath -> Permissions -> IO () + setPermissions name (Permissions r w e s) = +-#ifdef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++ do ++ let bitIf b i = if b then bit i else 0 ++ throwErrnoIfMinus1_ "setPermissions" $ ++ js_setPermissions (toJSString name) (bitIf r 0 .|. bitIf w 1 .|. bitIf e 2 .|. bitIf s 3) ++#elif defined(mingw32_HOST_OS) + allocaBytes sizeof_stat $ \ p_stat -> + withFilePath name $ \p_name -> do + throwErrnoIfMinus1_ "setPermissions" $ +@@ -287,7 +356,10 @@ + + copyPermissions :: FilePath -> FilePath -> IO () + copyPermissions source dest = +-#ifdef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++ throwErrnoIfMinus1_ "copyPermissions" $ ++ js_copyPermissions (toJSString source) (toJSString dest) ++#elif defined(mingw32_HOST_OS) + allocaBytes sizeof_stat $ \ p_stat -> + withFilePath source $ \p_source -> + withFilePath dest $ \p_dest -> do +@@ -300,7 +372,7 @@ + copyPermissionsFromStatus stat dest + #endif + +-#ifndef mingw32_HOST_OS ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + copyPermissionsFromStatus :: Posix.FileStatus -> FilePath -> IO () + copyPermissionsFromStatus st dst = do + Posix.setFileMode dst (Posix.fileMode st) +@@ -348,7 +420,10 @@ + + createDirectory :: FilePath -> IO () + createDirectory path = do +-#ifdef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++ throwErrnoIfMinus1_ "createDirectory" $ ++ js_createDirectory (toJSString path) ++#elif defined(mingw32_HOST_OS) + Win32.createDirectory path Nothing + #else + Posix.createDirectory path 0o777 +@@ -399,7 +474,11 @@ + unless canIgnore (ioError e) + | otherwise -> ioError e + where +-#ifdef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++ isDir = js_getFileStatusIsDirectory =<< ++ js_getFileOrSymlinkStatus (toJSString dir) ++ ++#elif defined(mingw32_HOST_OS) + isDir = withFileStatus "createDirectoryIfMissing" dir isDirectory + #else + isDir = (Posix.isDirectory <$> Posix.getFileStatus dir) +@@ -417,7 +496,13 @@ + getDirectoryType :: FilePath -> IO DirectoryType + getDirectoryType path = + (`ioeAddLocation` "getDirectoryType") `modifyIOError` do +-#ifdef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++ stat <- js_getFileOrSymlinkStatus (toJSString path) ++ isDir <- js_getFileStatusIsDirectory stat ++ return $ if isDir ++ then Directory ++ else NotDirectory ++#elif defined(mingw32_HOST_OS) + isDir <- withFileStatus "getDirectoryType" path isDirectory + if isDir + then do +@@ -477,7 +562,9 @@ + + removeDirectory :: FilePath -> IO () + removeDirectory path = +-#ifdef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++ throwErrnoIfMinus1_ "removeDirectory" $ js_removeDirectory (toJSString path) ++#elif defined(mingw32_HOST_OS) + Win32.removeDirectory path + #else + Posix.removeDirectory path +@@ -622,7 +709,9 @@ + + removeFile :: FilePath -> IO () + removeFile path = +-#ifdef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++ throwErrnoIfMinus1_ "removeFile" $ js_removeFile (toJSString path) ++#elif defined(mingw32_HOST_OS) + Win32.deleteFile path + #else + Posix.removeLink path +@@ -679,6 +768,10 @@ + + renameDirectory :: FilePath -> FilePath -> IO () + renameDirectory opath npath = ++#if defined(ghcjs_HOST_OS) ++ throwErrnoIfMinus1_ "renameDirectory" $ ++ js_renameDirectory (toJSString opath) (toJSString npath) ++#else + -- XXX this test isn't performed atomically with the following rename + #ifdef mingw32_HOST_OS + -- ToDo: use Win32 API +@@ -693,6 +786,7 @@ + ioError . (`ioeSetErrorString` "not a directory") $ + (mkIOError InappropriateType "renameDirectory" Nothing (Just opath)) + renamePath opath npath ++#endif + + {- |@'renameFile' old new@ changes the name of an existing file system + object from /old/ to /new/. If the /new/ object already +@@ -742,6 +836,10 @@ + renameFile opath npath = (`ioeAddLocation` "renameFile") `modifyIOError` do + -- XXX the tests are not performed atomically with the rename + checkNotDir opath ++#if defined(ghcjs_HOST_OS) ++ throwErrnoIfMinus1_ "renameFile" $ ++ js_renameFile (toJSString opath) (toJSString npath) ++#else + renamePath opath npath + -- The underlying rename implementation can throw odd exceptions when the + -- destination is a directory. For example, Windows typically throws a +@@ -752,6 +850,7 @@ + `catchIOError` \ err -> do + checkNotDir npath + ioError err ++#endif + where checkNotDir path = do + dirType <- getDirectoryType path + `catchIOError` \ _ -> return NotDirectory +@@ -928,7 +1027,9 @@ + copyFileWithMetadata src dst = + (`ioeAddLocation` "copyFileWithMetadata") `modifyIOError` doCopy + where +-#ifdef mingw32_HOST_OS ++#ifdef ghcjs_HOST_OS ++ doCopy = js_copyFileWithMetadata (toJSString src) (toJSString dst) ++#elif defined(mingw32_HOST_OS) + doCopy = Win32.copyFile src dst False + #else + doCopy = do +@@ -937,7 +1038,7 @@ + copyMetadataFromStatus st dst + #endif + +-#ifndef mingw32_HOST_OS ++#ifdef posix_OS + copyMetadataFromStatus :: Posix.FileStatus -> FilePath -> IO () + copyMetadataFromStatus st dst = do + tryCopyOwnerAndGroupFromStatus st dst +@@ -945,26 +1046,26 @@ + copyFileTimesFromStatus st dst + #endif + +-#ifndef mingw32_HOST_OS ++#ifdef posix_OS + tryCopyOwnerAndGroupFromStatus :: Posix.FileStatus -> FilePath -> IO () + tryCopyOwnerAndGroupFromStatus st dst = do + ignoreIOExceptions (copyOwnerFromStatus st dst) + ignoreIOExceptions (copyGroupFromStatus st dst) + #endif + +-#ifndef mingw32_HOST_OS ++#ifdef posix_OS + copyOwnerFromStatus :: Posix.FileStatus -> FilePath -> IO () + copyOwnerFromStatus st dst = do + Posix.setOwnerAndGroup dst (Posix.fileOwner st) (-1) + #endif + +-#ifndef mingw32_HOST_OS ++#ifdef posix_OS + copyGroupFromStatus :: Posix.FileStatus -> FilePath -> IO () + copyGroupFromStatus st dst = do + Posix.setOwnerAndGroup dst (-1) (Posix.fileGroup st) + #endif + +-#ifndef mingw32_HOST_OS ++#ifdef posix_OS + copyFileTimesFromStatus :: Posix.FileStatus -> FilePath -> IO () + copyFileTimesFromStatus st dst = do + let (atime, mtime) = fileTimesFromStatus st +@@ -1032,6 +1133,10 @@ + -- + canonicalizePath :: FilePath -> IO FilePath + canonicalizePath = \ path -> ++#if defined(ghcjs_HOST_OS) ++ -- fixme implement correct exception behaviour for GHCJS impl ++ fromJSString `fmap` js_canonicalizePath (toJSString path) ++#else + modifyIOError ((`ioeAddLocation` "canonicalizePath") . + (`ioeSetFileName` path)) $ + -- normalise does more stuff, like upper-casing the drive letter +@@ -1066,6 +1171,7 @@ + `catchIOError` \ _ -> realpathPrefix realpath rest path + else realpathPrefix realpath rest path + realpathPrefix _ _ path = return path ++#endif + + -- | Convert a path into an absolute path. If the given path is relative, the + -- current directory is prepended and then the combined result is +@@ -1139,7 +1245,9 @@ + -- + findExecutable :: String -> IO (Maybe FilePath) + findExecutable binary = do +-#if defined(mingw32_HOST_OS) ++#if defined(ghcjs_HOST_OS) ++ listToMaybe <$> findExecutables binary ++#elif defined(mingw32_HOST_OS) + Win32.searchPath Nothing binary exeExtension + #else + path <- getPath +@@ -1156,7 +1264,9 @@ + -- @since 1.2.2.0 + findExecutables :: String -> IO [FilePath] + findExecutables binary = do +-#if defined(mingw32_HOST_OS) ++#if defined(ghcjs_HOST_OS) ++ fmap (map fromJSString) $ fromJSArray =<< js_findExecutables (toJSString binary) ++#elif defined(mingw32_HOST_OS) + file <- findExecutable binary + return $ maybeToList file + #else +@@ -1164,7 +1274,7 @@ + findExecutablesInDirectories path binary + #endif + +-#ifndef mingw32_HOST_OS ++#ifdef posix_OS + -- | Get the contents of the @PATH@ environment variable. + getPath :: IO [FilePath] + getPath = do +@@ -1248,7 +1358,10 @@ + getDirectoryContents path = + modifyIOError ((`ioeSetFileName` path) . + (`ioeAddLocation` "getDirectoryContents")) $ do +-#ifndef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++ fmap (map fromJSString) $ fromJSArray =<< throwErrnoIfJSNull "getDirectoryContents" ++ (js_getDirectoryContents (toJSString path)) ++#elif !defined(mingw32_HOST_OS) + bracket + (Posix.openDirStream path) + Posix.closeDirStream +@@ -1279,6 +1392,7 @@ + else return (filename:acc) + -- no need to reverse, ordering is undefined + #endif /* mingw32 */ ++{-# NOINLINE getDirectoryContents #-} + + -- | @'listDirectory' dir@ returns a list of /all/ entries in /dir/ without + -- the special entries (@.@ and @..@). +@@ -1351,7 +1465,9 @@ + isDoesNotExistError + getCwd + where +-#ifdef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++ getCwd = fromJSString `fmap` throwErrnoIfJSNull "getCurrentDirectory" js_getCurrentDirectory ++#elif defined(mingw32_HOST_OS) + getCwd = Win32.getCurrentDirectory + #else + getCwd = Posix.getWorkingDirectory +@@ -1392,7 +1508,9 @@ + -- + setCurrentDirectory :: FilePath -> IO () + setCurrentDirectory = +-#ifdef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++ throwErrnoIfMinus1_ "setCurrentDirectory" . js_setCurrentDirectory . toJSString ++#elif defined(mingw32_HOST_OS) + Win32.setCurrentDirectory + #else + Posix.changeWorkingDirectory +@@ -1448,7 +1566,10 @@ + + doesDirectoryExist :: FilePath -> IO Bool + doesDirectoryExist name = +-#ifdef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++ (js_getFileStatusIsDirectory =<< ++ throwErrnoIfJSNull "doesDirectoryExist" (js_getFileStatus (toJSString name))) ++#elif defined(mingw32_HOST_OS) + (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st) + #else + (do stat <- Posix.getFileStatus name +@@ -1462,7 +1583,10 @@ + + doesFileExist :: FilePath -> IO Bool + doesFileExist name = +-#ifdef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++ (fmap not . js_getFileStatusIsDirectory =<< ++ throwErrnoIfJSNull "doesFileExist" (js_getFileStatus (toJSString name))) ++#elif defined(mingw32_HOST_OS) + (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b)) + #else + (do stat <- Posix.getFileStatus name +@@ -1477,7 +1601,9 @@ + pathIsSymbolicLink :: FilePath -> IO Bool + pathIsSymbolicLink path = + (`ioeAddLocation` "getDirectoryType") `modifyIOError` do +-#ifdef mingw32_HOST_OS ++#ifdef ghcjs_HOST_OS ++ js_getFileStatusIsSymbolicLink =<< js_getFileOrSymlinkStatus (toJSString path) ++#elif defined(mingw32_HOST_OS) + isReparsePoint <$> Win32.getFileAttributes path + where + isReparsePoint attr = attr .&. win32_fILE_ATTRIBUTE_REPARSE_POINT /= 0 +@@ -1544,7 +1670,13 @@ + getTimes + where + path' = normalise path -- handle empty paths +-#ifdef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++ cvtTime = fmap (posixSecondsToUTCTime . realToFrac) ++ getTimes = do ++ st <- js_getFileStatus (toJSString path') ++ (,) <$> cvtTime (js_getFileStatusAccessTime st) ++ <*> cvtTime (js_getFileStatusModificationTime st) ++#elif defined(mingw32_HOST_OS) + getTimes = + bracket (openFileHandle path' Win32.gENERIC_READ) + Win32.closeHandle $ \ handle -> +@@ -1559,7 +1691,7 @@ + getTimes = fileTimesFromStatus <$> Posix.getFileStatus path' + #endif + +-#ifndef mingw32_HOST_OS ++#if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) + fileTimesFromStatus :: Posix.FileStatus -> (UTCTime, UTCTime) + fileTimesFromStatus st = + # if MIN_VERSION_unix(2, 6, 0) +@@ -1637,7 +1769,10 @@ + path' = normalise path -- handle empty paths + + setTimes :: (Maybe POSIXTime, Maybe POSIXTime) -> IO () +-#ifdef mingw32_HOST_OS ++#if defined(ghcjs_HOST_OS) ++ setTimes time = ++ error "fixme: setFileTimes unimplemented for GHCJS" ++#elif defined(mingw32_HOST_OS) + setTimes (atime', mtime') = + bracket (openFileHandle path' Win32.gENERIC_WRITE) + Win32.closeHandle $ \ handle -> +@@ -1730,7 +1865,9 @@ + getHomeDirectory :: IO FilePath + getHomeDirectory = modifyIOError (`ioeAddLocation` "getHomeDirectory") get + where +-#if defined(mingw32_HOST_OS) ++#if defined(ghcjs_HOST_OS) ++ get = fromJSString `fmap` throwErrnoIfJSNull "getHomeDirectory" js_getHomeDirectory ++#elif defined(mingw32_HOST_OS) + get = getFolderPath Win32.cSIDL_PROFILE `catchIOError` \ _ -> + getFolderPath Win32.cSIDL_WINDOWS + getFolderPath what = Win32.sHGetFolderPath nullPtr what nullPtr 0 +@@ -1799,7 +1936,9 @@ + XdgConfig -> get False "XDG_CONFIG_HOME" ".config" + XdgCache -> get True "XDG_CACHE_HOME" ".cache" + where +-#if defined(mingw32_HOST_OS) ++#if defined(ghcjs_HOST_OS) ++ get _ _ _ = error "fixme: getXdgDirectory not implemented for GHCJS" ++#elif defined(mingw32_HOST_OS) + get isLocal _ _ = Win32.sHGetFolderPath nullPtr which nullPtr 0 + where which | isLocal = win32_cSIDL_LOCAL_APPDATA + | otherwise = Win32.cSIDL_APPDATA +@@ -1869,7 +2008,10 @@ + -> IO FilePath + getAppUserDataDirectory appName = do + modifyIOError (`ioeAddLocation` "getAppUserDataDirectory") $ do +-#if defined(mingw32_HOST_OS) ++#if defined(ghcjs_HOST_OS) ++ fromJSString `fmap` throwErrnoIfJSNull "getAppUserDataDirectory" ++ (js_getAppUserDataDirectory (toJSString appName)) ++#elif defined(mingw32_HOST_OS) + s <- Win32.sHGetFolderPath nullPtr Win32.cSIDL_APPDATA nullPtr 0 + return (s++'\\':appName) + #else +@@ -1900,7 +2042,9 @@ + getUserDocumentsDirectory :: IO FilePath + getUserDocumentsDirectory = do + modifyIOError (`ioeAddLocation` "getUserDocumentsDirectory") $ do +-#if defined(mingw32_HOST_OS) ++#if defined(ghcjs_HOST_OS) ++ fromJSString `fmap` throwErrnoIfJSNull "getUserDocumentsDirectory" js_getUserDocumentsDirectory ++#elif defined(mingw32_HOST_OS) + Win32.sHGetFolderPath nullPtr Win32.cSIDL_PERSONAL nullPtr 0 + #else + getEnv "HOME" +@@ -1934,7 +2078,9 @@ + -} + getTemporaryDirectory :: IO FilePath + getTemporaryDirectory = +-#if defined(mingw32_HOST_OS) ++#if defined(ghcjs_HOST_OS) ++ fromJSString `fmap` throwErrnoIfJSNull "getTemporaryDirectory" js_getTemporaryDirectory ++#elif defined(mingw32_HOST_OS) + Win32.getTemporaryDirectory + #else + getEnv "TMPDIR" `catchIOError` \ err -> diff --git a/lib/patches/filepath.patch b/lib/patches/filepath.patch new file mode 100644 index 00000000..2e1099b1 --- /dev/null +++ b/lib/patches/filepath.patch @@ -0,0 +1,56 @@ +diff -Nru upstream/pkg/filepath/filepath.cabal boot/pkg/filepath/filepath.cabal +--- upstream/pkg/filepath/filepath.cabal 2018-01-09 08:27:52.000000000 +0000 ++++ boot/pkg/filepath/filepath.cabal 2018-01-09 10:09:15.907700603 +0000 +@@ -47,6 +47,10 @@ + System.FilePath.Posix + System.FilePath.Windows + ++ if impl(GHCJS >= 0.1) ++ Exposed-modules: ++ System.FilePath.Current ++ + build-depends: + base >= 4 && < 4.11 + +diff -Nru upstream/pkg/filepath/System/FilePath/Current.hs boot/pkg/filepath/System/FilePath/Current.hs +--- upstream/pkg/filepath/System/FilePath/Current.hs 1970-01-01 00:00:00.000000000 +0000 ++++ boot/pkg/filepath/System/FilePath/Current.hs 2018-01-09 09:42:02.322726494 +0000 +@@ -0,0 +1,4 @@ ++{-# LANGUAGE CPP #-} ++#define MODULE_NAME Current ++#define IS_CURRENT 1 ++#include "Internal.hs" +diff -Nru upstream/pkg/filepath/System/FilePath/Internal.hs boot/pkg/filepath/System/FilePath/Internal.hs +--- upstream/pkg/filepath/System/FilePath/Internal.hs 2018-01-09 08:27:52.000000000 +0000 ++++ boot/pkg/filepath/System/FilePath/Internal.hs 2018-01-09 10:33:35.378062650 +0000 +@@ -1,4 +1,6 @@ +-#if __GLASGOW_HASKELL__ >= 704 ++#ifdef IS_CURRENT ++{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI, Trustworthy #-} ++#elif __GLASGOW_HASKELL__ >= 704 + {-# LANGUAGE Safe #-} + #endif + {-# LANGUAGE PatternGuards #-} +@@ -63,6 +65,8 @@ + -- [1] (Microsoft MSDN) + module System.FilePath.MODULE_NAME + ( ++ isWindows, isPosix, ++ + -- * Separator predicates + FilePath, + pathSeparator, pathSeparators, isPathSeparator, +@@ -126,8 +130,12 @@ + + -- | Is the operating system Windows like + isWindows :: Bool ++#ifdef IS_CURRENT ++isWindows = js_isWindows ++foreign import javascript unsafe "h$filepath_isWindows()" js_isWindows :: Bool ++#else + isWindows = IS_WINDOWS +- ++#endif + + --------------------------------------------------------------------- + -- The basic functions diff --git a/lib/patches/ghc-prim.patch b/lib/patches/ghc-prim.patch new file mode 100644 index 00000000..f6fe5a95 --- /dev/null +++ b/lib/patches/ghc-prim.patch @@ -0,0 +1,134 @@ +diff -Nru upstream/pkg/ghc-prim/ghc-prim.cabal boot/pkg/ghc-prim/ghc-prim.cabal +--- upstream/pkg/ghc-prim/ghc-prim.cabal 2018-01-09 07:35:13.707685154 +0000 ++++ boot/pkg/ghc-prim/ghc-prim.cabal 2018-01-09 08:27:56.566224517 +0000 +@@ -23,22 +23,24 @@ + Description: Include GHC.Prim in exposed-modules + default: False + +-custom-setup +- setup-depends: base >= 4 && < 5, Cabal >= 1.23 ++-- custom-setup ++-- setup-depends: base >= 4 && < 5, Cabal >= 1.23 + + Library + default-language: Haskell2010 ++ default-extensions: ++ MagicHash ++ UnboxedTuples ++ NoImplicitPrelude + other-extensions: + BangPatterns + CPP + DeriveGeneric + MagicHash + MultiParamTypeClasses +- NoImplicitPrelude + StandaloneDeriving + Trustworthy + TypeFamilies +- UnboxedTuples + UnliftedFFITypes + + build-depends: rts == 1.0.* +diff -Nru upstream/pkg/ghc-prim/Setup.hs boot/pkg/ghc-prim/Setup.hs +--- upstream/pkg/ghc-prim/Setup.hs 2018-01-09 07:35:13.707685154 +0000 ++++ boot/pkg/ghc-prim/Setup.hs 2018-01-09 08:27:56.566224517 +0000 +@@ -6,21 +6,29 @@ + import Control.Monad + import Data.List + import Data.Maybe ++import Distribution.ModuleName (components) + import Distribution.PackageDescription + import Distribution.Simple + import Distribution.Simple.LocalBuildInfo + import Distribution.Simple.Program + import Distribution.Simple.Utils ++import Distribution.Simple.Setup ++import Distribution.Simple.Register ++import Distribution.Simple.Install + import Distribution.Text + import System.Cmd + import System.FilePath + import System.Exit + import System.Directory + ++import qualified Data.ByteString as B ++import qualified Distribution.Compat.Exception as E ++ + main :: IO () + main = do let hooks = simpleUserHooks { + regHook = addPrimModule + $ regHook simpleUserHooks, ++ instHook = myInstHook, + buildHook = build_primitive_sources + $ buildHook simpleUserHooks, + haddockHook = addPrimModuleForHaddock +@@ -58,31 +66,56 @@ + + build_primitive_sources :: Hook a -> Hook a + build_primitive_sources f pd lbi uhs x +- = do when (compilerFlavor (compiler lbi) == GHC) $ do ++ = do let primhs = joinPath ["GHC", "Prim.hs"] ++ primhs_tmp = addExtension primhs "tmp" ++ primopwrappers = joinPath ["GHC", "PrimopWrappers.hs"] ++ primopwrappers_tmp = addExtension primopwrappers "tmp" ++ when (compilerFlavor (compiler lbi) == GHC) $ do + let genprimopcode = joinPath ["..", "..", "utils", + "genprimopcode", "genprimopcode"] + primops = joinPath ["..", "..", "compiler", "prelude", + "primops.txt"] +- primhs = joinPath ["GHC", "Prim.hs"] +- primopwrappers = joinPath ["GHC", "PrimopWrappers.hs"] +- primhs_tmp = addExtension primhs "tmp" +- primopwrappers_tmp = addExtension primopwrappers "tmp" + maybeExit $ system (genprimopcode ++ " --make-haskell-source < " + ++ primops ++ " > " ++ primhs_tmp) + maybeUpdateFile primhs_tmp primhs + maybeExit $ system (genprimopcode ++ " --make-haskell-wrappers < " + ++ primops ++ " > " ++ primopwrappers_tmp) + maybeUpdateFile primopwrappers_tmp primopwrappers ++ when (compilerFlavor (compiler lbi) == GHCJS) $ do ++ copyFile (joinPath ["..", "..", "data", "Prim.hs"]) ++ primhs_tmp ++ copyFile (joinPath ["..", "..", "data", "PrimopWrappers.hs"]) ++ primopwrappers_tmp ++ maybeUpdateFile primhs_tmp primhs ++ maybeUpdateFile primopwrappers_tmp primopwrappers + f pd lbi uhs x + + -- Replace a file only if the new version is different from the old. + -- This prevents make from doing unnecessary work after we run 'setup makefile' + maybeUpdateFile :: FilePath -> FilePath -> IO () + maybeUpdateFile source target = do +- r <- rawSystem "cmp" ["-s" {-quiet-}, source, target] +- case r of +- ExitSuccess -> removeFile source +- ExitFailure _ -> do exists <- doesFileExist target +- when exists $ removeFile target +- renameFile source target +- ++ let readf file = fmap (either (const Nothing) Just) (E.tryIO $ B.readFile file) ++ s <- readf source ++ t <- readf target ++ if isJust s && s == t ++ then removeFile source ++ else do doesFileExist target >>= flip when (removeFile target) ++ renameFile source target ++ ++myInstHook :: PackageDescription -> LocalBuildInfo ++ -> UserHooks -> InstallFlags -> IO () ++myInstHook pkg_descr localbuildinfo uh flags = do ++ let copyFlags = defaultCopyFlags { ++ copyDistPref = installDistPref flags, ++ copyDest = toFlag NoCopyDest, ++ copyVerbosity = installVerbosity flags ++ } ++ install pkg_descr localbuildinfo copyFlags ++ let registerFlags = defaultRegisterFlags { ++ regDistPref = installDistPref flags, ++ regInPlace = installInPlace flags, ++ regPackageDB = installPackageDB flags, ++ regVerbosity = installVerbosity flags ++ } ++ when (hasLibs pkg_descr) $ addPrimModule (\pd lbi _ -> register pd lbi) ++ pkg_descr localbuildinfo uh registerFlags diff --git a/lib/patches/integer-gmp.patch b/lib/patches/integer-gmp.patch new file mode 100644 index 00000000..9d1cc474 --- /dev/null +++ b/lib/patches/integer-gmp.patch @@ -0,0 +1,5327 @@ +diff -Nru upstream/pkg/integer-gmp/integer-gmp.buildinfo.in boot/pkg/integer-gmp/integer-gmp.buildinfo.in +--- upstream/pkg/integer-gmp/integer-gmp.buildinfo.in 2018-01-09 08:27:52.000000000 +0000 ++++ boot/pkg/integer-gmp/integer-gmp.buildinfo.in 2018-01-09 08:27:52.990576464 +0000 +@@ -2,4 +2,4 @@ + extra-lib-dirs: @GMP_LIB_DIRS@ + extra-libraries: @GMP_LIBS@ + frameworks: @GMP_FRAMEWORK@ +-install-includes: HsIntegerGmp.h ghc-gmp.h ++install-includes: HsIntegerGmp.h +diff -Nru upstream/pkg/integer-gmp/integer-gmp.cabal boot/pkg/integer-gmp/integer-gmp.cabal +--- upstream/pkg/integer-gmp/integer-gmp.cabal 2018-01-09 08:27:52.000000000 +0000 ++++ boot/pkg/integer-gmp/integer-gmp.cabal 2018-01-09 08:27:52.990576464 +0000 +@@ -64,6 +64,9 @@ + c-sources: + cbits/wrappers.c + ++ js-sources: ++ jsbits/ghcjsbn.js ++ + exposed-modules: + GHC.Integer + GHC.Integer.Logarithms +diff -Nru upstream/pkg/integer-gmp/jsbits/ghcjsbn.js boot/pkg/integer-gmp/jsbits/ghcjsbn.js +--- upstream/pkg/integer-gmp/jsbits/ghcjsbn.js 1970-01-01 00:00:00.000000000 +0000 ++++ boot/pkg/integer-gmp/jsbits/ghcjsbn.js 2018-01-09 08:27:52.994576047 +0000 +@@ -0,0 +1,4026 @@ ++/* ++ GHCJS bignum library for integer-gmp package ++ ++ uses JavaScript arrays for big numbers ++ some algorithms and code based on JSBN by Tom Wu ++ ++ Copyright Luite Stegeman 2016 ++ */ ++ ++#include ++ ++// #define GHCJSBN_TRACE_INTEGER 1 ++#define GHCJSBN_ASSERT_INTEGER 1 ++ ++// bits per limb ++#define GHCJSBN_BITS 28 ++#define GHCJSBN_MASK 0xfffffff ++#define GHCJSBN_DV 0x10000000 ++ ++// BI_FP = 52 ++// BI_FP - GHCJSBN_BITS ++#define GHCJSBN_F1 24 ++// 2*GHCJSBN_BITS - BI_FP ++#define GHCJSBN_F2 4 ++// 2 ^ BI_FP ++#define GHCJSBN_FV 4503599627370496 ++ ++// values for the Haskell Ordering enum ++#define GHCJSBN_LT 0 ++#define GHCJSBN_EQ 1 ++#define GHCJSBN_GT 2 ++ ++var h$ghcjsbn_zero_i = MK_INTEGER_S(0); ++var h$ghcjsbn_one_i = MK_INTEGER_S(1); ++var h$ghcjsbn_negOne_i = MK_INTEGER_S(-1); ++var h$ghcjsbn_null_b = [-1]; ++var h$ghcjsbn_zero_b = [0]; ++var h$ghcjsbn_one_b = [1, 1]; ++var h$ghcjsbn_two31_b = [2, 0, 8]; ++var h$ghcjsbn_czero_b = [2, 268435455, 15]; ++var h$ghcjsbn_two31_i = MK_INTEGER_Jp(h$ghcjsbn_two31_b); ++var h$ghcjsbn_negTwo31_i = MK_INTEGER_S(-2147483648); ++ ++/****************************************************************************** ++ ++ Types used here: ++ - b BigNat: array of limbs (each a number of GHCJSBN_BITS bits) ++ - s Int: small integer in range -2^31 .. 2^31-1 ++ - w Word: small integer in range 0 .. 2^32-1, ++ values greater than 2^31-1 are stored as negative numbers ++ - i Integer: Haskell Integer heap object, see invariants ++ ++ Integer invariants: ++ - BigNat arrays do not have leading zeroes ++ - Jp > S > Jn ++ - S range: -2^31 .. 2^31-1 (-2147483648 .. 2147483647) ++ ++ ******************************************************************************/ ++ ++#ifdef GHCJSBN_ASSERT_INTEGER ++#define ASSERTVALID_I(i, msg) h$ghcjsbn_assertValid_i(i, msg) ++#define ASSERTVALID_B(d, msg) h$ghcjsbn_assertValid_b(d, msg) ++#define ASSERTVALID_S(s, msg) h$ghcjsbn_assertValid_s(s, msg) ++#define ASSERTVALID_W(w, msg) h$ghcjsbn_assertValid_w(w, msg) ++#define ASSERTVALID_D(d, msg) h$ghcjsbn_assertValid_d(d, msg) ++ ++// checks that the S,Jn,Jp constructor invariants hold ++function h$ghcjsbn_assertValid_i(b, msg) { ++ var sd, d, neg, i, n; ++ // check global constants for unwanted mutations ++ if(h$ghcjsbn_zero_b.length !== 1 || h$ghcjsbn_zero_b[0] !== 0) { ++ throw new Error("zero_b mutated"); ++ } ++ if(h$ghcjsbn_one_b.length !== 2 || h$ghcjsbn_one_b[0] !== 1 || h$ghcjsbn_one_b[1] !== 1) { ++ throw new Error("one_b mutated"); ++ } ++ if(IS_INTEGER_S(b)) { ++ sd = INTEGER_S_DATA(b); ++ if(typeof sd !== 'number') ++ throw new Error("invalid small integer: not a number"); ++ if((sd|0) !== sd) ++ throw new Error("invalid small integer: not a small int"); ++ } else { ++ if(IS_INTEGER_Jp(b)) { ++ neg = false; ++ } else if(IS_INTEGER_Jn(b)) { ++ neg = true; ++ } else { ++ throw new Error("invalid integer: unexpected constructor"); ++ } ++ d = INTEGER_J_DATA(b); ++ ASSERTVALID_B(d, "assertValid_i"); ++ if(d[0] < 2) ++ throw new Error("invalid big integer: array too short"); ++ if(d[0] === 2) { ++ if((d[2] >> (31-GHCJSBN_BITS)) === 0 || ++ (neg && d[2] === 0x20 && d[1] === 0)) ++ throw new Error("invalid big integer: in smallint range"); ++ } ++ // everything ok ++ } ++} ++ ++// checks invariant for big number ++function h$ghcjsbn_assertValid_b(d, msg) { ++ var i, n; ++ if(!Array.isArray(d)) ++ throw new Error("invalid big integer: not an array"); ++#ifdef GHCJSBN_TRACE_INTEGER ++ var jb = h$ghcjsbn_tmp_toJSBN(d); ++ if(msg) h$log("BigNat: " + msg + ": [" + d.join(",") + "] (" + jb.toString() + ")"); ++#endif ++ if(typeof d[0] !== 'number' || d[0] > (d.length-1)) ++ throw new Error("invalid big integer: incorrect number of limbs"); ++ if(d[0] > 0 && d[d[0]] === 0) ++ throw new Error("invalid big integer: leading zero"); ++ for(i = 1; i <= d[0]; i++) { ++ n = d[i]; ++ if(typeof n !== 'number') ++ throw new Error("invalid big integer: limb is not a number"); ++ if((n & GHCJSBN_MASK) !== n) ++ throw new Error("invalid big integer: limb out of range"); ++ } ++} ++ ++function h$ghcjsbn_assertValid_s(s, msg) { ++ if(typeof s !== 'number') ++ throw new Error("invalid int: not a number"); ++#ifdef GHCJSBN_TRACE_INTEGER ++ if(msg) h$log("Int: " + msg + ": " + s); ++#endif ++ if((s|0) !== s) ++ throw new Error("invalid int: not in smallint range"); ++} ++ ++function h$ghcjsbn_assertValid_w(w, msg) { ++ if(typeof w !== 'number') ++ throw new Error("invalid word: not a number"); ++#ifdef GHCJSBN_TRACE_INTEGER ++ if(msg) h$log("Word: " + msg + ": " + w); ++#endif ++ if((w|0) !== w) ++ throw new Error("invalid word: not in smallint range"); ++} ++ ++function h$ghcjsbn_assertValid_d(d, msg) { ++ if(typeof d !== 'number') ++ throw new Error("invalid double: not a number"); ++#ifdef GHCJSBN_TRACE_INTEGER ++ if(msg) h$log("Double: " + msg + " : " + d); ++#endif ++} ++ ++#else ++#define ASSERTVALID_I(i, msg) ++#define ASSERTVALID_B(b, msg) ++#define ASSERTVALID_S(s, msg) ++#define ASSERTVALID_W(w, msg) ++#define ASSERTVALID_D(d, msg) ++#endif ++ ++/******************************************************************************/ ++ ++/////////////////////////////////////////////////////////////////////////////// ++// the ghcjsbn_r functions operate on the raw array data directly ++/////////////////////////////////////////////////////////////////////////////// ++ ++#define GHCJS_SMALLPRIMES_MAX 1008 ++ ++var h$ghcjsbn_smallPrimes = ++ [ 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47 ++ , 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113 ++ , 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197 ++ , 199, 211, 223, 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281 ++ , 283, 293, 307, 311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379 ++ , 383, 389, 397, 401, 409, 419, 421, 431, 433, 439, 443, 449, 457, 461, 463 ++ , 467, 479, 487, 491, 499, 503, 509, 521, 523, 541, 547, 557, 563, 569, 571 ++ , 577, 587, 593, 599, 601, 607, 613, 617, 619, 631, 641, 643, 647, 653, 659 ++ , 661, 673, 677, 683, 691, 701, 709, 719, 727, 733, 739, 743, 751, 757, 761 ++ , 769, 773, 787, 797, 809, 811, 821, 823, 827, 829, 839, 853, 857, 859, 863 ++ , 877, 881, 883, 887, 907, 911, 919, 929, 937, 941, 947, 953, 967, 971, 977 ++ , 983, 991, 997 ++ ]; ++ ++var h$ghcjsbn_smallPrimesM = null; ++ ++function h$ghcjsbn_getSmallPrimesM() { ++ var a, i; ++ if(h$ghcjsbn_smallPrimesM === null) { ++ a = []; ++ for(i = 0; i < GHCJS_SMALLPRIMES_MAX; i++) { ++ a[i] = false; ++ } ++ for(i = h$ghcjsbn_smallPrimes.length - 1; i >= 0; i--) { ++ a[h$ghcjsbn_smallPrimes[i]] = true; ++ } ++ h$ghcjsbn_smallPrimesM = a; ++ } ++ return h$ghcjsbn_smallPrimesM; ++} ++ ++ ++// Int -> Int -> Bool ++// fixme: seed ++function h$ghcjsbn_isPrime_s(s, rounds) { ++ if(s < 2 || (s > 2 && ((s&1) === 1))) return false; ++ if(s <= GHCJS_SMALLPRIMES_MAX) { ++ return h$ghcjsbn_getSmallPrimesM()[s]; ++ } ++ throw new Error("isPrime_s"); ++} ++ ++// BigNat -> Int -> Bool ++// fixme: seed ++function h$ghcjsbn_isPrime_b(b, rounds) { ++ ASSERTVALID_B(b, "isPrime"); ++ throw new Error("isPrime_b"); ++} ++ ++// BigNat -> BigNat -> Bool ++/* ++function h$ghcjsbn_eq_bb(b1, b2) { ++ ASSERTVALID_B(b1, "eq_bb b1"); ++ ASSERTVALID_B(b2, "eq_bb b2"); ++ var l1 = b1.length, l2 = b2.length; ++ if(l1 !== l2) return false; ++ while(--l1 >= 0) { ++ if(b1[l1] !== b2[l1]) return false; ++ } ++ return true; ++} ++*/ ++ ++// BigNat -> BigNat -> Int (Ordering: LT,EQ,GT) ++function h$ghcjsbn_cmp_bb(b1, b2) { ++ ASSERTVALID_B(b1, "cmp_bb b1"); ++ ASSERTVALID_B(b2, "cmp_bb b2"); ++ var l1 = b1[0], l2 = b2[0], d1, d2; ++ if(l1 === l2) { ++ while(--l1 >= 0) { ++ d1 = b1[l1+1]; ++ d2 = b2[l1+1]; ++ if(d1 !== d2) return d1 < d2 ? GHCJSBN_LT : GHCJSBN_GT; ++ } ++ return GHCJSBN_EQ; ++ } else { ++ return l1 > l2 ? GHCJSBN_GT : GHCJSBN_LT; ++ } ++} ++ ++// fixed size tmp, these should not grow ++var h$ghcjsbn_tmp_2a = [0, 0, 0]; ++var h$ghcjsbn_tmp_2b = [0, 0, 0]; ++ ++// this is variable size scratch space ++var h$ghcjsbn_tmp_a = [0, 0, 0, 0, 0, 0, 0, 0]; ++var h$ghcjsbn_tmp_b = [0, 0, 0, 0, 0, 0, 0, 0]; ++ ++// b - w :: BigNat -> Word -> BigNat ++ ++function h$ghcjsbn_sub_bw(b, w) { ++ var a = h$ghcjsbn_tmp_2a; ++ h$ghcjsbn_toBigNat_w(a, w); ++ return h$ghcjsbn_sub_bb(b, a); ++} ++ ++// b - s :: BigNat -> Int -> BigNat ++// returns new BigNat, nullBigNat in case of underflow ++// returns size of t ++function h$ghcjsbn_sub_bs(b, s) { ++ ASSERTVALID_B(b, "sub_bs"); ++ ASSERTVALID_S(s, "sub_bs"); ++ var a, ms, r; ++ if(s < 0) { ++ if(s === -2147483648) { ++ r = h$ghcjsbn_add_bb(b, h$ghcjsbn_two31_b); ++ } else { ++ a = h$ghcjsn_tmp_2a; ++ h$ghcjsbn_toBigNat_s(a, -s); ++ r = h$ghcjsbn_add_bb(b, a); ++ } ++ } else { ++ a = h$ghcjsn_tmp_2a; ++ h$ghcjsbn_toBigNat_s(a, s); ++ r = h$ghcjsbn_sub_bb(b, a); ++ } ++ ASSERTVALID_B(r, "sub_bs result"); ++ return r; ++} ++ ++// t = b + w :: BigNat -> BigNat -> Word -> Int ++// returns size of t ++function h$ghcjsbn_add_bw(b, w) { ++ ASSERTVALID_B(b, "add_bw"); ++ ASSERTVALID_W(w, "add_bw"); ++ var a = h$ghcjsbn_tmp_2a; ++ h$ghcjsbn_toBigNat_w(a, w); ++ return h$ghcjsbn_add_bb(b, a); ++} ++ ++// t = b + s :: BigNat -> BigNat -> Int -> Int ++// returns size of t, nullBigNat in case of underflow ++function h$ghcjsbn_add_bs(b, s) { ++ ASSERTVALID_B(b, "add_bs"); ++ ASSERTVALID_S(s, "add_bs"); ++ var a, ms, r; ++ if(s < 0) { ++ if(s === -2147483648) { ++ r = h$ghcjsbn_sub_bb(b, h$ghcjsbn_two31_r); ++ } else { ++ ms = -s; ++ a = h$ghcjsbn_tmp_2a; ++ h$ghcjsbn_toBigNat_s(a, ms); ++ r = h$ghcjsbn_sub(b, a); ++ } ++ } else { ++ a = h$ghcjsbn_tmp_2a; ++ h$ghcjsbn_toBigNat_s(a, s); ++ r = h$ghcjsbn_add_bb(b, a); ++ } ++ ASSERTVALID_B(r, "add_bs result"); ++ return r; ++} ++ ++// t = b1 + b2 :: BigNat -> BigNat -> BigNat -> Int ++// returns size of t ++function h$ghcjsbn_add_bb(b1, b2) { ++ ASSERTVALID_B(b1, "add_bb b1"); ++ ASSERTVALID_B(b2, "add_bb b2"); ++ var i, c = 0, l1 = b1[0], l2 = b2[0], t = [0]; ++ var bl, lmin, lmax; ++ if(l1 <= l2) { ++ lmin = l1; ++ lmax = l2; ++ bl = b2; ++ } else { ++ lmin = l2; ++ lmax = l1; ++ bl = b1; ++ } ++ for(i=1;i<=lmin;i++) { ++ c += b1[i] + b2[i]; ++ t[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ for(i=lmin+1;i<=lmax;i++) { ++ c += bl[i]; ++ t[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ if(c !== 0) t[++lmax] = c; ++ t[0] = lmax; ++ ASSERTVALID_B(t, "add_bb result"); ++ return t; ++} ++ ++// b1 += b2 :: BigNat -> BigNat -> Int ++// returns new size of b1 ++function h$ghcjsbn_addTo_bb(b1, b2) { ++ ASSERTVALID_B(b1, "addTo_bb b1"); ++ ASSERTVALID_B(b2, "addTo_bb b2"); ++ var i, c = 0, l1 = b1[0], l2 = b2[0]; ++ if(l2 > l1) { ++ for(i = l1 + 1; i <= l2; i++) { ++ b1[i] = 0; ++ } ++ l1 = l2; ++ } ++ for(i = 1; i <= l2; i++) { ++ c += b1[i] + b2[i]; ++ b1[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ // propagate carry as long as needed ++ for(i = l2 + 1; c !== 0 && i <= l1; i++) { ++ c += b1[i]; ++ b1[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ if(c !== 0) { ++ b1[l1] = c; ++ b1[0] = l1+1; ++ } else { ++ b1[0] = l1; ++ } ++ ASSERTVALID_B(b1, "addTo_bb result"); ++} ++ ++// b1 - b2 :: BigNat -> BigNat -> BigNat ++// returns a new BigNat, nullBigNat in case of underflow ++function h$ghcjsbn_sub_bb(b1, b2) { ++ ASSERTVALID_B(b1, "sub_bb b1"); ++ ASSERTVALID_B(b2, "sub_bb b2"); ++ if(h$ghcjsbn_cmp_bb(b1,b2) === GHCJSBN_LT) { ++ return []; ++ } else { ++ var i, c = 0, l1 = b1[0], l2 = b2[0], t = [0]; ++ for(i = 1; i <= l2; i++) { ++ c += b1[i] - b2[i]; ++ t[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ for(i = l2 + 1; i <= l1; i++) { ++ c += b1[i]; ++ t[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ while(l1 > 0 && t[l1] === 0) l1--; ++ t[0] = l1; ++ ASSERTVALID_B(t, "sub_bb result"); ++ return t; ++ } ++} ++ ++// b1 -= b2 :: BigNat -> BigNat -> Int ++// returns size of t, b1 must be >= b2 ++function h$ghcjsbn_subTo_bb(b1, b2) { ++ ASSERTVALID_B(b1, "subTo_bb b1"); ++ ASSERTVALID_B(b2, "subTo_bb b2"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(h$ghcjsbn_cmp_bb(b1, b2) === GHCJSBN_LT) { ++ throw new Error("h$ghcjsbn_subTo_bb assertion failed: b1 >= b2"); ++ } ++#endif ++ var i, c = 0, l1 = b1[0], l2 = b2[0]; ++ for(i = 1; i <= l2; i++) { ++ c += b1[i] - b2[i]; ++ b1[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ for(i = l2 + 1; c !== 0 && i <= l1; i++) { ++ c += b1[i]; ++ b1[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ while(l1 > 0 && b1[l1] === 0) l1--; ++ b1[0] = l1; ++ ASSERTVALID_B(b1, "subTo_bb result"); ++} ++ ++// t = b1 / b2, BigNat -> BigNat -> BigNat -> Int (returns size of t) ++/* function h$ghcjsbn_div_bb(t, b1, b2) { ++ ++} ++ ++// t = b1 % b2, BigNat -> BigNat -> BigNat -> Int (returns size of t) ++function h$ghcjsbn_mod_bb(t, b1, b2) { ++ ++} ++ ++// b % s, BigNat -> Int -> Int ++function h$ghcjsbn_mod_bs(b, s) { ++ ++} ++*/ ++// BigNat -> Integer (nonnegative, known length) ++/* ++function h$ghcjsbn_wrap_pl(b, l) { ++ var lb; ++ if(l === 0) { ++ return MK_INTEGER_S(0); ++ } else if(l === 1) { ++ return MK_INTEGER_S(b[0]); ++ } else if(l === 2 && (b[1] >> (31 - GHCJSBN_BITS)) === 0) { ++ return MK_INTEGER_S((b[1] << GHCJSBN_BITS)|b[0]); ++ } else { ++ lb = b.length - l; ++ while(lb-- > 0) b.pop(); ++ return MK_INTEGER_Jp(b); ++ } ++} ++*/ ++// BigNat -> Integer (nonnegative) ++function h$ghcjsbn_wrap_p(b) { ++ var l = b[0]; ++ if(l === 0) { ++ return MK_INTEGER_S(0); ++ } else if(l === 1) { ++ return MK_INTEGER_S(b[1]); ++ } else if(l === 2 && (b[2] >> (31 - GHCJSBN_BITS)) === 0) { ++ return MK_INTEGER_S((b[2] << GHCJSBN_BITS)|b[1]); ++ } else { ++ return MK_INTEGER_Jp(b); ++ } ++} ++/* ++function h$ghcjsbn_wrap_nl(b, l) { ++ var lb; ++ if(l === 0) { ++ return MK_INTEGER_S(0); ++ } else if(l === 1) { ++ return MK_INTEGER_S(-b[0]); ++ } else if(l === 2 && ++ ((b[1] >> (31 - GHCJSN_BITS)) === 0 || ++ (b[1] === (1 << (31 - GHCJSBN_BITS)) && b[0] === 0))) { ++ return MK_INTEGER_S((-b[1]-b[0])|0); ++ } else { ++ lb = b.length - l; ++ while(lb-- > 0) b.pop(); ++ return MK_INTEGER_Jn(b); ++ } ++} ++*/ ++// BigNat -> Integer (nonnegative) ++function h$ghcjsbn_wrap_n(b) { ++ var l = b[0]; ++ if(l === 0) { ++ return MK_INTEGER_S(0); ++ } else if(l === 1) { ++ return MK_INTEGER_S(-b[1]); ++ } else if(l === 2 && ++ ((b[2] >> (31 - GHCJSN_BITS)) === 0 || ++ (b[2] === (1 << (31 - GHCJSBN_BITS)) && b[1] === 0))) { ++ return MK_INTEGER_S((-b[2]-b[1])|0); ++ } else { ++ return MK_INTEGER_Jn(b); ++ } ++} ++ ++// b1 *= b2 :: BigNat -> BigNat -> IO () ++function h$ghcjsbn_mulTo_bb(b1, b2) { ++ ASSERTVALID_B(b1, "mulTo_bb b1"); ++ ASSERTVALID_B(b2, "mulTo_bb b2"); ++ var t = h$ghcjsbn_mul_bb(b1, b2); ++ h$ghcjsbn_copy(b1, t); ++ ASSERTVALID_B(b1, "mulTo_bb result"); ++} ++ ++// b1 * b2 :: BigNat -> BigNat -> BigNat ++function h$ghcjsbn_mul_bb(b1, b2) { ++ ASSERTVALID_B(b1, "mul_bb b1"); ++ ASSERTVALID_B(b2, "mul_bb b2"); ++ var l1 = b1[0], l2 = b2[0]; ++/* if(l1 > 50 && l2 > 50) { ++ return h$ghcjsbn_mul_karatsuba_bb(b1, b2); ++ } fixme update this */ ++ var n = l1 + l2, i, t = [0]; ++ for(i = 1; i <= n; i++) t[i] = 0; ++ if(l1 > l2) { ++ for(i = 0; i < l2; i++) { ++ t[i + l1 + 1] = h$ghcjsbn_mul_limb(0, b1, b2[i+1], t, i, 0, l1); ++ } ++ } else { ++ for(i = 0; i < l1; i++) { ++ t[i + l2 + 1] = h$ghcjsbn_mul_limb(0, b2, b1[i+1], t, i, 0, l2); ++ } ++ } ++ for(i = l1 + l2; i > 0 && t[i] === 0; i--); ++ t[0] = i; ++ ASSERTVALID_B(t, "mul_bb result"); ++ return t; ++} ++ ++function h$ghcjsbn_mul_bw(b, w) { ++ ASSERTVALID_B(b, "mul_bw"); ++ ASSERTVALID_W(w, "mul_bw"); ++ var a = h$ghcjsbn_tmp_2a; ++ h$ghcjsbn_toBigNat_w(a, w); ++ var t = h$ghcjsbn_mul_bb(b, a); ++ ASSERTVALID_B(t, "mul_bw result"); ++ return t; ++} ++ ++ ++// karatzuba multiplication for long numbers ++function h$ghcjsbn_mul_karatsuba_bb(t, b1, b2) { ++ throw new Error("not yet updated"); ++ var l1 = b1.length, l2 = b2.length; ++ var i, b = (l1 < l2 ? l1 : l2) >> 1; ++ var x0 = [b], x1 = [l1-b], y0 = [b], y1 = [l2-b]; ++ for(i = 1; i <= b; i++) { ++ x0[i] = b1[i]; ++ y0[i] = b2[i]; ++ } ++ for(i = b + 1; i <= l1; i++) x1[i - b] = b1[i]; ++ for(i = b + 1; i <= l2; i++) y1[i - b] = b2[i]; ++ var z0 = h$ghcjsbn_mul_bb(x0, y0), z1, z2 = h$ghcjsbn_mul_bb(x1, y1); ++ ++ // compute z1 = (x1 + x0)(y1 + y0) - z2 - z0 ++ // (reusing x0 and y0 for (x1 + x0) and (y1 + y0)) ++ h$ghcjsbn_addTo_bb(x0, x1); ++ h$ghcjsbn_addTo_bb(y0, x1); ++ z1 = h$ghcjsbn_mul_bb(x0, y0); ++ h$ghcjsbn_subTo_bb(z1, z2); ++ h$ghcjsbn_subTo_bb(z1, z0); ++ // store shifted z2 in t ++ // fixme this looks wrong ++ for(i = 0; i < 2*b; i++) t[i] = 0; ++ l2 = z2.length; ++ for(i = 0; i < l2; i++) t[i+2*b] = z2[i]; ++ // compute shifted z1s = z1 * B ++ var z1s = []; ++ l1 = z1.length; ++ for(i = 0; i < b; i++) z1s[i] = 0; ++ for(i = 0; i < l1; i++) z1s[i+b] = z1[i]; ++ // add the results so that t = z2 * (2*B) + z1 * B + z0 ++ h$ghcjsbn_addTo_bb(t, z1s); ++ h$ghcjsbn_addTo_bb(t, z0); ++ return t; ++} ++ ++// from JSBN am3 ++// w_j += (x*b_i) ? ++/* c = carry? ++ n = iterations? ++ */ ++#if(GHCJSBN_BITS == 28) ++function h$ghcjsbn_mul_limb(i,b,x,w,j,c,n) { ++ // ASSERTVALID_B(b, "mul_limb b"); ++ // ASSERTVALID_B(w, "mul_limb w"); ++ var xl = x & 0x3fff, xh = x >> 14; ++ while(--n >= 0) { ++ var l = b[++i] & 0x3fff; ++ var h = b[i] >> 14; ++ var m = xh * l + h * xl; ++ l = xl *l + ((m & 0x3fff) << 14) + w[++j] + c; ++ c = (l >> 28) + (m >> 14) + xh * h; ++ // h$log("mul_limb: c: " + c + " l: " + l + " xh: " + xh + " h: " + h); ++ w[j] = l & 0xfffffff; ++ } ++ return c; ++} ++#else ++#error "no limb multiplication routine for specified GHCJSBN_BITS" ++#endif ++ ++// q = b1 / b2, r = b1 % b2 :: BigNat -> BigNat -> BigNat -> BigNat -> Int ++// b2 must be > 0 ++// returns length of r ++// d is normalized before return ++ ++/* ++ algorithm: ++ y = 0? ++ nsh = number of leading zeroes in most significant word ++ pm = positive modulus ++ pt = positive divident ++ y = tmp, shifted modulus ++ r = shifted divident ++ ys = length of y ++ y0 = biggest limb of y ++ yt = new estimated length of y? ++ */ ++ ++function h$ghcjsbn_quotRem_bb(q, r, b1, b2) { ++ ASSERTVALID_B(b1, "quotRem_bb b1"); ++ ASSERTVALID_B(b2, "quotRem_bb b2"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(h$ghcjsbn_cmp_bw(b2, 0) !== GHCJSBN_GT) { ++ throw new Error("h$ghcjsbn_quotRem_bb: operand not positive"); ++ } ++ #endif ++ if(q === null) q = h$ghcjsbn_tmp_a; ++ if(r === null) r = h$ghcjsbn_tmp_b; ++ var l1 = b1[0], l2 = b2[0], nsh, y = []; ++ if(l1 === 0) { ++ q[0] = 0; ++ r[0] = 0; ++ return; ++ } ++ if(h$ghcjsbn_cmp_bb(b1,b2) === GHCJSBN_LT) { ++ q[0] = 0; ++ h$ghcjsbn_copy(r, b1); ++ return; ++ } ++ nsh = GHCJSBN_BITS-h$ghcjsbn_nbits_s(b2[l2]); ++ ASSERTVALID_S(nsh, "quotRem_bb nsh"); ++ if(nsh !== 0) { ++ h$ghcjsbn_shlTo_b(y, b2, nsh); ++ h$ghcjsbn_shlTo_b(r, b1, nsh); ++ } else { ++ h$ghcjsbn_copy(y, b2); ++ h$ghcjsbn_copy(r, b1); ++ } ++ ASSERTVALID_B(y, "quotRem_bb y_0"); ++ ASSERTVALID_B(r, "quotRem_bb r_0"); ++ var ys = y[0], y0 = y[ys]; ++ var yt = y0*(1<1)?y[ys-1]>>GHCJSBN_F2:0); ++ var d1 = GHCJSBN_FV/yt, d2 = (1<= 0) { ++ // Estimate quotient digit ++ var qd = (r[(--i)+1]===y0)?GHCJSBN_MASK:Math.floor(r[i+1]*d1+(r[i]+e)*d2); ++ // h$log("i: " + i + " j: " + j + " qd: " + qd + " rdi: " + r[i+1] + " ys: " + ys); ++ // h$log("yd: [" + y.join(',') + "] rd: [" + r.join(',') + "]"); ++ var am = h$ghcjsbn_mul_limb(0, y, qd, r, j, 0, ys); ++ // h$log("am: " + am); ++ if((r[i+1] += am) < qd) { ++ // if((r[i+1] += h$ghcjsbn_mul_limb(0, y, qd, r, j, 0, ys)) < qd) { ++ h$ghcjsbn_shlTo_limbs_b(t, y, j); ++ h$ghcjsbn_subTo_bb(r, t); ++ // h$log("0. rdi: " + r[i+1] + " qd: " + qd); ++ while(r[i+1] < --qd) { ++ // h$log("1. rdi: " + r[i+1] + " qd: " + qd); ++ h$ghcjsbn_subTo_bb(r, t); ++ } ++ } ++ } ++ ASSERTVALID_B(r, "intermediate r"); ++ h$ghcjsbn_shrTo_limbs_b(q, r, ys); ++ r[0] = ys; ++ while(r[r[0]] === 0 && r[0] > 0 && r[0]--); ++ if(nsh !== 0) { ++ var r0 = []; ++ h$ghcjsbn_copy(r0, r); ++ h$ghcjsbn_shrTo_b(r, r0, nsh); ++ } ++ ASSERTVALID_B(q, "quotRem_bb result q"); ++ ASSERTVALID_B(r, "quotRem_bb result r"); ++} ++ ++// b % w , q = b / w :: BigNat -> BigNat -> Word -> Word ++function h$ghcjsbn_quotRem_bw(q, b, w) { ++ ASSERTVALID_B(b, "quotRem_bw"); ++ ASSERTVALID_W(w, "quotRem_bw"); ++ var a = h$ghcjsbn_tmp_2a; ++ h$ghcjsbn_toBigNat_w(a, w); ++/* if(w === 0) { ++ a[0] = 0; ++ } else if(w > 0 && w <= GHCJSBN_MASK) { ++ a[0] = 1; ++ a[1] = w; ++ } else { ++ a[0] = 2; ++ a[1] = w & GHCJSBN_MASK; ++ a[2] = w >>> GHCJSBN_BITS; ++ } */ ++ var r = []; ++ h$ghcjsbn_quotRem_bb(q, r, b, a); ++ return h$ghcjsbn_toWord_b(r); ++} ++ ++// BigNat -> JSBN ++// assumes same number of bits ++function h$ghcjsbn_tmp_toJSBN(b) { ++ var j = new BigInteger(), bl = b[0], i; ++ for(i = 0; i < bl; i++) j.data[i] = b[i+1]; ++ j.s = 0; ++ j.t = bl; ++ return j; ++/* ASSERTVALID_B(b, "toJSBN"); ++ var j0 = new BigInteger(); ++ var j1 = new BigInteger(); ++ var j2 = new BigInteger(); ++ for(var i = b[0]; i > 0; i--) { ++ h$log("i: " + b[i]); ++ j2.fromString('' + b[i]); ++ j0.lShiftTo(28, j1); ++ j1.addTo(j2, j0); ++ } ++ return j0; */ ++} ++ ++// b = fromJSBN(j) :: BigNat -> JSBN -> Int ++// returns length ++function h$ghcjsbn_tmp_fromJSBN(b, j) { ++ var bl = j.t, i; ++ for(i = 0; i < bl; i++) { ++ b[i] = j.data[i]; ++ } ++ return bl; ++} ++ ++ ++// function h$ghcjsbn_divMod_bs(d ++ ++// t = b1 % b2 :: BigNat -> BigNat -> BigNat ++function h$ghcjsbn_rem_bb(b1, b2) { ++ ASSERTVALID_B(b1, "rem_bb b1"); ++ ASSERTVALID_B(b2, "rem_bb b2"); ++ var t1 = [], t2 = []; ++ h$ghcjsbn_quotRem_bb(t1, t2, b1, b2); ++ ASSERTVALID_B(t2, "rem_bb result"); ++ return t2; ++} ++ ++// b1 % s :: BigNat -> Word -> Word ++function h$ghcjsbn_rem_bw(b, w) { ++ ASSERTVALID_B(b, "rem_bw"); ++ ASSERTVALID_W(w, "rem_bw"); ++ // var t1 = []; ++ var r = h$ghcjsbn_quotRem_bw([] /* t1 */, b, w); ++ ASSERTVALID_W(r, "rem_bw result"); ++ return r; ++// var a = h$ghcjsbn_tmp_2a; ++// h$ghcjsbn_toBigNat_w(a, w); ++// a[1] = w & GHCJSBN_MASK; ++// a[2] = w >>> GHCJSBN_BITS; ++// var t1 = []; // , t2 = h$ghcjsbn_tmp_2b; ++// return h$ghcjsbn_quotRem_bw(t1, /* t2 , */ b, a); ++// return t[1] | (t[2] << GHCJSBN_BITS); ++} ++ ++// b1 / b2 :: BigNat -> BigNat -> BigNat ++function h$ghcjsbn_quot_bb(b1, b2) { ++ ASSERTVALID_B(b1, "quot_bb b1"); ++ ASSERTVALID_B(b2, "quot_bb b2"); ++ var t1 = [], t2 = []; ++ h$ghcjsbn_quotRem_bb(t1, t2, b1, b2); ++ ASSERTVALID_B(t1, "quot_bb result"); ++ return t1; ++} ++/* ++// b / s :: BigNat -> Int -> BigNat ++function h$ghcjsbn_div_bs(b, w) { ++ ASSERTVALID_B(b, "div_bs"); ++ ASSERTVALID_S(s, "div_bs"); ++#ifdef GHCJS_ASSERT_INTEGER ++ if(s <= 0) { ++ throw new Error("h$ghcjsbn_div_bs: divisor must be positive"); ++ } ++#endif ++ var a = h$ghcjsbn_tmp_2a; ++ a[0] = s & GHCJSBN_MASK; ++ a[1] = s >> GHCJSBN_BITS; ++ return h$ghcjsbn_div_bb(t, b, a); ++} ++*/ ++// t = b % w :: BigNat -> BigNat -> Word -> Int ++// returns length of t ++/* ++function h$ghcjsbn_div_bw(t, b, w) { ++ ASSERTVALID_B(b, "div_bw"); ++ ASSWRTVALID_W(w, "div_bw"); ++ var a = h$ghcjsbn_tmp_2a; ++ a[0] = w & GHCJSBN_MASK; ++ a[1] = w >>> GHCJSBN_BITS; ++ return h$ghcjsbn_div_bb(t, b, a); ++} ++*/ ++// b ^ 2 :: BigNat -> BigNat ++function h$ghcjsbn_sqr_b(b) { ++ ASSERTVALID_B(b, "sqr_b"); ++ var l = b[0], n = 2 * l, i, c, t = [0]; ++ for(i = 1; i <= n; i++) t[i] = 0; ++ for(i = 0; i < l - 1; i++) { ++ c = h$ghcjsbn_mul_limb(i, b, b[i+1],t,2*i,0,1); ++ if((t[i + l + 1] += h$ghcjsbn_mul_limb(i+1, b, 2*b[i+1], t, 2*i+1, c, l - i - 1)) >= GHCJSBN_DV) { ++ t[i + l + 1] -= GHCJSBN_DV; ++ t[i + l + 2] = 1; ++ } ++ } ++ if(n > 0) t[n] += h$ghcjsbn_mul_limb(i, b, b[i+1], t, 2*i, 0, 1); ++ if(t[n] === 0) n--; ++ t[0] = n; ++ ASSERTVALID_B(t, "sqr_b result"); ++ return t; ++} ++ ++// b1 ^ b2 :: BigNat -> BigNat -> BigNat ++// returns size of t ++function h$ghcjsbn_pow_bb(b1, b2) { ++ ASSERTVALID_B(b1, "pow_bb b1"); ++ ASSERTVALID_B(b2, "pow_bb b2"); ++ var i, sq = b1, t = [1,1]; ++ var bits = h$ghcjsbn_nbits_b(b2); ++ for(i = 0; i < bits; i++) { ++ if(h$ghcjsbn_testBit_b(b2, i)) { ++ h$ghcjsbn_mulTo_bb(t, sq); ++ } ++ sq = h$ghcjsbn_sqr_b(sq); ++ } ++ return t; ++} ++ ++// t = b ^ s :: BigNat -> Word -> BigNat ++function h$ghcjsbn_pow_bw(b, w) { ++ ASSERTVALID_B(b, "pow_bw"); ++ ASSERTVALID_W(w, "pow_bw"); ++ var i, sq = b, t = [1,1]; ++ while(w) { ++ if(w&1) h$ghcjsbn_mulTo_bb(t, sq); ++ w >>>= 1; ++ if(w) { ++ sq = h$ghcjsbn_sqr_b(sq); ++ } ++ } ++ ASSERTVALID_B(t, "pow_bw result"); ++ return t; ++} ++ ++// w1 ^ w2 :: Word -> Word -> BigNat ++function h$ghcjsbn_pow_ww(w1, w2) { ++ ASSERTVALID_S(w1, "pow_ww w1"); ++ ASSERTVALID_S(w2, "pow_ww w2"); ++ var b = h$ghcjsbn_tmp_2a; ++ h$ghcjsbn_toBigNat_w(b, w1); ++ var t = h$ghcjsbn_pow_bw(b, w2); ++ ASSERTVALID_B(t, "pow_ww result"); ++ return t; ++} ++ ++// (b ^ s1) % s2 :: BigNat -> BigNat -> BigNat -> BigNat ++function h$ghcjsbn_modPow_bbb(b, s1, s2) { ++ throw new Error("modPow_bbb"); ++} ++ ++// (b ^ s1) % s2 :: BigNat -> Int -> Int -> Int ++function h$ghcjsbn_modPow_bss(b, s1, s2) { ++ throw new Error("modPow_bss"); ++} ++ ++// (s1 ^ s2) % s3 :: Int -> Int -> Int -> Int ++function h$ghcjsbn_modPow_sss(s1, s2, s3) { ++ throw new Error("modPow_sss"); ++} ++ ++ ++ ++// r = gcd(b1,b2) BigNat -> BigNat -> BigNat ++function h$ghcjsbn_gcd_bb(b1, b2) { ++ ASSERTVALID_B(b1, "gcd_bb b1"); ++ ASSERTVALID_B(b2, "gcd_bb b2"); ++ var r; ++ if(h$ghcjsbn_cmp_bb(b1, b2) === GHCJSBN_GT) { ++ r = b1; ++ b1 = b2; ++ b2 = r; ++ } ++ while(b1[0] > 0) { ++ r = h$ghcjsbn_rem_bb(b2, b1); ++ b2 = b1; ++ b1 = r; ++ } ++ ASSERTVALID_B(b2, "gcd_bb result"); ++ return b2; ++} ++// gcd(b,s) :: BigNat -> Int -> Int ++function h$ghcjsbn_gcd_bs(b, s) { ++ throw new Error("h$ghcjsbn_gcd_bs not implemented"); ++} ++ ++// gcd(s1,s2) :: Int -> Int -> Int ++function h$ghcjsbn_gcd_ss(s1, s2) { ++ ASSERTVALID_S(s1, "gcd_ss s1"); ++ ASSERTVALID_S(s2, "gcd_ss s2"); ++ var a, b, r; ++ a = s1 < 0 ? -s1 : s1; ++ b = s2 < 0 ? -s2 : s2; ++ if(b < a) { ++ r = a; ++ a = b; ++ b = r; ++ } ++ while(a !== 0) { ++ r = b % a; ++ b = a; ++ a = r; ++ } ++ ASSERTVALID_S(b, "gcd_ss result"); ++ return b; ++} ++ ++// gcd(w1,w2) :: Word -> Word -> Word ++// fixme negatives are probably wrong here ++function h$ghcjsbn_gcd_ww(w1, w2) { ++ ASSERTVALID_W(w1, "gcd_ww w1"); ++ ASSERTVALID_W(w2, "gcd_ww w2"); ++ var a, b, r; ++ a = w1 < 0 ? (w1 + 4294967296) : w1; ++ b = w2 < 0 ? (w2 + 4294967296) : w2; ++ if(b < a) { ++ r = a; ++ a = b; ++ b = r; ++ } ++ while(a !== 0) { ++ r = b % a; ++ b = a; ++ a = r; ++ } ++ b = b|0; ++ ASSERTVALID_W(b, "gcd_ww result"); ++ return b; ++} ++ ++function h$ghcjsbn_gcd_bw(b, w) { ++ ASSERTVALID_B(b, "gcd_bw"); ++ ASSERTVALID_W(w, "gcd_bw"); ++ var q = [], r = h$ghcjsbn_quotRem_bw(q, b, w); ++ ASSERTVALID_W(r, "gcd_bw r"); ++ if(r === 0) { ++ return b[0] === 0 ? 0 : w; ++ } else { ++ return h$ghcjsbn_gcd_ww(r, w); ++ } ++} ++ ++// b >> s :: BigNat -> Int -> BigNat ++function h$ghcjsbn_shr_b(b, s) { ++ ASSERTVALID_B(b, "shr_b"); ++ ASSERTVALID_S(s, "shr_b"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(s < 0) throw new Error("h$ghcjsbn_shr_b: negative operand"); ++#endif ++ var i, v1, v2, l = b[0], sl = (s / GHCJSBN_BITS)|0, t = [0]; ++ l -= sl; ++ if(l <= 0) { ++ t[0] = 0; ++ } else { ++ var sb1 = s % GHCJSBN_BITS, sb2 = GHCJSBN_BITS - sb1, m = (1<> sb1, v; ++ for(i = 1; i < l; i++) { ++ v = b[i + sl + 1]; ++ t[i] = ((v&m) << sb2)|c; ++ c = v >> sb1; ++ } ++ if(c !== 0) { ++ t[l] = c; ++ t[0] = l; ++ } else { ++ t[0] = l - 1; ++ } ++ } ++ ASSERTVALID_B(t, "shr_b result"); ++ return t; ++} ++ ++// t = b >> s :: BigNat -> BigNat -> Int -> IO () ++function h$ghcjsbn_shrTo_b(t, b, s) { ++ ASSERTVALID_B(b, "shrTo_b"); ++ ASSERTVALID_S(s, "shrTo_b"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(s < 0) throw new Error("h$ghcjsbn_shrTo_b: negative operand"); ++#endif ++ var i, v1, v2, l = b[0], sl = (s / GHCJSBN_BITS)|0; ++ t[0] = 0; ++ l -= sl; ++ if(l <= 0) { ++ t[0] = 0; ++ } else { ++ var sb1 = s % GHCJSBN_BITS, sb2 = GHCJSBN_BITS - sb1, m = (1<> sb1, v; ++ for(i = 1; i < l; i++) { ++ v = b[i + sl + 1]; ++ t[i] = ((v&m) << sb2)|c; ++ c = v >> sb1; ++ } ++ if(c !== 0) { ++ t[l] = c; ++ t[0] = l; ++ } else { ++ t[0] = l - 1; ++ } ++ } ++ ASSERTVALID_B(t, "shrTo_b result"); ++} ++ ++function h$ghcjsbn_shr_neg_b(b, s) { ++ throw new Error ("shr_neg_b not implemented"); ++} ++ ++// b << s :: BigNat -> Int -> BigNat ++function h$ghcjsbn_shl_b(b, s) { ++ ASSERTVALID_B(b, "shl_b"); ++ ASSERTVALID_S(s, "shl_b"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(s < 0) throw new Error("h$ghcjsbn_shl_b: negative operand"); ++#endif ++ var sl = (s / GHCJSBN_BITS)|0; ++ var sb1 = s % GHCJSBN_BITS, sb2 = GHCJSBN_BITS - sb1; ++ // mask wrong ++ var l = b[0]; ++ if(l === 0) return h$ghcjsbn_zero_b; ++ var c = 0, i, v, m = (1 <> sb2; ++ } ++ if(c !== 0) { ++ t[l+sl+1] = c; ++ t[0] = l + sl + 1; ++ } else { ++ t[0] = l + sl; ++ } ++ ASSERTVALID_B(t, "shl_b result"); ++ return t; ++} ++ ++// t = b << s :: BigNat -> BigNat -> Int -> IO () ++function h$ghcjsbn_shlTo_b(t, b, s) { ++ ASSERTVALID_B(b, "shlTo_b"); ++ ASSERTVALID_S(s, "shlTo_b"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(s < 0) throw new Error("h$ghcjsbn_shlTo_b: negative operand"); ++#endif ++ var sl = (s / GHCJSBN_BITS)|0; ++ var sb1 = s % GHCJSBN_BITS, sb2 = GHCJSBN_BITS - sb1; ++ // mask wrong ++ var l = b[0], c = 0, i, v, m = (1 <> sb2; ++ } ++ if(c !== 0) { ++ t[l+sl+1] = c; ++ t[0] = l + sl + 1; ++ } else { ++ t[0] = l + sl; ++ } ++ ASSERTVALID_B(t, "shlTo_b result"); ++} ++ ++ ++// t = b >> (GHCJSBN_BITS * s) :: BigNat -> BigNat -> Int ++function h$ghcjsbn_shrTo_limbs_b(t, b, s) { ++ ASSERTVALID_B(b, "shrTo_limbs_b"); ++ ASSERTVALID_S(s, "shrTo_limbs_b"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(s < 0) throw new Error("h$ghcjsbn_shrTo_limbs_b: negative operand"); ++#endif ++ var l = b[0], l1 = l - s, i; ++ if(l1 < 1) { ++ t[0] = 0; ++ } else { ++ t[0] = l1; ++ for(i = 1; i <= l1; i++) t[i] = b[i+s]; ++ } ++ ASSERTVALID_B(t, "shrTo_limbs_b result"); ++} ++ ++// t = b << (GHCJSBN_BITS * s) :: BigNat -> BigNat -> Int ++function h$ghcjsbn_shlTo_limbs_b(t, b, s) { ++ ASSERTVALID_B(b, "shlTo_limbs_b"); ++ ASSERTVALID_S(s, "shlTo_limbs_b"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(s < 0) throw new Error("h$ghcjsbn_shlTo_limbs_b: negative operand"); ++#endif ++ var l = b[0], l1 = l + s, i; ++ if(l === 0) { ++ t[0] = 0; ++ } else { ++ t[0] = l1; ++ for(i = 1; i <= s; i++) t[i] = 0; ++ for(i = s+1; i <= l1; i++) t[i] = b[i-s]; ++ } ++ ASSERTVALID_B(t, "shlTo_limbs_b result"); ++} ++ ++function h$ghcjsbn_nbits_b(b) { ++ ASSERTVALID_B(b, "nbits_b"); ++ var l = b[0], c = 0, s, t; ++ if(l === 0) { ++ return 0; ++ } else { ++ var r = ((l-1)*GHCJSBN_BITS) + h$ghcjsbn_nbits_s(b[l]); ++ ASSERTVALID_S(r, "nbits_b result"); ++ return r; ++ } ++} ++ ++function h$ghcjsbn_nbits_s(s) { ++ ASSERTVALID_S(s, "nbits_s"); ++ var c = 1, t; ++ if((t = s >>> 16) != 0) { s = t; c += 16; } ++ if((t = s >> 8) != 0) { s = t; c += 8; } ++ if((t = s >> 4) != 0) { s = t; c += 4; } ++ if((t = s >> 2) != 0) { s = t; c += 2; } ++ if((t = s >> 1) != 0) { s = t; c += 1; } ++ ASSERTVALID_S(c, "nbits_s result"); ++ return c; ++} ++ ++// BigNat -> Word -> String ++function h$ghcjsbn_showBase(b, base) { ++ ASSERTVALID_B(b, "showBase"); ++ ASSERTVALID_S(base, "showBase"); ++ if(h$ghcjsbn_cmp_bb(b, h$ghcjsbn_zero_b) === GHCJSBN_EQ) { ++ return "0"; ++ } else { ++ return h$ghcjsbn_showBase_rec(b, base, Math.log(base), 0); ++ } ++} ++ ++function h$ghcjsbn_showBase_rec(b, base, logBase, pad) { ++ var bits = h$ghcjsbn_nbits_b(b), r; ++ // h$log("[" + b.join(",") + "] bits: " + bits); ++ if(h$ghcjsbn_cmp_bb(b, h$ghcjsbn_two31_b) === GHCJSBN_LT) { ++ // convert short numbers to int and show in base ++ var ti = h$ghcjsbn_toInt_b(b); ++ // h$log("############# got base limb: " + ti); ++ r = ti === 0 ? "" : ti.toString(base); ++ } else { ++ // divide and conquer for long numbers ++ var digits = Math.floor(bits * 0.6931471805599453 / logBase); ++ var d2 = Math.round(digits/2), p, q = [], r = []; ++ p = h$ghcjsbn_pow_ww(base, d2); ++ h$ghcjsbn_quotRem_bb(q, r, b, p); ++ r = h$ghcjsbn_showBase_rec(q, base, logBase, 0) + ++ h$ghcjsbn_showBase_rec(r, base, logBase, d2); ++ } ++ var rl = r.length; ++ if(rl < pad) { ++ while(rl <= pad-8) { r = "00000000" + r; rl += 8; } ++ switch(pad-rl) { ++ case 1: r = "0" + r; break; ++ case 2: r = "00" + r; break; ++ case 3: r = "000" + r; break; ++ case 4: r = "0000" + r; break; ++ case 5: r = "00000" + r; break; ++ case 6: r = "000000" + r; break; ++ case 7: r = "0000000" + r; break; ++ } ++ } ++ return r; ++} ++ ++// BigNat -> String (decimal) ++function h$ghcjsbn_show(b) { ++ throw new Error("show not implemented"); ++ // digits = ++} ++ ++// BigNat -> String ++function h$ghcjsbn_showHex(b) { ++ throw new Error("showHex not implemented"); ++} ++ ++// s = b[l - 1]; ++ ++// normalize a number to length l by stripping unused leading digits ++/* ++function h$ghcjsbn_normalize(b, l) { ++ var d = b.length - l; ++ while(d--) b.pop(); ++} ++ ++// normalize a number by stripping leading zeroes ++function h$ghcjsbn_normalize0(b) { ++ var l = b.length; ++ while(b[--l] === 0) b.pop(); ++} ++*/ ++// t = b :: BigNat -> BigNat -> Int, returns length of t ++function h$ghcjsbn_copy(t, b) { ++ ASSERTVALID_B(b, "copy"); ++ var l = b[0]; ++ for(var i = 0; i <= l; i++) { ++ t[i] = b[i]; ++ } ++ return l; ++} ++ ++// BigNat -> Int -> Bool ++// test if bit n is set in b (least significant bit is 0) ++function h$ghcjsbn_testBit_b(b, n) { ++ ASSERTVALID_B(b, "testBit_b"); ++ ASSERTVALID_S(n, "testBit_b"); ++ var limb = (n / GHCJSBN_BITS)|0; ++ if(limb >= b[0]) { ++ return false; ++ } else { ++ var d = b[limb]; ++ var bit = n - (GHCJSBN_BITS * limb); ++ return (b[limb] & (1 << bit)) !== 0; ++ } ++} ++ ++function h$ghcjsbn_popCount_b(b) { ++ ASSERTVALID_B(b, "popCount_b"); ++ var c = 0, l = b[0]; ++ while(l > 0) { ++ c += h$popCnt32(b[l--]); ++ } ++ return c; ++} ++ ++// t = b1 ^ b2 :: BigNat -> BigNat -> BigNat -> Int ++// returns length of t ++function h$ghcjsbn_xor_bb(b1, b2) { ++ ASSERTVALID_B(b1, "xor_bb b1"); ++ ASSERTVALID_B(b2, "xor_bb b2"); ++ var i, lmin, lmax, blmax, l1 = b1[0], l2 = b2[0], t = [0]; ++ if(l1 <= l2) { ++ lmin = l1; ++ lmax = l2; ++ blmax = b2; ++ } else { ++ lmin = l2; ++ lmax = l1; ++ blmax = b1; ++ } ++ for(i = 1; i <= lmin; i++) { ++ t[i] = b1[i] ^ b2[i]; ++ } ++ for(i = lmin + 1; i <= lmax; i++) { ++ t[i] = blmax[i]; ++ } ++ while(lmax > 0 && t[lmax] === 0) lmax--; ++ t[0] = lmax; ++ ASSERTVALID_B(t, "xor_bb result"); ++ return t; ++} ++ ++// b1 | b2 :: BigNat -> BigNat -> BigNat ++function h$ghcjsbn_or_bb(b1, b2) { ++ ASSERTVALID_B(b1, "or_bb b1"); ++ ASSERTVALID_B(b2, "or_bb b2"); ++ var i, lmin, lmax, blmax, l1 = b1[0], l2 = b2[0], t = [0]; ++ if(l1 <= l2) { ++ lmin = l1; ++ lmax = l2; ++ blmax = b2; ++ } else { ++ lmin = l2; ++ lmax = l1; ++ blmax = b1; ++ } ++ for(i = 1; i <= lmin; i++) { ++ t[i] = b1[i] | b2[i]; ++ } ++ for(i = lmin + 1; i <= lmax; i++) { ++ t[i] = blmax[i]; ++ } ++ t[0] = lmax; ++ ASSERTVALID_B(t, "or_bb result"); ++ return t; ++} ++ ++// b1 & b2 :: BigNat -> BigNat -> BigNat ++function h$ghcjsbn_and_bb(b1, b2) { ++ ASSERTVALID_B(b1, "and_bb b1"); ++ ASSERTVALID_B(b2, "and_bb b2"); ++ var i, lmin, l1 = b1[0], l2 = b2[0], t = [0]; ++ lmin = l1 <= l2 ? l1 : l2; ++ for(i = 1; i <= lmin; i++) { ++ t[i] = b1[i] & b2[i]; ++ } ++ while(lmin > 0 && t[lmin] === 0) lmin--; ++ t[0] = lmin; ++ ASSERTVALID_B(t, "and_bb result"); ++ return t; ++} ++ ++// b1 & (~b2) :: BigNat -> BigNat -> BigNat ++// fixme is this one correct? ++function h$ghcjsbn_andn_bb(b1, b2) { ++ ASSERTVALID_B(b1, "andn_bb b1"); ++ ASSERTVALID_B(b2, "andn_bb b2"); ++ var i, lmin, l1 = b1[0], l2 = b2[0], t = [0]; ++ if(l1 <= l2) { ++ for(i = 0; i <= l1; i++) t[i] = b1[i] & (~b2[i]); ++ } else { ++ for(i = 0; i <= l2; i++) t[i] = b1[i] & (~b2[i]); ++ for(i = l2+1; i <= l1; i++) t[i] = b1[i]; ++ } ++ while(l1 > 0 && t[l1] === 0) l1--; ++ t[0] = l1; ++ ASSERTVALID_B(t, "andn_bb result"); ++ return t; ++} ++ ++function h$ghcjsbn_toInt_b(b) { ++ ASSERTVALID_B(b, "toInt_b"); ++ var bl = b[0], r; ++ if(bl >= 2) { ++ r = (b[2] << GHCJSBN_BITS) | b[1]; ++ } else if(bl === 1) { ++ r = b[1]; ++ } else { ++ r = 0; ++ } ++ ASSERTVALID_S(r, "toInt_b result"); ++ return r; ++} ++ ++function h$ghcjsbn_toWord_b(b) { ++ ASSERTVALID_B(b, "toWord_b"); ++ var bl = b[0], w; ++ if(bl >= 2) { ++ w = (b[2] << GHCJSBN_BITS) | b[1]; ++ } else if(bl === 1) { ++ w = b[1]; ++ } else { ++ w = 0; ++ } ++ ASSERTVALID_W(w, "toWord_b result"); ++ return w; ++} ++ ++var h$integer_bigNatToWord64 = h$ghcjsbn_toWord64_b; ++var h$integer_word64ToBigNat = h$ghcjsbn_mkBigNat_ww; // fixme? ++ ++#if GHCJSBN_BITS == 28 ++function h$ghcjsbn_toWord64_b(b) { ++ ASSERTVALID_B(b, "toWord64_b"); ++ var len = b[0], w1, w2; ++ if(len < 2) { ++ w2 = 0; ++ w1 = (len === 1) ? b[1] : 0; ++ } else { ++ w1 = b[1] | (b[2] << 28); ++ if(len === 2) { ++ w2 = b[2] >>> 4; ++ } else { ++ w2 = (b[2] >>> 4) | (b[3] << 24); ++ } ++ } ++ ASSERTVALID_W(w2, "toWord64_b result w2"); ++ ASSERTVALID_W(w1, "toWord64_b result w1"); ++ RETURN_UBX_TUP2(w2, w1); ++} ++#else ++#error "no toWord64_b implementation for GHCJSBN_BITS" ++#endif ++ ++// BigNat -> Int -> IO () ++function h$ghcjsbn_toBigNat_s(b, s) { ++ ASSERTVALID_S(s, "toBigNat_s"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(s < 0) { ++ throw new Error("h$ghcjsbn_toBigNat_s: negative operand"); ++ } ++#endif ++ if(s === 0) { ++ b[0] = 0; ++ } else if(s <= GHCJSBN_MASK) { ++ b[0] = 1; ++ b[1] = s; ++ } else { ++ b[0] = 2; ++ b[1] = s & GHCJSBN_MASK; ++ b[2] = s >> GHCJSBN_MASK; ++ } ++ ASSERTVALID_B(b, "toBigNat_s result"); ++} ++ ++// BigNat -> Word -> IO () ++function h$ghcjsbn_toBigNat_w(b, w) { ++ ASSERTVALID_W(w, "toBigNat_w"); ++ if(w === 0) { ++ b[0] = 0; ++ } else if(w > 0 && w <= GHCJSBN_MASK) { ++ b[0] = 1; ++ b[1] = w; ++ } else { ++ b[0] = 2; ++ b[1] = w & GHCJSBN_MASK; ++ b[2] = w >>> GHCJSBN_BITS; ++ } ++ ASSERTVALID_B(b, "toBigNat_w result"); ++} ++ ++function h$ghcjsbn_mkBigNat_w(w) { ++ ASSERTVALID_W(w, "mkBigNat_w"); ++ var r; ++ if(w === 0) r = h$ghcjsbn_zero_b; ++ else if(w === 1) r = h$ghcjsbn_one_b; ++ else if(w > 0 && w <= GHCJSBN_MASK) r = [1,w]; ++ else r = [2, w & GHCJSBN_MASK, w >>> GHCJSBN_BITS]; ++ ASSERTVALID_B(r, "mkBigNat_w result"); ++ // ASSERTVALID_B(h$ghcjsbn_zero_b, "mkBigNat_w zero"); ++ return r; ++} ++ ++#if GHCJSBN_BITS == 28 ++function h$ghcjsbn_mkBigNat_ww(hw, lw) { ++ ASSERTVALID_W(hw, "mkBigNat_ww hw"); ++ ASSERTVALID_W(lw, "mkBigNat_ww lw"); ++ var r; ++ if(hw === 0) r = h$ghcjsbn_mkBigNat_w(lw); ++ else { ++ var w1 = lw & GHCJSBN_MASK; ++ var w2 = (lw >>> GHCJSBN_BITS) | ((hw << 4) & GHCJSBN_MASK); ++ var w3 = hw >>> 24; ++ if(w3 === 0) { ++ r = [2, w1, w2]; ++ } else { ++ r = [3, w1, w2, w3]; ++ } ++ } ++ ASSERTVALID_B(r, "mkBigNat_ww result"); ++ return r; ++} ++ ++ ++// fixme remove after reboot ++var h$ghcjsbn_toBigNat_ww = h$ghcjsbn_mkBigNat_ww; ++ ++/* fixme re-enable after reboot ++function h$ghcjsbn_toBigNat_ww(b, hw, lw) { ++ ASSERTVALID_W(hw, "toBigNat_ww hw"); ++ ASSERTVALID_W(lw, "toBigNat_ww lw"); ++ if(hw === 0) h$ghcjsbn_toBigNat_w(b, lw); ++ else { ++ var w1 = lw & GHCJSBN_MASK; ++ var w2 = (lw >>> GHCJSBN_BITS) | ((hw << 4) & GHCJSBN_MASK); ++ var w3 = hw >>> 24; ++ if(w3 === 0) { ++ r[0] = 2; ++ r[1] = w1; ++ r[2] = w2; ++ } else { ++ r[0] = 3; ++ r[1] = w1; ++ r[2] = w2; ++ r[3] = w3; ++ } ++ } ++} ++*/ ++#else ++#error "no mkBigNat_ww implementation for specified GHCJSBN_BITS" ++#endif ++ ++// fixme remove later ++var h$integer_mkInteger = h$ghcjsbn_mkInteger; ++ ++#if GHCJSBN_BITS == 28 ++function h$ghcjsbn_mkInteger(nonNeg, xs) { ++ // fixme write proper optimized version ++ var r = [0], s = 0, t; ++ while(IS_CONS(xs)) { ++ t = h$ghcjsbn_shl_b(h$ghcjsbn_mkBigNat_w(UNWRAP_NUMBER(CONS_HEAD(xs))), s); ++ h$ghcjsbn_addTo_bb(r, t); ++ s += 31; ++ xs = CONS_TAIL(xs); ++ } ++ if(nonNeg) { ++ if(h$ghcjsbn_cmp_bb(r, h$ghcjsbn_two31_b) === GHCJSBN_LT) { ++ return MK_INTEGER_S(h$ghcjsbn_toInt_b(r)); ++ } else { ++ return MK_INTEGER_Jp(r); ++ } ++ } else { ++ var c = h$ghcjsbn_cmp_bb(r, h$ghcjsbn_two31_b); ++ if(c === GHCJSBN_GT) { ++ return MK_INTEGER_Jn(r); ++ } else if(c === GHCJSBN_EQ) { ++ return h$ghcjsbn_negTwo31_i; ++ } else { ++ return MK_INTEGER_S(-h$ghcjsbn_toInt_b(r)); ++ } ++ } ++/* var r = h$ghcjsbn_mkBigNat_w(0), l = 0, s = 0, y, t; ++ while(IS_CONS(xs)) { ++ l++; ++ y = UNWRAP_NUMBER(CONS_HEAD(xs)); ++ r[++l] = (y << s | c) & GHCJSBN_MASK; ++ c = y >>> s; ++ xs = CONS_TAIL(xs); ++ s += 3; ++ l++; ++ if(s > GHCJSBN_BITS) { ++ s -= GHCJSBN_BITS; ++ r[++l] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ } ++ if(c !== 0) r[++l] = ++ while( ++ if(l === 0) { ++ return MK_INTEGER_S(0); ++ } else if(l === 1) { ++ ++ } else if(l === 2) { ++ ++ } */ ++} ++#else ++error "no mkInteger implementation for specified GHCJSBN_BITS" ++#endif ++ ++// BigNat -> Int -> Int ++function h$ghcjsbn_indexBigNat(b, i) { ++ ASSERTVALID_B(b, "indexBigNat"); ++ ASSERTVALID_S(i, "indexBigNat"); ++ var bl = b[0]; ++ return i >= bl ? 0 : b[i+1]; ++} ++ ++// BigNat -> Word -> Int (Ordering) ++function h$ghcjsbn_cmp_bw(b, w) { ++ ASSERTVALID_B(b, "cmp_bw"); ++ ASSERTVALID_W(w, "cmp_bw"); ++ var w1 = w & GHCJSBN_MASK, w2 = w >>> GHCJSBN_BITS, bl = b[0]; ++ if(w2 === 0) { ++ if(bl === 0) { ++ return w1 > 0 ? GHCJSBN_LT : GHCJSBN_EQ; ++ } else if(bl === 1) { ++ var bw = b[1]; ++ return bw > w1 ? GHCJSBN_GT : (bw === w1 ? GHCJSBN_EQ : GHCJSBN_LT); ++ } else { ++ return GHCJSBN_GT; ++ } ++ } else { ++ if(bl < 2) { ++ return GHCJSBN_LT; ++ } else if(bl > 2) { ++ return GHCJSBN_GT; ++ } else { ++ var bw1 = b[1], bw2 = b[2]; ++ return (bw2 > w2) ? GHCJSBN_GT ++ : (bw2 < w2 ? GHCJSBN_LT ++ : (bw1 > w1 ? GHCJSBN_GT ++ : (bw1 < w1 ? GHCJSBN_LT ++ : GHCJSBN_EQ))); ++ } ++ } ++} ++ ++/* ++function h$ghcjsbn_gt_bw(b, w) { ++ var r = h$ghcjsbn_gt_bw0(b,w); ++ h$log("gt_bw result: " + r); ++ return r; ++} ++*/ ++ ++function h$ghcjsbn_gt_bw(b, w) { ++ ASSERTVALID_B(b, "gt_bw"); ++ ASSERTVALID_W(w, "gt_bw"); ++ var bl = b[0]; ++ if(bl > 2) return true; ++ else if(bl === 0) return false; ++ else if(bl === 1) return w >= 0 && b[1] > w; ++ else { // bl === 2 ++ var wh = w >>> GHCJSBN_BITS, wl = w & GHCJSBN_MASK, b2 = b[2]; ++ // var r = (wh > b2 || ((wh === b2) && wl > b[1])); ++ // h$log("r: " + r + " " + wh + " " + wl + " " ); ++ return (b2 > wh || ((wh === b2) && b[1] > wl)); ++ } ++} ++ ++// BigNat -> BigNat -> Bool ++function h$ghcjsbn_eq_bb(b1, b2) { ++ ASSERTVALID_B(b1, "eq_bb"); ++ ASSERTVALID_B(b2, "eq_bb"); ++ var bl1 = b1[0], bl2 = b2[0]; ++ if(bl1 !== bl2) { ++ return false; ++ } else { ++ for(var i = bl1; i >= 1; i--) { ++ var bw1 = b1[i], bw2 = b2[i]; ++ if(bw1 !== bw2) return false; ++ } ++ } ++ return true; // GHCJSBN_EQ; ++} ++ ++// BigNat -> BigNat -> Bool ++function h$ghcjsbn_neq_bb(b1, b2) { ++ ASSERTVALID_B(b1, "neq_bb"); ++ ASSERTVALID_B(b2, "neq_bb"); ++ var bl1 = b1[0], bl2 = b2[0]; ++ if(bl1 !== bl2) { ++ return true; ++ } else { ++ for(var i = bl1; i >= 1; i--) { ++ var bw1 = b1[i], bw2 = b2[i]; ++ if(bw1 !== bw2) return true; ++ } ++ } ++ return false; ++} ++ ++// BigNat -> BigNat -> Bool ++/* ++function h$ghcjsbn_eq_bw(b, w) { ++ var r = h$ghcjsbn_eq_bw0(b, w); ++ return r; ++} ++*/ ++function h$ghcjsbn_eq_bw(b, w) { ++ ASSERTVALID_B(b, "eq_bw"); ++ ASSERTVALID_W(w, "eq_bw"); ++ var w1 = w & GHCJSBN_MASK, w2 = w >>> GHCJSBN_BITS, bl = b[0]; ++ if(w2 === 0) { ++ if(w1 === 0) { ++ return bl === 0; ++ } else { ++ return bl === 1 && b[1] === w; ++ } ++ } else { ++ return bl === 2 && b[1] === w1 && b[2] === w2; ++ } ++} ++ ++// BigNat -> Bool ++function h$ghcjsbn_isZero_b(b) { ++ ASSERTVALID_B(b, "isZero_b"); ++ return b[0] === 0; ++} ++ ++// BigNat -> Int ++function h$ghcjsbn_isNull_b(b) { ++ return b[0] === -1; ++} ++ ++// 1 << n ++function h$ghcjsbn_bitBigNat(n) { ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(n < 0) { ++ throw new Error("bitBigNat: argument must be positive"); ++ } ++#endif ++ if(n === 0) { ++ r = h$ghcjsbn_one_b; ++ } else if(n < GHCJSBN_BITS) { ++ r = [1, 1 << n]; ++ } else { ++ var l = (n / GHCJSBN_BITS)|0; ++ var r = [l+1]; ++ for(var i = 1; i<= l; i++) r[i] = 0; ++ r[l+1] = 1 << (n - (GHCJSBN_BITS * l)); ++ } ++ ASSERTVALID_B(r, "bitBigNat result"); ++ return r; ++} ++ ++ ++// Integer -> Int ++// assumes argument is strictly positive ++function h$ghcjsbn_integerLog2(i) { ++ ASSERTVALID_I(i, "integerLog2"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++/* if(h$ghcjsbn_cmp_ii(i, h$ghcjsbn_zero_i) !== GHCJSBN_GT) { ++ throw new Error("integerLog2: argument must be positive"); ++ } */ ++#endif ++ if(IS_INTEGER_S(i)) { ++ return h$ghcjsbn_nbits_s(INTEGER_S_DATA(i)); ++ } else { ++ return h$ghcjsbn_nbits_b(INTEGER_J_DATA(i)); ++ } ++} ++ ++// Integer -> Int ++// returns negation of result if integer is exactly a power of two ++function h$ghcjsbn_integerLog2IsPowerOf2(i) { ++ ASSERTVALID_I(i, "integerLog2IsPowerOf2"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++/* if(h$ghcjbn_cmp_ii(i, h$ghcjsbn_zero_i) !== GHCJSBN_GT) { ++ throw new Error("integerLog2IsPowerOf2: argument must be positive"); ++ } */ ++#endif ++ var nb; ++ if(IS_INTEGER_S(i)) { ++ var sd = INTEGER_S_DATA(i); ++ ASSERTVALID_S(sd, "integerLog2IsPowerOf2 sd"); ++ nb = h$ghcjsbn_nbits_s(sd); ++ return ((sd === 1 << nb) ? -nb : nb); ++ } else { ++ var bd = INTEGER_J_DATA(i); ++ ASSERTVALID_B(bd, "integerLog2IsPowerOf2 bd"); ++ nb = h$ghcjsbn_nbits_b(bd); ++ var i, bl = (nb / GHCJSBN_BITS) | 0, lb = nb - GHCJSBN_BITS * bl, l = bd[bl+1]; ++ if(l !== (1 << lb)) return nb; ++ for(i = bl; i >= 1; i--) { ++ if(bd[i] !== 0) return nb; ++ } ++ return -nb; ++ } ++} ++ ++// BigNat? -> Int ++function h$ghcjsbn_isValid_b(b) { ++ if(!Array.isArray(b)) return 0; ++ if(b.length < 1) return 0; ++ var bl = b[0], w; ++ if(b.length < (bl+1)) return 0; ++ for(var i = 0; i <= bl; i++) { ++ w = b[i]; ++ if(typeof w !== 'number' || (w & GHCJSBN_MASK) !== w) return 0; ++ } ++ return 1; ++} ++ ++// BigNat -> Integer ++function h$ghcjsbn_toInteger_b(b) { ++ ASSERTVALID_B(b, "toInteger_b"); ++ if(h$ghcjsbn_cmp_bb(b, h$ghcjsbn_two31_b) === GHCJSBN_LT) { ++ return MK_INTEGER_S(h$ghcjsbn_toInt_b(b)); ++ } else { ++ return MK_INTEGER_Jp(b); ++ } ++} ++ ++// BigNat -> Integer ++function h$ghcjsbn_toNegInteger_b(b) { ++ ASSERTVALID_B(b, "toNegInteger_b"); ++ var c = h$ghcjsbn_cmp_bb(b, h$ghcjsbn_two31_b); ++ if(c === GHCJSBN_LT) { ++ return MK_INTEGER_S(-h$ghcjsbn_toInt_b(b)); ++ } else if(c === GHCJSBN_EQ) { ++ return h$ghcjsbn_negTwo31_i; ++ } else { ++ return MK_INTEGER_Jn(b); ++ } ++} ++ ++// BigNat? -> Int ++// (can be called with invalid bignat) ++function h$ghcjsbn_sizeof_b(b) { ++ if(b.length < 1) return 0; ++ var bl = b[0]; ++ return Math.ceil((bl * GHCJSBN_BITS) / 32); ++} ++ ++// extract a word from a BigNat ++function h$ghcjsbn_index_b(b, w) { ++ throw new Error("index_b"); ++ ASSERTVALID_B(b, "index_b"); ++ ASSERTVALID_W(w, "index_b"); ++ var wbit = 32*w, len = b[0], limb = (wbit / GHCJSBN_BITS) | 0, lb = wbit - (limb * GHCJSBN_BITS); ++ var r = b[limb+1] >>> lb; ++/* if() { ++ ++ } */ ++ ASSERTVALID_W(r, "index_b result"); ++} ++ ++// Bool -> BigNat -> Double ++function h$ghcjsbn_toDouble_b(nonNeg, b) { ++ throw new Error("toDouble_b"); ++} ++ ++function h$ghcjsbn_byteArrayToBigNat(ba, len) { ++ throw new Error("h$ghcjsbn_byteArrayToBigNat not yet implemented"); ++} ++ ++function h$ghcjsbn_importBigNatFromAddr(a_d, a_o, len, msbf) { ++ throw new Error("h$ghcjsbn_importBigNatFromAddr not yet implemented"); ++} ++ ++function h$ghcjsbn_importBigNatFromByteArray(ba, ofs, len, msbf) { ++ throw new Error("h$ghcjsbn_importBigNatFromByteArray not yet implemented"); ++} ++ ++ ++////////////////////////////////////////////////////////////////////////////// ++// fixme move to primop places later ++ ++var h$integer_int64ToInteger = h$ghcjsbn_toInteger_s64; ++ ++function h$ghcjsbn_toInteger_s64(s_a, s_b) { ++ ASSERTVALID_S(s_a, "toInteger_s64 s_a"); ++ ASSERTVALID_S(s_b, "toInteger_s64 s_b"); ++ if(s_a === 0) { ++ if(s_b >= 0) { ++ return MK_INTEGER_S(s_b); ++ } else { ++ return MK_INTEGER_Jp(h$ghcjsbn_mkBigNat_w(s_b)); ++ } ++ } else if(s_a === -1) { ++ if(s_b < 0) { ++ return MK_INTEGER_S(s_b); ++ } else if(s_b === 0) { ++ return MK_INTEGER_Jn(h$ghcjsbn_mkBigNat_ww(1,0)); ++ } else { ++ return MK_INTEGER_Jn(h$ghcjsbn_mkBigNat_w(((~s_b)+1)|0)); ++ } ++ } else if(s_a > 0) { ++ return MK_INTEGER_Jp(h$ghcjsbn_mkBigNat_ww(s_a, s_b)); ++ } else { ++ if(s_b === 0) { // zero should be correct! ++ return MK_INTEGER_Jn(h$ghcjsbn_mkBigNat_ww(((~s_a)+1)|0, 0)); ++ } else { ++ return MK_INTEGER_Jn(h$ghcjsbn_mkBigNat_ww((~s_a)|0, ((~s_b)+1)|0)); ++ } ++ /* ++ if(s_b === 0) { // zero should be correct! ++ return MK_INTEGER_Jn(h$ghcjsbn_mkBigNat_ww(((~s_a)+1)|0, 0)); ++ } else { ++ return MK_INTEGER_Jn(h$ghcjsbn_mkBigNat_ww(~s_a, ((~s_b)+1)|0)); ++ } */ ++ } ++} ++ ++function h$decodeDoubleInt64(d) { ++ ASSERTVALID_D(d, "DoubleDecode_Int64"); ++ if(isNaN(d)) { ++ // RETURN_UBX_TUP4(null, -1572864, 0, 972); ++ RETURN_UBX_TUP3(972, -1572864, 0); ++ } ++ h$convertDouble[0] = d; ++ var i0 = h$convertInt[0], i1 = h$convertInt[1]; ++ var exp = (i1&2146435072)>>>20; ++ var ret1, ret2 = i0, ret3; ++ if(exp === 0) { // denormal or zero ++ if((i1&2147483647) === 0 && ret2 === 0) { ++ ret1 = 0; ++ ret3 = 0; ++ } else { ++ h$convertDouble[0] = d*9007199254740992; ++ i1 = h$convertInt[1]; ++ ret1 = (i1&1048575)|1048576; ++ ret2 = h$convertInt[0]; ++ ret3 = ((i1&2146435072)>>>20)-1128; ++ } ++ } else { ++ ret3 = exp-1075; ++ ret1 = (i1&1048575)|1048576; ++ } ++ // negate mantissa for negative input ++ if(d < 0) { ++ if(ret2 === 0) { ++ ret1 = ((~ret1) + 1) | 0; ++ // ret2 = 0; ++ } else { ++ ret1 = ~ret1; ++ ret2 = ((~ret2) + 1) | 0; ++ } ++ } ++ // prim ubx tup returns don't return the first value! ++ RETURN_UBX_TUP3(ret3,ret1,ret2); ++} ++ ++// fixme remove this once rebooted ++function h$primop_DoubleDecode_Int64Op(d) { ++ ASSERTVALID_D(d, "DoubleDecode_Int64"); ++ if(isNaN(d)) { ++ // RETURN_UBX_TUP4(null, -1572864, 0, 972); ++ RETURN_UBX_TUP4(null, -1572864, 0, 972); ++ } ++ h$convertDouble[0] = d; ++ var i0 = h$convertInt[0], i1 = h$convertInt[1]; ++ var exp = (i1&2146435072)>>>20; ++ var ret1, ret2 = i0, ret3; ++ if(exp === 0) { // denormal or zero ++ if((i1&2147483647) === 0 && ret2 === 0) { ++ ret1 = 0; ++ ret3 = 0; ++ } else { ++ h$convertDouble[0] = d*9007199254740992; ++ i1 = h$convertInt[1]; ++ ret1 = (i1&1048575)|1048576; ++ ret2 = h$convertInt[0]; ++ ret3 = ((i1&2146435072)>>>20)-1128; ++ } ++ } else { ++ ret3 = exp-1075; ++ ret1 = (i1&1048575)|1048576; ++ } ++ // negate mantissa for negative input ++ if(d < 0) { ++ if(ret2 === 0) { ++ ret1 = ((~ret1) + 1) | 0; ++ // ret2 = 0; ++ } else { ++ ret1 = ~ret1; ++ ret2 = ((~ret2) + 1) | 0; ++ } ++ } ++ // prim ubx tup returns don't return the first value! ++ RETURN_UBX_TUP4(null,ret1,ret2,ret3); ++} ++ ++function h$ghcjsbn_encodeDouble_b(pos, b, e) { ++ ASSERTVALID_B(b, "encodeDouble_b"); ++ ASSERTVALID_S(e, "encodeDouble_b"); ++ if(e >= 972) { ++ return pos ? Infinity : -Infinity; ++ } ++ var ls = 1, bl = b[0], i, r = b[bl], mul = 1 << GHCJSBN_BITS, rmul = 1/mul, s = 1; ++ for(i = bl-1; i >= 1; i--) { ++/* if(e > GHCJSBN_BITS) { ++ e -= GHCJSBN_BITS; ++ s *= rmul; ++ r = r + s * b[i]; ++ } else { */ ++ r = r * mul + s * b[i]; ++// } ++ } ++ // h$log("remaning exp: " + e); ++ if(e > 600) { ++ r = r * Math.pow(2, e-600) * Math.pow(2,600); ++ } else if(e < -600) { ++ r = r * Math.pow(2, e+600) * Math.pow(2,-600); ++ } else { ++ r = r * Math.pow(2, e); ++ } ++ ASSERTVALID_D(r, "encodeDouble_b result"); ++ return pos ? r : -r; ++} ++ ++function h$ghcjsbn_toDouble_b(nonNeg, b) { ++ return h$ghcjsbn_encodeDouble_b(nonNeg, b, 0); ++} ++ ++// fixme ++var h$ghcjsbn_encodeDouble_i = h$ghcjsbn_encodeDouble_s; ++ ++function h$ghcjsbn_encodeDouble_s(m, e) { ++ ASSERTVALID_S(m, "encodeDouble_s m"); ++ ASSERTVALID_S(e, "encodeDouble_s e"); ++ var r = m * Math.pow(2, e); ++ ASSERTVALID_D(r, "encodeDouble_s result"); ++ return r; ++} ++/* ++ GHCJS bignum library for integer-gmp package ++ ++ uses JavaScript arrays for big numbers ++ some algorithms and code based on JSBN by Tom Wu ++ ++ Copyright Luite Stegeman 2016 ++ */ ++ ++#include ++ ++// #define GHCJSBN_TRACE_INTEGER 1 ++#define GHCJSBN_ASSERT_INTEGER 1 ++ ++// bits per limb ++#define GHCJSBN_BITS 28 ++#define GHCJSBN_MASK 0xfffffff ++#define GHCJSBN_DV 0x10000000 ++ ++// BI_FP = 52 ++// BI_FP - GHCJSBN_BITS ++#define GHCJSBN_F1 24 ++// 2*GHCJSBN_BITS - BI_FP ++#define GHCJSBN_F2 4 ++// 2 ^ BI_FP ++#define GHCJSBN_FV 4503599627370496 ++ ++// values for the Haskell Ordering enum ++#define GHCJSBN_LT 0 ++#define GHCJSBN_EQ 1 ++#define GHCJSBN_GT 2 ++ ++var h$ghcjsbn_zero_i = MK_INTEGER_S(0); ++var h$ghcjsbn_one_i = MK_INTEGER_S(1); ++var h$ghcjsbn_negOne_i = MK_INTEGER_S(-1); ++var h$ghcjsbn_null_b = [-1]; ++var h$ghcjsbn_zero_b = [0]; ++var h$ghcjsbn_one_b = [1, 1]; ++var h$ghcjsbn_two31_b = [2, 0, 8]; ++var h$ghcjsbn_czero_b = [2, 268435455, 15]; ++var h$ghcjsbn_two31_i = MK_INTEGER_Jp(h$ghcjsbn_two31_b); ++var h$ghcjsbn_negTwo31_i = MK_INTEGER_S(-2147483648); ++ ++/****************************************************************************** ++ ++ Types used here: ++ - b BigNat: array of limbs (each a number of GHCJSBN_BITS bits) ++ - s Int: small integer in range -2^31 .. 2^31-1 ++ - w Word: small integer in range 0 .. 2^32-1, ++ values greater than 2^31-1 are stored as negative numbers ++ - i Integer: Haskell Integer heap object, see invariants ++ ++ Integer invariants: ++ - BigNat arrays do not have leading zeroes ++ - Jp > S > Jn ++ - S range: -2^31 .. 2^31-1 (-2147483648 .. 2147483647) ++ ++ ******************************************************************************/ ++ ++#ifdef GHCJSBN_ASSERT_INTEGER ++#define ASSERTVALID_I(i, msg) h$ghcjsbn_assertValid_i(i, msg) ++#define ASSERTVALID_B(d, msg) h$ghcjsbn_assertValid_b(d, msg) ++#define ASSERTVALID_S(s, msg) h$ghcjsbn_assertValid_s(s, msg) ++#define ASSERTVALID_W(w, msg) h$ghcjsbn_assertValid_w(w, msg) ++#define ASSERTVALID_D(d, msg) h$ghcjsbn_assertValid_d(d, msg) ++ ++// checks that the S,Jn,Jp constructor invariants hold ++function h$ghcjsbn_assertValid_i(b, msg) { ++ var sd, d, neg, i, n; ++ // check global constants for unwanted mutations ++ if(h$ghcjsbn_zero_b.length !== 1 || h$ghcjsbn_zero_b[0] !== 0) { ++ throw new Error("zero_b mutated"); ++ } ++ if(h$ghcjsbn_one_b.length !== 2 || h$ghcjsbn_one_b[0] !== 1 || h$ghcjsbn_one_b[1] !== 1) { ++ throw new Error("one_b mutated"); ++ } ++ if(IS_INTEGER_S(b)) { ++ sd = INTEGER_S_DATA(b); ++ if(typeof sd !== 'number') ++ throw new Error("invalid small integer: not a number"); ++ if((sd|0) !== sd) ++ throw new Error("invalid small integer: not a small int"); ++ } else { ++ if(IS_INTEGER_Jp(b)) { ++ neg = false; ++ } else if(IS_INTEGER_Jn(b)) { ++ neg = true; ++ } else { ++ throw new Error("invalid integer: unexpected constructor"); ++ } ++ d = INTEGER_J_DATA(b); ++ ASSERTVALID_B(d, "assertValid_i"); ++ if(d[0] < 2) ++ throw new Error("invalid big integer: array too short"); ++ if(d[0] === 2) { ++ if((d[2] >> (31-GHCJSBN_BITS)) === 0 || ++ (neg && d[2] === 0x20 && d[1] === 0)) ++ throw new Error("invalid big integer: in smallint range"); ++ } ++ // everything ok ++ } ++} ++ ++// checks invariant for big number ++function h$ghcjsbn_assertValid_b(d, msg) { ++ var i, n; ++ if(!Array.isArray(d)) ++ throw new Error("invalid big integer: not an array"); ++#ifdef GHCJSBN_TRACE_INTEGER ++ var jb = h$ghcjsbn_tmp_toJSBN(d); ++ if(msg) h$log("BigNat: " + msg + ": [" + d.join(",") + "] (" + jb.toString() + ")"); ++#endif ++ if(typeof d[0] !== 'number' || d[0] > (d.length-1)) ++ throw new Error("invalid big integer: incorrect number of limbs"); ++ if(d[0] > 0 && d[d[0]] === 0) ++ throw new Error("invalid big integer: leading zero"); ++ for(i = 1; i <= d[0]; i++) { ++ n = d[i]; ++ if(typeof n !== 'number') ++ throw new Error("invalid big integer: limb is not a number"); ++ if((n & GHCJSBN_MASK) !== n) ++ throw new Error("invalid big integer: limb out of range"); ++ } ++} ++ ++function h$ghcjsbn_assertValid_s(s, msg) { ++ if(typeof s !== 'number') ++ throw new Error("invalid int: not a number"); ++#ifdef GHCJSBN_TRACE_INTEGER ++ if(msg) h$log("Int: " + msg + ": " + s); ++#endif ++ if((s|0) !== s) ++ throw new Error("invalid int: not in smallint range"); ++} ++ ++function h$ghcjsbn_assertValid_w(w, msg) { ++ if(typeof w !== 'number') ++ throw new Error("invalid word: not a number"); ++#ifdef GHCJSBN_TRACE_INTEGER ++ if(msg) h$log("Word: " + msg + ": " + w); ++#endif ++ if((w|0) !== w) ++ throw new Error("invalid word: not in smallint range"); ++} ++ ++function h$ghcjsbn_assertValid_d(d, msg) { ++ if(typeof d !== 'number') ++ throw new Error("invalid double: not a number"); ++#ifdef GHCJSBN_TRACE_INTEGER ++ if(msg) h$log("Double: " + msg + " : " + d); ++#endif ++} ++ ++#else ++#define ASSERTVALID_I(i, msg) ++#define ASSERTVALID_B(b, msg) ++#define ASSERTVALID_S(s, msg) ++#define ASSERTVALID_W(w, msg) ++#define ASSERTVALID_D(d, msg) ++#endif ++ ++/******************************************************************************/ ++ ++/////////////////////////////////////////////////////////////////////////////// ++// the ghcjsbn_r functions operate on the raw array data directly ++/////////////////////////////////////////////////////////////////////////////// ++ ++#define GHCJS_SMALLPRIMES_MAX 1008 ++ ++var h$ghcjsbn_smallPrimes = ++ [ 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47 ++ , 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113 ++ , 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197 ++ , 199, 211, 223, 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281 ++ , 283, 293, 307, 311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379 ++ , 383, 389, 397, 401, 409, 419, 421, 431, 433, 439, 443, 449, 457, 461, 463 ++ , 467, 479, 487, 491, 499, 503, 509, 521, 523, 541, 547, 557, 563, 569, 571 ++ , 577, 587, 593, 599, 601, 607, 613, 617, 619, 631, 641, 643, 647, 653, 659 ++ , 661, 673, 677, 683, 691, 701, 709, 719, 727, 733, 739, 743, 751, 757, 761 ++ , 769, 773, 787, 797, 809, 811, 821, 823, 827, 829, 839, 853, 857, 859, 863 ++ , 877, 881, 883, 887, 907, 911, 919, 929, 937, 941, 947, 953, 967, 971, 977 ++ , 983, 991, 997 ++ ]; ++ ++var h$ghcjsbn_smallPrimesM = null; ++ ++function h$ghcjsbn_getSmallPrimesM() { ++ var a, i; ++ if(h$ghcjsbn_smallPrimesM === null) { ++ a = []; ++ for(i = 0; i < GHCJS_SMALLPRIMES_MAX; i++) { ++ a[i] = false; ++ } ++ for(i = h$ghcjsbn_smallPrimes.length - 1; i >= 0; i--) { ++ a[h$ghcjsbn_smallPrimes[i]] = true; ++ } ++ h$ghcjsbn_smallPrimesM = a; ++ } ++ return h$ghcjsbn_smallPrimesM; ++} ++ ++ ++// Int -> Int -> Bool ++// fixme: seed ++function h$ghcjsbn_isPrime_s(s, rounds) { ++ if(s < 2 || (s > 2 && ((s&1) === 1))) return false; ++ if(s <= GHCJS_SMALLPRIMES_MAX) { ++ return h$ghcjsbn_getSmallPrimesM()[s]; ++ } ++ throw new Error("isPrime_s"); ++} ++ ++// BigNat -> Int -> Bool ++// fixme: seed ++function h$ghcjsbn_isPrime_b(b, rounds) { ++ ASSERTVALID_B(b, "isPrime"); ++ throw new Error("isPrime_b"); ++} ++ ++// BigNat -> BigNat -> Bool ++/* ++function h$ghcjsbn_eq_bb(b1, b2) { ++ ASSERTVALID_B(b1, "eq_bb b1"); ++ ASSERTVALID_B(b2, "eq_bb b2"); ++ var l1 = b1.length, l2 = b2.length; ++ if(l1 !== l2) return false; ++ while(--l1 >= 0) { ++ if(b1[l1] !== b2[l1]) return false; ++ } ++ return true; ++} ++*/ ++ ++// BigNat -> BigNat -> Int (Ordering: LT,EQ,GT) ++function h$ghcjsbn_cmp_bb(b1, b2) { ++ ASSERTVALID_B(b1, "cmp_bb b1"); ++ ASSERTVALID_B(b2, "cmp_bb b2"); ++ var l1 = b1[0], l2 = b2[0], d1, d2; ++ if(l1 === l2) { ++ while(--l1 >= 0) { ++ d1 = b1[l1+1]; ++ d2 = b2[l1+1]; ++ if(d1 !== d2) return d1 < d2 ? GHCJSBN_LT : GHCJSBN_GT; ++ } ++ return GHCJSBN_EQ; ++ } else { ++ return l1 > l2 ? GHCJSBN_GT : GHCJSBN_LT; ++ } ++} ++ ++// fixed size tmp, these should not grow ++var h$ghcjsbn_tmp_2a = [0, 0, 0]; ++var h$ghcjsbn_tmp_2b = [0, 0, 0]; ++ ++// this is variable size scratch space ++var h$ghcjsbn_tmp_a = [0, 0, 0, 0, 0, 0, 0, 0]; ++var h$ghcjsbn_tmp_b = [0, 0, 0, 0, 0, 0, 0, 0]; ++ ++// b - w :: BigNat -> Word -> BigNat ++ ++function h$ghcjsbn_sub_bw(b, w) { ++ var a = h$ghcjsbn_tmp_2a; ++ h$ghcjsbn_toBigNat_w(a, w); ++ return h$ghcjsbn_sub_bb(b, a); ++} ++ ++// b - s :: BigNat -> Int -> BigNat ++// returns new BigNat, nullBigNat in case of underflow ++// returns size of t ++function h$ghcjsbn_sub_bs(b, s) { ++ ASSERTVALID_B(b, "sub_bs"); ++ ASSERTVALID_S(s, "sub_bs"); ++ var a, ms, r; ++ if(s < 0) { ++ if(s === -2147483648) { ++ r = h$ghcjsbn_add_bb(b, h$ghcjsbn_two31_b); ++ } else { ++ a = h$ghcjsn_tmp_2a; ++ h$ghcjsbn_toBigNat_s(a, -s); ++ r = h$ghcjsbn_add_bb(b, a); ++ } ++ } else { ++ a = h$ghcjsn_tmp_2a; ++ h$ghcjsbn_toBigNat_s(a, s); ++ r = h$ghcjsbn_sub_bb(b, a); ++ } ++ ASSERTVALID_B(r, "sub_bs result"); ++ return r; ++} ++ ++// t = b + w :: BigNat -> BigNat -> Word -> Int ++// returns size of t ++function h$ghcjsbn_add_bw(b, w) { ++ ASSERTVALID_B(b, "add_bw"); ++ ASSERTVALID_W(w, "add_bw"); ++ var a = h$ghcjsbn_tmp_2a; ++ h$ghcjsbn_toBigNat_w(a, w); ++ return h$ghcjsbn_add_bb(b, a); ++} ++ ++// t = b + s :: BigNat -> BigNat -> Int -> Int ++// returns size of t, nullBigNat in case of underflow ++function h$ghcjsbn_add_bs(b, s) { ++ ASSERTVALID_B(b, "add_bs"); ++ ASSERTVALID_S(s, "add_bs"); ++ var a, ms, r; ++ if(s < 0) { ++ if(s === -2147483648) { ++ r = h$ghcjsbn_sub_bb(b, h$ghcjsbn_two31_r); ++ } else { ++ ms = -s; ++ a = h$ghcjsbn_tmp_2a; ++ h$ghcjsbn_toBigNat_s(a, ms); ++ r = h$ghcjsbn_sub(b, a); ++ } ++ } else { ++ a = h$ghcjsbn_tmp_2a; ++ h$ghcjsbn_toBigNat_s(a, s); ++ r = h$ghcjsbn_add_bb(b, a); ++ } ++ ASSERTVALID_B(r, "add_bs result"); ++ return r; ++} ++ ++// t = b1 + b2 :: BigNat -> BigNat -> BigNat -> Int ++// returns size of t ++function h$ghcjsbn_add_bb(b1, b2) { ++ ASSERTVALID_B(b1, "add_bb b1"); ++ ASSERTVALID_B(b2, "add_bb b2"); ++ var i, c = 0, l1 = b1[0], l2 = b2[0], t = [0]; ++ var bl, lmin, lmax; ++ if(l1 <= l2) { ++ lmin = l1; ++ lmax = l2; ++ bl = b2; ++ } else { ++ lmin = l2; ++ lmax = l1; ++ bl = b1; ++ } ++ for(i=1;i<=lmin;i++) { ++ c += b1[i] + b2[i]; ++ t[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ for(i=lmin+1;i<=lmax;i++) { ++ c += bl[i]; ++ t[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ if(c !== 0) t[++lmax] = c; ++ t[0] = lmax; ++ ASSERTVALID_B(t, "add_bb result"); ++ return t; ++} ++ ++// b1 += b2 :: BigNat -> BigNat -> Int ++// returns new size of b1 ++function h$ghcjsbn_addTo_bb(b1, b2) { ++ ASSERTVALID_B(b1, "addTo_bb b1"); ++ ASSERTVALID_B(b2, "addTo_bb b2"); ++ var i, c = 0, l1 = b1[0], l2 = b2[0]; ++ if(l2 > l1) { ++ for(i = l1 + 1; i <= l2; i++) { ++ b1[i] = 0; ++ } ++ l1 = l2; ++ } ++ for(i = 1; i <= l2; i++) { ++ c += b1[i] + b2[i]; ++ b1[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ // propagate carry as long as needed ++ for(i = l2 + 1; c !== 0 && i <= l1; i++) { ++ c += b1[i]; ++ b1[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ if(c !== 0) { ++ b1[l1] = c; ++ b1[0] = l1+1; ++ } else { ++ b1[0] = l1; ++ } ++ ASSERTVALID_B(b1, "addTo_bb result"); ++} ++ ++// b1 - b2 :: BigNat -> BigNat -> BigNat ++// returns a new BigNat, nullBigNat in case of underflow ++function h$ghcjsbn_sub_bb(b1, b2) { ++ ASSERTVALID_B(b1, "sub_bb b1"); ++ ASSERTVALID_B(b2, "sub_bb b2"); ++ if(h$ghcjsbn_cmp_bb(b1,b2) === GHCJSBN_LT) { ++ return []; ++ } else { ++ var i, c = 0, l1 = b1[0], l2 = b2[0], t = [0]; ++ for(i = 1; i <= l2; i++) { ++ c += b1[i] - b2[i]; ++ t[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ for(i = l2 + 1; i <= l1; i++) { ++ c += b1[i]; ++ t[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ while(l1 > 0 && t[l1] === 0) l1--; ++ t[0] = l1; ++ ASSERTVALID_B(t, "sub_bb result"); ++ return t; ++ } ++} ++ ++// b1 -= b2 :: BigNat -> BigNat -> Int ++// returns size of t, b1 must be >= b2 ++function h$ghcjsbn_subTo_bb(b1, b2) { ++ ASSERTVALID_B(b1, "subTo_bb b1"); ++ ASSERTVALID_B(b2, "subTo_bb b2"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(h$ghcjsbn_cmp_bb(b1, b2) === GHCJSBN_LT) { ++ throw new Error("h$ghcjsbn_subTo_bb assertion failed: b1 >= b2"); ++ } ++#endif ++ var i, c = 0, l1 = b1[0], l2 = b2[0]; ++ for(i = 1; i <= l2; i++) { ++ c += b1[i] - b2[i]; ++ b1[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ for(i = l2 + 1; c !== 0 && i <= l1; i++) { ++ c += b1[i]; ++ b1[i] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ while(l1 > 0 && b1[l1] === 0) l1--; ++ b1[0] = l1; ++ ASSERTVALID_B(b1, "subTo_bb result"); ++} ++ ++// t = b1 / b2, BigNat -> BigNat -> BigNat -> Int (returns size of t) ++/* function h$ghcjsbn_div_bb(t, b1, b2) { ++ ++} ++ ++// t = b1 % b2, BigNat -> BigNat -> BigNat -> Int (returns size of t) ++function h$ghcjsbn_mod_bb(t, b1, b2) { ++ ++} ++ ++// b % s, BigNat -> Int -> Int ++function h$ghcjsbn_mod_bs(b, s) { ++ ++} ++*/ ++// BigNat -> Integer (nonnegative, known length) ++/* ++function h$ghcjsbn_wrap_pl(b, l) { ++ var lb; ++ if(l === 0) { ++ return MK_INTEGER_S(0); ++ } else if(l === 1) { ++ return MK_INTEGER_S(b[0]); ++ } else if(l === 2 && (b[1] >> (31 - GHCJSBN_BITS)) === 0) { ++ return MK_INTEGER_S((b[1] << GHCJSBN_BITS)|b[0]); ++ } else { ++ lb = b.length - l; ++ while(lb-- > 0) b.pop(); ++ return MK_INTEGER_Jp(b); ++ } ++} ++*/ ++// BigNat -> Integer (nonnegative) ++function h$ghcjsbn_wrap_p(b) { ++ var l = b[0]; ++ if(l === 0) { ++ return MK_INTEGER_S(0); ++ } else if(l === 1) { ++ return MK_INTEGER_S(b[1]); ++ } else if(l === 2 && (b[2] >> (31 - GHCJSBN_BITS)) === 0) { ++ return MK_INTEGER_S((b[2] << GHCJSBN_BITS)|b[1]); ++ } else { ++ return MK_INTEGER_Jp(b); ++ } ++} ++/* ++function h$ghcjsbn_wrap_nl(b, l) { ++ var lb; ++ if(l === 0) { ++ return MK_INTEGER_S(0); ++ } else if(l === 1) { ++ return MK_INTEGER_S(-b[0]); ++ } else if(l === 2 && ++ ((b[1] >> (31 - GHCJSN_BITS)) === 0 || ++ (b[1] === (1 << (31 - GHCJSBN_BITS)) && b[0] === 0))) { ++ return MK_INTEGER_S((-b[1]-b[0])|0); ++ } else { ++ lb = b.length - l; ++ while(lb-- > 0) b.pop(); ++ return MK_INTEGER_Jn(b); ++ } ++} ++*/ ++// BigNat -> Integer (nonnegative) ++function h$ghcjsbn_wrap_n(b) { ++ var l = b[0]; ++ if(l === 0) { ++ return MK_INTEGER_S(0); ++ } else if(l === 1) { ++ return MK_INTEGER_S(-b[1]); ++ } else if(l === 2 && ++ ((b[2] >> (31 - GHCJSN_BITS)) === 0 || ++ (b[2] === (1 << (31 - GHCJSBN_BITS)) && b[1] === 0))) { ++ return MK_INTEGER_S((-b[2]-b[1])|0); ++ } else { ++ return MK_INTEGER_Jn(b); ++ } ++} ++ ++// b1 *= b2 :: BigNat -> BigNat -> IO () ++function h$ghcjsbn_mulTo_bb(b1, b2) { ++ ASSERTVALID_B(b1, "mulTo_bb b1"); ++ ASSERTVALID_B(b2, "mulTo_bb b2"); ++ var t = h$ghcjsbn_mul_bb(b1, b2); ++ h$ghcjsbn_copy(b1, t); ++ ASSERTVALID_B(b1, "mulTo_bb result"); ++} ++ ++// b1 * b2 :: BigNat -> BigNat -> BigNat ++function h$ghcjsbn_mul_bb(b1, b2) { ++ ASSERTVALID_B(b1, "mul_bb b1"); ++ ASSERTVALID_B(b2, "mul_bb b2"); ++ var l1 = b1[0], l2 = b2[0]; ++/* if(l1 > 50 && l2 > 50) { ++ return h$ghcjsbn_mul_karatsuba_bb(b1, b2); ++ } fixme update this */ ++ var n = l1 + l2, i, t = [0]; ++ for(i = 1; i <= n; i++) t[i] = 0; ++ if(l1 > l2) { ++ for(i = 0; i < l2; i++) { ++ t[i + l1 + 1] = h$ghcjsbn_mul_limb(0, b1, b2[i+1], t, i, 0, l1); ++ } ++ } else { ++ for(i = 0; i < l1; i++) { ++ t[i + l2 + 1] = h$ghcjsbn_mul_limb(0, b2, b1[i+1], t, i, 0, l2); ++ } ++ } ++ for(i = l1 + l2; i > 0 && t[i] === 0; i--); ++ t[0] = i; ++ ASSERTVALID_B(t, "mul_bb result"); ++ return t; ++} ++ ++function h$ghcjsbn_mul_bw(b, w) { ++ ASSERTVALID_B(b, "mul_bw"); ++ ASSERTVALID_W(w, "mul_bw"); ++ var a = h$ghcjsbn_tmp_2a; ++ h$ghcjsbn_toBigNat_w(a, w); ++ var t = h$ghcjsbn_mul_bb(b, a); ++ ASSERTVALID_B(t, "mul_bw result"); ++ return t; ++} ++ ++ ++// karatzuba multiplication for long numbers ++function h$ghcjsbn_mul_karatsuba_bb(t, b1, b2) { ++ throw new Error("not yet updated"); ++ var l1 = b1.length, l2 = b2.length; ++ var i, b = (l1 < l2 ? l1 : l2) >> 1; ++ var x0 = [b], x1 = [l1-b], y0 = [b], y1 = [l2-b]; ++ for(i = 1; i <= b; i++) { ++ x0[i] = b1[i]; ++ y0[i] = b2[i]; ++ } ++ for(i = b + 1; i <= l1; i++) x1[i - b] = b1[i]; ++ for(i = b + 1; i <= l2; i++) y1[i - b] = b2[i]; ++ var z0 = h$ghcjsbn_mul_bb(x0, y0), z1, z2 = h$ghcjsbn_mul_bb(x1, y1); ++ ++ // compute z1 = (x1 + x0)(y1 + y0) - z2 - z0 ++ // (reusing x0 and y0 for (x1 + x0) and (y1 + y0)) ++ h$ghcjsbn_addTo_bb(x0, x1); ++ h$ghcjsbn_addTo_bb(y0, x1); ++ z1 = h$ghcjsbn_mul_bb(x0, y0); ++ h$ghcjsbn_subTo_bb(z1, z2); ++ h$ghcjsbn_subTo_bb(z1, z0); ++ // store shifted z2 in t ++ // fixme this looks wrong ++ for(i = 0; i < 2*b; i++) t[i] = 0; ++ l2 = z2.length; ++ for(i = 0; i < l2; i++) t[i+2*b] = z2[i]; ++ // compute shifted z1s = z1 * B ++ var z1s = []; ++ l1 = z1.length; ++ for(i = 0; i < b; i++) z1s[i] = 0; ++ for(i = 0; i < l1; i++) z1s[i+b] = z1[i]; ++ // add the results so that t = z2 * (2*B) + z1 * B + z0 ++ h$ghcjsbn_addTo_bb(t, z1s); ++ h$ghcjsbn_addTo_bb(t, z0); ++ return t; ++} ++ ++// from JSBN am3 ++// w_j += (x*b_i) ? ++/* c = carry? ++ n = iterations? ++ */ ++#if(GHCJSBN_BITS == 28) ++function h$ghcjsbn_mul_limb(i,b,x,w,j,c,n) { ++ // ASSERTVALID_B(b, "mul_limb b"); ++ // ASSERTVALID_B(w, "mul_limb w"); ++ var xl = x & 0x3fff, xh = x >> 14; ++ while(--n >= 0) { ++ var l = b[++i] & 0x3fff; ++ var h = b[i] >> 14; ++ var m = xh * l + h * xl; ++ l = xl *l + ((m & 0x3fff) << 14) + w[++j] + c; ++ c = (l >> 28) + (m >> 14) + xh * h; ++ // h$log("mul_limb: c: " + c + " l: " + l + " xh: " + xh + " h: " + h); ++ w[j] = l & 0xfffffff; ++ } ++ return c; ++} ++#else ++#error "no limb multiplication routine for specified GHCJSBN_BITS" ++#endif ++ ++// q = b1 / b2, r = b1 % b2 :: BigNat -> BigNat -> BigNat -> BigNat -> Int ++// b2 must be > 0 ++// returns length of r ++// d is normalized before return ++ ++/* ++ algorithm: ++ y = 0? ++ nsh = number of leading zeroes in most significant word ++ pm = positive modulus ++ pt = positive divident ++ y = tmp, shifted modulus ++ r = shifted divident ++ ys = length of y ++ y0 = biggest limb of y ++ yt = new estimated length of y? ++ */ ++ ++function h$ghcjsbn_quotRem_bb(q, r, b1, b2) { ++ ASSERTVALID_B(b1, "quotRem_bb b1"); ++ ASSERTVALID_B(b2, "quotRem_bb b2"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(h$ghcjsbn_cmp_bw(b2, 0) !== GHCJSBN_GT) { ++ throw new Error("h$ghcjsbn_quotRem_bb: operand not positive"); ++ } ++ #endif ++ if(q === null) q = h$ghcjsbn_tmp_a; ++ if(r === null) r = h$ghcjsbn_tmp_b; ++ var l1 = b1[0], l2 = b2[0], nsh, y = []; ++ if(l1 === 0) { ++ q[0] = 0; ++ r[0] = 0; ++ return; ++ } ++ if(h$ghcjsbn_cmp_bb(b1,b2) === GHCJSBN_LT) { ++ q[0] = 0; ++ h$ghcjsbn_copy(r, b1); ++ return; ++ } ++ nsh = GHCJSBN_BITS-h$ghcjsbn_nbits_s(b2[l2]); ++ ASSERTVALID_S(nsh, "quotRem_bb nsh"); ++ if(nsh !== 0) { ++ h$ghcjsbn_shlTo_b(y, b2, nsh); ++ h$ghcjsbn_shlTo_b(r, b1, nsh); ++ } else { ++ h$ghcjsbn_copy(y, b2); ++ h$ghcjsbn_copy(r, b1); ++ } ++ ASSERTVALID_B(y, "quotRem_bb y_0"); ++ ASSERTVALID_B(r, "quotRem_bb r_0"); ++ var ys = y[0], y0 = y[ys]; ++ var yt = y0*(1<1)?y[ys-1]>>GHCJSBN_F2:0); ++ var d1 = GHCJSBN_FV/yt, d2 = (1<= 0) { ++ // Estimate quotient digit ++ var qd = (r[(--i)+1]===y0)?GHCJSBN_MASK:Math.floor(r[i+1]*d1+(r[i]+e)*d2); ++ // h$log("i: " + i + " j: " + j + " qd: " + qd + " rdi: " + r[i+1] + " ys: " + ys); ++ // h$log("yd: [" + y.join(',') + "] rd: [" + r.join(',') + "]"); ++ var am = h$ghcjsbn_mul_limb(0, y, qd, r, j, 0, ys); ++ // h$log("am: " + am); ++ if((r[i+1] += am) < qd) { ++ // if((r[i+1] += h$ghcjsbn_mul_limb(0, y, qd, r, j, 0, ys)) < qd) { ++ h$ghcjsbn_shlTo_limbs_b(t, y, j); ++ h$ghcjsbn_subTo_bb(r, t); ++ // h$log("0. rdi: " + r[i+1] + " qd: " + qd); ++ while(r[i+1] < --qd) { ++ // h$log("1. rdi: " + r[i+1] + " qd: " + qd); ++ h$ghcjsbn_subTo_bb(r, t); ++ } ++ } ++ } ++ ASSERTVALID_B(r, "intermediate r"); ++ h$ghcjsbn_shrTo_limbs_b(q, r, ys); ++ r[0] = ys; ++ while(r[r[0]] === 0 && r[0] > 0 && r[0]--); ++ if(nsh !== 0) { ++ var r0 = []; ++ h$ghcjsbn_copy(r0, r); ++ h$ghcjsbn_shrTo_b(r, r0, nsh); ++ } ++ ASSERTVALID_B(q, "quotRem_bb result q"); ++ ASSERTVALID_B(r, "quotRem_bb result r"); ++} ++ ++// b % w , q = b / w :: BigNat -> BigNat -> Word -> Word ++function h$ghcjsbn_quotRem_bw(q, b, w) { ++ ASSERTVALID_B(b, "quotRem_bw"); ++ ASSERTVALID_W(w, "quotRem_bw"); ++ var a = h$ghcjsbn_tmp_2a; ++ h$ghcjsbn_toBigNat_w(a, w); ++/* if(w === 0) { ++ a[0] = 0; ++ } else if(w > 0 && w <= GHCJSBN_MASK) { ++ a[0] = 1; ++ a[1] = w; ++ } else { ++ a[0] = 2; ++ a[1] = w & GHCJSBN_MASK; ++ a[2] = w >>> GHCJSBN_BITS; ++ } */ ++ var r = []; ++ h$ghcjsbn_quotRem_bb(q, r, b, a); ++ return h$ghcjsbn_toWord_b(r); ++} ++ ++// BigNat -> JSBN ++// assumes same number of bits ++function h$ghcjsbn_tmp_toJSBN(b) { ++ var j = new BigInteger(), bl = b[0], i; ++ for(i = 0; i < bl; i++) j.data[i] = b[i+1]; ++ j.s = 0; ++ j.t = bl; ++ return j; ++/* ASSERTVALID_B(b, "toJSBN"); ++ var j0 = new BigInteger(); ++ var j1 = new BigInteger(); ++ var j2 = new BigInteger(); ++ for(var i = b[0]; i > 0; i--) { ++ h$log("i: " + b[i]); ++ j2.fromString('' + b[i]); ++ j0.lShiftTo(28, j1); ++ j1.addTo(j2, j0); ++ } ++ return j0; */ ++} ++ ++// b = fromJSBN(j) :: BigNat -> JSBN -> Int ++// returns length ++function h$ghcjsbn_tmp_fromJSBN(b, j) { ++ var bl = j.t, i; ++ for(i = 0; i < bl; i++) { ++ b[i] = j.data[i]; ++ } ++ return bl; ++} ++ ++ ++// function h$ghcjsbn_divMod_bs(d ++ ++// t = b1 % b2 :: BigNat -> BigNat -> BigNat ++function h$ghcjsbn_rem_bb(b1, b2) { ++ ASSERTVALID_B(b1, "rem_bb b1"); ++ ASSERTVALID_B(b2, "rem_bb b2"); ++ var t1 = [], t2 = []; ++ h$ghcjsbn_quotRem_bb(t1, t2, b1, b2); ++ ASSERTVALID_B(t2, "rem_bb result"); ++ return t2; ++} ++ ++// b1 % s :: BigNat -> Word -> Word ++function h$ghcjsbn_rem_bw(b, w) { ++ ASSERTVALID_B(b, "rem_bw"); ++ ASSERTVALID_W(w, "rem_bw"); ++ // var t1 = []; ++ var r = h$ghcjsbn_quotRem_bw([] /* t1 */, b, w); ++ ASSERTVALID_W(r, "rem_bw result"); ++ return r; ++// var a = h$ghcjsbn_tmp_2a; ++// h$ghcjsbn_toBigNat_w(a, w); ++// a[1] = w & GHCJSBN_MASK; ++// a[2] = w >>> GHCJSBN_BITS; ++// var t1 = []; // , t2 = h$ghcjsbn_tmp_2b; ++// return h$ghcjsbn_quotRem_bw(t1, /* t2 , */ b, a); ++// return t[1] | (t[2] << GHCJSBN_BITS); ++} ++ ++// b1 / b2 :: BigNat -> BigNat -> BigNat ++function h$ghcjsbn_quot_bb(b1, b2) { ++ ASSERTVALID_B(b1, "quot_bb b1"); ++ ASSERTVALID_B(b2, "quot_bb b2"); ++ var t1 = [], t2 = []; ++ h$ghcjsbn_quotRem_bb(t1, t2, b1, b2); ++ ASSERTVALID_B(t1, "quot_bb result"); ++ return t1; ++} ++/* ++// b / s :: BigNat -> Int -> BigNat ++function h$ghcjsbn_div_bs(b, w) { ++ ASSERTVALID_B(b, "div_bs"); ++ ASSERTVALID_S(s, "div_bs"); ++#ifdef GHCJS_ASSERT_INTEGER ++ if(s <= 0) { ++ throw new Error("h$ghcjsbn_div_bs: divisor must be positive"); ++ } ++#endif ++ var a = h$ghcjsbn_tmp_2a; ++ a[0] = s & GHCJSBN_MASK; ++ a[1] = s >> GHCJSBN_BITS; ++ return h$ghcjsbn_div_bb(t, b, a); ++} ++*/ ++// t = b % w :: BigNat -> BigNat -> Word -> Int ++// returns length of t ++/* ++function h$ghcjsbn_div_bw(t, b, w) { ++ ASSERTVALID_B(b, "div_bw"); ++ ASSWRTVALID_W(w, "div_bw"); ++ var a = h$ghcjsbn_tmp_2a; ++ a[0] = w & GHCJSBN_MASK; ++ a[1] = w >>> GHCJSBN_BITS; ++ return h$ghcjsbn_div_bb(t, b, a); ++} ++*/ ++// b ^ 2 :: BigNat -> BigNat ++function h$ghcjsbn_sqr_b(b) { ++ ASSERTVALID_B(b, "sqr_b"); ++ var l = b[0], n = 2 * l, i, c, t = [0]; ++ for(i = 1; i <= n; i++) t[i] = 0; ++ for(i = 0; i < l - 1; i++) { ++ c = h$ghcjsbn_mul_limb(i, b, b[i+1],t,2*i,0,1); ++ if((t[i + l + 1] += h$ghcjsbn_mul_limb(i+1, b, 2*b[i+1], t, 2*i+1, c, l - i - 1)) >= GHCJSBN_DV) { ++ t[i + l + 1] -= GHCJSBN_DV; ++ t[i + l + 2] = 1; ++ } ++ } ++ if(n > 0) t[n] += h$ghcjsbn_mul_limb(i, b, b[i+1], t, 2*i, 0, 1); ++ if(t[n] === 0) n--; ++ t[0] = n; ++ ASSERTVALID_B(t, "sqr_b result"); ++ return t; ++} ++ ++// b1 ^ b2 :: BigNat -> BigNat -> BigNat ++// returns size of t ++function h$ghcjsbn_pow_bb(b1, b2) { ++ ASSERTVALID_B(b1, "pow_bb b1"); ++ ASSERTVALID_B(b2, "pow_bb b2"); ++ var i, sq = b1, t = [1,1]; ++ var bits = h$ghcjsbn_nbits_b(b2); ++ for(i = 0; i < bits; i++) { ++ if(h$ghcjsbn_testBit_b(b2, i)) { ++ h$ghcjsbn_mulTo_bb(t, sq); ++ } ++ sq = h$ghcjsbn_sqr_b(sq); ++ } ++ return t; ++} ++ ++// t = b ^ s :: BigNat -> Word -> BigNat ++function h$ghcjsbn_pow_bw(b, w) { ++ ASSERTVALID_B(b, "pow_bw"); ++ ASSERTVALID_W(w, "pow_bw"); ++ var i, sq = b, t = [1,1]; ++ while(w) { ++ if(w&1) h$ghcjsbn_mulTo_bb(t, sq); ++ w >>>= 1; ++ if(w) { ++ sq = h$ghcjsbn_sqr_b(sq); ++ } ++ } ++ ASSERTVALID_B(t, "pow_bw result"); ++ return t; ++} ++ ++// w1 ^ w2 :: Word -> Word -> BigNat ++function h$ghcjsbn_pow_ww(w1, w2) { ++ ASSERTVALID_S(w1, "pow_ww w1"); ++ ASSERTVALID_S(w2, "pow_ww w2"); ++ var b = h$ghcjsbn_tmp_2a; ++ h$ghcjsbn_toBigNat_w(b, w1); ++ var t = h$ghcjsbn_pow_bw(b, w2); ++ ASSERTVALID_B(t, "pow_ww result"); ++ return t; ++} ++ ++// (b ^ s1) % s2 :: BigNat -> BigNat -> BigNat -> BigNat ++function h$ghcjsbn_modPow_bbb(b, s1, s2) { ++ throw new Error("modPow_bbb"); ++} ++ ++// (b ^ s1) % s2 :: BigNat -> Int -> Int -> Int ++function h$ghcjsbn_modPow_bss(b, s1, s2) { ++ throw new Error("modPow_bss"); ++} ++ ++// (s1 ^ s2) % s3 :: Int -> Int -> Int -> Int ++function h$ghcjsbn_modPow_sss(s1, s2, s3) { ++ throw new Error("modPow_sss"); ++} ++ ++ ++ ++// r = gcd(b1,b2) BigNat -> BigNat -> BigNat ++function h$ghcjsbn_gcd_bb(b1, b2) { ++ ASSERTVALID_B(b1, "gcd_bb b1"); ++ ASSERTVALID_B(b2, "gcd_bb b2"); ++ var r; ++ if(h$ghcjsbn_cmp_bb(b1, b2) === GHCJSBN_GT) { ++ r = b1; ++ b1 = b2; ++ b2 = r; ++ } ++ while(b1[0] > 0) { ++ r = h$ghcjsbn_rem_bb(b2, b1); ++ b2 = b1; ++ b1 = r; ++ } ++ ASSERTVALID_B(b2, "gcd_bb result"); ++ return b2; ++} ++// gcd(b,s) :: BigNat -> Int -> Int ++function h$ghcjsbn_gcd_bs(b, s) { ++ throw new Error("h$ghcjsbn_gcd_bs not implemented"); ++} ++ ++// gcd(s1,s2) :: Int -> Int -> Int ++function h$ghcjsbn_gcd_ss(s1, s2) { ++ ASSERTVALID_S(s1, "gcd_ss s1"); ++ ASSERTVALID_S(s2, "gcd_ss s2"); ++ var a, b, r; ++ a = s1 < 0 ? -s1 : s1; ++ b = s2 < 0 ? -s2 : s2; ++ if(b < a) { ++ r = a; ++ a = b; ++ b = r; ++ } ++ while(a !== 0) { ++ r = b % a; ++ b = a; ++ a = r; ++ } ++ ASSERTVALID_S(b, "gcd_ss result"); ++ return b; ++} ++ ++// gcd(w1,w2) :: Word -> Word -> Word ++// fixme negatives are probably wrong here ++function h$ghcjsbn_gcd_ww(w1, w2) { ++ ASSERTVALID_W(w1, "gcd_ww w1"); ++ ASSERTVALID_W(w2, "gcd_ww w2"); ++ var a, b, r; ++ a = w1 < 0 ? (w1 + 4294967296) : w1; ++ b = w2 < 0 ? (w2 + 4294967296) : w2; ++ if(b < a) { ++ r = a; ++ a = b; ++ b = r; ++ } ++ while(a !== 0) { ++ r = b % a; ++ b = a; ++ a = r; ++ } ++ b = b|0; ++ ASSERTVALID_W(b, "gcd_ww result"); ++ return b; ++} ++ ++function h$ghcjsbn_gcd_bw(b, w) { ++ ASSERTVALID_B(b, "gcd_bw"); ++ ASSERTVALID_W(w, "gcd_bw"); ++ var q = [], r = h$ghcjsbn_quotRem_bw(q, b, w); ++ ASSERTVALID_W(r, "gcd_bw r"); ++ if(r === 0) { ++ return b[0] === 0 ? 0 : w; ++ } else { ++ return h$ghcjsbn_gcd_ww(r, w); ++ } ++} ++ ++// b >> s :: BigNat -> Int -> BigNat ++function h$ghcjsbn_shr_b(b, s) { ++ ASSERTVALID_B(b, "shr_b"); ++ ASSERTVALID_S(s, "shr_b"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(s < 0) throw new Error("h$ghcjsbn_shr_b: negative operand"); ++#endif ++ var i, v1, v2, l = b[0], sl = (s / GHCJSBN_BITS)|0, t = [0]; ++ l -= sl; ++ if(l <= 0) { ++ t[0] = 0; ++ } else { ++ var sb1 = s % GHCJSBN_BITS, sb2 = GHCJSBN_BITS - sb1, m = (1<> sb1, v; ++ for(i = 1; i < l; i++) { ++ v = b[i + sl + 1]; ++ t[i] = ((v&m) << sb2)|c; ++ c = v >> sb1; ++ } ++ if(c !== 0) { ++ t[l] = c; ++ t[0] = l; ++ } else { ++ t[0] = l - 1; ++ } ++ } ++ ASSERTVALID_B(t, "shr_b result"); ++ return t; ++} ++ ++// t = b >> s :: BigNat -> BigNat -> Int -> IO () ++function h$ghcjsbn_shrTo_b(t, b, s) { ++ ASSERTVALID_B(b, "shrTo_b"); ++ ASSERTVALID_S(s, "shrTo_b"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(s < 0) throw new Error("h$ghcjsbn_shrTo_b: negative operand"); ++#endif ++ var i, v1, v2, l = b[0], sl = (s / GHCJSBN_BITS)|0; ++ t[0] = 0; ++ l -= sl; ++ if(l <= 0) { ++ t[0] = 0; ++ } else { ++ var sb1 = s % GHCJSBN_BITS, sb2 = GHCJSBN_BITS - sb1, m = (1<> sb1, v; ++ for(i = 1; i < l; i++) { ++ v = b[i + sl + 1]; ++ t[i] = ((v&m) << sb2)|c; ++ c = v >> sb1; ++ } ++ if(c !== 0) { ++ t[l] = c; ++ t[0] = l; ++ } else { ++ t[0] = l - 1; ++ } ++ } ++ ASSERTVALID_B(t, "shrTo_b result"); ++} ++ ++function h$ghcjsbn_shr_neg_b(b, s) { ++ throw new Error ("shr_neg_b not implemented"); ++} ++ ++// b << s :: BigNat -> Int -> BigNat ++function h$ghcjsbn_shl_b(b, s) { ++ ASSERTVALID_B(b, "shl_b"); ++ ASSERTVALID_S(s, "shl_b"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(s < 0) throw new Error("h$ghcjsbn_shl_b: negative operand"); ++#endif ++ var sl = (s / GHCJSBN_BITS)|0; ++ var sb1 = s % GHCJSBN_BITS, sb2 = GHCJSBN_BITS - sb1; ++ // mask wrong ++ var l = b[0]; ++ if(l === 0) return h$ghcjsbn_zero_b; ++ var c = 0, i, v, m = (1 <> sb2; ++ } ++ if(c !== 0) { ++ t[l+sl+1] = c; ++ t[0] = l + sl + 1; ++ } else { ++ t[0] = l + sl; ++ } ++ ASSERTVALID_B(t, "shl_b result"); ++ return t; ++} ++ ++// t = b << s :: BigNat -> BigNat -> Int -> IO () ++function h$ghcjsbn_shlTo_b(t, b, s) { ++ ASSERTVALID_B(b, "shlTo_b"); ++ ASSERTVALID_S(s, "shlTo_b"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(s < 0) throw new Error("h$ghcjsbn_shlTo_b: negative operand"); ++#endif ++ var sl = (s / GHCJSBN_BITS)|0; ++ var sb1 = s % GHCJSBN_BITS, sb2 = GHCJSBN_BITS - sb1; ++ // mask wrong ++ var l = b[0], c = 0, i, v, m = (1 <> sb2; ++ } ++ if(c !== 0) { ++ t[l+sl+1] = c; ++ t[0] = l + sl + 1; ++ } else { ++ t[0] = l + sl; ++ } ++ ASSERTVALID_B(t, "shlTo_b result"); ++} ++ ++ ++// t = b >> (GHCJSBN_BITS * s) :: BigNat -> BigNat -> Int ++function h$ghcjsbn_shrTo_limbs_b(t, b, s) { ++ ASSERTVALID_B(b, "shrTo_limbs_b"); ++ ASSERTVALID_S(s, "shrTo_limbs_b"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(s < 0) throw new Error("h$ghcjsbn_shrTo_limbs_b: negative operand"); ++#endif ++ var l = b[0], l1 = l - s, i; ++ if(l1 < 1) { ++ t[0] = 0; ++ } else { ++ t[0] = l1; ++ for(i = 1; i <= l1; i++) t[i] = b[i+s]; ++ } ++ ASSERTVALID_B(t, "shrTo_limbs_b result"); ++} ++ ++// t = b << (GHCJSBN_BITS * s) :: BigNat -> BigNat -> Int ++function h$ghcjsbn_shlTo_limbs_b(t, b, s) { ++ ASSERTVALID_B(b, "shlTo_limbs_b"); ++ ASSERTVALID_S(s, "shlTo_limbs_b"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(s < 0) throw new Error("h$ghcjsbn_shlTo_limbs_b: negative operand"); ++#endif ++ var l = b[0], l1 = l + s, i; ++ if(l === 0) { ++ t[0] = 0; ++ } else { ++ t[0] = l1; ++ for(i = 1; i <= s; i++) t[i] = 0; ++ for(i = s+1; i <= l1; i++) t[i] = b[i-s]; ++ } ++ ASSERTVALID_B(t, "shlTo_limbs_b result"); ++} ++ ++function h$ghcjsbn_nbits_b(b) { ++ ASSERTVALID_B(b, "nbits_b"); ++ var l = b[0], c = 0, s, t; ++ if(l === 0) { ++ return 0; ++ } else { ++ var r = ((l-1)*GHCJSBN_BITS) + h$ghcjsbn_nbits_s(b[l]); ++ ASSERTVALID_S(r, "nbits_b result"); ++ return r; ++ } ++} ++ ++function h$ghcjsbn_nbits_s(s) { ++ ASSERTVALID_S(s, "nbits_s"); ++ var c = 1, t; ++ if((t = s >>> 16) != 0) { s = t; c += 16; } ++ if((t = s >> 8) != 0) { s = t; c += 8; } ++ if((t = s >> 4) != 0) { s = t; c += 4; } ++ if((t = s >> 2) != 0) { s = t; c += 2; } ++ if((t = s >> 1) != 0) { s = t; c += 1; } ++ ASSERTVALID_S(c, "nbits_s result"); ++ return c; ++} ++ ++// BigNat -> Word -> String ++function h$ghcjsbn_showBase(b, base) { ++ ASSERTVALID_B(b, "showBase"); ++ ASSERTVALID_S(base, "showBase"); ++ if(h$ghcjsbn_cmp_bb(b, h$ghcjsbn_zero_b) === GHCJSBN_EQ) { ++ return "0"; ++ } else { ++ return h$ghcjsbn_showBase_rec(b, base, Math.log(base), 0); ++ } ++} ++ ++function h$ghcjsbn_showBase_rec(b, base, logBase, pad) { ++ var bits = h$ghcjsbn_nbits_b(b), r; ++ // h$log("[" + b.join(",") + "] bits: " + bits); ++ if(h$ghcjsbn_cmp_bb(b, h$ghcjsbn_two31_b) === GHCJSBN_LT) { ++ // convert short numbers to int and show in base ++ var ti = h$ghcjsbn_toInt_b(b); ++ // h$log("############# got base limb: " + ti); ++ r = ti === 0 ? "" : ti.toString(base); ++ } else { ++ // divide and conquer for long numbers ++ var digits = Math.floor(bits * 0.6931471805599453 / logBase); ++ var d2 = Math.round(digits/2), p, q = [], r = []; ++ p = h$ghcjsbn_pow_ww(base, d2); ++ h$ghcjsbn_quotRem_bb(q, r, b, p); ++ r = h$ghcjsbn_showBase_rec(q, base, logBase, 0) + ++ h$ghcjsbn_showBase_rec(r, base, logBase, d2); ++ } ++ var rl = r.length; ++ if(rl < pad) { ++ while(rl <= pad-8) { r = "00000000" + r; rl += 8; } ++ switch(pad-rl) { ++ case 1: r = "0" + r; break; ++ case 2: r = "00" + r; break; ++ case 3: r = "000" + r; break; ++ case 4: r = "0000" + r; break; ++ case 5: r = "00000" + r; break; ++ case 6: r = "000000" + r; break; ++ case 7: r = "0000000" + r; break; ++ } ++ } ++ return r; ++} ++ ++// BigNat -> String (decimal) ++function h$ghcjsbn_show(b) { ++ throw new Error("show not implemented"); ++ // digits = ++} ++ ++// BigNat -> String ++function h$ghcjsbn_showHex(b) { ++ throw new Error("showHex not implemented"); ++} ++ ++// s = b[l - 1]; ++ ++// normalize a number to length l by stripping unused leading digits ++/* ++function h$ghcjsbn_normalize(b, l) { ++ var d = b.length - l; ++ while(d--) b.pop(); ++} ++ ++// normalize a number by stripping leading zeroes ++function h$ghcjsbn_normalize0(b) { ++ var l = b.length; ++ while(b[--l] === 0) b.pop(); ++} ++*/ ++// t = b :: BigNat -> BigNat -> Int, returns length of t ++function h$ghcjsbn_copy(t, b) { ++ ASSERTVALID_B(b, "copy"); ++ var l = b[0]; ++ for(var i = 0; i <= l; i++) { ++ t[i] = b[i]; ++ } ++ return l; ++} ++ ++// BigNat -> Int -> Bool ++// test if bit n is set in b (least significant bit is 0) ++function h$ghcjsbn_testBit_b(b, n) { ++ ASSERTVALID_B(b, "testBit_b"); ++ ASSERTVALID_S(n, "testBit_b"); ++ var limb = (n / GHCJSBN_BITS)|0; ++ if(limb >= b[0]) { ++ return false; ++ } else { ++ var d = b[limb]; ++ var bit = n - (GHCJSBN_BITS * limb); ++ return (b[limb] & (1 << bit)) !== 0; ++ } ++} ++ ++function h$ghcjsbn_popCount_b(b) { ++ ASSERTVALID_B(b, "popCount_b"); ++ var c = 0, l = b[0]; ++ while(l > 0) { ++ c += h$popCnt32(b[l--]); ++ } ++ return c; ++} ++ ++// t = b1 ^ b2 :: BigNat -> BigNat -> BigNat -> Int ++// returns length of t ++function h$ghcjsbn_xor_bb(b1, b2) { ++ ASSERTVALID_B(b1, "xor_bb b1"); ++ ASSERTVALID_B(b2, "xor_bb b2"); ++ var i, lmin, lmax, blmax, l1 = b1[0], l2 = b2[0], t = [0]; ++ if(l1 <= l2) { ++ lmin = l1; ++ lmax = l2; ++ blmax = b2; ++ } else { ++ lmin = l2; ++ lmax = l1; ++ blmax = b1; ++ } ++ for(i = 1; i <= lmin; i++) { ++ t[i] = b1[i] ^ b2[i]; ++ } ++ for(i = lmin + 1; i <= lmax; i++) { ++ t[i] = blmax[i]; ++ } ++ while(lmax > 0 && t[lmax] === 0) lmax--; ++ t[0] = lmax; ++ ASSERTVALID_B(t, "xor_bb result"); ++ return t; ++} ++ ++// b1 | b2 :: BigNat -> BigNat -> BigNat ++function h$ghcjsbn_or_bb(b1, b2) { ++ ASSERTVALID_B(b1, "or_bb b1"); ++ ASSERTVALID_B(b2, "or_bb b2"); ++ var i, lmin, lmax, blmax, l1 = b1[0], l2 = b2[0], t = [0]; ++ if(l1 <= l2) { ++ lmin = l1; ++ lmax = l2; ++ blmax = b2; ++ } else { ++ lmin = l2; ++ lmax = l1; ++ blmax = b1; ++ } ++ for(i = 1; i <= lmin; i++) { ++ t[i] = b1[i] | b2[i]; ++ } ++ for(i = lmin + 1; i <= lmax; i++) { ++ t[i] = blmax[i]; ++ } ++ t[0] = lmax; ++ ASSERTVALID_B(t, "or_bb result"); ++ return t; ++} ++ ++// b1 & b2 :: BigNat -> BigNat -> BigNat ++function h$ghcjsbn_and_bb(b1, b2) { ++ ASSERTVALID_B(b1, "and_bb b1"); ++ ASSERTVALID_B(b2, "and_bb b2"); ++ var i, lmin, l1 = b1[0], l2 = b2[0], t = [0]; ++ lmin = l1 <= l2 ? l1 : l2; ++ for(i = 1; i <= lmin; i++) { ++ t[i] = b1[i] & b2[i]; ++ } ++ while(lmin > 0 && t[lmin] === 0) lmin--; ++ t[0] = lmin; ++ ASSERTVALID_B(t, "and_bb result"); ++ return t; ++} ++ ++// b1 & (~b2) :: BigNat -> BigNat -> BigNat ++// fixme is this one correct? ++function h$ghcjsbn_andn_bb(b1, b2) { ++ ASSERTVALID_B(b1, "andn_bb b1"); ++ ASSERTVALID_B(b2, "andn_bb b2"); ++ var i, lmin, l1 = b1[0], l2 = b2[0], t = [0]; ++ if(l1 <= l2) { ++ for(i = 0; i <= l1; i++) t[i] = b1[i] & (~b2[i]); ++ } else { ++ for(i = 0; i <= l2; i++) t[i] = b1[i] & (~b2[i]); ++ for(i = l2+1; i <= l1; i++) t[i] = b1[i]; ++ } ++ while(l1 > 0 && t[l1] === 0) l1--; ++ t[0] = l1; ++ ASSERTVALID_B(t, "andn_bb result"); ++ return t; ++} ++ ++function h$ghcjsbn_toInt_b(b) { ++ ASSERTVALID_B(b, "toInt_b"); ++ var bl = b[0], r; ++ if(bl >= 2) { ++ r = (b[2] << GHCJSBN_BITS) | b[1]; ++ } else if(bl === 1) { ++ r = b[1]; ++ } else { ++ r = 0; ++ } ++ ASSERTVALID_S(r, "toInt_b result"); ++ return r; ++} ++ ++function h$ghcjsbn_toWord_b(b) { ++ ASSERTVALID_B(b, "toWord_b"); ++ var bl = b[0], w; ++ if(bl >= 2) { ++ w = (b[2] << GHCJSBN_BITS) | b[1]; ++ } else if(bl === 1) { ++ w = b[1]; ++ } else { ++ w = 0; ++ } ++ ASSERTVALID_W(w, "toWord_b result"); ++ return w; ++} ++ ++var h$integer_bigNatToWord64 = h$ghcjsbn_toWord64_b; ++var h$integer_word64ToBigNat = h$ghcjsbn_mkBigNat_ww; // fixme? ++ ++#if GHCJSBN_BITS == 28 ++function h$ghcjsbn_toWord64_b(b) { ++ ASSERTVALID_B(b, "toWord64_b"); ++ var len = b[0], w1, w2; ++ if(len < 2) { ++ w2 = 0; ++ w1 = (len === 1) ? b[1] : 0; ++ } else { ++ w1 = b[1] | (b[2] << 28); ++ if(len === 2) { ++ w2 = b[2] >>> 4; ++ } else { ++ w2 = (b[2] >>> 4) | (b[3] << 24); ++ } ++ } ++ ASSERTVALID_W(w2, "toWord64_b result w2"); ++ ASSERTVALID_W(w1, "toWord64_b result w1"); ++ RETURN_UBX_TUP2(w2, w1); ++} ++#else ++#error "no toWord64_b implementation for GHCJSBN_BITS" ++#endif ++ ++// BigNat -> Int -> IO () ++function h$ghcjsbn_toBigNat_s(b, s) { ++ ASSERTVALID_S(s, "toBigNat_s"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(s < 0) { ++ throw new Error("h$ghcjsbn_toBigNat_s: negative operand"); ++ } ++#endif ++ if(s === 0) { ++ b[0] = 0; ++ } else if(s <= GHCJSBN_MASK) { ++ b[0] = 1; ++ b[1] = s; ++ } else { ++ b[0] = 2; ++ b[1] = s & GHCJSBN_MASK; ++ b[2] = s >> GHCJSBN_MASK; ++ } ++ ASSERTVALID_B(b, "toBigNat_s result"); ++} ++ ++// BigNat -> Word -> IO () ++function h$ghcjsbn_toBigNat_w(b, w) { ++ ASSERTVALID_W(w, "toBigNat_w"); ++ if(w === 0) { ++ b[0] = 0; ++ } else if(w > 0 && w <= GHCJSBN_MASK) { ++ b[0] = 1; ++ b[1] = w; ++ } else { ++ b[0] = 2; ++ b[1] = w & GHCJSBN_MASK; ++ b[2] = w >>> GHCJSBN_BITS; ++ } ++ ASSERTVALID_B(b, "toBigNat_w result"); ++} ++ ++function h$ghcjsbn_mkBigNat_w(w) { ++ ASSERTVALID_W(w, "mkBigNat_w"); ++ var r; ++ if(w === 0) r = h$ghcjsbn_zero_b; ++ else if(w === 1) r = h$ghcjsbn_one_b; ++ else if(w > 0 && w <= GHCJSBN_MASK) r = [1,w]; ++ else r = [2, w & GHCJSBN_MASK, w >>> GHCJSBN_BITS]; ++ ASSERTVALID_B(r, "mkBigNat_w result"); ++ // ASSERTVALID_B(h$ghcjsbn_zero_b, "mkBigNat_w zero"); ++ return r; ++} ++ ++#if GHCJSBN_BITS == 28 ++function h$ghcjsbn_mkBigNat_ww(hw, lw) { ++ ASSERTVALID_W(hw, "mkBigNat_ww hw"); ++ ASSERTVALID_W(lw, "mkBigNat_ww lw"); ++ var r; ++ if(hw === 0) r = h$ghcjsbn_mkBigNat_w(lw); ++ else { ++ var w1 = lw & GHCJSBN_MASK; ++ var w2 = (lw >>> GHCJSBN_BITS) | ((hw << 4) & GHCJSBN_MASK); ++ var w3 = hw >>> 24; ++ if(w3 === 0) { ++ r = [2, w1, w2]; ++ } else { ++ r = [3, w1, w2, w3]; ++ } ++ } ++ ASSERTVALID_B(r, "mkBigNat_ww result"); ++ return r; ++} ++ ++ ++// fixme remove after reboot ++var h$ghcjsbn_toBigNat_ww = h$ghcjsbn_mkBigNat_ww; ++ ++/* fixme re-enable after reboot ++function h$ghcjsbn_toBigNat_ww(b, hw, lw) { ++ ASSERTVALID_W(hw, "toBigNat_ww hw"); ++ ASSERTVALID_W(lw, "toBigNat_ww lw"); ++ if(hw === 0) h$ghcjsbn_toBigNat_w(b, lw); ++ else { ++ var w1 = lw & GHCJSBN_MASK; ++ var w2 = (lw >>> GHCJSBN_BITS) | ((hw << 4) & GHCJSBN_MASK); ++ var w3 = hw >>> 24; ++ if(w3 === 0) { ++ r[0] = 2; ++ r[1] = w1; ++ r[2] = w2; ++ } else { ++ r[0] = 3; ++ r[1] = w1; ++ r[2] = w2; ++ r[3] = w3; ++ } ++ } ++} ++*/ ++#else ++#error "no mkBigNat_ww implementation for specified GHCJSBN_BITS" ++#endif ++ ++// fixme remove later ++var h$integer_mkInteger = h$ghcjsbn_mkInteger; ++ ++#if GHCJSBN_BITS == 28 ++function h$ghcjsbn_mkInteger(nonNeg, xs) { ++ // fixme write proper optimized version ++ var r = [0], s = 0, t; ++ while(IS_CONS(xs)) { ++ t = h$ghcjsbn_shl_b(h$ghcjsbn_mkBigNat_w(UNWRAP_NUMBER(CONS_HEAD(xs))), s); ++ h$ghcjsbn_addTo_bb(r, t); ++ s += 31; ++ xs = CONS_TAIL(xs); ++ } ++ if(nonNeg) { ++ if(h$ghcjsbn_cmp_bb(r, h$ghcjsbn_two31_b) === GHCJSBN_LT) { ++ return MK_INTEGER_S(h$ghcjsbn_toInt_b(r)); ++ } else { ++ return MK_INTEGER_Jp(r); ++ } ++ } else { ++ var c = h$ghcjsbn_cmp_bb(r, h$ghcjsbn_two31_b); ++ if(c === GHCJSBN_GT) { ++ return MK_INTEGER_Jn(r); ++ } else if(c === GHCJSBN_EQ) { ++ return h$ghcjsbn_negTwo31_i; ++ } else { ++ return MK_INTEGER_S(-h$ghcjsbn_toInt_b(r)); ++ } ++ } ++/* var r = h$ghcjsbn_mkBigNat_w(0), l = 0, s = 0, y, t; ++ while(IS_CONS(xs)) { ++ l++; ++ y = UNWRAP_NUMBER(CONS_HEAD(xs)); ++ r[++l] = (y << s | c) & GHCJSBN_MASK; ++ c = y >>> s; ++ xs = CONS_TAIL(xs); ++ s += 3; ++ l++; ++ if(s > GHCJSBN_BITS) { ++ s -= GHCJSBN_BITS; ++ r[++l] = c & GHCJSBN_MASK; ++ c >>= GHCJSBN_BITS; ++ } ++ } ++ if(c !== 0) r[++l] = ++ while( ++ if(l === 0) { ++ return MK_INTEGER_S(0); ++ } else if(l === 1) { ++ ++ } else if(l === 2) { ++ ++ } */ ++} ++#else ++error "no mkInteger implementation for specified GHCJSBN_BITS" ++#endif ++ ++// BigNat -> Int -> Int ++function h$ghcjsbn_indexBigNat(b, i) { ++ ASSERTVALID_B(b, "indexBigNat"); ++ ASSERTVALID_S(i, "indexBigNat"); ++ var bl = b[0]; ++ return i >= bl ? 0 : b[i+1]; ++} ++ ++// BigNat -> Word -> Int (Ordering) ++function h$ghcjsbn_cmp_bw(b, w) { ++ ASSERTVALID_B(b, "cmp_bw"); ++ ASSERTVALID_W(w, "cmp_bw"); ++ var w1 = w & GHCJSBN_MASK, w2 = w >>> GHCJSBN_BITS, bl = b[0]; ++ if(w2 === 0) { ++ if(bl === 0) { ++ return w1 > 0 ? GHCJSBN_LT : GHCJSBN_EQ; ++ } else if(bl === 1) { ++ var bw = b[1]; ++ return bw > w1 ? GHCJSBN_GT : (bw === w1 ? GHCJSBN_EQ : GHCJSBN_LT); ++ } else { ++ return GHCJSBN_GT; ++ } ++ } else { ++ if(bl < 2) { ++ return GHCJSBN_LT; ++ } else if(bl > 2) { ++ return GHCJSBN_GT; ++ } else { ++ var bw1 = b[1], bw2 = b[2]; ++ return (bw2 > w2) ? GHCJSBN_GT ++ : (bw2 < w2 ? GHCJSBN_LT ++ : (bw1 > w1 ? GHCJSBN_GT ++ : (bw1 < w1 ? GHCJSBN_LT ++ : GHCJSBN_EQ))); ++ } ++ } ++} ++ ++/* ++function h$ghcjsbn_gt_bw(b, w) { ++ var r = h$ghcjsbn_gt_bw0(b,w); ++ h$log("gt_bw result: " + r); ++ return r; ++} ++*/ ++ ++function h$ghcjsbn_gt_bw(b, w) { ++ ASSERTVALID_B(b, "gt_bw"); ++ ASSERTVALID_W(w, "gt_bw"); ++ var bl = b[0]; ++ if(bl > 2) return true; ++ else if(bl === 0) return false; ++ else if(bl === 1) return w >= 0 && b[1] > w; ++ else { // bl === 2 ++ var wh = w >>> GHCJSBN_BITS, wl = w & GHCJSBN_MASK, b2 = b[2]; ++ // var r = (wh > b2 || ((wh === b2) && wl > b[1])); ++ // h$log("r: " + r + " " + wh + " " + wl + " " ); ++ return (b2 > wh || ((wh === b2) && b[1] > wl)); ++ } ++} ++ ++// BigNat -> BigNat -> Bool ++function h$ghcjsbn_eq_bb(b1, b2) { ++ ASSERTVALID_B(b1, "eq_bb"); ++ ASSERTVALID_B(b2, "eq_bb"); ++ var bl1 = b1[0], bl2 = b2[0]; ++ if(bl1 !== bl2) { ++ return false; ++ } else { ++ for(var i = bl1; i >= 1; i--) { ++ var bw1 = b1[i], bw2 = b2[i]; ++ if(bw1 !== bw2) return false; ++ } ++ } ++ return true; // GHCJSBN_EQ; ++} ++ ++// BigNat -> BigNat -> Bool ++function h$ghcjsbn_neq_bb(b1, b2) { ++ ASSERTVALID_B(b1, "neq_bb"); ++ ASSERTVALID_B(b2, "neq_bb"); ++ var bl1 = b1[0], bl2 = b2[0]; ++ if(bl1 !== bl2) { ++ return true; ++ } else { ++ for(var i = bl1; i >= 1; i--) { ++ var bw1 = b1[i], bw2 = b2[i]; ++ if(bw1 !== bw2) return true; ++ } ++ } ++ return false; ++} ++ ++// BigNat -> BigNat -> Bool ++/* ++function h$ghcjsbn_eq_bw(b, w) { ++ var r = h$ghcjsbn_eq_bw0(b, w); ++ return r; ++} ++*/ ++function h$ghcjsbn_eq_bw(b, w) { ++ ASSERTVALID_B(b, "eq_bw"); ++ ASSERTVALID_W(w, "eq_bw"); ++ var w1 = w & GHCJSBN_MASK, w2 = w >>> GHCJSBN_BITS, bl = b[0]; ++ if(w2 === 0) { ++ if(w1 === 0) { ++ return bl === 0; ++ } else { ++ return bl === 1 && b[1] === w; ++ } ++ } else { ++ return bl === 2 && b[1] === w1 && b[2] === w2; ++ } ++} ++ ++// BigNat -> Bool ++function h$ghcjsbn_isZero_b(b) { ++ ASSERTVALID_B(b, "isZero_b"); ++ return b[0] === 0; ++} ++ ++// BigNat -> Int ++function h$ghcjsbn_isNull_b(b) { ++ return b[0] === -1; ++} ++ ++// 1 << n ++function h$ghcjsbn_bitBigNat(n) { ++#ifdef GHCJSBN_ASSERT_INTEGER ++ if(n < 0) { ++ throw new Error("bitBigNat: argument must be positive"); ++ } ++#endif ++ if(n === 0) { ++ r = h$ghcjsbn_one_b; ++ } else if(n < GHCJSBN_BITS) { ++ r = [1, 1 << n]; ++ } else { ++ var l = (n / GHCJSBN_BITS)|0; ++ var r = [l+1]; ++ for(var i = 1; i<= l; i++) r[i] = 0; ++ r[l+1] = 1 << (n - (GHCJSBN_BITS * l)); ++ } ++ ASSERTVALID_B(r, "bitBigNat result"); ++ return r; ++} ++ ++ ++// Integer -> Int ++// assumes argument is strictly positive ++function h$ghcjsbn_integerLog2(i) { ++ ASSERTVALID_I(i, "integerLog2"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++/* if(h$ghcjsbn_cmp_ii(i, h$ghcjsbn_zero_i) !== GHCJSBN_GT) { ++ throw new Error("integerLog2: argument must be positive"); ++ } */ ++#endif ++ if(IS_INTEGER_S(i)) { ++ return h$ghcjsbn_nbits_s(INTEGER_S_DATA(i)); ++ } else { ++ return h$ghcjsbn_nbits_b(INTEGER_J_DATA(i)); ++ } ++} ++ ++// Integer -> Int ++// returns negation of result if integer is exactly a power of two ++function h$ghcjsbn_integerLog2IsPowerOf2(i) { ++ ASSERTVALID_I(i, "integerLog2IsPowerOf2"); ++#ifdef GHCJSBN_ASSERT_INTEGER ++/* if(h$ghcjbn_cmp_ii(i, h$ghcjsbn_zero_i) !== GHCJSBN_GT) { ++ throw new Error("integerLog2IsPowerOf2: argument must be positive"); ++ } */ ++#endif ++ var nb; ++ if(IS_INTEGER_S(i)) { ++ var sd = INTEGER_S_DATA(i); ++ ASSERTVALID_S(sd, "integerLog2IsPowerOf2 sd"); ++ nb = h$ghcjsbn_nbits_s(sd); ++ return ((sd === 1 << nb) ? -nb : nb); ++ } else { ++ var bd = INTEGER_J_DATA(i); ++ ASSERTVALID_B(bd, "integerLog2IsPowerOf2 bd"); ++ nb = h$ghcjsbn_nbits_b(bd); ++ var i, bl = (nb / GHCJSBN_BITS) | 0, lb = nb - GHCJSBN_BITS * bl, l = bd[bl+1]; ++ if(l !== (1 << lb)) return nb; ++ for(i = bl; i >= 1; i--) { ++ if(bd[i] !== 0) return nb; ++ } ++ return -nb; ++ } ++} ++ ++// BigNat? -> Int ++function h$ghcjsbn_isValid_b(b) { ++ if(!Array.isArray(b)) return 0; ++ if(b.length < 1) return 0; ++ var bl = b[0], w; ++ if(b.length < (bl+1)) return 0; ++ for(var i = 0; i <= bl; i++) { ++ w = b[i]; ++ if(typeof w !== 'number' || (w & GHCJSBN_MASK) !== w) return 0; ++ } ++ return 1; ++} ++ ++// BigNat -> Integer ++function h$ghcjsbn_toInteger_b(b) { ++ ASSERTVALID_B(b, "toInteger_b"); ++ if(h$ghcjsbn_cmp_bb(b, h$ghcjsbn_two31_b) === GHCJSBN_LT) { ++ return MK_INTEGER_S(h$ghcjsbn_toInt_b(b)); ++ } else { ++ return MK_INTEGER_Jp(b); ++ } ++} ++ ++// BigNat -> Integer ++function h$ghcjsbn_toNegInteger_b(b) { ++ ASSERTVALID_B(b, "toNegInteger_b"); ++ var c = h$ghcjsbn_cmp_bb(b, h$ghcjsbn_two31_b); ++ if(c === GHCJSBN_LT) { ++ return MK_INTEGER_S(-h$ghcjsbn_toInt_b(b)); ++ } else if(c === GHCJSBN_EQ) { ++ return h$ghcjsbn_negTwo31_i; ++ } else { ++ return MK_INTEGER_Jn(b); ++ } ++} ++ ++// BigNat? -> Int ++// (can be called with invalid bignat) ++function h$ghcjsbn_sizeof_b(b) { ++ if(b.length < 1) return 0; ++ var bl = b[0]; ++ return Math.ceil((bl * GHCJSBN_BITS) / 32); ++} ++ ++// extract a word from a BigNat ++function h$ghcjsbn_index_b(b, w) { ++ throw new Error("index_b"); ++ ASSERTVALID_B(b, "index_b"); ++ ASSERTVALID_W(w, "index_b"); ++ var wbit = 32*w, len = b[0], limb = (wbit / GHCJSBN_BITS) | 0, lb = wbit - (limb * GHCJSBN_BITS); ++ var r = b[limb+1] >>> lb; ++/* if() { ++ ++ } */ ++ ASSERTVALID_W(r, "index_b result"); ++} ++ ++// Bool -> BigNat -> Double ++function h$ghcjsbn_toDouble_b(nonNeg, b) { ++ throw new Error("toDouble_b"); ++} ++ ++function h$ghcjsbn_byteArrayToBigNat(ba, len) { ++ throw new Error("h$ghcjsbn_byteArrayToBigNat not yet implemented"); ++} ++ ++function h$ghcjsbn_importBigNatFromAddr(a_d, a_o, len, msbf) { ++ throw new Error("h$ghcjsbn_importBigNatFromAddr not yet implemented"); ++} ++ ++function h$ghcjsbn_importBigNatFromByteArray(ba, ofs, len, msbf) { ++ throw new Error("h$ghcjsbn_importBigNatFromByteArray not yet implemented"); ++} ++ ++ ++////////////////////////////////////////////////////////////////////////////// ++// fixme move to primop places later ++ ++var h$integer_int64ToInteger = h$ghcjsbn_toInteger_s64; ++ ++function h$ghcjsbn_toInteger_s64(s_a, s_b) { ++ ASSERTVALID_S(s_a, "toInteger_s64 s_a"); ++ ASSERTVALID_S(s_b, "toInteger_s64 s_b"); ++ if(s_a === 0) { ++ if(s_b >= 0) { ++ return MK_INTEGER_S(s_b); ++ } else { ++ return MK_INTEGER_Jp(h$ghcjsbn_mkBigNat_w(s_b)); ++ } ++ } else if(s_a === -1) { ++ if(s_b < 0) { ++ return MK_INTEGER_S(s_b); ++ } else if(s_b === 0) { ++ return MK_INTEGER_Jn(h$ghcjsbn_mkBigNat_ww(1,0)); ++ } else { ++ return MK_INTEGER_Jn(h$ghcjsbn_mkBigNat_w(((~s_b)+1)|0)); ++ } ++ } else if(s_a > 0) { ++ return MK_INTEGER_Jp(h$ghcjsbn_mkBigNat_ww(s_a, s_b)); ++ } else { ++ if(s_b === 0) { // zero should be correct! ++ return MK_INTEGER_Jn(h$ghcjsbn_mkBigNat_ww(((~s_a)+1)|0, 0)); ++ } else { ++ return MK_INTEGER_Jn(h$ghcjsbn_mkBigNat_ww((~s_a)|0, ((~s_b)+1)|0)); ++ } ++ /* ++ if(s_b === 0) { // zero should be correct! ++ return MK_INTEGER_Jn(h$ghcjsbn_mkBigNat_ww(((~s_a)+1)|0, 0)); ++ } else { ++ return MK_INTEGER_Jn(h$ghcjsbn_mkBigNat_ww(~s_a, ((~s_b)+1)|0)); ++ } */ ++ } ++} ++ ++function h$decodeDoubleInt64(d) { ++ ASSERTVALID_D(d, "DoubleDecode_Int64"); ++ if(isNaN(d)) { ++ // RETURN_UBX_TUP4(null, -1572864, 0, 972); ++ RETURN_UBX_TUP3(972, -1572864, 0); ++ } ++ h$convertDouble[0] = d; ++ var i0 = h$convertInt[0], i1 = h$convertInt[1]; ++ var exp = (i1&2146435072)>>>20; ++ var ret1, ret2 = i0, ret3; ++ if(exp === 0) { // denormal or zero ++ if((i1&2147483647) === 0 && ret2 === 0) { ++ ret1 = 0; ++ ret3 = 0; ++ } else { ++ h$convertDouble[0] = d*9007199254740992; ++ i1 = h$convertInt[1]; ++ ret1 = (i1&1048575)|1048576; ++ ret2 = h$convertInt[0]; ++ ret3 = ((i1&2146435072)>>>20)-1128; ++ } ++ } else { ++ ret3 = exp-1075; ++ ret1 = (i1&1048575)|1048576; ++ } ++ // negate mantissa for negative input ++ if(d < 0) { ++ if(ret2 === 0) { ++ ret1 = ((~ret1) + 1) | 0; ++ // ret2 = 0; ++ } else { ++ ret1 = ~ret1; ++ ret2 = ((~ret2) + 1) | 0; ++ } ++ } ++ // prim ubx tup returns don't return the first value! ++ RETURN_UBX_TUP3(ret3,ret1,ret2); ++} ++ ++// fixme remove this once rebooted ++function h$primop_DoubleDecode_Int64Op(d) { ++ ASSERTVALID_D(d, "DoubleDecode_Int64"); ++ if(isNaN(d)) { ++ // RETURN_UBX_TUP4(null, -1572864, 0, 972); ++ RETURN_UBX_TUP4(null, -1572864, 0, 972); ++ } ++ h$convertDouble[0] = d; ++ var i0 = h$convertInt[0], i1 = h$convertInt[1]; ++ var exp = (i1&2146435072)>>>20; ++ var ret1, ret2 = i0, ret3; ++ if(exp === 0) { // denormal or zero ++ if((i1&2147483647) === 0 && ret2 === 0) { ++ ret1 = 0; ++ ret3 = 0; ++ } else { ++ h$convertDouble[0] = d*9007199254740992; ++ i1 = h$convertInt[1]; ++ ret1 = (i1&1048575)|1048576; ++ ret2 = h$convertInt[0]; ++ ret3 = ((i1&2146435072)>>>20)-1128; ++ } ++ } else { ++ ret3 = exp-1075; ++ ret1 = (i1&1048575)|1048576; ++ } ++ // negate mantissa for negative input ++ if(d < 0) { ++ if(ret2 === 0) { ++ ret1 = ((~ret1) + 1) | 0; ++ // ret2 = 0; ++ } else { ++ ret1 = ~ret1; ++ ret2 = ((~ret2) + 1) | 0; ++ } ++ } ++ // prim ubx tup returns don't return the first value! ++ RETURN_UBX_TUP4(null,ret1,ret2,ret3); ++} ++ ++function h$ghcjsbn_encodeDouble_b(pos, b, e) { ++ ASSERTVALID_B(b, "encodeDouble_b"); ++ ASSERTVALID_S(e, "encodeDouble_b"); ++ if(e >= 972) { ++ return pos ? Infinity : -Infinity; ++ } ++ var ls = 1, bl = b[0], i, r = b[bl], mul = 1 << GHCJSBN_BITS, rmul = 1/mul, s = 1; ++ for(i = bl-1; i >= 1; i--) { ++/* if(e > GHCJSBN_BITS) { ++ e -= GHCJSBN_BITS; ++ s *= rmul; ++ r = r + s * b[i]; ++ } else { */ ++ r = r * mul + s * b[i]; ++// } ++ } ++ // h$log("remaning exp: " + e); ++ if(e > 600) { ++ r = r * Math.pow(2, e-600) * Math.pow(2,600); ++ } else if(e < -600) { ++ r = r * Math.pow(2, e+600) * Math.pow(2,-600); ++ } else { ++ r = r * Math.pow(2, e); ++ } ++ ASSERTVALID_D(r, "encodeDouble_b result"); ++ return pos ? r : -r; ++} ++ ++function h$ghcjsbn_toDouble_b(nonNeg, b) { ++ return h$ghcjsbn_encodeDouble_b(nonNeg, b, 0); ++} ++ ++// fixme ++var h$ghcjsbn_encodeDouble_i = h$ghcjsbn_encodeDouble_s; ++ ++function h$ghcjsbn_encodeDouble_s(m, e) { ++ ASSERTVALID_S(m, "encodeDouble_s m"); ++ ASSERTVALID_S(e, "encodeDouble_s e"); ++ var r = m * Math.pow(2, e); ++ ASSERTVALID_D(r, "encodeDouble_s result"); ++ return r; ++} +diff -Nru upstream/pkg/integer-gmp/src/GHC/Integer/GMP/Internals.hs boot/pkg/integer-gmp/src/GHC/Integer/GMP/Internals.hs +--- upstream/pkg/integer-gmp/src/GHC/Integer/GMP/Internals.hs 2018-01-09 08:27:52.000000000 +0000 ++++ boot/pkg/integer-gmp/src/GHC/Integer/GMP/Internals.hs 2018-01-09 08:27:52.994576047 +0000 +@@ -1,4 +1,5 @@ + {-# LANGUAGE BangPatterns #-} ++ + {-# LANGUAGE CApiFFI #-} + {-# LANGUAGE MagicHash #-} + {-# LANGUAGE UnboxedTuples #-} +@@ -200,10 +201,15 @@ + -- + -- @since 1.0.0.0 + sizeInBaseBigNat :: BigNat -> Int# -> Word# ++#ifdef ghcjs_HOST_OS ++sizeInBaseBigNat (BN# ba#) = js_sizeInBaseBigNat ba# ++foreign import javascript unsafe "h$ghcjsbn_sizeInBase_b($1)" js_sizeInBaseBigNat :: ByteArray# -> Int# -> Word# ++#else + sizeInBaseBigNat bn@(BN# ba#) = c_mpn_sizeinbase# ba# (sizeofBigNat# bn) + + foreign import ccall unsafe "integer_gmp_mpn_sizeinbase" + c_mpn_sizeinbase# :: ByteArray# -> GmpSize# -> Int# -> Word# ++#endif + + -- | Version of 'sizeInBaseInteger' operating on 'Word#' + -- +@@ -225,21 +231,31 @@ + + -- | Version of 'exportIntegerToAddr' operating on 'BigNat's. + exportBigNatToAddr :: BigNat -> Addr# -> Int# -> IO Word ++#ifdef ghcjs_HOST_OS ++exportBigNatToAddr (BN# ba#) addr# e# = js_exportBigNatToAddr ba# addr# e# ++foreign import javascript unsafe "h$ghcjsbn_exportToAddr_b($1,$2_1,$2_2,$3)" js_exportBigNatToAddr :: ByteArray# -> Addr# -> Int# -> IO Word ++#else + exportBigNatToAddr bn@(BN# ba#) addr e + = c_mpn_exportToAddr# ba# (sizeofBigNat# bn) addr 0# e + + foreign import ccall unsafe "integer_gmp_mpn_export" + c_mpn_exportToAddr# :: ByteArray# -> GmpSize# -> Addr# -> Int# -> Int# + -> IO Word ++#endif + + -- | Version of 'exportIntegerToAddr' operating on 'Word's. + exportWordToAddr :: Word -> Addr# -> Int# -> IO Word ++#ifdef ghcjs_HOST_OS ++exportWordToAddr (W# w#) addr# e# = js_exportWordToAddr w# addr# e# ++foreign import javascript unsafe "h$ghcjsb_exportToAddr_w($1,$2_1,$2_2,$3)" js_exportWordToAddr :: Word# -> Addr# -> Int# -> IO Word ++#else + exportWordToAddr (W# w#) addr + = c_mpn_export1ToAddr# w# addr 0# -- TODO: we don't calling GMP for that + + foreign import ccall unsafe "integer_gmp_mpn_export1" + c_mpn_export1ToAddr# :: GmpLimb# -> Addr# -> Int# -> Int# + -> IO Word ++#endif + + -- | Dump 'Integer' (without sign) to mutable byte-array in base-256 + -- representation. +@@ -281,6 +297,10 @@ + -- @since 1.0.0.0 + exportBigNatToMutableByteArray :: BigNat -> MutableByteArray# RealWorld -> Word# + -> Int# -> IO Word ++#ifdef ghcjs_HOST_OS ++exportBigNatToMutableByteArray (BN# ba#) mba# off# msbf# = js_exportBigNatToMutableByteArray ba# mba# off# msbf# ++foreign import javascript unsafe "h$ghcjs_exportToMutableByteArray_b($1,$2,$3,$4)" js_exportBigNatToMutableByteArray :: ByteArray# -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word ++#else + exportBigNatToMutableByteArray bn@(BN# ba#) + = c_mpn_exportToMutableByteArray# ba# (sizeofBigNat# bn) + +@@ -288,18 +308,23 @@ + c_mpn_exportToMutableByteArray# :: ByteArray# -> GmpSize# + -> MutableByteArray# RealWorld -> Word# + -> Int# -> IO Word ++#endif + + -- | Version of 'exportIntegerToMutableByteArray' operating on 'Word's. + -- + -- @since 1.0.0.0 + exportWordToMutableByteArray :: Word -> MutableByteArray# RealWorld -> Word# + -> Int# -> IO Word ++#ifdef ghcjs_HOST_OS ++exportWordToMutableByteArray (W# w#) mba# off# msbf# = js_exportWordToMutableByteArray w# mba# off# msbf# ++foreign import javascript unsafe "h$ghcjs_exportToMutableByteArray_w($1,$2,$3,$4)" js_exportWordToMutableByteArray :: Word# -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word ++#else + exportWordToMutableByteArray (W# w#) = c_mpn_export1ToMutableByteArray# w# + + foreign import ccall unsafe "integer_gmp_mpn_export1" + c_mpn_export1ToMutableByteArray# :: GmpLimb# -> MutableByteArray# RealWorld + -> Word# -> Int# -> IO Word +- ++#endif + + -- | Probalistic Miller-Rabin primality test. + -- +@@ -327,17 +352,27 @@ + -- + -- @since 1.0.0.0 + testPrimeBigNat :: BigNat -> Int# -> Int# ++#ifdef ghcjs_HOST_OS ++testPrimeBigNat (BN# ba#) r# = js_testPrimeBigNat ba# r# ++foreign import javascript unsafe "h$ghcjbn_testPrime_b($1,$2)" js_testPrimeBigNat :: ByteArray# -> Int# -> Int# ++#else + testPrimeBigNat bn@(BN# ba#) = c_integer_gmp_test_prime# ba# (sizeofBigNat# bn) + + foreign import ccall unsafe "integer_gmp_test_prime" + c_integer_gmp_test_prime# :: ByteArray# -> GmpSize# -> Int# -> Int# ++#endif + + -- | Version of 'testPrimeInteger' operating on 'Word#'s + -- + -- @since 1.0.0.0 ++#ifdef ghcjs_HOST_OS ++testPrimeWord# :: GmpLimb# -> Int# -> Int# ++testPrimeWord# w# r# = js_testPrimeWord w# r# ++foreign import javascript unsafe "h$ghcjsbn_testPrime_w($1,$2)" js_testPrimeWord :: Word# -> Int# -> Int# ++#else + foreign import ccall unsafe "integer_gmp_test_prime1" + testPrimeWord# :: GmpLimb# -> Int# -> Int# +- ++#endif + + -- | Compute next prime greater than @/n/@ probalistically. + -- +diff -Nru upstream/pkg/integer-gmp/src/GHC/Integer/Logarithms/Internals.hs boot/pkg/integer-gmp/src/GHC/Integer/Logarithms/Internals.hs +--- upstream/pkg/integer-gmp/src/GHC/Integer/Logarithms/Internals.hs 2018-01-09 08:27:52.000000000 +0000 ++++ boot/pkg/integer-gmp/src/GHC/Integer/Logarithms/Internals.hs 2018-01-09 08:27:52.994576047 +0000 +@@ -2,6 +2,11 @@ + {-# LANGUAGE MagicHash #-} + {-# LANGUAGE UnboxedTuples #-} + {-# LANGUAGE CPP #-} ++#ifdef ghcjs_HOST_OS ++{-# LANGUAGE JavaScriptFFI #-} ++{-# LANGUAGE UnliftedFFITypes #-} ++{-# LANGUAGE GHCForeignImportPrim #-} ++#endif + + {-# OPTIONS_HADDOCK hide #-} + +@@ -47,6 +52,13 @@ + -- First component of result is @log2 n@, second is @0#@ iff /n/ is a + -- power of two. + integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #) ++#if defined(ghcjs_HOST_OS) ++integerLog2IsPowerOf2# x = -- ++ case js_integerLog2IsPowerOf2 (unsafeCoerce# x) of ++ y | isTrue# (y <# 0#) -> (# 0# -# y, 0# #) ++ y -> (# y , 1# #) ++foreign import javascript unsafe "h$ghcjsbn_integerLog2IsPowerOf2($1)" js_integerLog2IsPowerOf2 :: Any -> Int# ++#else + -- The power of 2 test is n&(n-1) == 0, thus powers of 2 + -- are indicated bythe second component being zero. + integerLog2IsPowerOf2# (S# i#) = case int2Word# i# of +@@ -70,7 +82,7 @@ + else case indexBigNat# bn i of + 0## -> test (i -# 1#) + _ -> 1# +- ++#endif + + -- Assumption: Integer and Int# are strictly positive, Int# is less + -- than logBase 2 of Integer, otherwise havoc ensues. +@@ -84,6 +96,10 @@ + -- 1# means we have a half-integer, round to even + -- 2# means round up (away from zero) + roundingMode# :: Integer -> Int# -> Int# ++#if defined(ghcjs_HOST_OS) ++roundingMode# x y = js_roundingMode (unsafeCoerce# x) y ++foreign import javascript unsafe "h$integer_roundingMode($1,$2)" js_roundingMode :: Any -> Int# -> Int# ++#else + roundingMode# (S# i#) t = + case int2Word# i# `and#` ((uncheckedShiftL# 2## t) `minusWord#` 1##) of + k -> case uncheckedShiftL# 1## t of +@@ -116,3 +132,4 @@ + else case indexBigNat# bn i of + 0## -> test (i -# 1#) + _ -> 2# ++#endif +diff -Nru upstream/pkg/integer-gmp/src/GHC/Integer/Logarithms.hs boot/pkg/integer-gmp/src/GHC/Integer/Logarithms.hs +--- upstream/pkg/integer-gmp/src/GHC/Integer/Logarithms.hs 2018-01-09 08:27:52.000000000 +0000 ++++ boot/pkg/integer-gmp/src/GHC/Integer/Logarithms.hs 2018-01-09 08:27:52.994576047 +0000 +@@ -4,6 +4,9 @@ + {-# LANGUAGE UnliftedFFITypes #-} + {-# LANGUAGE CPP #-} + {-# LANGUAGE BangPatterns #-} ++#ifdef ghcjs_HOST_OS ++{-# LANGUAGE GHCForeignImportPrim #-} ++#endif + + module GHC.Integer.Logarithms + ( wordLog2# +@@ -24,6 +27,9 @@ + import GHC.Integer.Type + + import GHC.Prim ++#ifdef ghcjs_HOST_OS ++import GHC.Types ++#endif + + default () + +@@ -41,6 +47,10 @@ + -- + -- Note: Internally uses 'integerLog2#' for base 2 + integerLogBase# :: Integer -> Integer -> Int# ++-- #if defined(ghcjs_HOST_OS) ++-- integerLogBase# x y = js_integerLogBase (unsafeCoerce x) (unsafeCoerce y) ++-- foreign import javascript unsafe "h$integer_integerLogBase($1,$2)" js_integerLogBase :: Any -> Any -> Int# ++-- #else + integerLogBase# (S# 2#) m = integerLog2# m + integerLogBase# b m = e' + where +@@ -50,7 +60,7 @@ + go pw = case go (sqrInteger pw) of + (# q, e #) | q `ltInteger` pw -> (# q, 2# *# e #) + (# q, e #) -> (# q `quotInteger` pw, 2# *# e +# 1# #) +- ++-- #endif + + -- | Calculate the integer base 2 logarithm of an 'Integer'. The + -- calculation is more efficient than for the general case, on +@@ -58,6 +68,10 @@ + -- + -- The argument must be strictly positive, that condition is /not/ checked. + integerLog2# :: Integer -> Int# ++#if defined(ghcjs_HOST_OS) ++integerLog2# x = js_integerLog2 (unsafeCoerce# x) ++foreign import javascript unsafe "h$ghcjsbn_integerLog2($1)" js_integerLog2 :: Any -> Int# ++#else + integerLog2# (S# i#) = wordLog2# (int2Word# i#) + integerLog2# (Jn# _) = -1# + integerLog2# (Jp# bn) = go (s -# 1#) +@@ -66,6 +80,7 @@ + go i = case indexBigNat# bn i of + 0## -> go (i -# 1#) + w -> wordLog2# w +# (uncheckedIShiftL# i LD_WORD_SIZE_IN_BITS#) ++#endif + + -- | Compute base-2 log of 'Word#' + -- +diff -Nru upstream/pkg/integer-gmp/src/GHC/Integer/Type.hs boot/pkg/integer-gmp/src/GHC/Integer/Type.hs +--- upstream/pkg/integer-gmp/src/GHC/Integer/Type.hs 2018-01-09 08:27:52.000000000 +0000 ++++ boot/pkg/integer-gmp/src/GHC/Integer/Type.hs 2018-01-09 08:27:52.994576047 +0000 +@@ -9,6 +9,9 @@ + {-# LANGUAGE RebindableSyntax #-} + {-# LANGUAGE NegativeLiterals #-} + {-# LANGUAGE ExplicitForAll #-} ++#if defined(ghcjs_HOST_OS) ++{-# LANGUAGE JavaScriptFFI #-} ++#endif + + -- | + -- Module : GHC.Integer.Type +@@ -172,6 +175,14 @@ + -- significant first (ideally these would be machine-word + -- 'Word's rather than 31-bit truncated 'Int's) + -> Integer ++#if defined(ghcjs_HOST_OS) ++mkInteger nonNegative is = ++ seqList is `seq` unsafeCoerce# (js_mkInteger nonNegative (unsafeCoerce# is)) ++ where ++ seqList [] = () ++ seqList (x:xs) = x `seq` seqList xs ++foreign import javascript unsafe "h$ghcjsbn_mkInteger($1,$2)" js_mkInteger :: Bool -> Any -> Any ++#else + mkInteger nonNegative is + | nonNegative = f is + | True = negateInteger (f is) +@@ -179,6 +190,7 @@ + f [] = S# 0# + f (I# i : is') = smallInteger (i `andI#` 0x7fffffff#) `orInteger` + shiftLInteger (f is') 31# ++#endif + {-# CONSTANT_FOLDED mkInteger #-} + + -- | Test whether all internal invariants are satisfied by 'Integer' value +@@ -204,6 +216,10 @@ + + #if WORD_SIZE_IN_BITS < 64 + int64ToInteger :: Int64# -> Integer ++#if defined(ghcjs_HOST_OS) ++int64ToInteger i = unsafeCoerce# (js_int64ToInteger i) ++foreign import javascript unsafe "h$integer_int64ToInteger($1_1,$1_2)" js_int64ToInteger :: Int64# -> Any ++#else + int64ToInteger i + | isTrue# (i `leInt64#` intToInt64# 0x7FFFFFFF#) + , isTrue# (i `geInt64#` intToInt64# -0x80000000#) +@@ -212,6 +228,7 @@ + = Jp# (word64ToBigNat (int64ToWord64# i)) + | True + = Jn# (word64ToBigNat (int64ToWord64# (negateInt64# i))) ++#endif + {-# CONSTANT_FOLDED int64ToInteger #-} + + word64ToInteger :: Word64# -> Integer +@@ -235,7 +252,18 @@ + = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatToWord64 bn))) + {-# CONSTANT_FOLDED integerToWord64 #-} + +-#if GMP_LIMB_BITS == 32 ++#if defined(ghcjs_HOST_OS) ++word64ToBigNat :: Word64# -> BigNat ++word64ToBigNat w64 = BN# (js_word64ToBigNat w64) ++ ++bigNatToWord64 :: BigNat -> Word64# ++bigNatToWord64 (BN# bn) = js_bigNatToWord64 bn ++ ++foreign import javascript unsafe "h$ghcjsbn_mkBigNat_ww($1_1, $1_2)" ++ js_word64ToBigNat :: Word64# -> ByteArray# ++foreign import javascript unsafe "$r1 = h$ghcjsbn_toWord64_b($1); $r2 = h$ret1;" -- fixme tuple returns ++ js_bigNatToWord64 :: ByteArray# -> Word64# ++#elif GMP_LIMB_BITS == 32 + word64ToBigNat :: Word64# -> BigNat + word64ToBigNat w64 = wordToBigNat2 wh# wl# + where +@@ -514,18 +542,28 @@ + (# h ,l #) -> Jp# (wordToBigNat2 h l) + + bigNatToInteger :: BigNat -> Integer ++#ifdef ghcjs_HOST_OS ++bigNatToInteger (BN# bn) = unsafeCoerce# (js_bigNatToInteger bn) ++foreign import javascript unsafe "h$ghcjsbn_toInteger_b($1)" js_bigNatToInteger :: ByteArray# -> Any ++#else + bigNatToInteger bn + | isTrue# ((sizeofBigNat# bn ==# 1#) `andI#` (i# >=# 0#)) = S# i# + | True = Jp# bn + where + i# = word2Int# (bigNatToWord bn) ++#endif + + bigNatToNegInteger :: BigNat -> Integer ++#ifdef ghcjs_HOST_OS ++bigNatToNegInteger (BN# bn) = unsafeCoerce# (js_bigNatToNegInteger bn) ++foreign import javascript unsafe "h$ghcjsbn_toNegInteger_b($1)" js_bigNatToNegInteger :: ByteArray# -> Any ++#else + bigNatToNegInteger bn + | isTrue# ((sizeofBigNat# bn ==# 1#) `andI#` (i# <=# 0#)) = S# i# + | True = Jn# bn + where + i# = negateInt# (word2Int# (bigNatToWord bn)) ++#endif + + -- | Count number of set bits. For negative arguments returns negative + -- population count of negated argument. +@@ -795,6 +833,10 @@ + + -- | Compute least common multiple. + lcmInteger :: Integer -> Integer -> Integer ++-- #if defined(ghcjs_HOST_OS) ++-- lcmInteger x y = unsafeCoerce (js_lcmInteger (unsafeCoerce x) (unsafeCoerce y)) ++-- foreign import javascript unsafe "h$integer_lcmInteger($1,$2)" js_lcmInteger :: Any -> Any -> Any ++-- #else + lcmInteger (S# 0#) !_ = S# 0# + lcmInteger (S# 1#) b = absInteger b + lcmInteger (S# -1#) b = absInteger b +@@ -805,6 +847,7 @@ + where + aa = absInteger a + ab = absInteger b ++-- #endif + {-# CONSTANT_FOLDED lcmInteger #-} + + -- | Compute greatest common divisor. +@@ -825,6 +868,13 @@ + -- BigNat operations + + compareBigNat :: BigNat -> BigNat -> Ordering ++#ifdef ghcjs_HOST_OS ++compareBigNat (BN# x#) (BN# y#) = case (js_compareBigNat x# y#) of ++ 0# -> LT ++ 1# -> EQ ++ _ -> GT ++foreign import javascript unsafe "h$ghcjsbn_cmp_bb($1,$2)" js_compareBigNat :: ByteArray# -> ByteArray# -> Int# ++#else + compareBigNat x@(BN# x#) y@(BN# y#) + | isTrue# (nx# ==# ny#) + = compareInt# (narrowCInt# (c_mpn_cmp x# y# nx#)) 0# +@@ -833,76 +883,150 @@ + where + nx# = sizeofBigNat# x + ny# = sizeofBigNat# y ++#endif + + compareBigNatWord :: BigNat -> GmpLimb# -> Ordering ++#ifdef ghcjs_HOST_OS ++compareBigNatWord (BN# bn#) w# = case js_compareBigNatWord bn# w# of ++ 0# -> LT ++ 1# -> EQ ++ _ -> GT ++foreign import javascript unsafe "h$ghcjsbn_cmp_bw($1,$2)" js_compareBigNatWord :: ByteArray# -> Word# -> Int# ++#else + compareBigNatWord bn w# + | isTrue# (sizeofBigNat# bn ==# 1#) = cmpW# (bigNatToWord bn) w# + | True = GT ++#endif + + gtBigNatWord# :: BigNat -> GmpLimb# -> Int# ++#ifdef ghcjs_HOST_OS ++gtBigNatWord# (BN# bn#) w# = case js_gtBigNatWord bn# w# of ++ False -> 0# ++ _ -> 1# ++foreign import javascript unsafe "h$ghcjsbn_gt_bw($1,$2)" js_gtBigNatWord :: ByteArray# -> Word# -> Bool ++#else + gtBigNatWord# bn w# + = (sizeofBigNat# bn ># 1#) `orI#` (bigNatToWord bn `gtWord#` w#) ++#endif + + eqBigNat :: BigNat -> BigNat -> Bool ++#ifdef ghcjs_HOST_OS ++eqBigNat (BN# x#) (BN# y#) = js_eqBigNat x# y# ++foreign import javascript unsafe "h$ghcjsbn_eq_bb($1,$2)" js_eqBigNat :: ByteArray# -> ByteArray# -> Bool ++#else + eqBigNat x y = isTrue# (eqBigNat# x y) ++#endif + + eqBigNat# :: BigNat -> BigNat -> Int# ++#ifdef ghcjs_HOST_OS ++eqBigNat# (BN# x#) (BN# y#) = case js_eqBigNat x# y# of ++ False -> 0# ++ _ -> 1# ++#else + eqBigNat# x@(BN# x#) y@(BN# y#) + | isTrue# (nx# ==# ny#) = c_mpn_cmp x# y# nx# ==# 0# + | True = 0# + where + nx# = sizeofBigNat# x + ny# = sizeofBigNat# y ++#endif + + neqBigNat# :: BigNat -> BigNat -> Int# ++#ifdef ghcjs_HOST_OS ++neqBigNat# (BN# x#) (BN# y#) = case js_neqBigNat x# y# of ++ False -> 0# ++ _ -> 1# ++foreign import javascript unsafe "h$ghcjsbn_neq_bb($1,$2)" js_neqBigNat :: ByteArray# -> ByteArray# -> Bool ++#else + neqBigNat# x@(BN# x#) y@(BN# y#) + | isTrue# (nx# ==# ny#) = c_mpn_cmp x# y# nx# /=# 0# + | True = 1# + where + nx# = sizeofBigNat# x + ny# = sizeofBigNat# y ++#endif + + eqBigNatWord :: BigNat -> GmpLimb# -> Bool ++#ifdef ghcjs_HOST_OS ++eqBigNatWord (BN# bn#) w# = js_eqBigNatWord bn# w# ++foreign import javascript unsafe "h$ghcjsbn_eq_bw($1,$2)" js_eqBigNatWord :: ByteArray# -> GmpLimb# -> Bool ++#else + eqBigNatWord bn w# = isTrue# (eqBigNatWord# bn w#) ++#endif + + eqBigNatWord# :: BigNat -> GmpLimb# -> Int# ++#ifdef ghcjs_HOST_OS ++eqBigNatWord# (BN# bn#) w# = case js_eqBigNatWord bn# w# of ++ False -> 0# ++ _ -> 1# ++#else + eqBigNatWord# bn w# + = (sizeofBigNat# bn ==# 1#) `andI#` (bigNatToWord bn `eqWord#` w#) +- ++#endif + + -- | Same as @'indexBigNat#' bn 0\#@ + bigNatToWord :: BigNat -> Word# ++#ifdef ghcjs_HOST_OS ++bigNatToWord (BN# bn#) = js_bigNatToWord bn# ++foreign import javascript unsafe "h$ghcjsbn_toWord_b($1)" js_bigNatToWord :: ByteArray# -> Word# ++#else + bigNatToWord bn = indexBigNat# bn 0# ++#endif + + -- | Equivalent to @'word2Int#' . 'bigNatToWord'@ + bigNatToInt :: BigNat -> Int# ++#ifdef ghcjs_HOST_OS ++bigNatToInt (BN# bn#) = js_bigNatToInt bn# ++foreign import javascript unsafe "h$ghcjsbn_toInt_b($1)" js_bigNatToInt :: ByteArray# -> Int# ++#else + bigNatToInt (BN# ba#) = indexIntArray# ba# 0# ++#endif + + -- | CAF representing the value @0 :: BigNat@ + zeroBigNat :: BigNat ++#ifdef ghcjs_HOST_OS ++zeroBigNat = BN# (js_zeroBigNat 0#) ++foreign import javascript unsafe "$r = h$ghcjsbn_zero_b;" js_zeroBigNat :: Int# -> ByteArray# ++#else + zeroBigNat = runS $ do + mbn <- newBigNat# 1# + _ <- svoid (writeBigNat# mbn 0# 0##) + unsafeFreezeBigNat# mbn ++#endif + {-# NOINLINE zeroBigNat #-} + + -- | Test if 'BigNat' value is equal to zero. + isZeroBigNat :: BigNat -> Bool ++#ifdef ghcjs_HOST_OS ++isZeroBigNat (BN# b#) = js_isZeroBigNat b# ++foreign import javascript unsafe "h$ghcjsbn_isZero_b($1)" js_isZeroBigNat :: ByteArray# -> Bool ++#else + isZeroBigNat bn = eqBigNatWord bn 0## ++#endif + + -- | CAF representing the value @1 :: BigNat@ + oneBigNat :: BigNat ++#ifdef ghcjs_HOST_OS ++oneBigNat = BN# (js_oneBigNat 0#) ++foreign import javascript unsafe "$r = h$ghcjsbn_one_b;" js_oneBigNat :: Int# -> ByteArray# ++#else + oneBigNat = runS $ do + mbn <- newBigNat# 1# + _ <- svoid (writeBigNat# mbn 0# 1##) + unsafeFreezeBigNat# mbn ++#endif + {-# NOINLINE oneBigNat #-} + + czeroBigNat :: BigNat ++#ifdef ghcjs_HOST_OS ++czeroBigNat = BN# (js_czeroBigNat 0#) ++foreign import javascript unsafe "$r = h$ghcjsbn_czero_b;" js_czeroBigNat :: Int# -> ByteArray# ++#else + czeroBigNat = runS $ do + mbn <- newBigNat# 1# + _ <- svoid (writeBigNat# mbn 0# (not# 0##)) + unsafeFreezeBigNat# mbn ++#endif + {-# NOINLINE czeroBigNat #-} + + -- | Special 0-sized bigNat returned in case of arithmetic underflow +@@ -919,15 +1043,29 @@ + -- + -- NB: @isValidBigNat# nullBigNat@ is false + nullBigNat :: BigNat ++#ifdef ghcjs_HOST_OS ++nullBigNat = BN# (js_nullBigNat 0#) ++foreign import javascript unsafe "$r = h$ghcjsbn_null_b;" js_nullBigNat :: Int# -> ByteArray# ++#else + nullBigNat = runS (newBigNat# 0# >>= unsafeFreezeBigNat#) ++#endif + {-# NOINLINE nullBigNat #-} + + -- | Test for special 0-sized 'BigNat' representing underflows. + isNullBigNat# :: BigNat -> Int# ++#ifdef ghcjs_HOST_OS ++isNullBigNat# (BN# ba#) = js_isNullBigNat# ba# ++foreign import javascript unsafe "h$ghcjsbn_isNull_b($1)" js_isNullBigNat# :: ByteArray# -> Int# ++#else + isNullBigNat# (BN# ba#) = sizeofByteArray# ba# ==# 0# ++#endif + + -- | Construct 1-limb 'BigNat' from 'Word#' + wordToBigNat :: Word# -> BigNat ++#ifdef ghcjs_HOST_OS ++wordToBigNat w# = BN# (js_wordToBigNat w#) ++foreign import javascript unsafe "h$ghcjsbn_mkBigNat_w($1)" js_wordToBigNat :: Word# -> ByteArray# ++#else + wordToBigNat 0## = zeroBigNat + wordToBigNat 1## = oneBigNat + wordToBigNat w# +@@ -936,18 +1074,28 @@ + mbn <- newBigNat# 1# + _ <- svoid (writeBigNat# mbn 0# w#) + unsafeFreezeBigNat# mbn ++#endif + + -- | Construct BigNat from 2 limbs. + -- The first argument is the most-significant limb. + wordToBigNat2 :: Word# -> Word# -> BigNat ++#ifdef ghcjs_HOST_OS ++wordToBigNat2 hw# lw# = BN# (js_wordToBigNat2 hw# lw#) ++foreign import javascript unsafe "h$ghcjsbn_mkBigNat_ww($1,$2)" js_wordToBigNat2 :: Word# -> Word# -> ByteArray# ++#else + wordToBigNat2 0## lw# = wordToBigNat lw# + wordToBigNat2 hw# lw# = runS $ do + mbn <- newBigNat# 2# + _ <- svoid (writeBigNat# mbn 0# lw#) + _ <- svoid (writeBigNat# mbn 1# hw#) + unsafeFreezeBigNat# mbn ++#endif + + plusBigNat :: BigNat -> BigNat -> BigNat ++#ifdef ghcjs_HOST_OS ++plusBigNat (BN# x#) (BN# y#) = BN# (js_plusBigNat x# y#) ++foreign import javascript unsafe "h$ghcjsbn_add_bb($1,$2)" js_plusBigNat :: ByteArray# -> ByteArray# -> ByteArray# ++#else + plusBigNat x y + | isTrue# (eqBigNatWord# x 0##) = y + | isTrue# (eqBigNatWord# y 0##) = x +@@ -963,9 +1111,14 @@ + + nx# = sizeofBigNat# x + ny# = sizeofBigNat# y ++#endif + + plusBigNatWord :: BigNat -> GmpLimb# -> BigNat + plusBigNatWord x 0## = x ++#ifdef ghcjs_HOST_OS ++plusBigNatWord (BN# x#) y# = BN# (js_plusBigNatWord x# y#) ++foreign import javascript unsafe "h$ghcjsbn_add_bw($1,$2)" js_plusBigNatWord :: ByteArray# -> GmpLimb# -> ByteArray# ++#else + plusBigNatWord x@(BN# x#) y# = runS $ do + mbn@(MBN# mba#) <- newBigNat# nx# + (W# c#) <- liftIO (c_mpn_add_1 mba# x# nx# y#) +@@ -974,9 +1127,14 @@ + _ -> unsafeSnocFreezeBigNat# mbn c# + where + nx# = sizeofBigNat# x ++#endif + + -- | Returns 'nullBigNat' (see 'isNullBigNat#') in case of underflow + minusBigNat :: BigNat -> BigNat -> BigNat ++#ifdef ghcjs_HOST_OS ++minusBigNat (BN# x#) (BN# y#) = BN# (js_minusBigNat x# y#) ++foreign import javascript unsafe "h$ghcjsbn_sub_bb($1,$2)" js_minusBigNat :: ByteArray# -> ByteArray# -> ByteArray# ++#else + minusBigNat x@(BN# x#) y@(BN# y#) + | isZeroBigNat y = x + | isTrue# (nx# >=# ny#) = runS $ do +@@ -990,10 +1148,15 @@ + where + nx# = sizeofBigNat# x + ny# = sizeofBigNat# y ++#endif + + -- | Returns 'nullBigNat' (see 'isNullBigNat#') in case of underflow + minusBigNatWord :: BigNat -> GmpLimb# -> BigNat + minusBigNatWord x 0## = x ++#ifdef ghcjs_HOST_OS ++minusBigNatWord (BN# x#) y# = BN# (js_minusBigNatWord x# y#) ++foreign import javascript unsafe "h$ghcjsbn_sub_bw($1,$2)" js_minusBigNatWord :: ByteArray# -> Word# -> ByteArray# ++#else + minusBigNatWord x@(BN# x#) y# = runS $ do + mbn@(MBN# mba#) <- newBigNat# nx# + (W# b#) <- liftIO $ c_mpn_sub_1 mba# x# nx# y# +@@ -1002,12 +1165,16 @@ + _ -> return nullBigNat + where + nx# = sizeofBigNat# x +- ++#endif + + timesBigNat :: BigNat -> BigNat -> BigNat + timesBigNat x y + | isZeroBigNat x = zeroBigNat + | isZeroBigNat y = zeroBigNat ++#ifdef ghcjs_HOST_OS ++ | True = case x of (BN# x#) -> case y of (BN# y#) -> BN# (js_timesBigNat x# y#) ++foreign import javascript unsafe "h$ghcjsbn_mul_bb($1,$2)" js_timesBigNat :: ByteArray# -> ByteArray# -> ByteArray# ++#else + | isTrue# (nx# >=# ny#) = go x nx# y ny# + | True = go y ny# x nx# + where +@@ -1021,15 +1188,25 @@ + + nx# = sizeofBigNat# x + ny# = sizeofBigNat# y ++#endif + + -- | Square 'BigNat' + sqrBigNat :: BigNat -> BigNat + sqrBigNat x + | isZeroBigNat x = zeroBigNat + -- TODO: 1-limb BigNats below sqrt(maxBound::GmpLimb) ++#ifdef ghcjs_HOST_OS ++sqrBigNat (BN# x#) = BN# (js_sqrBigNat x#) ++foreign import javascript unsafe "h$ghcjsnb_sqr_b($1)" js_sqrBigNat :: ByteArray# -> ByteArray# ++#else + sqrBigNat x = timesBigNat x x -- TODO: mpn_sqr ++#endif + + timesBigNatWord :: BigNat -> GmpLimb# -> BigNat ++#ifdef ghcjs_HOST_OS ++timesBigNatWord (BN# x#) y# = BN# (js_timesBigNatWord x# y#) ++foreign import javascript unsafe "h$ghcjsbn_mul_bw($1,$2)" js_timesBigNatWord :: ByteArray# -> GmpLimb# -> ByteArray# ++#else + timesBigNatWord !_ 0## = zeroBigNat + timesBigNatWord x 1## = x + timesBigNatWord x@(BN# x#) y# +@@ -1045,6 +1222,7 @@ + + where + nx# = sizeofBigNat# x ++#endif + + -- | Specialised version of + -- +@@ -1055,6 +1233,10 @@ + bitBigNat i# + | isTrue# (i# <# 0#) = zeroBigNat -- or maybe 'nullBigNat'? + | isTrue# (i# ==# 0#) = oneBigNat ++#ifdef ghcjs_HOST_OS ++ | True = BN# (js_bitBigNat i#) ++foreign import javascript unsafe "h$ghcjsbn_bitBigNat($1)" js_bitBigNat :: Int# -> ByteArray# ++#else + | True = runS $ do + mbn@(MBN# mba#) <- newBigNat# (li# +# 1#) + -- FIXME: do we really need to zero-init MBAs returned by 'newByteArray#'? +@@ -1065,8 +1247,13 @@ + unsafeFreezeBigNat# mbn + where + !(# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS# ++#endif + + testBitBigNat :: BigNat -> Int# -> Bool ++#ifdef ghcjs_HOST_OS ++testBitBigNat (BN# bn#) i# = js_testBitBigNat bn# i# ++foreign import javascript unsafe "h$ghcjsbn_testBit_b($1,$2)" js_testBitBigNat :: ByteArray# -> Int# -> Bool ++#else + testBitBigNat bn i# + | isTrue# (i# <# 0#) = False + | isTrue# (li# <# nx#) = isTrue# (testBitWord# (indexBigNat# bn li#) bi#) +@@ -1074,8 +1261,13 @@ + where + !(# li#, bi# #) = quotRemInt# i# GMP_LIMB_BITS# + nx# = sizeofBigNat# bn ++#endif + + testBitNegBigNat :: BigNat -> Int# -> Bool ++#ifdef ghcjs_HOST_OS ++testBitNegBigNat (BN# bn#) i# = js_testBitNegBigNat bn# i# ++foreign import javascript unsafe "h$ghcjsbn_testBitNeg_b($1,$2)" js_testBitNegBigNat :: ByteArray# -> Int# -> Bool ++#else + testBitNegBigNat bn i# + | isTrue# (i# <# 0#) = False + | isTrue# (li# >=# nx#) = True +@@ -1089,13 +1281,22 @@ + allZ 0# = True + allZ j | isTrue# (indexBigNat# bn (j -# 1#) `eqWord#` 0##) = allZ (j -# 1#) + | True = False ++#endif + + popCountBigNat :: BigNat -> Int# ++#ifdef ghcjs_HOST_OS ++popCountBigNat (BN# bn#) = js_popCountBigNat bn# ++foreign import javascript unsafe "h$ghcjsbn_popCount_b($1)" js_popCountBigNat :: ByteArray# -> Int# ++#else + popCountBigNat bn@(BN# ba#) = word2Int# (c_mpn_popcount ba# (sizeofBigNat# bn)) +- ++#endif + + shiftLBigNat :: BigNat -> Int# -> BigNat + shiftLBigNat x 0# = x ++#ifdef ghcjs_HOST_OS ++shiftLBigNat (BN# bn#) x# = BN# (js_shiftLBigNat bn# x#) ++foreign import javascript unsafe "h$ghcjsbn_shl_b($1,$2)" js_shiftLBigNat :: ByteArray# -> Int# -> ByteArray# ++#else + shiftLBigNat x _ | isZeroBigNat x = zeroBigNat + shiftLBigNat x@(BN# xba#) n# = runS $ do + ymbn@(MBN# ymba#) <- newBigNat# yn# +@@ -1107,11 +1308,15 @@ + xn# = sizeofBigNat# x + yn# = xn# +# nlimbs# +# (nbits# /=# 0#) + !(# nlimbs#, nbits# #) = quotRemInt# n# GMP_LIMB_BITS# +- ++#endif + + + shiftRBigNat :: BigNat -> Int# -> BigNat + shiftRBigNat x 0# = x ++#ifdef ghcjs_HOST_OS ++shiftRBigNat (BN# x#) n# = BN# (js_shiftRBigNat x# n#) ++foreign import javascript unsafe "h$ghcjsbn_shr_b($1,$2)" js_shiftRBigNat :: ByteArray# -> Int# -> ByteArray# ++#else + shiftRBigNat x _ | isZeroBigNat x = zeroBigNat + shiftRBigNat x@(BN# xba#) n# + | isTrue# (nlimbs# >=# xn#) = zeroBigNat +@@ -1125,9 +1330,14 @@ + xn# = sizeofBigNat# x + yn# = xn# -# nlimbs# + nlimbs# = quotInt# n# GMP_LIMB_BITS# ++#endif + + shiftRNegBigNat :: BigNat -> Int# -> BigNat + shiftRNegBigNat x 0# = x ++#ifdef ghcjs_HOST_OS ++shiftRNegBigNat (BN# x#) n# = BN# (js_shiftRNegBigNat x# n#) ++foreign import javascript unsafe "h$ghcjsbn_shr_neg_b($1,$2)" js_shiftRNegBigNat :: ByteArray# -> Int# -> ByteArray# ++#else + shiftRNegBigNat x _ | isZeroBigNat x = zeroBigNat + shiftRNegBigNat x@(BN# xba#) n# + | isTrue# (nlimbs# >=# xn#) = zeroBigNat +@@ -1141,9 +1351,13 @@ + xn# = sizeofBigNat# x + yn# = xn# -# nlimbs# + nlimbs# = quotInt# (n# -# 1#) GMP_LIMB_BITS# +- ++#endif + + orBigNat :: BigNat -> BigNat -> BigNat ++#ifdef ghcjs_HOST_OS ++orBigNat (BN# x#) (BN# y#) = BN# (js_orBigNat x# y#) ++foreign import javascript unsafe "h$ghcjsbn_or_bb($1,$2)" js_orBigNat :: ByteArray# -> ByteArray# -> ByteArray# ++#else + orBigNat x@(BN# x#) y@(BN# y#) + | isZeroBigNat x = y + | isZeroBigNat y = x +@@ -1160,9 +1374,13 @@ + + nx# = sizeofBigNat# x + ny# = sizeofBigNat# y +- ++#endif + + xorBigNat :: BigNat -> BigNat -> BigNat ++#ifdef ghcjs_HOST_OS ++xorBigNat (BN# x#) (BN# y#) = BN# (js_xorBigNat x# y#) ++foreign import javascript unsafe "h$ghcjsbn_xor_bb($1,$2)" js_xorBigNat :: ByteArray# -> ByteArray# -> ByteArray# ++#else + xorBigNat x@(BN# x#) y@(BN# y#) + | isZeroBigNat x = y + | isZeroBigNat y = x +@@ -1179,9 +1397,14 @@ + + nx# = sizeofBigNat# x + ny# = sizeofBigNat# y ++#endif + + -- | aka @\x y -> x .&. (complement y)@ + andnBigNat :: BigNat -> BigNat -> BigNat ++#ifdef ghcjs_HOST_OS ++andnBigNat (BN# x#) (BN# y#) = BN# (js_andnBigNat x# y#) ++foreign import javascript unsafe "h$ghcjsbn_andn_bb($1,$2)" js_andnBigNat :: ByteArray# -> ByteArray# -> ByteArray# ++#else + andnBigNat x@(BN# x#) y@(BN# y#) + | isZeroBigNat x = zeroBigNat + | isZeroBigNat y = x +@@ -1197,9 +1420,13 @@ + | True = ny# + nx# = sizeofBigNat# x + ny# = sizeofBigNat# y +- ++#endif + + andBigNat :: BigNat -> BigNat -> BigNat ++#ifdef ghcjs_HOST_OS ++andBigNat (BN# x#) (BN# y#) = BN# (js_andBigNat x# y#) ++foreign import javascript unsafe "h$ghcjsbn_and_bb($1,$2)" js_andBigNat :: ByteArray# -> ByteArray# -> ByteArray# ++#else + andBigNat x@(BN# x#) y@(BN# y#) + | isZeroBigNat x = zeroBigNat + | isZeroBigNat y = zeroBigNat +@@ -1212,6 +1439,7 @@ + | True = ny# + nx# = sizeofBigNat# x + ny# = sizeofBigNat# y ++#endif + + -- | If divisor is zero, @(\# 'nullBigNat', 'nullBigNat' \#)@ is returned + quotRemBigNat :: BigNat -> BigNat -> (# BigNat,BigNat #) +@@ -1219,6 +1447,10 @@ + | isZeroBigNat d = (# nullBigNat, nullBigNat #) + | eqBigNatWord d 1## = (# n, zeroBigNat #) + | n < d = (# zeroBigNat, n #) ++#ifdef ghcjs_HOST_OS ++ | True = case js_quotRemBigNat nba# dba# of (# q, r #) -> (# BN# q, BN# r #) ++foreign import javascript unsafe "$r1 = []; $r2 = []; h$ghcjsbn_quotRem_bb($r1,$r2,$1,$2);" js_quotRemBigNat :: ByteArray# -> ByteArray# -> (# ByteArray#, ByteArray# #) ++#else + | True = case runS go of (!q,!r) -> (# q, r #) + where + nn# = sizeofBigNat# n +@@ -1235,12 +1467,17 @@ + q <- unsafeRenormFreezeBigNat# qmbn + r <- unsafeRenormFreezeBigNat# rmbn + return (q, r) ++#endif + + quotBigNat :: BigNat -> BigNat -> BigNat + quotBigNat n@(BN# nba#) d@(BN# dba#) + | isZeroBigNat d = nullBigNat + | eqBigNatWord d 1## = n + | n < d = zeroBigNat ++#ifdef ghcjs_HOST_OS ++ | True = BN# (js_quotBigNat nba# dba#) ++foreign import javascript unsafe "h$ghcjsbn_quot_bb($1,$2)" js_quotBigNat :: ByteArray# -> ByteArray# -> ByteArray# ++#else + | True = runS $ do + let nn# = sizeofBigNat# n + let dn# = sizeofBigNat# d +@@ -1248,23 +1485,34 @@ + qmbn@(MBN# qmba#) <- newBigNat# qn# + _ <- liftIO (c_mpn_tdiv_q qmba# nba# nn# dba# dn#) + unsafeRenormFreezeBigNat# qmbn ++#endif + + remBigNat :: BigNat -> BigNat -> BigNat + remBigNat n@(BN# nba#) d@(BN# dba#) + | isZeroBigNat d = nullBigNat + | eqBigNatWord d 1## = zeroBigNat + | n < d = n ++#ifdef ghcjs_HOST_OS ++ | True = BN# (js_remBigNat nba# dba#) ++foreign import javascript unsafe "h$ghcjsbn_rem_bb($1,$2)" js_remBigNat :: ByteArray# -> ByteArray# -> ByteArray# ++#else + | True = runS $ do + let nn# = sizeofBigNat# n + let dn# = sizeofBigNat# d + rmbn@(MBN# rmba#) <- newBigNat# dn# + _ <- liftIO (c_mpn_tdiv_r rmba# nba# nn# dba# dn#) + unsafeRenormFreezeBigNat# rmbn ++#endif + + -- | Note: Result of div/0 undefined + quotRemBigNatWord :: BigNat -> GmpLimb# -> (# BigNat, GmpLimb# #) + quotRemBigNatWord !_ 0## = (# nullBigNat, 0## #) + quotRemBigNatWord n 1## = (# n, 0## #) ++#ifdef ghcjs_HOST_OS ++quotRemBigNatWord (BN# nba#) d# = ++ case js_quotRemBigNatWord nba# d# of (# ba, w #) -> (# BN# ba, w #) ++foreign import javascript unsafe "$r1 = []; $r2 = h$ghcjsbn_quotRem_bw($r1,$1,$2);" js_quotRemBigNatWord :: ByteArray# -> Word# -> (# ByteArray#, Word# #) ++#else + quotRemBigNatWord n@(BN# nba#) d# = case compareBigNatWord n d# of + LT -> (# zeroBigNat, bigNatToWord n #) + EQ -> (# oneBigNat, 0## #) +@@ -1276,21 +1524,36 @@ + r <- liftIO (c_mpn_divrem_1 qmba# 0# nba# nn# d#) + q <- unsafeRenormFreezeBigNat# qmbn + return (q,r) ++#endif + + quotBigNatWord :: BigNat -> GmpLimb# -> BigNat + quotBigNatWord n d# = case inline quotRemBigNatWord n d# of (# q, _ #) -> q + + -- | div/0 not checked + remBigNatWord :: BigNat -> GmpLimb# -> Word# ++#ifdef ghcjs_HOST_OS ++remBigNatWord (BN# ba#) w# = js_remBigNatWord ba# w# ++foreign import javascript unsafe "h$ghcjsbn_rem_bw($1,$2)" js_remBigNatWord :: ByteArray# -> Word# -> Word# ++#else + remBigNatWord n@(BN# nba#) d# = c_mpn_mod_1 nba# (sizeofBigNat# n) d# ++#endif + + gcdBigNatWord :: BigNat -> Word# -> Word# ++#ifdef ghcjs_HOST_OS ++gcdBigNatWord (BN# ba#) w# = js_gcdBigNatWord ba# w# ++foreign import javascript unsafe "h$ghcjsbn_gcd_bw($1,$2)" js_gcdBigNatWord :: ByteArray# -> Word# -> Word# ++#else + gcdBigNatWord bn@(BN# ba#) = c_mpn_gcd_1# ba# (sizeofBigNat# bn) ++#endif + + gcdBigNat :: BigNat -> BigNat -> BigNat + gcdBigNat x@(BN# x#) y@(BN# y#) + | isZeroBigNat x = y + | isZeroBigNat y = x ++#ifdef ghcjs_HOST_OS ++ | True = BN# (js_gcdBigNat x# y#) ++foreign import javascript unsafe "h$ghcjsbn_gcd_bb($1,$2)" js_gcdBigNat :: ByteArray# -> ByteArray# -> ByteArray# ++#else + | isTrue# (nx# >=# ny#) = runS (gcd' x# nx# y# ny#) + | True = runS (gcd' y# ny# x# nx#) + where +@@ -1304,6 +1567,7 @@ + + nx# = sizeofBigNat# x + ny# = sizeofBigNat# y ++#endif + + -- | Extended euclidean algorithm. + -- +@@ -1323,6 +1587,20 @@ + + -- internal helper + gcdExtSBigNat :: SBigNat -> SBigNat -> (# BigNat, SBigNat #) ++#ifdef ghcjs_HOST_OS ++gcdExtSBigNat x y = ++ case js_gcdExtSBigNat xPos x# yPos y# of ++ (# b1#, b2#, False #) -> (# BN# b1#, NegBN (BN# b2#) #) ++ (# b1#, b2#, _ #) -> (# BN# b1#, PosBN (BN# b2#) #) ++ where ++ xPos = case x of (NegBN {}) -> False ++ _ -> True ++ yPos = case y of (NegBN {}) -> False ++ _ -> True ++ !(BN# x#) = absSBigNat x ++ !(BN# y#) = absSBigNat y ++foreign import javascript unsafe "$r1 = []; $r2 = []; $r3 = h$ghcjsbn_gcdExtSBigNat($r1,$r2,$1,$2,$3,$4)" js_gcdExtSBigNat :: Bool -> ByteArray# -> Bool -> ByteArray# -> (# ByteArray#, ByteArray#, Bool #) ++#else + gcdExtSBigNat x y = case runS go of (g,s) -> (# g, s #) + where + go = do +@@ -1343,6 +1621,7 @@ + yn# = ssizeofSBigNat# y + + gn0# = minI# (absI# xn#) (absI# yn#) ++#endif + + ---------------------------------------------------------------------------- + -- modular exponentiation +@@ -1396,6 +1675,17 @@ + + -- internal non-exported helper + powModSBigNat :: SBigNat -> SBigNat -> BigNat -> BigNat ++#ifdef ghcjs_HOST_OS ++powModSBigNat b e (BN# m#) = BN# (js_powModSBigNat bPos b# ePos e# m#) ++ where ++ bPos = case b of NegBN {} -> False ++ _ -> True ++ ePos = case e of NegBN {} -> False ++ _ -> True ++ !(BN# b#) = absSBigNat b ++ !(BN# e#) = absSBigNat e ++foreign import javascript unsafe "h$ghcjsbn_powModSBigNat($1,$2,$3,$4,$5)" js_powModSBigNat :: Bool -> ByteArray# -> Bool -> ByteArray# -> ByteArray# -> ByteArray# ++#else + powModSBigNat b e m@(BN# m#) = runS $ do + r@(MBN# r#) <- newBigNat# mn# + I# rn_# <- liftIO (integer_gmp_powm# r# b# bn# e# en# m# mn#) +@@ -1414,9 +1704,20 @@ + integer_gmp_powm# :: MutableByteArray# RealWorld + -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize# + -> ByteArray# -> GmpSize# -> IO GmpSize +- ++#endif + -- internal non-exported helper + powModSBigNatWord :: SBigNat -> SBigNat -> GmpLimb# -> GmpLimb# ++#ifdef ghcjs_HOST_OS ++powModSBigNatWord b e m# = js_powModSBigNatWord bPos b# ePos e# m# ++ where ++ bPos = case b of NegBN {} -> False ++ _ -> True ++ ePos = case e of NegBN {} -> False ++ _ -> True ++ !(BN# b#) = absSBigNat b ++ !(BN# e#) = absSBigNat e ++foreign import javascript unsafe "h$ghcjsbn_powModSBigNatWord($1,$2,$3,$4,$5)" js_powModSBigNatWord :: Bool -> ByteArray# -> Bool -> ByteArray# -> Word# -> Word# ++#else + powModSBigNatWord b e m# = integer_gmp_powm1# b# bn# e# en# m# + where + !(BN# b#) = absSBigNat b +@@ -1427,7 +1728,7 @@ + foreign import ccall unsafe "integer_gmp_powm1" + integer_gmp_powm1# :: ByteArray# -> GmpSize# -> ByteArray# -> GmpSize# + -> GmpLimb# -> GmpLimb# +- ++#endif + + -- | \"@'recipModInteger' /x/ /m/@\" computes the inverse of @/x/@ modulo @/m/@. If + -- the inverse exists, the return value @/y/@ will satisfy @0 < /y/ < +@@ -1448,7 +1749,12 @@ + -- + -- @since 1.0.0.0 + recipModBigNat :: BigNat -> BigNat -> BigNat ++#ifdef ghcjs_HOST_OS ++recipModBigNat (BN# x#) (BN# m#) = BN# (js_recipModBigNat x# m#) ++foreign import javascript unsafe "h$ghcjsbn_recipMod_bb($1,$2)" js_recipModBigNat :: ByteArray# -> ByteArray# -> ByteArray# ++#else + recipModBigNat x m = inline recipModSBigNat (PosBN x) m ++#endif + + -- | Version of 'recipModInteger' operating on 'Word#'s + -- +@@ -1458,6 +1764,11 @@ + + -- internal non-exported helper + recipModSBigNat :: SBigNat -> BigNat -> BigNat ++#ifdef ghcjs_HOST_OS ++recipModSBigNat (PosBN (BN# x#)) (BN# y#) = BN# (js_recipModSBigNat True x# y#) ++recipModSBigNat (NegBN (BN# x#)) (BN# y#) = BN# (js_recipModSBigNat False x# y#) ++foreign import javascript unsafe "h$ghcjsbn_recipModS_bb($1,$2,$3)" js_recipModSBigNat :: Bool -> ByteArray# -> ByteArray# -> ByteArray# ++#else + recipModSBigNat x m@(BN# m#) = runS $ do + r@(MBN# r#) <- newBigNat# mn# + I# rn_# <- liftIO (integer_gmp_invert# r# x# xn# m# mn#) +@@ -1474,6 +1785,7 @@ + integer_gmp_invert# :: MutableByteArray# RealWorld + -> ByteArray# -> GmpSize# + -> ByteArray# -> GmpSize# -> IO GmpSize ++#endif + + ---------------------------------------------------------------------------- + -- Conversions to/from floating point +@@ -1495,11 +1807,19 @@ + + encodeDoubleInteger :: Integer -> Int# -> Double# + encodeDoubleInteger (S# m#) 0# = int2Double# m# ++#ifdef ghcjs_HOST_OS ++encodeDoubleInteger (S# m#) e# = js_encodeDoubleInt m# e# ++encodeDoubleInteger (Jp# (BN# bn#)) e# = js_encodeDoubleBigNat True bn# e# ++encodeDoubleInteger (Jn# (BN# bn#)) e# = js_encodeDoubleBigNat False bn# e# ++foreign import javascript unsafe "h$ghcjsbn_encodeDouble_s($1,$2)" js_encodeDoubleInt :: Int# -> Int# -> Double# ++foreign import javascript unsafe "h$ghcjsbn_encodeDouble_b($1,$2,$3)" js_encodeDoubleBigNat :: Bool -> ByteArray# -> Int# -> Double# ++#else + encodeDoubleInteger (S# m#) e# = int_encodeDouble# m# e# + encodeDoubleInteger (Jp# bn@(BN# bn#)) e# + = c_mpn_get_d bn# (sizeofBigNat# bn) e# + encodeDoubleInteger (Jn# bn@(BN# bn#)) e# + = c_mpn_get_d bn# (negateInt# (sizeofBigNat# bn)) e# ++#endif + {-# CONSTANT_FOLDED encodeDoubleInteger #-} + + -- double integer_gmp_mpn_get_d (const mp_limb_t sp[], const mp_size_t sn) +@@ -1508,10 +1828,16 @@ + + doubleFromInteger :: Integer -> Double# + doubleFromInteger (S# m#) = int2Double# m# ++#ifdef ghcjs_HOST_OS ++doubleFromInteger (Jp# (BN# bn#)) = js_doubleFromBigNat True bn# ++doubleFromInteger (Jn# (BN# bn#)) = js_doubleFromBigNat False bn# ++foreign import javascript unsafe "h$ghcjsbn_toDouble_b($1,$2)" js_doubleFromBigNat :: Bool -> ByteArray# -> Double# ++#else + doubleFromInteger (Jp# bn@(BN# bn#)) + = c_mpn_get_d bn# (sizeofBigNat# bn) 0# + doubleFromInteger (Jn# bn@(BN# bn#)) + = c_mpn_get_d bn# (negateInt# (sizeofBigNat# bn)) 0# ++#endif + {-# CONSTANT_FOLDED doubleFromInteger #-} + + -- TODO: Not sure if it's worth to write 'Float' optimized versions here +@@ -1524,8 +1850,12 @@ + ---------------------------------------------------------------------------- + -- FFI ccall imports + ++#ifdef ghcjs_HOST_OS ++foreign import javascript unsafe "h$ghcjsbn_gcd_ww($1,$2)" gcdWord# :: Word# -> Word# -> Word# ++#else + foreign import ccall unsafe "integer_gmp_gcd_word" + gcdWord# :: GmpLimb# -> GmpLimb# -> GmpLimb# ++#endif + + foreign import ccall unsafe "integer_gmp_mpn_gcd_1" + c_mpn_gcd_1# :: ByteArray# -> GmpSize# -> GmpLimb# -> GmpLimb# +@@ -1652,12 +1982,18 @@ + + ---------------------------------------------------------------------------- + -- BigNat-wrapped ByteArray#-primops +- + -- | Return number of limbs contained in 'BigNat'. + sizeofBigNat# :: BigNat -> GmpSize# ++#ifdef ghcjs_HOST_OS ++-- returns number of words instead ++sizeofBigNat# (BN# x#) = js_sizeofBigNat x# ++foreign import javascript unsafe "h$ghcjsbn_sizeof_b($1)" js_sizeofBigNat :: ByteArray# -> Int# ++#else + sizeofBigNat# (BN# x#) + = sizeofByteArray# x# `uncheckedIShiftRL#` GMP_LIMB_SHIFT# ++#endif + ++#ifndef ghcjs_HOST_OS + data MutBigNat s = MBN# !(MutableByteArray# s) + + getSizeofMutBigNat# :: MutBigNat s -> State# s -> (# State# s, GmpSize# #) +@@ -1673,12 +2009,19 @@ + + writeBigNat# :: MutBigNat s -> GmpSize# -> GmpLimb# -> State# s -> State# s + writeBigNat# (MBN# mba#) = writeWordArray# mba# ++#endif + + -- | Extract /n/-th (0-based) limb in 'BigNat'. + -- /n/ must be less than size as reported by 'sizeofBigNat#'. + indexBigNat# :: BigNat -> GmpSize# -> GmpLimb# ++#ifdef ghcjs_HOST_OS ++indexBigNat# (BN# ba#) w# = js_indexBigNat ba# w# ++foreign import javascript unsafe "h$ghcjsbn_index_b($1,$2)" js_indexBigNat :: ByteArray# -> Int# -> Word# ++#else + indexBigNat# (BN# ba#) = indexWordArray# ba# ++#endif + ++#ifndef ghcjs_HOST_OS + unsafeFreezeBigNat# :: MutBigNat s -> S s BigNat + unsafeFreezeBigNat# (MBN# mba#) s = case unsafeFreezeByteArray# mba# s of + (# s', ba# #) -> (# s', BN# ba# #) +@@ -1766,7 +2109,7 @@ + go i0# s = case readWordArray# mba (i0# -# 1#) s of + (# s', 0## #) -> go (i0# -# 1#) s' + (# s', _ #) -> (# s', i0# #) +- ++#endif + -- | Construct 'BigNat' from existing 'ByteArray#' containing /n/ + -- 'GmpLimb's in least-significant-first order. + -- +@@ -1776,6 +2119,10 @@ + -- Note: size parameter (times @sizeof(GmpLimb)@) must be less or + -- equal to its 'sizeofByteArray#'. + byteArrayToBigNat# :: ByteArray# -> GmpSize# -> BigNat ++#ifdef ghcjs_HOST_OS ++byteArrayToBigNat# ba# n# = BN# (js_byteArrayToBigNat ba# n#) ++foreign import javascript unsafe "h$ghcjsbn_byteArrayToBigNat($1, $2)" js_byteArrayToBigNat :: ByteArray# -> GmpSize# -> ByteArray# ++#else + byteArrayToBigNat# ba# n0# + | isTrue# (n# ==# 0#) = zeroBigNat + | isTrue# (baszr# ==# 0#) -- i.e. ba# is multiple of limb-size +@@ -1796,6 +2143,7 @@ + | isTrue# (i# <# 0#) = 0# + | isTrue# (neWord# (indexWordArray# ba# i#) 0##) = i# +# 1# + | True = fmssl (i# -# 1#) ++#endif + + -- | Read 'Integer' (without sign) from memory location at @/addr/@ in + -- base-256 representation. +@@ -1813,6 +2161,11 @@ + -- | Version of 'importIntegerFromAddr' constructing a 'BigNat' + importBigNatFromAddr :: Addr# -> Word# -> Int# -> IO BigNat + importBigNatFromAddr _ 0## _ = IO (\s -> (# s, zeroBigNat #)) ++#ifdef ghcjs_HOST_OS ++importBigNatFromAddr addr len msbf = IO $ \s -> ++ case js_importBigNatFromAddr addr len msbf s of (# s', ba #) -> (# s', BN# ba #) ++foreign import javascript unsafe "h$ghcjsbn_importBigNatFromAddr($1_1, $1_2, $2, $3)" js_importBigNatFromAddr :: Addr# -> Word# -> Int# -> State# s -> (# State# s, ByteArray# #) ++#else + importBigNatFromAddr addr len0 1# = IO $ do -- MSBF + W# ofs <- liftIO (c_scan_nzbyte_addr addr 0## len0) + let len = len0 `minusWord#` ofs +@@ -1842,6 +2195,7 @@ + foreign import ccall unsafe "integer_gmp_mpn_import" + c_mpn_import_addr :: MutableByteArray# RealWorld -> Addr# -> Word# -> Word# + -> Int# -> IO () ++#endif + + -- | Read 'Integer' (without sign) from byte-array in base-256 representation. + -- +@@ -1866,6 +2220,11 @@ + -- | Version of 'importIntegerFromByteArray' constructing a 'BigNat' + importBigNatFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> BigNat + importBigNatFromByteArray _ _ 0## _ = zeroBigNat ++#ifdef ghcjs_HOST_OS ++importBigNatFromByteArray ba ofs len msbf = ++ BN# (js_importBigNatFromByteArray ba ofs len msbf) ++foreign import javascript unsafe "h$ghcjsbn_importBigNatFromByteArray($1,$2,$3,$4)" js_importBigNatFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> ByteArray# ++#else + importBigNatFromByteArray ba ofs0 len0 1# = runS $ do -- MSBF + W# ofs <- liftIO (c_scan_nzbyte_bytearray ba ofs0 len0) + let len = (len0 `plusWord#` ofs0) `minusWord#` ofs +@@ -1895,6 +2254,7 @@ + foreign import ccall unsafe "integer_gmp_mpn_import" + c_mpn_import_bytearray :: MutableByteArray# RealWorld -> ByteArray# -> Word# + -> Word# -> Int# -> IO () ++#endif + + -- | Test whether all internal invariants are satisfied by 'BigNat' value + -- +@@ -1903,6 +2263,10 @@ + -- This operation is mostly useful for test-suites and/or code which + -- constructs 'Integer' values directly. + isValidBigNat# :: BigNat -> Int# ++#ifdef ghcjs_HOST_OS ++isValidBigNat# (BN# bn#) = js_isValidBigNat bn# ++foreign import javascript unsafe "h$ghcjsbn_isValid_b($1)" js_isValidBigNat :: ByteArray# -> Int# ++#else + isValidBigNat# (BN# ba#) + = (szq# ># 0#) `andI#` (szr# ==# 0#) `andI#` isNorm# + where +@@ -1913,11 +2277,16 @@ + sz# = sizeofByteArray# ba# + + !(# szq#, szr# #) = quotRemInt# sz# GMP_LIMB_BYTES# ++#endif + + -- | Version of 'nextPrimeInteger' operating on 'BigNat's + -- + -- @since 1.0.0.0 + nextPrimeBigNat :: BigNat -> BigNat ++#ifdef ghcjs_HOST_OS ++nextPrimeBigNat (BN# bn#) = BN# (js_nextPrimeBigNat bn#) ++foreign import javascript unsafe "h$ghcjsbn_nextPrime_b($1)" js_nextPrimeBigNat :: ByteArray# -> ByteArray# ++#else + nextPrimeBigNat bn@(BN# ba#) = runS $ do + mbn@(MBN# mba#) <- newBigNat# n# + (W# c#) <- liftIO (nextPrime# mba# ba# n#) +@@ -1930,7 +2299,7 @@ + foreign import ccall unsafe "integer_gmp_next_prime" + nextPrime# :: MutableByteArray# RealWorld -> ByteArray# -> GmpSize# + -> IO GmpLimb +- ++#endif + ---------------------------------------------------------------------------- + -- monadic combinators for low-level state threading + +@@ -1985,10 +2354,12 @@ + absSBigNat (NegBN bn) = bn + absSBigNat (PosBN bn) = bn + ++#ifndef ghcjs_HOST_OS + -- | /Signed/ limb count. Negative sizes denote negative integers + ssizeofSBigNat# :: SBigNat -> GmpSize# + ssizeofSBigNat# (NegBN bn) = negateInt# (sizeofBigNat# bn) + ssizeofSBigNat# (PosBN bn) = sizeofBigNat# bn ++#endif + + -- | Construct 'SBigNat' from 'Int#' value + intToSBigNat# :: Int# -> SBigNat diff --git a/lib/patches/primitive.patch b/lib/patches/primitive.patch new file mode 100644 index 00000000..55ebc472 --- /dev/null +++ b/lib/patches/primitive.patch @@ -0,0 +1,63 @@ +diff -Nru upstream/pkg/primitive/Data/Primitive/Internal/Operations.hs boot/pkg/primitive/Data/Primitive/Internal/Operations.hs +--- upstream/pkg/primitive/Data/Primitive/Internal/Operations.hs 2018-01-09 08:27:53.000000000 +0000 ++++ boot/pkg/primitive/Data/Primitive/Internal/Operations.hs 2018-01-09 08:27:53.638510582 +0000 +@@ -1,4 +1,4 @@ +-{-# LANGUAGE MagicHash, UnliftedFFITypes #-} ++{-# LANGUAGE MagicHash, UnliftedFFITypes, CPP #-} + + -- | + -- Module : Data.Primitive.Internal.Operations +@@ -30,6 +30,44 @@ + import Foreign.C.Types + import GHC.Prim + ++#ifdef ghcjs_HOST_OS ++ ++-- the GHCJS calling convention for ByteArray# is different from Addr# ++-- only one argument, whereas Addr# has two, data and offset ++ ++-- so we import the ByteArray# variant with different names here ++ ++foreign import ccall unsafe "primitive-memops.h hsprimitive_memsetba_Word8" ++ setWord8Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO () ++foreign import ccall unsafe "primitive-memops.h hsprimitive_memsetba_Word16" ++ setWord16Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO () ++foreign import ccall unsafe "primitive-memops.h hsprimitive_memsetba_Word32" ++ setWord32Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO () ++foreign import ccall unsafe "primitive-memops.h hsprimitive_memsetba_Word64" ++ setWord64Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word64_# -> IO () ++foreign import ccall unsafe "primitive-memops.h hsprimitive_memsetba_Word" ++ setWordArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO () ++foreign import ccall unsafe "primitive-memops.h hsprimitive_memsetba_Word8" ++ setInt8Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO () ++foreign import ccall unsafe "primitive-memops.h hsprimitive_memsetba_Word16" ++ setInt16Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO () ++foreign import ccall unsafe "primitive-memops.h hsprimitive_memsetba_Word32" ++ setInt32Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO () ++foreign import ccall unsafe "primitive-memops.h hsprimitive_memsetba_Word64" ++ setInt64Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int64_# -> IO () ++foreign import ccall unsafe "primitive-memops.h hsprimitive_memsetba_Word" ++ setIntArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Int# -> IO () ++foreign import ccall unsafe "primitive-memops.h hsprimitive_memsetba_Ptr" ++ setAddrArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Addr# -> IO () ++foreign import ccall unsafe "primitive-memops.h hsprimitive_memsetba_Float" ++ setFloatArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Float# -> IO () ++foreign import ccall unsafe "primitive-memops.h hsprimitive_memsetba_Double" ++ setDoubleArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Double# -> IO () ++foreign import ccall unsafe "primitive-memops.h hsprimitive_memsetba_Char" ++ setWideCharArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Char# -> IO () ++ ++#else ++ + foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8" + setWord8Array# :: MutableByteArray# s -> CPtrdiff -> CSize -> Word# -> IO () + foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16" +@@ -59,6 +97,8 @@ + foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Char" + setWideCharArray# :: MutableByteArray# s -> CPtrdiff -> CSize -> Char# -> IO () + ++#endif ++ + foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word8" + setWord8OffAddr# :: Addr# -> CPtrdiff -> CSize -> Word# -> IO () + foreign import ccall unsafe "primitive-memops.h hsprimitive_memset_Word16" diff --git a/lib/patches/process.patch b/lib/patches/process.patch new file mode 100644 index 00000000..fefa32e9 --- /dev/null +++ b/lib/patches/process.patch @@ -0,0 +1,322 @@ +diff -Nru upstream/pkg/process/process.cabal boot/pkg/process/process.cabal +--- upstream/pkg/process/process.cabal 2018-01-09 08:27:53.000000000 +0000 ++++ boot/pkg/process/process.cabal 2018-01-09 08:27:53.854488634 +0000 +@@ -79,6 +79,9 @@ + filepath >= 1.2 && < 1.5, + deepseq >= 1.1 && < 1.5 + ++ if(impl(ghcjs)) ++ build-depends: ghcjs-prim ++ + test-suite test + default-language: Haskell2010 + hs-source-dirs: test +diff -Nru upstream/pkg/process/System/Process/Common.hs boot/pkg/process/System/Process/Common.hs +--- upstream/pkg/process/System/Process/Common.hs 2018-01-09 08:27:53.000000000 +0000 ++++ boot/pkg/process/System/Process/Common.hs 2018-01-09 08:27:53.854488634 +0000 +@@ -55,6 +55,9 @@ + import System.Posix.Types + #endif + ++#ifdef ghcjs_HOST_OS ++type PHANDLE = CPid ++#else + #ifdef WINDOWS + -- Define some missing types for Windows compatibility. Note that these values + -- will never actually be used, as the setuid/setgid system calls are not +@@ -66,7 +69,7 @@ + #else + type PHANDLE = CPid + #endif +- ++#endif + data CreateProcess = CreateProcess{ + cmdspec :: CmdSpec, -- ^ Executable & arguments, or shell command. If 'cwd' is 'Nothing', relative paths are resolved with respect to the current working directory. If 'cwd' is provided, it is implementation-dependent whether relative paths are resolved with respect to 'cwd' or the current working directory, so absolute paths should be used to ensure portability. + cwd :: Maybe FilePath, -- ^ Optional path to the working directory for the new process +diff -Nru upstream/pkg/process/System/Process/Internals.hs boot/pkg/process/System/Process/Internals.hs +--- upstream/pkg/process/System/Process/Internals.hs 2018-01-09 08:27:53.000000000 +0000 ++++ boot/pkg/process/System/Process/Internals.hs 2018-01-09 08:27:53.854488634 +0000 +@@ -3,6 +3,10 @@ + {-# LANGUAGE Trustworthy #-} + {-# LANGUAGE InterruptibleFFI #-} + ++#ifdef ghcjs_HOST_OS ++{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI, UnliftedFFITypes, MagicHash #-} ++#endif ++ + ----------------------------------------------------------------------------- + -- | + -- Module : System.Process.Internals +@@ -39,6 +43,7 @@ + endDelegateControlC, + stopDelegateControlC, + unwrapHandles, ++#if !defined ghcjs_HOST_OS + #ifdef WINDOWS + terminateJob, + waitForJobCompletion, +@@ -47,6 +52,7 @@ + pPrPr_disableITimers, c_execvpe, + ignoreSignal, defaultSignal, + #endif ++#endif + withFilePathException, withCEnvironment, + translate, + createPipe, +@@ -62,12 +68,95 @@ + + import System.Process.Common + ++#ifdef ghcjs_HOST_OS ++import Control.Applicative ++import Control.Concurrent.MVar ++import GHCJS.Prim ++import System.Exit ++import System.IO.Error ++import qualified GHC.IO.FD as FD ++import GHC.IO.Handle.FD (mkHandleFromFD) ++import GHC.IO.Device (IODeviceType(..)) ++import GHC.IO.Encoding (getLocaleEncoding) ++import Foreign.Ptr (Ptr, nullPtr) ++import Foreign.Marshal.Utils (withMany) ++import Foreign.Marshal.Array (withArray0) ++ ++mkProcessHandle :: PHANDLE -> Bool -> IO ProcessHandle ++mkProcessHandle p mb_delegate_ctlc = do ++ m <- newMVar (OpenHandle p) ++ ml <- newMVar () ++ return (ProcessHandle m mb_delegate_ctlc ml) ++ ++closePHANDLE :: PHANDLE -> IO () ++closePHANDLE _ = return () ++ ++startDelegateControlC :: IO () ++startDelegateControlC = return () ++ ++stopDelegateControlC :: IO () ++stopDelegateControlC = return () ++ ++endDelegateControlC :: ExitCode -> IO () ++endDelegateControlC _ = return () ++ ++isDefaultSignal :: CLong -> Bool ++isDefaultSignal _ = True ++ ++interruptProcessGroupOfInternal ++ :: ProcessHandle -- ^ A process in the process group ++ -> IO () ++interruptProcessGroupOfInternal ph = ++ error "System.Process.interruptProcessGroupOfInternal: not yet supported for GHCJS" ++ ++translateInternal :: String -> String ++translateInternal = id ++ ++createPipeInternal :: IO (Handle, Handle) ++createPipeInternal = error "System.Process.createPipeInternal: not yet supported on GHCJS" ++ ++createPipeInternalFd :: IO (FD, FD) ++createPipeInternalFd = error "System.Process.createPipeInternalFd: not yet supported on GHCJS" ++ ++withCEnvironment :: [(String,String)] -> (Ptr CString -> IO a) -> IO a ++withCEnvironment envir act = ++ let env' = map (\(name, val) -> name ++ ('=':val)) envir ++ in withMany withCString env' (\pEnv -> withArray0 nullPtr pEnv act) ++ ++{- -- fixme does ghcjs need anything special? ++mbFd :: String -> FD -> StdStream -> IO FD ++mbFd _ _std CreatePipe = return (-1) ++mbFd _fun std Inherit = return std ++mbFd fun _std (UseHandle hdl) = ++ withHandle fun hdl $ \x@Handle__{haDevice=dev,..} -> ++ case cast dev of ++ Just fd -> return (x, fd) ++ Nothing -> ioError (mkIOError illegalOperationErrorType "createProcess" (Just hdl) Nothing ++ `ioeSetErrorString` "handle is not a file descriptor") ++ ++-} ++ ++commandToProcess :: CmdSpec -> IO (FilePath, [String]) ++commandToProcess (ShellCommand xs) = do ++ r <- js_commandToProcess (toJSString xs) jsNull ++ if isNull r ++ then ioError (mkIOError doesNotExistErrorType "commandToProcess" Nothing Nothing) ++ else (\(x:xs) -> (x,xs)) <$> fromJSStrings r ++commandToProcess (RawCommand cmd args) = do ++ r <- js_commandToProcess (toJSString cmd) =<< toJSStrings args ++ if isNull r ++ then ioError (mkIOError doesNotExistErrorType "commandToProcess" Nothing Nothing) ++ else (\(x:xs) -> (x,xs)) <$> fromJSStrings r ++ ++#else + #ifdef WINDOWS + import System.Process.Windows + #else + import System.Process.Posix + #endif + ++#endif ++ + -- ---------------------------------------------------------------------------- + -- | This function is almost identical to + -- 'System.Process.createProcess'. The only differences are: +@@ -98,7 +187,68 @@ + :: String -- ^ function name (for error messages) + -> CreateProcess + -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) ++#ifdef ghcjs_HOST_OS ++createProcess_ fun CreateProcess{ cmdspec = cmdsp, ++ cwd = mb_cwd, ++ env = mb_env, ++ std_in = mb_stdin, ++ std_out = mb_stdout, ++ std_err = mb_stderr, ++ close_fds = mb_close_fds, ++ create_group = mb_create_group, ++ delegate_ctlc = mb_delegate_ctlc } ++ = do ++ (cmd,args) <- commandToProcess cmdsp ++ withFilePathException cmd $ do ++ fdin <- mbFd fun fd_stdin mb_stdin ++ fdout <- mbFd fun fd_stdout mb_stdout ++ fderr <- mbFd fun fd_stderr mb_stderr ++ env' <- maybe (return jsNull) (toJSStrings . concatMap (\(x,y) -> [x,y])) mb_env ++ let cwd' = maybe jsNull toJSString mb_cwd ++ let c1 = toJSString cmd ++ c2 <- case args of ++ [] -> return jsNull ++ _ -> toJSStrings args ++ ++ r <- js_runInteractiveProcess c1 c2 cwd' env' fdin fdout fderr ++ mb_close_fds mb_create_group mb_delegate_ctlc ++ ++ proc_handle <- fromIntegral . fromJSInt <$> getProp r "pid" ++ fds@[fdin_r, fdout_r, fderr_r] <- map (stdFD . fromIntegral) <$> (fromJSInts =<< getProp r "fds") ++ ++ hndStdInput <- mbPipe_GHCJS mb_stdin fdin_r WriteMode ++ hndStdOutput <- mbPipe_GHCJS mb_stdout fdout_r ReadMode ++ hndStdError <- mbPipe_GHCJS mb_stderr fderr_r ReadMode ++ ++ ph <- mkProcessHandle proc_handle mb_delegate_ctlc ++ return (hndStdInput, hndStdOutput, hndStdError, ph) ++ ++mbPipe_GHCJS :: StdStream -> FD.FD -> IOMode -> IO (Maybe Handle) ++mbPipe_GHCJS CreatePipe fd mode = do ++{- (fD,fd_type) <- FD.mkFD (fromIntegral fd) mode ++ (Just (Stream,0,0)) -- avoid calling fstat() ++ False {-is_socket-} ++ False {-non-blocking-} -} ++ enc <- getLocaleEncoding ++ fmap Just (mkHandleFromFD fd Stream ("fd: " ++ show fd) mode False {-is_socket-} (Just enc)) ++mbPipe_GHCJS _ _ _ = return Nothing ++ ++ ++stdFD :: CInt -> FD.FD ++stdFD fd = FD.FD { FD.fdFD = fd, ++#ifdef mingw32_HOST_OS ++ FD.fdIsSocket_ = 0 ++#else ++ FD.fdIsNonBlocking = 0 ++ -- We don't set non-blocking mode on standard handles, because it may ++ -- confuse other applications attached to the same TTY/pipe ++ -- see Note [nonblock] ++#endif ++ } ++ ++#else + createProcess_ msg proc_ = unwrapHandles `fmap` createProcess_Internal msg proc_ ++#endif + {-# INLINE createProcess_ #-} + + -- ------------------------------------------------------------------------ +@@ -165,6 +315,46 @@ + unwrapHandles :: ProcRetHandles -> (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) + unwrapHandles r = (hStdInput r, hStdOutput r, hStdError r, procHandle r) + ++#if defined(ghcjs_HOST_OS) ++ ++type JSArray = JSVal ++type JSObject = JSVal ++type JSString = JSVal ++ ++fromJSStrings :: JSVal -> IO [String] ++fromJSStrings x = fmap (map fromJSString) (fromJSArray x) ++ ++fromJSInts :: JSVal -> IO [Int] ++fromJSInts x = map fromJSInt <$> fromJSArray x ++ ++toJSStrings :: [String] -> IO JSVal ++toJSStrings xs = toJSArray (map toJSString xs) ++ ++throwErrnoIfJSNull :: String -> IO JSVal -> IO JSVal ++throwErrnoIfJSNull msg m = do ++ r <- m ++ if isNull r then throwErrno msg ++ else return r ++ ++foreign import javascript safe ++ "h$process_runInteractiveProcess($1,$2,$3,$4,$5,$6,$7,$8,$9,$10)" ++ js_runInteractiveProcess :: JSString -- ^ $1 command or program ++ -> JSArray -- ^ $2 arguments, null if it's a raw command ++ -> JSString -- ^ $3 working dir, null for current ++ -> JSArray -- ^ $4 environment, null for existing ++ -> CInt -- ^ $5 stdin fd ++ -> CInt -- ^ $6 stdout fd ++ -> CInt -- ^ $7 stderr fd ++ -> Bool -- ^ $8 close handles ++ -> Bool -- ^ $9 ++ -> Bool -- ^ $10 delegate ctrl-c ++ -> IO JSVal -- ^ process handle ++ ++foreign import javascript safe ++ "h$process_commandToProcess($1,$2)" ++ js_commandToProcess :: JSString -> JSArray -> IO JSArray ++#endif ++ + -- ---------------------------------------------------------------------------- + -- Deprecated / compat + +diff -Nru upstream/pkg/process/System/Process.hs boot/pkg/process/System/Process.hs +--- upstream/pkg/process/System/Process.hs 2018-01-09 08:27:53.000000000 +0000 ++++ boot/pkg/process/System/Process.hs 2018-01-09 08:27:53.854488634 +0000 +@@ -6,6 +6,10 @@ + #endif + {-# LANGUAGE InterruptibleFFI #-} + ++#ifdef ghcjs_HOST_OS ++{-# LANGUAGE JavaScriptFFI #-} ++#endif ++ + ----------------------------------------------------------------------------- + -- | + -- Module : System.Process +@@ -718,6 +722,22 @@ + -- ---------------------------------------------------------------------------- + -- Interface to C bits + ++#if defined(ghcjs_HOST_OS) ++ ++foreign import javascript unsafe ++ "h$process_terminateProcess($1)" ++ c_terminateProcess :: PHANDLE -> IO CInt ++ ++foreign import javascript unsafe ++ "h$process_getProcessExitCode($1,$2_1,$2_2)" ++ c_getProcessExitCode :: PHANDLE -> Ptr CInt -> IO CInt ++ ++foreign import javascript interruptible ++ "h$process_waitForProcess($1,$2_1,$2_2,$c);" ++ c_waitForProcess :: PHANDLE -> Ptr CInt -> IO CInt ++ ++#else ++ + foreign import ccall unsafe "terminateProcess" + c_terminateProcess + :: PHANDLE +@@ -735,6 +755,7 @@ + -> Ptr CInt + -> IO CInt + ++#endif + + -- ---------------------------------------------------------------------------- + -- Old deprecated variants diff --git a/lib/cache/test.tar b/lib/patches/template-haskell.patch similarity index 100% rename from lib/cache/test.tar rename to lib/patches/template-haskell.patch diff --git a/lib/patches/time.patch b/lib/patches/time.patch new file mode 100644 index 00000000..e29fa0f6 --- /dev/null +++ b/lib/patches/time.patch @@ -0,0 +1,90 @@ +diff -Nru upstream/pkg/time/lib/Data/Time/Clock/Internal/CTimespec.hsc boot/pkg/time/lib/Data/Time/Clock/Internal/CTimespec.hsc +--- upstream/pkg/time/lib/Data/Time/Clock/Internal/CTimespec.hsc 2018-01-09 08:27:54.000000000 +0000 ++++ boot/pkg/time/lib/Data/Time/Clock/Internal/CTimespec.hsc 2018-01-09 08:27:54.718402618 +0000 +@@ -1,5 +1,80 @@ + module Data.Time.Clock.Internal.CTimespec where + ++#ifdef __GHCJS__ ++ ++import Foreign ++import Foreign.C ++import System.IO.Unsafe ++ ++type ClockID = CInt ++ ++data CTimespec = MkCTimespec CTime CLong ++ ++instance Storable CTimespec where ++ sizeOf _ = 8 ++ alignment _ = 4 ++ peek p = do ++ s <- peekByteOff p 0 ++ ns <- peekByteOff p 4 ++ return (MkCTimespec s ns) ++ poke p (MkCTimespec s ns) = do ++ pokeByteOff p 0 s ++ pokeByteOff p 4 ns ++ ++-- | Get the current POSIX time from the system clock. ++getCTimespec :: IO CTimespec ++getCTimespec = alloca (\ptspec -> do ++ throwErrnoIfMinus1_ "clock_gettime" $ ++ clock_gettime 0 ptspec ++ peek ptspec ++ ) ++ ++foreign import ccall unsafe "time.h clock_gettime" ++ clock_gettime :: ClockID -> Ptr CTimespec -> IO CInt ++foreign import ccall unsafe "time.h clock_getres" ++ clock_getres :: ClockID -> Ptr CTimespec -> IO CInt ++ ++-- | Get the resolution of the given clock. ++clockGetRes :: ClockID -> IO (Either Errno CTimespec) ++clockGetRes clockid = alloca $ \ptspec -> do ++ rc <- clock_getres clockid ptspec ++ case rc of ++ 0 -> do ++ res <- peek ptspec ++ return $ Right res ++ _ -> do ++ errno <- getErrno ++ return $ Left errno ++ ++-- | Get the current time from the given clock. ++clockGetTime :: ClockID -> IO CTimespec ++clockGetTime clockid = alloca (\ptspec -> do ++ throwErrnoIfMinus1_ "clock_gettime" $ clock_gettime clockid ptspec ++ peek ptspec ++ ) ++ ++clock_REALTIME :: ClockID ++clock_REALTIME = 0 ++ ++clock_TAI :: ClockID ++clock_TAI = 11 ++ ++realtimeRes :: CTimespec ++realtimeRes = unsafePerformIO $ do ++ mres <- clockGetRes clock_REALTIME ++ case mres of ++ Left errno -> ioError (errnoToIOError "clock_getres" errno Nothing Nothing) ++ Right res -> return res ++ ++clockResolution :: ClockID -> Maybe CTimespec ++clockResolution clockid = unsafePerformIO $ do ++ mres <- clockGetRes clockid ++ case mres of ++ Left _ -> return Nothing ++ Right res -> return $ Just res ++ ++#else ++ + #include "HsTimeConfig.h" + + #if !defined(mingw32_HOST_OS) && HAVE_CLOCK_GETTIME +@@ -74,3 +149,5 @@ + Right res -> return $ Just res + + #endif ++ ++#endif diff --git a/lib/patches/unix.patch b/lib/patches/unix.patch new file mode 100644 index 00000000..7e29ecb7 --- /dev/null +++ b/lib/patches/unix.patch @@ -0,0 +1,76 @@ +diff -Nru upstream/pkg/unix/System/Posix/Files/Common.hsc boot/pkg/unix/System/Posix/Files/Common.hsc +--- upstream/pkg/unix/System/Posix/Files/Common.hsc 2018-01-09 08:27:54.000000000 +0000 ++++ boot/pkg/unix/System/Posix/Files/Common.hsc 2018-01-09 08:27:55.082366723 +0000 +@@ -520,7 +520,7 @@ + -- Note: calls @ftruncate@. + setFdSize :: Fd -> FileOffset -> IO () + setFdSize (Fd fd) off = +- throwErrnoIfMinus1_ "setFdSize" (c_ftruncate fd off) ++ throwErrnoIfMinus1_ "setFdSize" (c_ftruncate fd (fromIntegral off)) + + -- ----------------------------------------------------------------------------- + -- pathconf()/fpathconf() support +diff -Nru upstream/pkg/unix/System/Posix/IO/Common.hsc boot/pkg/unix/System/Posix/IO/Common.hsc +--- upstream/pkg/unix/System/Posix/IO/Common.hsc 2018-01-09 08:27:54.000000000 +0000 ++++ boot/pkg/unix/System/Posix/IO/Common.hsc 2018-01-09 08:27:55.082366723 +0000 +@@ -281,7 +281,7 @@ + -- | May throw an exception if this is an invalid descriptor. + fdSeek :: Fd -> SeekMode -> FileOffset -> IO FileOffset + fdSeek (Fd fd) mode off = +- throwErrnoIfMinus1 "fdSeek" (Base.c_lseek fd off (mode2Int mode)) ++ throwErrnoIfMinus1 "fdSeek" (fmap fromIntegral $ Base.c_lseek fd (fromIntegral off) (mode2Int mode)) + + -- ----------------------------------------------------------------------------- + -- Locking +diff -Nru upstream/pkg/unix/System/Posix/Process/Internals.hs boot/pkg/unix/System/Posix/Process/Internals.hs +--- upstream/pkg/unix/System/Posix/Process/Internals.hs 2018-01-09 08:27:54.000000000 +0000 ++++ boot/pkg/unix/System/Posix/Process/Internals.hs 2018-01-09 08:27:55.082366723 +0000 +@@ -1,5 +1,6 @@ + {-# LANGUAGE CApiFFI #-} + {-# LANGUAGE Trustworthy #-} ++{-# LANGUAGE CPP #-} + + module System.Posix.Process.Internals ( + pPrPr_disableITimers, c_execvpe, +@@ -9,7 +10,12 @@ + import Foreign.C + import System.Exit + import System.IO.Error ++ ++#ifdef ghcjs_HOST_OS ++type Signal = CInt ++#else + import GHC.Conc (Signal) ++#endif + + -- | The exit status of a process + data ProcessStatus +diff -Nru upstream/pkg/unix/System/Posix/Signals.hsc boot/pkg/unix/System/Posix/Signals.hsc +--- upstream/pkg/unix/System/Posix/Signals.hsc 2018-01-09 08:27:54.000000000 +0000 ++++ boot/pkg/unix/System/Posix/Signals.hsc 2018-01-09 08:27:55.082366723 +0000 +@@ -349,11 +349,13 @@ + -> Maybe SignalSet -- ^ other signals to block + -> IO Handler -- ^ old handler + +-#ifdef __PARALLEL_HASKELL__ ++##if defined(__PARALLEL_HASKELL__) + installHandler = + error "installHandler: not available for Parallel Haskell" +-#else +- ++##elif defined(ghcjs_HOST_OS) ++installHandler = ++ error "installHandler: not available for GHCJS" ++##else + installHandler sig handler _maybe_mask = do + ensureIOManagerIsRunning -- for the threaded RTS + +@@ -441,7 +443,7 @@ + siginfoError = Errno errno, + siginfoSpecific = extra } + +-#endif /* !__PARALLEL_HASKELL__ */ ++##endif /* !__PARALLEL_HASKELL__ */ + + -- ----------------------------------------------------------------------------- + -- Alarms diff --git a/src-bin/Boot.hs b/src-bin/Boot.hs index 3b1f669f..c095fe0b 100755 --- a/src-bin/Boot.hs +++ b/src-bin/Boot.hs @@ -3,31 +3,43 @@ {- | The ghcjs-boot program installs the libraries and runtime system for GHCJS - There are two types of installation: + You can explicitly set the boot source location with the -s option. It + can either be a directory containing the boot.yaml file or a boot.tar + archive. - - release (default): - install ghcjs-boot and shims from the tar cache archives included - in the package + if the -s option is not set, the following locations are tried in order: - - development: - install ghcjs-boot and shims from their git repository + 1. the current directory if it contains boot.yaml + 2. the boot.tar file installed by cabal install in the GHCJS + data directory - You can customize the boot configuration in boot.yaml and override some - of the options on the command line. + ghcjs-boot installs the libraries into the GHCJS library directory, + which is set by the `ghcjs' and `ghcjs-pkg' scripts, which pass the + library path with the -B option to the underlying binary executable. - If you want to install to a different directory, set the ghcjs and ghcjs-pkg - programs to wrapper scripts that pass the correct -B flag to the executable - (see lib/etc/ghcjs.sh and lib/etc/ghcjs-pkg.sh in the GHCJS data dir) + modify the scripts to change the installation location -} -{-# LANGUAGE CPP, ExtendedDefaultRules, OverloadedStrings, ScopedTypeVariables, - TemplateHaskell, LambdaCase, FlexibleInstances, DeriveDataTypeable, - GeneralizedNewtypeDeriving, NoMonomorphismRestriction, FlexibleContexts, - RankNTypes, TupleSections +{-# LANGUAGE CPP, + ExtendedDefaultRules, + OverloadedStrings, + ScopedTypeVariables, + TemplateHaskell, + LambdaCase, + FlexibleInstances, + DeriveDataTypeable, + GeneralizedNewtypeDeriving, + NoMonomorphismRestriction, + FlexibleContexts, + RankNTypes, + TupleSections #-} module Main where -import Prelude hiding (FilePath, forM_, elem, mapM, mapM_, any, all, concat, concatMap) +import Prelude + hiding (FilePath, forM_, elem, mapM, mapM_, any, all, concat, concatMap) + +import qualified Prelude import qualified Distribution.Simple.Utils as Cabal @@ -37,10 +49,11 @@ import qualified Codec.Archive.Tar.Entry as Tar import Control.Applicative import qualified Control.Exception as Ex import Control.Lens hiding ((<.>)) -import Control.Monad (void, when, unless, mplus, join) -import Control.Monad.Reader (MonadReader, ReaderT(..), MonadIO, ask, local, lift, liftIO) +import Control.Monad + (void, when, unless, mplus, join) +import Control.Monad.Reader + (MonadReader, ReaderT(..), MonadIO, ask, local, lift, liftIO) -import qualified Data.Aeson as Aeson import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Char @@ -61,31 +74,32 @@ import Data.Typeable import qualified Data.Vector as V import Data.Yaml ((.:)) import qualified Data.Yaml as Yaml - -import Filesystem (getWorkingDirectory, getModified, getSize - ,canonicalizePath, isDirectory) -import Filesystem.Path hiding ((<.>), (), null, concat) +import Filesystem + (getWorkingDirectory, getModified, getSize, canonicalizePath, isDirectory) +import Filesystem.Path + hiding ((<.>), (), null, concat) import Filesystem.Path.CurrentOS (encodeString) -import GHC.IO.Encoding (setLocaleEncoding, setForeignEncoding, utf8) - -import qualified Network.Browser as Br -import Network.HTTP (mkRequest, RequestMethod(..), Response(..)) -import Network.URI (parseURI, URI(..)) +import GHC.IO.Encoding + (setLocaleEncoding, setForeignEncoding, utf8) import Options.Applicative hiding (info, (&)) import qualified Options.Applicative as O -import System.Directory (findExecutable) +import System.Directory import System.Environment (getEnvironment, getArgs) import System.Environment.Executable (getExecutablePath) -import System.Exit (exitSuccess, exitFailure, ExitCode(..)) +import System.Exit + (exitSuccess, exitFailure, ExitCode(..)) import qualified System.FilePath -import System.IO (hSetBuffering, stdout, BufferMode(..)) +import qualified System.FilePath as FP + +import System.IO + (hPutStrLn, hSetBuffering, stderr, stdout, BufferMode(..)) import System.PosixCompat.Files (setFileMode) import System.Process (readProcessWithExitCode) -import Shelly ((<.>),{-(),-} fromText) +import Shelly ((<.>), fromText) import qualified Shelly as Sh import Text.Read (readEither, readMaybe) @@ -93,8 +107,7 @@ import Text.Read (readEither, readMaybe) -- import Compiler.GhcjsProgram (printVersion) import qualified Compiler.Info as Info -import qualified Compiler.Utils as Utils -import Compiler.Settings (NodeSettings(..)) +import Compiler.Utils as Utils default (Text) @@ -111,106 +124,85 @@ info = Verbosity 2 warn = Verbosity 1 err = Verbosity 0 -data BootSettings = BootSettings { _bsClean :: Bool -- ^ remove existing tree first - , _bsShowVersion :: Bool -- ^ show the version and exit - , _bsQuick :: Bool -- ^ don't install the Cabal library and stage2 packages - , _bsDev :: Bool -- ^ do a development boot - , _bsJobs :: Maybe Int -- ^ number of parallel jobs - , _bsDebug :: Bool -- ^ build debug version of the libraries (GHCJS records the STG in the object files for easier inspection) - , _bsProf :: Bool -- ^ build profiling version of the libraries - , _bsHaddock :: Bool -- ^ build documentation - , _bsVerbosity :: Verbosity -- ^ verbosity level 0..3, 2 is default - , _bsIconvInclude :: Maybe Text -- ^ directory containing iconv.h - , _bsIconvLib :: Maybe Text -- ^ directory containing iconv library - , _bsGmpInclude :: Maybe Text -- ^ directory containing gmp.h - , _bsGmpLib :: Maybe Text -- ^ directory containing gmp library - , _bsGmpFramework :: Bool -- ^ with-gmp-framework-preferred - , _bsGmpInTree :: Bool -- ^ force using the in-tree GMP - , _bsWithCabal :: Maybe Text -- ^ location of cabal (cabal-install) executable, must have GHCJS support - , _bsWithGhcjsBin :: Maybe Text -- ^ bin directory for GHCJS programs - , _bsWithGhcjs :: Maybe Text -- ^ location of GHCJS compiler - , _bsWithGhcjsPkg :: Maybe Text -- ^ location of ghcjs-pkg program - , _bsWithGhcjsRun :: Maybe Text -- ^ location of ghcjs-run program - , _bsWithGhc :: Maybe Text -- ^ location of GHC compiler (must have a GHCJS-compatible Cabal library installed. ghcjs-boot copies some files from this compiler) - , _bsWithGhcPkg :: Maybe Text -- ^ location of ghc-pkg program - , _bsWithNode :: Maybe Text -- ^ location of the node.js program - , _bsWithNodePath :: Maybe Text -- ^ NODE_PATH to use when running node.js Template Haskell or REPL - -- (if unspecified, GHCJS uses bundled packages) - , _bsNodeExtraArgs :: Maybe Text -- ^ extra node arguments - , _bsWithDataDir :: Maybe Text -- ^ override data dir - , _bsWithConfig :: Maybe Text -- ^ installation source configuration (default: lib/etc/boot-sources.yaml in data dir) - , _bsShimsDevRepo :: Maybe Text -- ^ override shims repository - , _bsShimsDevBranch :: Maybe Text -- ^ override shims branch or commit - , _bsBootDevRepo :: Maybe Text -- ^ override ghcjs-boot repository - , _bsBootDevBranch :: Maybe Text -- ^ override ghcjs-boot branch or commit - , _bsStage1Unbooted :: Bool -- ^ build stage1 (like --quick) but leave the compiler in unbooted state with the Cabal package still registered - } deriving (Ord, Eq, Data, Typeable) - -{- | locations to get installation files from - - files may have multiple locations, they're tried in order until one succeeds - - locations are typically read from the sources section in boot.yaml, - customize the defaults in lib/etc/boot.yaml in the installed data dir, - or use the --sources or --datadir options - -} -data BootSources = BootSources { _bsrcShims :: [Text] - , _bsrcBoot :: [Text] - , _bsrcTest :: [Text] - , _bsrcEtc :: [Text] - , _bsrcDoc :: [Text] - , _bsrcGhcjsPrim :: [Text] - , _bsrcGhcjsTh :: [Text] - , _bsrcInclude :: [Text] - , _bsrcShimsDev :: [Text] - , _bsrcShimsDevBranch :: Text - , _bsrcBootDev :: [Text] - , _bsrcBootDevBranch :: Text - , _bsrcBuildtoolsWindows :: [Text] - , _bsrcBuildtoolsBootWindows :: [Text] - } deriving (Data, Typeable) +data BootSettings = BootSettings + { _bsShowVersion :: Bool -- ^show the version and exit + , _bsJobs :: Maybe Int -- ^number of parallel jobs + , _bsDebug :: Bool {- ^build debug version of the libraries + (GHCJS records the STG in the object + files for easier inspection) -} + , _bsProf :: Bool -- ^build profiling version of the libraries + , _bsHaddock :: Bool -- ^build documentation + , _bsVerbosity :: Verbosity -- ^verbosity level 0..3, 2 is default + , _bsWithCabal :: Maybe Text {- ^location of cabal (cabal-install) + executable, must have GHCJS support -} + , _bsWithGhcjsBin :: Maybe Text -- ^bin directory for GHCJS programs + , _bsWithGhcjs :: Maybe Text -- ^location of GHCJS compiler + , _bsWithGhcjsPkg :: Maybe Text -- ^location of ghcjs-pkg program + , _bsWithGhcjsRun :: Maybe Text -- ^location of ghcjs-run program + , _bsWithGhc :: Maybe Text {- ^location of GHC compiler (must have a + GHCJS-compatible Cabal library + installed. ghcjs-boot copies some files + from this compiler) -} + , _bsWithGhcPkg :: Maybe Text -- ^location of ghc-pkg program + , _bsWithNode :: Maybe Text -- ^location of the node.js program + , _bsSourceDir :: Maybe Text -- ^source directory (can be a tar file) + -- , _bsBuildDir :: Maybe Text -- ^build directory + } deriving (Ord, Eq, Data, Typeable) + {- | Stage configuration file: packages to install in each stage see boot.yaml for more information -} -data BootStages = BootStages { _bstStage1a :: Stage - , _bstStage1b :: Stage - , _bstStage2 :: Stage - , _bstPretend :: [Package] -- ^ packages we pretend to have in stage one, but actually hand off to GHC - , _bstCabal :: Package -- ^ installed between 1b and 2, only when doing a full boot - , _bstGhcjsTh :: Package -- ^ installed between 1b and 2 - , _bstGhcjsPrim :: Package -- ^ installed between 1a and 1b - , _bstGhcPrim :: Package -- ^ installed before stage 1a - } deriving (Data, Typeable) +data BootStages = BootStages + { _bstStage1a :: Stage + , _bstStage1b :: Stage + , _bstPretend :: [Package] {- ^packages we pretend to have in stage one, + but actually hand off to GHC -} + , _bstCabal :: Package {- ^installed between 1b and 2, + only when doing a full boot -} + , _bstGhcjsTh :: Package -- ^installed between 1b and 2 + , _bstGhcjsPrim :: Package -- ^installed between 1a and 1b + , _bstGhcPrim :: Package -- ^installed before stage 1a + } deriving (Data, Typeable) type Stage = [CondPackage] -type Package = Text -- ^ just the package name, can be a directory name - -- (starting with ./ relative to the ghcjs-boot root), - -- a url or a plain package name - -data PlatformCond = Windows | Unix deriving (Eq, Ord, Enum, Data, Typeable) -data BootTypeCond = Full | Quick deriving (Eq, Ord, Enum, Data, Typeable) - -data CondPackage = CondPackage { _cpPlatform :: Maybe PlatformCond - , _cpBootType :: Maybe BootTypeCond - , _cpPackage :: Package - } deriving (Data, Typeable) - -data BootLocations = BootLocations { _blGhcjsTopDir :: FilePath -- ^ install to here - , _blGhcjsLibDir :: FilePath - , _blGhcLibDir :: FilePath -- ^ copy GHC files from here - , _blGlobalDB :: FilePath -- ^ global package database - , _blUserDBDir :: Maybe FilePath -- ^ user package database location - , _blNativeToo :: Bool -- ^ build/install native code too - } deriving (Data, Typeable) - -data Program a = Program { _pgmName :: Text -- ^ program name for messages - , _pgmSearch :: Text -- ^ name searched for when configuring the program (from command line or config file) - , _pgmVersion :: Maybe Text -- ^ version if known - , _pgmLoc :: Maybe FilePath -- ^ absolute path to the program - , _pgmArgs :: [Text] -- ^ extra arguments to pass to the program - } deriving (Data, Typeable) + +type Package = Text {- ^just the package name/location, unversioned + + can be a directory name + (starting with ./ relative to the ghcjs-boot root), + a url or a plain package name + -} + +data PlatformCond = Windows + | Unix + deriving (Eq, Ord, Enum, Data, Typeable) + +data CondPackage = CondPackage + { _cpPlatform :: Maybe PlatformCond + , _cpPackage :: Package + } deriving (Data, Typeable) + +data BootLocations = BootLocations + { _blSourceDir :: FilePath + , _blBuildDir :: FilePath + , _blGhcjsTopDir :: FilePath -- ^install to here + , _blGhcjsLibDir :: FilePath + , _blGhcLibDir :: FilePath -- ^copy GHC files from here + , _blGlobalDB :: FilePath -- ^global package database + , _blUserDBDir :: Maybe FilePath -- ^user package database location + } deriving (Data, Typeable) + +data Program a = Program + { _pgmName :: Text -- ^program name for messages + , _pgmSearch :: Text {- ^name searched for when configuring the + program (from command line or config file) + -} + , _pgmVersion :: Maybe Text -- ^version if known + , _pgmLoc :: Maybe FilePath -- ^absolute path to the program + , _pgmArgs :: [Text] -- ^extra arguments to pass to the program + } deriving (Data, Typeable) data Required = Required deriving (Data, Typeable) data Optional = Optional deriving (Data, Typeable) @@ -228,11 +220,9 @@ data BootPrograms = BootPrograms { _bpGhcjs :: Program Required , _bpCabal :: Program Required , _bpNode :: Program Required , _bpHaddock :: Program Required - , _bpNpm :: Program Optional , _bpGit :: Program Optional , _bpAlex :: Program Optional , _bpHappy :: Program Optional - , _bpTar :: Program Optional , _bpCpp :: Program Optional , _bpBash :: Program Optional , _bpAutoreconf :: Program Optional @@ -240,229 +230,140 @@ data BootPrograms = BootPrograms { _bpGhcjs :: Program Required } deriving (Data, Typeable) data BootEnv = BootEnv { _beSettings :: BootSettings - , _beSources :: BootSources , _beLocations :: BootLocations , _bePrograms :: BootPrograms , _beStages :: BootStages } -data BootConfigFile = BootConfigFile BootStages BootSources BootPrograms +data BootConfigFile = BootConfigFile BootStages BootPrograms deriving (Data, Typeable) makeLenses ''Program makeLenses ''CondPackage makeLenses ''BootSettings -makeLenses ''BootSources makeLenses ''BootLocations makeLenses ''BootPrograms makeLenses ''BootStages makeLenses ''BootEnv -resolveConds :: Bool -> [CondPackage] -> [Package] -resolveConds quick stage = - let excluded cp = cp ^. cpPlatform == Just (if isWindows then Unix else Windows) || - cp ^. cpBootType == Just (if quick then Full else Quick) +resolveConds :: [CondPackage] -> [Package] +resolveConds stage = + let excluded cp = cp ^. cpPlatform == + Just (if isWindows then Unix else Windows) in map (view cpPackage) (filter (not . excluded) stage) --- | all packages that can be built on this host +-- |all packages that can be built on this host resolveCondsHost :: [CondPackage] -> [Package] resolveCondsHost stage = - let excluded cp = cp ^. cpPlatform == Just (if isWindows then Unix else Windows) + let excluded cp = cp ^. cpPlatform == + Just (if isWindows then Unix else Windows) in map (view cpPackage) (filter (not . excluded) stage) --- | all packages from all stages that can be built on this machine +-- |all packages from all stages that can be built on this machine allPackages :: B [Package] allPackages = p <$> view beStages where p s = [s ^. bstGhcjsPrim, s ^. bstCabal, s ^. bstGhcPrim] ++ - resolveCondsHost ((s ^. bstStage1a) ++ (s ^. bstStage1b) ++ (s ^. bstStage2)) + resolveCondsHost ((s ^. bstStage1a) ++ (s ^. bstStage1b)) main :: IO () main = do - -- temporary warning - whenM ((==["--init"]) <$> getArgs) (putStrLn "ghcjs-boot has been updated. see README.\nUse `ghcjs-boot --dev' for a development build (if you installed GHCJS from a Git repo) or `ghcjs-boot' for a release build" >> exitFailure) - settings <- adjustDefaultSettings <$> execParser optParser' + settings <- execParser optParser' when (settings ^. bsShowVersion) (printVersion >> exitSuccess) hSetBuffering stdout LineBuffering setLocaleEncoding utf8 setForeignEncoding utf8 env <- initBootEnv settings printBootEnvSummary False env - r <- Sh.shelly $ runReaderT ((actions >> pure Nothing) `catchAny` (pure . Just)) env + r <- Sh.shelly $ runReaderT ((actions >> pure Nothing) + `catchAny` (pure . Just)) env maybe exitSuccess Ex.throwIO r where actions :: B () actions = verbosely . tracing False $ do e <- ask - when (e ^. beSettings . bsClean) cleanTree removeCompleted - mapM_ addCheckpoint ["ghcjs-boot checkpoints file", "init"] - installBuildTools - bool (e ^. beSettings . bsDev) installDevelopmentTree installReleaseTree initPackageDB cleanCache - installRts - installEtc - installDocs - installTests - copyGhcjsIntree - copyIncludes + prepareLibDir let base = e ^. beLocations . blGhcjsLibDir setenv "CFLAGS" $ "-I" <> toTextI (base "include") installFakes installStage1 - unless (e ^. beSettings . bsStage1Unbooted) $ do - removeFakes - unless (e ^. beSettings . bsQuick) installStage2 + removeFakes + installCabal when (e ^. beSettings . bsHaddock) buildDocIndex liftIO . printBootEnvSummary True =<< ask - unless (e ^. beSettings . bsStage1Unbooted) addCompleted - -cleanTree :: B () -cleanTree = do - topDir <- view (beLocations . blGhcjsTopDir) - exists <- liftIO $ isDirectory topDir - if exists - then do - msg info ("cleaning installation tree " <> toTextI topDir) - hasCheckpoint "init" >>= cond (rm_rf topDir) - (failWith ("directory to clean might not be a GHCJS installation directory: " <> toTextI topDir <> ", not cleaning")) - else msg info "skipping clean because installation tree doesn't exist" - -instance Yaml.FromJSON BootSources where - parseJSON (Yaml.Object v) = BootSources - <$> v ..: "shims" <*> v ..: "boot" <*> v ..: "test" - <*> v ..: "etc" <*> v ..: "doc" - <*> v ..: "ghcjs-prim" <*> v ..: "ghcjs-th" - <*> v ..: "include" - <*> v ..: "shims-dev" <*> v .: "shims-dev-branch" - <*> v ..: "ghcjs-boot-dev" <*> v .: "ghcjs-boot-dev-branch" - <*> v ..: "buildtools-windows" <*> v ..: "buildtools-boot-windows" - where - o ..: p = (nonempty =<< o .: p) <|> ((:[]) <$> o .: p) - nonempty xs = if null xs then mempty else return xs - parseJSON _ = mempty + addCompleted instance Yaml.FromJSON BootPrograms where parseJSON (Yaml.Object v) = BootPrograms <$> v ..: "ghcjs" <*> v ..: "ghcjs-pkg" <*> v ..: "ghcjs-run" <*> v ..: "ghc" <*> v ..: "ghc-pkg" <*> v ..: "cabal" <*> v ..: "node" <*> v ..: "haddock-ghcjs" - <*> v ..: "npm" <*> v ..: "git" <*> v ..: "alex" - <*> v ..: "happy" <*> v ..: "tar" + <*> v ..: "git" <*> v ..: "alex" + <*> v ..: "happy" <*> v ..: "cpp" <*> v ..: "bash" <*> v ..: "autoreconf" <*> v ..: "make" where - o ..: p = ((\t -> Program p t Nothing Nothing []) <$> o .: p) <|> (withArgs p =<< o .: p) + o ..: p = ((\t -> Program p t Nothing Nothing []) <$> o .: p) <|> + (withArgs p =<< o .: p) withArgs :: Text -> Yaml.Value -> Yaml.Parser (Program a) - withArgs p (Yaml.Object o) | [(k,v)] <- HM.toList o = Program p k Nothing Nothing <$> Yaml.parseJSON v - withArgs _ _ = mempty + withArgs p (Yaml.Object o) | [(k,v)] <- HM.toList o = + Program p k Nothing Nothing <$> Yaml.parseJSON v + withArgs _ _ = + mempty parseJSON _ = mempty instance Yaml.FromJSON BootStages where parseJSON (Yaml.Object v) = BootStages - <$> v ..: "stage1a" <*> v ..: "stage1b" <*> v ..: "stage2" - <*> v .:: "stage1PretendToHave" <*> v .: "cabal" - <*> v .: "ghcjs-th" <*> v .: "ghcjs-prim" + <$> v ..: "stage1a" + <*> v ..: "stage1b" + <*> v .:: "stage1PretendToHave" + <*> v .: "cabal" + <*> v .: "ghcjs-th" + <*> v .: "ghcjs-prim" <*> v .: "ghc-prim" where o .:: p = ((:[])<$>o.:p) <|> o.:p - o ..: p = pkgs Nothing Nothing =<< o .: p - pkgs plc btc (Yaml.Object o) | [(k,v)] <- HM.toList o = matchCond plc btc k v - pkgs plc btc (Yaml.String t) = pure [CondPackage plc btc t] - pkgs plc btc (Yaml.Array v) = concat <$> mapM (pkgs plc btc) (V.toList v) - pkgs _ _ _ = mempty - matchCond plc btc k v - | k == "IfWindows" && plc /= Just Unix = pkgs (Just Windows) btc v - | k == "IfUnix" && plc /= Just Windows = pkgs (Just Unix) btc v - | k == "IfQuick" && btc /= Just Full = pkgs plc (Just Quick) v - | k == "IfFull" && btc /= Just Quick = pkgs plc (Just Full) v + o ..: p = pkgs Nothing =<< o .: p + pkgs plc (Yaml.Object o) | [(k,v)] <- HM.toList o = + matchCond plc k v + pkgs plc (Yaml.String t) = + pure [CondPackage plc t] + pkgs plc (Yaml.Array v) = + concat <$> mapM (pkgs plc) (V.toList v) + pkgs _ _ = + mempty + matchCond plc k v + | k == "IfWindows" && plc /= Just Unix = pkgs (Just Windows) v + | k == "IfUnix" && plc /= Just Windows = pkgs (Just Unix) v | otherwise = mempty parseJSON _ = mempty instance Yaml.FromJSON BootConfigFile where parseJSON (Yaml.Object v) = BootConfigFile - <$> v .: "packages" <*> v .: "sources" <*> v .: "programs" + <$> v .: "packages" <*> v .: "programs" parseJSON _ = mempty -adjustDefaultSettings :: BootSettings -> BootSettings -adjustDefaultSettings s - | isWindows && isNothing (s ^. bsGmpInclude) && isNothing (s ^. bsGmpLib) = s & bsGmpInTree .~ True - | otherwise = s - -{- - We install some build tools automatically if we're on Windows - -} -installBuildTools :: B () -installBuildTools - | not isWindows = return () - | otherwise = instBt -- >> setBuildEnv - where - instBt = checkpoint' "buildtools" "buildtools already installed" $ do - subTop $ do - checkpoint' "mingw" "MingW installation already copied" $ do - msg info "MingW installation not found, copying from GHC" - flip cp_r ".." <^> beLocations . blGhcLibDir . to ( (".." "mingw")) -{- - subTop $ do - p <- absPath =<< pwd - checkpoint' "buildtools" "Buildtools already installed" $ do - checkpoint' "buildtools-boot" "Buildtools bootstrap archive already installed" $ - install' "Windows buildtools bootstrap archive" "buildtools-boot" <^> beSources . bsrcBuildtoolsBootWindows - prependPathEnv [p "buildtools-boot" "bin"] - install' "Windows buildtools" "buildtools" <^> beSources . bsrcBuildtoolsWindows - setBuildEnv = do - libDir <- view (beLocations . blGhcjsLibDir) - cd libDir - p <- absPath =<< pwd - let bt = p "buildtools" - mw <- canonicalize (p ".." "mingw") - prependPathEnv [ mw "bin" - , bt "bin" - , bt "msys" "1.0" "bin" - , bt "git" "bin" - ] - setenv "MINGW_HOME" (toTextI mw) - setenv "PERL5LIB" (msysPath $ bt "share" "autoconf") - mkdir_p (bt "etc") - mkdir_p (bt "msys" "1.0" "mingw") - writefile (bt "msys" "1.0" "etc" "fstab") $ T.unlines - [ escapePath bt <> " /mingw" - , escapePath (bt "msys" "1.0" "bin") <> " /bin" - ] --} -prependPathEnv :: [FilePath] -> B () -prependPathEnv xs = do - path1 <- get_env "Path" - path2 <- get_env "PATH" - let path = maybe "" (";"<>) (path1 <> path2) - newPath = T.intercalate ";" (map toTextI xs) <> path - setenv "Path" newPath - setenv "PATH" newPath -- convert C:\x\y to /c/x/y (only on Windows) msysPath :: FilePath -> Text msysPath p - | isWindows = let p' = toTextI p - backToForward '\\' = '/' - backToForward x = x - isRel = "." `T.isPrefixOf` p' -- fixme - in bool isRel "" "/" <> T.map backToForward (T.filter (/=':') p') + | isWindows = + let p' = toTextI p + backToForward '\\' = '/' + backToForward x = x + isRel = "." `T.isPrefixOf` p' -- fixme + in bool isRel "" "/" <> T.map backToForward (T.filter (/=':') p') | otherwise = toTextI p -escapePath :: FilePath -> Text -escapePath p = let p' = toTextI p - escape ' ' = "\\ " - escape '\\' = "/" - escape c = T.singleton c - in T.concatMap escape p' - optParser' :: ParserInfo BootSettings -optParser' = O.info (helper <*> optParser) - (fullDesc <> - header "GHCJS booter, build base libraries for the compiler" <> - progDesc description - ) +optParser' = + O.info (helper <*> optParser) + (fullDesc <> + header "GHCJS booter, build base libraries for the compiler" <> + progDesc description) description :: String description = unlines @@ -470,71 +371,66 @@ description = unlines ] optParser :: Parser BootSettings -optParser = BootSettings - <$> switch ( long "clean" <> short 'c' <> - help "clean the installation directory first" ) - <*> switch ( long "version" <> - help "show the ghcjs-boot version" ) - <*> switch ( long "quick" <> short 'q' <> - help "quick boot (no Cabal or ghcjs-base, but enough to compile basic tests)" ) - <*> switch ( long "dev" <> short 'd' <> - help "fetch development sources (requires more build tools)" ) - <*> (optional . option auto) ( long "jobs" <> short 'j' <> metavar "JOBS" <> - help "number of jobs to run in parallel" ) - <*> switch ( long "debug" <> short 'd' <> - help "build debug libraries with extra checks" ) - <*> fmap not (switch ( long "no-prof" <> - help "don't generate profiling version of the libraries" )) - <*> fmap not (switch ( long "no-haddock" <> - help "don't generate documentation" )) - <*> (fmap Verbosity . option auto) ( long "verbosity" <> short 'v' <> value 2 <> - help "verbose output" ) - <*> (optional . fmap T.pack . strOption) ( long "with-iconv-includes" <> metavar "DIR" <> - help "directory containing iconv.h" ) - <*> (optional . fmap T.pack . strOption) ( long "with-iconv-libraries" <> metavar "DIR" <> - help "directory containing iconv library" ) - <*> (optional . fmap T.pack . strOption) ( long "with-gmp-includes" <> metavar "DIR" <> - help "directory containing gmp.h" ) - <*> (optional . fmap T.pack . strOption) ( long "with-gmp-libraries" <> metavar "DIR" <> - help "directory containing gmp library" ) - <*> switch ( long "with-gmp-framework-preferred" <> - help "on OSX, prefer the GMP framework to the gmp lib" ) - <*> switch ( long "with-intree-gmp" <> - help "force using the in-tree GMP" ) - <*> (optional . fmap T.pack . strOption) ( long "with-cabal" <> metavar "PROGRAM" <> - help "cabal program to use" ) - <*> (optional . fmap T.pack . strOption) ( long "with-ghcjs-bin" <> metavar "DIR" <> - help "bin directory for GHCJS programs" ) - <*> (optional . fmap T.pack . strOption) ( long "with-ghcjs" <> metavar "PROGRAM" <> - help "ghcjs program to use" ) - <*> (optional . fmap T.pack . strOption ) ( long "with-ghcjs-pkg" <> metavar "PROGRAM" <> - help "ghcjs-pkg program to use" ) - <*> (optional . fmap T.pack . strOption ) ( long "with-ghcjs-run" <> metavar "PROGRAM" <> - help "ghcjs-run program to use" ) - <*> (optional . fmap T.pack . strOption) ( long "with-ghc" <> metavar "PROGRAM" <> - help "ghc program to use" ) - <*> (optional . fmap T.pack . strOption) ( long "with-ghc-pkg" <> metavar "PROGRAM" <> - help "ghc-pkg program to use" ) - <*> (optional . fmap T.pack . strOption) ( long "with-node" <> metavar "PROGRAM" <> - help "node.js program to use" ) - <*> (optional . fmap T.pack . strOption) ( long "with-node-path" <> metavar "PATH" <> - help "value of NODE_PATH environment variable when running Template Haskell or GHCJSi" ) - <*> (optional . fmap T.pack . strOption) ( long "extra-node-args" <> metavar "ARGS" <> - help "extra arguments to pass to node.js") - <*> (optional . fmap T.pack . strOption) ( long "with-datadir" <> metavar "DIR" <> - help "data directory with libraries and configuration files" ) - <*> (optional . fmap T.pack . strOption) ( long "with-config" <> metavar "FILE" <> - help "boot configuration file (default: boot.yaml in datadir)" ) - <*> (optional . fmap T.pack . strOption ) ( long "shims-dev-repo" <> metavar "REPOSITORY" <> - help "override shims repository location" ) - <*> (optional . fmap T.pack . strOption ) ( long "shims-dev-branch" <> metavar "BRANCH" <> - help "override shims branch or commit to check out" ) - <*> (optional . fmap T.pack . strOption ) ( long "ghcjs-boot-dev-repo" <> metavar "REPOSITORY" <> - help "override ghcjs-boot repository location" ) - <*> (optional . fmap T.pack . strOption ) ( long "ghcjs-boot-dev-branch" <> metavar "BRANCH" <> - help "override ghcjs-boot branch or commit to check out" ) - <*> switch ( long "build-stage1-unbooted" <> - help "build stage1 packages but leave the compiler in unbooted state (for testing only)" ) +optParser = + BootSettings + <$> switch + (long "version" <> + help "show the ghcjs-boot version") + <*> (optional . option auto) + (long "jobs" <> + short 'j' <> + metavar "JOBS" <> + help "number of jobs to run in parallel") + <*> switch + (long "debug" <> + short 'd' <> + help "build debug libraries with extra checks") + <*> (fmap not . switch) + (long "no-prof" <> + help "don't generate profiling version of the libraries") + <*> (fmap not . switch) + (long "no-haddock" <> + help "don't generate documentation") + <*> (fmap Verbosity . option auto) + (long "verbosity" <> + short 'v' <> + value 2 <> + help "verbose output") + <*> (optional . fmap T.pack . strOption) + (long "with-cabal" <> metavar "PROGRAM" <> + help "cabal program to use") + <*> (optional . fmap T.pack . strOption) + (long "with-ghcjs-bin" <> + metavar "DIR" <> + help "bin directory for GHCJS programs") + <*> (optional . fmap T.pack . strOption) + (long "with-ghcjs" <> + metavar "PROGRAM" <> + help "ghcjs program to use") + <*> (optional . fmap T.pack . strOption) + (long "with-ghcjs-pkg" <> + metavar "PROGRAM" <> + help "ghcjs-pkg program to use") + <*> (optional . fmap T.pack . strOption) + (long "with-ghcjs-run" <> + metavar "PROGRAM" <> + help "ghcjs-run program to use") + <*> (optional . fmap T.pack . strOption) + (long "with-ghc" <> + metavar "PROGRAM" <> + help "ghc program to use") + <*> (optional . fmap T.pack . strOption) + (long "with-ghc-pkg" <> metavar "PROGRAM" <> + help "ghc-pkg program to use") + <*> (optional . fmap T.pack . strOption) + (long "with-node" <> + metavar "PROGRAM" <> + help "node.js program to use") + <*> (optional . fmap T.pack . strOption) + (long "source-dir" <> + short 's' <> + metavar "DIR" <> + help "location of GHCJS library sources") initPackageDB :: B () initPackageDB = do @@ -542,7 +438,9 @@ initPackageDB = do initDB "--global" <^> beLocations . blGlobalDB traverseOf_ _Just initUser <^> beLocations . blUserDBDir where - initUser dir = rm_f (dir "package.conf") >> initDB "--user" (dir "package.conf.d") + initUser dir = do + rm_f (dir "package.conf") + initDB "--user" (dir "package.conf.d") initDB dbName db = do rm_rf db >> mkdir_p db ghcjs_pkg_ ["init", toTextI db] `catchAny_` return () @@ -554,248 +452,55 @@ cleanCache = Just p -> rm_rf (fromString p) `catchAny_` return () Nothing -> return () -bootDescr :: Text -bootDescr = "boot libraries" - -shimsDescr :: Text -shimsDescr = "shims, runtime system and support libraries" - -installDevelopmentTree :: B () -installDevelopmentTree = subTop $ do - p <- pwd - msgD info $ "preparing development boot tree" - checkpoint' "ghcjs-boot-git" "ghcjs-boot repository already cloned and prepared" $ do - testGit "ghcjs-boot" >>= \case - Just False -> failWith "ghcjs-boot already exists and is not a git repository" - Just True -> do - msg info "ghcjs-boot repository already exists but checkpoint not reached, cleaning first, then cloning" - rm_rf "ghcjs-boot" - initGhcjsBoot - Nothing -> do - msgD info "cloning ghcjs-boot git repository" - initGhcjsBoot - checkpoint' "shims-git" "shims repository already cloned" $ do - testGit "shims" >>= \case - Just False -> failWith "shims already exists and is not a git repository" - Just True -> do - msgD info "shims repository already exists but checkpoint not reached, cleaning first, then cloning" - rm_rf "shims" - cloneGit shimsDescr "shims" bsrcShimsDevBranch bsrcShimsDev - Nothing -> do - msgD info "cloning shims git repository" - cloneGit shimsDescr "shims" bsrcShimsDevBranch bsrcShimsDev - where - initGhcjsBoot = sub $ do - cloneGit bootDescr "ghcjs-boot" bsrcBootDevBranch bsrcBootDev - cd "ghcjs-boot" - git_ ["submodule", "update", "--init", "--recursive"] - mapM_ patchPackage =<< allPackages - preparePrimops - buildGenPrim - cleanGmp - testGit d = cond (Just<$>test_d (d".git")) (pure Nothing) =<< test_d d - cloneGit descr repoName branch srcs = do - msgD info ("cloning git repository for " <> descr) - cloneGitSrcs descr <^> beSources . srcs - branch' <- view (beSources . branch) - sub $ do - cd repoName - git_ ["checkout", branch'] - cloneGitSrcs d [] = failWith ("could not clone " <> d <> ", no available sources") - cloneGitSrcs d (x:xs) = git_ ["clone", x] `catchAny_` - (msgD warn "clone failed, trying next source" >> cloneGitSrcs d xs) - -installReleaseTree :: B () -installReleaseTree = subTop $ do - msgD info "preparing release boot tree" - checkpoint' "ghcjs-boot-release" "ghcjs-boot tree already installed" $ do - whenM (test_d "ghcjs-boot") (msgD warn "existing ghcjs-boot tree found from incomplete installation") - install' bootDescr "ghcjs-boot" <^> beSources . bsrcBoot - preparePrimops - buildGenPrim - checkpoint' "shims-release" "shims tree already installed" $ do - whenM (test_d "shims") (msgD warn "existing shims tree found from incomplete installation") - install' shimsDescr "shims" <^> beSources . bsrcShims - --- | preprocess primops.txt.pp, one version for the JS platform --- one for native -preparePrimops :: B () -preparePrimops = subTop' ("ghcjs-boot" "data") . checkpoint' "primops" "primops already prepared" $ do - msg info "preparing primops" - mkdir_p "native" - ghcLibDir <- view (beLocations . blGhcLibDir) - cp (ghcLibDir "include" "MachDeps.h") "native" - cp (ghcLibDir "include" "ghcautoconf.h") "native" - cp (ghcLibDir "include" "ghcplatform.h") ("native" "ghc_boot_platform.h") - silently $ do - primopsJs <- cpp ["-P", "-Ijs", "primops.txt.pp"] - writefile "primops-js.txt" primopsJs - primopsNative <- cpp ["-P", "-Inative", "primops.txt.pp"] - writefile "primops-native.txt" primopsNative - --- | build the genprimopcode tool, this requires alex and happy -buildGenPrim :: B () -buildGenPrim = subTop' ("ghcjs-boot" "utils" "genprimopcode") $ do - make "genprimopcode" [] $ do - make "Lexer.hs" ["Lexer.x"] (alex_ ["-g", "-o", "Lexer.hs", "Lexer.x"]) - make "Parser.hs" ["Parser.y"] (happy_ ["-agc", "-o", "Parser.hs", "Parser.y"]) - ghc_ ["-o", "genprimopcode", "-O", "Main.hs", "+RTS", "-K128M"] - --- fixme this hardcodes the location of integer-gmp -integerGmp :: FilePath -integerGmp = "ghcjs-boot" "boot" "integer-gmp" - -cleanGmp :: B () -cleanGmp = subTop' integerGmp $ do - rm_rf ("gmp" "intree") - rm_f ("mkGmpDerivedConstants" exe "mkGmpDerivedConstants") - rm_f "GmpDerivedConstants.h" - -prepareGmp :: B () -prepareGmp = subTop' integerGmp . checkpoint' "gmp" "in-tree gmp already prepared" $ do - intreeInstalled <- test_f ("gmp" "intree" "include" "gmp.h") - gmpInTree <- view (beSettings . bsGmpInTree) - sub $ when (gmpInTree && not intreeInstalled) $ do - cd "gmp" - lsFilter "." isGmpSubDir rm_rf - msg info "unpacking in-tree GMP" - lsFilter "tarball" (return . isTarball) (installArchive False "in-tree libgmp" ".") - d <- pwd - ad <- absPath d - lsFilter "." isGmpSubDir $ \dir -> do - -- patch has already been applied - cd dir - adir <- absPath dir - msgD info "building GMP" - configure_ ["--prefix=" <> msysPath (ad "intree")] - runMake_ [] - runMake_ ["install"] - make "GmpGeneratedConstants.h" [] $ do - gmpIncl <- view (beSettings . bsGmpInclude) - p <- absPath =<< pwd - buildGmpConstants (gmpIncl `mplus` bj gmpInTree (toTextI $ p "gmp" "intree" "include")) - where - lsFilter :: FilePath -> (FilePath -> B Bool) -> (FilePath -> B ()) -> B () - lsFilter dir p a = ls dir >>= mapM_ (\x -> p x >>= flip when (a x)) - isTarball file = any (`T.isSuffixOf` toTextI file) [".tar", ".tar.bz2"] - isGmpSubDir dir = (("gmp-" `T.isPrefixOf`) . toTextI) <$> relativeTo "." dir - -buildGmpConstants :: Maybe Text -> B () -buildGmpConstants includeDir = subTop' integerGmp $ do - msg info "generating GMP derived constants" - cd "mkGmpDerivedConstants" - ghc_ $ maybe [] (\d -> ["-I" <> d]) includeDir ++ - ["-fforce-recomp", "-no-hs-main", "-o", "mkGmpDerivedConstants", "mkGmpDerivedConstants.c"] - p <- pwd - constants <- run (Program "" "" Nothing (Just $ p "mkGmpDerivedConstants") []) [] - writefile "GmpDerivedConstants.h" constants - -patchPackage :: Package -> B () -patchPackage pkg - | Just pkg' <- T.stripPrefix "./" (T.strip pkg) = - let pkgName = last (T.splitOn "/" pkg') - p = "patches" fromText pkgName <.> "patch" - applyPatch = do - msg info ("applying patch: " <> toTextI p) - cd (fromText pkg') - when isWindows (git_ ["config", "core.filemode", "false"]) - -- workaround for Windows MSYS2 git not liking our absolute paths - git_ ["apply", T.replicate (1 + T.count "/" pkg') "../" <> - "patches/" <> pkgName <> ".patch"] - in sub $ cond applyPatch (msg info $ "no patch for package " <> pkgName <> " found") =<< test_f p - | otherwise = return () - -installRts :: B () -installRts = subTop' "ghcjs-boot" $ do - msg info "installing RTS" +prepareLibDir :: B () +prepareLibDir = subBuild $ do + msg info "preparing GHCJS library directory" globalDB <- view (beLocations . blGlobalDB) ghcLib <- view (beLocations . blGhcLibDir) ghcjsLib <- view (beLocations . blGhcjsLibDir) ghcjsTop <- view (beLocations . blGhcjsTopDir) let inc = ghcjsLib "include" incNative = ghcjsLib "include_native" -#if __GLASGOW_HASKELL__ >= 711 rtsConfFile = "rts.conf" -#else - rtsConfFile = "builtin_rts.conf" -#endif -#if __GLASGOW_HASKELL__ >= 709 rtsLib = ghcjsLib "rts" -#else - rtsLib = ghcjsLib "rts-1.0" -#endif rtsConf <- readfile (ghcLib "package.conf.d" rtsConfFile) - writefile (globalDB rtsConfFile) (fixRtsConf (toTextI inc) (toTextI rtsLib) rtsConf) + writefile (globalDB rtsConfFile) + (fixRtsConf (toTextI inc) (toTextI rtsLib) rtsConf) ghcjs_pkg_ ["recache", "--global", "--no-user-package-db"] forM_ [ghcjsLib, inc, incNative] mkdir_p + cp_r "shims" ghcjsLib + sub $ cd "data" >> cp_r "." ghcjsLib sub $ cd (ghcLib "include") >> cp_r "." incNative -#if __GLASGOW_HASKELL__ >= 709 sub $ cd (ghcLib "rts") >> cp_r "." rtsLib -#else - sub $ cd (ghcLib "rts-1.0") >> cp_r "." rtsLib -#endif sub $ cd ("data" "include") >> installPlatformIncludes inc incNative cp (ghcLib "settings") (ghcjsLib "settings") cp (ghcLib "platformConstants") (ghcjsLib "platformConstants") -#if __GLASGOW_HASKELL__ >= 711 let unlitDest = ghcjsLib "bin" exe "unlit" -#else - let unlitDest = ghcjsLib exe "unlit" -#endif ghcjsRunDest = ghcjsLib exe "ghcjs-run" ghcjsRunSrc <- view (bePrograms . bpGhcjsRun . pgmLoc . to fromJust) -#if __GLASGOW_HASKELL__ >= 711 mkdir_p (ghcjsLib "bin") cp (ghcLib "bin" exe "unlit") unlitDest -#else - cp (ghcLib exe "unlit") unlitDest -#endif cp ghcjsRunSrc ghcjsRunDest - mapM_ (liftIO . Cabal.setFileExecutable . toStringI) [unlitDest, ghcjsRunDest] - prepareNodeJs + mapM_ (liftIO . Cabal.setFileExecutable . toStringI) + [unlitDest, ghcjsRunDest] + writefile (ghcjsLib "node") <^> bePrograms + . bpNode + . pgmLoc + . to (maybe "-" toTextI) when (not isWindows) $ do let runSh = ghcjsLib "run" <.> "sh" writefile runSh "#!/bin/sh\nCOMMAND=$1\nshift\n\"$COMMAND\" \"$@\"\n" liftIO . Cabal.setFileExecutable . toStringI =<< absPath runSh -- required for integer-gmp - whenM (view (beLocations . blNativeToo)) $ do - prepareGmp - cp ("boot" "integer-gmp" "mkGmpDerivedConstants" "GmpDerivedConstants.h") inc subTop $ do writefile "empty.c" "" ghc_ ["-c", "empty.c"] when isWindows $ -#if __GLASGOW_HASKELL__ >= 711 - cp (ghcLib "bin" exe "touchy") (ghcjsLib "bin" exe "touchy") -#else - cp (ghcLib exe "touchy") (ghcjsLib exe "touchy") -#endif + cp (ghcLib "bin" exe "touchy") + (ghcjsLib "bin" exe "touchy") writefile (ghcjsLib "ghc_libdir") (toTextI ghcLib) msg info "RTS prepared" -prepareNodeJs :: B () -prepareNodeJs = do - ghcjsLib <- view (beLocations . blGhcjsLibDir) - nodeProgram <- view (bePrograms . bpNode . pgmLoc . to (maybe "-" toTextI)) - mbNodePath <- view (beSettings . bsWithNodePath) - extraArgs <- view (beSettings . bsNodeExtraArgs) - -- If no setting for NODE_PATH is specified, we use the libraries bundled - -- with the ghcjs-boot repo. We must run "npm rebuild" to build - -- any sytem-specific components. - when (isNothing mbNodePath) $ do - npmProgram <- view (bePrograms . bpNpm) - subTop $ cp_r ("ghcjs-boot" "ghcjs-node") "ghcjs-node" - subTop' "ghcjs-node" $ npm_ ["rebuild"] - -- write nodeSettings.json file - let nodeSettings = NodeSettings - { nodeProgram = T.unpack nodeProgram - , nodePath = mbNodePath - , nodeExtraArgs = maybeToList extraArgs - , nodeKeepAliveMaxMem = 536870912 - } - liftIO $ BL.writeFile (T.unpack . toTextI $ ghcjsLib "nodeSettings.json") - (Aeson.encode $ Aeson.toJSON nodeSettings) - installPlatformIncludes :: FilePath -> FilePath -> B () installPlatformIncludes inc incNative = do pw <- pwd @@ -820,54 +525,45 @@ installPlatformIncludes inc incNative = do exe :: FilePath -> FilePath exe = bool isWindows (<.>"exe") id -copyGhcjsIntree :: B () -copyGhcjsIntree = checkpoint' "ghcjs-intree" "ghcjs-intree" $ do - install' "ghcjs-prim package sources" <$^> beLocations . blGhcjsLibDir . to ( "ghcjs-prim") <<*^> beSources . bsrcGhcjsPrim - install' "ghcjs-prim package sources" <$^> beLocations . blGhcjsLibDir . to ( "ghcjs-th") <<*^> beSources . bsrcGhcjsTh - -copyIncludes :: B () -copyIncludes = checkpoint' "includes" "includes" $ - install' "ghcjs rts include files" <$^> beLocations . blGhcjsLibDir . to ( "include") <<*^> beSources . bsrcInclude - -installEtc :: B () -installEtc = checkpoint' "additional configuration files" "etc" $ do - install' "additional configuration files" <$^> beLocations . blGhcjsLibDir <<*^> beSources . bsrcEtc +-- fixme this part will fail to compile #ifdef WINDOWS - -- compile the resources we need for the runner to prevent Windows from trying to detect - -- programs that require elevated privileges + -- compile the resources we need for the runner to prevent Windows from + -- trying to detect programs that require elevated privileges ghcjsTop <- view (beLocations . blGhcjsTopDir) - let windres = Program "windres" "windres" Nothing - (Just $ ghcjsTop ".." "mingw" "bin" "windres.exe") [] + let windres = Program "windres" + "windres" + Nothing + (Just $ ghcjsTop + ".." + "mingw" + "bin" + "windres.exe") + [] subTop $ run_ windres ["runner.rc", "-o", "runner-resources.o"] #endif -installDocs :: B () -installDocs = checkpoint' "documentation" "doc" $ - install' "documentation" <$^> beLocations . blGhcjsLibDir . to ("doc") <<*^> beSources . bsrcDoc - -installTests :: B () -installTests = unlessM (hasCheckpoint "tests") $ do - msg info "installing test suite" - (install False "test suite" <$^> beLocations . blGhcjsLibDir . to ("test") <<*^> beSources . bsrcTest) >>= - cond (addCheckpoint "tests") (msg warn "test suite could not be installed, continuing without") - buildDocIndex :: B () buildDocIndex = subTop' "doc" $ do haddockFiles <- findWhen (return . flip hasExtension "haddock") "." - haddock_ $ ["--gen-contents", "--gen-index", "-o", "html", "--title=GHCJS Libraries"] ++ - map (\p -> "--read-interface=../" <> toTextI (directory p) <> "," <> toTextI p) haddockFiles - -installStage2 :: B () -installStage2 = subTop' "ghcjs-boot" $ do + haddock_ $ ["--gen-contents" + ,"--gen-index" + , "-o" + , "html" + , "--title=GHCJS Libraries" + ] ++ + map (\p -> "--read-interface=../" <> + toTextI (directory p) <> + "," <> + toTextI p) + haddockFiles + +installCabal :: B () +installCabal = subBuild $ do msg info "installing Cabal library" removeFakes cabalPkg <- view (beStages . bstCabal) preparePackage cabalPkg cabalInstall [cabalPkg] - msg info "installing stage 2 packages" - stage2 <- stagePackages bstStage2 - forM_ stage2 preparePackage - cabalInstall stage2 installGhcjsPrim :: B () installGhcjsPrim = do @@ -879,25 +575,27 @@ installGhcjsPrim = do installGhcjsTh :: B () installGhcjsTh = do msg info "installing ghcjs-th" - prim <- view (beStages . bstGhcjsTh) - preparePackage prim - cabalStage1 [prim] + ghcjsTh <- view (beStages . bstGhcjsTh) + preparePackage ghcjsTh + cabalStage1 [ghcjsTh] installStage1 :: B () -installStage1 = subTop' "ghcjs-boot" $ do +installStage1 = subBuild $ do prim <- view (beStages . bstGhcPrim) installStage "0" [prim] fixGhcPrim installStage "1a" =<< stagePackages bstStage1a s <- ask - when (s ^. beSettings . bsGmpInTree && s ^. beLocations . blNativeToo) installInTreeGmp installGhcjsPrim installStage "1b" =<< stagePackages bstStage1b installGhcjsTh resolveWiredInPackages where fixGhcPrim = do - descr <- T.lines <$> ghcjs_pkg ["describe", "ghc-prim", "--no-user-package-db"] + descr <- T.lines <$> ghcjs_pkg [ "describe" + , "ghc-prim" + , "--no-user-package-db" + ] setStdin (T.unlines $ map fixGhcPrimDescr descr) ghcjs_pkg_ ["update", "-", "--global", "--no-user-package-db"] -- add GHC.Prim to exposed-modules @@ -912,47 +610,28 @@ resolveWiredInPackages :: B () resolveWiredInPackages = subTop $ do wips <- readBinary ("wiredinpkgs" <.> "yaml") case Yaml.decodeEither wips of - Left err -> failWith ("error parsing wired-in packages file wiredinpkgs.yaml\n" <> T.pack err) + Left err -> failWith $ + "error parsing wired-in packages file wiredinpkgs.yaml\n" <> T.pack err Right pkgs -> do pkgs' <- forM pkgs $ \p -> (p,) . T.strip <$> ghcjs_pkg [ "--simple-output" , "field" , p -#if __GLASGOW_HASKELL__ >= 709 , "key" -#else - , "id" -#endif ] writefile ("wiredinkeys" <.> "yaml") $ T.unlines ("# resolved wired-in packages" : map (\(p,k) -> p <> ": " <> k) pkgs') --- fixme: urk, this is probably not how it's supposed to be done -installInTreeGmp :: B () -installInTreeGmp = subTop' integerGmp $ do - p <- absPath =<< pwd - let gmpLib = p "gmp" "intree" "lib" "libgmp.a" - libPath <- ghcjs_pkg ["field", "integer-gmp", "library-dirs", "--simple-output", "--no-user-package-db"] - libPath' <- canonic (fromText $ T.strip libPath) - msg info $ "installing in-tree gmp: " <> toTextI gmpLib <> " -> " <> toTextI libPath' - cp gmpLib libPath' - descr <- T.lines <$> ghcjs_pkg ["describe", "integer-gmp", "--no-user-package-db"] - let updateLine line | "extra-libraries:" `T.isPrefixOf` line = line <> " gmp" - | otherwise = line - setStdin (T.unlines $ map updateLine descr) - ghcjs_pkg_ ["update", "-", "--global", "--no-user-package-db"] - preparePackage :: Package -> B () preparePackage pkg | "./" `T.isPrefixOf` pkg || "../" `T.isPrefixOf` pkg = sub $ do msg trace ("preparing package " <> pkg) cd (fromText pkg) e <- ask - when (e ^. beSettings . bsDev) $ - whenM (test_f "configure.ac") $ - make "configure" ["configure.ac"] - (msg info ("generating configure script for " <> pkg) >> autoreconf_) + whenM (test_f "configure.ac") $ + make "configure" ["configure.ac"] + (msg info ("generating configure script for " <> pkg) >> autoreconf_) rm_rf "dist" | otherwise = return () @@ -960,9 +639,9 @@ fixRtsConf :: Text -> Text -> Text -> Text fixRtsConf incl lib conf = T.unlines . map fixLine . T.lines $ conf where fixLine l - | "library-dirs:" `T.isPrefixOf` l = "library-dirs: " <> lib - | "include-dirs:" `T.isPrefixOf` l = "include-dirs: " <> incl - | otherwise = l + | "library-dirs:" `T.isPrefixOf` l = "library-dirs: " <> lib + | "include-dirs:" `T.isPrefixOf` l = "include-dirs: " <> incl + | otherwise = l -- | register fake, empty packages to be able to build packages -- that depend on Cabal @@ -977,16 +656,13 @@ installFakes = silently $ do (x:_) -> do let version = T.drop 1 (T.dropWhile (/='-') x) case findPkgId dumped pkg version of - Nothing -> failWith ("cannot find package id of " <> pkg <> "-" <> version) + Nothing -> failWith $ + "cannot find package id of " <> pkg <> "-" <> version Just pkgId -> do globalDB <- view (beLocations . blGlobalDB) libDir <- view (beLocations . blGhcjsLibDir) -#if __GLASGOW_HASKELL__ >= 711 pkgAbi <- findPkgAbi pkgId let conf = fakeConf libDir libDir pkg version pkgId pkgAbi -#else - let conf = fakeConf libDir libDir pkg version pkgId -#endif writefile (globalDB fromText pkgId <.> "conf") conf ghcjs_pkg_ ["recache", "--global", "--no-user-package-db"] @@ -996,31 +672,23 @@ findPkgId dump pkg version = where pkgVer = pkg <> "-" <> version pkgVer' = pkgVer <> "-" - ids = map (T.dropWhile isSpace . T.drop 3) $ filter ("id:" `T.isPrefixOf`) dump + ids = map (T.dropWhile isSpace . T.drop 3) + (filter ("id:" `T.isPrefixOf`) dump) -#if __GLASGOW_HASKELL__ >= 711 findPkgAbi :: Text -> B Text findPkgAbi pkgId = do dumped <- T.lines <$> ghc_pkg ["field", pkgId, "abi"] case catMaybes (map (T.stripPrefix "abi:") dumped) of (x:_) -> return (T.strip x) _ -> failWith ("cannot find abi hash of package " <> pkgId) -#endif -#if __GLASGOW_HASKELL__ >= 711 fakeConf :: FilePath -> FilePath -> Text -> Text -> Text -> Text -> Text fakeConf incl lib name version pkgId pkgAbi = T.unlines -#else -fakeConf :: FilePath -> FilePath -> Text -> Text -> Text -> Text -fakeConf incl lib name version pkgId = T.unlines -#endif [ "name: " <> name , "version: " <> version , "id: " <> pkgId -#if __GLASGOW_HASKELL__ >= 711 , "key: " <> pkgId , "abi: " <> pkgAbi -#endif , "license: BSD3" , "maintainer: stegeman@gmail.com" , "import-dirs: " <> toTextI incl @@ -1033,9 +701,21 @@ fakeConf incl lib name version pkgId = T.unlines removeFakes :: B () removeFakes = do fakes <- map (<>"-") <$> view (beStages . bstPretend) - pkgs <- T.words <$> ghcjs_pkg ["list", "--simple-output", "--no-user-package-db"] - forM_ pkgs $ \p -> when (any (`T.isPrefixOf` p) fakes) - (msg info ("unregistering " <> p) >> ghcjs_pkg_ ["unregister", p, "--no-user-package-db"]) + pkgs <- T.words <$> ghcjs_pkg [ "list" + , "--simple-output" + , "--no-user-package-db" + ] + forM_ pkgs $ \p -> + when (any (`T.isPrefixOf` p) fakes) + (msg info ("unregistering " <> p) >> + ghcjs_pkg_ ["unregister", p, "--no-user-package-db"]) + +-- | subshell in path relative to build dir +subBuild' :: FilePath -> B a -> B a +subBuild' p a = subBuild (cd p >> a) + +subBuild :: B a -> B a +subBuild a = sub (view (beLocations . blBuildDir) >>= cd >> a) -- | subshell in path relative to top installation dir subTop' :: FilePath -> B a -> B a @@ -1050,55 +730,79 @@ writeBinary file bs = do file' <- absPath file liftIO $ BL.writeFile (toStringI file') bs --- | unpack a tar file (does not support compression) --- only supports files, does not try to emulate symlinks -unpackTar :: Bool -- ^ strip the first directory component? - -> FilePath -- ^ destination to unpack to - -> FilePath -- ^ the tar file - -> B () +{- |unpack a tar file (does not support compression) + only supports files, does not try to emulate symlinks -} +unpackTar :: Bool -- ^strip the first directory component? + -> Prelude.FilePath -- ^destination to unpack to + -> Prelude.FilePath -- ^the tar file + -> IO () unpackTar stripFirst dest tarFile = do - mkdir_p dest - entries <- Tar.read . BL.fromStrict <$> readBinary tarFile - void $ Tar.foldEntries (\e -> (>>=checkExtract e)) (return Nothing) (\e -> failWith $ "error unpacking tar: " <> showT e) entries + createDirectoryIfMissing True dest + entries <- Tar.read . BL.fromStrict <$> B.readFile tarFile + void $ Tar.foldEntries (\e -> (>>=checkExtract e)) + (return Nothing) + (\e -> failWith $ "error unpacking tar: " <> showT e) + entries where dropComps = if stripFirst then 1 else 0 - failSec e msg = failWith $ "tar security check, " <> msg <> ": " <> T.pack (Tar.entryPath e) + failSec e msg = failWith $ "tar security check, " <> + msg <> + ": " <> + T.pack (Tar.entryPath e) checkExtract e Nothing - | (p:_) <- System.FilePath.splitDirectories (Tar.entryPath e) - = checkExtract e (Just p) - | otherwise = failSec e "no path" + | (p:_) <- FP.splitDirectories (Tar.entryPath e) + = checkExtract e (Just p) + | otherwise = failSec e $ + "no path" checkExtract e je@(Just expected) - | System.FilePath.isAbsolute ep = failSec e "absolute path" - | any (=="..") epd = failSec e "'..' in path" - | listToMaybe epd /= je && isSupportedEntry (Tar.entryContent e) - = failSec e ("tar bomb, expected path component: " <> T.pack expected) + | FP.isAbsolute ep = failSec e $ + "absolute path" + | any (=="..") epd = failSec e $ + "'..' in path" + | listToMaybe epd /= je && + isSupportedEntry (Tar.entryContent e) = failSec e $ + "tar bomb, expected path component: " <> T.pack expected | otherwise = do - view (beSettings . bsVerbosity) >>= \v -> - -- this gets chatty, reduce verbosity for file writes / directory creates here unless we're at trace level - (if v < trace then quieter warn else id) - (extractEntry e $ dest fromString (System.FilePath.joinPath (drop (if stripFirst then 1 else 0) epd))) + --view (beSettings . bsVerbosity) >>= \v -> + -- this gets chatty, reduce verbosity for + -- file writes / directory creates here + -- unless we're at trace level + -- (if v < trace then quieter warn else id) + (extractEntry e $ dest FP. + (FP.joinPath + (drop (if stripFirst then 1 else 0) epd))) return je where ep = Tar.entryPath e - epd = System.FilePath.splitDirectories ep + epd = FP.splitDirectories ep isSupportedEntry (Tar.NormalFile{}) = True isSupportedEntry (Tar.Directory{}) = True isSupportedEntry _ = False + extractEntry :: Tar.Entry -> Prelude.FilePath -> IO () extractEntry e tgt | Tar.NormalFile bs size <- Tar.entryContent e = do - mkdir_p (directory tgt) - writeBinary tgt bs + createDirectoryIfMissing True (FP.dropFileName tgt) + BL.writeFile tgt bs setPermissions (Tar.entryPermissions e) tgt | Tar.Directory <- Tar.entryContent e = do - mkdir_p tgt + createDirectoryIfMissing True tgt setPermissions (Tar.entryPermissions e) tgt - | otherwise = - msg warn ("ignoring unexpected entry type in tar. only normal files and directories (no links) are supported:\n " <> toTextI tgt) + | otherwise = hPutStrLn stderr $ + "ignoring unexpected entry type in tar. " <> + "only normal files and directories (no links) " <> + "are supported:\n " <> tgt + -- setPermissions :: FileMode -> Prelude.FilePath -> IO () setPermissions mode tgt = do - absTgt <- absPath tgt - msgD trace ("setting permissions of " <> toTextI tgt <> " to " <> showT mode) + absTgt <- makeAbsolute tgt + setFileMode tgt mode + -- absTgt <- absPath tgt + {- msgD trace $ "setting permissions of " <> + toTextI tgt <> + " to " <> + showT mode -} + {- let tgt = toStringI absTgt tgt' = bool (last tgt `elem` ['/','\\']) (init tgt) tgt - liftIO (setFileMode tgt' mode) + liftIO (setFileMode tgt' mode) -} ghc_ = runE_ bpGhc @@ -1108,18 +812,18 @@ ghcjs_pkg_ = runE_ bpGhcjsPkg alex_ = runE_ bpAlex happy_ = runE_ bpHappy haddock_ = runE_ bpHaddock -tar_ = runE_ bpTar +-- tar_ = runE_ bpTar git_ = runE_ bpGit cpp = runE bpCpp cabal = runE bpCabal cabal_ = runE_ bpCabal -npm_ = runE_ bpNpm runE g a = view (bePrograms . g) >>= flip run a runE_ g a = view (bePrograms . g) >>= flip run_ a +{- | stage 1 cabal install: boot mode, hand off to GHC if GHCJS + cannot yet compile it -} cabalStage1 :: [Text] -> B () --- | stage 1 cabal install: boot mode, hand off to GHC if GHCJS cannot yet compile it cabalStage1 pkgs = sub $ do ghc <- requirePgmLoc =<< view (bePrograms . bpGhc) s <- view beSettings @@ -1127,17 +831,7 @@ cabalStage1 pkgs = sub $ do setenv "GHCJS_BOOTING" "1" setenv "GHCJS_BOOTING_STAGE1" "1" setenv "GHCJS_WITH_GHC" (toTextI ghc) - let configureOpts = catMaybes $ [("--with-iconv-includes=" <>)<$>s^.bsIconvInclude - ,("--with-iconv-libraries=" <>)<$>s^.bsIconvLib - ,("--with-gmp-includes=" <>)<$>(s^.bsGmpInclude<>inTreePath p "include") - ,("--with-gmp-libraries= " <>)<$>s^.bsGmpLib - ] ++ gmpOpts - -- fixme this hardcodes the location of integer-gmp - inTreePath p sub = - bj (s^.bsGmpInTree) (toTextI (p "boot" "integer-gmp" "gmp" "intree" sub)) - gmpOpts = [bj (s^.bsGmpFramework) "--with-gmp-framework-preferred" - ,bj (s^.bsGmpInTree) "--with-intree-gmp" - ] + let configureOpts = [] globalFlags <- cabalGlobalFlags flags <- cabalInstallFlags (length pkgs == 1) let args = globalFlags ++ ("install" : pkgs) ++ @@ -1162,27 +856,40 @@ cabalInstall pkgs = do -- uses somewhat fragile parsing of --dry-run output, find a better way checkInstallPlan :: [Package] -> [Text] -> B () checkInstallPlan pkgs opts = do - plan <- cabal (opts ++ ["-vverbose+nowrap", "--dry-run"]) - when (hasReinstalls plan || hasUnexpectedInstalls plan || hasNewVersion plan) (err plan) + plan <- cabal (opts ++ ["-v2", "--dry-run"]) + when (any ($ plan) [hasReinstalls, {- hasUnexpectedInstalls, -} hasNewVersion]) + (err plan) where - hasReinstalls = T.isInfixOf "(reinstall)" -- reject reinstalls - hasNewVersion = T.isInfixOf "(new version)" -- only allow one version of each package during boot + -- reject reinstalls + hasReinstalls = T.isInfixOf "(reinstall)" + + -- only allow one version of each package during boot + hasNewVersion = T.isInfixOf "(new version)" + hasUnexpectedInstalls plan = let ls = filter ("(new package)" `T.isInfixOf`) (T.lines plan) in length ls /= length pkgs || not (all isExpected ls) + isExpected l | (w:_) <- T.words l, ps@(_:_) <- T.splitOn "-" w = any (T.intercalate "-" (init ps) `T.isInfixOf`) pkgs | otherwise = False - err plan = failWith $ "unacceptable install plan, expecting exactly the following list of packages to be installed,\n" <> - "without reinstalls and only one version of each package in the database:\n\n" <> - T.unlines (map (" - " <>) pkgs) <> "\nbut got:\n\n" <> plan + + err plan = failWith $ + "unacceptable install plan, expecting exactly the following " <> + "list of packages to be installed,\n" <> + "without reinstalls and only one version " <> + "of each package in the database:\n\n" <> + T.unlines (map (" - " <>) pkgs) <> + "\nbut got:\n\n" <> + plan cabalGlobalFlags :: B [Text] cabalGlobalFlags = do instDir <- view (beLocations . blGhcjsTopDir) - return [ "--config-file", toTextI (instDir "cabalBootConfig") - , "--ignore-sandbox" + return ["--config-file" + ,toTextI (instDir "cabalBootConfig") + ,"--ignore-sandbox" ] cabalInstallFlags :: Bool -> B [Text] @@ -1205,26 +912,34 @@ cabalInstallFlags parmakeGhcjs = do , "--prefix", toTextI instDir , bool haddock "--enable-documentation" "--disable-documentation" , "--haddock-html" +-- fixme comment is outdated? -- workaround for hoogle support being broken in haddock for GHC 7.10RC1 -#if !(__GLASGOW_HASKELL__ >= 709) , "--haddock-hoogle" -#endif , "--haddock-hyperlink-source" --- don't slow down Windows builds too much, on other platforms we get this more --- or less for free, thanks to dynamic-too -#ifndef WINDOWS - , "--enable-shared" -#endif - , bool prof "--enable-library-profiling" "--disable-library-profiling" + , bool prof + "--enable-library-profiling" + "--disable-library-profiling" ] ++ + -- don't slow down Windows builds too much, + -- on other platforms we get this more + -- or less for free, thanks to dynamic-too + bool isWindows [ "--enable-shared"] [] ++ -- workaround for Cabal bug? - bool isWindows ["--disable-executable-stripping", "--disable-library-stripping"] [] ++ - catMaybes [ (((bool parmakeGhcjs "--ghcjs-options=-j" "-j")<>) . showT) <$> j + bool isWindows [ "--disable-executable-stripping" + , "--disable-library-stripping"] [] ++ + catMaybes [ (((bool parmakeGhcjs + "--ghcjs-options=-j" + "-j")<>) . showT) <$> j , bj debug "--ghcjs-options=-debug" , bj (v > info) "-v2" ] -configure_ = run_ (Program "configure" "./configure" Nothing (Just "./configure") []) +configure_ = run_ (Program "configure" + "./configure" + Nothing + (Just "./configure") + []) + #ifdef WINDOWS autoreconf_ = runE_ bpBash ["autoreconf"] #else @@ -1232,13 +947,13 @@ autoreconf_ = runE_ bpAutoreconf [] #endif runMake_ = runE_ bpMake -ignoreExcep a = a `catchAny` (\e -> msg info $ "ignored exception: " <> showT e) +ignoreExcep a = a `catchAny` + (\e -> msg info $ "ignored exception: " <> showT e) stagePackages :: Getter BootStages Stage -> B [Package] stagePackages l = do - quick <- view (beSettings . bsQuick) condPkgs <- view (beStages . l) - return (resolveConds quick condPkgs) + return (resolveConds condPkgs) whenM :: Monad m => m Bool -> m () -> m () whenM c m = c >>= flip when m @@ -1246,9 +961,10 @@ whenM c m = c >>= flip when m unlessM :: Monad m => m Bool -> m () -> m () unlessM c m = c >>= flip unless m -make :: FilePath -- ^ target, build this file if not exists - -> [FilePath] -- ^ also build if any of these is newer than the target (ignored if they don't exist) - -> B () -- ^ action to run for building +make :: FilePath -- ^target, build this file if not exists + -> [FilePath] {- ^also build if any of these is newer than the + target (ignored if they don't exist) -} + -> B () -- ^action to run for building -> B () make tgt deps m = mtime tgt >>= \case Nothing -> m @@ -1267,149 +983,69 @@ filesize file = do absFile <- absPath file liftIO (getSize absFile) -install' :: Text -> FilePath -> [Text] -> B () -install' descr dest srcs = void (install True descr dest srcs) - --- | install some files, from multiple sources with fallback -install :: Bool -- ^ install is required, exit with a panic if it didn't succeed - -> Text -- ^ description, for progress output - -> FilePath -- ^ destination - -> [Text] -- ^ sources, can be tar files, directories, tar.gz / tar.xz works with external tools - -> B Bool -- ^ whether installation was succesful -install req descr dest [] - | req = failWith ("cannot install " <> descr <> " to " <> toTextI dest <> " , no more sources") - | otherwise = return False -install req descr dest (s:ss) - | "http://" `T.isPrefixOf` s = withTmpDir $ - \t -> let file = t fromText (last $ T.split (=='/') s) - in fetch descr file s >>= cond - (install req descr dest (toTextI file:ss)) - (msg warn ("could not fetch " <> s <> ", trying next source") >> install req descr dest ss) - | otherwise = do - let s' = fromText s - d <- test_d s' - if d then do - msg info ("installing " <> descr <> ", copying directory: " <> s <> " -> " <> toTextI dest) - mkdir_p dest >> ls s' >>= mapM_ (\file -> cp_r (s' filename file) (dest filename file)) - return True - else do - f <- test_f s' - if f then do - size <- filesize s' - if size == 0 - then do - isDev <- view (beSettings . bsDev) - if isDev - then msg info ("source " <> s <> " for " <> descr <> " is empty, trying next") - else msg warn $ T.unlines - [ "Archive file " <> s <> " for " <> descr <> " is empty." - , "You might be missing the required cache archives for doing a release build." - , "Use `ghcjs-boot --dev' if you installed GHCJS from a Git repository." - ] - install req descr dest ss - else installArchive True descr dest s' >> return True - else do - msg trace ("source " <> s <> " for " <> descr <> " does not exist, trying next") - install req descr dest ss - --- | install files from an archive -installArchive :: Bool - -> Text - -> FilePath - -> FilePath - -> B () -installArchive stripFirst descr dest src - | suff ".tar" = do - msg info ("installing " <> descr <> " unpacking tar (internal) " <> s <> " -> " <> d) - unpackTar stripFirst dest src - | suff ".tar.gz" = m "tar.gz" >> untar "-xzf" - | suff ".tar.bz2" = m "tar.bz2" >> untar "-xjf" - | suff ".tar.xz" = m "tar.xz" >> untar "-xJf" - | otherwise = failWith ("unknown archive type installing " <> descr <> ": " <> s) - where - m e = msg info ("installing " <> descr <> " unpacking " <> e <> " " <> s <> " -> " <> d) - suff e = e `T.isSuffixOf` s - d = toTextI dest - s = toTextI src - str = bool stripFirst ["--strip-components=1"] [] - untar o = sub (absPath src >>= \as -> mkdir_p dest >> cd dest >> tar_ ([o, msysPath as] ++ str)) - --- | download a file over HTTP -fetch :: Text -- ^ description - -> FilePath -- ^ target - -> Text -- ^ url to download - -> B Bool -- ^ True if the file was downloaded succesfully -fetch descr dest url - | Just u <- parseURI (T.unpack url) = do - msg info ("installing " <> descr <> ", downloading " <> url <> " -> " <> toTextI dest) - liftIO (download u) >>= \case - Nothing -> return False - Just r | (2,_,_) <- rspCode r -> do - msg info ("finished downloading, status " <> (T.pack . show . rspCode $ r) <> " writing file") - writeBinary dest (BL.fromStrict $ rspBody r) - return True - | otherwise -> do - msg info ("file not downloaded, status " <> (T.pack . show . rspCode $ r)) - return False - | otherwise = return False - where - download :: URI -> IO (Maybe (Response B.ByteString)) - download u = - (Just . snd <$> (Br.browse $ Br.setAllowRedirects True >> Br.request (mkRequest GET u))) - `Ex.catch` \(Ex.SomeException _) -> return Nothing - --- | initialize our boot environment by reading the configuration files, finding all programs +{- |initialize our boot environment by reading the configuration files, + finding all programs -} initBootEnv :: BootSettings -> IO BootEnv initBootEnv bs = do - dataDir <- bootDataDir bs - env <- (traverse . both %~ T.pack) <$> getEnvironment - -- substitute some values in our config files - let subst = [ ("datadir", toTextI dataDir) - , ("version", T.pack Info.getCompilerVersion) - ] - substituteConfig c = c & template %~ substText - & template . iso toTextI fromText %~ substText - substText = Utils.substPatterns subst env - BootConfigFile stgs srcs pgms1 <- substituteConfig <$> readBootConfigFile bs - let srcs' = configureBootSources bs srcs - pgms2 <- configureBootPrograms bs srcs' pgms1 + BootConfigFile stgs pgms1 <- readBootConfigFile bs + pgms2 <- configureBootPrograms bs pgms1 locs <- configureBootLocations bs pgms2 - return (BootEnv bs srcs' locs pgms2 stgs) - --- | configure the sources -configureBootSources :: BootSettings -> BootSources -> BootSources -configureBootSources bs srcs = - srcs & bsrcShimsDev %~ override (const . (:[])) bsShimsDevRepo - & bsrcShimsDevBranch %~ override const bsShimsDevBranch - & bsrcBootDev %~ override (const . (:[])) bsBootDevRepo - & bsrcBootDevBranch %~ override const bsBootDevBranch - where override f l = maybe id f (bs^.l) + return (BootEnv bs locs pgms2 stgs) -- | configure the locations configureBootLocations :: BootSettings -> BootPrograms -> IO BootLocations configureBootLocations bs pgms = do - ghcLibDir <- fromText . T.strip <$> run' bs (pgms ^. bpGhc) ["--print-libdir"] - ghcjsLibDir <- fromText . T.strip <$> run' bs (pgms ^. bpGhcjs) ["--ghcjs-booting-print", "--print-libdir"] - ghcjsTopDir <- fromText . T.strip <$> run' bs (pgms ^. bpGhcjs) ["--ghcjs-booting-print", "--print-topdir"] - globalDB <- fromText . T.strip <$> run' bs (pgms ^. bpGhcjs) ["--ghcjs-booting-print", "--print-global-db"] - userDBT <- T.strip <$> run' bs (pgms ^. bpGhcjs) ["--ghcjs-booting-print", "--print-user-db-dir"] - nativeToo <- (=="True") . T.strip <$> run' bs (pgms ^. bpGhcjs) ["--ghcjs-booting-print", "--print-native-too"] + ghcLibDir <- fromText . T.strip <$> run' bs (pgms ^. bpGhc) + ["--print-libdir"] + ghcjsLibDir <- fromText . T.strip <$> run' bs (pgms ^. bpGhcjs) + ["--ghcjs-booting-print", "--print-libdir"] + ghcjsTopDir <- fromText . T.strip <$> run' bs (pgms ^. bpGhcjs) + ["--ghcjs-booting-print", "--print-topdir"] + globalDB <- fromText . T.strip <$> run' bs (pgms ^. bpGhcjs) + ["--ghcjs-booting-print", "--print-global-db"] + userDBT <- T.strip <$> run' bs (pgms ^. bpGhcjs) + ["--ghcjs-booting-print", "--print-user-db-dir"] when (T.null (toTextI ghcjsLibDir)) $ failWith ("Could not determine GHCJS library installation path.\n" <> - "Make sure that the ghcjs wrapper script (or options file on Windows) " <> + "Make sure that the ghcjs wrapper script " <> + "(or options file on Windows) " <> "has been set up correctly.") - return $ BootLocations ghcjsTopDir ghcjsLibDir ghcLibDir globalDB - (bool (userDBT == "") Nothing (Just $ fromText userDBT)) - nativeToo - --- | build the program configuration and do some sanity checks -configureBootPrograms :: BootSettings -- ^ command line settings - -> BootSources - -> BootPrograms -- ^ default programs from config file - -> IO BootPrograms -- ^ configured programs -configureBootPrograms bs srcs pgms0 = do + sourceDir <- bootSourceDir bs + buildDir <- fromString <$> prepareBuildDir (toStringI sourceDir) + (toStringI ghcjsLibDir) + pure $ BootLocations sourceDir + buildDir + ghcjsTopDir + ghcjsLibDir + ghcLibDir + globalDB + (bool (userDBT == "") + Nothing + (Just $ fromText userDBT)) + +prepareBuildDir :: Prelude.FilePath + -> Prelude.FilePath + -> IO Prelude.FilePath +prepareBuildDir srcDir ghcjsLibDir = do + e <- doesFileExist srcDir + if e then do unpackTar False ghcjsLibDir srcDir + pure (ghcjsLibDir FP. "boot") + else do + d <- doesDirectoryExist srcDir + if d then do + e <- doesFileExist (srcDir FP. "boot" FP.<.> "yaml") + if e then pure srcDir else err + else err + where + err = failWith "source location must contain boot.yaml or be a tar file" + +-- |build the program configuration and do some sanity checks +configureBootPrograms :: BootSettings -- ^command line settings + -> BootPrograms -- ^default programs from config file + -> IO BootPrograms -- ^configured programs +configureBootPrograms bs pgms0 = do -- first replace all defaults with the overrides from the command line let r l = maybe id (pgmSearch .~) (bs ^. l) tpo = template :: Traversal' BootPrograms (Program Optional) @@ -1428,44 +1064,81 @@ configureBootPrograms bs srcs pgms0 = do & bpCabal %~ r bsWithCabal & bpNode %~ r bsWithNode -- resolve all programs - pgms3 <- mapMOf tpo (resolveProgram bs) =<< mapMOf tpr (resolveProgram bs) pgms2 + pgms3 <- mapMOf tpo (resolveProgram bs) + =<< mapMOf tpr (resolveProgram bs) pgms2 traverseOf_ tpr (reportProgramLocation bs) pgms3 traverseOf_ tpo (reportProgramLocation bs) pgms3 pgms4 <- checkProgramVersions bs pgms3 - checkCabalSupport bs pgms4 + -- checkCabalSupport bs pgms4 return pgms4 --- | resolves program -resolveProgram :: MaybeRequired (Program a) => BootSettings -> Program a -> IO (Program a) +resolveProgram :: MaybeRequired (Program a) + => BootSettings + -> Program a + -> IO (Program a) resolveProgram bs pgm = do let search' = pgm ^. pgmSearch . to fromText absSearch <- ( search') <$> getWorkingDirectory let searchPaths = catMaybes [ Just search' - , bj (relative search' && length (splitDirectories search') > 1) absSearch + , bj (relative search' && + length (splitDirectories search') > 1) + absSearch ] fmap catMaybes (mapM (findExecutable . encodeString) searchPaths) >>= \case - (p':_) -> (\cp -> pgm & pgmLoc .~ Just cp) <$> {- canonicalizePath -} return (fromString p') - _ | isRequired pgm -> failWith ("program " <> pgm ^. pgmName <> - " is required but could not be found at " <> pgm ^. pgmSearch) + (p':_) -> (\cp -> pgm & pgmLoc .~ Just cp) <$> return (fromString p') + _ | isRequired pgm -> failWith $ + "program " <> + pgm ^. pgmName <> + " is required but could not be found at " <> + pgm ^. pgmSearch | otherwise -> return (pgm & pgmLoc .~ Nothing) -- | report location of a configured program reportProgramLocation :: BootSettings -> Program a -> IO () reportProgramLocation bs p - | Just l <- p ^. pgmLoc = msg' bs info ("program " <> p ^. pgmName <> " found at " <> toTextI l) - | otherwise = msg' bs info ("program " <> p ^. pgmName <> " NOT found, searched for " <> p ^. pgmSearch) + | Just l <- p ^. pgmLoc = msg' bs info $ "program " <> + p ^. pgmName <> + " found at " <> + toTextI l + | otherwise = msg' bs info $ "program " <> + p ^. pgmName <> + " NOT found, searched for " <> + p ^. pgmSearch -- | check that the GHC, ghcjs and ghcjs-pkg we're using are the correct version checkProgramVersions :: BootSettings -> BootPrograms -> IO BootPrograms checkProgramVersions bs pgms = do pgms' <- foldrM verifyVersion pgms - [ (view bpGhcjs, set bpGhcjs, "--numeric-version", Just Info.getCompilerVersion, True) - , (view bpGhcjs, set bpGhcjs, "--numeric-ghc-version", Just Info.getGhcCompilerVersion, False) - , (view bpGhc, set bpGhc, "--numeric-version", Just Info.getGhcCompilerVersion, True) - , (view bpGhcjsPkg, set bpGhcjsPkg, "--numeric-ghcjs-version", Nothing, True) - , (view bpGhcjsPkg, set bpGhcjsPkg, "--numeric-ghc-version", Just Info.getGhcCompilerVersion, False) - , (view bpCabal, set bpCabal, "--numeric-version", Nothing, True) - , (view bpNode, set bpNode, "--version", Nothing, True) + [ ( view bpGhcjs, set bpGhcjs + , "--numeric-version" + , Just Info.getCompilerVersion + , True + ) + , ( view bpGhcjs + , set bpGhcjs + , "--numeric-ghc-version" + , Just Info.getGhcCompilerVersion + , False + ) +-- fixme check ghc version again, but only major version? + -- , (view bpGhc, set bpGhc, "--numeric-version", Just Info.getGhcCompilerVersion, True) + , ( view bpGhcjsPkg + , set bpGhcjsPkg + , "--numeric-ghcjs-version" + , Nothing + , True + ) + -- , (view bpGhcjsPkg, set bpGhcjsPkg, "--numeric-ghc-version", Just Info.getGhcCompilerVersion, False) + , ( view bpCabal, set bpCabal + , "--numeric-version" + , Nothing + , True + ) + , ( view bpNode, set bpNode + , "--version" + , Nothing + , True + ) ] verifyNotProfiled verifyNodeVersion pgms' @@ -1475,9 +1148,13 @@ checkProgramVersions bs pgms = do -- res <- T.strip <$> run' bs (pgms ^. bpGhcjs) ["--ghcjs-booting-print", "--print-rts-profiled"] -- when (res /= "False") $ failWith ("GHCJS program " <> pgms ^. bpGhcjs . pgmLocText <> -- " has been installed with executable profiling.\n" <> - -- "u need a non-profiled executable to boot") + -- "you need a non-profiled executable to boot") -- verifyVersion :: (Lens' BootPrograms (Program Required), Text, Maybe String, Bool) -> BootPrograms -> IO BootPrograms - verifyVersion :: forall a. (BootPrograms -> Program a, Program a -> BootPrograms -> BootPrograms, Text, Maybe String, Bool) -> BootPrograms -> IO BootPrograms + verifyVersion :: forall a. ( BootPrograms -> Program a + , Program a -> BootPrograms -> BootPrograms + , Text, Maybe String + , Bool + ) -> BootPrograms -> IO BootPrograms verifyVersion (g, s, arg :: Text, expected :: Maybe String, update :: Bool) ps = do res <- T.strip <$> run' bs (g ps) [arg] case expected of @@ -1498,27 +1175,15 @@ checkProgramVersions bs pgms = do | otherwise -> failWith ("minimum required version for node.js is 0.10.28, found: " <> verTxt) _ -> failWith ("unrecognized version for node.js: " <> verTxt) --- | check that cabal-install supports GHCJS and that our boot-GHC has a Cabal library that supports GHCJS -checkCabalSupport :: BootSettings -> BootPrograms -> IO () -checkCabalSupport bs pgms = do - cbl <- run' bs (pgms ^. bpCabal) ["install", "--help"] - when (not $ "--ghcjs" `T.isInfixOf` cbl) $ - failWith ("cabal-install program " <> pgms ^. bpCabal . pgmLocText <> " does not support GHCJS") - when (not $ "--allow-boot-library-installs" `T.isInfixOf` cbl) $ - failWith ("cabal-install program " <> pgms ^. bpCabal . pgmLocText <> " does not support --allow-boot-library-installs (requires version 2.0.0.0 or newer)") - void (run' bs (pgms ^. bpGhc) ["-e", "either error id (Text.Read.readEither \"GHCJS\" :: Either String Distribution.Simple.CompilerFlavor)"]) `Ex.catch` - \(Ex.SomeException _) -> failWith - ("GHC program " <> pgms ^. bpGhc . pgmLocText <> " does not have a Cabal library that supports GHCJS\n" <> - "(note that the Cabal library is not the same as the cabal-install program, you need a compatible version for both)") - -- | read the boot configuration yaml file readBootConfigFile :: BootSettings -> IO BootConfigFile readBootConfigFile bs = do bf <- bootConfigFile bs - msgD' bs trace ("reading file " <> toTextI bf) - b <- B.readFile (toStringI bf) - case Yaml.decodeEither b of - Left err -> failWith ("error parsing boot configuration file " <> toTextI bf <> "\n" <> T.pack err) + -- b <- B.readFile (toStringI bf) + case Yaml.decodeEither bf of + Left err -> failWith $ + "error parsing boot.yaml configuration file\n" <> + T.pack err Right bss -> return bss printBootEnvSummary :: Bool -> BootEnv -> IO () @@ -1526,8 +1191,10 @@ printBootEnvSummary after be = do section "Boot libraries installation for GHCJS" $ do bootLoc <- getExecutablePath bootMod <- getModified (fromString bootLoc) - bootConf <- bootConfigFile (be ^. beSettings) - ghcjsMod <- maybe (return "") (fmap show . getModified) (be ^. bePrograms . bpGhcjs . pgmLoc) + bootSrc <- bootSourceDir (be ^. beSettings) + ghcjsMod <- maybe (return "") + (fmap show . getModified) + (be ^. bePrograms . bpGhcjs . pgmLoc) curDir <- getWorkingDirectory p $ bool after ["ghcjs-boot has installed the libraries and runtime system for GHCJS"] @@ -1536,13 +1203,14 @@ printBootEnvSummary after be = do t "rl" [["ghcjs-boot program version", Info.getCompilerVersion] ,["file location", bootLoc] ,["last modified", show bootMod],[] - ,["using configuration file", toStringI bootConf] + ,["boot source location", toStringI bootSrc] ,["current directory", toStringI curDir] ] h "boot configuration" t "rl" [["installation directory", path $ beLocations . blGhcjsTopDir] ,["global package DB", path $ beLocations . blGlobalDB] - ,["user package DB location", path $ beLocations . blUserDBDir . to (fromMaybe "")],[] + ,["user package DB location" + , path $ beLocations . blUserDBDir . to (fromMaybe "")],[] ,["GHCJS version", ver "" bpGhcjs] ,["program location", loc bpGhcjs] ,["library path", path $ beLocations . blGhcjsLibDir] @@ -1554,55 +1222,44 @@ printBootEnvSummary after be = do ,["location", loc bpCabal],[] ,["ghcjs-pkg version", ver "" bpGhcjsPkg] ,["location", loc bpGhcjsPkg],[] - ,["quick boot", y isQuick] - ,["clean tree first", be ^. beSettings . bsClean . to y] - ,["development boot", y isDev] - ,["native too", be ^. beLocations . blNativeToo . to y] ] h "packages" p ["stage 1a"] >> l (stg bstStage1a) p ["ghcjs-prim: " ++ be ^. beStages . bstGhcjsPrim . to str] p ["stage 1b"] >> l (stg bstStage1b) - p ["ghcjs-th: " ++ be ^. beStages . bstGhcjsTh . to str] - when (not isQuick) $ do - p ["Cabal: " ++ be ^. beStages . bstCabal . to str] - p ["stage 2"] >> l (stg bstStage2) + -- p ["ghcjs-th: " ++ be ^. beStages . bstGhcjsTh . to str] + p ["Cabal: " ++ be ^. beStages . bstCabal . to str] section "Configured programs" $ do t "hlll" $ ["program", "version", "location"] : - be ^.. bePrograms . (template :: Traversal' BootPrograms (Program Required)) . to pgm ++ - be ^.. bePrograms . (template :: Traversal' BootPrograms (Program Optional)) . to pgm - section "Installation sources" $ do - t "rl" $ concatMap (\(t,l) -> [t,""] : be ^.. beSources . l . traverse . to (\x->["",str x]) ++ [["",""]]) - [("shims (runtime system)", bsrcShims), ("boot libraries", bsrcBoot), ("test suite", bsrcTest), ("configuration files", bsrcEtc), ("documentation", bsrcDoc)] ++ - [["bootstrap GHC library path",""],["", path $ beLocations . blGhcLibDir]] - when isWindows $ do - h "Windows development tools" - t "rl" $ ["development tools",""] : be ^.. beSources . bsrcBuildtoolsWindows . traverse . to (\x->["",str x]) ++ - ["bootstrap package",""] : be ^.. beSources . bsrcBuildtoolsBootWindows . traverse . to (\x->["",str x]) - when (isDev) $ do - h "development source repositories" - p ["shims (" ++ be ^. beSources . bsrcShimsDevBranch . to str ++ ")"] - l (be ^.. beSources . bsrcShimsDev . traverse . to str) - p ["ghcjs-boot (" ++ be ^. beSources . bsrcBootDevBranch . to str ++ ")"] - l (be ^.. beSources . bsrcBootDev . traverse . to str) + be ^.. bePrograms . + (template :: Traversal' BootPrograms (Program Required)) . + to pgm ++ + be ^.. bePrograms . + (template :: Traversal' BootPrograms (Program Optional)) . + to pgm where - stg s = be ^.. beStages . s . to (resolveConds isQuick) . traverse . to str - isDev = be ^. beSettings . bsDev - isQuick = be ^. beSettings . bsQuick - h xs = b >> mapM_ (putStrLn . indent 2) [xs, replicate (length xs) '-'] >> b + stg s = be ^.. beStages . s . to resolveConds . traverse . to str + h xs = b >> + mapM_ (putStrLn . indent 2) + [xs, replicate (length xs) '-'] >> b p xs = mapM_ (putStrLn . indent 3) xs >> b l xs = mapM_ (putStrLn . indent 3 . ("- "++)) xs >> b t :: String -> [[String]] -> IO () - t aln xxs = let colWidths = map (foldl' (\m xs -> max m (length xs)) 0) (transpose xxs) + t aln xxs = let colWidths = map (foldl' (\m xs -> max m (length xs)) 0) + (transpose xxs) (colAlign,hdr) = case aln of ('h':a) -> (a, True) a -> (a, False) colSep = replicate 3 ' ' - cell w a xs = let pad = sp (w - length xs) in if a == 'r' then pad ++ xs else xs ++ pad + cell w a xs = let pad = sp (w - length xs) + in if a == 'r' then pad ++ xs + else xs ++ pad cols xs = sp 3 ++ intercalate (sp 3) xs row xs = cols (zipWith3 cell colWidths colAlign xs) in case (xxs, hdr) of - (x:ys, True) -> putStrLn (row x) >> putStrLn (cols $ map sp colWidths) >> mapM_ (putStrLn . row) ys >> b + (x:ys, True) -> putStrLn (row x) >> + putStrLn (cols $ map sp colWidths) >> + mapM_ (putStrLn . row) ys >> b _ -> mapM_ (putStrLn . row) xxs b = putStrLn "" sp n = replicate n ' ' @@ -1615,18 +1272,44 @@ printBootEnvSummary after be = do loc l = be ^. bePrograms . l . pgmLocString path l = be ^. l . to toStringI str = T.unpack - pgm x = [x ^. pgmName . to str, maybe "-" T.unpack (x ^. pgmVersion) , x ^. pgmLocString] + pgm x = [ x ^. pgmName . to str + , maybe "-" T.unpack (x ^. pgmVersion) + , x ^. pgmLocString + ] -- | boot.yaml -bootConfigFile :: BootSettings -> IO FilePath -bootConfigFile bs - | Just bsf <- bs ^. bsWithConfig = return (fromText bsf) - | otherwise = ( ("lib" "etc" "boot" <.> "yaml")) <$> bootDataDir bs - -bootDataDir :: BootSettings -> IO FilePath -bootDataDir bs - | Just dd <- bs ^. bsWithDataDir = return (fromText dd) - | otherwise = fromString <$> Info.ghcjsBootDefaultDataDir +bootConfigFile :: BootSettings -> IO B.ByteString +bootConfigFile bs = do + sourceDir <- bootSourceDir bs + let sourceDir' = toStringI sourceDir + e <- doesFileExist sourceDir' + if e then do -- it's a tar file + entries <- Tar.read . BL.fromStrict <$> + B.readFile sourceDir' + pure (BL.toStrict $ getBootYaml entries) + else B.readFile (toStringI $ sourceDir "boot" <.> "yaml") + where + getBootYaml (Tar.Next e es) + | Tar.entryPath e == "boot/boot.yaml" + , Tar.NormalFile contents _size <- Tar.entryContent e = contents + | otherwise = getBootYaml es + getBootYaml Tar.Done = error "boot/boot.yaml file not found in archive" + getBootYaml (Tar.Fail e) = error $ "error reading boot archive: " ++ show e + +bootSourceDir :: BootSettings -> IO FilePath +bootSourceDir bs + | Just dd <- bs ^. bsSourceDir = return (fromText dd) + | otherwise = do + workingDirectory <- getWorkingDirectory + let configFile = workingDirectory "boot" <.> "yaml" + configInCurrentDir <- doesFileExist (toStringI configFile) + if configInCurrentDir + then pure ( workingDirectory) + else do + dataDir <- Info.ghcjsBootDefaultDataDir + let bootArchive = fromString dataDir "boot" <.> "tar" + bootArchiveExists <- doesFileExist (toStringI bootArchive) + pure $ if bootArchiveExists then bootArchive else workingDirectory -- | our boot monad, we wrap around shelly but with a config environment -- shelly commands are wrapped with logging @@ -1662,8 +1345,10 @@ msgD' bs v t = getWorkingDirectory >>= \p -> msg' bs v (toTextI p <> "$ " <> t) ls = lift . Sh.ls mkdir p = msgD info ("mkdir " <> toTextI p) >> lift (Sh.mkdir p) mkdir_p p = msgD info ("mkdir_p " <> toTextI p) >> lift (Sh.mkdir_p p) -cp f t = msgD info ("cp " <> toTextI f <> " -> " <> toTextI t) >> lift (Sh.cp f t) -cp_r f t = msgD info ("cp_r " <> toTextI f <> " -> " <> toTextI t) >> lift (Sh.cp_r f t) +cp f t = msgD info ("cp " <> toTextI f <> " -> " <> toTextI t) >> + lift (Sh.cp f t) +cp_r f t = msgD info ("cp_r " <> toTextI f <> " -> " <> toTextI t) >> + lift (Sh.cp_r f t) rm_f p = msgD info ("rm_f " <> toTextI p) >> lift (Sh.rm_f p) rm_rf p = msgD info ("rm_rf " <> toTextI p) >> lift (Sh.rm_rf p) cd p = msgD trace ("cd " <> toTextI p) >> lift (Sh.cd p) @@ -1671,8 +1356,12 @@ sub = liftE Sh.sub test_d = lift . Sh.test_d test_f = lift . Sh.test_f test_s = lift . Sh.test_s -run p xs = msgD info (traceRun p xs) >> requirePgmLoc p >>= \loc -> lift (Sh.run loc (p ^. pgmArgs ++ xs)) -run_ p xs = msgD info (traceRun p xs) >> requirePgmLoc p >>= \loc -> lift (Sh.run_ loc (p ^. pgmArgs ++ xs)) +run p xs = msgD info (traceRun p xs) >> + requirePgmLoc p >>= + \loc -> lift (Sh.run loc (p ^. pgmArgs ++ xs)) +run_ p xs = msgD info (traceRun p xs) >> + requirePgmLoc p >>= + \loc -> lift (Sh.run_ loc (p ^. pgmArgs ++ xs)) readBinary p = msgD trace ("reading " <> toTextI p) >> lift (Sh.readBinary p) canonic = lift . Sh.canonic absPath = lift . Sh.absPath @@ -1682,11 +1371,16 @@ verbosely = liftE Sh.verbosely tracing b = liftE (Sh.tracing b) findWhen f p = ask >>= \e -> lift (Sh.findWhen (runB e . f) p) errorExit = lift . Sh.errorExit -writefile p t = msgD info ("writing " <> toTextI p) >> lift (Sh.writefile p t) -appendfile p t = msgD info ("appending " <> toTextI p) >> lift (Sh.appendfile p t) -readfile p = msgD trace ("reading " <> toTextI p) >> lift (Sh.readfile p) +writefile p t = msgD info ("writing " <> toTextI p) >> + lift (Sh.writefile p t) +appendfile p t = msgD info ("appending " <> toTextI p) >> + lift (Sh.appendfile p t) +readfile p = msgD trace ("reading " <> toTextI p) >> + lift (Sh.readfile p) withTmpDir = liftE2 Sh.withTmpDir -catchAny a h = ask >>= \e -> lift (Sh.catchany_sh (runReaderT a e) (\ex -> runReaderT (h ex) e)) +catchAny a h = ask >>= + \e -> lift (Sh.catchany_sh (runReaderT a e) + (\ex -> runReaderT (h ex) e)) catchAny_ a h = catchAny a (\_ -> h) setenv e v = lift (Sh.setenv e v) get_env = lift . Sh.get_env @@ -1701,60 +1395,52 @@ liftE2 :: ((a -> Sh.Sh b) -> Sh.Sh b) -> (a -> B b) -> B b liftE2 s f = ask >>= \e -> lift (s $ runB e . f) traceRun :: Program a -> [Text] -> Text -traceRun p xs = "[" <> p ^. pgmName <> "]: " <> p ^. pgmLocText <> " " <> T.intercalate " " (map (showT . T.unpack) xs) - --- | add a checkpoint to the file -addCheckpoint :: Text -> B () -addCheckpoint name = unlessM (hasCheckpoint name) $ do - mkdir_p =<< view (beLocations . blGhcjsTopDir) - flip appendfile (name <> "\n") =<< checkpointFile - --- | check whether we have passed a checkpoint. this reads the --- whole checkpoints file so use sparingly -hasCheckpoint :: Text -> B Bool -hasCheckpoint name = - (((name `elem`) . map T.strip . T.lines) <$> (readfile =<< checkpointFile)) `catchAny` - \e -> msg warn ("no checkpoint " <> name <> " because of " <> showT e) >> return False - --- | perform the action if the checkpoint does not exist, --- add the checkpoint when the action completes without exceptions -checkpoint :: Text -> B () -> B () -checkpoint name m = unlessM (hasCheckpoint name) (m <* addCheckpoint name) - -checkpoint' name txt m = hasCheckpoint name >>= cond (msg info txt) (m <* addCheckpoint name) - -checkpointFile :: B FilePath -checkpointFile = - absPath . ( ("ghcjs_boot" <.> "charlie")) =<< view (beLocations . blGhcjsTopDir) +traceRun p xs = "[" <> + p ^. pgmName <> + "]: " <> + p ^. pgmLocText <> + " " <> + T.intercalate " " (map (showT . T.unpack) xs) addCompleted :: B () addCompleted = do - t <- cond "quick" "full" <$^> beSettings . bsQuick f <- completedFile - writefile f t + writefile f "full" removeCompleted :: B () removeCompleted = rm_f =<< completedFile completedFile :: B FilePath completedFile = - absPath . ( ("ghcjs_boot" <.> "completed")) =<< view (beLocations . blGhcjsTopDir) + absPath . ( ("ghcjs_boot" <.> "completed")) =<< + view (beLocations . blGhcjsTopDir) requirePgmLoc :: Program a -> B FilePath requirePgmLoc p | Just loc <- p ^. pgmLoc = return loc | otherwise = do - -- search in original path, where we configured the programs. the shelly path might be local + {- search in original path, where we configured the programs. + the shelly path might be local -} path <- fromMaybe "" <$> liftIO (Utils.getEnvMay "PATH") - failWith $ "program " <> p ^. pgmName <> " is required but was not found\n" <> - " name searched for (from boot.yaml or command line): " <> p ^. pgmSearch <> "\n" <> - " searched in PATH:\n" <> T.pack path + failWith $ "program " <> + p ^. pgmName <> + " is required but was not found\n" <> + " name searched for (from boot.yaml or command line): " <> + p ^. pgmSearch <> + "\n" <> + " searched in PATH:\n" <> + T.pack path run' :: BootSettings -> Program a -> [Text] -> IO Text run' bs p xs = do msgD' bs info (traceRun p xs) - (e, out, _err) <- readProcessWithExitCode (p ^. pgmLocString) (map T.unpack xs) "" - when (e /= ExitSuccess) (failWith $ "program " <> p ^. pgmLocText <> " returned a nonzero exit code") + (e, out, _err) <- readProcessWithExitCode (p ^. pgmLocString) + (map T.unpack xs) + "" + when (e /= ExitSuccess) + (failWith $ "program " <> + p ^. pgmLocText <> + " returned a nonzero exit code") return (T.pack out) -- | reduces verbosity of the action to the specified level @@ -1789,15 +1475,23 @@ bj :: Bool -> a -> Maybe a bj b v = if b then Just v else Nothing infixl 2 <^> -(<^>) :: MonadReader s m => (a -> m b) -> Getting a s a -> m b +(<^>) :: MonadReader s m + => (a -> m b) + -> Getting a s a + -> m b (<^>) m l = m =<< view l infixl 3 <*^> -(<*^>) :: (Applicative m, MonadReader s m) => (m (a -> b)) -> Getting a s a -> m b +(<*^>) :: (Applicative m, MonadReader s m) + => (m (a -> b)) + -> Getting a s a -> m b (<*^>) f l = f <*> view l infixl 3 <<*^> -(<<*^>) :: (Applicative m, MonadReader s m) => (m (a -> m b)) -> Getting a s a -> m b +(<<*^>) :: (Applicative m, MonadReader s m) + => (m (a -> m b)) + -> Getting a s a + -> m b (<<*^>) f l = join (f <*> view l) infixl 4 <$^> diff --git a/src-bin/Haddock.hs b/src-bin/Haddock.hs index 96fcf42b..9500eb1a 100644 --- a/src-bin/Haddock.hs +++ b/src-bin/Haddock.hs @@ -13,7 +13,7 @@ import System.Exit import GHC import DynFlags -import StaticFlags +-- import StaticFlags import Documentation.Haddock import ResponseFile (expandResponse) @@ -74,10 +74,10 @@ withGhcjs' libDir flags ghcActs = runGhc (Just libDir) $ do -- -- This is a bit of a hack until we get rid of the rest of the remaining -- StaticFlags. See GHC issue #8276. - let flags' = discardStaticFlags flags - (dynflags', rest, _) <- parseDynamicFlags dynflags (map noLoc $ flags') + -- let flags' = discardStaticFlags flags + (dynflags', rest, _) <- parseDynamicFlags dynflags (map noLoc $ flags) if not (null rest) - then throw (HaddockException $ "Couldn't parse GHC options: " ++ unwords flags') + then throw (HaddockException $ "Couldn't parse GHC options: " ++ unwords flags) else return dynflags' getGhcjsDirs :: [Flag] -> IO (String, String) @@ -85,4 +85,3 @@ getGhcjsDirs flags = case [ dir | Flag_GhcLibDir dir <- flags ] of [] -> error "haddock-ghcjs: missing -B option, cannot find library dir" xs -> return ("not available", last xs) - diff --git a/src-bin/Pkg.hs b/src-bin/Pkg.hs index 97074896..2a20973b 100644 --- a/src-bin/Pkg.hs +++ b/src-bin/Pkg.hs @@ -1,15 +1,27 @@ {- Somehwat modified ghc-pkg, customizes default database locations and lib names - based on GHC repository revision d0010d749f80b405f991e88e0e953a21d54a744d + based on GHC 8.2.1 release -} + {-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ < 711 -#include "Pkg-710.hs" -#elif __GLASGOW_HASKELL__ < 709 -#include "Pkg-708.hs" -#else -{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} + +-- We never want to link against terminfo while bootstrapping. +#ifdef BOOTSTRAPPING +#ifdef WITH_TERMINFO +#undef WITH_TERMINFO +#endif +#endif + ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow 2004-2009. @@ -22,6 +34,7 @@ module Main (main) where -- import Version ( version, targetOS, targetARCH ) import qualified GHC.PackageDb as GhcPkg +import GHC.PackageDb (BinaryStringRep(..)) import qualified Distribution.Simple.PackageIndex as PackageIndex import qualified Data.Graph as Graph import qualified Distribution.ModuleName as ModuleName @@ -32,7 +45,12 @@ import Distribution.ParseUtils import Distribution.Package hiding (installedUnitId) import Distribution.Text import Distribution.Version +import Distribution.Backpack +import Distribution.Types.UnqualComponentName +import Distribution.Types.MungedPackageName +import Distribution.Types.MungedPackageId import Distribution.Simple.Utils (fromUTF8, toUTF8, writeUTF8File, readUTF8File) +import qualified Data.Version as Version import System.FilePath as FilePath import qualified System.FilePath.Posix as FilePath.Posix import System.Directory ( getAppUserDataDirectory, createDirectoryIfMissing, @@ -46,9 +64,6 @@ import qualified Control.Exception as Exception import Data.Maybe import Data.Char ( isSpace, toLower ) -#if __GLASGOW_HASKELL__ < 709 -import Control.Applicative (Applicative(..)) -#endif import Control.Monad import System.Directory ( doesDirectoryExist, getDirectoryContents, doesFileExist, removeFile, @@ -60,6 +75,10 @@ import System.IO.Error import GHC.IO.Exception (IOErrorType(InappropriateType)) import Data.List import Control.Concurrent +import qualified Data.Foldable as F +import qualified Data.Traversable as F +import qualified Data.Set as Set +import qualified Data.Map as Map import qualified Data.ByteString.Char8 as BS @@ -67,9 +86,7 @@ import qualified Data.ByteString.Char8 as BS -- mingw32 needs these for getExecDir import Foreign import Foreign.C -#endif - -#ifdef mingw32_HOST_OS +import System.Directory ( canonicalizePath ) import GHC.ConsoleHandler #else import System.Posix hiding (fdToHandle) @@ -79,7 +96,7 @@ import System.Posix hiding (fdToHandle) import qualified System.Info(os) #endif -#if !defined(mingw32_HOST_OS) && !defined(BOOTSTRAPPING) +#ifdef WITH_TERMINFO import System.Console.Terminfo as Terminfo #endif @@ -252,8 +269,8 @@ usageHeader prog = substProg prog $ " Register the package, overwriting any other package with the\n" ++ " same name. The input file should be encoded in UTF-8.\n" ++ "\n" ++ - " $p unregister {pkg-id}\n" ++ - " Unregister the specified package.\n" ++ + " $p unregister [pkg-id] \n" ++ + " Unregister the specified packages in the order given.\n" ++ "\n" ++ " $p expose {pkg-id}\n" ++ " Expose the specified package.\n" ++ @@ -350,8 +367,8 @@ data AsPackageArg -- | Represents how a package may be specified by a user on the command line. data PackageArg - -- | A package identifier foo-0.1; the version might be a glob. - = Id PackageIdentifier + -- | A package identifier foo-0.1, or a glob foo-* + = Id GlobPackageIdentifier -- | An installed package ID foo-0.1-HASH. This is guaranteed to uniquely -- match a single entry in the package database. | IUId UnitId @@ -448,9 +465,10 @@ runit verbosity cli nonopts = do registerPackage filename verbosity cli multi_instance expand_env_vars True force - ["unregister", pkgarg_str] -> do - pkgarg <- readPackageArg as_arg pkgarg_str - unregisterPackage pkgarg verbosity cli force + "unregister" : pkgarg_strs@(_:_) -> do + forM_ pkgarg_strs $ \pkgarg_str -> do + pkgarg <- readPackageArg as_arg pkgarg_str + unregisterPackage pkgarg verbosity cli force ["expose", pkgarg_str] -> do pkgarg <- readPackageArg as_arg pkgarg_str exposePackage pkgarg verbosity cli force @@ -473,8 +491,8 @@ runit verbosity cli nonopts = do (Just (Substring pkgarg_str m)) Nothing ["dot"] -> do showPackageDot verbosity cli - ["find-module", moduleName] -> do - let match = maybe (==moduleName) id (substringCheck moduleName) + ["find-module", mod_name] -> do + let match = maybe (==mod_name) id (substringCheck mod_name) listPackages verbosity cli Nothing (Just match) ["latest", pkgid_str] -> do pkgid <- readGlobPkgId pkgid_str @@ -512,26 +530,32 @@ parseCheck parser str what = [x] -> return x _ -> die ("cannot parse \'" ++ str ++ "\' as a " ++ what) -readGlobPkgId :: String -> IO PackageIdentifier +-- | Either an exact 'PackageIdentifier', or a glob for all packages +-- matching 'PackageName'. +data GlobPackageIdentifier + = ExactPackageIdentifier MungedPackageId + | GlobPackageIdentifier MungedPackageName + +displayGlobPkgId :: GlobPackageIdentifier -> String +displayGlobPkgId (ExactPackageIdentifier pid) = display pid +displayGlobPkgId (GlobPackageIdentifier pn) = display pn ++ "-*" + +readGlobPkgId :: String -> IO GlobPackageIdentifier readGlobPkgId str = parseCheck parseGlobPackageId str "package identifier" -parseGlobPackageId :: ReadP r PackageIdentifier +parseGlobPackageId :: ReadP r GlobPackageIdentifier parseGlobPackageId = - parse + fmap ExactPackageIdentifier parse +++ (do n <- parse _ <- string "-*" - return (PackageIdentifier{ pkgName = n, pkgVersion = globVersion })) + return (GlobPackageIdentifier n)) readPackageArg :: AsPackageArg -> String -> IO PackageArg readPackageArg AsUnitId str = parseCheck (IUId `fmap` parse) str "installed package id" readPackageArg AsDefault str = Id `fmap` readGlobPkgId str --- globVersion means "all versions" -globVersion :: Version -globVersion = Version [] ["*"] - -- ----------------------------------------------------------------------------- -- Package databases @@ -544,27 +568,36 @@ globVersion = Version [] ["*"] -- Some commands operate on multiple databases, with overlapping semantics: -- list, describe, field -data PackageDB +data PackageDB (mode :: GhcPkg.DbMode) = PackageDB { location, locationAbsolute :: !FilePath, - -- We need both possibly-relative and definately-absolute package + -- We need both possibly-relative and definitely-absolute package -- db locations. This is because the relative location is used as -- an identifier for the db, so it is important we do not modify it. -- On the other hand we need the absolute path in a few places -- particularly in relation to the ${pkgroot} stuff. + packageDbLock :: !(GhcPkg.DbOpenMode mode GhcPkg.PackageDbLock), + -- If package db is open in read write mode, we keep its lock around for + -- transactional updates. + packages :: [InstalledPackageInfo] } -type PackageDBStack = [PackageDB] +type PackageDBStack = [PackageDB 'GhcPkg.DbReadOnly] -- A stack of package databases. Convention: head is the topmost -- in the stack. +-- | Selector for picking the right package DB to modify as 'register' and +-- 'recache' operate on the database on top of the stack, whereas 'modify' +-- changes the first database that contains a specific package. +data DbModifySelector = TopOne | ContainsPkg PackageArg + allPackagesInStack :: PackageDBStack -> [InstalledPackageInfo] allPackagesInStack = concatMap packages getPkgDatabases :: Verbosity - -> Bool -- we are modifying, not reading + -> GhcPkg.DbOpenMode mode DbModifySelector -> Bool -- use the user db -> Bool -- read caches, if available -> Bool -- expand vars, like ${pkgroot} and $topdir @@ -572,7 +605,7 @@ getPkgDatabases :: Verbosity -> IO (PackageDBStack, -- the real package DB stack: [global,user] ++ -- DBs specified on the command line with -f. - Maybe FilePath, + GhcPkg.DbOpenMode mode (PackageDB mode), -- which one to modify, if any PackageDBStack) -- the package DBs specified on the command @@ -580,7 +613,7 @@ getPkgDatabases :: Verbosity -- is used as the list of package DBs for -- commands that just read the DB, such as 'list'. -getPkgDatabases verbosity modify use_user use_cache expand_vars my_flags = do +getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do -- first we determine the location of the global package config. On Windows, -- this is found relative to the ghc-pkg.exe binary, whereas on Unix the -- location is passed to the binary using the --global-package-db flag by the @@ -662,29 +695,117 @@ getPkgDatabases verbosity modify use_user use_cache expand_vars my_flags = do [ f | FlagConfig f <- reverse my_flags ] ++ env_stack - -- the database we actually modify is the one mentioned - -- rightmost on the command-line. - let to_modify - | not modify = Nothing - | null db_flags = Just virt_global_conf - | otherwise = Just (last db_flags) + top_db = if null db_flags + then virt_global_conf + else last db_flags - db_stack <- sequence - [ do db <- readParseDatabase verbosity mb_user_conf modify use_cache db_path - if expand_vars then return (mungePackageDBPaths top_dir db) - else return db - | db_path <- final_stack ] + (db_stack, db_to_operate_on) <- getDatabases top_dir mb_user_conf + flag_db_names final_stack top_db let flag_db_stack = [ db | db_name <- flag_db_names, db <- db_stack, location db == db_name ] when (verbosity > Normal) $ do infoLn ("db stack: " ++ show (map location db_stack)) - infoLn ("modifying: " ++ show to_modify) + F.forM_ db_to_operate_on $ \db -> + infoLn ("modifying: " ++ (location db)) infoLn ("flag db stack: " ++ show (map location flag_db_stack)) - return (db_stack, to_modify, flag_db_stack) - + return (db_stack, db_to_operate_on, flag_db_stack) + where + getDatabases top_dir mb_user_conf flag_db_names + final_stack top_db = case mode of + -- When we open in read only mode, we simply read all of the databases/ + GhcPkg.DbOpenReadOnly -> do + db_stack <- mapM readDatabase final_stack + return (db_stack, GhcPkg.DbOpenReadOnly) + + -- The only package db we open in read write mode is the one on the top of + -- the stack. + GhcPkg.DbOpenReadWrite TopOne -> do + (db_stack, mto_modify) <- stateSequence Nothing + [ \case + to_modify@(Just _) -> (, to_modify) <$> readDatabase db_path + Nothing -> if db_path /= top_db + then (, Nothing) <$> readDatabase db_path + else do + db <- readParseDatabase verbosity mb_user_conf + mode use_cache db_path + `Exception.catch` couldntOpenDbForModification db_path + let ro_db = db { packageDbLock = GhcPkg.DbOpenReadOnly } + return (ro_db, Just db) + | db_path <- final_stack ] + + to_modify <- case mto_modify of + Just db -> return db + Nothing -> die "no database selected for modification" + + return (db_stack, GhcPkg.DbOpenReadWrite to_modify) + + -- The package db we open in read write mode is the first one included in + -- flag_db_names that contains specified package. Therefore we need to + -- open each one in read/write mode first and decide whether it's for + -- modification based on its contents. + GhcPkg.DbOpenReadWrite (ContainsPkg pkgarg) -> do + (db_stack, mto_modify) <- stateSequence Nothing + [ \case + to_modify@(Just _) -> (, to_modify) <$> readDatabase db_path + Nothing -> if db_path `notElem` flag_db_names + then (, Nothing) <$> readDatabase db_path + else do + let hasPkg :: PackageDB mode -> Bool + hasPkg = not . null . findPackage pkgarg . packages + + openRo (e::IOError) = do + db <- readDatabase db_path + if hasPkg db + then couldntOpenDbForModification db_path e + else return (db, Nothing) + + -- If we fail to open the database in read/write mode, we need + -- to check if it's for modification first before throwing an + -- error, so we attempt to open it in read only mode. + Exception.handle openRo $ do + db <- readParseDatabase verbosity mb_user_conf + mode use_cache db_path + let ro_db = db { packageDbLock = GhcPkg.DbOpenReadOnly } + if hasPkg db + then return (ro_db, Just db) + else do + -- If the database is not for modification after all, + -- drop the write lock as we are already finished with + -- the database. + case packageDbLock db of + GhcPkg.DbOpenReadWrite lock -> + GhcPkg.unlockPackageDb lock + return (ro_db, Nothing) + | db_path <- final_stack ] + + to_modify <- case mto_modify of + Just db -> return db + Nothing -> cannotFindPackage pkgarg Nothing + + return (db_stack, GhcPkg.DbOpenReadWrite to_modify) + where + couldntOpenDbForModification :: FilePath -> IOError -> IO a + couldntOpenDbForModification db_path e = die $ "Couldn't open database " + ++ db_path ++ " for modification: " ++ show e + + -- Parse package db in read-only mode. + readDatabase :: FilePath -> IO (PackageDB 'GhcPkg.DbReadOnly) + readDatabase db_path = do + db <- readParseDatabase verbosity mb_user_conf + GhcPkg.DbOpenReadOnly use_cache db_path + if expand_vars + then return $ mungePackageDBPaths top_dir db + else return db + + stateSequence :: Monad m => s -> [s -> m (a, s)] -> m ([a], s) + stateSequence s [] = return ([], s) + stateSequence s (m:ms) = do + (a, s') <- m s + (as, s'') <- stateSequence s' ms + return (a : as, s'') lookForPackageDBIn :: FilePath -> IO (Maybe FilePath) lookForPackageDBIn dir = do @@ -695,17 +816,19 @@ lookForPackageDBIn dir = do exists_file <- doesFileExist path_file if exists_file then return (Just path_file) else return Nothing -readParseDatabase :: Verbosity +readParseDatabase :: forall mode t. Verbosity -> Maybe (FilePath,Bool) - -> Bool -- we will be modifying, not just reading + -> GhcPkg.DbOpenMode mode t -> Bool -- use cache -> FilePath - -> IO PackageDB - -readParseDatabase verbosity mb_user_conf modify use_cache path + -> IO (PackageDB mode) +readParseDatabase verbosity mb_user_conf mode use_cache path -- the user database (only) is allowed to be non-existent | Just (user_conf,False) <- mb_user_conf, path == user_conf - = mkPackageDB [] + = do lock <- F.forM mode $ \_ -> do + createDirectoryIfMissing True path + GhcPkg.lockPackageDb cache + mkPackageDB [] lock | otherwise = do e <- tryIO $ getDirectoryContents path case e of @@ -714,7 +837,7 @@ readParseDatabase verbosity mb_user_conf modify use_cache path -- We provide a limited degree of backwards compatibility for -- old single-file style db: mdb <- tryReadParseOldFileStyleDatabase verbosity - mb_user_conf modify use_cache path + mb_user_conf mode use_cache path case mdb of Just db -> return db Nothing -> @@ -726,76 +849,87 @@ readParseDatabase verbosity mb_user_conf modify use_cache path Right fs | not use_cache -> ignore_cache (const $ return ()) | otherwise -> do - let cache = path cachefilename - tdir <- getModificationTime path e_tcache <- tryIO $ getModificationTime cache case e_tcache of Left ex -> do whenReportCacheErrors $ if isDoesNotExistError ex - then do - warn ("WARNING: cache does not exist: " ++ cache) - warn ("ghcjs will fail to read this package db. " ++ - recacheAdvice) + then + -- It's fine if the cache is not there as long as the + -- database is empty. + when (not $ null confs) $ do + warn ("WARNING: cache does not exist: " ++ cache) + warn ("ghcjs will fail to read this package db. " ++ + recacheAdvice) else do warn ("WARNING: cache cannot be read: " ++ show ex) warn "ghcjs will fail to read this package db." ignore_cache (const $ return ()) Right tcache -> do - let compareTimestampToCache file = - when (verbosity >= Verbose) $ do - tFile <- getModificationTime file - compareTimestampToCache' file tFile - compareTimestampToCache' file tFile = do - let rel = case tcache `compare` tFile of - LT -> " (NEWER than cache)" - GT -> " (older than cache)" - EQ -> " (same as cache)" - warn ("Timestamp " ++ show tFile - ++ " for " ++ file ++ rel) when (verbosity >= Verbose) $ do warn ("Timestamp " ++ show tcache ++ " for " ++ cache) - compareTimestampToCache' path tdir - if tcache >= tdir + -- If any of the .conf files is newer than package.cache, we + -- assume that cache is out of date. + cache_outdated <- (`anyM` confs) $ \conf -> + (tcache <) <$> getModificationTime conf + if not cache_outdated then do when (verbosity > Normal) $ infoLn ("using cache: " ++ cache) - pkgs <- GhcPkg.readPackageDbForGhcPkg cache - mkPackageDB pkgs + GhcPkg.readPackageDbForGhcPkg cache mode + >>= uncurry mkPackageDB else do whenReportCacheErrors $ do warn ("WARNING: cache is out of date: " ++ cache) warn ("ghcjs will see an old view of this " ++ "package db. " ++ recacheAdvice) - ignore_cache compareTimestampToCache + ignore_cache $ \file -> do + when (verbosity >= Verbose) $ do + tFile <- getModificationTime file + let rel = case tcache `compare` tFile of + LT -> " (NEWER than cache)" + GT -> " (older than cache)" + EQ -> " (same as cache)" + warn ("Timestamp " ++ show tFile + ++ " for " ++ file ++ rel) where - ignore_cache :: (FilePath -> IO ()) -> IO PackageDB + confs = map (path ) $ filter (".conf" `isSuffixOf`) fs + + ignore_cache :: (FilePath -> IO ()) -> IO (PackageDB mode) ignore_cache checkTime = do - let confs = filter (".conf" `isSuffixOf`) fs - doFile f = do checkTime f + -- If we're opening for modification, we need to acquire a + -- lock even if we don't open the cache now, because we are + -- going to modify it later. + lock <- F.mapM (const $ GhcPkg.lockPackageDb cache) mode + let doFile f = do checkTime f parseSingletonPackageConf verbosity f - pkgs <- mapM doFile $ map (path ) confs - mkPackageDB pkgs + pkgs <- mapM doFile confs + mkPackageDB pkgs lock -- We normally report cache errors for read-only commands, - -- since modify commands because will usually fix the cache. - whenReportCacheErrors = - when ( verbosity > Normal - || verbosity >= Normal && not modify) + -- since modify commands will usually fix the cache. + whenReportCacheErrors = when $ verbosity > Normal + || verbosity >= Normal && GhcPkg.isDbOpenReadMode mode where + cache = path cachefilename + recacheAdvice | Just (user_conf, True) <- mb_user_conf, path == user_conf = "Use 'ghcjs-pkg recache --user' to fix." | otherwise = "Use 'ghcjs-pkg recache' to fix." - mkPackageDB pkgs = do + mkPackageDB :: [InstalledPackageInfo] + -> GhcPkg.DbOpenMode mode GhcPkg.PackageDbLock + -> IO (PackageDB mode) + mkPackageDB pkgs lock = do path_abs <- absolutePath path - return PackageDB { - location = path, - locationAbsolute = path_abs, - packages = pkgs - } + return $ PackageDB { + location = path, + locationAbsolute = path_abs, + packageDbLock = lock, + packages = pkgs + } parseSingletonPackageConf :: Verbosity -> FilePath -> IO InstalledPackageInfo parseSingletonPackageConf verbosity file = do @@ -805,7 +939,7 @@ parseSingletonPackageConf verbosity file = do cachefilename :: FilePath cachefilename = "package.cache" -mungePackageDBPaths :: FilePath -> PackageDB -> PackageDB +mungePackageDBPaths :: FilePath -> PackageDB mode -> PackageDB mode mungePackageDBPaths top_dir db@PackageDB { packages = pkgs } = db { packages = map (mungePackagePaths top_dir pkgroot) pkgs } where @@ -814,7 +948,7 @@ mungePackageDBPaths top_dir db@PackageDB { packages = pkgs } = -- files and "package.conf.d" dirs) the pkgroot is the parent directory -- ${pkgroot}/package.conf or ${pkgroot}/package.conf.d/ --- TODO: This code is duplicated in compiler/main/Packages.lhs +-- TODO: This code is duplicated in compiler/main/Packages.hs mungePackagePaths :: FilePath -> FilePath -> InstalledPackageInfo -> InstalledPackageInfo -- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec @@ -881,44 +1015,50 @@ mungePackagePaths top_dir pkgroot pkg = -- ghc itself also cooperates in this workaround tryReadParseOldFileStyleDatabase :: Verbosity -> Maybe (FilePath, Bool) - -> Bool -> Bool -> FilePath - -> IO (Maybe PackageDB) -tryReadParseOldFileStyleDatabase verbosity mb_user_conf modify use_cache path = do + -> GhcPkg.DbOpenMode mode t -> Bool -> FilePath + -> IO (Maybe (PackageDB mode)) +tryReadParseOldFileStyleDatabase verbosity mb_user_conf + mode use_cache path = do -- assumes we've already established that path exists and is not a dir content <- readFile path `catchIO` \_ -> return "" if take 2 content == "[]" then do path_abs <- absolutePath path - let path_dir = path <.> "d" + let path_dir = adjustOldDatabasePath path warn $ "Warning: ignoring old file-style db and trying " ++ path_dir direxists <- doesDirectoryExist path_dir if direxists - then do db <- readParseDatabase verbosity mb_user_conf - modify use_cache path_dir - -- but pretend it was at the original location - return $ Just db { - location = path, - locationAbsolute = path_abs - } - else return $ Just PackageDB { - location = path, - locationAbsolute = path_abs, - packages = [] - } + then do + db <- readParseDatabase verbosity mb_user_conf mode use_cache path_dir + -- but pretend it was at the original location + return $ Just db { + location = path, + locationAbsolute = path_abs + } + else do + lock <- F.forM mode $ \_ -> do + createDirectoryIfMissing True path_dir + GhcPkg.lockPackageDb $ path_dir cachefilename + return $ Just PackageDB { + location = path, + locationAbsolute = path_abs, + packageDbLock = lock, + packages = [] + } -- if the path is not a file, or is not an empty db then we fail else return Nothing -adjustOldFileStylePackageDB :: PackageDB -> IO PackageDB +adjustOldFileStylePackageDB :: PackageDB mode -> IO (PackageDB mode) adjustOldFileStylePackageDB db = do -- assumes we have not yet established if it's an old style or not mcontent <- liftM Just (readFile (location db)) `catchIO` \_ -> return Nothing case fmap (take 2) mcontent of -- it is an old style and empty db, so look for a dir kind in location.d/ Just "[]" -> return db { - location = location db <.> "d", - locationAbsolute = locationAbsolute db <.> "d" - } + location = adjustOldDatabasePath $ location db, + locationAbsolute = adjustOldDatabasePath $ locationAbsolute db + } -- it is old style but not empty, we have to bail Just _ -> die $ "ghcjs no longer supports single-file style package " ++ "databases (" ++ location db ++ ") use 'ghcjs-pkg init'" @@ -926,6 +1066,8 @@ adjustOldFileStylePackageDB db = do -- probably not old style, carry on as normal Nothing -> return db +adjustOldDatabasePath :: FilePath -> FilePath +adjustOldDatabasePath = (<.> "d") -- ----------------------------------------------------------------------------- -- Creating a new package DB @@ -937,11 +1079,15 @@ initPackageDB filename verbosity _flags = do when b1 eexist b2 <- doesDirectoryExist filename when b2 eexist + createDirectoryIfMissing True filename + lock <- GhcPkg.lockPackageDb $ filename cachefilename filename_abs <- absolutePath filename changeDB verbosity [] PackageDB { - location = filename, locationAbsolute = filename_abs, - packages = [] - } + location = filename, + locationAbsolute = filename_abs, + packageDbLock = GhcPkg.DbOpenReadWrite lock, + packages = [] + } -- ----------------------------------------------------------------------------- -- Registering @@ -956,13 +1102,12 @@ registerPackage :: FilePath -> IO () registerPackage input verbosity my_flags multi_instance expand_env_vars update force = do - (db_stack, Just to_modify, _flag_dbs) <- - getPkgDatabases verbosity True{-modify-} True{-use user-} - True{-use cache-} False{-expand vars-} my_flags + (db_stack, GhcPkg.DbOpenReadWrite db_to_operate_on, _flag_dbs) <- + getPkgDatabases verbosity (GhcPkg.DbOpenReadWrite TopOne) + True{-use user-} True{-use cache-} False{-expand vars-} my_flags + + let to_modify = location db_to_operate_on - let - db_to_operate_on = my_head "register" $ - filter ((== to_modify).location) db_stack s <- case input of "-" -> do @@ -985,7 +1130,7 @@ registerPackage input verbosity my_flags multi_instance -- report any warnings from the parse phase _ <- reportValidateErrors verbosity [] ws - (display (sourcePackageId pkg) ++ ": Warning: ") Nothing + (display (mungedId pkg) ++ ": Warning: ") Nothing -- validate the expanded pkg, but register the unexpanded pkgroot <- absolutePath (takeDirectory to_modify) @@ -1006,7 +1151,9 @@ registerPackage input verbosity my_flags multi_instance removes = [ RemovePackage p | not multi_instance, p <- packages db_to_operate_on, - sourcePackageId p == sourcePackageId pkg ] + mungedId p == mungedId pkg, + -- Only remove things that were instantiated the same way! + instantiatedWith p == instantiatedWith pkg ] -- changeDB verbosity (removes ++ [AddPackage pkg]) db_to_operate_on @@ -1033,14 +1180,15 @@ data DBOp = RemovePackage InstalledPackageInfo | AddPackage InstalledPackageInfo | ModifyPackage InstalledPackageInfo -changeDB :: Verbosity -> [DBOp] -> PackageDB -> IO () +changeDB :: Verbosity -> [DBOp] -> PackageDB 'GhcPkg.DbReadWrite -> IO () changeDB verbosity cmds db = do let db' = updateInternalDB db cmds db'' <- adjustOldFileStylePackageDB db' createDirectoryIfMissing True (location db'') changeDBDir verbosity cmds db'' -updateInternalDB :: PackageDB -> [DBOp] -> PackageDB +updateInternalDB :: PackageDB 'GhcPkg.DbReadWrite + -> [DBOp] -> PackageDB 'GhcPkg.DbReadWrite updateInternalDB db cmds = db{ packages = foldl do_cmd (packages db) cmds } where do_cmd pkgs (RemovePackage p) = @@ -1050,7 +1198,7 @@ updateInternalDB db cmds = db{ packages = foldl do_cmd (packages db) cmds } do_cmd (do_cmd pkgs (RemovePackage p)) (AddPackage p) -changeDBDir :: Verbosity -> [DBOp] -> PackageDB -> IO () +changeDBDir :: Verbosity -> [DBOp] -> PackageDB 'GhcPkg.DbReadWrite -> IO () changeDBDir verbosity cmds db = do mapM_ do_cmd cmds updateDBCache verbosity db @@ -1066,7 +1214,7 @@ changeDBDir verbosity cmds db = do do_cmd (ModifyPackage p) = do_cmd (AddPackage p) -updateDBCache :: Verbosity -> PackageDB -> IO () +updateDBCache :: Verbosity -> PackageDB 'GhcPkg.DbReadWrite -> IO () updateDBCache verbosity db = do let filename = location db cachefilename @@ -1078,45 +1226,45 @@ updateDBCache verbosity db = do when (verbosity > Normal) $ infoLn ("writing cache " ++ filename) + GhcPkg.writePackageDb filename pkgsGhcCacheFormat pkgsCabalFormat `catchIO` \e -> if isPermissionError e - then die (filename ++ ": you don't have permission to modify this file") + then die $ filename ++ ": you don't have permission to modify this file" else ioError e - -- See Note [writeAtomic leaky abstraction] - -- Cross-platform "touch". This only works if filename is not empty, and not - -- open for writing already. - -- TODO. When the Win32 or directory packages have either a touchFile or a - -- setModificationTime function, use one of those. - withBinaryFile filename ReadWriteMode $ \handle -> do - c <- hGetChar handle - hSeek handle AbsoluteSeek 0 - hPutChar handle c + + case packageDbLock db of + GhcPkg.DbOpenReadWrite lock -> GhcPkg.unlockPackageDb lock type PackageCacheFormat = GhcPkg.InstalledPackageInfo - String -- src package id - String -- package name - String -- unit id - ModuleName -- module name + ComponentId + PackageIdentifier + PackageName + UnitId + OpenUnitId + ModuleName + OpenModule convertPackageInfoToCacheFormat :: InstalledPackageInfo -> PackageCacheFormat convertPackageInfoToCacheFormat pkg = GhcPkg.InstalledPackageInfo { - GhcPkg.unitId = display (installedUnitId pkg), - GhcPkg.sourcePackageId = display (sourcePackageId pkg), - GhcPkg.packageName = display (packageName pkg), - GhcPkg.packageVersion = packageVersion pkg, - GhcPkg.depends = map display (depends pkg), - GhcPkg.abiHash = let AbiHash abi = abiHash pkg - in abi, + GhcPkg.unitId = installedUnitId pkg, + GhcPkg.componentId = installedComponentId pkg, + GhcPkg.instantiatedWith = instantiatedWith pkg, + GhcPkg.sourcePackageId = sourcePackageId pkg, + GhcPkg.packageName = packageName pkg, + GhcPkg.packageVersion = Version.Version (versionNumbers (packageVersion pkg)) [], + GhcPkg.sourceLibName = + fmap (mkPackageName . unUnqualComponentName) (sourceLibName pkg), + GhcPkg.depends = depends pkg, + GhcPkg.abiDepends = map (\(AbiDependency k v) -> (k,unAbiHash v)) (abiDepends pkg), + GhcPkg.abiHash = unAbiHash (abiHash pkg), GhcPkg.importDirs = importDirs pkg, GhcPkg.hsLibraries = hsLibraries pkg, GhcPkg.extraLibraries = extraLibraries pkg, GhcPkg.extraGHCiLibraries = extraGHCiLibraries pkg, GhcPkg.libraryDirs = libraryDirs pkg, -#if MIN_VERSION_ghc(8,0,2) GhcPkg.libraryDynDirs = libraryDynDirs pkg, -#endif GhcPkg.frameworks = frameworks pkg, GhcPkg.frameworkDirs = frameworkDirs pkg, GhcPkg.ldOptions = ldOptions pkg, @@ -1127,22 +1275,49 @@ convertPackageInfoToCacheFormat pkg = GhcPkg.haddockHTMLs = haddockHTMLs pkg, GhcPkg.exposedModules = map convertExposed (exposedModules pkg), GhcPkg.hiddenModules = hiddenModules pkg, + GhcPkg.indefinite = indefinite pkg, GhcPkg.exposed = exposed pkg, GhcPkg.trusted = trusted pkg } - where convertExposed (ExposedModule n reexport) = - GhcPkg.ExposedModule n (fmap convertOriginal reexport) - convertOriginal (OriginalModule ipid m) = - GhcPkg.OriginalModule (display ipid) m + where + convertExposed (ExposedModule n reexport) = (n, reexport) + +instance GhcPkg.BinaryStringRep ComponentId where + fromStringRep = mkComponentId . fromStringRep + toStringRep = toStringRep . display + +instance GhcPkg.BinaryStringRep PackageName where + fromStringRep = mkPackageName . fromStringRep + toStringRep = toStringRep . display + +instance GhcPkg.BinaryStringRep PackageIdentifier where + fromStringRep = fromMaybe (error "BinaryStringRep PackageIdentifier") + . simpleParse . fromStringRep + toStringRep = toStringRep . display instance GhcPkg.BinaryStringRep ModuleName where - fromStringRep = ModuleName.fromString . fromUTF8 . BS.unpack - toStringRep = BS.pack . toUTF8 . display + fromStringRep = ModuleName.fromString . fromStringRep + toStringRep = toStringRep . display instance GhcPkg.BinaryStringRep String where fromStringRep = fromUTF8 . BS.unpack toStringRep = BS.pack . toUTF8 +instance GhcPkg.BinaryStringRep UnitId where + fromStringRep = mkUnitId . fromStringRep + toStringRep = toStringRep . display + +instance GhcPkg.DbUnitIdModuleRep UnitId ComponentId OpenUnitId ModuleName OpenModule where + fromDbModule (GhcPkg.DbModule uid mod_name) = OpenModule uid mod_name + fromDbModule (GhcPkg.DbModuleVar mod_name) = OpenModuleVar mod_name + toDbModule (OpenModule uid mod_name) = GhcPkg.DbModule uid mod_name + toDbModule (OpenModuleVar mod_name) = GhcPkg.DbModuleVar mod_name + fromDbUnitId (GhcPkg.DbUnitId cid insts) = IndefFullUnitId cid (Map.fromList insts) + fromDbUnitId (GhcPkg.DbInstalledUnitId uid) + = DefiniteUnitId (unsafeMkDefUnitId uid) + toDbUnitId (IndefFullUnitId cid insts) = GhcPkg.DbUnitId cid (Map.toList insts) + toDbUnitId (DefiniteUnitId def_uid) + = GhcPkg.DbInstalledUnitId (unDefUnitId def_uid) -- ----------------------------------------------------------------------------- -- Exposing, Hiding, Trusting, Distrusting, Unregistering are all similar @@ -1170,35 +1345,39 @@ modifyPackage -> Force -> IO () modifyPackage fn pkgarg verbosity my_flags force = do - (db_stack, Just _to_modify, flag_dbs) <- - getPkgDatabases verbosity True{-modify-} True{-use user-} - True{-use cache-} False{-expand vars-} my_flags + (db_stack, GhcPkg.DbOpenReadWrite db, _flag_dbs) <- + getPkgDatabases verbosity (GhcPkg.DbOpenReadWrite $ ContainsPkg pkgarg) + True{-use user-} True{-use cache-} False{-expand vars-} my_flags - -- Do the search for the package respecting flags... - (db, ps) <- fmap head $ findPackagesByDB flag_dbs pkgarg - let - db_name = location db + let db_name = location db pkgs = packages db - pks = map installedUnitId ps + -- Get package respecting flags... + ps = findPackage pkgarg pkgs + + -- This shouldn't happen if getPkgDatabases picks the DB correctly. + when (null ps) $ cannotFindPackage pkgarg $ Just db + + let pks = map installedUnitId ps cmds = [ fn pkg | pkg <- pkgs, installedUnitId pkg `elem` pks ] new_db = updateInternalDB db cmds + new_db_ro = new_db { packageDbLock = GhcPkg.DbOpenReadOnly } -- ...but do consistency checks with regards to the full stack old_broken = brokenPackages (allPackagesInStack db_stack) rest_of_stack = filter ((/= db_name) . location) db_stack - new_stack = new_db : rest_of_stack + new_stack = new_db_ro : rest_of_stack new_broken = brokenPackages (allPackagesInStack new_stack) newly_broken = filter ((`notElem` map installedUnitId old_broken) . installedUnitId) new_broken -- let displayQualPkgId pkg - | [_] <- filter ((== pkgid) . sourcePackageId) + | [_] <- filter ((== pkgid) . mungedId) (allPackagesInStack db_stack) = display pkgid | otherwise = display pkgid ++ "@" ++ display (installedUnitId pkg) - where pkgid = sourcePackageId pkg + where pkgid = mungedId pkg when (not (null newly_broken)) $ dieOrForceAll force ("unregistering would break the following packages: " ++ unwords (map displayQualPkgId newly_broken)) @@ -1207,13 +1386,9 @@ modifyPackage fn pkgarg verbosity my_flags force = do recache :: Verbosity -> [Flag] -> IO () recache verbosity my_flags = do - (db_stack, Just to_modify, _flag_dbs) <- - getPkgDatabases verbosity True{-modify-} True{-use user-} False{-no cache-} - False{-expand vars-} my_flags - let - db_to_operate_on = my_head "recache" $ - filter ((== to_modify).location) db_stack - -- + (_db_stack, GhcPkg.DbOpenReadWrite db_to_operate_on, _flag_dbs) <- + getPkgDatabases verbosity (GhcPkg.DbOpenReadWrite TopOne) + True{-use user-} False{-no cache-} False{-expand vars-} my_flags changeDB verbosity [] db_to_operate_on -- ----------------------------------------------------------------------------- @@ -1224,9 +1399,9 @@ listPackages :: Verbosity -> [Flag] -> Maybe PackageArg -> IO () listPackages verbosity my_flags mPackageName mModuleName = do let simple_output = FlagSimpleOutput `elem` my_flags - (db_stack, _, flag_db_stack) <- - getPkgDatabases verbosity False{-modify-} False{-use user-} - True{-use cache-} False{-expand vars-} my_flags + (db_stack, GhcPkg.DbOpenReadOnly, flag_db_stack) <- + getPkgDatabases verbosity GhcPkg.DbOpenReadOnly + False{-use user-} True{-use cache-} False{-expand vars-} my_flags let db_stack_filtered -- if a package is given, filter out all other packages | Just this <- mPackageName = @@ -1242,14 +1417,14 @@ listPackages verbosity my_flags mPackageName mModuleName = do | db <- db_stack_filtered ] where sort_pkgs = sortBy cmpPkgIds cmpPkgIds pkg1 pkg2 = - case pkgName p1 `compare` pkgName p2 of + case mungedName p1 `compare` mungedName p2 of LT -> LT GT -> GT - EQ -> case pkgVersion p1 `compare` pkgVersion p2 of + EQ -> case mungedVersion p1 `compare` mungedVersion p2 of LT -> LT GT -> GT EQ -> installedUnitId pkg1 `compare` installedUnitId pkg2 - where (p1,p2) = (sourcePackageId pkg1, sourcePackageId pkg2) + where (p1,p2) = (mungedId pkg1, mungedId pkg2) stack = reverse db_stack_sorted @@ -1271,7 +1446,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do where doc | verbosity >= Verbose = printf "%s (%s)" pkg (display (installedUnitId p)) | otherwise = pkg where - pkg = display (sourcePackageId p) + pkg = display (mungedId p) show_simple = simplePackageList my_flags . allPackagesInStack @@ -1281,7 +1456,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do if simple_output then show_simple stack else do -#if defined(mingw32_HOST_OS) || defined(BOOTSTRAPPING) +#ifndef WITH_TERMINFO mapM_ show_normal stack #else let @@ -1302,7 +1477,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do | otherwise = termText pkg where - pkg = display (sourcePackageId p) + pkg = display (mungedId p) is_tty <- hIsTerminalDevice stdout if not is_tty @@ -1316,17 +1491,17 @@ listPackages verbosity my_flags mPackageName mModuleName = do simplePackageList :: [Flag] -> [InstalledPackageInfo] -> IO () simplePackageList my_flags pkgs = do - let showPkg = if FlagNamesOnly `elem` my_flags then display . pkgName + let showPkg = if FlagNamesOnly `elem` my_flags then display . mungedName else display - strs = map showPkg $ map sourcePackageId pkgs + strs = map showPkg $ map mungedId pkgs when (not (null pkgs)) $ hPutStrLn stdout $ concat $ intersperse " " strs showPackageDot :: Verbosity -> [Flag] -> IO () showPackageDot verbosity myflags = do - (_, _, flag_db_stack) <- - getPkgDatabases verbosity False{-modify-} False{-use user-} - True{-use cache-} False{-expand vars-} myflags + (_, GhcPkg.DbOpenReadOnly, flag_db_stack) <- + getPkgDatabases verbosity GhcPkg.DbOpenReadOnly + False{-use user-} True{-use cache-} False{-expand vars-} myflags let all_pkgs = allPackagesInStack flag_db_stack ipix = PackageIndex.fromList all_pkgs @@ -1335,10 +1510,10 @@ showPackageDot verbosity myflags = do let quote s = '"':s ++ "\"" mapM_ putStrLn [ quote from ++ " -> " ++ quote to | p <- all_pkgs, - let from = display (sourcePackageId p), + let from = display (mungedId p), key <- depends p, Just dep <- [PackageIndex.lookupUnitId ipix key], - let to = display (sourcePackageId dep) + let to = display (mungedId dep) ] putStrLn "}" @@ -1347,16 +1522,16 @@ showPackageDot verbosity myflags = do -- ToDo: This is no longer well-defined with unit ids, because the -- dependencies may be varying versions -latestPackage :: Verbosity -> [Flag] -> PackageIdentifier -> IO () +latestPackage :: Verbosity -> [Flag] -> GlobPackageIdentifier -> IO () latestPackage verbosity my_flags pkgid = do - (_, _, flag_db_stack) <- - getPkgDatabases verbosity False{-modify-} False{-use user-} - True{-use cache-} False{-expand vars-} my_flags + (_, GhcPkg.DbOpenReadOnly, flag_db_stack) <- + getPkgDatabases verbosity GhcPkg.DbOpenReadOnly + False{-use user-} True{-use cache-} False{-expand vars-} my_flags ps <- findPackages flag_db_stack (Id pkgid) case ps of [] -> die "no matches" - _ -> show_pkg . maximum . map sourcePackageId $ ps + _ -> show_pkg . maximum . map mungedId $ ps where show_pkg pid = hPutStrLn stdout (display pid) @@ -1365,18 +1540,18 @@ latestPackage verbosity my_flags pkgid = do describePackage :: Verbosity -> [Flag] -> PackageArg -> Bool -> IO () describePackage verbosity my_flags pkgarg expand_pkgroot = do - (_, _, flag_db_stack) <- - getPkgDatabases verbosity False{-modify-} False{-use user-} - True{-use cache-} expand_pkgroot my_flags + (_, GhcPkg.DbOpenReadOnly, flag_db_stack) <- + getPkgDatabases verbosity GhcPkg.DbOpenReadOnly + False{-use user-} True{-use cache-} expand_pkgroot my_flags dbs <- findPackagesByDB flag_db_stack pkgarg doDump expand_pkgroot [ (pkg, locationAbsolute db) | (db, pkgs) <- dbs, pkg <- pkgs ] dumpPackages :: Verbosity -> [Flag] -> Bool -> IO () dumpPackages verbosity my_flags expand_pkgroot = do - (_, _, flag_db_stack) <- - getPkgDatabases verbosity False{-modify-} False{-use user-} - True{-use cache-} expand_pkgroot my_flags + (_, GhcPkg.DbOpenReadOnly, flag_db_stack) <- + getPkgDatabases verbosity GhcPkg.DbOpenReadOnly + False{-use user-} True{-use cache-} expand_pkgroot my_flags doDump expand_pkgroot [ (pkg, locationAbsolute db) | db <- flag_db_stack, pkg <- packages db ] @@ -1398,42 +1573,47 @@ findPackages :: PackageDBStack -> PackageArg -> IO [InstalledPackageInfo] findPackages db_stack pkgarg = fmap (concatMap snd) $ findPackagesByDB db_stack pkgarg +findPackage :: PackageArg -> [InstalledPackageInfo] -> [InstalledPackageInfo] +findPackage pkgarg pkgs = filter (pkgarg `matchesPkg`) pkgs + findPackagesByDB :: PackageDBStack -> PackageArg - -> IO [(PackageDB, [InstalledPackageInfo])] + -> IO [(PackageDB 'GhcPkg.DbReadOnly, [InstalledPackageInfo])] findPackagesByDB db_stack pkgarg = case [ (db, matched) | db <- db_stack, - let matched = filter (pkgarg `matchesPkg`) (packages db), + let matched = findPackage pkgarg $ packages db, not (null matched) ] of - [] -> die ("cannot find package " ++ pkg_msg pkgarg) + [] -> cannotFindPackage pkgarg Nothing ps -> return ps - where - pkg_msg (Id pkgid) = display pkgid - pkg_msg (IUId ipid) = display ipid - pkg_msg (Substring pkgpat _) = "matching " ++ pkgpat -matches :: PackageIdentifier -> PackageIdentifier -> Bool -pid `matches` pid' - = (pkgName pid == pkgName pid') - && (pkgVersion pid == pkgVersion pid' || not (realVersion pid)) +cannotFindPackage :: PackageArg -> Maybe (PackageDB mode) -> IO a +cannotFindPackage pkgarg mdb = die $ "cannot find package " ++ pkg_msg pkgarg + ++ maybe "" (\db -> " in " ++ location db) mdb + where + pkg_msg (Id pkgid) = displayGlobPkgId pkgid + pkg_msg (IUId ipid) = display ipid + pkg_msg (Substring pkgpat _) = "matching " ++ pkgpat -realVersion :: PackageIdentifier -> Bool -realVersion pkgid = versionBranch (pkgVersion pkgid) /= [] - -- when versionBranch == [], this is a glob +matches :: GlobPackageIdentifier -> MungedPackageId -> Bool +GlobPackageIdentifier pn `matches` pid' + = (pn == mungedName pid') +ExactPackageIdentifier pid `matches` pid' + = mungedName pid == mungedName pid' && + (mungedVersion pid == mungedVersion pid' || mungedVersion pid == nullVersion) matchesPkg :: PackageArg -> InstalledPackageInfo -> Bool -(Id pid) `matchesPkg` pkg = pid `matches` sourcePackageId pkg +(Id pid) `matchesPkg` pkg = pid `matches` mungedId pkg (IUId ipid) `matchesPkg` pkg = ipid == installedUnitId pkg -(Substring _ m) `matchesPkg` pkg = m (display (sourcePackageId pkg)) +(Substring _ m) `matchesPkg` pkg = m (display (mungedId pkg)) -- ----------------------------------------------------------------------------- -- Field describeField :: Verbosity -> [Flag] -> PackageArg -> [String] -> Bool -> IO () describeField verbosity my_flags pkgarg fields expand_pkgroot = do - (_, _, flag_db_stack) <- - getPkgDatabases verbosity False{-modify-} False{-use user-} - True{-use cache-} expand_pkgroot my_flags + (_, GhcPkg.DbOpenReadOnly, flag_db_stack) <- + getPkgDatabases verbosity GhcPkg.DbOpenReadOnly + False{-use user-} True{-use cache-} expand_pkgroot my_flags fns <- mapM toField fields ps <- findPackages flag_db_stack pkgarg mapM_ (selectFields fns) ps @@ -1451,12 +1631,11 @@ describeField verbosity my_flags pkgarg fields expand_pkgroot = do checkConsistency :: Verbosity -> [Flag] -> IO () checkConsistency verbosity my_flags = do - (db_stack, _, _) <- - getPkgDatabases verbosity False{-modify-} True{-use user-} - True{-use cache-} True{-expand vars-} - my_flags - -- although check is not a modify command, we do need to use the user - -- db, because we may need it to verify package deps. + (db_stack, GhcPkg.DbOpenReadOnly, _) <- + getPkgDatabases verbosity GhcPkg.DbOpenReadOnly + True{-use user-} True{-use cache-} True{-expand vars-} my_flags + -- although check is not a modify command, we do need to use the user + -- db, because we may need it to verify package deps. let simple_output = FlagSimpleOutput `elem` my_flags @@ -1472,7 +1651,7 @@ checkConsistency verbosity my_flags = do return [] else do when (not simple_output) $ do - reportError ("There are problems in package " ++ display (sourcePackageId p) ++ ":") + reportError ("There are problems in package " ++ display (mungedId p) ++ ":") _ <- reportValidateErrors verbosity es ws " " Nothing return () return [p] @@ -1480,8 +1659,8 @@ checkConsistency verbosity my_flags = do broken_pkgs <- concat `fmap` mapM checkPackage pkgs let filterOut pkgs1 pkgs2 = filter not_in pkgs2 - where not_in p = sourcePackageId p `notElem` all_ps - all_ps = map sourcePackageId pkgs1 + where not_in p = mungedId p `notElem` all_ps + all_ps = map mungedId pkgs1 let not_broken_pkgs = filterOut broken_pkgs pkgs (_, trans_broken_pkgs) = closure [] not_broken_pkgs @@ -1493,7 +1672,7 @@ checkConsistency verbosity my_flags = do else do reportError ("\nThe following packages are broken, either because they have a problem\n"++ "listed above, or because they depend on a broken package.") - mapM_ (hPutStrLn stderr . display . sourcePackageId) all_broken_pkgs + mapM_ (hPutStrLn stderr . display . mungedId) all_broken_pkgs when (not (null all_broken_pkgs)) $ exitWith (ExitFailure 1) @@ -1536,7 +1715,6 @@ instance Applicative Validate where (<*>) = ap instance Monad Validate where - return = pure m >>= k = V $ do (a, es, ws) <- runValidate m (b, es', ws') <- runValidate (k a) @@ -1588,7 +1766,7 @@ validatePackageConfig pkg verbosity db_stack checkPackageConfig pkg verbosity db_stack multi_instance update ok <- reportValidateErrors verbosity es ws - (display (sourcePackageId pkg) ++ ": ") (Just force) + (display (mungedId pkg) ++ ": ") (Just force) when (not ok) $ exitWith (ExitFailure 1) checkPackageConfig :: InstalledPackageInfo @@ -1606,18 +1784,17 @@ checkPackageConfig pkg verbosity db_stack checkDuplicateDepends (depends pkg) mapM_ (checkDir False "import-dirs") (importDirs pkg) mapM_ (checkDir True "library-dirs") (libraryDirs pkg) -#if MIN_VERSION_ghc(8,0,2) - mapM_ (checkDir True "dynamic-library-dirs") (libraryDynDirs pkg) -#endif + -- mapM_ (checkDir True "dynamic-library-dirs") (libraryDynDirs pkg) mapM_ (checkDir True "include-dirs") (includeDirs pkg) mapM_ (checkDir True "framework-dirs") (frameworkDirs pkg) mapM_ (checkFile True "haddock-interfaces") (haddockInterfaces pkg) mapM_ (checkDirURL True "haddock-html") (haddockHTMLs pkg) checkDuplicateModules pkg checkExposedModules db_stack pkg - -- disabled for GHCJS, package may not have native libs - -- mapM_ (checkHSLib verbosity (libraryDirs pkg ++ libraryDynDirs pkg)) (hsLibraries pkg) - checkOtherModules pkg + checkOtherModules pkg + -- let has_code = Set.null (openModuleSubstFreeHoles (Map.fromList (instantiatedWith pkg))) + -- disabled for GHCJS, package may not have native libs + -- when has_code $ mapM_ (checkHSLib verbosity (libraryDirs pkg ++ libraryDynDirs pkg)) (hsLibraries pkg) -- ToDo: check these somehow? -- extra_libraries :: [String], -- c_includes :: [String], @@ -1628,8 +1805,8 @@ checkPackageConfig pkg verbosity db_stack -- we check that the package id can be parsed properly here. checkPackageId :: InstalledPackageInfo -> Validate () checkPackageId ipi = - let str = display (sourcePackageId ipi) in - case [ x :: PackageIdentifier | (x,ys) <- readP_to_S parse str, all isSpace ys ] of + let str = display (mungedId ipi) in + case [ x :: MungedPackageId | (x,ys) <- readP_to_S parse str, all isSpace ys ] of [_] -> return () [] -> verror CannotForce ("invalid package identifier: " ++ str) _ -> verror CannotForce ("ambiguous package identifier: " ++ str) @@ -1653,19 +1830,19 @@ checkDuplicates :: PackageDBStack -> InstalledPackageInfo -> Bool -> Bool-> Validate () checkDuplicates db_stack pkg multi_instance update = do let - pkgid = sourcePackageId pkg + pkgid = mungedId pkg pkgs = packages (head db_stack) -- -- Check whether this package id already exists in this DB -- when (not update && not multi_instance - && (pkgid `elem` map sourcePackageId pkgs)) $ + && (pkgid `elem` map mungedId pkgs)) $ verror CannotForce $ "package " ++ display pkgid ++ " is already installed" let uncasep = map toLower . display - dups = filter ((== uncasep pkgid) . uncasep) (map sourcePackageId pkgs) + dups = filter ((== uncasep pkgid) . uncasep) (map mungedId pkgs) when (not update && not multi_instance && not (null dups)) $ verror ForceAll $ @@ -1754,7 +1931,7 @@ checkExposedModules db_stack pkg = where checkExposedModule (ExposedModule modl reexport) = do let checkOriginal = checkModuleFile pkg modl - checkReexport = checkOriginalModule "module reexport" db_stack pkg + checkReexport = checkModule "module reexport" db_stack pkg maybe checkOriginal checkReexport reexport -- | Validates the existence of an appropriate @hi@ file associated with @@ -1792,14 +1969,16 @@ checkDuplicateModules pkg -- implementation, then we should also check that the original module in -- question is NOT a signature (however, if it is a reexport, then it's fine -- for the original module to be a signature.) -checkOriginalModule :: String - -> PackageDBStack - -> InstalledPackageInfo - -> OriginalModule - -> Validate () -checkOriginalModule field_name db_stack pkg - (OriginalModule definingPkgId definingModule) = - let mpkg = if definingPkgId == installedUnitId pkg +checkModule :: String + -> PackageDBStack + -> InstalledPackageInfo + -> OpenModule + -> Validate () +checkModule _ _ _ (OpenModuleVar _) = error "Impermissible reexport" +checkModule field_name db_stack pkg + (OpenModule (DefiniteUnitId def_uid) definingModule) = + let definingPkgId = unDefUnitId def_uid + mpkg = if definingPkgId == installedUnitId pkg then Just pkg else PackageIndex.lookupUnitId ipix definingPkgId in case mpkg of @@ -1829,7 +2008,6 @@ checkOriginalModule field_name db_stack pkg "that is reexported but not defined in the " ++ "defining package " ++ display definingPkgId) _ -> return () - where all_pkgs = allPackagesInStack db_stack ipix = PackageIndex.fromList all_pkgs @@ -1841,6 +2019,10 @@ checkOriginalModule field_name db_stack pkg (depgraph, _, graphVertex) = PackageIndex.dependencyGraph (PackageIndex.insert pkg ipix) +checkModule _ _ _ (OpenModule (IndefFullUnitId _ _) _) = + -- TODO: add some checks here + return () + -- --------------------------------------------------------------------------- -- expanding environment variables in the package configuration @@ -1908,10 +2090,6 @@ reportError s = do hFlush stdout; hPutStrLn stderr s dieForcible :: String -> IO () dieForcible s = die (s ++ " (use --force to override)") -my_head :: String -> [a] -> a -my_head s [] = error s -my_head _ (x : _) = x - ----------------------------------------- -- Cut and pasted from ghc/compiler/main/SysTools @@ -1923,7 +2101,15 @@ unDosifyPath :: FilePath -> FilePath unDosifyPath xs = subst '\\' '/' xs getLibDir :: IO (Maybe String) -getLibDir = fmap (fmap ( "lib")) $ getExecDir "/bin/ghcjs-pkg.exe" +getLibDir = do base <- getExecDir "/ghcjs-pkg.exe" + case base of + Nothing -> return Nothing + Just base' -> do + libdir <- canonicalizePath $ base' "../lib" + exists <- doesDirectoryExist libdir + if exists + then return $ Just libdir + else return Nothing -- (getExecDir cmd) returns the directory in which the current -- executable, which should be called 'cmd', is running @@ -1996,40 +2182,3 @@ removeFileSafe fn = -- absolute path. absolutePath :: FilePath -> IO FilePath absolutePath path = return . normalise . ( path) =<< getCurrentDirectory - - -{- Note [writeAtomic leaky abstraction] -GhcPkg.writePackageDb calls writeAtomic, which first writes to a temp file, -and then moves the tempfile to its final destination. This all happens in the -same directory (package.conf.d). -Moving a file doesn't change its modification time, but it *does* change the -modification time of the directory it is placed in. Since we compare the -modification time of the cache file to that of the directory it is in to -decide whether the cache is out-of-date, it will be instantly out-of-date -after creation, if the renaming takes longer than the smallest time difference -that the getModificationTime can measure. - -The solution we opt for is a "touch" of the cache file right after it is -created. This resets the modification time of the cache file and the directory -to the current time. - -Other possible solutions: - * backdate the modification time of the directory to the modification time - of the cachefile. This is what we used to do on posix platforms. An - observer of the directory would see the modification time of the directory - jump back in time. Not nice, although in practice probably not a problem. - Also note that a cross-platform implementation of setModificationTime is - currently not available. - * set the modification time of the cache file to the modification time of - the directory (instead of the curent time). This could also work, - given that we are the only ones writing to this directory. It would also - require a high-precision getModificationTime (lower precision times get - rounded down it seems), or the cache would still be out-of-date. - * change writeAtomic to create the tempfile outside of the target file's - directory. - * create the cachefile outside of the package.conf.d directory in the first - place. But there are tests and there might be tools that currently rely on - the package.conf.d/package.cache format. --} - -#endif diff --git a/src/Compiler/Compat.hs b/src/Compiler/Compat.hs index cd29e627..0ca30076 100644 --- a/src/Compiler/Compat.hs +++ b/src/Compiler/Compat.hs @@ -10,9 +10,13 @@ module Compiler.Compat ( PackageKey , mainPackageKey , modulePackageName , getPackageName + , getInstalledPackageName , getPackageVersion + , getInstalledPackageVersion , getPackageLibDirs + , getInstalledPackageLibDirs , getPackageHsLibs + , getInstalledPackageHsLibs , searchModule , Version(..) , showVersion @@ -23,12 +27,7 @@ import Module import DynFlags import FastString -#if !(__GLASGOW_HASKELL__ >= 709) -import Distribution.Package hiding ( PackageId ) import Packages hiding ( Version ) -#else -import Packages hiding ( Version ) -#endif import Data.Binary import Data.Text (Text) @@ -50,136 +49,66 @@ isEmptyVersion = null . unVersion convertVersion :: DV.Version -> Version convertVersion v = Version (map fromIntegral $ versionBranch v) -#if !(__GLASGOW_HASKELL__ >= 709) - -type PackageKey = PackageId - -packageKeyString :: PackageKey -> String -packageKeyString = packageIdString - -modulePackageKey :: Module -> PackageKey -modulePackageKey = modulePackageId - -stringToPackageKey :: String -> PackageKey -stringToPackageKey = stringToPackageId - -primPackageKey :: PackageKey -primPackageKey = primPackageId - -mainPackageKey :: PackageKey -mainPackageKey = mainPackageId - -modulePackageName :: DynFlags -> Module -> String -modulePackageName dflags - = getPackageName dflags . modulePackageId - -getPackageName :: DynFlags -> PackageKey -> String -getPackageName dflags - = maybe "" ((\(PackageName n) -> n) . pkgName . sourcePackageId) - . lookupPackage (pkgIdMap . pkgState $ dflags) - -getPackageVersion :: DynFlags -> PackageKey -> Maybe Version -getPackageVersion dflags - = fmap (convertVersion . pkgVersion . sourcePackageId) - . lookupPackage (pkgIdMap . pkgState $ dflags) - -getPackageLibDirs :: DynFlags -> PackageKey -> [FilePath] -getPackageLibDirs dflags - = maybe [] libraryDirs . lookupPackage (pkgIdMap . pkgState $ dflags) - -getPackageHsLibs :: DynFlags -> PackageKey -> [String] -getPackageHsLibs dflags - = maybe [] hsLibraries . lookupPackage (pkgIdMap . pkgState $ dflags) - -searchModule :: DynFlags -> ModuleName -> [(String, PackageKey)] -searchModule dflags - = map ((\k -> (getPackageName dflags k, k)) . packageConfigId . fst) - . lookupModuleInAllPackages dflags - -#elif !(__GLASGOW_HASKELL__ >= 711) - -getPackageName :: DynFlags -> PackageKey -> String -getPackageName dflags - = maybe "" ((\(PackageName n) -> unpackFS n) . packageName) - . lookupPackage dflags - -modulePackageName :: DynFlags -> Module -> String -modulePackageName dflags - = getPackageName dflags . modulePackageKey - -getPackageVersion :: DynFlags -> PackageKey -> Maybe Version -getPackageVersion dflags - = fmap (convertVersion . packageVersion) - . lookupPackage dflags - -getPackageLibDirs :: DynFlags -> PackageKey -> [FilePath] -getPackageLibDirs dflags - = maybe [] libraryDirs . lookupPackage dflags - -getPackageHsLibs :: DynFlags -> PackageKey -> [String] -getPackageHsLibs dflags - = maybe [] hsLibraries . lookupPackage dflags - -searchModule :: DynFlags -> ModuleName -> [(String, PackageKey)] -searchModule dflags - = map ((\k -> (getPackageName dflags k, k)) . packageKey . snd) --- $ fromLookupResult --- $ lookupModuleWithSuggestions dflags mn Nothing - . lookupModuleInAllPackages dflags -{- -fromLookupResult :: LookupResult -> [(Module, PackageConfig)] -fromLookupResult (LookupFound m c) = [(m,c)] -fromLookupResult (LookupMultiple ms) = concatMap fromModuleOrigin ms -fromLookupResult (LookupHidden phs mhs) = concatMap fromModuleOrigin (phs ++ mhs) - -fromModuleOrigin :: (Module, ModuleOrigin) -> [(Module, PackageConfig)] -fromModuleOrigin (m, mo) = case mo of - -} -#else type PackageKey = UnitId -packageKeyString :: PackageKey -> String +packageKeyString :: UnitId -> String packageKeyString = unitIdString -modulePackageKey :: Module -> PackageKey +modulePackageKey :: Module -> UnitId modulePackageKey = moduleUnitId -stringToPackageKey :: String -> PackageKey -stringToPackageKey = stringToUnitId +stringToPackageKey :: String -> InstalledUnitId +stringToPackageKey = stringToInstalledUnitId -primPackageKey :: PackageKey +primPackageKey :: UnitId primPackageKey = primUnitId -mainPackageKey :: PackageKey +mainPackageKey :: UnitId mainPackageKey = mainUnitId -getPackageName :: DynFlags -> PackageKey -> String +getPackageName :: DynFlags -> UnitId -> String getPackageName dflags = maybe "" ((\(PackageName n) -> unpackFS n) . packageName) . lookupPackage dflags +getInstalledPackageName :: DynFlags -> InstalledUnitId -> String +getInstalledPackageName dflags + = maybe "" ((\(PackageName n) -> unpackFS n) . packageName) + . lookupInstalledPackage dflags + modulePackageName :: DynFlags -> Module -> String modulePackageName dflags = getPackageName dflags . moduleUnitId -getPackageVersion :: DynFlags -> PackageKey -> Maybe Version +getPackageVersion :: DynFlags -> UnitId -> Maybe Version getPackageVersion dflags = fmap (convertVersion . packageVersion) . lookupPackage dflags -getPackageLibDirs :: DynFlags -> PackageKey -> [FilePath] +getInstalledPackageVersion :: DynFlags -> InstalledUnitId -> Maybe Version +getInstalledPackageVersion dflags + = fmap (convertVersion . packageVersion) + . lookupInstalledPackage dflags + +getPackageLibDirs :: DynFlags -> UnitId -> [FilePath] getPackageLibDirs dflags = maybe [] libraryDirs . lookupPackage dflags -getPackageHsLibs :: DynFlags -> PackageKey -> [String] +getInstalledPackageLibDirs :: DynFlags -> InstalledUnitId -> [FilePath] +getInstalledPackageLibDirs dflags + = maybe [] libraryDirs . lookupInstalledPackage dflags + +getPackageHsLibs :: DynFlags -> UnitId -> [String] getPackageHsLibs dflags = maybe [] hsLibraries . lookupPackage dflags -searchModule :: DynFlags -> ModuleName -> [(String, PackageKey)] +getInstalledPackageHsLibs :: DynFlags -> InstalledUnitId -> [String] +getInstalledPackageHsLibs dflags + = maybe [] hsLibraries . lookupInstalledPackage dflags + +searchModule :: DynFlags -> ModuleName -> [(String, UnitId)] searchModule dflags - = map ((\k -> (getPackageName dflags k, k)) . unitId . snd) + = map ((\k -> (getPackageName dflags k, k)) . moduleUnitId . fst) -- $ fromLookupResult -- $ lookupModuleWithSuggestions dflags mn Nothing . lookupModuleInAllPackages dflags - -#endif diff --git a/src/Compiler/GhcjsHooks.hs b/src/Compiler/GhcjsHooks.hs index 65caa15b..11d6fc84 100644 --- a/src/Compiler/GhcjsHooks.hs +++ b/src/Compiler/GhcjsHooks.hs @@ -1,4 +1,10 @@ -{-# language CPP, GADTs, ScopedTypeVariables, ImpredicativeTypes, OverloadedStrings, TupleSections #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs, + ScopedTypeVariables, + ImpredicativeTypes, + OverloadedStrings, + TupleSections + #-} module Compiler.GhcjsHooks where import CorePrep (corePrepPgm) @@ -185,11 +191,12 @@ runGhcjsPhase _ _ (RealPhase ph) input _dflags `catchIOError` \_ -> return () return (RealPhase next, output) where -#if MIN_VERSION_ghc(7,8,3) - skipPhases = [ (CmmCpp, Cmm), (Cmm, As False), (Cmm, As True), (As False, StopLn), (As True, StopLn) ] -#else - skipPhases = [ (CmmCpp, Cmm), (Cmm, As), (As, StopLn) ] -#endif + skipPhases = [ (CmmCpp, Cmm) + , (Cmm, As False) + , (Cmm, As True) + , (As False, StopLn) + , (As True, StopLn) + ] -- otherwise use default runGhcjsPhase _ _ p input dflags = runPhase p input dflags @@ -236,11 +243,7 @@ ghcjsCompileModule settings jsEnv env core mod = do cms = compiledModules jsEnv dflags = hsc_dflags env compile = do -#if __GLASGOW_HASKELL__ < 709 - core_binds <- corePreppgm dflags env (cg_binds core) (cg_tycons core) -#else core_binds <- corePrepPgm env mod' (ms_location mod) (cg_binds core) (cg_tycons core) -#endif - stg <- coreToStg dflags mod' core_binds + let stg = coreToStg dflags mod' core_binds (stg', cCCs) <- stg2stg dflags mod' stg return $ variantRender gen2Variant settings dflags mod' stg' cCCs diff --git a/src/Compiler/GhcjsProgram.hs b/src/Compiler/GhcjsProgram.hs old mode 100755 new mode 100644 index 266a2468..b4a2671e --- a/src/Compiler/GhcjsProgram.hs +++ b/src/Compiler/GhcjsProgram.hs @@ -33,6 +33,7 @@ import BasicTypes (Boxity(..)) import TcTypeNats import TysWiredIn import TysPrim +import NameCache #endif import Control.Applicative @@ -363,8 +364,8 @@ generateLib _settings = do dflags1 <- getSessionDynFlags liftIO $ do (dflags2, pkgs0) <- initPackages dflags1 - let pkgs = catMaybes $ map (\p -> fmap (T.pack (getPackageName dflags2 p),) - (getPackageVersion dflags2 p)) + let pkgs = catMaybes $ map (\p -> fmap (T.pack (getInstalledPackageName dflags2 p),) + (getInstalledPackageVersion dflags2 p)) pkgs0 base = getDataDir (getLibDir dflags2) "shims" pkgs' :: [(T.Text, Version)] @@ -444,7 +445,18 @@ ghcjsCleanupHandler :: (ExceptionMonad m, MonadIO m) => DynFlags -> GhcjsEnv -> m a -> m a ghcjsCleanupHandler dflags env inner = defaultCleanupHandler dflags inner `gfinally` - (liftIO $ Gen2.finishTHAll env) + (liftIO $ do + runners <- readMVar (thRunners env) + forM_ (M.assocs runners) $ \(m,r) -> + getProcessExitCode (thrProcess r) >>= \case + Just _ -> return () + Nothing -> + (timeout 2000000 (Gen2.finishTh env m r) >>= + maybe (terminate r) return) + `catch` \(_::SomeException) -> terminate r + ) + where + terminate r = terminateProcess (thrProcess r) `catch` \(_::SomeException) -> return () runGhcjsSession :: Maybe FilePath -- ^ Directory with library files, -- like GHC's -B argument diff --git a/src/Compiler/Info.hs b/src/Compiler/Info.hs index 33a401f7..1282e90c 100644 --- a/src/Compiler/Info.hs +++ b/src/Compiler/Info.hs @@ -1,7 +1,6 @@ -{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings, LambdaCase #-} +{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-} module Compiler.Info where -import Control.Applicative import qualified Control.Exception as E import Data.Function (on) @@ -39,7 +38,8 @@ compilerInfo :: Bool compilerInfo nativeToo dflags = do let topDir = getTopDir dflags nubBy ((==) `on` fst) $ - [ ("Project name" , "The Glorious Glasgow Haskell Compilation System for JavaScript") + [ ("Project name" + , "The Glorious Glasgow Haskell Compilation System for JavaScript") , ("Global Package DB", getGlobalPackageDB topDir) , ("Project version" , getCompilerVersion) , ("LibDir" , topDir) @@ -72,7 +72,7 @@ getTopDir = sTopDir . settings -- | get the library directory (ghcjs --print-libdir). getLibDir :: DynFlags -> FilePath -getLibDir = {- ("lib") . -} sTopDir . settings +getLibDir = sTopDir . settings {- | get the library directory from the unsafe global DynFlags throws an exception if called before a Ghc session has been started @@ -86,10 +86,10 @@ getGlobalPackageDB :: FilePath getGlobalPackageDB libDir = libDir "package.conf.d" getUserTopDir :: IO (Maybe FilePath) -getUserTopDir = fmap Just getUserTopDir' `E.catch` +getUserTopDir = fmap Just getUserTopDir' `E.catch` \(E.SomeException _) -> return Nothing -getUserTopDir' :: IO FilePath -- (Maybe FilePath) +getUserTopDir' :: IO FilePath getUserTopDir' = ( subdir) <$> getAppUserDataDirectory "ghcjs" where targetARCH = arch @@ -112,7 +112,9 @@ getGhcCompilerVersion = cProjectVersion -- | GHCJS-GHC getFullCompilerVersion :: [Char] -getFullCompilerVersion = Version.showVersion Paths_ghcjs.version ++ "-" ++ getGhcCompilerVersion +getFullCompilerVersion = Version.showVersion Paths_ghcjs.version ++ + "-" ++ + getGhcCompilerVersion -- | Just the GHCJS version getCompilerVersion :: String @@ -166,7 +168,8 @@ getFullArguments = do True -> getOptionArgs o False -> addArgs os exists <- doesFileExist (exe) - when (not exists) (error $ "could not determine executable location: " ++ exe) + when (not exists) + (panic $ "could not determine executable location: " ++ exe) (++) <$> addArgs opts <*> getArgs getOptionArgs :: FilePath -> IO [String] @@ -176,7 +179,8 @@ getOptionArgs file = do where f env line | "#" == (take 1 . dropWhile isSpace $ line) = Nothing | all isSpace line = Nothing - | otherwise = Just (T.unpack $ substPatterns [] env (T.pack line)) + | otherwise = + Just (T.unpack $ substPatterns [] env (T.pack line)) #else getFullArguments = getArgs #endif diff --git a/src/Compiler/JMacro.hs b/src/Compiler/JMacro.hs index 146689a5..88b1927b 100644 --- a/src/Compiler/JMacro.hs +++ b/src/Compiler/JMacro.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE PackageImports #-} {- | Module : Language.Javascript.JMacro Copyright : (c) Gershom Bazerman, 2010 @@ -60,7 +61,7 @@ Meanwhile, the above lambda is in Javascript, and brings the variable into scope Other than that, the language is essentially Javascript (1.5). Note however that one must use semicolons in a principled fashion -- i.e. to end statements consistently. Otherwise, the parser will mistake the whitespace for a whitespace application, and odd things will occur. A further gotcha exists in regex literals, whicch cannot begin with a space. @x / 5 / 4@ parses as ((x / 5) / 4). However, @x /5 / 4@ will parse as x(/5 /, 4). Such are the perils of operators used as delimeters in the presence of whitespace application. -Additional features in jmacro (documented on the wiki) include an infix application operator, and an enhanced destructuring bind. +Additional features in jmacro (documented on the wiki) include an infix application operator, and an enhanced destructuring bind. Additional datatypes can be marshalled to Javascript by proper instance declarations for the ToJExpr class. @@ -76,7 +77,7 @@ module Compiler.JMacro ( j, je ) where -import Language.Haskell.TH.Quote (QuasiQuoter) +import "template-haskell" Language.Haskell.TH.Quote (QuasiQuoter) import Compiler.JMacro.Base hiding (expr2stat) import Compiler.JMacro.QQ @@ -88,4 +89,3 @@ j = jmacro je :: QuasiQuoter je = jmacroE - diff --git a/src/Compiler/JMacro/Base.hs b/src/Compiler/JMacro/Base.hs index a8ebdf2f..c57052e2 100644 --- a/src/Compiler/JMacro/Base.hs +++ b/src/Compiler/JMacro/Base.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances, OverloadedStrings, TypeFamilies, RankNTypes, DeriveDataTypeable, StandaloneDeriving, FlexibleContexts, TypeSynonymInstances, ScopedTypeVariables, GADTs, GeneralizedNewtypeDeriving, BangPatterns, DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverloadedStrings, TypeFamilies, RankNTypes, DeriveDataTypeable, FlexibleContexts, TypeSynonymInstances, ScopedTypeVariables, GADTs, GeneralizedNewtypeDeriving, BangPatterns, DeriveGeneric #-} ----------------------------------------------------------------------------- {- | @@ -38,7 +38,7 @@ module Compiler.JMacro.Base ( jsSaturate, SaneDouble(..) ) where import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read) -import Control.Applicative hiding (empty) +-- import Control.Applicative hiding (empty) import Control.Arrow (second, (***)) import Control.DeepSeq import Control.Monad.State.Strict @@ -317,22 +317,18 @@ class JMacro a where instance JMacro Ident where jtoGADT = JMGId jfromGADT (JMGId x) = x - jfromGADT _ = error "impossible" instance JMacro JStat where jtoGADT = JMGStat jfromGADT (JMGStat x) = x - jfromGADT _ = error "impossible" instance JMacro JExpr where jtoGADT = JMGExpr jfromGADT (JMGExpr x) = x - jfromGADT _ = error "impossible" instance JMacro JVal where jtoGADT = JMGVal jfromGADT (JMGVal x) = x - jfromGADT _ = error "impossible" -- | Union type to allow regular traversal by compos. data JMGadt a where @@ -503,7 +499,7 @@ withHygiene_ un f x = jfromGADT $ case jtoGADT x of JMGVal _ -> jtoGADT $ UnsatVal (jsUnsat_ is' x'') JMGId _ -> jtoGADT $ f x where - (x', (TxtI l : _)) = runState (runIdentSupply $ jsSaturate_ x) is + (x', (TxtI l : _)) = runState (runIdentSupply $ jsSaturate_ x) is is' = take lastVal is x'' = f x' lastVal = readNote ("inSat" ++ T.unpack un) (reverse . takeWhile (/= '_') . reverse $ T.unpack l) :: Int @@ -888,5 +884,3 @@ encodeJsonChar c where hexxs prefix pad cp = let h = showHex cp "" in T.pack (prefix ++ replicate (pad - length h) '0' ++ h) - - diff --git a/src/Compiler/JMacro/ParseTH.hs b/src/Compiler/JMacro/ParseTH.hs index 5b249f44..fc73aa25 100644 --- a/src/Compiler/JMacro/ParseTH.hs +++ b/src/Compiler/JMacro/ParseTH.hs @@ -1,7 +1,8 @@ +{-# LANGUAGE PackageImports #-} module Compiler.JMacro.ParseTH (parseHSExp) where import Language.Haskell.Meta.Parse -import qualified Language.Haskell.TH as TH +import qualified "template-haskell" Language.Haskell.TH as TH -- import Language.Haskell.Exts.Translate -- import Language.Haskell.Exts.Parser -- import Language.Haskell.Exts.Extension diff --git a/src/Compiler/JMacro/QQ.hs b/src/Compiler/JMacro/QQ.hs index e7bd2979..84947392 100644 --- a/src/Compiler/JMacro/QQ.hs +++ b/src/Compiler/JMacro/QQ.hs @@ -1,5 +1,16 @@ -{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances, TypeFamilies, TemplateHaskell, QuasiQuotes, RankNTypes, GADTs, OverloadedStrings, PatternGuards #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleInstances, + UndecidableInstances, + TypeFamilies, + TemplateHaskell, + QuasiQuotes, + RankNTypes, + GADTs, + OverloadedStrings, + PatternGuards, + ScopedTypeVariables, + PackageImports + #-} + ----------------------------------------------------------------------------- {- | Module : Language.Javascript.JMacro @@ -15,7 +26,6 @@ Simple EDSL for lightweight (untyped) programmatic generation of Javascript. module Compiler.JMacro.QQ (jmacro, jmacroE, parseJM, parseJME, expr2ident) where import Prelude hiding ((<*), tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read) -import Control.Applicative hiding ((<|>), many, optional, (<*)) import Control.Arrow (first) import Control.Lens ((^..)) import Control.Lens.Plated (rewriteOn) @@ -29,9 +39,9 @@ import Data.Monoid import qualified Data.Map as M import qualified Data.Text as T -import qualified Language.Haskell.TH as TH -import Language.Haskell.TH (mkName, appE) -import Language.Haskell.TH.Quote +import qualified "template-haskell" Language.Haskell.TH as TH +import "template-haskell" Language.Haskell.TH (mkName, appE) +import "template-haskell" Language.Haskell.TH.Quote import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Expr @@ -104,7 +114,7 @@ antiIdent :: JMacro a => String -> a -> a antiIdent s e = jfromGADT $ go (jtoGADT e) where go :: forall a. JMGadt a -> JMGadt a go (JMGStat (ForInStat b (TxtI s') e' st)) - | s == T.unpack s' = JMGStat (ForInStat b (TxtI ("jmId_anti_" <> s')) + | s == T.unpack s' = JMGStat (ForInStat b (TxtI ("jmId_anti_" <> s')) (antiIdent s e') (antiIdent s st)) go (JMGExpr (ValExpr (JVar (TxtI s')))) | s == T.unpack s' = JMGExpr (AntiExpr . T.pack . fixIdent $ s) diff --git a/src/Compiler/Plugins.hs b/src/Compiler/Plugins.hs index bb7ae092..0b21ae61 100644 --- a/src/Compiler/Plugins.hs +++ b/src/Compiler/Plugins.hs @@ -90,6 +90,8 @@ import RdrName import SrcLoc import TcRnMonad +import Unsafe.Coerce + getValueSafely :: DynFlags -> GhcjsEnv -> HscEnv -> Name -> Type -> IO (Maybe a) getValueSafely orig_dflags js_env hsc_env val_name expected_type = do @@ -98,6 +100,7 @@ getValueSafely orig_dflags js_env hsc_env val_name expected_type = do Nothing -> return Nothing Just hval -> do value <- lessUnsafeCoerce dflags "getValueSafely" hval + -- let value = unsafeCoerce hval return (Just value) where dflags = hsc_dflags hsc_env @@ -162,18 +165,25 @@ remapName src_env tgt_env val_name sdf = hsc_dflags src_env tdf = hsc_dflags tgt_env -remapUnit :: DynFlags -> DynFlags -> ModuleName -> UnitId -> Maybe UnitId +remapUnit :: DynFlags + -> DynFlags + -> ModuleName + -> UnitId + -> Maybe UnitId remapUnit src_dflags tgt_dflags module_name unit -- first try package with same unit id if possible | Just _ <- lookupPackage tgt_dflags unit = Just unit -- if we're building the package, then we don't have a PackageConfig for it | unit == thisPackage tgt_dflags - , tgt_config:_ <- searchPackageId tgt_dflags (SourcePackageId . mkFastString . unitToPkg . unitIdString $ unit) = - Just (unitId tgt_config) + , tgt_config:_ <- searchPackageId tgt_dflags (SourcePackageId . mkFastString . unitToPkg . unitIdString $ unit) + , Just m <- lookup module_name (instantiatedWith tgt_config) = + Just (moduleUnitId m) -- otherwise look up package with same package id (e.g. foo-0.1) | Just src_config <- lookupPackage src_dflags unit - , tgt_config:_ <- searchPackageId tgt_dflags (sourcePackageId src_config) = - Just (unitId tgt_config) + , tgt_config:_ <- searchPackageId tgt_dflags (sourcePackageId src_config) + , Just m <- lookup module_name (instantiatedWith tgt_config) + = Just (moduleUnitId m) + -- Just (unitId tgt_config) | otherwise = Nothing initPluginsEnv :: DynFlags -> Maybe HscEnv -> IO (Maybe HscEnv, HscEnv) @@ -187,7 +197,8 @@ initPluginsEnv orig_dflags _ = do dflags1 = gopt_unset dflags0 Opt_HideAllPackages dflags2 = updateWays $ dflags1 { packageFlags = [] -- filterPackageFlags (packageFlags dflags1) - , extraPkgConfs = filterPackageConfs . extraPkgConfs dflags1 + -- , extraPkgConfs = filterPackageConfs . extraPkgConfs dflags1 + , packageDBFlags = filterPackageDBFlags . packageDBFlags $ dflags1 , ways = filter (/= WayCustom "js") (ways dflags1) , hiSuf = removeJsPrefix (hiSuf dflags1) , dynHiSuf = removeJsPrefix (dynHiSuf dflags1) @@ -216,8 +227,15 @@ unitToPkg xs | ('-':ys) <- dropWhile (/='-') (reverse xs) = reverse ys | otherwise = xs -filterPackageConfs :: [PkgConfRef] -> [PkgConfRef] -filterPackageConfs = mapMaybe fixPkgConf +filterPackageDBFlags :: [PackageDBFlag] -> [PackageDBFlag] +filterPackageDBFlags = mapMaybe f + where + f (PackageDB pcr) = PackageDB <$> filterPackageConfs pcr + f x = Just x + + +filterPackageConfs :: PkgConfRef -> Maybe PkgConfRef -- [PkgConfRef] -> [PkgConfRef] +filterPackageConfs = fixPkgConf -- mapMaybe fixPkgConf where dtu '.' = '_' dtu x = x diff --git a/src/Compiler/Program.hs b/src/Compiler/Program.hs index 67192874..df13c5e9 100644 --- a/src/Compiler/Program.hs +++ b/src/Compiler/Program.hs @@ -37,6 +37,14 @@ import DriverMkDepend ( doMkDependHS ) import InteractiveUI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings ) #endif +-- Frontend plugins +-- #ifdef GHCI +import DynamicLoading ( loadFrontendPlugin ) +import Plugins +-- #else +-- import DynamicLoading ( pluginError ) +-- #endif +import Module ( ModuleName ) -- Various other random stuff that we need import Config @@ -49,7 +57,6 @@ import Packages ( dumpPackages ) #endif import DriverPhases import BasicTypes ( failed ) -import StaticFlags import DynFlags import ErrUtils import FastString @@ -63,12 +70,14 @@ import MonadUtils ( liftIO ) -- Imports for --abi-hash import LoadIface ( loadUserInterface ) import Module ( mkModuleName ) -import Finder ( findImportedModule, cannotFindInterface ) +import Finder ( findImportedModule, cannotFindModule ) import TcRnMonad ( initIfaceCheck ) -import Binary ( openBinMem, put_, fingerprintBinMem ) +import Binary ( openBinMem, put_) +import BinFingerprint ( fingerprintBinMem ) -- Standard Haskell libraries import System.IO +import System.Environment import System.Exit import System.FilePath import Control.Monad @@ -90,8 +99,22 @@ import Data.Maybe main :: IO () main = do + initGCStatistics -- See Note [-Bsymbolic and hooks] hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering + + -- Handle GHC-specific character encoding flags, allowing us to control how + -- GHC produces output regardless of OS. + env <- getEnvironment + case lookup "GHC_CHARENC" env of + Just "UTF-8" -> do + hSetEncoding stdout utf8 + hSetEncoding stderr utf8 + _ -> do + -- Avoid GHC erroring out when trying to display unhandled characters + hSetTranslit stdout + hSetTranslit stderr + Ghcjs.ghcjsErrorHandler defaultFatalMessager defaultFlushOut $ do -- 1. extract the -B flag from the args (argv0, booting, booting_stage1) <- Ghcjs.getWrappedArgs @@ -101,18 +124,15 @@ main = do | otherwise = Just (drop 2 (last minusB_args)) argv1' = map (mkGeneralLocated "on the commandline") argv1 when (any (== "--run") argv1) (Ghcjs.runJsProgram mbMinusB argv1) - (argv1'', ghcjsSettings) <- Ghcjs.getGhcjsSettings argv1' + + (argv2, ghcjsSettings) <- Ghcjs.getGhcjsSettings argv1' -- fall back to native GHC if we're booting (we can't build Setup.hs with GHCJS yet) when (booting_stage1 && Ghcjs.gsBuildRunner ghcjsSettings) Ghcjs.bootstrapFallback - (argv2, staticFlagWarnings) <- parseStaticFlags argv1'' - -- 2. Parse the "mode" flags (--make, --interactive etc.) - (mode, argv3, modeFlagWarnings) <- parseModeFlags argv2 - - let flagWarnings = staticFlagWarnings ++ modeFlagWarnings + (mode, argv3, flagWarnings) <- parseModeFlags argv2 -- If all we want to do is something like showing the version number -- then do it now, before we start a GHC session etc. This makes @@ -263,13 +283,6 @@ main' postLoadMode dflags0 args flagWarnings ghcjsSettings native = do | v >= 5 -> liftIO $ dumpPackages dflags6 | otherwise -> return () - when (verbosity dflags6 >= 3) $ do - liftIO $ hPutStrLn stderr ("Hsc static flags: " ++ unwords staticFlags) - - when (dopt Opt_D_dump_mod_map dflags6) . liftIO $ - printInfoForUser (dflags6 { pprCols = 200 }) - (pkgQual dflags6) (pprModuleMap dflags6) - liftIO $ initUniqSupply (initialUnique dflags6) (uniqueIncrement dflags6) ---------------- Final sanity checking ----------- liftIO $ checkOptions ghcjsSettings postLoadMode dflags6 srcs objs (js_objs ++ Ghcjs.gsJsLibSrcs ghcjsSettings) @@ -289,7 +302,7 @@ main' postLoadMode dflags0 args flagWarnings ghcjsSettings native = do StopBefore p -> phaseMsg >> liftIO (Ghcjs.ghcjsOneShot jsEnv ghcjsSettings native hsc_env p srcs) >> return False DoInteractive -> ghciUI srcs Nothing >> return True DoEval exprs -> (ghciUI srcs $ Just $ reverse exprs) >> return True - DoAbiHash -> abiHash srcs >> return True + DoAbiHash -> abiHash (map fst srcs) >> return True ShowPackages -> liftIO $ showPackages dflags6 >> return True DoGenerateLib -> Ghcjs.generateLib ghcjsSettings >> return True DoPrintRts -> liftIO (Ghcjs.printRts dflags6) >> return True @@ -861,17 +874,9 @@ showOptions isInteractive = putStr (unlines availableOptions) where availableOptions = concat [ flagsForCompletion isInteractive, - map ('-':) (concat [ - getFlagNames mode_flags - , (filterUnwantedStatic . getFlagNames $ flagsStatic) - , flagsStaticNames - ]) + map ('-':) (getFlagNames mode_flags) ] - getFlagNames opts = map flagName opts - -- this is a hack to get rid of two unwanted entries that get listed - -- as static flags. Hopefully this hack will disappear one day together - -- with static flags - filterUnwantedStatic = filter (`notElem`["f", "fno-"]) + getFlagNames opts = map flagName opts showGhcUsage :: DynFlags -> IO () showGhcUsage = showUsage False @@ -929,6 +934,20 @@ showPackages dflags = putStrLn (showSDoc dflags (pprPackages dflags)) dumpPackages dflags = putMsg dflags (pprPackages dflags) dumpPackagesSimple dflags = putMsg dflags (pprPackagesSimple dflags) +-- ----------------------------------------------------------------------------- +-- Frontend plugin support + +doFrontend :: ModuleName -> [(String, Maybe Phase)] -> Ghc () +-- #ifndef GHCI +-- doFrontend modname _ = pluginError [modname] +-- #else +doFrontend modname srcs = do + hsc_env <- getSession + frontend_plugin <- liftIO $ loadFrontendPlugin hsc_env modname + frontend frontend_plugin + (reverse $ frontendPluginOpts (hsc_dflags hsc_env)) srcs +-- #endif + -- ----------------------------------------------------------------------------- -- ABI hash support @@ -945,7 +964,13 @@ the package chagnes, so during registration Cabal calls ghc --abi-hash to get a hash of the package's ABI. -} -abiHash :: [(String, Maybe Phase)] -> Ghc () +-- | Print ABI hash of input modules. +-- +-- The resulting hash is the MD5 of the GHC version used (Trac #5328, +-- see 'hiVersion') and of the existing ABI hash from each module (see +-- 'mi_mod_hash'). +abiHash :: [String] -- ^ List of module names + -> Ghc () abiHash strs = do hsc_env <- getSession let dflags = hsc_dflags hsc_env @@ -958,12 +983,12 @@ abiHash strs = do case r of Found _ m -> return m _error -> throwGhcException $ CmdLineError $ showSDoc dflags $ - cannotFindInterface dflags modname r + cannotFindModule dflags modname r - mods <- mapM find_it (map fst strs) + mods <- mapM find_it strs let get_iface modl = loadUserInterface False (text "abiHash") modl - ifaces <- initIfaceCheck hsc_env $ mapM get_iface mods + ifaces <- initIfaceCheck (text "abiHash") hsc_env $ mapM get_iface mods bh <- openBinMem (3*1024) -- just less than a block put_ bh hiVersion @@ -982,6 +1007,39 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs where oneError f = "unrecognised flag: " ++ f ++ "\n" ++ - (case fuzzyMatch f (nub allNonDeprecatedFlags) of + (case match f (nubSort allNonDeprecatedFlags) of [] -> "" suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) + -- fixes #11789 + -- If the flag contains '=', + -- this uses both the whole and the left side of '=' for comparing. + match f allFlags + | elem '=' f = + let (flagsWithEq, flagsWithoutEq) = partition (elem '=') allFlags + fName = takeWhile (/= '=') f + in (fuzzyMatch f flagsWithEq) ++ (fuzzyMatch fName flagsWithoutEq) + | otherwise = fuzzyMatch f allFlags + +{- Note [-Bsymbolic and hooks] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-Bsymbolic is a flag that prevents the binding of references to global +symbols to symbols outside the shared library being compiled (see `man +ld`). When dynamically linking, we don't use -Bsymbolic on the RTS +package: that is because we want hooks to be overridden by the user, +we don't want to constrain them to the RTS package. + +Unfortunately this seems to have broken somehow on OS X: as a result, +defaultHooks (in hschooks.c) is not called, which does not initialize +the GC stats. As a result, this breaks things like `:set +s` in GHCi +(#8754). As a hacky workaround, we instead call 'defaultHooks' +directly to initalize the flags in the RTS. + +A byproduct of this, I believe, is that hooks are likely broken on OS +X when dynamically linking. But this probably doesn't affect most +people since we're linking GHC dynamically, but most things themselves +link statically. +-} + +-- foreign import ccall safe "initGCStatistics" +-- initGCStatistics :: IO () +initGCStatistics = pure () diff --git a/src/Compiler/Settings.hs b/src/Compiler/Settings.hs old mode 100755 new mode 100644 index ed77f6df..0a280215 --- a/src/Compiler/Settings.hs +++ b/src/Compiler/Settings.hs @@ -1,6 +1,4 @@ {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} module Compiler.Settings where @@ -12,36 +10,21 @@ import qualified Control.Exception as E import Control.Concurrent.MVar import Control.Monad -import Data.Aeson import Data.ByteString (ByteString) -import qualified Data.ByteString.Lazy as BL import Data.IntMap (IntMap) -import qualified Data.List as L import Data.Map (Map) import qualified Data.Map as M -import Data.Maybe -import Data.Monoid import Data.Set (Set) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Typeable - -import GHC.Generics +import Data.Monoid +import Data.Text (Text) -import System.Environment (getEnvironment) import System.IO import System.Process -import System.FilePath ((), searchPathSeparator - ,splitSearchPath) -import DynFlags import Module import TcRnTypes import ErrUtils import HscTypes -import Panic - -import qualified Compiler.Info as Info {- | We can link incrementally against a base bundle, where we assume that the symbols from the bundle and their dependencies have already @@ -119,8 +102,8 @@ instance Monoid GhcjsSettings where (jslsrc1 <> jslsrc2) (dd1 || dd2) -data THRunner = - THRunner { thrProcess :: ProcessHandle +data ThRunner = + ThRunner { thrProcess :: ProcessHandle , thrHandleIn :: Handle , thrHandleErr :: Handle , thrBase :: MVar Base @@ -133,33 +116,9 @@ data DepsLocation = ObjectFile FilePath | InMemory String ByteString deriving (Eq, Show) -data THRunnerState = THRunnerState - { activeRunners :: Map String THRunner - , idleRunners :: [THRunner] - } - -consIdleRunner :: THRunner -> THRunnerState -> THRunnerState -consIdleRunner r s = s { idleRunners = r : idleRunners s } - -unconsIdleRunner :: THRunnerState -> Maybe (THRunner, THRunnerState) -unconsIdleRunner s - | (r:xs) <- idleRunners s = Just (r, s { idleRunners = xs }) - | otherwise = Nothing - -deleteActiveRunner :: String -> THRunnerState -> THRunnerState -deleteActiveRunner m s = - s { activeRunners = M.delete m (activeRunners s) } - -insertActiveRunner :: String -> THRunner -> THRunnerState -> THRunnerState -insertActiveRunner m runner s = - s { activeRunners = M.insert m runner (activeRunners s) } - -emptyTHRunnerState :: THRunnerState -emptyTHRunnerState = THRunnerState mempty mempty - data GhcjsEnv = GhcjsEnv { compiledModules :: MVar (Map Module ByteString) -- ^ keep track of already compiled modules so we don't compile twice for dynamic-too - , thRunners :: MVar THRunnerState -- (Map String ThRunner) -- ^ template haskell runners + , thRunners :: MVar (Map String ThRunner) -- ^ template haskell runners , thSplice :: MVar Int , linkerArchiveDeps :: MVar (Map (Set FilePath) (Map (Object.Package, Text) @@ -171,7 +130,7 @@ data GhcjsEnv = GhcjsEnv newGhcjsEnv :: IO GhcjsEnv newGhcjsEnv = GhcjsEnv <$> newMVar M.empty - <*> newMVar emptyTHRunnerState + <*> newMVar M.empty <*> newMVar 0 <*> newMVar M.empty <*> newMVar Nothing @@ -180,40 +139,3 @@ newGhcjsEnv = GhcjsEnv <$> newMVar M.empty data LinkedObj = ObjFile FilePath -- load from this file | ObjLoaded String ByteString -- already loaded, description deriving (Eq, Ord, Show) - -data NodeSettings = NodeSettings - { nodeProgram :: FilePath -- ^ location of node.js program - , nodePath :: Maybe Text -- ^ value of NODE_PATH environment variable - , nodeExtraArgs :: [Text] -- ^ extra arguments to pass to node.js - , nodeKeepAliveMaxMem :: Integer -- ^ keep node.js (TH, GHCJSi) processes alive if they don't use more than this - } deriving (Eq, Ord, Show, Typeable, Generic) - -instance FromJSON NodeSettings -instance ToJSON NodeSettings - -readNodeSettings :: DynFlags -> IO NodeSettings -readNodeSettings dflags = do - contents <- BL.readFile (Info.getLibDir dflags "nodeSettings.json") - either panic pure (eitherDecode' contents) - -runNodeInteractive :: DynFlags - -> Maybe FilePath - -> FilePath - -> IO (Handle, Handle, Handle, ProcessHandle) -runNodeInteractive dflags mbWorkingDir src = do - putStrLn "runNodeInteractive" - nodeSettings <- readNodeSettings dflags - env0 <- getEnvironment - let ghcjsNodePath = topDir dflags "ghcjs-node" "node_modules" - addGhcjsNodePath origNodePath = - L.intercalate (searchPathSeparator:[]) - (ghcjsNodePath:splitSearchPath origNodePath) - nodePath = maybe ghcjsNodePath - addGhcjsNodePath - (L.lookup "NODE_PATH" env0) - env1 = [("NODE_PATH", nodePath)] ++ filter ((/="NODE_PATH") . fst) env0 - runInteractiveProcess - (nodeProgram nodeSettings) - (map T.unpack (nodeExtraArgs nodeSettings) ++ [src]) - mbWorkingDir - (Just env1) diff --git a/src/Compiler/Variants.hs b/src/Compiler/Variants.hs index f42c36c4..d9700175 100644 --- a/src/Compiler/Variants.hs +++ b/src/Compiler/Variants.hs @@ -16,14 +16,14 @@ import qualified Gen2.Object as Gen2 import CostCentre (CollectedCCs) import DynFlags (DynFlags) -import Module (Module (..)) -import StgSyn (StgBinding) +import Module (Module (..), InstalledUnitId) +import StgSyn (StgBinding, StgTopBinding) data Variant = Variant { variantRender :: GhcjsSettings -> DynFlags -> Module - -> StgPgm + -> [StgTopBinding] -> CollectedCCs -> ByteString , variantLink :: DynFlags @@ -31,7 +31,7 @@ data Variant = Variant -> GhcjsSettings -> FilePath -- output directory -> [FilePath] -- include paths for home package - -> [PackageKey] -- dependencies + -> [InstalledUnitId] -- dependencies -> [LinkedObj] -- object files -> [FilePath] -- extra JavaScript files -> (Gen2.Fun -> Bool) -- function to use as roots diff --git a/src/Gen2/Base.hs b/src/Gen2/Base.hs index 94be2ae5..69df9459 100644 --- a/src/Gen2/Base.hs +++ b/src/Gen2/Base.hs @@ -1,4 +1,7 @@ -{-# LANGUAGE TemplateHaskell, OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell, + OverloadedStrings, + TupleSections + #-} {- A base bundle is used for incremental linking. it contains information about the symbols that have already been linked. These symbols are not included @@ -14,6 +17,7 @@ import qualified Gen2.Object as Object import Compiler.JMacro import Control.Applicative +import Control.Arrow import Control.Lens import Control.Monad @@ -21,6 +25,7 @@ import Data.Array import qualified Data.Binary as DB import qualified Data.Binary.Get as DB import qualified Data.Binary.Put as DB +import Data.Hashable import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS @@ -30,9 +35,14 @@ import Data.Set (Set) import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T +import Data.ByteString (ByteString) + +import Panic newLocals :: [Ident] -newLocals = filter (not . isKeyword) $ map (TxtI . T.pack) $ (map (:[]) chars0) ++ concatMap mkIdents [1..] +newLocals = filter (not . isKeyword) $ + map (TxtI . T.pack) $ + (map (:[]) chars0) ++ concatMap mkIdents [1..] where mkIdents n = [c0:cs | c0 <- chars0, cs <- replicateM n chars] chars0 = ['a'..'z']++['A'..'Z'] @@ -44,8 +54,10 @@ newLocals = filter (not . isKeyword) $ map (TxtI . T.pack) $ (map (:[]) chars0) , "function", "if", "in", "instanceof", "new", "return" , "switch", "this", "throw", "try", "typeof", "var", "void" , "while", "with" - , "class", "enum", "export", "extends", "import", "super", "const" - , "implements", "interface", "let", "package", "private", "protected" + , "class", "enum", "export", "extends", "import", "super" + , "const" + , "implements", "interface", "let", "package", "private" + , "protected" , "public", "static", "yield" , "null", "true", "false" ] @@ -53,24 +65,56 @@ newLocals = filter (not . isKeyword) $ map (TxtI . T.pack) $ (map (:[]) chars0) renamedVars :: [Ident] renamedVars = map (\(TxtI xs) -> TxtI ("h$$"<>xs)) newLocals -data CompactorState = - CompactorState { _identSupply :: [Ident] -- ^ ident supply for new names - , _nameMap :: !(HashMap Text Ident) -- ^ renaming mapping for internal names - , _entries :: !(HashMap Text Int) -- ^ entry functions (these get listed in the metadata init array) - , _numEntries :: !Int - , _statics :: !(HashMap Text Int) -- ^ mapping of global closure -> index in current block, for static initialisation - , _numStatics :: !Int -- ^ number of static entries - , _labels :: !(HashMap Text Int) -- ^ non-Haskell JS labels - , _numLabels :: !Int -- ^ number of labels - , _parentEntries :: !(HashMap Text Int) -- ^ entry functions we're not linking, offset where parent gets [0..n], grantparent [n+1..k] etc - , _parentStatics :: !(HashMap Text Int) -- ^ objects we're not linking in base bundle - , _parentLabels :: !(HashMap Text Int) -- ^ non-Haskell JS labels in parent - } deriving (Show) +data CompactorState = CompactorState + { _identSupply :: [Ident] -- ^ ident supply for new names + , _nameMap :: !(HashMap Text Ident) -- ^ renaming mapping for internal names + , _entries :: !(HashMap Text Int) -- ^ entry functions (these get listed in the metadata init array) + , _numEntries :: !Int + , _statics :: !(HashMap Text Int) -- ^ mapping of global closure -> index in current block, for static initialisation + , _numStatics :: !Int -- ^ number of static entries + , _labels :: !(HashMap Text Int) -- ^ non-Haskell JS labels + , _numLabels :: !Int -- ^ number of labels + , _parentEntries :: !(HashMap Text Int) -- ^ entry functions we're not linking, offset where parent gets [0..n], grandparent [n+1..k] etc + , _parentStatics :: !(HashMap Text Int) -- ^ objects we're not linking in base bundle + , _parentLabels :: !(HashMap Text Int) -- ^ non-Haskell JS labels in parent + , _stringTable :: !StringTable + } deriving (Show) + +data StringTable = StringTable + { stTableIdents :: !(Array Int Text) + , stOffsets :: !(HashMap ByteString (Int, Int)) -- ^ content of the table + , stIdents :: !(HashMap Text (Either Int Int)) -- ^ identifiers in the table + } deriving (Show) + +instance DB.Binary StringTable where + put (StringTable tids offs idents) = do + DB.put tids + DB.put (HM.toList offs) + DB.put (HM.toList idents) + get = StringTable <$> DB.get + <*> fmap HM.fromList DB.get + <*> fmap HM.fromList DB.get + +emptyStringTable :: StringTable +emptyStringTable = StringTable (listArray (0,-1) []) + HM.empty + HM.empty makeLenses ''CompactorState emptyCompactorState :: CompactorState -emptyCompactorState = CompactorState renamedVars HM.empty HM.empty 0 HM.empty 0 HM.empty 0 HM.empty HM.empty HM.empty +emptyCompactorState = CompactorState renamedVars + HM.empty + HM.empty + 0 + HM.empty + 0 + HM.empty + 0 + HM.empty + HM.empty + HM.empty + emptyStringTable showBase :: Base -> String showBase b = unlines @@ -109,8 +153,9 @@ putBase (Base cs packages funs) = do modsM = M.fromList (zip mods [(0::Int)..]) putList f xs = pi (length xs) >> mapM_ f xs -- serialise the compactor state - putCs (CompactorState [] _ _ _ _ _ _ _ _ _ _) = error "putBase: putCs exhausted renamer symbol names" - putCs (CompactorState (ns:_) nm es _ ss _ ls _ pes pss pls) = do + putCs (CompactorState [] _ _ _ _ _ _ _ _ _ _ _) = + panic "putBase: putCs exhausted renamer symbol names" + putCs (CompactorState (ns:_) nm es _ ss _ ls _ pes pss pls sts) = do DB.put ns DB.put (HM.toList nm) DB.put (HM.toList es) @@ -119,6 +164,7 @@ putBase (Base cs packages funs) = do DB.put (HM.toList pes) DB.put (HM.toList pss) DB.put (HM.toList pls) + DB.put sts putPkg (Object.Package k) = DB.put k -- fixme group things first putFun (p,m,s) = pi (pkgsM M.! p) >> pi (modsM M.! m) >> DB.put s @@ -141,12 +187,26 @@ getBase file = getBase' pes <- HM.fromList <$> DB.get pss <- HM.fromList <$> DB.get pls <- HM.fromList <$> DB.get - return (CompactorState (dropWhile (/=n) renamedVars) nm es (HM.size es) ss (HM.size ss) ls (HM.size ls) pes pss pls) + sts <- DB.get + return (CompactorState (dropWhile (/=n) renamedVars) + nm + es + (HM.size es) + ss + (HM.size ss) + ls + (HM.size ls) + pes + pss + pls + sts) getBase' = do hdr <- DB.getByteString 9 - when (hdr /= "GHCJSBASE") (error $ "getBase: invalid base file: " <> file) + when (hdr /= "GHCJSBASE") + (panic $ "getBase: invalid base file: " <> file) vt <- DB.getLazyByteString (fromIntegral Object.versionTagLength) - when (vt /= Object.versionTag) (error $ "getBase: incorrect version: " <> file) + when (vt /= Object.versionTag) + (panic $ "getBase: incorrect version: " <> file) cs <- makeCompactorParent <$> getCs linkedPackages <- getList DB.get pkgs <- la <$> getList getPkg @@ -154,14 +214,19 @@ getBase file = getBase' funs <- getList (getFun pkgs mods) return (Base cs linkedPackages $ S.fromList funs) --- | make a base state from a CompactorState: empty the current symbols sets, move everything to --- the parent +-- | make a base state from a CompactorState: empty the current symbols sets, +-- move everything to the parent makeCompactorParent :: CompactorState -> CompactorState -makeCompactorParent (CompactorState is nm es nes ss nss ls nls pes pss pls) = - CompactorState is nm HM.empty 0 HM.empty 0 HM.empty 0 - (HM.union (fmap (+nes) pes) es) - (HM.union (fmap (+nss) pss) ss) - (HM.union (fmap (+nls) pls) ls) +makeCompactorParent (CompactorState is nm es nes ss nss ls nls pes pss pls sts) + = CompactorState is + nm + HM.empty 0 + HM.empty 0 + HM.empty 0 + (HM.union (fmap (+nes) pes) es) + (HM.union (fmap (+nss) pss) ss) + (HM.union (fmap (+nls) pls) ls) + sts instance DB.Binary Base where get = getBase "" diff --git a/src/Gen2/Cache.hs b/src/Gen2/Cache.hs index b81992db..07ef0a38 100644 --- a/src/Gen2/Cache.hs +++ b/src/Gen2/Cache.hs @@ -67,7 +67,7 @@ getCached :: DynFlags -> IO (Maybe ByteString) getCached dflags prefix name = let getCacheEntry = - cacheFileName dflags prefix name >>= \case + cacheFileName dflags prefix name >>= \case Nothing -> return Nothing Just file -> getCacheFile file `E.onException` removeCacheFile file getCacheFile file = do @@ -76,7 +76,7 @@ getCached dflags prefix name = valid <- checkCacheMeta meta if valid then content `seq` return (Just content) else removeCacheFile file >> return Nothing - in getCacheEntry `E.catch` \(_::E.SomeException) -> return Nothing + in getCacheEntry `E.catch` \(_::E.SomeException) -> return Nothing {- put a file in the cache, returns False if the cache file could not be created @@ -96,4 +96,3 @@ putCached dflags prefix key deps content = Just meta -> (BL.writeFile file (DB.runPut $ DB.put (meta, content)) >> return True) `catchIOError` \_ -> return False - diff --git a/src/Gen2/ClosureInfo.hs b/src/Gen2/ClosureInfo.hs index eace2535..ff19f22a 100644 --- a/src/Gen2/ClosureInfo.hs +++ b/src/Gen2/ClosureInfo.hs @@ -1,4 +1,9 @@ -{-# LANGUAGE CPP, FlexibleContexts, QuasiQuotes, DeriveDataTypeable, DeriveGeneric, OverloadedStrings #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} module Gen2.ClosureInfo where @@ -26,8 +31,12 @@ import DynFlags import StgSyn import DataCon import TyCon +import RepType import Type import Id +import Util +import Outputable hiding ((<>)) +import TyCoRep -- closure types data CType = Thunk | Fun | Pap | Con | Blackhole | StackFrame @@ -106,49 +115,87 @@ isMatchable [DoubleV] = True isMatchable [IntV] = True isMatchable _ = False -tyConVt :: TyCon -> [VarType] +tyConVt :: HasDebugCallStack => TyCon -> [VarType] tyConVt = typeVt . mkTyConTy -idVt :: Id -> [VarType] +idVt :: HasDebugCallStack => Id -> [VarType] idVt = typeVt . idType -typeVt :: Type -> [VarType] -typeVt t | isRuntimeRepKindedTy t || isRuntimeRepTy t = [] -typeVt t = case repType t of - UbxTupleRep uts -> concatMap typeVt (dropRuntimeRepArgs uts) - UnaryRep ut -> [uTypeVt ut] +typeVt :: HasDebugCallStack => Type -> [VarType] +typeVt t | isRuntimeRepKindedTy t {- || isRuntimeRepTy t -} = [] +typeVt t = map primRepVt (typePrimRep t)-- map uTypeVt (repTypeArgs t) + +uTypeVt :: HasDebugCallStack => UnaryType -> VarType +uTypeVt ut = trace' ("uTypeVt: " ++ show ut ++ "\n" ++ (show $ isRuntimeRepKindedTy ut) + ++ "\n" ++ (show $ isRuntimeRepTy ut) + ++ "\n" ++ (show $ showDbgTy ut)) + (uTypeVt0 ut) + where + showDbgTy ty = "isPrimitiveType: " ++ + case splitTyConApp_maybe ty of + Just (tc, ty_args) -> show (tc, tyConArity tc, ty_args) + Nothing -> "" + + {- +case repType t of + MultiRep uts -> concatMap typeVt (dropRuntimeRepArgs uts) + UnaryRep ut -> [uTypeVt ut] -} -- only use if you know it's not an unboxed tuple -uTypeVt :: UnaryType -> VarType -uTypeVt ut +uTypeVt0 :: HasDebugCallStack => UnaryType -> VarType +uTypeVt0 ut | isRuntimeRepKindedTy ut = VoidV - | isRuntimeRepTy ut = VoidV - | isPrimitiveType ut = primTypeVt ut - | otherwise = primRepVt . typePrimRep' $ ut - where - primRepVt VoidRep = VoidV - primRepVt PtrRep = PtrV -- fixme does ByteArray# ever map to this? - primRepVt IntRep = IntV - primRepVt WordRep = IntV - primRepVt Int64Rep = LongV - primRepVt Word64Rep = LongV - primRepVt AddrRep = AddrV - primRepVt FloatRep = DoubleV - primRepVt DoubleRep = DoubleV - primRepVt (VecRep{}) = error "uTypeVt: vector types are unsupported" - -typePrimRep' :: UnaryType -> PrimRep -typePrimRep' ty = kindPrimRep' (typeKind ty) +-- | isRuntimeRepTy ut = VoidV + -- GHC panics on this otherwise + | Just (tc, ty_args) <- splitTyConApp_maybe ut + , length ty_args /= tyConArity tc = PtrV + | isPrimitiveType ut = (primTypeVt ut) + | otherwise = + case typePrimRep' ut of + [] -> VoidV + [pt] -> primRepVt pt + _ -> panic ("uTypeVt: not unary" ++ show ut) + -- primRepVt . typePrimRep' $ ut +-- where + +primRepVt :: HasDebugCallStack => PrimRep -> VarType +primRepVt VoidRep = VoidV +primRepVt LiftedRep = PtrV -- fixme does ByteArray# ever map to this? +primRepVt UnliftedRep = PtrV +primRepVt IntRep = IntV +primRepVt WordRep = IntV +primRepVt Int64Rep = LongV +primRepVt Word64Rep = LongV +primRepVt AddrRep = AddrV +primRepVt FloatRep = DoubleV +primRepVt DoubleRep = DoubleV +primRepVt (VecRep{}) = error "uTypeVt: vector types are unsupported" + +typePrimRep' :: HasDebugCallStack => UnaryType -> [PrimRep] +typePrimRep' ty = kindPrimRep' empty (typeKind ty) -- | Find the primitive representation of a 'TyCon'. Defined here to -- avoid module loops. Call this only on unlifted tycons. -tyConPrimRep' :: TyCon -> PrimRep -tyConPrimRep' tc = kindPrimRep' res_kind +tyConPrimRep' :: HasDebugCallStack => TyCon -> [PrimRep] +tyConPrimRep' tc = kindPrimRep' empty res_kind where res_kind = tyConResKind tc -- | Take a kind (of shape @TYPE rr@) and produce the 'PrimRep' of values -- of types of this kind. +-- | Take a kind (of shape @TYPE rr@) and produce the 'PrimRep's +-- of values of types of this kind. +kindPrimRep' :: HasDebugCallStack => SDoc -> Kind -> [PrimRep] +kindPrimRep' doc ki + | Just ki' <- coreView ki + = kindPrimRep' doc ki' +kindPrimRep' doc (TyConApp typ [runtime_rep]) + = -- ASSERT( typ `hasKey` tYPETyConKey ) + runtimeRepPrimRep doc runtime_rep +kindPrimRep' doc ki + = pprPanic "kindPrimRep'" (ppr ki $$ doc) + +{- kindPrimRep' :: Kind -> PrimRep kindPrimRep' ki | Just ki' <- coreViewOneStarKind ki = kindPrimRep' ki' kindPrimRep' ki -- (TyConApp typ [runtime_rep]) @@ -166,13 +213,12 @@ kindPrimRep' ki -- (TyConApp typ [runtime_rep]) kindPrimRep' ki = -- WARN( True -- , text "kindPrimRep defaulting to PtrRep on" <+> ppr ki ) PtrRep -- this can happen legitimately for, e.g., Any +-} -primTypeVt :: Type -> VarType -primTypeVt t = case repType t of - UnaryRep ut -> case tyConAppTyCon_maybe ut of +primTypeVt :: HasDebugCallStack => Type -> VarType +primTypeVt t = case tyConAppTyCon_maybe (unwrapType t) of Nothing -> error "primTypeVt: not a TyCon" Just tc -> go (show tc) - _ -> error "primTypeVt: non-unary type found" where pr xs = "ghc-prim:GHC.Prim." ++ xs go st @@ -206,18 +252,15 @@ primTypeVt t = case repType t of | st == pr "~#" = VoidV -- coercion token? | st == pr "~R#" = VoidV -- role | st == pr "Any" = PtrV -#if __GLASGOW_HASKELL__ >= 709 | st == pr "SmallMutableArray#" = ArrV | st == pr "SmallArray#" = ArrV -#endif -#if __GLASGOW_HASKELL__ >= 801 - | st == pr "TYPE" = PtrV -- ? -#endif + | st == pr "Compact#" = ObjV -- unsupported? | st == "Data.Dynamic.Obj" = PtrV -- ? | otherwise = error ("primTypeVt: unrecognized primitive type: " ++ st) -argVt :: StgArg -> VarType -argVt = uTypeVt . stgArgType +argVt :: HasDebugCallStack => StgArg -> VarType +argVt a = trace' ("argVt: " ++ show a) + (uTypeVt . stgArgType $ a) instance ToJExpr VarType where toJExpr = toJExpr . fromEnum @@ -393,9 +436,11 @@ data StaticVal = StaticFun !Text [StaticArg] -- ^ heap object for fu instance NFData StaticVal -data StaticUnboxed = StaticUnboxedBool !Bool - | StaticUnboxedInt !Integer - | StaticUnboxedDouble !SaneDouble +data StaticUnboxed = StaticUnboxedBool !Bool + | StaticUnboxedInt !Integer + | StaticUnboxedDouble !SaneDouble + | StaticUnboxedString !ByteString + | StaticUnboxedStringOffset !ByteString deriving (Eq, Ord, Show, Typeable, Generic) instance NFData StaticUnboxed @@ -445,6 +490,10 @@ staticDeclStat (StaticInfo si sv _) = ssu (StaticUnboxedBool b) = [je| h$p(`b`) |] ssu (StaticUnboxedInt i) = [je| h$p(`i`) |] ssu (StaticUnboxedDouble d) = [je| h$p(`unSaneDouble d`) |] + ssu (StaticUnboxedString str) = ApplExpr (initStr str) [] --[je| h$p(`unSaneDouble d`) |] + ssu (StaticUnboxedStringOffset str) = jint 0 -- AssignStat (jvar i) (initStr str) + ssu (StaticUnboxedDouble d) = [je| h$p(`unSaneDouble d`) |] + -- fixme, we shouldn't do h$di, we need to record the statement to init the thunks in maybe [j| h$di(`si'`); |] (\v -> DeclStat si' <> [j| `si'` = `v`; |]) (ssv sv) @@ -460,15 +509,41 @@ staticInitStat _prof (StaticInfo i sv cc) = StaticList args mt -> ApplStat (jvar "h$stl") $ [jvar i, toJExpr args, toJExpr $ maybe jnull (toJExpr . TxtI) mt] ++ ccArg StaticThunk (Just (f,args)) -> ApplStat (jvar "h$stc") $ [jvar i, jvar f, toJExpr args] ++ ccArg + --StaticUnboxed (StaticUnboxedString str) -> AssignStat (jvar i) (initStr str) + + + -- -> withNewIdent $ \ident -> do + -- this should do modified UTF8 + -- emitToplevel [j| `decl ident`; + -- `ident` = h$str(`T.unpack t`); + -- |] + -- return [ [je| `ident`() |], [je| 0 |] ] + -- Nothing -> withNewIdent $ \ident -> do + -- emitToplevel [j| `decl ident`; + -- `ident` = h$rstr(`map toInteger (B.unpack str)`); + -- |] + -- ApplStat (jvar "h$str") + --StaticUnboxed (StaticUnboxedStringOffset str) -> AssignStat (jvar i) (jint 0) _ -> mempty where ccArg = maybeToList (fmap toJExpr cc) + +initStr :: ByteString -> JExpr +initStr str = + case decodeModifiedUTF8 str of + Just t -> ApplExpr (jvar "h$str") [ValExpr (JStr t)] + Nothing -> [je| h$rstr(`map toInteger (B.unpack str)`) |] + allocDynamicE :: CgSettings -> JExpr -> [JExpr] -> Maybe JExpr -> JExpr allocDynamicE s entry free cc | csInlineAlloc s || length free > 24 = - ValExpr . jhFromList $ [("f", entry), ("d1", fillObj1), ("d2", fillObj2), ("m", ji 0)] - ++ maybe [] (\cid -> [("cc", cid)]) cc + ValExpr . jhFromList $ [ ("f", entry) + , ("d1", fillObj1) + , ("d2", fillObj2) + , ("m", ji 0) + ] ++ + maybe [] (\cid -> [("cc", cid)]) cc | otherwise = ApplExpr allocFun (toJExpr entry : free ++ maybeToList cc) where allocFun = allocClsA ! length free diff --git a/src/Gen2/Compactor.hs b/src/Gen2/Compactor.hs index 0951a794..b77d7869 100644 --- a/src/Gen2/Compactor.hs +++ b/src/Gen2/Compactor.hs @@ -3,7 +3,8 @@ ScopedTypeVariables, TemplateHaskell, TupleSections, - OverloadedStrings #-} + OverloadedStrings + #-} {- The compactor does link-time optimization. It is much simpler @@ -18,16 +19,21 @@ module Gen2.Compactor where import DynFlags +import Util +import Panic + import Control.Applicative import Control.Arrow import Control.Lens import Control.Monad.State.Strict +import Data.Array import qualified Data.Binary.Get as DB import qualified Data.Binary.Put as DB import Data.Bits import qualified Data.ByteString.Lazy as BL +import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Builder as BB @@ -51,6 +57,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Encoding as TE +import qualified Data.Text.Encoding.Error as TE import Compiler.JMacro import Compiler.Settings @@ -59,7 +66,7 @@ import Gen2.Base import Gen2.ClosureInfo import Gen2.Utils (buildingProf, buildingDebug) import Gen2.Printer (pretty) -import qualified Panic +import qualified Gen2.Utils as U import Text.PrettyPrint.Leijen.Text (renderPretty, displayT) import qualified Crypto.Hash.SHA256 as SHA256 import Data.Aeson (ToJSON(..), Value) @@ -68,6 +75,7 @@ import qualified Data.ByteString.Base16 as B16 import System.IO.Unsafe (unsafePerformIO) +type LinkedUnit = (JStat, [ClosureInfo], [StaticInfo]) -- | collect global objects (data / CAFs). rename them and add them to the table collectGlobals :: [StaticInfo] @@ -75,13 +83,180 @@ collectGlobals :: [StaticInfo] collectGlobals = mapM_ (\(StaticInfo i _ _) -> renameObj i) debugShowStat :: (JStat, [ClosureInfo], [StaticInfo]) -> String -debugShowStat (_s, cis, sis) = "closures:\n" ++ unlines (map show cis) ++ "\nstatics:" ++ unlines (map show sis) ++ "\n\n" - -renameInternals :: GhcjsSettings +debugShowStat (_s, cis, sis) = + "closures:\n" ++ + unlines (map show cis) ++ + "\nstatics:" ++ + unlines (map show sis) ++ + "\n\n" + +{- create a single string initializer for all StaticUnboxedString references + in the code, and rewrite all references to point to it + + if incremental linking is used, each increment gets its own packed string + blob. if a string value already exists in an earlier blob it is not added + again + -} +packStrings :: HasDebugCallStack + => GhcjsSettings + -> DynFlags + -> CompactorState + -> [LinkedUnit] + -> (CompactorState, [LinkedUnit]) +packStrings settings dflags cstate code = + let allStatics :: [StaticInfo] + allStatics = concatMap (\(_,_,x) -> x) code + + origStringTable :: StringTable + origStringTable = cstate ^. stringTable + + allStrings :: Set ByteString + allStrings = S.fromList $ + filter (not . isExisting) + (mapMaybe (staticString . siVal) allStatics) + where + isExisting bs = isJust (HM.lookup bs $ stOffsets origStringTable) + + staticString :: StaticVal -> Maybe ByteString + staticString (StaticUnboxed (StaticUnboxedString bs)) = Just bs + staticString (StaticUnboxed (StaticUnboxedStringOffset bs)) = Just bs + staticString _ = Nothing + + allStringsList :: [ByteString] + allStringsList = S.toList allStrings + + -- we may see two kinds of null characters + -- - string separator, packed as \0 + -- - within a string, packed as \cz\0 + -- we transform the strings to + transformPackedLiteral :: Text -> Text + transformPackedLiteral = T.concatMap f + where + f :: Char -> Text + f '\0' = "\^Z\0" + f '\^Z' = "\^Z\^Z" + f x = T.singleton x + + allStringsPacked :: Text + allStringsPacked = T.intercalate "\0" $ + map ( transformPackedLiteral + . fromMaybe (panic "invalid string literal") + . U.decodeModifiedUTF8) + allStringsList + + allStringsWithOffset :: [(ByteString, Int)] + allStringsWithOffset = snd $ + mapAccumL (\o b -> let o' = o + fromIntegral (BS.length b) + 1 + in o' `seq` (o', (b, o))) + 0 + allStringsList + + -- the offset of each of the strings in the big blob + offsetIndex :: HashMap ByteString Int + offsetIndex = HM.fromList allStringsWithOffset + + stringSymbol :: Ident + stringSymbol = head $ cstate ^. identSupply + + stringSymbolT :: Text + stringSymbolT = let (TxtI t) = stringSymbol in t + + stringSymbolIdx :: Int + stringSymbolIdx = snd (bounds $ stTableIdents origStringTable) + 1 + + -- append the new string symbol + newTableIdents :: Array Int Text + newTableIdents = + listArray (0, stringSymbolIdx) + (elems (stTableIdents origStringTable) ++ [stringSymbolT]) + + newOffsetsMap :: HashMap ByteString (Int, Int) + newOffsetsMap = HM.union (stOffsets origStringTable) + (fmap (stringSymbolIdx,) offsetIndex) + + newIdentsMap :: HashMap Text (Either Int Int) + newIdentsMap = + let f (StaticInfo s (StaticUnboxed (StaticUnboxedString bs)) _) + = Just (s, Left . fst $ newOffsetsMap HM.! bs) + f (StaticInfo s (StaticUnboxed (StaticUnboxedStringOffset bs)) _) + = Just (s, Right . snd $ newOffsetsMap HM.! bs) + f _ = Nothing + in HM.union (stIdents origStringTable) + (HM.fromList $ mapMaybe f allStatics) + + newStringTable :: StringTable + newStringTable = StringTable newTableIdents newOffsetsMap newIdentsMap + + replaceSymbol :: Text -> Maybe JVal + replaceSymbol t = + let f (Left i) = JVar (TxtI $ newTableIdents ! i) + f (Right o) = JInt (fromIntegral o) + in fmap f (HM.lookup t newIdentsMap) + + cstate0 :: CompactorState + cstate0 = cstate & identSupply %~ tail + & stringTable .~ newStringTable + + initStr :: JStat + initStr = + DeclStat stringSymbol <> + AssignStat (ValExpr $ JVar stringSymbol) + (ApplExpr (ApplExpr (ValExpr $ JVar (TxtI "h$pstr")) + [ValExpr (JStr allStringsPacked)]) + []) + + rewriteValsE :: JExpr -> JExpr + rewriteValsE e = e & valsE %~ rewriteVals + + rewriteVals :: JVal -> JVal + rewriteVals (JVar (TxtI t)) + | Just v <- replaceSymbol t = v + rewriteVals (JList es) = JList (map rewriteValsE es) + rewriteVals (JHash m) = JHash (fmap rewriteValsE m) + rewriteVals (JFunc args body) = JFunc args (body & valsS %~ rewriteVals) + rewriteVals v = v + + rewriteStat :: JStat -> JStat + rewriteStat st = st & valsS %~ rewriteVals + + rewriteStatic :: StaticInfo -> Maybe StaticInfo + rewriteStatic (StaticInfo i + (StaticUnboxed (StaticUnboxedString {})) + cc) = + Nothing + rewriteStatic (StaticInfo i + (StaticUnboxed (StaticUnboxedStringOffset {})) + cc) = + Nothing + rewriteStatic si = Just (si & staticInfoArgs %~ rewriteStaticArg) + + rewriteStaticArg :: StaticArg -> StaticArg + rewriteStaticArg a@(StaticObjArg t) = + case HM.lookup t newIdentsMap of + Just (Right v) -> StaticLitArg (IntLit $ fromIntegral v) + Just (Left idx) -> StaticObjArg (newTableIdents ! idx) + _ -> a + rewriteStaticArg (StaticConArg v es) + = StaticConArg v (map rewriteStaticArg es) + rewriteStaticArg x = x + + initStatic :: LinkedUnit + initStatic = + let (TxtI ss) = stringSymbol + in (initStr, [], [StaticInfo ss (StaticThunk Nothing) Nothing]) + + rewriteBlock :: LinkedUnit -> LinkedUnit + rewriteBlock (stat, ci, si) + = (rewriteStat stat, ci, mapMaybe rewriteStatic si) + + in (cstate0, initStatic : map rewriteBlock code) + +renameInternals :: HasDebugCallStack + => GhcjsSettings -> DynFlags -> CompactorState -> [Text] - -> [(JStat, [ClosureInfo], [StaticInfo])] + -> [LinkedUnit] -> (CompactorState, [JStat], JStat) renameInternals settings dflags cs0 rtsDeps stats0a = (cs, stats, meta) where @@ -93,9 +268,12 @@ renameInternals settings dflags cs0 rtsDeps stats0a = (cs, stats, meta) renamed | buildingDebug dflags || buildingProf dflags = do cs <- get - let renamedStats = map (\(s,_,_) -> s & identsS %~ lookupRenamed cs) stats0 - statics = map (renameStaticInfo cs) $ concatMap (\(_,_,x) -> x) stats0 - infos = map (renameClosureInfo cs) $ concatMap (\(_,x,_) -> x) stats0 + let renamedStats = map (\(s,_,_) -> s & identsS %~ lookupRenamed cs) + stats0 + statics = map (renameStaticInfo cs) $ + concatMap (\(_,_,x) -> x) stats0 + infos = map (renameClosureInfo cs) $ + concatMap (\(_,x,_) -> x) stats0 -- render metadata as individual statements meta = mconcat (map staticDeclStat statics) <> (stbs & identsS %~ lookupRenamed cs) <> @@ -117,20 +295,35 @@ renameInternals settings dflags cs0 rtsDeps stats0a = (cs, stats, meta) safariCrashWorkaround xs = case chunksOf 10000 xs of (y:ys) | not (null ys) - -> ApplExpr (SelExpr (toJExpr y) (TxtI "concat")) (map toJExpr ys) - _ -> toJExpr xs - let renamedStats = map (\(s,_,_) -> s & identsS %~ lookupRenamed cs) stats0 - sortedInfo = concatMap (\(_,xs,_) -> map (renameClosureInfo cs) xs) stats0 + -> ApplExpr (SelExpr (toJExpr y) (TxtI "concat")) + (map toJExpr ys) + _ -> toJExpr xs + let renamedStats = map (\(s,_,_) -> s & identsS %~ lookupRenamed cs) + stats0 + sortedInfo = concatMap (\(_,xs,_) -> map (renameClosureInfo cs) + xs) + stats0 entryArr = safariCrashWorkaround $ - map (TxtI . fst) . sortBy (compare `on` snd) . HM.toList $ cs ^. entries - lblArr = map (TxtI . fst) . sortBy (compare `on` snd) . HM.toList $ cs ^. labels - ss = concatMap (\(_,_,xs) -> map (renameStaticInfo cs) xs) stats0 + map (TxtI . fst) . + sortBy (compare `on` snd) . + HM.toList $ + cs ^. entries + lblArr = map (TxtI . fst) . + sortBy (compare `on` snd) . + HM.toList $ + cs ^. labels + ss = concatMap (\(_,_,xs) -> map (renameStaticInfo cs) xs) + stats0 infoBlock = encodeStr (concatMap (encodeInfo cs) sortedInfo) staticBlock = encodeStr (concatMap (encodeStatic cs) ss) stbs' = stbs & identsS %~ lookupRenamed cs staticDecls = mconcat (map staticDeclStat ss) <> stbs' meta = staticDecls <> - [j| h$scheduleInit(`entryArr`, h$staticDelayed, `lblArr`, `infoBlock`, `staticBlock`); + [j| h$scheduleInit( `entryArr` + , h$staticDelayed + , `lblArr` + , `infoBlock` + , `staticBlock`); h$staticDelayed = []; |] return (renamedStats, meta) @@ -152,8 +345,13 @@ renameEntry i = do addItem entries entries numEntries numEntries parentEntries i'' return i' -addItem :: Getting (HashMap Text Int) CompactorState (HashMap Text Int) - -> Setting (->) CompactorState CompactorState (HashMap Text Int) (HashMap Text Int) +addItem :: HasDebugCallStack + => Getting (HashMap Text Int) CompactorState (HashMap Text Int) + -> Setting (->) + CompactorState + CompactorState + (HashMap Text Int) + (HashMap Text Int) -> Getting Int CompactorState Int -> ASetter' CompactorState Int -> Getting (HashMap Text Int) CompactorState (HashMap Text Int) @@ -173,7 +371,8 @@ addItem items items' numItems numItems' parentItems i = do numItems' += 1 collectLabels :: StaticInfo -> State CompactorState () -collectLabels si = mapM_ (addItem labels labels numLabels numLabels parentLabels) (labelsV . siVal $ si) +collectLabels si = mapM_ (addItem labels labels numLabels numLabels parentLabels) + (labelsV . siVal $ si) where labelsV (StaticData _ args) = concatMap labelsA args labelsV (StaticList args _) = concatMap labelsA args @@ -228,14 +427,20 @@ renameStaticInfo cs si = si & staticIdents %~ renameIdent renameIdent t = maybe t (\(TxtI t') -> t') (HM.lookup t $ cs ^. nameMap) staticIdents :: Traversal' StaticInfo Text -staticIdents f (StaticInfo i v cc) = StaticInfo <$> f i <*> staticIdentsV f v <*> pure cc +staticIdents f (StaticInfo i v cc) = + StaticInfo <$> f i <*> staticIdentsV f v <*> pure cc staticIdentsV :: Traversal' StaticVal Text -staticIdentsV f (StaticFun i args) = StaticFun <$> f i <*> traverse (staticIdentsA f) args -staticIdentsV f (StaticThunk (Just (i, args))) = StaticThunk . Just <$> liftA2 (,) (f i) (traverse (staticIdentsA f) args) -staticIdentsV f (StaticData con args) = StaticData <$> f con <*> traverse (staticIdentsA f) args -staticIdentsV f (StaticList xs t) = StaticList <$> traverse (staticIdentsA f) xs <*> traverse f t -staticIdentsV _ x = pure x +staticIdentsV f (StaticFun i args) = + StaticFun <$> f i <*> traverse (staticIdentsA f) args +staticIdentsV f (StaticThunk (Just (i, args))) = + StaticThunk . Just <$> liftA2 (,) (f i) (traverse (staticIdentsA f) args) +staticIdentsV f (StaticData con args) = + StaticData <$> f con <*> traverse (staticIdentsA f) args +staticIdentsV f (StaticList xs t) = + StaticList <$> traverse (staticIdentsA f) xs <*> traverse f t +staticIdentsV _ x = + pure x staticIdentsA :: Traversal' StaticArg Text staticIdentsA f (StaticObjArg t) = StaticObjArg <$> f t @@ -250,64 +455,76 @@ staticIdentsA _ x = pure x 2 byte: 124 a b (90-8189) 3 byte: 125 a b c (8190-737189) -} -encodeStr :: [Int] -> String +encodeStr :: HasDebugCallStack => [Int] -> String encodeStr = concatMap encodeChr where - c :: Int -> Char + c :: HasDebugCallStack => Int -> Char c i | i > 90 || i < 0 = error ("encodeStr: c " ++ show i) | i >= 59 = chr (34+i) | i >= 2 = chr (33+i) | otherwise = chr (32+i) + encodeChr :: HasDebugCallStack => Int -> String encodeChr i - | i < 0 = error "encodeStr: negative" + | i < 0 = panic "encodeStr: negative" | i <= 89 = [c i] | i <= 8189 = let (c1, c2) = (i - 90) `divMod` 90 in [chr 124, c c1, c c2] | i <= 737189 = let (c2a, c3) = (i - 8190) `divMod` 90 (c1, c2) = c2a `divMod` 90 in [chr 125, c c1, c c2, c c3] - | otherwise = error "encodeStr: overflow" + | otherwise = panic "encodeStr: overflow" -entryIdx :: String +entryIdx :: HasDebugCallStack + => String -> CompactorState -> Text -> Int entryIdx msg cs i = fromMaybe lookupParent (HM.lookup i' (cs ^. entries)) where (TxtI i') = lookupRenamed cs (TxtI i) - lookupParent = maybe err (+ cs ^. numEntries) (HM.lookup i' (cs ^. parentEntries)) - err = error (msg ++ ": invalid entry: " ++ T.unpack i') + lookupParent = maybe err + (+ cs ^. numEntries) + (HM.lookup i' (cs ^. parentEntries)) + err = panic (msg ++ ": invalid entry: " ++ T.unpack i') -objectIdx :: String +objectIdx :: HasDebugCallStack + => String -> CompactorState -> Text -> Int objectIdx msg cs i = fromMaybe lookupParent (HM.lookup i' (cs ^. statics)) where (TxtI i') = lookupRenamed cs (TxtI i) - lookupParent = maybe err (+ cs ^. numStatics) (HM.lookup i' (cs ^. parentStatics)) - err = error (msg ++ ": invalid static: " ++ T.unpack i') + lookupParent = maybe err + (+ cs ^. numStatics) + (HM.lookup i' (cs ^. parentStatics)) + err = panic (msg ++ ": invalid static: " ++ T.unpack i') -labelIdx :: String +labelIdx :: HasDebugCallStack + => String -> CompactorState -> Text -> Int labelIdx msg cs l = fromMaybe lookupParent (HM.lookup l (cs ^. labels)) where - lookupParent = maybe err (+ cs ^. numLabels) (HM.lookup l (cs ^. parentLabels)) - err = error (msg ++ ": invalid label: " ++ T.unpack l) + lookupParent = maybe err + (+ cs ^. numLabels) + (HM.lookup l (cs ^. parentLabels)) + err = panic (msg ++ ": invalid label: " ++ T.unpack l) -encodeInfo :: CompactorState +encodeInfo :: HasDebugCallStack + => CompactorState -> ClosureInfo -- ^ information to encode -> [Int] encodeInfo cs (ClosureInfo _var regs name layout typ static) | CIThunk <- typ = [0] ++ ls | (CIFun _arity regs0) <- typ, regs0 /= argSize regs - = error ("encodeInfo: inconsistent register metadata for " ++ T.unpack name) + = panic ("encodeInfo: inconsistent register metadata for " ++ T.unpack name) | (CIFun arity _regs0) <- typ = [1, arity, encodeRegs regs] ++ ls | (CICon tag) <- typ = [2, tag] ++ ls | CIStackFrame <- typ = [3, encodeRegs regs] ++ ls -- (CIPap ar) <- typ = [4, ar] ++ ls -- these should only appear during runtime - | otherwise = error ("encodeInfo, unexpected closure type: " ++ show typ) + | otherwise = panic $ + "encodeInfo, unexpected closure type: " ++ show typ where ls = encodeLayout layout ++ encodeSrt static encodeLayout CILayoutVariable = [0] @@ -318,44 +535,78 @@ encodeInfo cs (ClosureInfo _var regs name layout typ static) encodeRegs (CIRegs skip regTypes) = let nregs = sum (map varSize regTypes) in encodeRegsTag skip nregs encodeRegsTag skip nregs - | skip < 0 || skip > 1 = error "encodeRegsTag: unexpected skip" + | skip < 0 || skip > 1 = panic "encodeRegsTag: unexpected skip" | otherwise = 1 + (nregs `shiftL` 1) + skip argSize (CIRegs skip regTypes) = sum (map varSize regTypes) - 1 + skip argSize _ = 0 -encodeStatic :: CompactorState +encodeStatic :: HasDebugCallStack + => CompactorState + -> StaticInfo + -> [Int] +encodeStatic cs si = + U.trace' ("encodeStatic: " ++ show si) + (encodeStatic0 cs si) + +encodeStatic0 :: HasDebugCallStack + => CompactorState -> StaticInfo -> [Int] -encodeStatic cs (StaticInfo _to sv _) - | StaticFun f args <- sv = [1, entry f, length args] ++ concatMap encodeArg args - | StaticThunk (Just (t, args)) <- sv = [2, entry t, length args] ++ concatMap encodeArg args - | StaticThunk Nothing <- sv = [0] - | StaticUnboxed (StaticUnboxedBool b) <- sv = [3 + fromEnum b] - | StaticUnboxed (StaticUnboxedInt i) <- sv = [5] -- ++ encodeInt i - | StaticUnboxed (StaticUnboxedDouble d) <- sv = [6] -- ++ encodeDouble d +encodeStatic0 cs (StaticInfo _to sv _) + | StaticFun f args <- sv = + [1, entry f, length args] ++ concatMap encodeArg args + | StaticThunk (Just (t, args)) <- sv = + [2, entry t, length args] ++ concatMap encodeArg args + | StaticThunk Nothing <- sv = + [0] + | StaticUnboxed (StaticUnboxedBool b) <- sv = + [3 + fromEnum b] + | StaticUnboxed (StaticUnboxedInt i) <- sv = + [5] -- ++ encodeInt i + | StaticUnboxed (StaticUnboxedDouble d) <- sv = + [6] -- ++ encodeDouble d -- | StaticString t <- sv = [7, T.length t] ++ map encodeChar (T.unpack t) -- | StaticBin bs <- sv = [8, BS.length bs] ++ map fromIntegral (BS.unpack bs) - | StaticList [] Nothing <- sv = [8] - | StaticList args t <- sv = [9, length args] ++ maybe [0] (\t' -> [1, obj t']) t ++ concatMap encodeArg (reverse args) + | StaticList [] Nothing <- sv = + [8] + | StaticList args t <- sv = + [9, length args] ++ + maybe [0] (\t' -> [1, obj t']) t ++ + concatMap encodeArg (reverse args) | StaticData con args <- sv = - (if length args <= 6 then [11+length args] else [10,length args]) ++ [entry con] ++ concatMap encodeArg args + (if length args <= 6 + then [11+length args] + else [10,length args]) ++ + [entry con] ++ + concatMap encodeArg args where obj = objectIdx "encodeStatic" cs entry = entryIdx "encodeStatic" cs lbl = labelIdx "encodeStatic" cs -- | an argument is either a reference to a heap object or a primitive value - encodeArg (StaticLitArg (BoolLit b)) = [0 + fromEnum b] - encodeArg (StaticLitArg (IntLit 0)) = [2] - encodeArg (StaticLitArg (IntLit 1)) = [3] - encodeArg (StaticLitArg (IntLit i)) = [4] ++ encodeInt i - encodeArg (StaticLitArg NullLit) = [5] - encodeArg (StaticLitArg (DoubleLit d)) = [6] ++ encodeDouble d - encodeArg (StaticLitArg (StringLit s)) = [7] ++ encodeString s - encodeArg (StaticLitArg (BinLit b)) = [8] ++ encodeBinary b - encodeArg (StaticLitArg (LabelLit b l)) = [9, fromEnum b, lbl l] - encodeArg (StaticConArg con args) = [10, entry con, length args] ++ concatMap encodeArg args - encodeArg (StaticObjArg t) = [11 + obj t] - -- encodeArg x = error ("encodeArg: unexpected: " ++ show x) + encodeArg (StaticLitArg (BoolLit b)) = + [0 + fromEnum b] + encodeArg (StaticLitArg (IntLit 0)) = + [2] + encodeArg (StaticLitArg (IntLit 1)) = + [3] + encodeArg (StaticLitArg (IntLit i)) = + [4] ++ encodeInt i + encodeArg (StaticLitArg NullLit) = + [5] + encodeArg (StaticLitArg (DoubleLit d)) = + [6] ++ encodeDouble d + encodeArg (StaticLitArg (StringLit s)) = + [7] ++ encodeString s + encodeArg (StaticLitArg (BinLit b)) = + [8] ++ encodeBinary b + encodeArg (StaticLitArg (LabelLit b l)) = + [9, fromEnum b, lbl l] + encodeArg (StaticConArg con args) = + [10, entry con, length args] ++ concatMap encodeArg args + encodeArg (StaticObjArg t) = + [11 + obj t] + -- encodeArg x = panic ("encodeArg: unexpected: " ++ show x) encodeChar = ord -- fixme make characters more readable encodeString :: Text -> [Int] @@ -387,18 +638,24 @@ encodeBinary bs = BS.length bs : go bs encodeInt :: Integer -> [Int] encodeInt i | i >= -10 && i < encodeMax - 11 = [fromIntegral i + 12] - | i > 2^(31::Int)-1 || i < -2^(31::Int) = error "encodeInt: integer outside 32 bit range" + | i > 2^(31::Int)-1 || i < -2^(31::Int) + = panic "encodeInt: integer outside 32 bit range" | otherwise = let i' :: Int32 = fromIntegral i - in [0, fromIntegral ((i' `shiftR` 16) .&. 0xffff), fromIntegral (i' .&. 0xffff)] + in [ 0 + , fromIntegral ((i' `shiftR` 16) .&. 0xffff) + , fromIntegral (i' .&. 0xffff) + ] -- encode a possibly 53 bit int encodeSignificand :: Integer -> [Int] encodeSignificand i | i >= -10 && i < encodeMax - 11 = [fromIntegral i + 12] - | i > 2^(53::Int) || i < -2^(53::Int) = error ("encodeInt: integer outside 53 bit range: " ++ show i) + | i > 2^(53::Int) || i < -2^(53::Int) + = panic ("encodeInt: integer outside 53 bit range: " ++ show i) | otherwise = let i' = abs i in [if i < 0 then 0 else 1] ++ - map (\r -> fromIntegral ((i' `shiftR` r) .&. 0xffff)) [48,32,16,0] + map (\r -> fromIntegral ((i' `shiftR` r) .&. 0xffff)) + [48,32,16,0] encodeDouble :: SaneDouble -> [Int] encodeDouble (SaneDouble d) @@ -407,8 +664,10 @@ encodeDouble (SaneDouble d) | isInfinite d && d > 0 = [2] | isInfinite d = [3] | isNaN d = [4] - | abs exponent <= 30 = [6 + fromIntegral exponent + 30] ++ encodeSignificand significand - | otherwise = [5] ++ encodeInt (fromIntegral exponent) ++ encodeSignificand significand + | abs exponent <= 30 + = [6 + fromIntegral exponent + 30] ++ encodeSignificand significand + | otherwise + = [5] ++ encodeInt (fromIntegral exponent) ++ encodeSignificand significand where (significand, exponent) = decodeFloat d @@ -481,17 +740,70 @@ identsV f (JHash m) = JHash <$> (traverse . identsE) f m identsV f (JFunc args s) = JFunc <$> traverse f args <*> identsS f s identsV _ (UnsatVal{}) = error "identsV: UnsatVal" +---------------------------- + +{-# INLINE valsS #-} +valsS :: Traversal' JStat JVal +valsS _ d@(DeclStat _i) = pure d -- DeclStat <$> f i +valsS f (ReturnStat e) = ReturnStat <$> valsE f e +valsS f (IfStat e s1 s2) = IfStat <$> valsE f e <*> valsS f s1 <*> valsS f s2 +valsS f (WhileStat b e s) = WhileStat b <$> valsE f e <*> valsS f s +valsS f (ForInStat b i e s) = ForInStat b <$> pure i <*> valsE f e <*> valsS f s +valsS f (SwitchStat e xs s) = SwitchStat <$> valsE f e <*> (traverse . traverseCase) f xs <*> valsS f s + where traverseCase g (e,s) = (,) <$> valsE g e <*> valsS g s +valsS f (TryStat s1 i s2 s3) = TryStat <$> valsS f s1 <*> pure i <*> valsS f s2 <*> valsS f s3 +valsS f (BlockStat xs) = BlockStat <$> (traverse . valsS) f xs +valsS f (ApplStat e es) = ApplStat <$> valsE f e <*> (traverse . valsE) f es +valsS f (UOpStat op e) = UOpStat op <$> valsE f e +valsS f (AssignStat e1 e2) = AssignStat <$> valsE f e1 <*> valsE f e2 +valsS _ (UnsatBlock{}) = panic "valsS: UnsatBlock" +valsS _ (AntiStat{}) = panic "valsS: AntiStat" +valsS f (LabelStat l s) = LabelStat l <$> valsS f s +valsS _ b@(BreakStat{}) = pure b +valsS _ c@(ContinueStat{}) = pure c + +{-# INLINE valsE #-} +valsE :: Traversal' JExpr JVal +valsE f (ValExpr v) = ValExpr <$> f v +valsE f (SelExpr e i) = SelExpr <$> valsE f e <*> pure i +valsE f (IdxExpr e1 e2) = IdxExpr <$> valsE f e1 <*> valsE f e2 +valsE f (InfixExpr s e1 e2) = InfixExpr s <$> valsE f e1 <*> valsE f e2 +valsE f (UOpExpr o e) = UOpExpr o <$> valsE f e +valsE f (IfExpr e1 e2 e3) = IfExpr <$> valsE f e1 <*> valsE f e2 <*> valsE f e3 +valsE f (ApplExpr e es) = ApplExpr <$> valsE f e <*> (traverse . valsE) f es +valsE _ (UnsatExpr{}) = panic "valsE: UnsatExpr" +valsE _ (AntiExpr{}) = panic "valsE: AntiExpr" + + +staticInfoArgs :: Traversal' StaticInfo StaticArg +staticInfoArgs f (StaticInfo si sv sa) = + StaticInfo <$> pure si <*> staticValArgs f sv <*> pure sa + +staticValArgs :: Traversal' StaticVal StaticArg +staticValArgs f (StaticFun fn as) + = StaticFun fn <$> traverse f as +staticValArgs f (StaticThunk (Just (t, as))) + = StaticThunk . Just . (t,) <$> traverse f as +staticValArgs f (StaticData c as) = StaticData c <$> traverse f as +staticValArgs f (StaticList as mt) = StaticList <$> traverse f as <*> pure mt +staticValArgs _ x = pure x + compact :: GhcjsSettings -> DynFlags -> CompactorState -> [Text] - -> [(JStat, [ClosureInfo], [StaticInfo])] - -> (CompactorState, [JStat], JStat) -- ^ renamer state, statements for each unit, metadata -compact settings dflags rs rtsDeps input + -> [LinkedUnit] + -> (CompactorState, [JStat], JStat) +compact settings dflags cs0 rtsDeps0 input0 -- | dumpHashes' input = - let rtsDeps' = rtsDeps ++ map (<> "_e") rtsDeps ++ map (<> "_con_e") rtsDeps - in renameInternals settings dflags rs rtsDeps' input + let rtsDeps1 = rtsDeps0 ++ + map (<> "_e") rtsDeps0 ++ + map (<> "_con_e") rtsDeps0 + (cs1, input1) = packStrings settings dflags cs0 input0 + in renameInternals settings dflags cs1 rtsDeps1 input1 + + -- renameInternals settings dflags cs1 rtsDeps' input -- hash compactification @@ -506,9 +818,13 @@ dedupeBodies rtsDeps input = (renderBuildFunctions bfN bfCB, input') (map (\(k, s, bs) -> (bs, (s, [k]))) hdefs0) hdefsR = M.fromList $ map (\(k, _, bs) -> (k, bs)) hdefs0 hdefs0 :: [(Text, Int, BS.ByteString)] - hdefs0 = concatMap (\(b,_,_) -> (map (\(k,h) -> - let (s,fh, _deps) = finalizeHash' h - in (k, s, fh)) . hashDefinitions globals) b) input + hdefs0 = concatMap (\(b,_,_) -> + (map (\(k,h) -> + let (s,fh, _deps) = finalizeHash' h + in (k, s, fh)) + . hashDefinitions globals) b + ) + input globals = foldl' (flip S.delete) (findAllGlobals input) rtsDeps renderBuildFunctions :: [BuildFunction] -> [BuildFunction] -> JStat @@ -551,14 +867,16 @@ sortBuildFunctions bfs = (map snd normBFs, map snd cbBFs) fromSCC (G.AcyclicSCC x) = [(False, bfm M.! x)] fromSCC (G.CyclicSCC xs) = breakCycles xs sccs :: [BuildFunction] -> [G.SCC Text] - sccs b = G.stronglyConnComp $ map (\bf -> let n = bfName bf in (n, n, bfDeps bf)) b + sccs b = G.stronglyConnComp $ + map (\bf -> let n = bfName bf in (n, n, bfDeps bf)) b {- finding the maximum acyclic subgraph is the Minimum Feedback Arc Set problem, which is NP-complete. We use an approximation here. -} breakCycles :: [Text] -> [(Bool, BuildFunction)] - breakCycles nodes = (True, bfm M.! selected) - : concatMap fromSCC (sccs $ (map (bfm M.!) $ filter (/=selected) nodes)) + breakCycles nodes = + (True, bfm M.! selected) + : concatMap fromSCC (sccs $ (map (bfm M.!) $ filter (/=selected) nodes)) where outDeg, inDeg :: Map Text Int outDeg = M.fromList $ map (\n -> (n, length (bfDeps (bfm M.! n)))) nodes @@ -570,8 +888,8 @@ sortBuildFunctions bfs = (map snd normBFs, map snd cbBFs) rewriteBodies :: Set Text -> Map Text BS.ByteString -> Map BS.ByteString (Int, [Text]) - -> [(JStat, [ClosureInfo], [StaticInfo])] - -> ([BuildFunction], [BuildFunction], [(JStat, [ClosureInfo], [StaticInfo])]) + -> [LinkedUnit] + -> ([BuildFunction], [BuildFunction], [LinkedUnit]) rewriteBodies globals idx1 idx2 input = (bfsNormal, bfsCycleBreaker, input') where (bfs1, input') = unzip (map rewriteBlock input) @@ -582,7 +900,7 @@ rewriteBodies globals idx1 idx2 input = (bfsNormal, bfsCycleBreaker, input') idx2' = M.filter (\(s, xs) -> dedupeBody (length xs) s) idx2 rewriteBlock :: (JStat, [ClosureInfo], [StaticInfo]) - -> ([BuildFunction], (JStat, [ClosureInfo], [StaticInfo])) + -> ([BuildFunction], LinkedUnit) rewriteBlock (st, cis, sis) = let (bfs, st') = rewriteFunctions st -- remove the declarations for things that we just deduped @@ -596,15 +914,22 @@ rewriteBodies globals idx1 idx2 input = (bfsNormal, bfsCycleBreaker, input') removeDecls _ s = s rewriteFunctions :: JStat -> ([BuildFunction], JStat) - rewriteFunctions (BlockStat ss) = let (bfs, ss') = unzip (map rewriteFunctions ss) - in (concat bfs, BlockStat ss') - rewriteFunctions (AssignStat (ValExpr (JVar (TxtI i))) (ValExpr (JFunc args st))) + rewriteFunctions (BlockStat ss) = + let (bfs, ss') = unzip (map rewriteFunctions ss) + in (concat bfs, BlockStat ss') + rewriteFunctions (AssignStat (ValExpr (JVar (TxtI i))) + (ValExpr (JFunc args st))) | Just h <- M.lookup i idx1 , Just (_s, his) <- M.lookup h idx2' = let (bf, st') = rewriteFunction i h his args st in ([bf], st') rewriteFunctions x = ([], x) - rewriteFunction :: Text -> BS.ByteString -> [Text] -> [Ident] -> JStat -> (BuildFunction, JStat) + rewriteFunction :: Text + -> BS.ByteString + -> [Text] + -> [Ident] + -> JStat + -> (BuildFunction, JStat) rewriteFunction i h his args body | i == iFirst = (bf, createFunction i idx g args body) | otherwise = (bf, mempty) @@ -616,7 +941,12 @@ rewriteBodies globals idx1 idx2 input = (bfsNormal, bfsCycleBreaker, input') iFirst = head his Just idx = M.lookupIndex h idx2' - createFunction :: Text -> Int -> [Text] -> [Ident] -> JStat -> JStat + createFunction :: Text + -> Int + -> [Text] + -> [Ident] + -> JStat + -> JStat createFunction i idx g args body = DeclStat bi <> AssignStat (ValExpr (JVar bi)) @@ -689,9 +1019,16 @@ dedupe rtsDeps input pickShortest :: [Text] -> Text pickShortest = head . sortBy (compare `on` T.length) -dedupeBlock :: HashIdx -> JStat -> [ClosureInfo] -> [StaticInfo] -> (JStat, [ClosureInfo], [StaticInfo]) +dedupeBlock :: HashIdx + -> JStat + -> [ClosureInfo] + -> [StaticInfo] + -> LinkedUnit dedupeBlock hi st ci si = - (dedupeStat hi st, mapMaybe (dedupeClosureInfo hi) ci, mapMaybe (dedupeStaticInfo hi) si) + ( dedupeStat hi st + , mapMaybe (dedupeClosureInfo hi) ci + , mapMaybe (dedupeStaticInfo hi) si + ) dedupeStat :: HashIdx -> JStat -> JStat dedupeStat hi st = go st @@ -731,8 +1068,11 @@ dedupeStaticVal hi (StaticList args lt) = dedupeStaticVal _ v = v -- unboxed value or thunk with alt init, no rewrite needed dedupeStaticArg :: HashIdx -> StaticArg -> StaticArg -dedupeStaticArg hi (StaticObjArg o) = StaticObjArg (toCanon hi o) -dedupeStaticArg hi (StaticConArg c args) = StaticConArg (toCanon hi c) (map (dedupeStaticArg hi) args) +dedupeStaticArg hi (StaticObjArg o) + = StaticObjArg (toCanon hi o) +dedupeStaticArg hi (StaticConArg c args) + = StaticConArg (toCanon hi c) + (map (dedupeStaticArg hi) args) dedupeStaticArg hi a@(StaticLitArg{}) = a isCanon :: HashIdx -> Text -> Bool @@ -786,7 +1126,7 @@ dumpHashes' input = BL.writeFile "hashes.json" (Aeson.encode $ dumpHashes hashes) in unsafePerformIO writeHashes `seq` True -} -buildHashes :: [Text] -> [(JStat, [ClosureInfo], [StaticInfo])] -> Map Text Hash +buildHashes :: [Text] -> [LinkedUnit] -> Map Text Hash buildHashes rtsDeps xss -- - | dumpHashes0 hashes0 = fixHashes (fmap finalizeHash hashes0) @@ -799,7 +1139,7 @@ buildHashes rtsDeps xss hsis = map hashStaticInfo (filter (not . ignoreStatic) sis) in M.fromList (combineHashes hdefs hcis ++ hsis) -findAllGlobals :: [(JStat, [ClosureInfo], [StaticInfo])] -> Set Text +findAllGlobals :: [LinkedUnit] -> Set Text findAllGlobals xss = S.fromList $ concatMap f xss where f (_, cis, sis) = @@ -869,17 +1209,24 @@ fixHashesIter n invDeps allKeys checkKeys sccs hashes finalHashes luds = map lookupDep deps in (k, makeFinalHash bs luds) lookupDep :: Text -> BS.ByteString - lookupDep d | Just b <- M.lookup d finalHashes = b - | Just i <- M.lookup d toHashIdx = grpHash <> (TE.encodeUtf8 . T.pack . show $ i) - | otherwise = Panic.panic ("Gen2.Compactor.hashRootSCC: unknown key: " ++ T.unpack d) + lookupDep d + | Just b <- M.lookup d finalHashes = b + | Just i <- M.lookup d toHashIdx + = grpHash <> (TE.encodeUtf8 . T.pack . show $ i) + | otherwise + = Panic.panic $ "Gen2.Compactor.hashRootSCC: unknown key: " ++ + T.unpack d toHashIdx :: M.Map Text Integer toHashIdx = M.fromList $ zip toHash [1..] grpHash :: BS.ByteString - grpHash = BL.toStrict . BB.toLazyByteString $ mconcat (map (mkGrpHash . (hashes M.!)) toHash) - mkGrpHash (h, deps) = let deps' = mapMaybe (`M.lookup` finalHashes) deps - in BB.byteString h <> - BB.int64LE (fromIntegral $ length deps') <> - mconcat (map BB.byteString deps') + grpHash = BL.toStrict + . BB.toLazyByteString + $ mconcat (map (mkGrpHash . (hashes M.!)) toHash) + mkGrpHash (h, deps) = + let deps' = mapMaybe (`M.lookup` finalHashes) deps + in BB.byteString h <> + BB.int64LE (fromIntegral $ length deps') <> + mconcat (map BB.byteString deps') toHash :: [Text] toHash = sortBy (compare `on` (fst . (hashes M.!))) scc @@ -892,8 +1239,12 @@ ignoreStatic (StaticInfo _ (StaticThunk {}) _) = True ignoreStatic _ = False -- combine hashes from x and y, leaving only those which have an entry in both -combineHashes :: [(Text, HashBuilder)] -> [(Text, HashBuilder)] -> [(Text, HashBuilder)] -combineHashes x y = M.toList $ M.intersectionWith (<>) (M.fromList x) (M.fromList y) +combineHashes :: [(Text, HashBuilder)] + -> [(Text, HashBuilder)] + -> [(Text, HashBuilder)] +combineHashes x y = M.toList $ M.intersectionWith (<>) + (M.fromList x) + (M.fromList y) {- dumpHashes0 :: Map Text HashBuilder -> Bool @@ -1015,9 +1366,11 @@ hashMaybe _ Nothing = ht 1 hashMaybe f (Just x) = ht 2 <> f x hashStaticUnboxed :: StaticUnboxed -> HashBuilder -hashStaticUnboxed (StaticUnboxedBool b) = ht 1 <> hi (fromEnum b) -hashStaticUnboxed (StaticUnboxedInt iv) = ht 2 <> hi' iv -hashStaticUnboxed (StaticUnboxedDouble sd) = ht 3 <> hashSaneDouble sd +hashStaticUnboxed (StaticUnboxedBool b) = ht 1 <> hi (fromEnum b) +hashStaticUnboxed (StaticUnboxedInt iv) = ht 2 <> hi' iv +hashStaticUnboxed (StaticUnboxedDouble sd) = ht 3 <> hashSaneDouble sd +hashStaticUnboxed (StaticUnboxedString str) = ht 4 <> hb str +hashStaticUnboxed (StaticUnboxedStringOffset str) = ht 5 <> hb str hashStaticArg :: StaticArg -> HashBuilder diff --git a/src/Gen2/Deps.hs b/src/Gen2/Deps.hs new file mode 100644 index 00000000..4c787291 --- /dev/null +++ b/src/Gen2/Deps.hs @@ -0,0 +1,82 @@ + +module Gen2.Deps where + +import Data.List +import Data.Monoid + +import Id +import StgSyn +import VarSet + +type LiveVars = DVarSet +{- +newtype LiveVars = LiveVars LiveVars deriving Eq + +instance Monoid LiveVars where + mempty = emptyVarSet + mappend = unionVarSet +-} + +liveStatic :: LiveVars -> LiveVars +liveStatic = filterDVarSet isGlobalId + +liveVars :: LiveVars -> LiveVars +liveVars = filterDVarSet (not . isGlobalId) + +stgTopBindLive :: StgTopBinding -> [(Id, LiveVars)] +stgTopBindLive (StgTopLifted b) = stgBindLive b +stgTopBindLive (StgTopStringLit {}) = [] + +stgBindLive :: StgBinding -> [(Id, LiveVars)] +stgBindLive (StgNonRec b rhs) = [(b, stgRhsLive rhs)] +stgBindLive (StgRec bs) = map (\(b,rhs) -> (b, stgRhsLive rhs)) bs + +stgBindRhsLive :: StgBinding -> LiveVars +stgBindRhsLive b = + let (bs, ls) = unzip (stgBindLive b) + in delDVarSetList (unionDVarSets ls) bs + +stgRhsLive :: StgRhs -> LiveVars +stgRhsLive (StgRhsClosure _ _ fvs _ args e) = + delDVarSetList (stgExprLive True e) args +stgRhsLive (StgRhsCon _ _ args) = + mconcat (map stgArgLive args) + +stgArgLive :: StgArg -> LiveVars +stgArgLive (StgVarArg occ) = unitDVarSet occ +stgArgLive (StgLitArg {}) = mempty + +stgExprLive :: Bool -> StgExpr -> LiveVars +stgExprLive _ (StgApp occ args) = + unitDVarSet occ <> mconcat (map stgArgLive args) +stgExprLive _ (StgLit {}) = + mempty +stgExprLive _ (StgConApp _dc args _tys) = + mconcat (map stgArgLive args) +stgExprLive _ (StgOpApp _op args _ty) = + mconcat (map stgArgLive args) +stgExprLive _ (StgLam bs e) = + delDVarSetList (stgExprLive True e) bs +stgExprLive includeLHS (StgCase e b _at alts) + | includeLHS = el `unionDVarSet` delDVarSet al b + | otherwise = delDVarSet al b + where + al = mconcat (map stgAltLive alts) + el = stgExprLive True e +stgExprLive _ (StgLet b e) = + delDVarSetList (stgBindRhsLive b `unionDVarSet` stgExprLive True e) (bindees b) +stgExprLive _ (StgLetNoEscape b e) = + delDVarSetList (stgBindRhsLive b `unionDVarSet` stgExprLive True e) (bindees b) +stgExprLive _ (StgTick _ti e) = + stgExprLive True e + +stgAltLive :: StgAlt -> LiveVars +stgAltLive (_altCon, bs, e) = + delDVarSetList (stgExprLive True e) bs + +stgLetNoEscapeLive :: Bool -> StgBinding -> StgExpr -> LiveVars +stgLetNoEscapeLive someBool b e = error "stgLetNoEscapeLive" + +bindees :: StgBinding -> [Id] +bindees (StgNonRec b _e) = [b] +bindees (StgRec bs) = map fst bs diff --git a/src/Gen2/DynamicLinking.hs b/src/Gen2/DynamicLinking.hs index d728d00a..03ceafd3 100644 --- a/src/Gen2/DynamicLinking.hs +++ b/src/Gen2/DynamicLinking.hs @@ -40,7 +40,7 @@ import Platform import ErrUtils import DriverPhases import DriverPipeline hiding ( linkingNeeded ) -import UniqFM +import UniqDFM import Maybes hiding ( Succeeded ) import Control.Applicative @@ -119,7 +119,7 @@ ghcjsLinkJsLib settings jsFiles dflags hpt meta = Meta (opt_P dflags) jsEntries <- forM jsFiles' $ \file -> (JsSource file,) . B.fromStrict <$> BS.readFile file - objEntries <- forM (eltsUFM hpt) $ \hmi -> do + objEntries <- forM (eltsUDFM hpt) $ \hmi -> do let mt = T.pack . moduleNameString . moduleName . mi_module . hm_iface $ hmi files = maybe [] (\l -> [ o | DotO o <- linkableUnlinked l]) (hm_linkable hmi) -- fixme archive does not handle multiple files for a module yet @@ -142,13 +142,13 @@ dumpHpt :: DynFlags -> HomePackageTable -> String dumpHpt dflags pt = "hpt:\n" ++ unlines (map (\hmi -> (moduleNameString . moduleName . mi_module . hm_iface $ hmi) ++ " -> " ++ maybe "" (showPpr dflags) (hm_linkable hmi)) - (eltsUFM pt)) + (eltsUDFM pt)) ghcjsLinkJsBinary :: GhcjsEnv -> GhcjsSettings -> [FilePath] -> DynFlags -> [FilePath] - -> [PackageKey] + -> [InstalledUnitId] -> IO () ghcjsLinkJsBinary env settings jsFiles dflags objs dep_pkgs = void $ variantLink gen2Variant dflags env settings exe [] dep_pkgs objs' jsFiles isRoot S.empty @@ -156,21 +156,16 @@ ghcjsLinkJsBinary env settings jsFiles dflags objs dep_pkgs = objs' = map ObjFile objs isRoot _ = True exe = Utils.exeFileName dflags - packageLibPaths :: PackageKey -> [FilePath] -#if __GLASGOW_HASKELL__ >= 709 - packageLibPaths = maybe [] libraryDirs . lookupPackage dflags -#else - packageLibPaths pkg = maybe [] libraryDirs (lookupPackage pidMap pkg) - pidMap = pkgIdMap (pkgState dflags) -#endif + packageLibPaths :: InstalledUnitId -> [FilePath] + packageLibPaths = maybe [] libraryDirs . lookupInstalledPackage dflags -isGhcjsPrimPackage :: DynFlags -> PackageKey -> Bool +isGhcjsPrimPackage :: DynFlags -> InstalledUnitId -> Bool isGhcjsPrimPackage dflags pkgKey - = getPackageName dflags pkgKey == "ghcjs-prim" || - (pkgKey == thisPackage dflags && + = getInstalledPackageName dflags pkgKey == "ghcjs-prim" || + (pkgKey == thisInstalledUnitId dflags && any (=="-DBOOTING_PACKAGE=ghcjs-prim") (opt_P dflags)) -ghcjsPrimPackage :: DynFlags -> IO PackageKey +ghcjsPrimPackage :: DynFlags -> IO InstalledUnitId ghcjsPrimPackage dflags = do keys <- BS.readFile filename case Yaml.decodeEither keys of @@ -198,7 +193,7 @@ link' env settings extraJs buildJs dflags batch_attempt_linking hpt LinkStaticLib -> True _ -> platformBinariesAreStaticLibs (targetPlatform dflags) - home_mod_infos = eltsUFM hpt + home_mod_infos = eltsUDFM hpt -- the packages we depend on pkg_deps = concatMap (map fst . dep_pkgs . mi_deps . hm_iface) home_mod_infos @@ -254,7 +249,7 @@ link' env settings extraJs buildJs dflags batch_attempt_linking hpt return Succeeded -linkingNeeded :: DynFlags -> Bool -> [Linkable] -> [PackageKey] -> IO Bool +linkingNeeded :: DynFlags -> Bool -> [Linkable] -> [InstalledUnitId] -> IO Bool linkingNeeded dflags staticLink linkables pkg_deps = do -- if the modification time on the executable is later than the -- modification times on all of the objects and libraries, then omit @@ -275,9 +270,8 @@ linkingNeeded dflags staticLink linkables pkg_deps = do -- next, check libraries. XXX this only checks Haskell libraries, -- not extra_libraries or -l things from the command line. -#if __GLASGOW_HASKELL__ >= 709 let pkg_hslibs = [ (libraryDirs c, lib) - | Just c <- map (lookupPackage dflags) pkg_deps, + | Just c <- map (lookupInstalledPackage dflags) pkg_deps, lib <- packageHsLibs dflags c ] pkg_libfiles <- mapM (uncurry (findHSLib dflags)) pkg_hslibs @@ -288,36 +282,22 @@ linkingNeeded dflags staticLink linkables pkg_deps = do if not (null lib_errs) || any (t <) lib_times then return True else checkLinkInfo dflags pkg_deps exe_file -#else - let pkg_map = pkgIdMap (pkgState dflags) - pkg_hslibs = [ (libraryDirs c, lib) - | Just c <- map (lookupPackage pkg_map) pkg_deps, - lib <- ghcjsPackageHsLibs dflags c ] - pkg_libfiles <- mapM (uncurry (findHSLib dflags)) pkg_hslibs - if any isNothing pkg_libfiles then return True else do - e_lib_times <- mapM (tryIO . getModificationUTCTime) - (catMaybes pkg_libfiles) - let (lib_errs,lib_times) = splitEithers e_lib_times - if not (null lib_errs) || any (t <) lib_times - then return True - else checkLinkInfo dflags pkg_deps exe_file -#endif panicBadLink :: GhcLink -> a panicBadLink other = panic ("link: GHC not built to link this way: " ++ show other) -linkDynLibCheck :: DynFlags -> [String] -> [PackageKey] -> IO () +linkDynLibCheck :: DynFlags -> [String] -> [InstalledUnitId] -> IO () linkDynLibCheck dflags o_files dep_packages = do when (haveRtsOptsFlags dflags) $ do - log_action dflags dflags NoReason SevInfo noSrcSpan defaultUserStyle + log_action dflags dflags NoReason SevInfo noSrcSpan (defaultUserStyle dflags) (text "Warning: -rtsopts and -with-rtsopts have no effect with -shared." $$ text " Call hs_init_ghc() from your main() function to set these options.") linkDynLib dflags o_files dep_packages -linkStaticLibCheck :: DynFlags -> [String] -> [PackageKey] -> IO () +linkStaticLibCheck :: DynFlags -> [String] -> [InstalledUnitId] -> IO () linkStaticLibCheck dflags o_files dep_packages = do when (platformOS (targetPlatform dflags) `notElem` [OSiOS, OSDarwin]) $ @@ -537,7 +517,7 @@ linkBinary' staticLink dflags o_files dep_packages = do -- linkBinary :: DynFlags -> [FilePath] -> [UnitId] -> IO () -- linkBinary = linkBinary' False -linkBinary' :: Bool -> DynFlags -> [FilePath] -> [UnitId] -> IO () +linkBinary' :: Bool -> DynFlags -> [FilePath] -> [InstalledUnitId] -> IO () linkBinary' staticLink dflags o_files dep_packages = do let platform = targetPlatform dflags mySettings = settings dflags @@ -562,8 +542,9 @@ linkBinary' staticLink dflags o_files dep_packages = do then "$ORIGIN" (l `makeRelativeTo` full_output_fn) else l + -- See Note [-Xlinker -rpath vs -Wl,-rpath] rpath = if gopt Opt_RPath dflags - then ["-Wl,-rpath", "-Wl," ++ libpath] + then ["-Xlinker", "-rpath", "-Xlinker", libpath] else [] -- Solaris 11's linker does not support -rpath-link option. It silently -- ignores it and then complains about next option which is -l (l `makeRelativeTo` full_output_fn) else l - in ["-L" ++ l] ++ ["-Wl,-rpath", "-Wl," ++ libpath] + in ["-L" ++ l] ++ ["-Xlinker", "-rpath", "-Xlinker", libpath] | otherwise = ["-L" ++ l] + let + dead_strip + | gopt Opt_WholeArchiveHsLibs dflags = [] + | otherwise = if osSubsectionsViaSymbols (platformOS platform) + then ["-Wl,-dead_strip"] + else [] let lib_paths = libraryPaths dflags let lib_path_opts = map ("-L"++) lib_paths extraLinkObj <- mkExtraObjToLinkIntoBinary dflags noteLinkObjs <- mkNoteObjsToLinkIntoBinary dflags dep_packages + let + (pre_hs_libs, post_hs_libs) + | gopt Opt_WholeArchiveHsLibs dflags + = if platformOS platform == OSDarwin + then (["-Wl,-all_load"], []) + -- OS X does not have a flag to turn off -all_load + else (["-Wl,--whole-archive"], ["-Wl,--no-whole-archive"]) + | otherwise + = ([],[]) + pkg_link_opts <- do (package_hs_libs, extra_libs, other_flags) <- getPackageLinkOpts dflags dep_packages return $ if staticLink @@ -600,16 +597,19 @@ linkBinary' staticLink dflags o_files dep_packages = do -- HS packages, because libtool doesn't accept other options. -- In the case of iOS these need to be added by hand to the -- final link in Xcode. - else other_flags ++ package_hs_libs ++ extra_libs -- -Wl,-u, contained in other_flags - -- needs to be put before -l, - -- otherwise Solaris linker fails linking - -- a binary with unresolved symbols in RTS - -- which are defined in base package - -- the reason for this is a note in ld(1) about - -- '-u' option: "The placement of this option - -- on the command line is significant. - -- This option must be placed before the library - -- that defines the symbol." + else other_flags ++ dead_strip + ++ pre_hs_libs ++ package_hs_libs ++ post_hs_libs + ++ extra_libs + -- -Wl,-u, contained in other_flags + -- needs to be put before -l, + -- otherwise Solaris linker fails linking + -- a binary with unresolved symbols in RTS + -- which are defined in base package + -- the reason for this is a note in ld(1) about + -- '-u' option: "The placement of this option + -- on the command line is significant. + -- This option must be placed before the library + -- that defines the symbol." -- frameworks pkg_framework_opts <- getPkgFrameworkOpts dflags platform dep_packages @@ -632,9 +632,8 @@ linkBinary' staticLink dflags o_files dep_packages = do let thread_opts | WayThreaded `elem` ways dflags = let os = platformOS (targetPlatform dflags) - in if os == OSOsf3 then ["-lpthread", "-lexc"] - else if os `elem` [OSMinGW32, OSFreeBSD, OSOpenBSD, - OSNetBSD, OSHaiku, OSQNXNTO, OSiOS, OSDarwin] + in if os `elem` [OSMinGW32, OSFreeBSD, OSOpenBSD, OSAndroid, + OSNetBSD, OSHaiku, OSQNXNTO, OSiOS, OSDarwin] then [] else ["-lpthread"] | otherwise = [] @@ -652,6 +651,11 @@ linkBinary' staticLink dflags o_files dep_packages = do ++ map SysTools.Option ( [] + -- See Note [No PIE eating when linking] + ++ (if sGccSupportsNoPie mySettings + then ["-no-pie"] + else []) + -- Permit the linker to auto link _symbol to _imp_symbol. -- This lets us link against DLLs without needing an "import library". ++ (if platformOS platform == OSMinGW32 @@ -697,7 +701,8 @@ linkBinary' staticLink dflags o_files dep_packages = do then ["-Wl,-read_only_relocs,suppress"] else []) - ++ (if sLdIsGnuLd mySettings + ++ (if sLdIsGnuLd mySettings && + not (gopt Opt_WholeArchiveHsLibs dflags) then ["-Wl,--gc-sections"] else []) @@ -753,7 +758,7 @@ ghcjsCompileCoreExpr hsc_env srcspan ds_expr = error "ghcjsCompileCoreExpr" {- Prepare for codegen -} ; prepd_expr <- corePrepExpr dflags hsc_env tidy_expr {- Lint if necessary -} - ; lintInteractiveExpr "hscCompileExpr" hsc_env prepd_expr + ; lintInteractiveExpr "hscCompileExpr" hsc_env prepd_expr {- Convert to BCOs -} ; bcos <- coreExprToBCOs dflags (icInteractiveModule (hsc_IC hsc_env)) prepd_expr {- link it -} @@ -803,4 +808,3 @@ throwCmdLineErrorS dflags = throwCmdLineError . showSDoc dflags throwCmdLineError :: String -> IO a throwCmdLineError = throwGhcExceptionIO . CmdLineError - diff --git a/src/Gen2/Foreign.hs b/src/Gen2/Foreign.hs index a6570f94..9c37c901 100644 --- a/src/Gen2/Foreign.hs +++ b/src/Gen2/Foreign.hs @@ -28,11 +28,7 @@ import ErrUtils import HscTypes import HsBinds import HsDecls -#if __GLASGOW_HASKELL__ >= 711 import Gen2.GHC.DsForeign (dsForeigns, dsForeigns', dsPrimCall) -#else -import DsForeign -#endif import DsMonad import Encoding import HsUtils @@ -54,6 +50,7 @@ import DataCon import Outputable import Coercion import Type +import RepType import TysWiredIn import TysPrim import CoreUtils @@ -78,9 +75,7 @@ import Gen2.PrimIface import Gen2.StgAst -- fixme -#if __GLASGOW_HASKELL__ >= 711 import GHC.LanguageExtensions -#endif import Data.Char import Data.List (stripPrefix) @@ -393,7 +388,7 @@ dsJsFExportDynamic id co0 _cconv = do let fun_ty = head arg_tys arg_id <- newSysLocalDs fun_ty let mkExport = mkFCallId dflags u - (CCall (CCallSpec (StaticTarget "h$mkExportDyn" (fsLit "h$mkExportDyn") Nothing True) JavaScriptCallConv PlayRisky)) + (CCall (CCallSpec (StaticTarget NoSourceText (fsLit "h$mkExportDyn") Nothing True) JavaScriptCallConv PlayRisky)) (mkFunTy addrPrimTy ty) mkExportTy = mkFunTy (mkFunTys arg_tys res_ty) unitTy (_fun_args0, _fun_r) = splitFunTys (dropForAlls fun_ty) @@ -412,66 +407,45 @@ dsJsFExportDynamic id co0 _cconv = do dsJsCall :: Id -> Coercion -> ForeignCall -> Maybe Header -> DsM ([(Id, Expr TyVar)], SDoc, SDoc) -#if __GLASGOW_HASKELL__ >= 711 -dsJsCall fn_id co fcall mDeclHeader = do - let - ty = pFst $ coercionKind co - (all_bndrs, io_res_ty) = tcSplitPiTys ty - (named_bndrs, arg_tys) = partitionBindersIntoBinders all_bndrs - tvs = map (binderVar "dsFCall") named_bndrs - -- Must use tcSplit* functions because we want to - -- see that (IO t) in the corner - - args <- newSysLocalsDs arg_tys - (val_args, arg_wrappers) <- mapAndUnzipM unboxJsArg (map Var args) - - let - work_arg_ids = [v | Var v <- val_args] -- All guaranteed to be vars - - (ccall_result_ty, res_wrapper) <- boxJsResult io_res_ty - - ccall_uniq <- newUnique - work_uniq <- newUnique - - dflags <- getDynFlags - let - -- Build the worker - worker_ty = mkForAllTys named_bndrs (mkFunTys (map idType work_arg_ids) ccall_result_ty) - the_ccall_app = mkFCall dflags ccall_uniq fcall val_args ccall_result_ty - work_rhs = mkLams tvs (mkLams work_arg_ids the_ccall_app) - work_id = mkSysLocal (fsLit "$wccall") work_uniq worker_ty - - -- Build the wrapper - work_app = mkApps (mkVarApps (Var work_id) tvs) val_args - wrapper_body = foldr ($) (res_wrapper work_app) arg_wrappers - wrap_rhs = mkLams (tvs ++ args) wrapper_body - wrap_rhs' = Cast wrap_rhs co - fn_id_w_inl = fn_id `setIdUnfolding` mkInlineUnfolding (Just (length args)) wrap_rhs' - - return ([(work_id, work_rhs), (fn_id_w_inl, wrap_rhs')], empty, empty) -#else dsJsCall fn_id co fcall _mDeclHeader = do - let - ty = pFst $ coercionKind co - (tvs, fun_ty) = tcSplitForAllTys ty - (arg_tys, io_res_ty) = tcSplitFunTys fun_ty - -- Must use tcSplit* functions because we want to - -- see that (IO t) in the corner + let + ty = pFst $ coercionKind co + (tv_bndrs, rho) = tcSplitForAllTyVarBndrs ty + (arg_tys, io_res_ty) = tcSplitFunTys rho - args <- newSysLocalsDs arg_tys - (val_args, arg_wrappers) <- mapAndUnzipM unboxJsArg (map Var args) + args <- newSysLocalsDs arg_tys + (val_args, arg_wrappers) <- mapAndUnzipM unboxJsArg (map Var args) - let work_arg_ids = [v | Var v <- val_args] -- All guaranteed to be vars + let + work_arg_ids = [v | Var v <- val_args] -- All guaranteed to be vars - (ccall_result_ty, res_wrapper) <- boxJsResult io_res_ty + (ccall_result_ty, res_wrapper) <- boxJsResult io_res_ty - ccall_uniq <- newUnique - work_uniq <- newUnique + ccall_uniq <- newUnique + work_uniq <- newUnique - dflags <- getDynFlags - let + dflags <- getDynFlags + + let + -- Build the worker + worker_ty = mkForAllTys tv_bndrs (mkFunTys (map idType work_arg_ids) ccall_result_ty) + tvs = map binderVar tv_bndrs + the_ccall_app = mkFCall dflags ccall_uniq fcall val_args ccall_result_ty + work_rhs = mkLams tvs (mkLams work_arg_ids the_ccall_app) + work_id = mkSysLocal (fsLit "$wccall") work_uniq worker_ty + + -- Build the wrapper + work_app = mkApps (mkVarApps (Var work_id) tvs) val_args + wrapper_body = foldr ($) (res_wrapper work_app) arg_wrappers + wrap_rhs = mkLams (tvs ++ args) wrapper_body + wrap_rhs' = Cast wrap_rhs co + fn_id_w_inl = fn_id `setIdUnfolding` mkInlineUnfoldingWithArity + (length args) wrap_rhs' + + return ([(work_id, work_rhs), (fn_id_w_inl, wrap_rhs')], empty, empty) +{- -- Build the worker - worker_ty = mkForAllTys tvs (mkFunTys (map idType work_arg_ids) ccall_result_ty) + worker_ty = mkForAllTys named_bndrs (mkFunTys (map idType work_arg_ids) ccall_result_ty) the_ccall_app = mkFCall dflags ccall_uniq fcall val_args ccall_result_ty work_rhs = mkLams tvs (mkLams work_arg_ids the_ccall_app) work_id = mkSysLocal (fsLit "$wccall") work_uniq worker_ty @@ -484,7 +458,7 @@ dsJsCall fn_id co fcall _mDeclHeader = do fn_id_w_inl = fn_id `setIdUnfolding` mkInlineUnfolding (Just (length args)) wrap_rhs' return ([(work_id, work_rhs), (fn_id_w_inl, wrap_rhs')], empty, empty) -#endif +-} mkHObj :: Type -> SDoc mkHObj t = text "rts_mk" <> text (showFFIType t) @@ -500,8 +474,8 @@ showFFIType t = getOccString (getName (typeTyCon t)) typeTyCon :: Type -> TyCon typeTyCon ty - | UnaryRep rep_ty <- repType ty - , Just (tc, _) <- tcSplitTyConApp_maybe rep_ty + -- | UnaryRep rep_ty <- repType ty + | Just (tc, _) <- tcSplitTyConApp_maybe (unwrapType ty) -- rep_ty = tc | otherwise = pprPanic "Gen2.Foreign.typeTyCon" (ppr ty) @@ -593,7 +567,7 @@ boxJSResult result_ty boxJsResult result_ty | Just (io_tycon, io_res_ty) <- tcSplitIOType_maybe result_ty - -- isIOType_maybe handles the case where the type is a + -- isIOType_maybe handles the case where the type is a -- simple wrapping of IO. E.g. -- newtype Wrap a = W (IO a) -- No coercion necessary because its a non-recursive newtype @@ -824,7 +798,7 @@ jsResultWrapper result_ty -- low-level primitive JavaScript call: mkJsCall :: DynFlags -> Unique -> String -> [CoreExpr] -> Type -> CoreExpr mkJsCall dflags u tgt args t = - mkFCall dflags u (CCall (CCallSpec (StaticTarget tgt (mkFastString tgt) + mkFCall dflags u (CCall (CCallSpec (StaticTarget NoSourceText (mkFastString tgt) (Just primPackageKey) True) JavaScriptCallConv PlayRisky)) args t @@ -850,7 +824,7 @@ getPrimTyOf ty prim_ty _other -> pprPanic "DsForeign.getPrimTyOf" (ppr ty) where - UnaryRep rep_ty = repType ty + rep_ty = unwrapType ty -- When the result of a foreign call is smaller than the word size, we -- need to sign- or zero-extend the result up to the word size. The C @@ -860,11 +834,9 @@ getPrimTyOf ty -- narrow int32 and word32 since JS numbers can contain more maybeJsNarrow :: DynFlags -> TyCon -> (CoreExpr -> CoreExpr) maybeJsNarrow _dflags tycon - | tycon `hasKey` intTyConKey = \e -> App (Var (mkGhcjsPrimOpId Narrow32IntOp)) e | tycon `hasKey` int8TyConKey = \e -> App (Var (mkGhcjsPrimOpId Narrow8IntOp)) e | tycon `hasKey` int16TyConKey = \e -> App (Var (mkGhcjsPrimOpId Narrow16IntOp)) e | tycon `hasKey` int32TyConKey = \e -> App (Var (mkGhcjsPrimOpId Narrow32IntOp)) e - | tycon `hasKey` wordTyConKey = \e -> App (Var (mkGhcjsPrimOpId Narrow32WordOp)) e | tycon `hasKey` word8TyConKey = \e -> App (Var (mkGhcjsPrimOpId Narrow8WordOp)) e | tycon `hasKey` word16TyConKey = \e -> App (Var (mkGhcjsPrimOpId Narrow16WordOp)) e | tycon `hasKey` word32TyConKey = \e -> App (Var (mkGhcjsPrimOpId Narrow32WordOp)) e @@ -902,7 +874,7 @@ ghcjsNativeDsForeigns fos = do convertForeignDecl _ x = x convertSpec :: DynFlags -> Located Id -> CImportSpec - convertSpec dflags i = CFunction (StaticTarget "" (stubName dflags (unLoc i)) Nothing True) + convertSpec dflags i = CFunction (StaticTarget NoSourceText (stubName dflags (unLoc i)) Nothing True) stubName :: DynFlags -> Id -> FastString stubName dflags i = mkFastString $ @@ -956,7 +928,7 @@ jsTySigLit dflags isResult t | isResult, Just (_ ,result) <- tcSplitIOType_maybe where tcSig :: Bool -> TyCon -> (String, Char) tcSig isResult tc - | isUnliftedTyCon tc = prim (tyConPrimRep tc) + | isUnliftedTyCon tc, [tt] <- tyConPrimRep tc = prim tt -- = prim (tyConPrimRep tc) | Just r <- lookup (getUnique tc) boxed = r | isResult && getUnique tc == unitTyConKey = ("void", 'v') | isJSValTyCon dflags tc = ("StgPtr", 'r') @@ -965,7 +937,9 @@ jsTySigLit dflags isResult t | isResult, Just (_ ,result) <- tcSplitIOType_maybe where -- fixme is there already a list of these somewhere else? prim VoidRep = error "jsTySigLit: VoidRep" - prim PtrRep = hsPtr + prim LiftedRep = hsPtr + prim UnliftedRep = hsPtr -- fixme? + -- prim PtrRep = hsPtr prim IntRep = hsInt prim WordRep = hsWord prim Int64Rep = hsInt64 @@ -1072,7 +1046,7 @@ isGhcjsFFIImportResultTy dflags ty where check ty | Just (tc, args) <- tcSplitTyConApp_maybe ty , getUnique tc == liftedTypeKindTyConKey - || getUnique tc == unliftedTypeKindTyConKey = IsValid + {- || getUnique tc == unliftedTypeKindTyConKey -} = IsValid -- fixme | isValid (isGhcjsFFIImportResultTy' dflags ty) = IsValid | isGhcjsFFITy dflags ty = IsValid | otherwise = NotValid (text $ "") diff --git a/src/Gen2/GHC/DsForeign.hs b/src/Gen2/GHC/DsForeign.hs index ca7a1436..ec73018e 100644 --- a/src/Gen2/GHC/DsForeign.hs +++ b/src/Gen2/GHC/DsForeign.hs @@ -26,6 +26,7 @@ import Literal import Module import Name import Type +import RepType import TyCon import Coercion import TcEnv @@ -194,15 +195,9 @@ dsFCall :: Id -> Coercion -> ForeignCall -> Maybe Header -> DsM ([(Id, Expr TyVar)], SDoc, SDoc) dsFCall fn_id co fcall mDeclHeader = do let - ty = pFst $ coercionKind co - (all_bndrs, io_res_ty) = tcSplitPiTys ty - (named_bndrs, arg_tys) = partitionBindersIntoBinders all_bndrs - tvs = -- ASSERT( fst (span isNamedBinder all_bndrs) - -- `equalLength` named_bndrs ) - -- ensure that the named binders all come first - map (binderVar "dsFCall") named_bndrs - -- Must use tcSplit* functions because we want to - -- see that (IO t) in the corner + ty = pFst $ coercionKind co + (tv_bndrs, rho) = tcSplitForAllTyVarBndrs ty + (arg_tys, io_res_ty) = tcSplitFunTys rho args <- newSysLocalsDs arg_tys (val_args, arg_wrappers) <- mapAndUnzipM unboxArg (map Var args) @@ -222,7 +217,7 @@ dsFCall fn_id co fcall mDeclHeader = do CApiConv safety) -> do wrapperName <- mkWrapperName "ghc_wrapper" (unpackFS cName) let fcall' = CCall (CCallSpec - (StaticTarget (unpackFS wrapperName) + (StaticTarget NoSourceText wrapperName mUnitId True) CApiConv safety) @@ -265,7 +260,8 @@ dsFCall fn_id co fcall mDeclHeader = do return (fcall, empty) let -- Build the worker - worker_ty = mkForAllTys named_bndrs (mkFunTys (map idType work_arg_ids) ccall_result_ty) + worker_ty = mkForAllTys tv_bndrs (mkFunTys (map idType work_arg_ids) ccall_result_ty) + tvs = map binderVar tv_bndrs the_ccall_app = mkFCall dflags ccall_uniq fcall' val_args ccall_result_ty work_rhs = mkLams tvs (mkLams work_arg_ids the_ccall_app) work_id = mkSysLocal (fsLit "$wccall") work_uniq worker_ty @@ -275,8 +271,22 @@ dsFCall fn_id co fcall mDeclHeader = do wrapper_body = foldr ($) (res_wrapper work_app) arg_wrappers wrap_rhs = mkLams (tvs ++ args) wrapper_body wrap_rhs' = Cast wrap_rhs co - fn_id_w_inl = fn_id `setIdUnfolding` mkInlineUnfolding (Just (length args)) wrap_rhs' + fn_id_w_inl = fn_id `setIdUnfolding` mkInlineUnfoldingWithArity + (length args) wrap_rhs' +{- + -- Build the worker + worker_ty = mkForAllTys tv_bndrs (mkFunTys (map idType work_arg_ids) ccall_result_ty) + the_ccall_app = mkFCall dflags ccall_uniq fcall' val_args ccall_result_ty + work_rhs = mkLams tvs (mkLams work_arg_ids the_ccall_app) + work_id = mkSysLocal (fsLit "$wccall") work_uniq worker_ty + -- Build the wrapper + work_app = mkApps (mkVarApps (Var work_id) tvs) val_args + wrapper_body = foldr ($) (res_wrapper work_app) arg_wrappers + wrap_rhs = mkLams (tvs ++ args) wrapper_body + wrap_rhs' = Cast wrap_rhs co + fn_id_w_inl = fn_id `setIdUnfolding` mkInlineUnfolding (Just (length args)) wrap_rhs' +-} return ([(work_id, work_rhs), (fn_id_w_inl, wrap_rhs')], empty, cDoc) {- @@ -299,11 +309,8 @@ dsPrimCall :: Id -> Coercion -> ForeignCall dsPrimCall fn_id co fcall = do let ty = pFst $ coercionKind co - (bndrs, io_res_ty) = tcSplitPiTys ty - (tvs, arg_tys) = partitionBinders bndrs - -- Must use tcSplit* functions because we want to - -- see that (IO t) in the corner - + (tvs, fun_ty) = tcSplitForAllTys ty + (arg_tys, io_res_ty) = tcSplitFunTys fun_ty -- MASSERT( fst (span isNamedBinder bndrs) `equalLength` tvs ) args <- newSysLocalsDs arg_tys @@ -479,10 +486,10 @@ dsFExportDynamic id co0 cconv = do return ([fed], h_code, c_code) where - ty = pFst (coercionKind co0) - (bndrs, fn_res_ty) = tcSplitPiTys ty - (tvs, [arg_ty]) = partitionBinders bndrs - Just (io_tc, res_ty) = tcSplitIOType_maybe fn_res_ty + ty = pFst (coercionKind co0) + (tvs,sans_foralls) = tcSplitForAllTys ty + ([arg_ty], fn_res_ty) = tcSplitFunTys sans_foralls + Just (io_tc, res_ty) = tcSplitIOType_maybe fn_res_ty -- Must have an IO type; hence Just @@ -547,10 +554,10 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc type_string -- libffi needs to know the result type too: - | libffi = primTyDescChar dflags res_hty : arg_type_string + | libffi = primTyDescChar dflags res_hty ++ arg_type_string | otherwise = arg_type_string - arg_type_string = [primTyDescChar dflags ty | (_,_,ty,_) <- arg_info] + arg_type_string = concat [primTyDescChar dflags ty | (_,_,ty,_) <- arg_info] -- just the real args -- add some auxiliary args; the stable ptr in the wrapper case, and @@ -731,8 +738,7 @@ toCType = f False typeTyCon :: Type -> TyCon typeTyCon ty - | UnaryRep rep_ty <- repType ty - , Just (tc, _) <- tcSplitTyConApp_maybe rep_ty + | Just (tc, _) <- tcSplitTyConApp_maybe (unwrapType ty) = tc | otherwise = pprPanic "DsForeign.typeTyCon" (ppr ty) @@ -791,25 +797,26 @@ getPrimTyOf ty prim_ty _other -> pprPanic "DsForeign.getPrimTyOf" (ppr ty) where - UnaryRep rep_ty = repType ty + rep_ty = unwrapType ty -- represent a primitive type as a Char, for building a string that -- described the foreign function type. The types are size-dependent, -- e.g. 'W' is a signed 32-bit integer. -primTyDescChar :: DynFlags -> Type -> Char +primTyDescChar :: DynFlags -> Type -> String primTyDescChar dflags ty - | ty `eqType` unitTy = 'v' + | ty `eqType` unitTy = "v" | otherwise - = case typePrimRep (getPrimTyOf ty) of - IntRep -> signed_word - WordRep -> unsigned_word - Int64Rep -> 'L' - Word64Rep -> 'l' - AddrRep -> 'p' - FloatRep -> 'f' - DoubleRep -> 'd' - _ -> pprPanic "primTyDescChar" (ppr ty) + = map repChar (typePrimRep (getPrimTyOf ty)) where + repChar r = case r of + IntRep -> signed_word + WordRep -> unsigned_word + Int64Rep -> 'L' + Word64Rep -> 'l' + AddrRep -> 'p' + FloatRep -> 'f' + DoubleRep -> 'd' + _ -> pprPanic "primTyDescChar" (ppr ty) (signed_word, unsigned_word) | wORD_SIZE dflags == 4 = ('W','w') | wORD_SIZE dflags == 8 = ('L','l') diff --git a/src/Gen2/GHC/PrelRules.hs b/src/Gen2/GHC/PrelRules.hs index 78f41be8..b5008cb1 100644 --- a/src/Gen2/GHC/PrelRules.hs +++ b/src/Gen2/GHC/PrelRules.hs @@ -15,19 +15,24 @@ ToDo: {-# LANGUAGE CPP, RankNTypes #-} {-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-} -module Gen2.GHC.PrelRules ( primOpRules, builtinRules ) where +module Gen2.GHC.PrelRules + ( primOpRules + , builtinRules + , caseRules + ) +where -- #include "HsVersions.h" -- #include "../includes/MachDeps.h" -import {- {-# SOURCE #-} -} MkId ( {- mkPrimOpId, -} magicDictId ) +import MkId ( {- mkPrimOpId, -} magicDictId ) import {-# SOURCE #-} Gen2.PrimIface import CoreSyn import MkCore import Id import Literal -import CoreSubst ( exprIsLiteral_maybe ) +import CoreOpt ( exprIsLiteral_maybe ) import PrimOp ( PrimOp(..), tagToEnumKey ) import TysWiredIn import TysPrim @@ -48,11 +53,7 @@ import Platform import Util import Coercion (mkUnbranchedAxInstCo,mkSymCo,Role(..)) -#if __GLASGOW_HASKELL__ >= 709 import Control.Applicative ( Alternative(..) ) -#else -import Control.Applicative ( Applicative(..), Alternative(..) ) -#endif import Control.Monad #if __GLASGOW_HASKELL__ > 710 @@ -64,6 +65,8 @@ import Data.Int import Data.Ratio import Data.Word +import qualified Debug.Trace + {- Note [Constant folding] ~~~~~~~~~~~~~~~~~~~~~~~ @@ -176,7 +179,7 @@ primOpRules nm Narrow32IntOp = mkPrimOpRule nm 1 [ liftLit narrow32IntLit , subsumedByPrimOp Narrow8IntOp , subsumedByPrimOp Narrow16IntOp , subsumedByPrimOp Narrow32IntOp - , removeOp32 ] + {- , removeOp32 -} ] primOpRules nm Narrow8WordOp = mkPrimOpRule nm 1 [ liftLit narrow8WordLit , subsumedByPrimOp Narrow8WordOp , Narrow8WordOp `subsumesPrimOp` Narrow16WordOp @@ -189,7 +192,7 @@ primOpRules nm Narrow32WordOp = mkPrimOpRule nm 1 [ liftLit narrow32WordLit , subsumedByPrimOp Narrow8WordOp , subsumedByPrimOp Narrow16WordOp , subsumedByPrimOp Narrow32WordOp - , removeOp32 ] + {- , removeOp32 -} ] primOpRules nm OrdOp = mkPrimOpRule nm 1 [ liftLit char2IntLit , inversePrimOp ChrOp ] primOpRules nm ChrOp = mkPrimOpRule nm 1 [ do [Lit lit] <- getArgs @@ -539,24 +542,50 @@ isMaxBound _ (MachWord64 i) = i == toInteger (maxBound :: Word64) isMaxBound _ _ = False --- Note that we *don't* warn the user about overflow. It's not done at --- runtime either, and compilation of completely harmless things like +-- Note [Word/Int underflow/overflow] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- According to the Haskell Report 2010 (Sections 18.1 and 23.1 about signed and +-- unsigned integral types): "All arithmetic is performed modulo 2^n, where n is +-- the number of bits in the type." +-- +-- GHC stores Word# and Int# constant values as Integer. Core optimizations such +-- as constant folding must ensure that the Integer value remains in the valid +-- target Word/Int range (see #13172). The following functions are used to +-- ensure this. +-- +-- Note that we *don't* warn the user about overflow. It's not done at runtime +-- either, and compilation of completely harmless things like -- ((124076834 :: Word32) + (2147483647 :: Word32)) --- would yield a warning. Instead we simply squash the value into the --- *target* Int/Word range. +-- doesn't yield a warning. Instead we simply squash the value into the *target* +-- Int/Word range. + +-- | Ensure the given Integer is in the target Int range +intResult' :: DynFlags -> Integer -> Integer +intResult' dflags result = case platformWordSize (targetPlatform dflags) of + 4 -> toInteger (fromInteger result :: Int32) + 8 -> toInteger (fromInteger result :: Int64) + w -> panic ("intResult: Unknown platformWordSize: " ++ show w) + +-- | Ensure the given Integer is in the target Word range +wordResult' :: DynFlags -> Integer -> Integer +wordResult' dflags result = case platformWordSize (targetPlatform dflags) of + 4 -> toInteger (fromInteger result :: Word32) + 8 -> toInteger (fromInteger result :: Word64) + w -> panic ("wordResult: Unknown platformWordSize: " ++ show w) + +-- | Create an Int literal expression while ensuring the given Integer is in the +-- target Int range intResult :: DynFlags -> Integer -> Maybe CoreExpr -intResult dflags result = Just (mkIntVal dflags result') - where result' = case platformWordSize (targetPlatform dflags) of - 4 -> toInteger (fromInteger result :: Int32) - 8 -> toInteger (fromInteger result :: Int64) - w -> panic ("intResult: Unknown platformWordSize: " ++ show w) +intResult dflags result = Just (mkIntVal dflags (intResult' dflags result)) +-- | Create a Word literal expression while ensuring the given Integer is in the +-- target Word range wordResult :: DynFlags -> Integer -> Maybe CoreExpr -wordResult dflags result = Just (mkWordVal dflags result') - where result' = case platformWordSize (targetPlatform dflags) of - 4 -> toInteger (fromInteger result :: Word32) - 8 -> toInteger (fromInteger result :: Word64) - w -> panic ("wordResult: Unknown platformWordSize: " ++ show w) +wordResult dflags result = Just (mkWordVal dflags (wordResult' dflags result)) + + + inversePrimOp :: PrimOp -> RuleM CoreExpr inversePrimOp primop = do @@ -655,7 +684,6 @@ instance Applicative RuleM where (<*>) = ap instance Monad RuleM where - return = pure RuleM f >>= g = RuleM $ \dflags iu e -> case f dflags iu e of Nothing -> Nothing Just r -> runRuleM (g r) dflags iu e @@ -667,13 +695,11 @@ instance MonadFail.MonadFail RuleM where #endif instance Alternative RuleM where - empty = mzero - (<|>) = mplus + empty = RuleM $ \_ _ _ -> Nothing + RuleM f1 <|> RuleM f2 = RuleM $ \dflags iu args -> + f1 dflags iu args <|> f2 dflags iu args -instance MonadPlus RuleM where - mzero = RuleM $ \_ _ _ -> Nothing - mplus (RuleM f1) (RuleM f2) = RuleM $ \dflags iu args -> - f1 dflags iu args `mplus` f2 dflags iu args +instance MonadPlus RuleM instance HasDynFlags RuleM where getDynFlags = RuleM $ \dflags _ _ -> Just dflags @@ -692,16 +718,13 @@ liftLitDynFlags f = do return $ Lit (f dflags lit) removeOp32 :: RuleM CoreExpr -removeOp32 = mzero -{- removed for GHCJS - do +removeOp32 = {- do dflags <- getDynFlags if wordSizeInBits dflags == 32 then do [e] <- getArgs return e - else mzero --} + else -} mzero getArgs :: RuleM [CoreExpr] getArgs = RuleM $ \_ _ args -> Just args @@ -993,25 +1016,43 @@ builtinRules :: [CoreRule] builtinRules = [BuiltinRule { ru_name = fsLit "AppendLitString", ru_fn = unpackCStringFoldrName, - ru_nargs = 4, ru_try = \_ _ _ -> match_append_lit }, + ru_nargs = 4, ru_try = match_append_lit }, BuiltinRule { ru_name = fsLit "EqString", ru_fn = eqStringName, - ru_nargs = 2, ru_try = \dflags _ _ -> match_eq_string dflags }, + ru_nargs = 2, ru_try = match_eq_string }, BuiltinRule { ru_name = fsLit "Inline", ru_fn = inlineIdName, ru_nargs = 2, ru_try = \_ _ _ -> match_inline }, BuiltinRule { ru_name = fsLit "MagicDict", ru_fn = idName magicDictId, - ru_nargs = 4, ru_try = \_ _ _ -> match_magicDict } + ru_nargs = 4, ru_try = \_ _ _ -> match_magicDict }, + mkBasicRule divIntName 2 $ msum + [ nonZeroLit 1 >> binaryLit (intOp2 div) + , leftZero zeroi + , do + [arg, Lit (MachInt d)] <- getArgs + Just n <- return $ exactLog2 d + dflags <- getDynFlags + return $ Var (mkGhcjsPrimOpId ISraOp) `App` arg `App` mkIntVal dflags n + ], + mkBasicRule modIntName 2 $ msum + [ nonZeroLit 1 >> binaryLit (intOp2 mod) + , leftZero zeroi + , do + [arg, Lit (MachInt d)] <- getArgs + Just _ <- return $ exactLog2 d + dflags <- getDynFlags + return $ Var (mkGhcjsPrimOpId AndIOp) + `App` arg `App` mkIntVal dflags (d - 1) + ] ] ++ builtinIntegerRules -mkWordLitWord' :: DynFlags -> Word -> Expr b -mkWordLitWord' dflags w = - let w32 = fromIntegral w :: Word32 - in mkWordLitWord dflags (fromIntegral w32) +-- workaround for incorrect truncation with 64 bit host, 32 bit target +-- (truncating to Word or Int gives incorrect results if the host/target +-- word size are different) +mkWordLitWord32 :: DynFlags -> Word32 -> Expr b +mkWordLitWord32 dflags w = Lit (mkMachWord dflags (toInteger w)) -mkIntLitInt' :: DynFlags -> Int -> Expr b -mkIntLitInt' dflags i = - let i32 = fromIntegral i :: Int32 - in mkIntLitInt dflags (fromIntegral i32) +mkIntLitInt32 :: DynFlags -> Int32 -> Expr b +mkIntLitInt32 dflags n = Lit (mkMachInt dflags (toInteger n)) builtinIntegerRules :: [CoreRule] builtinIntegerRules = @@ -1019,8 +1060,8 @@ builtinIntegerRules = rule_WordToInteger "wordToInteger" wordToIntegerName, rule_Int64ToInteger "int64ToInteger" int64ToIntegerName, rule_Word64ToInteger "word64ToInteger" word64ToIntegerName, - rule_convert "integerToWord" integerToWordName mkWordLitWord', - rule_convert "integerToInt" integerToIntName mkIntLitInt', + rule_convert "integerToWord" integerToWordName mkWordLitWord32, + rule_convert "integerToInt" integerToIntName mkIntLitInt32, rule_convert "integerToWord64" integerToWord64Name (\_ -> mkWord64LitWord64), rule_convert "integerToInt64" integerToInt64Name (\_ -> mkInt64LitInt64), rule_binop "plusInteger" plusIntegerName (+), @@ -1130,37 +1171,42 @@ builtinIntegerRules = -- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n) -- = unpackFoldrCString# "foobaz" c n -match_append_lit :: [Expr CoreBndr] -> Maybe (Expr CoreBndr) -match_append_lit [Type ty1, - Lit (MachStr s1), - c1, - Var unpk `App` Type ty2 - `App` Lit (MachStr s2) - `App` c2 - `App` n - ] +match_append_lit :: RuleFun +match_append_lit _ id_unf _ + [ Type ty1 + , lit1 + , c1 + , Var unpk `App` Type ty2 + `App` lit2 + `App` c2 + `App` n + ] | unpk `hasKey` unpackCStringFoldrIdKey && c1 `cheapEqExpr` c2 + , Just (MachStr s1) <- exprIsLiteral_maybe id_unf lit1 + , Just (MachStr s2) <- exprIsLiteral_maybe id_unf lit2 = -- ASSERT( ty1 `eqType` ty2 ) Just (Var unpk `App` Type ty1 `App` Lit (MachStr (s1 `BS.append` s2)) `App` c1 `App` n) -match_append_lit _ = Nothing +match_append_lit _ _ _ _ = Nothing --------------------------------------------------- -- The rule is this: -- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2 -match_eq_string :: DynFlags -> [Expr CoreBndr] -> Maybe (Expr CoreBndr) -match_eq_string _ [Var unpk1 `App` Lit (MachStr s1), - Var unpk2 `App` Lit (MachStr s2)] - | unpk1 `hasKey` unpackCStringIdKey, - unpk2 `hasKey` unpackCStringIdKey +match_eq_string :: RuleFun +match_eq_string _ id_unf _ + [Var unpk1 `App` lit1, Var unpk2 `App` lit2] + | unpk1 `hasKey` unpackCStringIdKey + , unpk2 `hasKey` unpackCStringIdKey + , Just (MachStr s1) <- exprIsLiteral_maybe id_unf lit1 + , Just (MachStr s2) <- exprIsLiteral_maybe id_unf lit2 = Just (if s1 == s2 then trueValBool else falseValBool) -match_eq_string _ _ = Nothing +match_eq_string _ _ _ _ = Nothing --------------------------------------------------- @@ -1245,7 +1291,8 @@ match_Integer_convert :: Num a -> RuleFun match_Integer_convert convert dflags id_unf _ [xl] | Just (LitInteger x _) <- exprIsLiteral_maybe id_unf xl - = Just (convert dflags (fromInteger x)) + = -- Debug.Trace.trace ("integer convert match: " ++ show x) + (Just (convert dflags (fromInteger x))) match_Integer_convert _ _ _ _ _ = Nothing match_Integer_unop :: (Integer -> Integer) -> RuleFun @@ -1387,3 +1434,57 @@ match_smallIntegerTo primOp _ _ _ [App (Var x) y] | idName x == smallIntegerName = Just $ App (Var (mkGhcjsPrimOpId primOp)) y match_smallIntegerTo _ _ _ _ _ = Nothing + + + +-------------------------------------------------------- +-- Constant folding through case-expressions +-- +-- cf Scrutinee Constant Folding in simplCore/SimplUtils +-------------------------------------------------------- + +-- | Match the scrutinee of a case and potentially return a new scrutinee and a +-- function to apply to each literal alternative. +caseRules :: DynFlags -> CoreExpr -> Maybe (CoreExpr, Integer -> Integer) +caseRules dflags scrut = case scrut of + + -- We need to call wordResult' and intResult' to ensure that the literal + -- alternatives remain in Word/Int target ranges (cf Note [Word/Int + -- underflow/overflow] and #13172). + + -- v `op` x# + App (App (Var f) v) (Lit l) + | Just op <- isPrimOpId_maybe f + , Just x <- isLitValue_maybe l -> + case op of + WordAddOp -> Just (v, \y -> wordResult' dflags $ y-x ) + IntAddOp -> Just (v, \y -> intResult' dflags $ y-x ) + WordSubOp -> Just (v, \y -> wordResult' dflags $ y+x ) + IntSubOp -> Just (v, \y -> intResult' dflags $ y+x ) + XorOp -> Just (v, \y -> wordResult' dflags $ y `xor` x) + XorIOp -> Just (v, \y -> intResult' dflags $ y `xor` x) + _ -> Nothing + + -- x# `op` v + App (App (Var f) (Lit l)) v + | Just op <- isPrimOpId_maybe f + , Just x <- isLitValue_maybe l -> + case op of + WordAddOp -> Just (v, \y -> wordResult' dflags $ y-x ) + IntAddOp -> Just (v, \y -> intResult' dflags $ y-x ) + WordSubOp -> Just (v, \y -> wordResult' dflags $ x-y ) + IntSubOp -> Just (v, \y -> intResult' dflags $ x-y ) + XorOp -> Just (v, \y -> wordResult' dflags $ y `xor` x) + XorIOp -> Just (v, \y -> intResult' dflags $ y `xor` x) + _ -> Nothing + + -- op v + App (Var f) v + | Just op <- isPrimOpId_maybe f -> + case op of + NotOp -> Just (v, \y -> wordResult' dflags $ complement y) + NotIOp -> Just (v, \y -> intResult' dflags $ complement y) + IntNegOp -> Just (v, \y -> intResult' dflags $ negate y ) + _ -> Nothing + + _ -> Nothing diff --git a/src/Gen2/Generator.hs b/src/Gen2/Generator.hs index 2dac6c95..42d80a24 100644 --- a/src/Gen2/Generator.hs +++ b/src/Gen2/Generator.hs @@ -26,10 +26,12 @@ import Unique import StgSyn import PrimOp import Module +import VarSet import Panic import TyCon import Util import Type hiding (typeSize) +import RepType import Name import GHC import Id @@ -40,7 +42,8 @@ import Control.Lens hiding ((||=)) import Control.Monad.State.Strict import Data.Array -import Data.Bits ((.|.), shiftL, shiftR, (.&.), testBit, xor, complement) +import Data.Bits + ((.|.), shiftL, shiftR, (.&.), testBit, xor, complement) import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL @@ -54,7 +57,8 @@ import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as IM import qualified Data.IntSet as IS import Data.Monoid -import Data.Maybe (isJust, isNothing, catMaybes, fromMaybe, maybeToList, listToMaybe) +import Data.Maybe + (isJust, isNothing, catMaybes, fromMaybe, maybeToList, listToMaybe) import Data.Map (Map) import qualified Data.Map as M import Data.Set (Set) @@ -72,6 +76,7 @@ import Compiler.Compat import Compiler.Settings import Gen2.Base +import Gen2.Deps import Gen2.Utils import Gen2.Prim import Gen2.Rts @@ -87,11 +92,19 @@ import Gen2.Sinker import Gen2.Profiling import qualified Gen2.Compactor as Compactor -import qualified Debug.Trace +import qualified Control.Exception + +-- debug +import Gen2.Printer (pretty) + +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TLE +import Text.PrettyPrint.Leijen.Text (displayT, renderPretty) + data DependencyDataCache = DDC - { _ddcModule :: !(IntMap Object.Package) -- Unique Module -> Object.Package - , _ddcId :: !(IntMap Object.Fun) -- Unique Id -> Object.Fun (only to other modules) + { _ddcModule :: !(IntMap Object.Package) -- ^ Unique Module -> Object.Package + , _ddcId :: !(IntMap Object.Fun) -- ^ Unique Id -> Object.Fun (only to other modules) , _ddcOther :: !(Map OtherSymb Object.Fun) } @@ -103,13 +116,19 @@ data ExprCtx = ExprCtx { _ctxTop :: Id , _ctxTarget :: [JExpr] , _ctxEval :: UniqSet Id - , _ctxLne :: UniqSet Id -- all lne-bound things - , _ctxLneFrameBs :: UniqFM Int -- binds in current lne frame (defined at size) - , _ctxLneFrame :: [(Id,Int)] -- contents of current lne frame + , _ctxLne :: UniqSet Id -- ^ all lne-bound things + , _ctxLneFrameBs :: UniqFM Int -- ^ binds in current lne frame (defined at size) + , _ctxLneFrame :: [(Id,Int)] -- ^ contents of current lne frame } makeLenses ''ExprCtx +instance Show ExprCtx where + show (ExprCtx top tgt eval lne _lnefbs lnef) = + "ExprCtx\n" ++ unlines [show top, show tgt, sus eval, sus lne, show lnef] + where + sus = show . nonDetEltsUniqSet + clearCtxStack :: ExprCtx -> ExprCtx clearCtxStack ctx = ctx & ctxLneFrameBs .~ emptyUFM & ctxLneFrame .~ [] @@ -128,22 +147,25 @@ addEval i = over ctxEval (flip addOneToUniqSet i) generate :: GhcjsSettings -> DynFlags -> Module - -> StgPgm + -> [StgTopBinding] -- StgPgm -> CollectedCCs -> ByteString -- ^ binary data for the .js_o object file generate settings df m s cccs = let (uf, s') = sinkPgm m s - in flip evalState (initState df m uf) $ do + in trace' ("generate\n" ++ intercalate "\n\n" (map showIndent s)) $ + + flip evalState (initState df m uf) $ do ifProfiling' $ initCostCentres cccs (st, lus) <- genUnits df m s' -- (exported symbol names, javascript statements) for each linkable unit - p <- forM lus $ \u -> mapM (fmap (\(TxtI i) -> i) . jsIdI) (luIdExports u) >>= - \ts -> return (ts ++ luOtherExports u, luStat u) + p <- forM lus $ \u -> + mapM (fmap (\(TxtI i) -> i) . jsIdI) (luIdExports u) >>= + \ts -> return (ts ++ luOtherExports u, luStat u) let (st', dbg) = dumpAst st settings df s' deps <- genDependencyData df m lus - return . BL.toStrict $ - Object.object' st' deps (p ++ dbg) -- p first, so numbering of linkable units lines up - + -- p first, so numbering of linkable units lines up + pure . BL.toStrict $ + Object.object' st' deps (p ++ dbg) {- | Generate an extra linkable unit for the object file if -debug is active. this unit is never actually linked, but it contains the optimized STG AST @@ -153,7 +175,7 @@ generate settings df m s cccs = dumpAst :: Object.SymbolTable -> GhcjsSettings -> DynFlags - -> StgPgm + -> [StgTopBinding] -> (Object.SymbolTable, [([Text], BL.ByteString)]) dumpAst st _settings dflags s | buildingDebug dflags = (st', [(["h$debug", "h$dumpAst"], bs)]) @@ -179,43 +201,71 @@ data LinkableUnit = LinkableUnit } deriving (Eq, Ord, Show) -- | Generate the ingredients for the linkable units for this module -genUnits :: DynFlags +genUnits :: HasDebugCallStack + => DynFlags -> Module - -> StgPgm + -> [StgTopBinding] -- StgPgm -> G (Object.SymbolTable, [LinkableUnit]) -- ^ the final symbol table and the linkable units genUnits dflags m ss = generateGlobalBlock =<< go 2 Object.emptySymbolTable ss where - go :: Int -- ^ the block we're generating (block 0 is the global unit for the module) + -- ss' = [l | StgTopLifted l <- ss] + + go :: HasDebugCallStack + => Int -- ^ the block we're generating (block 0 is the global unit for the module) -> Object.SymbolTable -- ^ the shared symbol table - -> StgPgm + -> [StgTopBinding] -> G (Object.SymbolTable, [LinkableUnit]) go n st (x:xs) = do - (st', lu) <- generateBlock st x n + (st', mlu) <- generateBlock st x n (st'', lus) <- go (n+1) st' xs - return (st'', lu:lus) + return (st'', maybe lus (:lus) mlu) go _ st [] = return (st, []) -- | Generate the global unit that all other blocks in the module depend on -- used for cost centres and static initializers -- the global unit has no dependencies, exports the moduleGlobalSymbol - generateGlobalBlock :: (Object.SymbolTable, [LinkableUnit]) + generateGlobalBlock :: HasDebugCallStack + => (Object.SymbolTable, [LinkableUnit]) -> G (Object.SymbolTable, [LinkableUnit]) generateGlobalBlock (st, lus) = do glbl <- use gsGlobal - staticInit <- initStaticPtrs (collectStaticInfo ss) + staticInit <- + initStaticPtrs (collectStaticInfo [l | StgTopLifted l <- ss]) (st', [], bs) <- serializeLinkableUnit m st [] [] [] . O.optimize . jsSaturate (Just $ modulePrefix m 1) $ mconcat (reverse glbl) <> staticInit - return (st', LinkableUnit bs [] [moduleGlobalSymbol dflags m] [] [] False : lus) + return ( st' + , LinkableUnit bs + [] + [moduleGlobalSymbol dflags m] + [] + [] + False + : lus + ) -- | Generate the linkable unit for one binding or group of -- mutually recursive bindings - generateBlock :: Object.SymbolTable - -> StgBinding + generateBlock :: HasDebugCallStack + => Object.SymbolTable + -> StgTopBinding -> Int - -> G (Object.SymbolTable, LinkableUnit) - generateBlock st decl n = do + -> G (Object.SymbolTable, Maybe LinkableUnit) + generateBlock st (StgTopStringLit bnd str) n = do + [b1@(TxtI b1t),b2@(TxtI b2t)] <- genIdsI bnd + -- [e1,e2] <- genLit (MachStr str) + emitStatic b1t (StaticUnboxed (StaticUnboxedString str)) Nothing + emitStatic b2t (StaticUnboxed (StaticUnboxedStringOffset str)) Nothing + extraTl <- use (gsGroup . ggsToplevelStats) + si <- use (gsGroup . ggsStatic) + let stat = mempty -- mconcat (reverse extraTl) <> b1 ||= e1 <> b2 ||= e2 + (st', _ss, bs) <- serializeLinkableUnit m st [bnd] [] si $ + jsSaturate (Just $ modulePrefix m n) stat + pure (st', Just $ LinkableUnit bs [bnd] [] [] [] False) + generateBlock st (StgTopLifted decl) n = + trace' ("generateBlock:\n" ++ showIndent decl) $ + do tl <- genToplevel decl extraTl <- use (gsGroup . ggsToplevelStats) ci <- use (gsGroup . ggsClosureInfo) @@ -231,7 +281,7 @@ genUnits dflags m ss = generateGlobalBlock =<< go 2 Object.emptySymbolTable ss . jsSaturate (Just $ modulePrefix m n) $ mconcat (reverse extraTl) <> tl return $! seqList topDeps `seq` seqList allDeps `seq` st' `seq` - (st', LinkableUnit bs topDeps [] allDeps (S.toList extraDeps) required) + (st', Just $ LinkableUnit bs topDeps [] allDeps (S.toList extraDeps) required) data SomeStaticPtr = SomeStaticPtr { sspId :: Id @@ -247,62 +297,53 @@ initStaticPtrs ptrs = mconcat <$> mapM initStatic ptrs i <- jsId (sspId p) let Fingerprint w1 w2 = sspFingerprint p fpa <- concat <$> mapM (genLit . MachWord64 . fromIntegral) [w1,w2] - let sptInsert = ApplExpr (ValExpr (JVar (TxtI "h$hs_spt_insert"))) (fpa ++ [i]) + let sptInsert = ApplExpr (ValExpr (JVar (TxtI "h$hs_spt_insert"))) + (fpa ++ [i]) return [j| h$initStatic.push(function() { `sptInsert`; }) |] -collectStaticInfo :: StgPgm -> [SomeStaticPtr] -#if __GLASGOW_HASKELL__ >= 709 +collectStaticInfo :: HasDebugCallStack => StgPgm -> [SomeStaticPtr] collectStaticInfo pgm = eltsUFM (collect collectStaticPtr emptyUFM pgm) where - fingerprints :: UniqFM Fingerprint - fingerprints = collect collectFingerprint emptyUFM pgm - collect :: (UniqFM a -> Id -> StgRhs -> UniqFM a) -> UniqFM a -> StgPgm -> UniqFM a collect f !m [] = m collect f !m (d:ds) = collect f (collectDecl f m d) ds + collectDecl :: (UniqFM a -> Id -> StgRhs -> UniqFM a) -> UniqFM a -> StgBinding -> UniqFM a collectDecl f !m (StgNonRec b e) = f m b e collectDecl f !m (StgRec bs) = foldl' (\m (b,e) -> f m b e) m bs - collectFingerprint !m b - (StgRhsCon _cc con [StgLitArg (MachWord64 w1), StgLitArg (MachWord64 w2)]) - | getUnique con == fingerprintDataConKey - = addToUFM m b $ Fingerprint (fromIntegral w1) (fromIntegral w2) - collectFingerprint !m _ _ = m - collectStaticPtr !m b - (StgRhsCon _cc con [StgVarArg fpId, StgVarArg info, StgVarArg tgt]) + (StgRhsCon _cc con [ StgLitArg (MachWord64 w1) + , StgLitArg (MachWord64 w2) + , StgVarArg info + , StgVarArg tgt + ] ) | getUnique con == staticPtrDataConKey - = let Just fp = lookupUFM fingerprints fpId + = let fp = Fingerprint (fromIntegral w1) (fromIntegral w2) in addToUFM m b (SomeStaticPtr b info tgt fp) collectStaticPtr !m _ _ = m -#else -collectStaticInfo _pgm = [] -#endif hasExport :: StgBinding -> Bool -#if __GLASGOW_HASKELL__ >= 709 hasExport bnd = case bnd of StgNonRec b e -> isExportedBind b e StgRec bs -> any (uncurry isExportedBind) bs where - isExportedBind _i (StgRhsCon _cc con _) = getUnique con == staticPtrDataConKey + isExportedBind _i (StgRhsCon _cc con _) = + getUnique con == staticPtrDataConKey isExportedBind _ _ = False -#else -hasExport _bnd = False -#endif {- | serialize the payload of a linkable unit in the object file, adding strings to the SymbolTable where necessary -} -serializeLinkableUnit :: Module +serializeLinkableUnit :: HasDebugCallStack + => Module -> Object.SymbolTable -- symbol table to start with -> [Id] -- id's exported by unit -> [ClosureInfo] @@ -323,7 +364,8 @@ collectTopIds (StgRec bs) = let xs = map (zapFragileIdInfo . fst) bs collectIds :: UniqFM StgExpr -> StgBinding -> [Id] collectIds unfloated b = - let xs = map zapFragileIdInfo . filter acceptId $ S.toList (bindingRefs unfloated b) + let xs = map zapFragileIdInfo . + filter acceptId $ S.toList (bindingRefs unfloated b) in seqList xs `seq` xs where acceptId i = all ($ i) [not . isForbidden] -- fixme test this: [isExported[isGlobalId, not.isForbidden] @@ -338,13 +380,17 @@ collectIds unfloated b = generate the object's dependy data, taking care that package and module names are only stored once -} -genDependencyData :: DynFlags -> Module -> [LinkableUnit] +genDependencyData :: HasDebugCallStack + => DynFlags + -> Module + -> [LinkableUnit] -> G Object.Deps genDependencyData dflags mod units = do -- [(blockindex, blockdeps, required, exported)] ds <- evalStateT (sequence (map (uncurry oneDep) blocks)) (DDC IM.empty IM.empty M.empty) - return $ Object.Deps (Linker.mkPackage $ modulePackageKey mod) + return $ Object.Deps (Linker.mkPackage $ + toInstalledUnitId (moduleUnitId mod)) (moduleNameText mod) (IS.fromList [ n | (n, _, True, _) <- ds ]) (M.fromList $ (\(n,_,_,es) -> map (,n) es) =<< ds) @@ -433,7 +479,7 @@ genDependencyData dflags mod units = do -> OtherSymb -> StateT DependencyDataCache G Object.Fun lookupExternalFun mbIdKey od@(OtherSymb m idTxt) = do let mk = getKey . getUnique $ m - mpk = Linker.mkPackage (modulePackageKey m) + mpk = Linker.mkPackage (toInstalledUnitId (moduleUnitId m)) inCache p = Object.Fun p (moduleNameText m) idTxt addCache = do let cache' = IM.insert mk mpk @@ -477,36 +523,57 @@ genToplevelDecl i rhs = do return (s1 <> s2) genToplevelConEntry :: Id -> StgRhs -> C -genToplevelConEntry i (StgRhsCon _cc con _args) - | i `elem` [ i' | AnId i' <- dataConImplicitTyThings con ] = genSetConInfo i con NoSRT -genToplevelConEntry i (StgRhsClosure _cc _bi [] _upd_flag srt _args (removeTick -> StgConApp dc _cargs)) - | i `elem` [ i' | AnId i' <- dataConImplicitTyThings dc ] = genSetConInfo i dc srt +genToplevelConEntry i rhs@(StgRhsCon _cc con _args) + | i `elem` [ i' | AnId i' <- dataConImplicitTyThings con ] + = genSetConInfo i con (stgRhsLive rhs) -- NoSRT +genToplevelConEntry i rhs@(StgRhsClosure _cc _bi [] _upd_flag + _args (removeTick -> StgConApp dc _cargs _)) + | i `elem` [ i' | AnId i' <- dataConImplicitTyThings dc ] + = genSetConInfo i dc (stgRhsLive rhs) -- srt genToplevelConEntry _ _ = mempty removeTick :: StgExpr -> StgExpr removeTick (StgTick _ e) = e removeTick e = e -genStaticRefs :: SRT -> G CIStatic -genStaticRefs NoSRT = return noStatic +genStaticRefsRhs :: StgRhs -> G CIStatic +genStaticRefsRhs lv = genStaticRefs (stgRhsLive lv) + +-- fixme, update to new way to compute static refs dynamically +genStaticRefs :: LiveVars -> G CIStatic +genStaticRefs lv + | isEmptyDVarSet sv = return noStatic + | otherwise = do + unfloated <- use gsUnfloated + let xs = filter (\x -> not (elemUFM x unfloated || + isLiftedType_maybe (idType x) == Just False)) + (dVarSetElems sv) + CIStaticRefs . catMaybes <$> mapM getStaticRef xs + where + sv = liveStatic lv + +{- +genStaticRefs {- NoSRT -} = return noStatic +-} +{- genStaticRefs (SRTEntries s) = do unfloated <- use gsUnfloated let xs = filter (\x -> not $ elemUFM x unfloated) (uniqSetToList s) CIStaticRefs <$> mapM getStaticRef xs -#if __GLASGOW_HASKELL__ < 711 -genStaticRefs (SRT{}) = - panic "genStaticRefs: unexpected SRT" -#endif +-} -getStaticRef :: Id -> G Text -getStaticRef = fmap (itxt.head) . genIdsI +getStaticRef :: Id -> G (Maybe Text) +getStaticRef = fmap (fmap itxt . listToMaybe) . genIdsI + +headYikes (x:_) = x +headYikes [] = panic "headYikes" genToplevelRhs :: Id -> StgRhs -> C --- genTopLevelRhs _ _ | Debug.Trace.trace "genToplevelRhs" False = error "genTopLevelRhs" +-- genTopLevelRhs _ _ | trace' "genToplevelRhs" False = error "genTopLevelRhs" -- special cases -genToplevelRhs i (StgRhsClosure cc _bi _ upd _ args body) +genToplevelRhs i rhs@(StgRhsClosure cc _bi _ upd args body) -- foreign exports | (StgOpApp (StgFCallOp (CCall (CCallSpec (StaticTarget _ t _ _) _ _)) _) [StgLitArg (MachInt _is_js_conv), StgLitArg (MachStr _js_name), StgVarArg _tgt] _) <- body, @@ -521,7 +588,7 @@ genToplevelRhs i (StgRhsCon cc con args) = do ii <- jsIdI i allocConStatic ii cc con args return mempty -genToplevelRhs i (StgRhsClosure cc _bi [] _upd_flag srt args body) = do +genToplevelRhs i rhs@(StgRhsClosure cc _bi [] _upd_flag {- srt -} args body) = do eid@(TxtI eidt) <- jsEnIdI i (TxtI idt) <- jsIdI i -- pushGlobalRefs @@ -530,7 +597,7 @@ genToplevelRhs i (StgRhsClosure cc _bi [] _upd_flag srt args body) = do let lidents' = map (\(TxtI t) -> t) lidents -- li -- refs <- popGlobalRefs - CIStaticRefs sr0 <- genStaticRefs srt + CIStaticRefs sr0 <- genStaticRefsRhs rhs let sri = filter (`notElem` lidents') sr0 sr = CIStaticRefs sri @@ -622,39 +689,71 @@ loadLiveFun l = do dataFields :: Array Int Ident dataFields = listArray (1,1024) (map (TxtI . T.pack . ('d':) . show) [(1::Int)..1024]) +genBody :: HasDebugCallStack => ExprCtx -> Id -> StgReg -> [Id] -> StgExpr -> C genBody ctx i startReg args e = - {- Debug.Trace.trace ("genBody: " ++ show args) -} (genBody0 ctx i startReg args e) - -genBody0 :: ExprCtx -> Id -> StgReg -> [Id] -> StgExpr -> C + -- trace' ("genBody: " ++ show args) + (genBody0 ctx i startReg args e) + +genBody0 :: HasDebugCallStack + => ExprCtx + -> Id + -> StgReg + -> [Id] + -> StgExpr + -> C genBody0 ctx i startReg args e = do la <- loadArgs startReg args let ids = take (resultSize args $ idType i) (map toJExpr $ enumFrom R1) - (e, _r) <- genExpr (ctx & ctxTarget .~ ids) e + (e, _r) <- trace' ("genBody0 ids:\n" ++ show ids) (genExpr (ctx & ctxTarget .~ ids) e) return $ la <> e <> returnStack -- [j| return `Stack`[`Sp`]; |] -- find the result type after applying the function to the arguments -resultSize xs t = {- Debug.Trace.trace "resultSize" -} (resultSize0 xs t) - -resultSize0 :: [Id] -> Type -> Int -resultSize0 (x:xs) t - | UbxTupleRep _ <- {- Debug.Trace.trace "resultSize0 ubx" -} (repType (idType x)) = panic "genBody: unboxed tuple argument" - | otherwise = {- Debug.Trace.trace "resultSize0 not" $ -} - case repType t of - (UnaryRep t') | isFunTy t' -> - let (fa,fr) = splitFunTy t' - t'' = mkFunTys (flattenRepType $ repType fa) fr - in {- Debug.Trace.trace ("resultSize0 fun: " ++ show (fa, fr)) $ -} - resultSize0 xs (snd . splitFunTy $ t'') - _ -> 1 -- possibly newtype family, must be boxed +resultSize :: HasDebugCallStack => [Id] -> Type -> Int +resultSize xs t = trace' ("resultSize\n" ++ show xs ++ "\n" ++ show t) + (let r = resultSize0 xs t + in trace' ("resultSize -> " ++ show r) r + ) + +resultSize0 :: HasDebugCallStack + => [Id] + -> Type + -> Int +resultSize0 xxs@(x:xs) t + -- | isUnboxedTupleType + -- | t' <- piResultTys t (map idType xxs) = resultSize0 [] t' + -- | MultiRep _ <- {- trace' "resultSize0 ubx" -} (repType (idType x)) = panic "genBody: unboxed tuple argument" + -- | otherwise = {- trace' "resultSize0 not" $ -} + | t' <- unwrapType t + , Just (fa, fr) <- splitFunTy_maybe t' -- isFunTy t' = + , Just (tc, ys) <- splitTyConApp_maybe fa + , isUnboxedTupleTyCon tc = + resultSize0 xxs (mkFunTys (dropRuntimeRepArgs ys) fr) + | t' <- unwrapType t + , Just (fa, fr) <- splitFunTy_maybe t' = -- isFunTy t' = + resultSize0 xs fr + -- let (fa, fr) = splitFunTy t' + -- let t'' = mkFunTys (map primRepToType . typePrimRep $ unwrapType fa) fr + -- in resultSize0 xs (maybe fr snd . splitFunTy_maybe $ t'') + | otherwise = 1 -- possibly newtype family, must be boxed +-- case typePrimRep (unwrapType t) of -- repType t of + -- (UnaryRep t' | isFunTy t' -> + -- let (fa,fr) = splitFunTy t' + -- t'' = mkFunTys (map slotTyToType . repTypeSlots $ repType fa) fr +-- in {- trace' ("resultSize0 fun: " ++ show (fa, fr)) $ -} + -- resultSize0 xs (snd . splitFunTy $ t'') +-- _ -> 1 -- possibly newtype family, must be boxed resultSize0 [] t - | isRuntimeRepKindedTy t = 0 - | isRuntimeRepTy t = 0 - | otherwise = {- Debug.Trace.trace "resultSize0 eol" $ -} - case repType t of - UnaryRep t' -> {- Debug.Trace.trace ("resultSize0 eol2: " ++ show t') $ -} typeSize t' - UbxTupleRep tys -> {- Debug.Trace.trace ("resultSize0 eol3: " ++ show tys) $ -} sum (map typeSize tys) - -loadArgs :: StgReg -> [Id] -> C + -- | isRuntimeRepKindedTy t = 0 + -- | isRuntimeRepTy t = 0 + | Nothing <- isLiftedType_maybe t = 1 + | otherwise = sum . map (varSize . primRepVt) $ typePrimRep (unwrapType t) + + {- trace' "resultSize0 eol" $ -} + -- case repType t of + -- UnaryRep t' -> {- trace' ("resultSize0 eol2: " ++ show t') $ -} typeSize t' + -- MultiRep tys -> {- trace' ("resultSize0 eol3: " ++ show tys) $ -} sum (map (typeSize . slotTyToType) tys) + +loadArgs :: HasDebugCallStack => StgReg -> [Id] -> C loadArgs start args = do args' <- concatMapM genIdArgI args return (mconcat $ zipWith (||=) args' [start..]) @@ -667,7 +766,7 @@ data ExprValData = ExprValData [JExpr] deriving (Eq, Ord, Show) -- not a Monoid -branchResult :: [ExprResult] -> ExprResult +branchResult :: HasDebugCallStack => [ExprResult] -> ExprResult branchResult [] = panic "branchResult: empty list" branchResult [e] = e branchResult (ExprCont:_) = ExprCont @@ -675,56 +774,61 @@ branchResult (_:es) | any (==ExprCont) es = ExprCont | otherwise = ExprInline Nothing -genExpr :: ExprCtx -> StgExpr -> G (JStat, ExprResult) -genExpr top (StgApp f args) = {- Debug.Trace.trace "genExpr -> genApp" -} (genApp top f args) -genExpr top (StgLit l) = (,ExprInline Nothing) - . assignAllCh ("genExpr StgLit " ++ show (top ^. ctxTarget)) - (top ^. ctxTarget) +genExpr :: HasDebugCallStack => ExprCtx -> StgExpr -> G (JStat, ExprResult) +genExpr top e = trace' ("genExpr\n" ++ showIndent e) + (genExpr0 top e) + +genExpr0 :: HasDebugCallStack + => ExprCtx + -> StgExpr + -> G (JStat, ExprResult) +genExpr0 top (StgApp f args) = genApp top f args +genExpr0 top (StgLit l) = + (,ExprInline Nothing) . + assignAllCh ("genExpr StgLit " ++ show (top ^. ctxTarget)) + (top ^. ctxTarget) <$> genLit l -genExpr top (StgConApp con args) = do +genExpr0 top (StgConApp con args _) = do as <- concatMapM genArg args c <- genCon top con as return (c, ExprInline (Just as)) -genExpr top (StgOpApp (StgFCallOp f _) args t) = +genExpr0 top (StgOpApp (StgFCallOp f _) args t) = genForeignCall f t (top ^. ctxTarget) args -genExpr top (StgOpApp (StgPrimOp op) args t) = genPrimOp top op args t -genExpr top (StgOpApp (StgPrimCallOp c) args t) = genPrimCall top c args t -genExpr _ (StgLam{}) = panic "genExpr: StgLam" -genExpr top (StgCase e _ liveRhs b srt at alts) = genCase top b e at alts liveRhs srt -genExpr top (StgLet b e) = do +genExpr0 top (StgOpApp (StgPrimOp op) args t) = genPrimOp top op args t +genExpr0 top (StgOpApp (StgPrimCallOp c) args t) = genPrimCall top c args t +genExpr0 _ (StgLam{}) = panic "genExpr: StgLam" +genExpr0 top stg@(StgCase e b at alts) = + genCase top b e at alts (liveVars $ stgExprLive False stg) +genExpr0 top (StgLet b e) = do (b',top') <- genBind top b (s,r) <- genExpr top' e return (b' <> s, r) -genExpr top (StgLetNoEscape _ live b e) = do - (b', top') <- genBindLne top live b +genExpr0 top (StgLetNoEscape b e) = do + (b', top') <- genBindLne top b (s, r) <- genExpr top' e return (b' <> s, r) -#if __GLASGOW_HASKELL__ < 709 -genExpr top (StgSCC cc tick push e) = do - setSCCstats <- ifProfilingM $ setCC cc tick push - (stats, result) <- genExpr top e - return (setSCCstats <> stats, result) -genExpr top (StgTick _m _n e) = genExpr top e -#else -genExpr top (StgTick (ProfNote cc count scope) e) = do +genExpr0 top (StgTick (ProfNote cc count scope) e) = do setSCCstats <- ifProfilingM $ setCC cc count scope (stats, result) <- genExpr top e return (setSCCstats <> stats, result) -genExpr top (StgTick _m e) = genExpr top e -#endif +genExpr0 top (StgTick _m e) = genExpr top e -might_be_a_function :: Type -> Bool +might_be_a_function :: HasDebugCallStack => Type -> Bool -- Return False only if we are *sure* it's a data type -- Look through newtypes etc as much as poss might_be_a_function ty - | UnaryRep rep <- repType ty - , Just tc <- tyConAppTyCon_maybe rep + | [LiftedRep] <- typePrimRep ty + , Just tc <- tyConAppTyCon_maybe (unwrapType ty) , isDataTyCon tc = False | otherwise = True -genApp :: ExprCtx -> Id -> [StgArg] -> G (JStat, ExprResult) +genApp :: HasDebugCallStack + => ExprCtx + -> Id + -> [StgArg] + -> G (JStat, ExprResult) -- special cases for unpacking C Strings, avoid going through a typed array when possible genApp ctx i [StgLitArg (MachStr bs)] | [top] <- (ctx ^. ctxTarget), getUnique i == unpackCStringIdKey = @@ -774,7 +878,7 @@ genApp top i a return ([j| `c` = (typeof `i'` === 'object') ? `i'`.d1 : `i'`; |] ,ExprInline Nothing) | n == 0 && (i `elementOfUniqSet` (top ^. ctxEval) || isStrictId i) = do - a <- assignAllCh ("genApp:" ++ show i ++ " " ++ show (idRepArity i, idVt i)) + a <- assignAllCh ("genApp:" ++ show i ++ " " ++ show (idFunRepArity i, idVt i)) (top ^. ctxTarget) <$> genIds i settings <- use gsSettings @@ -792,15 +896,15 @@ genApp top i a if isStrictId a' || a' `elementOfUniqSet` (top ^. ctxEval) then return ([j| `t` = `ai`; |], ExprInline Nothing) else return ([j| return h$e(`ai`); |], ExprCont) - | idRepArity i == 0 && n == 0 && not (might_be_a_function (idType i)) = do + | idFunRepArity i == 0 && n == 0 && not (might_be_a_function (idType i)) = do ii <- enterId return ([j| return h$e(`ii`) |], ExprCont) - | idRepArity i == n && not (isLocalId i) && isStrictId i && n /= 0 = do + | idFunRepArity i == n && not (isLocalId i) && isStrictId i && n /= 0 = do as' <- concatMapM genArg a jmp <- jumpToII i as' =<< r1 return (jmp, ExprCont) - | idRepArity i < n && isStrictId i && idRepArity i > 0 = - let (reg,over) = splitAt (idRepArity i) a + | idFunRepArity i < n && isStrictId i && idFunRepArity i > 0 = + let (reg,over) = splitAt (idFunRepArity i) a in do reg' <- concatMapM genArg reg pc <- pushCont over @@ -814,7 +918,7 @@ genApp top i a enterId = genArg (StgVarArg i) >>= \case [x] -> return x - _ -> panic "genApp: unexpected multi-var argument" + xs -> panic $ "genApp: unexpected multi-var argument (" ++ show (length xs) ++ ")\n" ++ showIndent i r1 :: C r1 = do @@ -822,7 +926,9 @@ genApp top i a return $ mconcat $ zipWith (\r u -> [j| `r`=`u`; |]) (enumFrom R1) ids n = length a -pushCont :: [StgArg] -> C +pushCont :: HasDebugCallStack + => [StgArg] + -> C pushCont as = do as' <- concatMapM genArg as (app, spec) <- selectApply False (as,as') @@ -833,7 +939,10 @@ pushCont as = do mkTag rs ns = toJExpr ((length rs `shiftL` 8) .|. length ns) -- regular let binding: allocate heap object -genBind :: ExprCtx -> StgBinding -> G (JStat, ExprCtx) +genBind :: HasDebugCallStack + => ExprCtx + -> StgBinding + -> G (JStat, ExprCtx) genBind ctx bndr = case bndr of StgNonRec b r -> do @@ -850,7 +959,7 @@ genBind ctx bndr = ctx' = clearCtxStack ctx assign :: Id -> StgRhs -> G (Maybe JStat) - assign b (StgRhsClosure _ccs _bi _free _upd _str [] expr) + assign b (StgRhsClosure _ccs _bi _free _upd [] expr) | snd (isInlineExpr (ctx ^. ctxEval) expr) = do d <- declIds b tgt <- genIds b @@ -861,12 +970,23 @@ genBind ctx bndr = addEvalRhs c [] = c addEvalRhs c ((b,r):xs) - | (StgRhsCon{}) <- r = addEvalRhs (addEval b c) xs - | (StgRhsClosure _ _ _ ReEntrant _ _ _) <- r = addEvalRhs (addEval b c) xs - | otherwise = addEvalRhs c xs - -genBindLne :: ExprCtx -> StgLiveVars -> StgBinding -> G (JStat, ExprCtx) -genBindLne ctx live bndr = do + | (StgRhsCon{}) <- r = addEvalRhs (addEval b c) xs + | (StgRhsClosure _ _ _ ReEntrant _ _) <- r = addEvalRhs (addEval b c) xs + | otherwise = addEvalRhs c xs + +genBindLne :: HasDebugCallStack + => ExprCtx + -> StgBinding + -> G (JStat, ExprCtx) +genBindLne ctx bndr = + trace' ("genBindLne\n" ++ showIndent bndr) + (genBindLne0 ctx bndr) + +genBindLne0 :: HasDebugCallStack + => ExprCtx + -> StgBinding + -> G (JStat, ExprCtx) +genBindLne0 ctx bndr = do vis <- map (\(x,y,_) -> (x,y)) <$> optimizeFree oldFrameSize (newLvs++map fst updBinds) declUpds <- mconcat <$> mapM (fmap (||= jnull) . jsIdI . fst) updBinds @@ -879,17 +999,30 @@ genBindLne ctx live bndr = do where oldFrame = ctx ^. ctxLneFrame oldFrameSize = length oldFrame - isOldLv i = i `elementOfUniqSet` (ctx ^. ctxLne) || i `elem` (map fst oldFrame) - newLvs = filter (not . isOldLv) (uniqSetToList live) + isOldLv i = i `elementOfUniqSet` (ctx ^. ctxLne) || + i `elem` (map fst oldFrame) + live = liveVars $ mkDVarSet $ stgLneLive' bndr + newLvs = filter (not . isOldLv) (dVarSetElems live) binds = case bndr of StgNonRec b e -> [(b,e)] StgRec bs -> bs bound = map fst binds (updBinds, _nonUpdBinds) = partition (isUpdatableRhs . snd) binds +stgLneLive' :: StgBinding -> [Id] +stgLneLive' b = filter (`notElem` bindees b) (stgLneLive b) + +stgLneLive :: StgBinding -> [Id] +stgLneLive (StgNonRec _b e) = stgLneLiveExpr e +stgLneLive (StgRec bs) = L.nub $ concatMap (stgLneLiveExpr . snd) bs + +stgLneLiveExpr :: StgRhs -> [Id] +stgLneLiveExpr (StgRhsClosure _ _ l _ _ _) = l +stgLneLiveExpr (StgRhsCon {}) = [] + isUpdatableRhs :: StgRhs -> Bool -isUpdatableRhs (StgRhsClosure _ _ _ u _ _ _) = isUpdatable u -isUpdatableRhs _ = False +isUpdatableRhs (StgRhsClosure _ _ _ u _ _) = isUpdatable u +isUpdatableRhs _ = False {- Let-no-escape entries live on the stack. There is no heap object associated with them. @@ -902,8 +1035,9 @@ isUpdatableRhs _ = False is initially set to null, changed to h$blackhole when the thunk is being evaluated. -} -genEntryLne :: ExprCtx -> Id -> StgRhs -> G () -genEntryLne ctx i (StgRhsClosure _cc _bi _live2 update srt args body) = resetSlots $ do +genEntryLne :: HasDebugCallStack => ExprCtx -> Id -> StgRhs -> G () +genEntryLne ctx i rhs@(StgRhsClosure _cc _bi _live2 update args body) = + resetSlots $ do let payloadSize = length frame frame = ctx ^. ctxLneFrame myOffset = @@ -918,7 +1052,7 @@ genEntryLne ctx i (StgRhsClosure _cc _bi _live2 update srt args body) = resetSlo lvs <- popLneFrame True payloadSize ctx body <- genBody ctx i R1 args body ei <- jsEntryIdI i - sr <- genStaticRefs srt + sr <- genStaticRefsRhs rhs let f = JFunc [] (bh <> lvs <> body) emitClosureInfo $ ClosureInfo (itxt ei) @@ -938,13 +1072,13 @@ genEntryLne ctx i (StgRhsCon cc con args) = resetSlots $ do args' <- concatMapM genArg args ac <- allocCon ii con cc args' emitToplevel $ ei ||= JFunc [] - (decl ii <> p <> ac <> [j| `R1` = `ii`; |] <> returnStack) -- return `Stack`[`Sp`]; |]) + (decl ii <> p <> ac <> [j| `R1` = `ii`; |] <> returnStack) -- generate the entry function for a local closure -genEntry :: ExprCtx -> Id -> StgRhs -> G () +genEntry :: HasDebugCallStack => ExprCtx -> Id -> StgRhs -> G () genEntry _ _i (StgRhsCon _cc _con _args) = return () -- mempty -- error "local data entry" -genEntry ctx i (StgRhsClosure cc _bi live upd_flag srt args body) = resetSlots $ do +genEntry ctx i rhs@(StgRhsClosure cc _bi live upd_flag args body) = resetSlots $ do ll <- loadLiveFun live upd <- genUpdFrame upd_flag i body <- genBody entryCtx i R2 args body @@ -954,7 +1088,7 @@ genEntry ctx i (StgRhsClosure cc _bi live upd_flag srt args body) = resetSlots $ if et == CIThunk then enterCostCentreThunk else enterCostCentreFun cc - sr <- genStaticRefs srt + sr <- genStaticRefsRhs rhs emitClosureInfo $ ClosureInfo (itxt ei) (CIRegs 0 $ PtrV : concatMap idVt args) (itxt ei <> ", " <> T.pack (show i)) @@ -965,18 +1099,18 @@ genEntry ctx i (StgRhsClosure cc _bi live upd_flag srt args body) = resetSlots $ where entryCtx = ExprCtx i [] (ctx ^. ctxEval) (ctx ^. ctxLne) emptyUFM [] -genEntryType :: [Id] -> G CIType +genEntryType :: HasDebugCallStack => [Id] -> G CIType genEntryType [] = return CIThunk -genEntryType args0 = {- Debug.Trace.trace "genEntryType" $ -} do +genEntryType args0 = {- trace' "genEntryType" $ -} do args' <- mapM genIdArg args return $ CIFun (length args) (length $ concat args') where args = filter (not . isRuntimeRepKindedTy . idType) args0 -genSetConInfo :: Id -> DataCon -> SRT -> C -genSetConInfo i d srt = do +genSetConInfo :: HasDebugCallStack => Id -> DataCon -> LiveVars -> C +genSetConInfo i d l {- srt -} = do ei <- jsDcEntryIdI i - sr <- genStaticRefs srt + sr <- genStaticRefs l emitClosureInfo $ ClosureInfo (itxt ei) (CIRegs 0 [PtrV]) (T.pack $ show d) @@ -986,7 +1120,9 @@ genSetConInfo i d srt = do return (ei ||= mkDataEntry) where -- dataConRepArgTys sometimes returns unboxed tuples. is that a bug? - fields = concatMap (flattenRepType . repType) (dataConRepArgTys d) + fields = concatMap (map primRepToType . typePrimRep . unwrapType) + (dataConRepArgTys d) + -- concatMap (map slotTyToType . repTypeSlots . repType) (dataConRepArgTys d) mkDataEntry :: JExpr mkDataEntry = ValExpr $ JFunc [] returnStack @@ -1025,28 +1161,66 @@ allocCls dynMiddle xs = do -- dynamics toCl (i, StgRhsCon cc con ar) = -- fixme do we need to handle unboxed? - Right <$> ((,,,) <$> jsIdI i <*> enterDataCon con <*> concatMapM genArg ar <*> pure cc) - toCl (i, StgRhsClosure cc _bi live _upd_flag _srt _args _body) = - Right <$> ((,,,) <$> jsIdI i <*> jsEntryId i <*> concatMapM genIds live <*> pure cc) - + Right <$> ((,,,) <$> jsIdI i + <*> enterDataCon con + <*> concatMapM genArg ar + <*> pure cc) + toCl (i, StgRhsClosure cc _bi live _upd_flag _args _body) = + Right <$> ((,,,) <$> jsIdI i + <*> jsEntryId i + <*> concatMapM genIds live + <*> pure cc) + + +genCase :: HasDebugCallStack + => ExprCtx + -> Id + -> StgExpr + -> AltType + -> [StgAlt] + -> LiveVars + -> G (JStat, ExprResult) +genCase top bnd e at alts l = + trace' ("genCase\n" ++ showIndent e ++ "\n" ++ unlines (map showIndent alts)) + (genCase0 top bnd e at alts l) -- fixme CgCase has a reps_compatible check here -genCase :: ExprCtx -> Id -> StgExpr -> AltType -> [StgAlt] -> StgLiveVars -> SRT -> G (JStat, ExprResult) -genCase top bnd e at alts l srt +genCase0 :: HasDebugCallStack + => ExprCtx + -> Id + -> StgExpr + -> AltType + -> [StgAlt] + -> LiveVars + -> G (JStat, ExprResult) +genCase0 top bnd e at alts l | snd (isInlineExpr (top ^. ctxEval) e) = withNewIdent $ \ccsVar -> do bndi <- genIdsI bnd - (ej, r) <- genExpr (top & ctxTop .~ bnd & ctxTarget .~ map toJExpr bndi) e -- ExprCtx bnd (map toJExpr bndi) (top ^. ctxEval) (top ^. ctxLneV) (top ^. ctxLneB) (top ^. ctxLne)) e + (ej, r) <- genExpr (top & ctxTop .~ bnd & ctxTarget .~ map toJExpr bndi) e + -- ExprCtx bnd (map toJExpr bndi) (top ^. ctxEval) (top ^. ctxLneV) (top ^. ctxLneB) (top ^. ctxLne)) e let d = case r of ExprInline d0 -> d0 - ExprCont -> panic $ "genCase: expression was not inline:\n" ++ show e + ExprCont -> panic $ "genCase: expression was not inline:\n" ++ + showIndent e ++ "\n" ++ + (TL.unpack . (<>"\n") . displayT . renderPretty 0.8 150 . pretty . jsSaturate (Just "debug") $ ej) + ww = mempty -- if snd (isInlineExpr emptyUniqSet e) then mempty else [j| h$log('danger will robinson'); |] (aj, ar) <- genAlts (addEval bnd top) bnd at d alts saveCCS <- ifProfiling $ ccsVar |= jCurrentCCS restoreCCS <- ifProfiling $ [j| `jCurrentCCS` = `ccsVar`; |] - return (decl ccsVar <> mconcat (map decl bndi) <> saveCCS <> ww <> ej <> restoreCCS <> aj, ar) + return ( decl ccsVar <> + mconcat (map decl bndi) <> + saveCCS <> + ww <> + ej <> + restoreCCS <> + aj + , ar + ) | otherwise = do n <- length <$> genIdsI bnd - rj <- genRet (addEval bnd top) bnd at alts l srt - (ej, _r) <- genExpr (top & ctxTop .~ bnd & ctxTarget .~ take n (map toJExpr [R1 ..])) e + rj <- genRet (addEval bnd top) bnd at alts l + (ej, _r) <- genExpr (top & ctxTop .~ bnd + & ctxTarget .~ take n (map toJExpr [R1 ..])) e return (rj <> ej, ExprCont) assignAll :: (ToJExpr a, ToJExpr b) => [a] -> [b] -> JStat @@ -1055,19 +1229,40 @@ assignAll xs ys = mconcat (zipWith assignj xs ys) assignAllCh :: (ToJExpr a, ToJExpr b) => String -> [a] -> [b] -> JStat assignAllCh msg xs ys | length xs == length ys = mconcat (zipWith assignj xs ys) - | otherwise = panic $ "assignAllCh: lengths do not match: " ++ show (length xs, length ys) ++ "\n " ++ msg - -genRet :: ExprCtx -> Id -> AltType -> [StgAlt] -> StgLiveVars -> SRT -> C -genRet ctx e at as l srt = withNewIdent f + | otherwise = + panic $ "assignAllCh: lengths do not match: " ++ + show (length xs, length ys) ++ + "\n " ++ + msg + +genRet :: HasDebugCallStack + => ExprCtx + -> Id + -> AltType + -> [StgAlt] + -> LiveVars + -> C +genRet ctx e at as l = -- withNewIdent f + trace' ("genRet" ++ unlines (map showIndent as)) + (genRet0 ctx e at as l) + +genRet0 :: HasDebugCallStack + => ExprCtx + -> Id + -> AltType + -> [StgAlt] + -> LiveVars + -> C +genRet0 ctx e at as l = withNewIdent f where allRefs :: [Id] - allRefs = S.toList . S.unions $ as ^.. traverse . _4 . to (exprRefs emptyUFM) + allRefs = S.toList . S.unions $ as ^.. traverse . _3 . to (exprRefs emptyUFM) lneLive :: Int lneLive = maximum $ 0 : map (fromMaybe 0 . lookupUFM (ctx ^. ctxLneFrameBs)) allRefs ctx' = adjustCtxStack lneLive ctx lneVars = map fst $ take lneLive (ctx ^. ctxLneFrame) isLne i = i `elem` lneVars || i `elementOfUniqSet` (ctx ^. ctxLne) - nonLne = filter (not . isLne) (uniqSetToList l) + nonLne = filter (not . isLne) (dVarSetElems l) -- [] -- fixme filter (not . isLne) (uniqSetToList l) f :: Ident -> C f r = do @@ -1076,7 +1271,7 @@ genRet ctx e at as l srt = withNewIdent f free <- optimizeFree 0 nonLne pushRet <- pushRetArgs free (iex r) fun' <- fun free - sr <- genStaticRefs srt + sr <- genStaticRefs l -- srt prof <- profiling emitClosureInfo $ ClosureInfo (itxt r) @@ -1092,10 +1287,11 @@ genRet ctx e at as l srt = withNewIdent f return (pushLne <> saveCCS <> pushRet) fst3 ~(x,_,_) = x + altRegs :: HasDebugCallStack => [VarType] altRegs = case at of - PrimAlt ptc -> tyConVt ptc - UbxTupAlt _n -> idVt e - _ -> [PtrV] + PrimAlt ptc -> [primRepVt ptc] + MultiValAlt _n -> idVt e + _ -> [PtrV] fun free = resetSlots $ do decs <- declIds e @@ -1127,7 +1323,7 @@ popLneFrame inEntry size ctx skip = if inEntry then 1 else 0 -- pop the frame header l = ctx ^. ctxLneFrame . to length -pushLneFrame :: Int -> ExprCtx -> C +pushLneFrame :: HasDebugCallStack => Int -> ExprCtx -> C pushLneFrame size ctx | l < size = panic $ "pushLneFrame: let-no-escape frame too short " ++ show l ++ " < " ++ show size @@ -1137,9 +1333,14 @@ pushLneFrame size ctx -- reorder the things we need to push to reuse existing stack values as much as possible -- True if already on the stack at that location -optimizeFree :: Int -> [Id] -> G [(Id,Int,Bool)] +optimizeFree :: HasDebugCallStack => Int -> [Id] -> G [(Id,Int,Bool)] optimizeFree offset ids = do - let ids' = concat $ map (\i -> map (i,) [1..varSize . uTypeVt . idType $ i]) ids + -- this line goes wrong vvvvvvv + let -- ids' = concat $ map (\i -> map (i,) [1..varSize . uTypeVt . idType $ i]) ids + idSize :: Id -> Int + idSize i = sum $ map varSize (typeVt . idType $ i) + ids' = concat $ map (\i -> map (i,) [1..idSize i]) ids + -- 1..varSize] . uTypeVt . idType $ i]) (typeVt ids) l = length ids' slots <- drop offset . take l . (++repeat SlotUnknown) <$> getSlots let slm = M.fromList (zip slots [0..]) @@ -1153,7 +1354,7 @@ optimizeFree offset ids = do return $ map (\(i,n,_,b) -> (i,n,b)) allSlots -pushRetArgs :: [(Id,Int,Bool)] -> JExpr -> C +pushRetArgs :: HasDebugCallStack => [(Id,Int,Bool)] -> JExpr -> C pushRetArgs free fun = do p <- pushOptimized . (++[(fun,False)]) =<< mapM (\(i,n,b) -> (\es->(es!!(n-1),b)) <$> genIdArg i) free -- p <- push . (++[fun]) =<< mapM (\(i,n,b) -> (\es->es!!(n-1)) <$> genIdArg i) free @@ -1170,67 +1371,99 @@ loadRetArgs free = popSkipI 1 =<< ids where ids = mapM (\(i,n,_b) -> (!!(n-1)) <$> genIdStackArgI i) free -genAlts :: ExprCtx -- ^ lhs to assign expression result to +genAlts :: HasDebugCallStack + => ExprCtx -- ^ lhs to assign expression result to -> Id -- ^ id being matched -> AltType -- ^ type -> Maybe [JExpr] -- ^ if known, fields in datacon from earlier expression -> [StgAlt] -- ^ the alternatives -> G (JStat, ExprResult) -genAlts top e PolyAlt _ [alt] = (\(_,s,r) -> (s,r)) <$> mkAlgBranch top e alt -genAlts _ _ PolyAlt _ _ = panic "genAlts: multiple polyalt" -genAlts top e (PrimAlt _tc) _ [(_, bs, _use, expr)] = do +genAlts top e at me as = + trace'' + ("genAlts0\n" ++ unlines ([{- show top, -} show e, show at] ++ map show as)) + (genAlts0 top e at me as) + --(\(_,s,r) -> (s,r)) <$> mkAlgBranch top e alt + + +genAlts0 :: HasDebugCallStack + => ExprCtx -- ^ lhs to assign expression result to + -> Id -- ^ id being matched + -> AltType -- ^ type + -> Maybe [JExpr] -- ^ if known, fields in datacon from earlier expression + -> [StgAlt] -- ^ the alternatives + -> G (JStat, ExprResult) +genAlts0 top e PolyAlt _ [alt] = (\(_,s,r) -> (s,r)) <$> mkAlgBranch top e alt +genAlts0 _ _ PolyAlt _ _ = panic "genAlts: multiple polyalt" +genAlts0 top e (PrimAlt _tc) _ [(_, bs, expr)] = do ie <- genIds e dids <- mconcat (map declIds bs) bss <- concatMapM genIds bs (ej, er) <- genExpr top expr - return (dids <> assignAll {- Ch ("genAlts PrimAlt: " ++ show (idType e)) -} bss ie <> ej, er) -genAlts top e (PrimAlt tc) _ alts = do + return (dids <> assignAll bss ie <> ej, er) +genAlts0 top e (PrimAlt tc) _ alts = do ie <- genIds e - (r, bss) <- normalizeBranches top <$> mapM (isolateSlots . mkPrimIfBranch top (tyConVt tc)) alts + (r, bss) <- normalizeBranches top <$> + mapM (isolateSlots . mkPrimIfBranch top [primRepVt tc]) alts setSlots [] return (mkSw ie bss, r) -genAlts top e (UbxTupAlt n) _ [(_, bs, _use, expr)] = do +genAlts0 top e (MultiValAlt n) _ [(_, bs, expr)] = do eids <- genIds e l <- loadUbxTup eids bs n (ej, er) <- genExpr top expr return (l <> ej, er) -genAlts _ _ (AlgAlt tc) _ [_alt] | isUnboxedTupleTyCon tc = panic "genAlts: unexpected unboxed tuple" -genAlts top _ (AlgAlt _tc) (Just es) [(DataAlt dc, bs, use, expr)] | not (isUnboxableCon dc) = do - bsi <- mapM genIdsI bs - let bus = concat $ zipWith (\bss u -> zip bss (repeat u)) bsi use - args = zipWith (\(i,u) de -> if u then i ||= de else mempty) bus es - (ej, er) <- genExpr top expr - return (mconcat args <> ej, er) -genAlts top e (AlgAlt _tc) _ [alt] = do +genAlts0 _ _ (AlgAlt tc) _ [_alt] | isUnboxedTupleTyCon tc = + panic "genAlts: unexpected unboxed tuple" +genAlts0 top _ (AlgAlt _tc) (Just es) [(DataAlt dc, bs, expr)] + | not (isUnboxableCon dc) = do + bsi <- mapM genIdsI bs + let args = zipWith (\i de -> i ||= de) (concat bsi) es + (ej, er) <- genExpr top expr + return (mconcat args <> ej, er) +genAlts0 top e (AlgAlt _tc) _ [alt] = do (_,s,r) <- mkAlgBranch top e alt return (s, r) -genAlts top e (AlgAlt _tc) _ alts@[(DataAlt dc,_,_,_),_] +genAlts0 top e (AlgAlt _tc) _ alts@[(DataAlt dc,_,_),_] | isBoolTy (dataConType dc) = do i <- jsId e - (r, [(_,s1,_), (_,s2,_)]) <- normalizeBranches top <$> mapM (isolateSlots . mkAlgBranch top e) alts - let s = if dataConTag dc == 2 then [j| if(`i`) { `s1` } else { `s2` } |] - else [j| if(`i`) { `s2` } else { `s1` } |] + (r, [(_,s1,_), (_,s2,_)]) <- normalizeBranches top <$> + mapM (isolateSlots . mkAlgBranch top e) alts + let s = if dataConTag dc == 2 + then [j| if(`i`) { `s1` } else { `s2` } |] + else [j| if(`i`) { `s2` } else { `s1` } |] setSlots [] return (s, r) -- fixme, add all alts -genAlts top e (AlgAlt _tc) _ alts = do +genAlts0 top e (AlgAlt _tc) _ alts = do ei <- jsId e - (r, brs) <- normalizeBranches top <$> mapM (isolateSlots . mkAlgBranch top e) alts + (r, brs) <- normalizeBranches top <$> + mapM (isolateSlots . mkAlgBranch top e) alts setSlots [] return (mkSwitch [je| `ei`.f.a |] brs, r) -genAlts _ _ a _ l = do +genAlts0 _ _ a _ l = do ap <- showPpr' a - panic $ "genAlts: unhandled case variant: " ++ ap ++ " (" ++ show (length l) ++ ")" - --- if one branch ends in a continuation but another is inline, we need to adjust the inline branch --- to use the continuation convention -normalizeBranches :: ExprCtx -> [(a, JStat, ExprResult)] -> (ExprResult, [(a, JStat, ExprResult)]) + panic $ "genAlts: unhandled case variant: " ++ + ap ++ + " (" ++ + show (length l) ++ + ")" + +-- if one branch ends in a continuation but another is inline, +-- we need to adjust the inline branch to use the continuation convention +normalizeBranches :: ExprCtx + -> [(a, JStat, ExprResult)] + -> (ExprResult, [(a, JStat, ExprResult)]) normalizeBranches e brs - | all (==ExprCont) (brs ^.. traverse . _3) = (ExprCont, brs) - | branchResult (brs ^.. traverse ._3) == ExprCont = (ExprCont, map mkCont brs) - | otherwise = (ExprInline Nothing, brs) + | all (==ExprCont) (brs ^.. traverse . _3) = + (ExprCont, brs) + | branchResult (brs ^.. traverse ._3) == ExprCont = + (ExprCont, map mkCont brs) + | otherwise = + (ExprInline Nothing, brs) where - mkCont (me, s, ExprInline{}) = (me, s <> assignAll (enumFrom R1) (e ^. ctxTarget), ExprCont) + mkCont (me, s, ExprInline{}) = ( me + , s <> assignAll (enumFrom R1) + (e ^. ctxTarget) + , ExprCont) mkCont x = x loadUbxTup :: [JExpr] -> [Id] -> Int -> C @@ -1245,11 +1478,15 @@ mkSw es cases = mkIfElse es cases -- switch for pattern matching on constructors or prims mkSwitch :: JExpr -> [(Maybe JExpr, JStat, ExprResult)] -> JStat mkSwitch e cases - | [(Just c1,s1,_)] <- n, [(_,s2,_)] <- d = IfStat [je| `e` === `c1` |] s1 s2 - | [(Just c1,s1,_),(_,s2,_)] <- n, null d = IfStat [je| `e` === `c1` |] s1 s2 - | null d = SwitchStat e (map addBreak (init n)) (last n ^. _2) - | [(_,d0,_)] <- d = SwitchStat e (map addBreak n) d0 - | otherwise = panic "mkSwitch: multiple default cases" + | [(Just c1,s1,_)] <- n, [(_,s2,_)] <- d = + IfStat [je| `e` === `c1` |] s1 s2 + | [(Just c1,s1,_),(_,s2,_)] <- n, null d = + IfStat [je| `e` === `c1` |] s1 s2 + | null d = + SwitchStat e (map addBreak (init n)) (last n ^. _2) + | [(_,d0,_)] <- d = + SwitchStat e (map addBreak n) d0 + | otherwise = panic "mkSwitch: multiple default cases" where addBreak (Just c, s, _) = (c, s <> [j| break; |]) addBreak _ = panic "mkSwitch: addBreak" @@ -1278,16 +1515,16 @@ mkAlgBranch :: ExprCtx -- ^ toplevel id for the result -> Id -- ^ datacon to match -> StgAlt -- ^ match alternative with binders -> G (Maybe JExpr, JStat, ExprResult) -mkAlgBranch top d (DataAlt dc,[b],_,expr) +mkAlgBranch top d (DataAlt dc,[b],expr) | isUnboxableCon dc = do idd <- jsId d [fld] <- genIdsI b (ej, er) <- genExpr top expr return (Nothing, decl fld <> [j| `fld` = `idd` |] <> ej, er) -mkAlgBranch top d (a,bs,use,expr) = do +mkAlgBranch top d (a, bs, expr) = do cc <- caseCond a idd <- jsId d - b <- loadParams idd bs use + b <- loadParams idd bs (ej, er) <- genExpr top expr return (cc, b <> ej, er) @@ -1298,8 +1535,11 @@ mkPrimBranch top _vt (cond, _bs, _us, e) = (\cc (ej,er) -> (cc,ej,er)) <$> caseCond cond <*> genExpr top e -} -mkPrimIfBranch :: ExprCtx -> [VarType] -> StgAlt -> G (Maybe [JExpr], JStat, ExprResult) -mkPrimIfBranch top _vt (cond, _bs, _us, e) = +mkPrimIfBranch :: ExprCtx + -> [VarType] + -> StgAlt + -> G (Maybe [JExpr], JStat, ExprResult) +mkPrimIfBranch top _vt (cond, _, e) = (\ic (ej,er) -> (ic,ej,er)) <$> ifCond cond <*> genExpr top e -- fixme are bool things always checked correctly here? @@ -1315,8 +1555,8 @@ caseCond DEFAULT = return Nothing -- load parameters from constructor -- fixme use single tmp var for all branches -loadParams :: JExpr -> [Id] -> [Bool] -> C -loadParams from args use = do +loadParams :: JExpr -> [Id] -> C +loadParams from args = do as <- concat <$> sequence (zipWith (\a u -> map (,u) <$> genIdsI a) args use) return $ case as of [] -> mempty @@ -1328,6 +1568,7 @@ loadParams from args use = do `loadConVarsIfUsed d xs`; |] where + use = repeat True -- fixme clean up loadIfUsed fr tgt True = decl' tgt fr loadIfUsed _ _ _ = mempty @@ -1349,8 +1590,14 @@ genStackArg a@(StgVarArg i) = zipWith f [1..] <$> genArg a f :: Int -> JExpr -> (JExpr, StackSlot) f n e = (e, SlotId i n) -} +{- +genArg :: HasDebugCallStack => StgArg -> G [JExpr] +genArg arg = do + res <- genArg0 arg + trace' ("genArg:\n" ++ show arg ++ "\n" ++ show res) (pure res) +-} -genArg :: StgArg -> G [JExpr] +genArg :: HasDebugCallStack => StgArg -> G [JExpr] genArg (StgLitArg l) = genLit l genArg a@(StgVarArg i) = do unFloat <- use gsUnfloated @@ -1358,7 +1605,11 @@ genArg a@(StgVarArg i) = do Nothing -> reg Just expr -> unfloated expr where - r = uTypeVt . stgArgType $ a + -- if our argument is a joinid, it can be an unboxed tuple + r :: HasDebugCallStack => VarType + r = trace' ("r: " ++ showIndent a) r0 + r0 :: HasDebugCallStack => VarType + r0 = uTypeVt . stgArgType $ a reg | isVoid r = return [] | i == trueDataConId = return [ [je| true |] ] @@ -1366,9 +1617,9 @@ genArg a@(StgVarArg i) = do | isMultiVar r = mapM (jsIdN i) [1..varSize r] | otherwise = (:[]) <$> jsId i - unfloated :: StgExpr -> G [JExpr] + unfloated :: HasDebugCallStack => StgExpr -> G [JExpr] unfloated (StgLit l) = genLit l - unfloated (StgConApp dc args) + unfloated (StgConApp dc args _) | isBoolTy (dataConType dc) || isUnboxableCon dc = (:[]) . allocUnboxedCon dc . concat <$> mapM genArg args | null args = (:[]) <$> jsId (dataConWorkId dc) @@ -1377,9 +1628,10 @@ genArg a@(StgVarArg i) = do e <- enterDataCon dc cs <- use gsSettings return [allocDynamicE cs e as Nothing] -- FIXME: ccs - unfloated x = panic ("genArg: unexpected unfloated expression: " ++ show x) + unfloated x = panic $ "genArg: unexpected unfloated expression: " ++ + show x -genStaticArg :: StgArg -> G [StaticArg] +genStaticArg :: HasDebugCallStack => StgArg -> G [StaticArg] genStaticArg (StgLitArg l) = map StaticLitArg <$> genStaticLit l genStaticArg a@(StgVarArg i) = do unFloat <- use gsUnfloated @@ -1389,15 +1641,19 @@ genStaticArg a@(StgVarArg i) = do where r = uTypeVt . stgArgType $ a reg - | isVoid r = return [] - | i == trueDataConId = return [StaticLitArg (BoolLit True)] - | i == falseDataConId = return [StaticLitArg (BoolLit False)] - | isMultiVar r = map (\(TxtI t) -> StaticObjArg t) <$> mapM (jsIdIN i) [1..varSize r] -- this seems wrong, not an obj? + | isVoid r = + return [] + | i == trueDataConId = + return [StaticLitArg (BoolLit True)] + | i == falseDataConId = + return [StaticLitArg (BoolLit False)] + | isMultiVar r = + map (\(TxtI t) -> StaticObjArg t) <$> mapM (jsIdIN i) [1..varSize r] -- this seems wrong, not an obj? | otherwise = (\(TxtI it) -> [StaticObjArg it]) <$> jsIdI i unfloated :: StgExpr -> G [StaticArg] unfloated (StgLit l) = map StaticLitArg <$> genStaticLit l - unfloated (StgConApp dc args) + unfloated (StgConApp dc args _) | isBoolTy (dataConType dc) || isUnboxableCon dc = (:[]) . allocUnboxedConStatic dc . concat <$> mapM genStaticArg args -- fixme what is allocunboxedcon? | null args = (\(TxtI t) -> [StaticObjArg t]) <$> jsIdI (dataConWorkId dc) @@ -1413,7 +1669,7 @@ allocateStaticList xs a@(StgVarArg i) | otherwise = do unFloat <- use gsUnfloated case lookupUFM unFloat i of - Just (StgConApp dc [h,t]) + Just (StgConApp dc [h,t] _) | dc == consDataCon -> allocateStaticList (h:xs) t _ -> listAlloc xs (Just a) where @@ -1426,10 +1682,15 @@ allocateStaticList xs a@(StgVarArg i) r' <- genStaticArg r case r' of [StaticObjArg ri] -> return (StaticList as (Just ri)) - _ -> panic ("allocateStaticList: invalid argument (tail): " ++ show xs ++ " " ++ show r) + _ -> + panic $ "allocateStaticList: invalid argument (tail): " ++ + show xs ++ + " " ++ + show r allocateStaticList _ _ = panic "allocateStaticList: unexpected literal in list" --- generate arg to be passed to FFI call, with marshalling JStat to be run before the call +-- generate arg to be passed to FFI call, with marshalling JStat to be run +-- before the call -- currently marshalling: -- String literals passed as real JS string -- Ptr ghcjs-base.GHCJS.Types.JSChar -> JavaScript String @@ -1447,11 +1708,14 @@ genFFIArg a@(StgVarArg i) where r = uTypeVt . stgArgType $ a -genIdArg :: Id -> G [JExpr] +genIdArg :: HasDebugCallStack => Id -> G [JExpr] genIdArg i = genArg (StgVarArg i) -genIdArgI :: Id -> G [Ident] -genIdArgI i +genIdArgI :: HasDebugCallStack => Id -> G [Ident] +genIdArgI i = trace' ("genIdArgI: " ++ show i) (genIdArgI0 i) + +genIdArgI0 :: HasDebugCallStack => Id -> G [Ident] +genIdArgI0 i | isVoid r = return [] | isMultiVar r = mapM (jsIdIN i) [1..varSize r] | otherwise = (:[]) <$> jsIdI i @@ -1459,7 +1723,7 @@ genIdArgI i r = uTypeVt . idType $ i -genIdStackArgI :: Id -> G [(Ident,StackSlot)] +genIdStackArgI :: HasDebugCallStack => Id -> G [(Ident,StackSlot)] genIdStackArgI i = zipWith f [1..] <$> genIdArgI i where f :: Int -> Ident -> (Ident,StackSlot) @@ -1468,7 +1732,12 @@ genIdStackArgI i = zipWith f [1..] <$> genIdArgI i r2d :: Rational -> Double r2d = realToFrac -genStrThunk :: Id -> Bool -> B.ByteString -> CostCentreStack -> C +genStrThunk :: HasDebugCallStack + => Id + -> Bool + -> B.ByteString + -> CostCentreStack + -> C genStrThunk i nonAscii str cc = do ii@(TxtI iit) <- jsIdI i let d = decl ii @@ -1476,22 +1745,25 @@ genStrThunk i nonAscii str cc = do let ccsArg = map toJExpr $ maybeToList ccs emitStatic iit (StaticThunk Nothing) Nothing return $ case decodeModifiedUTF8 str of - Just t -> d <> if nonAscii - then [j| `ii` = `ApplExpr (jvar "h$strt") $ - [toJExpr $ T.unpack t] ++ ccsArg`; |] - else [j| `ii` = `ApplExpr (jvar "h$strta") $ - [toJExpr $ T.unpack t] ++ ccsArg`; |] - Nothing -> d <> if nonAscii - then [j| `ii` = `ApplExpr (jvar "h$strtb") $ - [toJExpr $ map toInteger (B.unpack str)] ++ ccsArg`; |] - else [j| `ii` = `ApplExpr (jvar "h$strta") $ - [toJExpr $ map (chr.fromIntegral) (B.unpack str)] ++ ccsArg`; |] - -genLit :: Literal -> G [JExpr] + Just t -> d <> + if nonAscii + then [j| `ii` = `ApplExpr (jvar "h$strt") $ + [toJExpr $ T.unpack t] ++ ccsArg`; |] + else [j| `ii` = `ApplExpr (jvar "h$strta") $ + [toJExpr $ T.unpack t] ++ ccsArg`; |] + Nothing -> d <> + if nonAscii + then [j| `ii` = `ApplExpr (jvar "h$strtb") $ + [toJExpr $ map toInteger (B.unpack str)] ++ ccsArg`; |] + else [j| `ii` = `ApplExpr (jvar "h$strta") $ + [toJExpr $ map (chr.fromIntegral) (B.unpack str)] ++ ccsArg`; |] + +genLit :: HasDebugCallStack => Literal -> G [JExpr] genLit (MachChar c) = return [ [je| `ord c` |] ] genLit (MachStr str) = case decodeModifiedUTF8 str of Just t -> withNewIdent $ \ident -> do + -- this should do modified UTF8 emitToplevel [j| `decl ident`; `ident` = h$str(`T.unpack t`); |] @@ -1503,15 +1775,19 @@ genLit (MachStr str) = return [ [je| `ident`() |], [je| 0 |] ] genLit MachNullAddr = return [ [je| null |], [je| 0 |] ] genLit (MachInt i) = return [ [je| `intLit i` |] ] -genLit (MachInt64 i) = return [ [je| `intLit (shiftR i 32)` |] , [je| `toSigned i` |] ] +genLit (MachInt64 i) = return [ [je| `intLit (shiftR i 32)` |] + , [je| `toSigned i` |] + ] genLit (MachWord w) = return [ [je| `toSigned w` |] ] -genLit (MachWord64 w) = return [ [je| `toSigned (shiftR w 32)` |] , [je| `toSigned w` |] ] +genLit (MachWord64 w) = return [ [je| `toSigned (shiftR w 32)` |] + , [je| `toSigned w` |] + ] genLit (MachFloat r) = return [ [je| `r2d r` |] ] genLit (MachDouble r) = return [ [je| `r2d r` |] ] genLit (MachLabel name _size fod) | fod == IsFunction = return [ [je| h$mkFunctionPtr(`TxtI . T.pack $ "h$" ++ unpackFS name`) |], [je| 0 |] ] | otherwise = return [ iex (TxtI . T.pack $ "h$" ++ unpackFS name), [je| 0 |] ] -genLit (LitInteger _i _id) =panic ("genLit: LitInteger") -- removed by CorePrep +genLit (LitInteger _i _id) = panic "genLit: LitInteger" -- removed by CorePrep -- | generate a literal for the static init tables genStaticLit :: Literal -> G [StaticLit] @@ -1522,14 +1798,21 @@ genStaticLit (MachStr str) = Left _ -> return [ BinLit str, IntLit 0] genStaticLit MachNullAddr = return [ NullLit, IntLit 0 ] genStaticLit (MachInt i) = return [ IntLit (fromIntegral i) ] -genStaticLit (MachInt64 i) = return [ IntLit (i `shiftR` 32), IntLit (toSigned i) ] +genStaticLit (MachInt64 i) = return [ IntLit (i `shiftR` 32) + , IntLit (toSigned i) + ] genStaticLit (MachWord w) = return [ IntLit (toSigned w) ] -genStaticLit (MachWord64 w) = return [ IntLit (toSigned (w `shiftR` 32)), IntLit (toSigned w) ] +genStaticLit (MachWord64 w) = return [ IntLit (toSigned (w `shiftR` 32)) + , IntLit (toSigned w) + ] genStaticLit (MachFloat r) = return [ DoubleLit . SaneDouble . r2d $ r ] genStaticLit (MachDouble r) = return [ DoubleLit . SaneDouble . r2d $ r ] genStaticLit (MachLabel name _size fod) = - return [ LabelLit (fod == IsFunction) (T.pack $ "h$" ++ unpackFS name) , IntLit 0 ] -genStaticLit l = panic ("genStaticLit: " ++ show l) + return [ LabelLit (fod == IsFunction) (T.pack $ "h$" ++ unpackFS name) + , IntLit 0 + ] +genStaticLit l = panic $ "genStaticLit: " ++ + show l -- make a signed 32 bit int from this unsigned one, lower 32 bits toSigned :: Integer -> Integer @@ -1552,7 +1835,11 @@ genCon tgt con args | isUnboxedTupleCon con && length (tgt^.ctxTarget) == length args = return $ assignAll (tgt ^. ctxTarget) args genCon tgt con args | isUnboxedTupleCon con = - panic ("genCon: unhandled DataCon: " ++ show con ++ " " ++ show (tgt ^. ctxTop, length args)) + panic ("genCon: unhandled DataCon:\n" ++ + show con ++ "\n" ++ + show (tgt ^. ctxTop) ++ "\n" ++ + show (tgt ^. ctxTarget) ++ "\n" ++ + show args) genCon tgt con args | [ValExpr (JVar tgti)] <- tgt ^. ctxTarget = allocCon tgti con currentCCS args genCon tgt con args = @@ -1583,8 +1870,10 @@ allocUnboxedCon con xs = panic ("allocUnboxedCon: not an unboxed constructor: " allocUnboxedConStatic :: DataCon -> [StaticArg] -> StaticArg allocUnboxedConStatic con [] - | isBoolTy (dataConType con) && dataConTag con == 1 = StaticLitArg (BoolLit False) - | isBoolTy (dataConType con) && dataConTag con == 2 = StaticLitArg (BoolLit True) + | isBoolTy (dataConType con) && dataConTag con == 1 = + StaticLitArg (BoolLit False) + | isBoolTy (dataConType con) && dataConTag con == 2 = + StaticLitArg (BoolLit True) allocUnboxedConStatic _ [a@(StaticLitArg (IntLit _i))] = a allocUnboxedConStatic _ [a@(StaticLitArg (DoubleLit _d))] = a allocUnboxedConStatic con _ = @@ -1592,7 +1881,7 @@ allocUnboxedConStatic con _ = allocConStatic :: Ident -> CostCentreStack -> DataCon -> [GenStgArg Id] {- -> Bool -} -> G () allocConStatic (TxtI to) cc con args -- isRecursive -{- | Debug.Trace.trace ("allocConStatic: " ++ show to ++ " " ++ show con ++ " " ++ show args) True -} = do +{- | trace' ("allocConStatic: " ++ show to ++ " " ++ show con ++ " " ++ show args) True -} = do as <- mapM genStaticArg args cc' <- costCentreStackLbl cc allocConStatic' cc' (concat as) @@ -1609,10 +1898,14 @@ allocConStatic (TxtI to) cc con args -- isRecursive allocConStatic' cc' [x] | isUnboxableCon con = case x of - StaticLitArg (IntLit i) -> emitStatic to (StaticUnboxed $ StaticUnboxedInt i) cc' - StaticLitArg (BoolLit b) -> emitStatic to (StaticUnboxed $ StaticUnboxedBool b) cc' - StaticLitArg (DoubleLit d) -> emitStatic to (StaticUnboxed $ StaticUnboxedDouble d) cc' - _ -> panic $ "allocConStatic: invalid unboxed literal: " ++ show x + StaticLitArg (IntLit i) -> + emitStatic to (StaticUnboxed $ StaticUnboxedInt i) cc' + StaticLitArg (BoolLit b) -> + emitStatic to (StaticUnboxed $ StaticUnboxedBool b) cc' + StaticLitArg (DoubleLit d) -> + emitStatic to (StaticUnboxed $ StaticUnboxedDouble d) cc' + _ -> + panic $ "allocConStatic: invalid unboxed literal: " ++ show x allocConStatic' cc' xs = if con == consDataCon then flip (emitStatic to) cc' =<< allocateStaticList [args !! 0] (args !! 1) @@ -1641,7 +1934,7 @@ jumpTo' fun args = ra <> [j| return `fun`(); |] ra = assignAll (enumFrom R2) args -} -jumpToFast :: [StgArg] -> JStat -> C +jumpToFast :: HasDebugCallStack => [StgArg] -> JStat -> C jumpToFast as afterLoad = do regs <- concatMapM genArg as (fun, spec) <- selectApply True (as,regs) @@ -1676,18 +1969,31 @@ getObjectKeyValuePairs [] = Just [] getObjectKeyValuePairs (k:v:xs) | Just t <- argJSStringLitUnfolding k = fmap ((t,v):) (getObjectKeyValuePairs xs) -getObjectKeyValuePairs _ = Nothing +getObjectKeyValuePairs _ = Nothing argJSStringLitUnfolding :: StgArg -> Maybe Text argJSStringLitUnfolding (StgVarArg v) | False = Just "abc" -- fixme argJSStringLitUnfolding _ = Nothing -genForeignCall :: ForeignCall -> Type -> [JExpr] -> [StgArg] -> G (JStat, ExprResult) -genForeignCall (CCall (CCallSpec (StaticTarget _ tgt Nothing True) JavaScriptCallConv PlayRisky)) t [obj] args - | tgt == fsLit "h$buildObject", Just pairs <- getObjectKeyValuePairs args = do +genForeignCall :: HasDebugCallStack + => ForeignCall + -> Type + -> [JExpr] + -> [StgArg] + -> G (JStat, ExprResult) +genForeignCall (CCall (CCallSpec (StaticTarget _ tgt Nothing True) + JavaScriptCallConv + PlayRisky)) + t + [obj] + args + | tgt == fsLit "h$buildObject" + , Just pairs <- getObjectKeyValuePairs args = do pairs' <- mapM (\(k,v) -> genArg v >>= \([v']) -> return (k,v')) pairs - return (assignj obj (ValExpr (JHash $ M.fromList pairs')), ExprInline Nothing) + return ( assignj obj (ValExpr (JHash $ M.fromList pairs')) + , ExprInline Nothing + ) genForeignCall (CCall (CCallSpec ccTarget cconv safety)) t tgt args = (,exprResult) <$> parseFFIPattern catchExcep async isJsCc lbl t tgt' args where @@ -1871,9 +2177,10 @@ saturateFFI u = jsSaturate (Just . T.pack $ "ghcjs_ffi_sat_" ++ show u) resultPlaceholders :: Bool -> Type -> [JExpr] -> [(Ident,JExpr)] -- ident, replacement resultPlaceholders True _ _ = [] -- async has no direct resuls, use callback resultPlaceholders False t rs = - case repType t of - UbxTupleRep uts -> - let sizes = filter (>0) (map typeSize uts) + case typeVt (unwrapType t) of + [t'] -> mkUnary (varSize t') + uts -> + let sizes = filter (>0) (map varSize uts) f _ 0 = [] f n 1 = [["$r" ++ show n]] f n k = ["$r" ++ sn, "$r" ++ sn ++ "_1"] : map (\x -> ["$r" ++ sn ++ "_" ++ show x]) [2..k] @@ -1882,7 +2189,6 @@ resultPlaceholders False t rs = in case sizes of [n] -> mkUnary n _ -> concat $ zipWith (\phs' r -> map (\i -> (TxtI (T.pack i), r)) phs') (concat phs) rs - UnaryRep t' -> mkUnary (typeSize t') where mkUnary 0 = [] mkUnary 1 = [(TxtI "$r",head rs)] -- single @@ -1931,34 +2237,45 @@ makeIdent = do gsId += 1 i <- use gsId mod <- use gsModule - return (TxtI . T.pack $ "h$$" ++ zEncodeString (show mod) ++ "_" ++ encodeUnique i) + return (TxtI . T.pack $ "h$$" ++ + zEncodeString (show mod) ++ + "_" ++ + encodeUnique i + ) freshUnique :: G Int freshUnique = gsId += 1 >> use gsId -- returns True if the expression is definitely inline isInlineExpr :: UniqSet Id -> StgExpr -> (UniqSet Id, Bool) -isInlineExpr v (StgApp i args) = (emptyUniqSet, isInlineApp v i args) -isInlineExpr _ (StgLit{}) = (emptyUniqSet, True) -isInlineExpr _ (StgConApp{}) = (emptyUniqSet, True) -isInlineExpr _ (StgOpApp (StgFCallOp f _) _ _) = (emptyUniqSet, isInlineForeignCall f) -isInlineExpr v (StgOpApp (StgPrimOp SeqOp) [StgVarArg e] t) = (emptyUniqSet, e `elementOfUniqSet` v || isStrictType t) -isInlineExpr _ (StgOpApp (StgPrimOp op) _ _) = (emptyUniqSet, isInlinePrimOp op) -isInlineExpr _ (StgOpApp (StgPrimCallOp _c) _ _) = (emptyUniqSet, True) -isInlineExpr _ (StgLam{}) = (emptyUniqSet, True) -isInlineExpr v (StgCase e _ _ b _ _ alts) = let (_ve, ie) = isInlineExpr v e - v' = addOneToUniqSet v b - (vas, ias) = unzip $ map (isInlineExpr v') (alts ^.. traverse . _4) - vr = foldl1' intersectUniqSets vas - in (vr, (ie || b `elementOfUniqSet` v) && and ias) -isInlineExpr v (StgLet b e) = isInlineExpr (inspectInlineBinding v b) e -isInlineExpr v (StgLetNoEscape _ _ b e) = isInlineExpr v e -#if __GLASGOW_HASKELL__ < 709 -isInlineExpr v (StgSCC _ _ _ e) = isInlineExpr v e -isInlineExpr v (StgTick _ _ e) = isInlineExpr v e -#else -isInlineExpr v (StgTick _ e) = isInlineExpr v e -#endif +isInlineExpr v (StgApp i args) = + (emptyUniqSet, isInlineApp v i args) +isInlineExpr _ (StgLit{}) = + (emptyUniqSet, True) +isInlineExpr _ (StgConApp{}) = + (emptyUniqSet, True) +isInlineExpr _ (StgOpApp (StgFCallOp f _) _ _) = + (emptyUniqSet, isInlineForeignCall f) +isInlineExpr v (StgOpApp (StgPrimOp SeqOp) [StgVarArg e] t) = + (emptyUniqSet, e `elementOfUniqSet` v || isStrictType t) +isInlineExpr _ (StgOpApp (StgPrimOp op) _ _) = + (emptyUniqSet, isInlinePrimOp op) +isInlineExpr _ (StgOpApp (StgPrimCallOp _c) _ _) = + (emptyUniqSet, True) +isInlineExpr _ (StgLam{}) = + (emptyUniqSet, True) +isInlineExpr v (StgCase e b _ alts) = + let (_ve, ie) = isInlineExpr v e + v' = addOneToUniqSet v b + (vas, ias) = unzip $ map (isInlineExpr v') (alts ^.. traverse . _3) + vr = foldl1' intersectUniqSets vas + in (vr, (ie || b `elementOfUniqSet` v) && and ias) +isInlineExpr v (StgLet b e) = + isInlineExpr (inspectInlineBinding v b) e +isInlineExpr v (StgLetNoEscape b e) = + isInlineExpr (inspectInlineBinding v b) e +isInlineExpr v (StgTick _ e) = + isInlineExpr v e inspectInlineBinding :: UniqSet Id -> StgBinding -> UniqSet Id inspectInlineBinding v (StgNonRec i r) = inspectInlineRhs v i r @@ -1966,9 +2283,9 @@ inspectInlineBinding v (StgRec bs) = foldl' (\v' (i,r) -> inspectInlineRhs v' i r) v bs inspectInlineRhs :: UniqSet Id -> Id -> StgRhs -> UniqSet Id -inspectInlineRhs v i (StgRhsCon{}) = addOneToUniqSet v i -inspectInlineRhs v i (StgRhsClosure _ _ _ ReEntrant _ _ _) = addOneToUniqSet v i -inspectInlineRhs v _ _ = v +inspectInlineRhs v i (StgRhsCon{}) = addOneToUniqSet v i +inspectInlineRhs v i (StgRhsClosure _ _ _ ReEntrant _ _) = addOneToUniqSet v i +inspectInlineRhs v _ _ = v isInlineForeignCall :: ForeignCall -> Bool isInlineForeignCall (CCall (CCallSpec _ cconv safety)) = @@ -1976,9 +2293,19 @@ isInlineForeignCall (CCall (CCallSpec _ cconv safety)) = not (cconv /= JavaScriptCallConv && playSafe safety) isInlineApp :: UniqSet Id -> Id -> [StgArg] -> Bool -isInlineApp v i [] = isUnboxedTupleType (idType i) || isStrictType (idType i) || i `elementOfUniqSet` v || isStrictId i +isInlineApp _ i _ + | isJoinId i = False +isInlineApp v i [] = isUnboxedTupleType (idType i) || + isStrictType (idType i) || + i `elementOfUniqSet` v || + isStrictId i isInlineApp _ i [StgLitArg (MachStr _)] - | getUnique i `elem` [unpackCStringIdKey, unpackCStringUtf8IdKey, unpackCStringAppendIdKey] = True + | getUnique i `elem` [ unpackCStringIdKey + , unpackCStringUtf8IdKey + , unpackCStringAppendIdKey + ] = True isInlineApp v i [StgVarArg a] - | DataConWrapId dc <- idDetails i, isNewTyCon (dataConTyCon dc), isStrictType (idType a) || a `elementOfUniqSet` v || isStrictId a = True + | DataConWrapId dc <- idDetails i + , isNewTyCon (dataConTyCon dc) + , isStrictType (idType a) || a `elementOfUniqSet` v || isStrictId a = True isInlineApp _ _ _ = False diff --git a/src/Gen2/Linker.hs b/src/Gen2/Linker.hs old mode 100755 new mode 100644 index d335ebe0..e04ea70c --- a/src/Gen2/Linker.hs +++ b/src/Gen2/Linker.hs @@ -4,7 +4,8 @@ TupleSections, LambdaCase, DeriveGeneric, - TemplateHaskell #-} + TemplateHaskell + #-} {- | GHCJS linker, collects dependencies from the object files (.js_o, js_p_o), which contain linkable @@ -16,21 +17,14 @@ module Gen2.Linker where import DynFlags import Encoding import Panic -#if __GLASGOW_HASKELL__ >= 711 -import Module (mkModuleName, wiredInUnitIds) +import Module ( InstalledUnitId + , stringToInstalledUnitId + , installedUnitIdString + , toInstalledUnitId + , mkModuleName, wiredInUnitIds + , moduleNameString + , primUnitId ) import PackageConfig (sourcePackageId, unitId) -#elif __GLASGOW_HASKELL__ >= 709 -import Module (mkModuleName, wiredInPackageKeys) -import PackageConfig (sourcePackageId, packageKey) -#else -import UniqFM -import Module (mkModuleName) -import qualified Module as Mod -import PackageConfig (sourcePackageId) -import Data.Maybe (listToMaybe) -import Distribution.Package (InstalledPackageId(..)) -#endif -import Module (moduleNameString) import Outputable (ppr, showSDoc) import qualified Packages import qualified SysTools @@ -47,7 +41,6 @@ import Data.Array import Data.Binary import Data.ByteString (ByteString) import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as BL import Data.Char (toLower, chr) import Data.Function (on) @@ -65,7 +58,6 @@ import Data.Set (Set) import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Text.Encoding as TE import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL @@ -85,8 +77,8 @@ import System.FilePath (splitPath, (<.>), (), dropExtension, takeExtension) import System.Directory - (createDirectoryIfMissing, doesDirectoryExist, canonicalizePath - ,doesFileExist, getDirectoryContents, getCurrentDirectory, copyFile) + ( createDirectoryIfMissing, doesDirectoryExist, canonicalizePath + , doesFileExist, getDirectoryContents, getCurrentDirectory, copyFile ) import Text.PrettyPrint.Leijen.Text (displayT, renderPretty) import Compiler.Compat @@ -132,7 +124,7 @@ link :: DynFlags -> GhcjsSettings -> FilePath -- ^ output file/directory -> [FilePath] -- ^ include path for home package - -> [PackageKey] -- ^ packages to link + -> [InstalledUnitId] -- ^ packages to link -> [LinkedObj] -- ^ the object files we're linking -> [FilePath] -- ^ extra js files to include -> (Fun -> Bool) -- ^ functions from the objects to use as roots (include all their deps) @@ -181,7 +173,7 @@ link' :: DynFlags -> GhcjsSettings -> String -- ^ target (for progress message) -> [FilePath] -- ^ include path for home package - -> [PackageKey] -- ^ packages to link + -> [InstalledUnitId] -- ^ packages to link -> [LinkedObj] -- ^ the object files we're linking -> [FilePath] -- ^ extra js files to include -> (Fun -> Bool) -- ^ functions from the objects to use as roots (include all their deps) @@ -206,12 +198,13 @@ link' dflags env settings target include pkgs objFiles jsFiles isRootFun extraSt BaseState b -> return b (rdPkgs, rds) <- rtsDeps dflags c <- newMVar M.empty - let rtsPkgs = map stringToPackageKey + let rtsPkgs = map stringToInstalledUnitId ["@rts", "@rts_" ++ rtsBuildTag dflags] + pkgs' :: [InstalledUnitId] pkgs' = nub (rtsPkgs ++ rdPkgs ++ reverse objPkgs ++ reverse pkgs) pkgs'' = filter (not . (isAlreadyLinked base)) pkgs' pkgLibPaths = mkPkgLibPaths pkgs' - getPkgLibPaths :: PackageKey -> ([FilePath],[String]) + getPkgLibPaths :: InstalledUnitId -> ([FilePath],[String]) getPkgLibPaths k = fromMaybe ([],[]) (lookup k pkgLibPaths) (archsDepsMap, archsRequiredUnits) <- loadArchiveDeps env =<< getPackageArchives dflags (map snd $ mkPkgLibPaths pkgs') @@ -219,7 +212,7 @@ link' dflags env settings target include pkgs objFiles jsFiles isRootFun extraSt (allDeps, code) <- collectDeps dflags (objDepsMap `M.union` archsDepsMap) - (pkgs' ++ [thisPackage dflags]) + (pkgs' ++ [thisInstalledUnitId dflags]) (baseUnits base) (roots `S.union` rds `S.union` extraStaticDeps) (archsRequiredUnits ++ objRequiredUnits) @@ -234,13 +227,14 @@ link' dflags env settings target include pkgs objFiles jsFiles isRootFun extraSt (filter (`notElem` alreadyLinkedAfter) shimsAfter) pkgArchs base' where - isAlreadyLinked :: Base -> PackageKey -> Bool + isAlreadyLinked :: Base -> InstalledUnitId -> Bool isAlreadyLinked b pkg = mkPackage pkg `elem` basePkgs b - mkPkgLibPaths :: [PackageKey] -> [(PackageKey, ([FilePath],[String]))] + mkPkgLibPaths :: [InstalledUnitId] -> [(InstalledUnitId, ([FilePath],[String]))] mkPkgLibPaths = map (\k -> ( k - , (getPackageLibDirs dflags k, getPackageHsLibs dflags k) + , (getInstalledPackageLibDirs dflags k + , getInstalledPackageHsLibs dflags k) )) renderLinker :: GhcjsSettings @@ -298,19 +292,19 @@ getPackageArchives dflags pkgs = | otherwise = "" -- fixme the wired-in package id's we get from GHC we have no version -getShims :: DynFlags -> [FilePath] -> [PackageKey] -> IO ([FilePath], [FilePath]) +getShims :: DynFlags -> [FilePath] -> [InstalledUnitId] -> IO ([FilePath], [FilePath]) getShims dflags extraFiles pkgDeps = do (w,a) <- collectShims (getLibDir dflags "shims") (map (convertPkg dflags) pkgDeps) extraFiles' <- mapM canonicalizePath extraFiles return (w, a++extraFiles') -convertPkg :: DynFlags -> PackageKey -> (Text, Version) +convertPkg :: DynFlags -> InstalledUnitId -> (Text, Version) convertPkg dflags p - = case getPackageVersion dflags p of - Just v -> (T.pack (getPackageName dflags p), v) + = case getInstalledPackageVersion dflags p of + Just v -> (T.pack (getInstalledPackageName dflags p), v) -- special or wired-in - Nothing -> (T.pack (packageKeyString p), Version []) + Nothing -> (T.pack (installedUnitIdString p), Version []) {- | convenience: combine rts.js, lib.js, out.js to all.js that can be run directly with node.js or SpiderMonkey jsshell @@ -343,16 +337,15 @@ writeRunner :: GhcjsSettings -> DynFlags -> FilePath -> IO () writeRunner settings dflags out = when (gsBuildRunner settings) $ do cd <- getCurrentDirectory let runner = cd addExeExtension (dropExtension out) - nodeSettings <- readNodeSettings dflags #ifdef mingw32_HOST_OS src <- B.readFile (cd out "all" <.> "js") + node <- B.readFile (topDir dflags "node") templ <- T.readFile (topDir dflags "runner.c-tmpl") runnerSrc <- SysTools.newTempName dflags "c" - -- FIXME: this does not take the node extra arguments into account T.writeFile runnerSrc $ substPatterns [] [ ("js", bsLit src) , ("jsSize", T.pack (show $ B.length src)) - , ("node", bsLit (BC.pack $ nodeProgram nodeSettings)) + , ("node", bsLit node) ] templ SysTools.runCc dflags [ Option "-o" , FileOption "" runner @@ -374,9 +367,9 @@ writeRunner settings dflags out = when (gsBuildRunner settings) $ do let x' = showOct x [] in replicate (3-length x') '0' ++ x' #else - src <- B.readFile (cd out "all" <.> "js") - let pgm = TE.encodeUtf8 (T.pack $ nodeProgram nodeSettings) - B.writeFile runner ("#!" <> pgm <> "\n" <> src) + src <- B.readFile (cd out "all" <.> "js") + node <- B.readFile (topDir dflags "node") + B.writeFile runner ("#!" <> node <> "\n" <> src) Cabal.setFileExecutable runner #endif @@ -453,7 +446,7 @@ getDeps lookup base fun startlu = go' S.empty (S.fromList startlu) (S.toList fun -- | collect dependencies for a set of roots collectDeps :: DynFlags -> Map (Package, Module) (Deps, DepsLocation) - -> [PackageKey] -- ^ packages, code linked in this order + -> [InstalledUnitId] -- ^ packages, code linked in this order -> Set LinkableUnit -- ^ do not include these -> Set Fun -- ^ roots -> [LinkableUnit] -- ^ more roots @@ -463,7 +456,7 @@ collectDeps :: DynFlags collectDeps dflags lookup packages base roots units = do allDeps <- getDeps (fmap fst lookup) base roots units -- read ghc-prim first, since we depend on that for static initialization - let packages' = uncurry (++) $ partition (==primPackageKey) (nub packages) + let packages' = uncurry (++) $ partition (==(toInstalledUnitId primUnitId)) (nub packages) unitsByModule :: Map (Package, Module) IntSet unitsByModule = M.fromListWith IS.union $ map (\(p,m,n) -> ((p,m),IS.singleton n)) (S.toList allDeps) @@ -502,11 +495,11 @@ extractDeps units deps loc = , concatMap oiStatic l) in evaluate (rnf x) >> return (Just x) -mkPackage :: PackageKey -> Package -mkPackage pk = Package (T.pack $ packageKeyString pk) +mkPackage :: InstalledUnitId -> Package +mkPackage pk = Package (T.pack $ installedUnitIdString pk) -toPackageKey :: Package -> PackageKey -toPackageKey = stringToPackageKey . T.unpack . unPackage +toPackageKey :: Package -> InstalledUnitId +toPackageKey = stringToInstalledUnitId . T.unpack . unPackage {- | Static dependencies are symbols that need to be linked regardless of whether the linked program refers to them. For example @@ -545,7 +538,7 @@ instance FromJSON StaticDeps where parseJSON _ = mempty -- | dependencies for the RTS, these need to be always linked -rtsDeps :: DynFlags -> IO ([PackageKey], Set Fun) +rtsDeps :: DynFlags -> IO ([InstalledUnitId], Set Fun) rtsDeps dflags = readSystemDeps dflags "RTS" "linking" @@ -553,7 +546,7 @@ rtsDeps dflags = readSystemDeps dflags -- | dependencies for the Template Haskell, these need to be linked when running -- Template Haskell (in addition to the RTS deps) -thDeps :: DynFlags -> IO ([PackageKey], Set Fun) +thDeps :: DynFlags -> IO ([InstalledUnitId], Set Fun) thDeps dflags = readSystemDeps dflags "Template Haskell" "running Template Haskell" @@ -563,45 +556,39 @@ readSystemDeps :: DynFlags -> String -> String -> FilePath - -> IO ([PackageKey], Set Fun) + -> IO ([InstalledUnitId], Set Fun) readSystemDeps dflags depsName requiredFor file = do b <- B.readFile (getLibDir dflags file) wi <- readSystemWiredIn dflags case Yaml.decodeEither b of - Left err -> error $ "could not read " ++ depsName ++ + Left err -> panic $ "could not read " ++ depsName ++ " dependencies from " ++ file ++ ":\n" ++ err Right sdeps -> let (StaticDeps unresolved, pkgs, funs) = staticDeps dflags wi sdeps in case unresolved of xs@((p,_,_):_) -> do - error ( "Package `" ++ T.unpack p ++ "' is required for " ++ - requiredFor ++ ", but was not found") - _ -> return (pkgs, funs) + panic $ "Package `" ++ T.unpack p ++ "' is required for " ++ + requiredFor ++ ", but was not found" + _ -> do + -- putStrLn "system dependencies:" + -- print (map installedUnitIdString pkgs, funs) + return (pkgs, funs) -readSystemWiredIn :: DynFlags -> IO [(Text, PackageKey)] +readSystemWiredIn :: DynFlags -> IO [(Text, InstalledUnitId)] readSystemWiredIn dflags = do b <- B.readFile filename case Yaml.decodeEither b of Left err -> error $ "could not read wired-in package keys from " ++ filename Right m -> return . M.toList . M.union ghcWiredIn -- GHC wired-in package keys override those in the file - . fmap stringToPackageKey $ m + . fmap stringToInstalledUnitId $ m where filename = getLibDir dflags "wiredinkeys" <.> "yaml" - ghcWiredIn :: Map Text PackageKey - ghcWiredIn = M.fromList $ map (\k -> (T.pack (packageKeyString k), k)) -#if __GLASGOW_HASKELL__ >= 711 - wiredInUnitIds -#elif __GLASGOW_HASKELL__ >= 709 - wiredInPackageKeys -#else - [ Mod.primPackageId, Mod.integerPackageId, Mod.basePackageId - , Mod.rtsPackageId, Mod.thPackageId, Mod.dphSeqPackageId - , Mod.dphParPackageId, Mod.thisGhcPackageId - ] -#endif + ghcWiredIn :: Map Text InstalledUnitId + ghcWiredIn = M.fromList $ map (\k -> (T.pack (installedUnitIdString k), k)) + (map toInstalledUnitId wiredInUnitIds) {- | read a static dependencies specification and give the roots if dependencies come from a versioned (non-hardwired) package @@ -612,86 +599,51 @@ readSystemWiredIn dflags = do type SDep = (Text, Text, Text) staticDeps :: DynFlags - -> [(Text, PackageKey)] -- ^ wired-in package names / keys + -> [(Text, InstalledUnitId)] -- ^ wired-in package names / keys -> StaticDeps -- ^ deps from yaml file - -> (StaticDeps, [PackageKey], Set Fun) + -> (StaticDeps, [InstalledUnitId], Set Fun) -- ^ the StaticDeps contains the symbols -- for which no package could be found staticDeps dflags wiredin sdeps = mkDeps sdeps where -#if !(__GLASGOW_HASKELL__ >= 709) - lookupInstalledPackage :: Packages.PackageConfigMap -> PackageKey -> Maybe Packages.PackageConfig - lookupInstalledPackage pkgs ipid = - case filter ((==InstalledPackageId (packageKeyString ipid)) . Packages.installedPackageId) (eltsUFM pkgs) of - [conf] -> Just conf - _ -> Packages.lookupPackage pkgs ipid -#endif zenc = T.pack . zEncodeString . T.unpack mkDeps (StaticDeps ds) = let (u, p, r) = foldl' resolveDep ([], S.empty, S.empty) ds in (StaticDeps u, S.toList (closePackageDeps dflags p), r) - resolveDep :: ([SDep], Set PackageKey, Set Fun) + resolveDep :: ([SDep], Set InstalledUnitId, Set Fun) -> SDep - -> ([SDep], Set PackageKey, Set Fun) + -> ([SDep], Set InstalledUnitId, Set Fun) resolveDep (unresolved, pkgs, resolved) dep@(p, m, s) = case lookup p wiredin of Nothing -> ( dep : unresolved, pkgs, resolved) -#if __GLASGOW_HASKELL__ >= 709 - Just k -> case Packages.lookupPackage dflags k of -#else - Just k -> case lookupInstalledPackage (Packages.pkgIdMap . pkgState $ dflags) k of -#endif + Just k -> case Packages.lookupInstalledPackage dflags k of Nothing -> error $ "Package key for wired-in dependency `" ++ T.unpack p ++ "' could not be found: " ++ - packageKeyString k + installedUnitIdString k Just conf -> -#if __GLASGOW_HASKELL__ >= 711 let k' = unitId conf -#elif __GLASGOW_HASKELL__ >= 709 - let k' = packageKey conf -#else - let k' = Packages.packageConfigId conf -#endif in ( unresolved , S.insert k' pkgs , S.insert (Fun (mkPackage k') m $ mkSymb k' m s) - resolved + resolved ) - mkSymb :: PackageKey -> Text -> Text -> Text + mkSymb :: InstalledUnitId -> Text -> Text -> Text mkSymb p m s = - "h$" <> zenc (T.pack (encodePackageKey dflags p) <> ":" <> m <> "." <> s) + "h$" <> zenc (T.pack (encodeInstalledUnitId dflags p) <> ":" <> m <> "." <> s) -closePackageDeps :: DynFlags -> Set PackageKey -> Set PackageKey +closePackageDeps :: DynFlags -> Set InstalledUnitId -> Set InstalledUnitId closePackageDeps dflags pkgs | S.size pkgs == S.size pkgs' = pkgs | otherwise = closePackageDeps dflags pkgs' where pkgs' = pkgs `S.union` S.fromList (concatMap deps $ S.toList pkgs) notFound = error "closePackageDeps: package not found" - deps :: PackageKey -> [PackageKey] + deps :: InstalledUnitId -> [InstalledUnitId] deps = -#if __GLASGOW_HASKELL__ >= 711 -- map (Packages.resolveInstalledPackageId dflags) Packages.depends . fromMaybe notFound - . Packages.lookupPackage dflags -#elif __GLASGOW_HASKELL__ >= 709 - map (Packages.resolveInstalledPackageId dflags) - . Packages.depends - . fromMaybe notFound - . Packages.lookupPackage dflags -#else - map resolveDep - . Packages.depends - . fromMaybe notFound - . Packages.lookupPackage pkgMap - pkgMap = Packages.pkgIdMap (pkgState dflags) - allPkgs = eltsUFM pkgMap - resolveDep ipid = - maybe notFound - Packages.packageConfigId - (listToMaybe $ filter ((==ipid).Packages.installedPackageId) allPkgs) -#endif + . Packages.lookupInstalledPackage dflags -- read all dependency data from the to-be-linked files loadObjDeps :: [LinkedObj] -- ^ object files to link @@ -700,7 +652,9 @@ loadObjDeps objs = prepareLoadedDeps <$> mapM readDepsFile' objs loadArchiveDeps :: GhcjsEnv -> [FilePath] - -> IO (Map (Package, Module) (Deps, DepsLocation), [LinkableUnit]) + -> IO ( Map (Package, Module) (Deps, DepsLocation) + , [LinkableUnit] + ) loadArchiveDeps env archives = modifyMVar (linkerArchiveDeps env) $ \m -> case M.lookup archives' m of Just r -> return (m, r) @@ -709,16 +663,22 @@ loadArchiveDeps env archives = modifyMVar (linkerArchiveDeps env) $ \m -> archives' = S.fromList archives loadArchiveDeps' :: [FilePath] - -> IO (Map (Package, Module) (Deps, DepsLocation), [LinkableUnit]) + -> IO ( Map (Package, Module) (Deps, DepsLocation) + , [LinkableUnit] + ) loadArchiveDeps' archives = do - archDeps <- forM archives $ \file -> - Ar.withAllObjects file $ \modulename h _len -> + archDeps <- forM archives $ \file -> do + -- putStrLn $ "reading archive: " ++ file + Ar.withAllObjects file $ \modulename h _len -> do + -- putStrLn ("reading module: " ++ moduleNameString modulename) (,ArchiveFile file) <$> hReadDeps (file ++ ':':moduleNameString modulename) h return (prepareLoadedDeps $ concat archDeps) prepareLoadedDeps :: [(Deps, DepsLocation)] - -> (Map (Package, Module) (Deps, DepsLocation), [LinkableUnit]) + -> ( Map (Package, Module) (Deps, DepsLocation) + , [LinkableUnit] + ) prepareLoadedDeps deps = let req = concatMap (requiredUnits . fst) deps depsMap = M.fromList $ map (\d -> ((depsPackage (fst d) @@ -727,7 +687,8 @@ prepareLoadedDeps deps = in (depsMap, req) requiredUnits :: Deps -> [LinkableUnit] -requiredUnits d = map (depsPackage d, depsModule d,) (IS.toList $ depsRequired d) +requiredUnits d = map (depsPackage d, depsModule d,) + (IS.toList $ depsRequired d) -- read dependencies from an object that might have already been into memory -- pulls in all Deps from an archive diff --git a/src/Gen2/Object.hs b/src/Gen2/Object.hs index c89dbaba..c175d60c 100644 --- a/src/Gen2/Object.hs +++ b/src/Gen2/Object.hs @@ -7,7 +7,8 @@ ScopedTypeVariables, DeriveGeneric, Rank2Types, - GeneralizedNewtypeDeriving#-} + GeneralizedNewtypeDeriving + #-} {- | Serialization/deserialization for the binary .js_o files @@ -23,6 +24,7 @@ file layout: - header ["GHCJSOBJ", length of symbol table, length of dependencies, length of index] + - compiler version tag - symbol table - dependency info - closureinfo index @@ -169,7 +171,7 @@ instance NFData Fun where rnf x = x `seq` () data Package = Package { packageName :: !Text , packageVersion :: !Text } --} +-} newtype Package = Package { unPackage :: Text } deriving (Eq, Ord, Show, Generic, NFData) instance DB.Binary Package @@ -794,13 +796,17 @@ instance Objectable StaticVal where n -> unexpected ("Objectable get StaticVal: invalid tag " ++ show n) instance Objectable StaticUnboxed where - put (StaticUnboxedBool b) = tag 1 >> put b - put (StaticUnboxedInt i) = tag 2 >> put i - put (StaticUnboxedDouble d) = tag 3 >> put d + put (StaticUnboxedBool b) = tag 1 >> put b + put (StaticUnboxedInt i) = tag 2 >> put i + put (StaticUnboxedDouble d) = tag 3 >> put d + put (StaticUnboxedString str) = tag 4 >> put str + put (StaticUnboxedStringOffset str) = tag 5 >> put str get = getTag >>= \case - 1 -> StaticUnboxedBool <$> get - 2 -> StaticUnboxedInt <$> get - 3 -> StaticUnboxedDouble <$> get + 1 -> StaticUnboxedBool <$> get + 2 -> StaticUnboxedInt <$> get + 3 -> StaticUnboxedDouble <$> get + 4 -> StaticUnboxedString <$> get + 5 -> StaticUnboxedStringOffset <$> get n -> unexpected ("Objectable get StaticUnboxed: invalid tag " ++ show n) instance Objectable StaticArg where @@ -834,4 +840,3 @@ instance Objectable StaticLit where instance Objectable BS.ByteString where put = lift . DB.put get = lift DB.get - diff --git a/src/Gen2/Optimizer.hs b/src/Gen2/Optimizer.hs index 81e59dc7..6ac448f9 100644 --- a/src/Gen2/Optimizer.hs +++ b/src/Gen2/Optimizer.hs @@ -5,7 +5,8 @@ QuasiQuotes, NoMonomorphismRestriction, TupleSections, - OverloadedStrings #-} + OverloadedStrings + #-} {- | Optimizer: @@ -56,6 +57,8 @@ optimize :: JStat -> JStat #ifdef DISABLE_OPTIMIZER optimize = id #else +-- optimize = id +-- fixme optimize = renameLocalVars . removeDeadVars . dataflow #endif @@ -732,7 +735,7 @@ normalizeReg cache g = rewriteOf template assoc . rewriteOf template comm . fold associates2b op1 op2 = (op1,op2) `elem` [(AddOp, SubOp)] -- , ("*", "/")] -- (a - b) + c = a + (c - b) cf = rewriteOf template comm . foldExpr cache f = Just . foldExpr cache - allowed e + allowed e | IdxE (ValE (Var st)) e' <- e, Just st == stack = allowed' e' | otherwise = allowed' e where @@ -1093,4 +1096,3 @@ showCons g (CReached imf) = "\n" ++ (L.unlines $ map (\x -> " " ++ f x) (IM.to where f (i,v) = showId g i ++ ":" ++ show v -} - diff --git a/src/Gen2/Prim.hs b/src/Gen2/Prim.hs index 0ce091fb..53b22ecd 100644 --- a/src/Gen2/Prim.hs +++ b/src/Gen2/Prim.hs @@ -194,6 +194,7 @@ genPrim _ _ DoubleSubOp [r] [x,y] = PrimInline [j| `r` = `x` - `y` |] genPrim _ _ DoubleMulOp [r] [x,y] = PrimInline [j| `r` = `x` * `y` |] genPrim _ _ DoubleDivOp [r] [x,y] = PrimInline [j| `r` = `x` / `y` |] genPrim _ _ DoubleNegOp [r] [x] = PrimInline [j| `r` = `jneg x` |] -- fixme negate +genPrim _ _ DoubleFabsOp [r] [x] = PrimInline [j| `r` = Math.abs(`x`) |] genPrim _ _ Double2IntOp [r] [x] = PrimInline [j| `r` = `x`|0; |] genPrim _ _ Double2FloatOp [r] [x] = PrimInline [j| `r` = `x` |] genPrim _ _ DoubleExpOp [r] [x] = PrimInline [j| `r` = Math.exp(`x`) |] @@ -231,6 +232,7 @@ genPrim _ _ FloatSubOp [r] [x,y] = PrimInline [j| `r` = `x` - `y` |] genPrim _ _ FloatMulOp [r] [x,y] = PrimInline [j| `r` = `x` * `y` |] genPrim _ _ FloatDivOp [r] [x,y] = PrimInline [j| `r` = `x` / `y` |] genPrim _ _ FloatNegOp [r] [x] = PrimInline [j| `r` = `jneg x` |] +genPrim _ _ FloatFabsOp [r] [x] = PrimInline [j| `r` = Math.abs(`x`) |] genPrim _ _ Float2IntOp [r] [x] = PrimInline [j| `r` = `x`|0 |] genPrim _ _ FloatExpOp [r] [x] = PrimInline [j| `r` = Math.exp(`x`) |] genPrim _ _ FloatLogOp [r] [x] = PrimInline [j| `r` = Math.log(`x`) |] @@ -261,19 +263,26 @@ genPrim _ _ CopyArrayOp [] [a,o1,ma,o2,n] = `ma`[i+`o2`] = `a`[i+`o1`]; } |] -genPrim d t CopyMutableArrayOp [] [a1,o1,a2,o2,n] = genPrim d t CopyArrayOp [] [a1,o1,a2,o2,n] +genPrim d t CopyMutableArrayOp [] [a1,o1,a2,o2,n] = + genPrim d t CopyArrayOp [] [a1,o1,a2,o2,n] genPrim _ _ CloneArrayOp [r] [a,start,n] = PrimInline [j| `r` = h$sliceArray(`a`,`start`,`n`) |] -genPrim d t CloneMutableArrayOp [r] [a,start,n] = genPrim d t CloneArrayOp [r] [a,start,n] +genPrim d t CloneMutableArrayOp [r] [a,start,n] = + genPrim d t CloneArrayOp [r] [a,start,n] genPrim _ _ FreezeArrayOp [r] [a,start,n] = PrimInline [j| `r` = h$sliceArray(`a`,`start`,`n`); |] genPrim _ _ ThawArrayOp [r] [a,start,n] = PrimInline [j| `r` = h$sliceArray(`a`,`start`,`n`); |] genPrim _ _ NewByteArrayOp_Char [r] [l] = PrimInline (newByteArray r l) genPrim _ _ NewPinnedByteArrayOp_Char [r] [l] = PrimInline (newByteArray r l) -genPrim _ _ NewAlignedPinnedByteArrayOp_Char [r] [l,_align] = PrimInline (newByteArray r l) -genPrim _ _ ByteArrayContents_Char [a,o] [b] = PrimInline [j| `a` = `b`; `o` = 0; |] -genPrim _ _ SameMutableByteArrayOp [r] [a,b] = PrimInline [j| `r` = (`a` === `b`) ? 1 : 0 |] +genPrim _ _ NewAlignedPinnedByteArrayOp_Char [r] [l,_align] = + PrimInline (newByteArray r l) +genPrim _ _ MutableByteArrayIsPinnedOp [r] [_] = PrimInline [j| `r` = 1; |] +genPrim _ _ ByteArrayIsPinnedOp [r] [_] = PrimInline [j| `r` = 1; |] +genPrim _ _ ByteArrayContents_Char [a,o] [b] = + PrimInline [j| `a` = `b`; `o` = 0; |] +genPrim _ _ SameMutableByteArrayOp [r] [a,b] = + PrimInline [j| `r` = (`a` === `b`) ? 1 : 0 |] genPrim _ _ UnsafeFreezeByteArrayOp [a] [b] = PrimInline [j| `a` = `b`; |] genPrim _ _ SizeofByteArrayOp [r] [a] = PrimInline [j| `r` = `a`.len; |] genPrim _ _ SizeofMutableByteArrayOp [r] [a] = PrimInline [j| `r` = `a`.len; |] @@ -281,50 +290,69 @@ genPrim _ _ IndexByteArrayOp_Char [r] [a,i] = PrimInline [j| `r` = `a`.u8[`i`]; genPrim _ _ IndexByteArrayOp_WideChar [r] [a,i] = PrimInline [j| `r` = `a`.i3[`i`]; |] genPrim _ _ IndexByteArrayOp_Int [r] [a,i] = PrimInline [j| `r` = `a`.i3[`i`]; |] genPrim _ _ IndexByteArrayOp_Word [r] [a,i] = PrimInline [j| `r` = `a`.i3[`i`]; |] -genPrim _ _ IndexByteArrayOp_Addr [r1,r2] [a,i] = PrimInline [j| if(`a`.arr && `a`.arr[`i`<<2]) { - `r1` = `a`.arr[`i`<<2][0]; - `r2` = `a`.arr[`i`<<2][1]; - } else { - `r1` = null; - `r2` = 0; - } - |] -genPrim _ _ IndexByteArrayOp_Float [r] [a,i] = PrimInline [j| `r` = `a`.f3[`i`]; |] -genPrim _ _ IndexByteArrayOp_Double [r] [a,i] = PrimInline [j| `r` = `a`.f6[`i`]; |] +genPrim _ _ IndexByteArrayOp_Addr [r1,r2] [a,i] = + PrimInline [j| if(`a`.arr && `a`.arr[`i`<<2]) { + `r1` = `a`.arr[`i`<<2][0]; + `r2` = `a`.arr[`i`<<2][1]; + } else { + `r1` = null; + `r2` = 0; + } + |] +genPrim _ _ IndexByteArrayOp_Float [r] [a,i] = + PrimInline [j| `r` = `a`.f3[`i`]; |] +genPrim _ _ IndexByteArrayOp_Double [r] [a,i] = + PrimInline [j| `r` = `a`.f6[`i`]; |] -- genPrim _ IndexByteArrayOp_StablePtr -genPrim _ _ IndexByteArrayOp_Int8 [r] [a,i] = PrimInline [j| `r` = `a`.dv.getInt8(`i`,true); |] -genPrim _ _ IndexByteArrayOp_Int16 [r] [a,i] = PrimInline [j| `r` = `a`.dv.getInt16(`i`<<1,true); |] -genPrim _ _ IndexByteArrayOp_Int32 [r] [a,i] = PrimInline [j| `r` = `a`.i3[`i`]; |] +genPrim _ _ IndexByteArrayOp_Int8 [r] [a,i] = + PrimInline [j| `r` = `a`.dv.getInt8(`i`,true); |] +genPrim _ _ IndexByteArrayOp_Int16 [r] [a,i] = + PrimInline [j| `r` = `a`.dv.getInt16(`i`<<1,true); |] +genPrim _ _ IndexByteArrayOp_Int32 [r] [a,i] = + PrimInline [j| `r` = `a`.i3[`i`]; |] genPrim _ _ IndexByteArrayOp_Int64 [r1,r2] [a,i] = PrimInline [j| `r1` = `a`.i3[`i`<<1]; `r2` = `a`.i3[(`i`<<1)+1]; |] -genPrim _ _ IndexByteArrayOp_Word8 [r] [a,i] = PrimInline [j| `r` = `a`.u8[`i`]; |] -genPrim _ _ IndexByteArrayOp_Word16 [r] [a,i] = PrimInline [j| `r` = `a`.dv.getUint16(`i`<<1,true); |] -genPrim _ _ IndexByteArrayOp_Word32 [r] [a,i] = PrimInline [j| `r` = `a`.i3[`i`]; |] +genPrim _ _ IndexByteArrayOp_Word8 [r] [a,i] = + PrimInline [j| `r` = `a`.u8[`i`]; |] +genPrim _ _ IndexByteArrayOp_Word16 [r] [a,i] = + PrimInline [j| `r` = `a`.dv.getUint16(`i`<<1,true); |] +genPrim _ _ IndexByteArrayOp_Word32 [r] [a,i] = + PrimInline [j| `r` = `a`.i3[`i`]; |] genPrim _ _ IndexByteArrayOp_Word64 [r1,r2] [a,i] = PrimInline [j| `r1` = `a`.i3[`i`<<1]; `r2` = `a`.i3[(`i`<<1)+1]; |] -genPrim _ _ ReadByteArrayOp_Char [r] [a,i] = PrimInline [j| `r` = `a`.u8[`i`]; |] -genPrim _ _ ReadByteArrayOp_WideChar [r] [a,i] = PrimInline [j| `r` = `a`.i3[`i`]; |] -genPrim _ _ ReadByteArrayOp_Int [r] [a,i] = PrimInline [j| `r` = `a`.i3[`i`]; |] -genPrim _ _ ReadByteArrayOp_Word [r] [a,i] = PrimInline [j| `r` = `a`.i3[`i`]; |] -genPrim _ _ ReadByteArrayOp_Addr [r1,r2] [a,i] = PrimInline [j| var x = `i`<<2; - if(`a`.arr && `a`.arr[x]) { - `r1` = `a`.arr[x][0]; - `r2` = `a`.arr[x][1]; - } else { - `r1` = null; - `r2` = 0; - } - |] -genPrim _ _ ReadByteArrayOp_Float [r] [a,i] = PrimInline [j| `r` = `a`.f3[`i`]; |] -genPrim _ _ ReadByteArrayOp_Double [r] [a,i] = PrimInline [j| `r` = `a`.f6[`i`]; |] +genPrim _ _ ReadByteArrayOp_Char [r] [a,i] = + PrimInline [j| `r` = `a`.u8[`i`]; |] +genPrim _ _ ReadByteArrayOp_WideChar [r] [a,i] = + PrimInline [j| `r` = `a`.i3[`i`]; |] +genPrim _ _ ReadByteArrayOp_Int [r] [a,i] = + PrimInline [j| `r` = `a`.i3[`i`]; |] +genPrim _ _ ReadByteArrayOp_Word [r] [a,i] = + PrimInline [j| `r` = `a`.i3[`i`]; |] +genPrim _ _ ReadByteArrayOp_Addr [r1,r2] [a,i] = + PrimInline [j| var x = `i`<<2; + if(`a`.arr && `a`.arr[x]) { + `r1` = `a`.arr[x][0]; + `r2` = `a`.arr[x][1]; + } else { + `r1` = null; + `r2` = 0; + } + |] +genPrim _ _ ReadByteArrayOp_Float [r] [a,i] = + PrimInline [j| `r` = `a`.f3[`i`]; |] +genPrim _ _ ReadByteArrayOp_Double [r] [a,i] = + PrimInline [j| `r` = `a`.f6[`i`]; |] -- genPrim _ ReadByteArrayOp_StablePtr -genPrim _ _ ReadByteArrayOp_Int8 [r] [a,i] = PrimInline [j| `r` = `a`.dv.getInt8(`i`,true); |] -genPrim _ _ ReadByteArrayOp_Int16 [r] [a,i] = PrimInline [j| `r` = `a`.dv.getInt16(`i`<<1,true); |] -genPrim _ _ ReadByteArrayOp_Int32 [r] [a,i] = PrimInline [j| `r` = `a`.i3[`i`]; |] +genPrim _ _ ReadByteArrayOp_Int8 [r] [a,i] = + PrimInline [j| `r` = `a`.dv.getInt8(`i`,true); |] +genPrim _ _ ReadByteArrayOp_Int16 [r] [a,i] = + PrimInline [j| `r` = `a`.dv.getInt16(`i`<<1,true); |] +genPrim _ _ ReadByteArrayOp_Int32 [r] [a,i] = + PrimInline [j| `r` = `a`.i3[`i`]; |] genPrim _ _ ReadByteArrayOp_Int64 [r1,r2] [a,i] = PrimInline [j| `r1` = `a`.i3[`i`<<1]; `r2` = `a`.i3[(`i`<<1)+1]; @@ -399,18 +427,12 @@ genPrim _ _ AddrSubOp [i] [_a1,o1,_a2,o2] = PrimInline [j| `i` = `o1` - `o2` |] genPrim _ _ AddrRemOp [r] [_a,o,i] = PrimInline [j| `r` = `o` % `i` |] genPrim _ _ Addr2IntOp [i] [_a,o] = PrimInline [j| `i` = `o`; |] -- only usable for comparisons within one range genPrim _ _ Int2AddrOp [a,o] [i] = PrimInline [j| `a` = []; `o` = `i`; |] -- unsupported -genPrim _ _ AddrGtOp [r] [a1,o1,a2,o2] = - PrimInline [j| `r` = h$comparePointer(`a1`,`o1`,`a2`,`o2`) > 0 ? 1 : 0; |] -genPrim _ _ AddrGeOp [r] [a1,o1,a2,o2] = - PrimInline [j| `r` = h$comparePointer(`a1`,`o1`,`a2`,`o2`) >= 0 ? 1 : 0; |] -genPrim _ _ AddrEqOp [r] [a1,o1,a2,o2] = - PrimInline [j| `r` = h$comparePointer(`a1`,`o1`,`a2`,`o2`) === 0 ? 1 : 0; |] -genPrim _ _ AddrNeOp [r] [a1,o1,a2,o2] = - PrimInline [j| `r` = h$comparePointer(`a1`,`o1`,`a2`,`o2`) !== 0 ? 1 : 0; |] -genPrim _ _ AddrLtOp [r] [a1,o1,a2,o2] = - PrimInline [j| `r` = h$comparePointer(`a1`,`o1`,`a2`,`o2`) < 0 ? 1 : 0; |] -genPrim _ _ AddrLeOp [r] [a1,o1,a2,o2] = - PrimInline [j| `r` = h$comparePointer(`a1`,`o1`,`a2`,`o2`) <= 0 ? 1 : 0; |] +genPrim _ _ AddrGtOp [r] [_a1,o1,_a2,o2] = PrimInline [j| `r` = (`o1` > `o2`) ? 1 : 0; |] +genPrim _ _ AddrGeOp [r] [_a1,o1,_a2,o2] = PrimInline [j| `r` = (`o1` >= `o2`) ? 1 : 0; |] +genPrim _ _ AddrEqOp [r] [a1,o1,a2,o2] = PrimInline [j| `r` = (`a1` === `a2` && `o1` === `o2`) ? 1 : 0; |] +genPrim _ _ AddrNeOp [r] [a1,o1,a2,o2] = PrimInline [j| `r` = (`a1` === `a2` && `o1` === `o2`) ? 1 : 0; |] +genPrim _ _ AddrLtOp [r] [_a1,o1,_a2,o2] = PrimInline [j| `r` = (`o1` < `o2`) ? 1 : 0; |] +genPrim _ _ AddrLeOp [r] [_a1,o1,_a2,o2] = PrimInline [j| `r` = (`o1` <= `o2`) ? 1 : 0; |] -- addr indexing: unboxed arrays genPrim _ _ IndexOffAddrOp_Char [c] [a,o,i] = PrimInline [j| `c` = `a`.u8[`o`+`i`]; |] diff --git a/src/Gen2/PrimIface.hs b/src/Gen2/PrimIface.hs index 72ef328d..538c4c6f 100644 --- a/src/Gen2/PrimIface.hs +++ b/src/Gen2/PrimIface.hs @@ -39,7 +39,9 @@ ghcjsPrimIface mi_fix_fn = mkIfaceFixCache fixities } where -#if __GLASGOW_HASKELL__ >= 711 +#if __GLASGOW_HASKELL__ >= 801 + fixities = (getOccName seqId, Fixity NoSourceText 0 InfixR) +#elif __GLASGOW_HASKELL__ >= 711 fixities = (getOccName seqId, Fixity "0" 0 InfixR) -- seq is infixr 0 #else fixities = (getOccName seqId, Fixity 0 InfixR) -- seq is infixr 0 @@ -58,8 +60,10 @@ ghcjsPrimExports -- include our own primop type list, this must match the host -- compiler version and be processed with WORD_SIZE_IN_BITS=32 primOpInfo :: PrimOp -> PrimOpInfo -#if __GLASGOW_HASKELL__ >= 801 +#if __GLASGOW_HASKELL__ >= 821 #error "unsupported GHC version" +#elif __GLASGOW_HASKELL__ >= 801 +#include "prim/primop-primop-info-820.hs-incl" #elif __GLASGOW_HASKELL__ >= 711 #include "prim/primop-primop-info-800.hs-incl" #elif __GLASGOW_HASKELL__ >= 709 @@ -71,8 +75,10 @@ primOpInfo :: PrimOp -> PrimOpInfo #endif primOpStrictness :: PrimOp -> Arity -> StrictSig -#if __GLASGOW_HASKELL__ >= 801 +#if __GLASGOW_HASKELL__ >= 821 #error "unsupported GHC version" +#elif __GLASGOW_HASKELL__ >= 801 +#include "prim/primop-strictness-820.hs-incl" #elif __GLASGOW_HASKELL__ >= 711 #include "prim/primop-strictness-800.hs-incl" #elif __GLASGOW_HASKELL__ >= 709 @@ -142,4 +148,3 @@ mkCompare str ty = Compare (mkVarOccFS str) ty mkGenPrimOp :: FastString -> [TyVar] -> [Type] -> Type -> PrimOpInfo mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOccFS str) tvs tys ty - diff --git a/src/Gen2/RtsTypes.hs b/src/Gen2/RtsTypes.hs index 77c06be9..5c67141c 100644 --- a/src/Gen2/RtsTypes.hs +++ b/src/Gen2/RtsTypes.hs @@ -697,15 +697,15 @@ showModule :: DynFlags -> Module -> String showModule dflags m = pkg ++ ":" ++ modName where modName = moduleNameString (moduleName m) - pkg = encodePackageKey dflags (modulePackageKey m) + pkg = encodeInstalledUnitId dflags (toInstalledUnitId $ moduleUnitId m) -encodePackageKey :: DynFlags -> PackageKey -> String -encodePackageKey dflags k +encodeInstalledUnitId :: DynFlags -> InstalledUnitId -> String +encodeInstalledUnitId dflags k | isGhcjsPrimPackage dflags k = "ghcjs-prim" | isGhcjsThPackage dflags k = "ghcjs-th" - | otherwise = packageKeyString k + | otherwise = installedUnitIdString k where - n = getPackageName dflags k + n = getInstalledPackageName dflags k {- some packages are wired into GHCJS, but not GHC @@ -713,35 +713,35 @@ encodePackageKey dflags k since the RTS uses thins from them -} -isGhcjsPrimPackage :: DynFlags -> PackageKey -> Bool +isGhcjsPrimPackage :: DynFlags -> InstalledUnitId -> Bool isGhcjsPrimPackage dflags pkgKey = pn == "ghcjs-prim" || - (null pn && pkgKey == thisPackage dflags && + (null pn && pkgKey == thisInstalledUnitId dflags && any (=="-DBOOTING_PACKAGE=ghcjs-prim") (opt_P dflags)) where - pn = getPackageName dflags pkgKey + pn = getInstalledPackageName dflags pkgKey -isGhcjsThPackage :: DynFlags -> PackageKey -> Bool +isGhcjsThPackage :: DynFlags -> InstalledUnitId -> Bool isGhcjsThPackage dflags pkgKey = pn == "ghcjs-th" || - (null pn && pkgKey == thisPackage dflags && + (null pn && pkgKey == thisInstalledUnitId dflags && any (=="-DBOOTING_PACKAGE=ghcjs-th") (opt_P dflags)) where - pn = getPackageName dflags pkgKey + pn = getInstalledPackageName dflags pkgKey -ghcjsPrimPackage :: DynFlags -> PackageKey +ghcjsPrimPackage :: DynFlags -> InstalledUnitId ghcjsPrimPackage dflags = case prims of - ((_,k):_) -> k + ((_,k):_) -> toInstalledUnitId k _ -> error "Package `ghcjs-prim' is required to link executables" where prims = filter ((=="ghcjs-prim").fst) (searchModule dflags (mkModuleName "GHCJS.Prim")) -ghcjsThPackage :: DynFlags -> PackageKey +ghcjsThPackage :: DynFlags -> InstalledUnitId ghcjsThPackage dflags = case prims of - ((_,k):_) -> k + ((_,k):_) -> toInstalledUnitId k _ -> error "Package `ghcjs-th' is required to link executables" where prims = filter ((=="ghcjs-th").fst) @@ -836,4 +836,3 @@ declIds i | otherwise = mconcat <$> mapM (\n -> decl <$> jsIdIN i n) [1..s] where s = typeSize (idType i) - diff --git a/src/Gen2/Sinker.hs b/src/Gen2/Sinker.hs index 37a45627..a9d048cd 100644 --- a/src/Gen2/Sinker.hs +++ b/src/Gen2/Sinker.hs @@ -16,6 +16,7 @@ import Control.Applicative import Control.Lens import Data.Char +import Data.Either import Data.List (partition) import Data.Maybe import Data.Traversable @@ -31,13 +32,23 @@ import Gen2.ClosureInfo - literals (small literals may also be sunk if they are used more than once) -} -sinkPgm :: Module -- ^ the module, since we treat definitions from the - -- current module differently - -> [StgBinding] -- ^ the bindings - -> (UniqFM StgExpr, [StgBinding]) -- ^ a map with sunken replacements for nodes, for where - -- the replacement does not fit in the 'StgBinding' AST - -- and the new bindings -sinkPgm m pgm = +sinkPgm :: Module + -> [StgTopBinding] + -> (UniqFM StgExpr, [StgTopBinding]) +sinkPgm m pgm = (sunk, map StgTopLifted pgm'' ++ stringLits) + where + selectLifted (StgTopLifted b) = Left b + selectLifted x = Right x + (pgm', stringLits) = partitionEithers (map selectLifted pgm) + (sunk, pgm'') = sinkPgm' m pgm' + +sinkPgm' :: Module -- ^ the module, since we treat definitions from the + -- current module differently + -> [StgBinding] -- ^ the bindings + -> (UniqFM StgExpr, [StgBinding]) -- ^ a map with sunken replacements for nodes, for where + -- the replacement does not fit in the 'StgBinding' AST + -- and the new bindings +sinkPgm' m pgm = let usedOnce = collectUsedOnce pgm sinkables = listToUFM $ concatMap alwaysSinkable pgm ++ @@ -53,10 +64,10 @@ sinkPgm m pgm = -} alwaysSinkable :: StgBinding -> [(Id, StgExpr)] alwaysSinkable (StgNonRec b rhs) - | (StgRhsClosure _ccs _bi _ _upd _srt _ e@(StgLit l)) <- rhs, + | (StgRhsClosure _ccs _bi _ _upd _srt e@(StgLit l)) <- rhs, isSmallSinkableLit l && isLocal b = [(b,e)] | (StgRhsCon _ccs dc as@[StgLitArg l]) <- rhs, - isSmallSinkableLit l && isLocal b && isUnboxableCon dc = [(b,StgConApp dc as)] + isSmallSinkableLit l && isLocal b && isUnboxableCon dc = [(b,StgConApp dc as [])] alwaysSinkable _ = [] isSmallSinkableLit :: Literal -> Bool @@ -74,8 +85,8 @@ onceSinkable _m (StgNonRec b rhs) | Just e <- getSinkable rhs, isLocal b = [(b,e)] where getSinkable (StgRhsCon _ccs dc args) - = Just (StgConApp dc args) - getSinkable (StgRhsClosure _ccs _bi _ _upd _srt _ e@(StgLit{})) + = Just (StgConApp dc args []) + getSinkable (StgRhsClosure _ccs _bi _ _upd _ e@(StgLit{})) = Just e getSinkable _ = Nothing onceSinkable _ _ = [] @@ -94,7 +105,7 @@ collectUsedOnce binds = intersectUniqSets (usedOnce foldArgs) (usedOnce foldArgs -- | fold over all id in StgArg used at the top level in an StgRhsCon foldArgsTop :: Fold StgBinding Id -foldArgsTop f e@(StgNonRec b r) +foldArgsTop f e@(StgNonRec b r) | (StgRhsCon ccs dc args) <- r = StgNonRec b . StgRhsCon ccs dc <$> (traverse . foldArgsA) f args | otherwise = pure e @@ -112,22 +123,22 @@ foldArgs f (StgRec bs) = StgRec <$> sequenceA (map (\(b,r) -> (,) b <$> foldArgsR f r) bs) foldArgsR :: Fold StgRhs Id -foldArgsR f (StgRhsClosure x0 x1 x2 x3 x4 x5 e) = - StgRhsClosure x0 x1 x2 x3 x4 x5 <$> foldArgsE f e +foldArgsR f (StgRhsClosure x0 x1 x2 x3 x4 e) = + StgRhsClosure x0 x1 x2 x3 x4 <$> foldArgsE f e foldArgsR f (StgRhsCon x y args) = StgRhsCon x y <$> (traverse . foldArgsA) f args foldArgsE :: Fold StgExpr Id foldArgsE f (StgApp x args) = StgApp <$> f x <*> (traverse . foldArgsA) f args -foldArgsE f (StgConApp c args) = StgConApp c <$> (traverse . foldArgsA) f args +foldArgsE f (StgConApp c args ts) = StgConApp c <$> (traverse . foldArgsA) f args <*> pure ts foldArgsE f (StgOpApp x args t) = StgOpApp x <$> (traverse . foldArgsA) f args <*> pure t foldArgsE f (StgLam b e) = StgLam b <$> foldArgsE f e -foldArgsE f (StgCase e l1 l2 b s a alts) = - StgCase <$> foldArgsE f e <*> pure l1 <*> pure l2 - <*> pure b <*> pure s <*> pure a - <*> sequenceA (map (\(ac,bs,us,e) -> (,,,) ac bs us <$> foldArgsE f e) alts) +foldArgsE f (StgCase e b a alts) = + StgCase <$> foldArgsE f e + <*> pure b <*> pure a + <*> sequenceA (map (\(ac,bs,e) -> (,,) ac bs <$> foldArgsE f e) alts) foldArgsE f (StgLet b e) = StgLet <$> foldArgs f b <*> foldArgsE f e -foldArgsE f (StgLetNoEscape l1 l2 b e) = StgLetNoEscape l1 l2 <$> foldArgs f b <*> foldArgsE f e +foldArgsE f (StgLetNoEscape b e) = StgLetNoEscape <$> foldArgs f b <*> foldArgsE f e #if __GLASGOW_HASKELL__ < 709 foldArgsE f (StgSCC cc b1 b2 e) = StgSCC cc b1 b2 <$> foldArgsE f e foldArgsE f (StgTick m i e) = StgTick m i <$> foldArgsE f e @@ -163,4 +174,3 @@ topSortDecls _m binds = rest ++ nr' nr' | (not . null) [()| CyclicSCC _ <- stronglyConnCompG g] = error "topSortDecls: unexpected cycle" | otherwise = map fst (topologicalSortG g) - diff --git a/src/Gen2/StgAst.hs b/src/Gen2/StgAst.hs index 5ebd12e3..c93d1d00 100644 --- a/src/Gen2/StgAst.hs +++ b/src/Gen2/StgAst.hs @@ -33,7 +33,6 @@ import TyCon import Type import Unique import UniqFM -import UniqSet import IdInfo import qualified Var @@ -60,28 +59,9 @@ instance Show Type where instance Show CostCentre where show _ = "CostCentre" instance Show CostCentreStack where show _ = "CostCentreStack" instance Show StgBinderInfo where show _ = "StgBinderInfo" -#if __GLASGOW_HASKELL__ >= 711 instance Show Module where show m = unitIdString (moduleUnitId m) ++ ":" ++ moduleNameString (moduleName m) -#elif __GLASGOW_HASKELL__ >= 709 -instance Show Module where show m = packageKeyString (modulePackageKey m) ++ ":" ++ moduleNameString (moduleName m) -#else -instance Show Module where show m = packageIdString (modulePackageId m) ++ ":" ++ moduleNameString (moduleName m) -#endif -instance Show (UniqFM Id) where show u = "[" ++ show (uniqSetToList u) ++ "]" +-- instance Show (UniqFM Id) where show u = "[" ++ show (uniqSetToList u) ++ "]" instance Show TyCon where show = show . tyConName -instance Show SRT where - show NoSRT = "SRT:NO" - show (SRTEntries e) = "SRT:" ++ show e -#if __GLASGOW_HASKELL__ < 711 - show (SRT i j _b) = "SRT:BMP" ++ show [i,j] -#endif -#if __GLASGOW_HASKELL__ >= 711 -instance Show UnitId where show = unitIdString -#elif __GLASGOW_HASKELL__ >= 709 -instance Show PackageKey where show = packageKeyString -#else -instance Show PackageId where show = packageIdString -#endif instance Show Name where show n = case nameModule_maybe n of Nothing -> show (nameOccName n) @@ -89,8 +69,10 @@ instance Show Name where instance Show OccName where show = occNameString instance Show DataCon where show d = show (dataConName d) instance Show Var where show v = "(" ++ show (Var.varName v) ++ "[" ++ - encodeUnique (getKey (getUnique v)) - ++ "] <" ++ show (idDetails v) ++ "> :: " ++ show (Var.varType v) ++ ")" + encodeUnique (getKey (getUnique v)) ++ + "]" ++ if isGlobalId v then "G" else "L" ++ + " <" ++ show (idDetails v) ++ "> :: " ++ + show (Var.varType v) ++ ")" instance Show IdDetails where show VanillaId = "VanillaId" show (RecSelId {}) = "RecSelId" @@ -101,13 +83,8 @@ instance Show IdDetails where show (FCallId {}) = "FCallId" show (TickBoxOpId {}) = "VanillaId" show (DFunId {}) = "DFunId" -#if __GLASGOW_HASKELL__ < 711 - show (PatSynId {}) = "PatSynId" - show (DefMethId {}) = "DefMethId" - show (ReflectionId {}) = "ReflectionId" -#else show CoVarId = "CoVarId" -#endif + show (JoinId {}) = "JoinId" deriving instance Show UpdateFlag deriving instance Show PrimOpVecCat @@ -123,17 +100,12 @@ deriving instance Show CCallConv deriving instance Show FunctionOrData deriving instance Show StgExpr deriving instance Show StgBinding +deriving instance Show StgTopBinding deriving instance Show StgRhs deriving instance Show StgOp -#if __GLASGOW_HASKELL__ >= 709 deriving instance Show a => Show (Tickish a) -#endif --- -#if __GLASGOW_HASKELL__ >= 711 +-- instance Show Coercion where show co = showPpr hackPprDflags co -#else -deriving instance Show Coercion -#endif deriving instance Show a => Show (Expr a) deriving instance Show a => Show (Bind a) instance Show CoAxiomRule where show _ = "CoAxiomRule" @@ -158,28 +130,22 @@ bindingRefs u (StgNonRec _ rhs) = rhsRefs u rhs bindingRefs u (StgRec bs) = l (rhsRefs u . snd) bs rhsRefs :: UniqFM StgExpr -> StgRhs -> Set Id -rhsRefs u (StgRhsClosure _ _ _ _ _ _ body) = exprRefs u body +rhsRefs u (StgRhsClosure _ _ _ _ _ body) = exprRefs u body rhsRefs u (StgRhsCon _ d args) = l s [ i | AnId i <- dataConImplicitTyThings d] <> l (argRefs u) args exprRefs :: UniqFM StgExpr -> StgExpr -> Set Id exprRefs u (StgApp f args) = s f <> l (argRefs u) args -exprRefs u (StgConApp d args) = l s [ i | AnId i <- dataConImplicitTyThings d] <> l (argRefs u) args +exprRefs u (StgConApp d args _) = l s [ i | AnId i <- dataConImplicitTyThings d] <> l (argRefs u) args exprRefs u (StgOpApp _ args _) = l (argRefs u) args exprRefs _ (StgLit {}) = mempty exprRefs _ (StgLam {}) = mempty -exprRefs u (StgCase expr _ _ _ _ _ alts) = exprRefs u expr <> alts^.folded._4.to (exprRefs u) +exprRefs u (StgCase expr _ _ alts) = exprRefs u expr <> alts^.folded._3.to (exprRefs u) exprRefs u (StgLet bnd expr) = bindingRefs u bnd <> exprRefs u expr -exprRefs u (StgLetNoEscape _ _ bnd expr) = bindingRefs u bnd <> exprRefs u expr -#if __GLASGOW_HASKELL__ < 709 -exprRefs u (StgTick _ _ expr) = exprRefs u expr -exprRefs u (StgSCC _ _ _ expr) = exprRefs u expr -#else +exprRefs u (StgLetNoEscape bnd expr) = bindingRefs u bnd <> exprRefs u expr exprRefs u (StgTick _ expr) = exprRefs u expr -#endif argRefs :: UniqFM StgExpr -> StgArg -> Set Id argRefs u (StgVarArg id) | Just e <- lookupUFM u id = exprRefs u e | otherwise = s id argRefs _ _ = mempty - diff --git a/src/Gen2/TH.hs b/src/Gen2/TH.hs old mode 100755 new mode 100644 index 9925bedf..8c66ba19 --- a/src/Gen2/TH.hs +++ b/src/Gen2/TH.hs @@ -1,5 +1,12 @@ -{-# LANGUAGE CPP, GADTs, OverloadedStrings, LambdaCase, TupleSections, - ScopedTypeVariables, ViewPatterns #-} +{-# LANGUAGE CPP, + GADTs, + OverloadedStrings, + LambdaCase, + TupleSections, + ScopedTypeVariables, + ViewPatterns, + PackageImports + #-} module Gen2.TH where @@ -16,6 +23,7 @@ import qualified Gen2.Shim as Gen2 import qualified Gen2.Object as Gen2 import qualified Gen2.Cache as Gen2 import qualified Gen2.Rts as Gen2 +import qualified Gen2.Utils as Utils import CoreToStg import CoreUtils @@ -80,9 +88,9 @@ import qualified GHC.Generics import qualified GHCJS.Prim.TH.Types as TH -import qualified Language.Haskell.TH as TH -import Language.Haskell.TH.Syntax (Quasi) -import qualified Language.Haskell.TH.Syntax as TH +import qualified "template-haskell-ghcjs" Language.Haskell.TH as TH +import "template-haskell-ghcjs" Language.Haskell.TH.Syntax (Quasi) +import qualified "template-haskell-ghcjs" Language.Haskell.TH.Syntax as TH import System.Process (runInteractiveProcess, terminateProcess, waitForProcess) @@ -102,9 +110,13 @@ import HsPat import HsTypes import HsDecls import TcSplice +import UniqDFM #include "HsVersions.h" +#if __GLASGOW_HASKELL__ >= 709 +-- GHC 7.10 has a new runMetaHook + convertE :: SrcSpan -> ByteString -> TcM (LHsExpr RdrName) convertE = convertTH (get :: Get TH.Exp) convertToHsExpr @@ -179,13 +191,13 @@ ghcjsRunMeta' js_env js_settings desc tht show_code ppr_code cvt expr = do (js_code, symb) <- compileExpr js_env js_settings hsc_env dflags src_span ds_expr gbl_env <- getGblEnv - r <- getTHRunner js_env hsc_env dflags (tcg_mod gbl_env) + r <- getThRunner js_env hsc_env dflags (tcg_mod gbl_env) base <- liftIO $ takeMVar (thrBase r) let m = tcg_mod gbl_env pkgs = L.nub $ - (imp_dep_pkgs . tcg_imports $ gbl_env) ++ + (S.toList . imp_dep_pkgs . tcg_imports $ gbl_env) ++ concatMap (map fst . dep_pkgs . mi_deps . hm_iface) - (eltsUFM $ hsc_HPT hsc_env) + (eltsUDFM $ hsc_HPT hsc_env) settings = thSettings { gsUseBase = BaseState base } lr <- liftIO $ linkTh js_env settings @@ -215,10 +227,11 @@ compileExpr :: GhcjsEnv -> GhcjsSettings -> HscEnv -> DynFlags -> SrcSpan -> CoreExpr -> TcM (ByteString, Text) compileExpr js_env js_settings hsc_env dflags src_span ds_expr = newUnique >>= \u -> liftIO $ do + -- liftIO (putStrLn $ "compileExpr:\n" ++ Utils.showIndent ds_expr) prep_expr <- corePrepExpr dflags hsc_env ds_expr n <- modifyMVar (thSplice js_env) (\n -> let n' = n+1 in pure (n',n')) - stg_pgm0 <- coreToStg dflags (mod n) [bind n u prep_expr] + let stg_pgm0 = coreToStg dflags (mod n) [bind n u prep_expr] (stg_pgm1, c) <- stg2stg dflags (mod n) stg_pgm0 return (Gen2.generate js_settings dflags (mod n) stg_pgm1 c, symb n) where @@ -229,38 +242,42 @@ compileExpr js_env js_settings hsc_env dflags src_span ds_expr src_span) (exprType ds_expr) bind n u e = NonRec (thExpr n u) e - mod n = mkModule thrunnerPackage (mkModuleName $ "ThRunner" ++ show n) + mod n = mkModule thrunnerPackage' (mkModuleName $ "ThRunner" ++ show n) + +thrunnerPackage :: InstalledUnitId +thrunnerPackage = stringToInstalledUnitId "thrunner" + +thrunnerPackage' :: UnitId +thrunnerPackage' = stringToUnitId "thrunner" -thrunnerPackage :: UnitId -thrunnerPackage = stringToUnitId "thrunner" -getTHRunner :: GhcjsEnv -> HscEnv -> DynFlags -> Module -> TcM THRunner -getTHRunner js_env hsc_env dflags m = do +getThRunner :: GhcjsEnv -> HscEnv -> DynFlags -> Module -> TcM ThRunner +getThRunner js_env hsc_env dflags m = do let m' = moduleNameString (moduleName m) (r, fin) <- liftIO $ modifyMVar (thRunners js_env) $ \runners -> - case M.lookup m' (activeRunners runners) of + case M.lookup m' runners of Just r -> return (runners, (r, return ())) Nothing -> do - (r, runners') <- startTHRunner dflags js_env hsc_env runners + r <- startThRunner dflags js_env hsc_env let fin = do th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv writeTcRef th_modfinalizers_var - [TH.qRunIO (finishTHModule dflags js_env m' r)] - return (insertActiveRunner m' r runners', (r, fin)) + [TH.qRunIO (finishTh js_env m' r)] + return (M.insert m' r runners, (r, fin)) fin >> return r linkTh :: GhcjsEnv -> GhcjsSettings -- settings (contains the base state) -> [FilePath] -- extra js files -> DynFlags -- dynamic flags - -> [UnitId] -- package dependencies + -> [InstalledUnitId] -- package dependencies -> HomePackageTable -- what to link -> Maybe ByteString -- current module or Nothing to get the initial code + rts -> IO Gen2.LinkResult linkTh env settings js_files dflags pkgs hpt code = do (th_deps_pkgs, th_deps) <- Gen2.thDeps dflags - let home_mod_infos = eltsUFM hpt + let home_mod_infos = eltsUDFM hpt pkgs' | isJust code = L.nub $ pkgs ++ th_deps_pkgs | otherwise = th_deps_pkgs is_root = const True @@ -277,14 +294,14 @@ linkTh env settings js_files dflags pkgs hpt code = do is_root th_deps dflags' = dflags { ways = WayDebug : ways dflags - , thisPackage = thrunnerPackage + , thisInstalledUnitId = thrunnerPackage -- thisPackage = thrunnerPackage } obj_files = maybe [] (\b -> ObjLoaded "