Internal compiler error

[FluxusMagna]

The code

def segm_scan [n] 't (op: t -> t -> t) (ne: t)
    (flags: [n]bool)
    (as: [n]t) : [n]t
    =  zip flags as
    |> scan (\(x_flag, x) (y_flag, y) -> (x_flag || y_flag, if y_flag then y else op x y)) (false, ne)
    |> unzip |> (.1)

def segm_iota [n] (flags:[n]bool) : [n]i64
    = segm_scan (+) (0) flags (replicate n 1) |> map (\a -> a-1)

def repl_iota [n] (sizes:[n]i64) : []i64 =
    let offsets = scan (+) (0) sizes
    in hist (+) 0 (i64.sum sizes) offsets (replicate n 1)
    |> scan (+) 0

def expand [n] 'a 'b (size: a -> i64) (get: a -> i64 -> b) (as:[n]a) : []b =
    let is = repl_iota (map size as)
    let js = segm_iota (map2 (!=) is (rotate (-1) is))
    in map2 (\i j -> get as[i] j) is js

local def givens (a:f32) (b:f32) =
    let sign x = let s = f32.sgn x in if s == 0 then 1 else s
    let abs = f32.abs
    in   if b == 0 then
        (sign a, 0, abs a)
    else if a == 0 then
        (0, -sign b, abs b)
    else if abs a > abs b then
        let t = b / a
        let u = sign a * f32.sqrt (1+t*t)
        let ui = f32.recip u
        in (ui, -ui * t, a * u)
    else
        let t = a / b
        let u = sign a * f32.sqrt (1+t*t)
        let ui = f32.recip u
        in (t * ui, -ui, b * u)

def identity_mat n = tabulate_2d n n (\i j -> f32.bool (i==j))

--row indices must be unique
local def givens_par_process [n][m][k] (indices:[k](i64,i64,i64))  (A:*[n][m]f32) (G:*[n][n]f32) =
    let new_rows (col,i,j) =
        let a = A[i,col]
        let b = A[j,col]
        let (c,s,_) = givens a b
        let (a_i, a_j) = map2 (\a b -> (c*a - s*b, s*a + c*b)) A[i] A[j] |> unzip
        let (g_i, g_j) = map2 (\a b -> (c*a - s*b, s*a + c*b)) G[i] G[j] |> unzip
        in ((i,j),(a_i,a_j),(g_i,g_j))
    let (ijs, a_ijs, g_ijs) = map new_rows indices |> unzip3
    let (is, js) = unzip ijs
    let (a_is, a_js) = unzip a_ijs
    let (g_is, g_js) = unzip g_ijs
    let A = scatter A (is++js) (a_is++a_js)
    let G = scatter G (is++js) (g_is++g_js)
    in (A, G)


local def all_work_indices (n:i64) (m:i64) =
    let block i prog prog' =
        (i, prog, i64.max 0 (i64.min (n-i) (if i == 0 then n else prog')))
    let size (_, a, b) = b-a >> 1
    let get (c, a, b) k =
        let j = n-1-a-k
        let i = j - size (c, a, b)
        in (c,i,j)
    let (iter, _) = loop (iter, progress) = (0, replicate m 0)
        while not (all id (tabulate m (\i -> progress[i] >= n-i-1))) do
                let blockrow = map3 block
                        (iota m) (progress) (rotate (-1) progress)
                let sizes = map size blockrow
                in (iter + 1, map2 (+) progress sizes)
    let (blocks, iter_sizes, _) =
        loop (blocks, iter_sizes, progress) = (replicate iter (replicate m (0,0,0)), replicate iter 0, replicate m 0)
            for j < iter do
                let blockrow = map3 block
                    (iota m) (progress) (rotate (-1) progress)
                let sizes = map size blockrow
                in (blocks with [j] = blockrow, iter_sizes with [j] = i64.sum sizes, map2 (+) progress sizes)
    let indices = expand size get (flatten blocks)
    in (indices, iter ,iter_sizes)

entry QR_decomp [n][m] (A:[n][m]f32) =
    let (work_indices, iter, iter_sizes) = all_work_indices n m
    let (R, G, _) = loop (A, G, j) = (copy A, identity_mat n, 0)
        for i < iter do
            let j' = j + iter_sizes[i]
            let (A, G) = givens_par_process (work_indices[j:j']) A G
        in (A, G, j')
    let Q = transpose G
    in (Q, R)
    

gives the error

Internal compiler error (unhandled IO exception).
Please report this at https://github.com/diku-dk/futhark/issues
BuilderT.lookupType: unknown variable progress_4891
Known variables:
n_4858 i_4896 map_5794 map_5796 map1_5797 map_5799 reduce_5800 all_5801 internal_map_5807 map_5809 map3_5810 map_5811 map_5813 map2_5814 map_5816 reduce_5824 scan_5835 hist_5836 map_5844 map2_5845 scan_5847 segm_scan_5858 map_5860 map2_5861 expand_5863 lifted_lambda_5962 lifted_lambda_5963 lifted_lambda_5965 lifted_lambda_5966 lifted_lambda_5969

CallStack (from HasCallStack):
  error, called at src/Futhark/Builder.hs:104:9 in futhark-0.26.0-HXLlDtoyvtTB3lobWyH4uu:Futhark.Builder

[athas]

Smaller case:

entry all_work_indices (n:i64) (m:i64) =
  let block i prog prog' =
    (i, prog, i64.max 0 (i64.min (n-i) (if i == 0 then n else prog')))
  let size (_, a, b) = b-a >> 1
  let (iter, _) = loop (iter, progress) = (0, replicate m 0)
                  while not (all id (tabulate m (\i -> progress[i] >= n-i-1))) do
                  let blockrow = map3 block
                                      (iota m) (progress) (rotate (-1) progress)
                  let sizes = map size blockrow
                  in (iter + 1i32, map2 (+) progress sizes)
  in iter

[athas]

Looks like a pretty straightforward bug in lambda lifting, where we forget to consider the loop variables in scope when lifting inside the while-loop condition.