hadrian/src/Settings/Builders/Haddock.hs

@@ -38,11 +38,13 @@ haddockBuilderArgs = mconcat
         output   <- getOutput
         pkg      <- getPackage
         root     <- getBuildRoot
+        stage    <- getStage
         context  <- getContext
         version  <- expr $ pkgVersion  pkg
         synopsis <- expr $ pkgSynopsis pkg
         haddocks <- expr $ haddockDependencies context
-        haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgIdentifier p | (p, h) <- haddocks]
+        haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgUnitId stage p | (p, h) <- haddocks]
+
         hVersion <- expr $ pkgVersion haddock
         statsDir <- expr $ haddockStatsFilesDir
         baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs)

hadrian/src/Settings/Default.hs

@@ -7,7 +7,7 @@ module Settings.Default (
 
     -- * Default command line arguments for various builders
     SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs,
-    defaultArgs,
+    defaultExtraArgs,
 
     -- * Default build flavour and BigNum backend
     defaultFlavour, defaultBignumBackend
@@ -17,7 +17,6 @@ import qualified Data.Set as Set
 
 import qualified Hadrian.Builder.Sphinx
 import qualified Hadrian.Builder.Tar
-import Hadrian.Haskell.Cabal.Type
 
 import CommandLine
 import Expression
@@ -210,7 +209,6 @@ data SourceArgs = SourceArgs
 sourceArgs :: SourceArgs -> Args
 sourceArgs SourceArgs {..} = builder Ghc ? mconcat
     [ hsDefault
-    , getContextData hcOpts
     -- `compiler` is also a library but the specific arguments that we want
     -- to apply to that are given by the hsCompiler option. `ghc` is an
     -- executable so we don't have to exclude that.
@@ -219,11 +217,8 @@ sourceArgs SourceArgs {..} = builder Ghc ? mconcat
     , package ghc      ? hsGhc ]
 
 -- | All default command line arguments.
-defaultArgs :: Args
-defaultArgs = mconcat
-    [ defaultBuilderArgs
-    , sourceArgs defaultSourceArgs
-    , defaultPackageArgs ]
+defaultExtraArgs :: Args
+defaultExtraArgs = sourceArgs defaultSourceArgs
 
 -- | Default source arguments, e.g. optimisation settings.
 defaultSourceArgs :: SourceArgs
@@ -241,7 +236,7 @@ defaultSourceArgs = SourceArgs
 defaultFlavour :: Flavour
 defaultFlavour = Flavour
     { name               = "default"
-    , args               = defaultArgs
+    , extraArgs          = defaultExtraArgs
     , packages           = defaultPackages
     , bignumBackend      = defaultBignumBackend
     , bignumCheck        = False

hadrian/src/Settings/Default.hs-boot

 module Settings.Default (
     SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs,
-    defaultArgs, defaultLibraryWays, defaultRtsWays,
+    defaultExtraArgs, defaultLibraryWays, defaultRtsWays,
     defaultFlavour, defaultBignumBackend
     ) where
 
@@ -15,7 +15,7 @@ data SourceArgs = SourceArgs
 
 sourceArgs :: SourceArgs -> Args
 
-defaultBuilderArgs, defaultPackageArgs, defaultArgs :: Args
+defaultBuilderArgs, defaultPackageArgs, defaultExtraArgs :: Args
 defaultLibraryWays, defaultRtsWays :: Ways
 defaultFlavour :: Flavour
 defaultBignumBackend :: String

hadrian/src/Settings/Flavours/Benchmark.hs

@@ -10,7 +10,7 @@ import {-# SOURCE #-} Settings.Default
 benchmarkFlavour :: Flavour
 benchmarkFlavour = defaultFlavour
     { name = "bench"
-    , args = defaultBuilderArgs <> benchmarkArgs <> defaultPackageArgs
+    , extraArgs = benchmarkArgs
     , libraryWays = pure $ Set.fromList [vanilla]
     , rtsWays = Set.fromList <$> mconcat [pure [vanilla], targetSupportsThreadedRts ? pure [threaded]] }
 

hadrian/src/Settings/Flavours/Development.hs

@@ -12,7 +12,7 @@ import {-# SOURCE #-} Settings.Default
 developmentFlavour :: Stage -> Flavour
 developmentFlavour ghcStage = defaultFlavour
     { name = "devel" ++ stageString ghcStage
-    , args = defaultBuilderArgs <> developmentArgs ghcStage <> defaultPackageArgs
+    , extraArgs = developmentArgs ghcStage
     , libraryWays = pure $ Set.fromList [vanilla]
     , rtsWays = Set.fromList <$> mconcat [pure [vanilla, debug], targetSupportsThreadedRts ? pure [threaded, threadedDebug]]
     , dynamicGhcPrograms = return False

hadrian/src/Settings/Flavours/GhcInGhci.hs

@@ -11,7 +11,7 @@ import {-# SOURCE #-} Settings.Default
 ghcInGhciFlavour :: Flavour
 ghcInGhciFlavour = defaultFlavour
     { name        = "ghc-in-ghci"
-    , args        = defaultBuilderArgs <> ghciArgs <> defaultPackageArgs
+    , extraArgs        = ghciArgs
     -- We can't build DLLs on Windows (yet). Actually we should only
     -- include the dynamic way when we have a dynamic host GHC, but just
     -- checking for Windows seems simpler for now.

hadrian/src/Settings/Flavours/Performance.hs

@@ -8,7 +8,7 @@ import {-# SOURCE #-} Settings.Default
 performanceFlavour :: Flavour
 performanceFlavour = splitSections $ defaultFlavour
     { name = "perf"
-    , args = defaultBuilderArgs <> performanceArgs <> defaultPackageArgs }
+    , extraArgs = performanceArgs }
 
 performanceArgs :: Args
 performanceArgs = sourceArgs SourceArgs

hadrian/src/Settings/Flavours/Quick.hs

@@ -15,7 +15,7 @@ import {-# SOURCE #-} Settings.Default
 quickFlavour :: Flavour
 quickFlavour = defaultFlavour
     { name        = "quick"
-    , args        = defaultBuilderArgs <> quickArgs <> defaultPackageArgs
+    , extraArgs        = quickArgs
     , libraryWays = Set.fromList <$>
                     mconcat
                     [ pure [vanilla]

hadrian/src/Settings/Flavours/QuickCross.hs

@@ -11,7 +11,7 @@ import {-# SOURCE #-} Settings.Default
 quickCrossFlavour :: Flavour
 quickCrossFlavour = defaultFlavour
     { name        = "quick-cross"
-    , args        = defaultBuilderArgs <> quickCrossArgs <> defaultPackageArgs
+    , extraArgs        = quickCrossArgs
     , dynamicGhcPrograms = pure False
     , libraryWays = Set.fromList <$>
                     mconcat

hadrian/src/Settings/Flavours/Quickest.hs

@@ -11,7 +11,7 @@ import {-# SOURCE #-} Settings.Default
 quickestFlavour :: Flavour
 quickestFlavour = defaultFlavour
     { name        = "quickest"
-    , args        = defaultBuilderArgs <> quickestArgs <> defaultPackageArgs
+    , extraArgs        = quickestArgs
     , libraryWays = pure (Set.fromList [vanilla])
     , rtsWays     = pure (Set.fromList [vanilla]) <> (targetSupportsThreadedRts ? pure (Set.fromList [threaded]))
     , dynamicGhcPrograms = return False }

hadrian/src/Settings/Flavours/Validate.hs

@@ -12,7 +12,7 @@ import {-# SOURCE #-} Settings.Default
 validateFlavour :: Flavour
 validateFlavour = enableLinting $ werror $ defaultFlavour
     { name = "validate"
-    , args = defaultBuilderArgs <> validateArgs <> defaultPackageArgs
+    , extraArgs = validateArgs
     , libraryWays = Set.fromList <$>
                     mconcat [ pure [vanilla]
                             , notStage0 ? platformSupportsSharedLibs ? pure [dynamic]
@@ -60,4 +60,4 @@ quickValidateArgs = sourceArgs SourceArgs
 quickValidateFlavour :: Flavour
 quickValidateFlavour = werror $ validateFlavour
     { name               = "quick-validate"
-    , args               = defaultBuilderArgs <> quickValidateArgs <> defaultPackageArgs }
+    , extraArgs               = quickValidateArgs }

hadrian/src/Settings/Packages.hs

@@ -74,6 +74,11 @@ packageArgs = do
             [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter"
             , notM cross `cabalFlag` "terminfo"
             , arg "-build-tool-depends"
+            -- ROMES: While the boot compiler is not updated wrt -this-unit-id
+            -- not being fixed to `ghc`, when building stage0, we must set
+            -- -this-unit-id to `ghc` because the boot compiler expects that.
+            -- We do it through a cabal flag in ghc.cabal
+            , stage0 ? arg "+hadrian-stage0"
             ]
 
           , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ]

libraries/base/jsbits/base.js

@@ -878,8 +878,7 @@ function h$__hscore_readdir(d,o,dst_a,dst_o) {
   }
   const e = d.readSync();
 
-  if (!dst_a.arr) dst_a.arr = [];
-  dst_a.arr[dst_o*2] = [e,0];
+  PUT_ADDR(dst_a,dst_o*2,e,0);
   return 0;
 }
 

rts/js/environment.js

@@ -158,20 +158,19 @@ function h$getProgArgv(argc_v,argc_off,argv_v,argv_off) {
   } else {
     argc_v.dv.setInt32(argc_off, c, true);
     var argv = h$newByteArray(4*c);
-    argv.arr = [];
     for(var i=0;i<h$programArgs().length;i++) {
-      argv.arr[4*i] = [ h$encodeUtf8(h$programArgs()[i]), 0 ];
+      PUT_ADDR(argv,4*i,h$encodeUtf8(h$programArgs()[i]),0);
     }
-    if(!argv_v.arr) { argv_v.arr = []; }
-    argv_v.arr[argv_off] = [argv, 0];
+    PUT_ADDR(argv_v,argv_off,argv,0);
   }
 }
 
 function h$setProgArgv(n, ptr_d, ptr_o) {
   args = [];
   for(var i=0;i<n;i++) {
-    var p = ptr_d.arr[ptr_o+4*i];
-    var arg = h$decodeUtf8z(p[0], p[1]);
+    var off = ptr_o+4*i;
+    GET_ADDR(ptr_d,off,p,o);
+    var arg = h$decodeUtf8z(p, o);
     args.push(arg);
   }
   h$programArgs_ = args;
@@ -218,9 +217,10 @@ function h$__hscore_environ() {
         }
         if(env.length === 0) return null;
         var p = h$newByteArray(4*env.length+1);
-        p.arr = [];
-        for(i=0;i<env.length;i++) p.arr[4*i] = [h$encodeUtf8(env[i]), 0];
-        p.arr[4*env.length] = [null, 0];
+        for(i=0;i<env.length;i++) {
+          PUT_ADDR(p,4*i,h$encodeUtf8(env[i]),0);
+        }
+        PUT_ADDR(p,4*env.length,null,0);
         RETURN_UBX_TUP2(p, 0);
     }
 #endif
@@ -435,9 +435,8 @@ function h$localtime_r(timep_v, timep_o, result_v, result_o) {
   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];
+  PUT_ADDR(result_v,result_o+40, h$myTimeZone, 0);
+  PUT_ADDR(result_v,result_o+48, h$myTimeZone, 0);
   RETURN_UBX_TUP2(result_v, result_o);
 }
 var h$__hscore_localtime_r = h$localtime_r;

rts/js/mem.js

@@ -563,6 +563,20 @@ function h$copyMutableByteArray(a1,o1,a2,o2,n) {
       a2.u8[o2+i] = a1.u8[o1+i];
     }
   }
+
+  // also update sub-array for Addr# support
+  if (!a1.arr) return;
+  if (!a2.arr) { a2.arr = [] };
+
+  if (o1 < o2) {
+    for (var i=n-1;i>=0;i--) {
+      a2.arr[o2+i] = a1.arr[o1+i] || null;
+    }
+  } else {
+    for (var i=0;i<n;i++) {
+      a2.arr[o2+i] = a1.arr[o1+i] || null;
+    }
+  }
 }
 
 //////////////////////////////////////////////////////////
@@ -961,7 +975,7 @@ function h$strlen(a_v, a_o) {
 }
 
 function h$newArray(len, e) {
-    var r = [];
+    var r = new Array(len);
     r.__ghcjsArray = true;
     r.m = 0;
     if(e === null) e = r;
@@ -986,6 +1000,7 @@ function h$newByteArray(len) {
          , f3: new Float32Array(buf)
          , f6: new Float64Array(buf)
          , dv: new DataView(buf)
+         , arr: [] // for Addr# array part
          , m: 0
          }
 }
@@ -1455,3 +1470,13 @@ function h$pext64(src_b, src_a, mask_b, mask_a) {
  }
  RETURN_UBX_TUP2(dst_b, dst_a);
 }
+
+function h$checkOverlapByteArray(a1, o1, a2, o2, n) {
+  if (n == 0)    return true;
+  if (a1 !== a2) return true;
+  if (o1 === o2) return true;
+
+  if (o1 < o2)   return o2 - o1 >= n;
+  if (o1 > o2)   return o1 - o2 >= n;
+  return true;
+}

rts/js/profiling.js

@@ -302,10 +302,9 @@ function h$buildCCPtr(o) {
 #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];
+  PUT_ADDR(cc, h$ccLabel_offset,  h$encodeUtf8(o.label),  0);
+  PUT_ADDR(cc, h$ccModule_offset, h$encodeUtf8(o.module), 0);
+  PUT_ADDR(cc, h$ccsrcloc_offset, h$encodeUtf8(o.srcloc), 0);
   return cc;
 }
 

rts/js/staticpointer.js

@@ -16,7 +16,7 @@ function h$hs_spt_insert(key1,key2,key3,key4,ref) {
         ba.i3[1] = key1;
         ba.i3[2] = key4;
         ba.i3[3] = key3;
-	h$static_pointer_table_keys.push([ba,0]);
+	h$static_pointer_table_keys.push(ba);
         h$retain({ root: ref, _key: -1 });
     }
     var s = h$static_pointer_table;
@@ -33,8 +33,9 @@ function h$hs_spt_key_count() {
 
 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<n&&i<ks.length);i++) tgt_d.arr[tgt_o+4*i] = ks[i];
+    for(var i=0;(i<n&&i<ks.length);i++) {
+      PUT_ADDR(tgt_d, tgt_o+4*i, ks[i], 0);
+    }
     return Math.min(n,ks.length);
 }
 

rts/js/string.js

@@ -602,47 +602,6 @@ 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) {

testsuite/driver/testlib.py

@@ -969,8 +969,9 @@ def normalise_win32_io_errors(name, opts):
 
 def normalise_version_( *pkgs ):
     def normalise_version__( str ):
-        return re.sub('(' + '|'.join(map(re.escape,pkgs)) + ')-[0-9.]+(-[0-9a-f]+)?',
-                      '\\1-<VERSION>', str)
+        # (name)(-version)(-hash)(-components)
+        return re.sub('(' + '|'.join(map(re.escape,pkgs)) + ')-[0-9.]+(-[0-9a-zA-Z]+)?(-[0-9a-zA-Z]+)?',
+                      '\\1-<VERSION>-<HASH>', str)
     return normalise_version__
 
 def normalise_version( *pkgs ):

testsuite/tests/backpack/cabal/bkpcabal02/all.T

@@ -5,6 +5,6 @@ else:
 
 test('bkpcabal02',
      [extra_files(['p', 'q', 'bkpcabal02.cabal', 'Setup.hs']),
-      js_broken(22351)],
+      js_broken(22351), normalise_version('bkpcabal01')],
      run_command,
      ['$MAKE -s --no-print-directory bkpcabal02 ' + cleanup])