where clause

[bearophile]

I have discussed this topic already once in past, but I want to talk some more about it. Lately I am using Haskell a bit, and I'm appreciating this very simple feature. In D it's not as useful as in Haskell because D allows nested functions, that are one of its main purposes, but it's a cute thing.

The "where" allows to write an expression where some parts of it are defined below it. In the where you are allowed to put one or more variables (immutable values in Haskell) and functions (values again).

So first of all some usage examples from random Haskell code (Haskell uses significant indentation, almost as Python):


median xs | even len  = (mean . take 2 . drop (mid - 1)) ordered
          | otherwise = ordered !! mid
  where len = length xs
        mid = len `div` 2
        ordered = sort xs


pts n = 
  map (map (intPoint.psPlus (100,0)). ((0,300):). scanl1 psPlus. ((r,300):). zipWith (\h a -> (h*cos a, h*sin a)) rs) hs
  where
    [r,h,sr,sh] = [50, pi/5, 0.9, 0.75]
    rs   = take n $ map (r*) $ iterate(*sr) sr
    lhs  = map (map (((-1)**).fromIntegral)) $ enumBase n 2
    rhs  = take n $ map (h*) $ iterate(*sh) 1
    hs   = map (scanl1 (+). zipWith (*)rhs) lhs


levenshtein s1 s2 = last $ foldl transform [0 .. length s1] s2
  where transform ns@(n:ns') c = scanl compute (n+1) $ zip3 s1 ns ns'
          where compute z (c', x, y) = minimum
                    [y+1, z+1, x + fromEnum (c' /= c)]



drawTree (width, height) start steps stdgen = do
    img <- image width height off
    setPix img (Pixel start) on
    gen <- newSTRef stdgen
    let -- randomElem :: [a] -> ST s a
        randomElem l = do
            stdgen <- readSTRef gen
            let (i, stdgen') = randomR (0, length l - 1) stdgen
            writeSTRef gen stdgen'
            return $ l !! i
        -- newPoint :: ST s (Int, Int)
        newPoint = do
            p <- randomElem border
            c <- getPix img $ Pixel p
            if c == off then return p else newPoint
        -- wander :: (Int, Int) -> ST s ()
        wander p = do
            next <- randomElem $ filter (inRange pointRange) $ adjacent p
            c <- getPix img $ Pixel next
            if c == on then setPix img (Pixel p) on else wander next
    replicateM_ steps $ newPoint >>= wander
    stdgen <- readSTRef gen
    return (img, stdgen)
  where pointRange = ((0, 0), (width - 1, height - 1))
        adjacent (x, y) = [(x - 1, y - 1), (x, y - 1), (x + 1, y - 1),
                           (x - 1, y),                 (x + 1, y),
                           (x - 1, y + 1), (x, y + 1), (x + 1, y + 1)]
        border = liftM2 (,) [0, width - 1] [0 .. height - 1] ++
                 liftM2 (,) [1 .. width - 2] [0, height - 1]
        off = black
        on = white



brkdwn = takeWhile (not.null) . unfoldr (Just . second (drop 1) . span ('$'/=))
 
format j ls = map (unwords. zipWith align colw) rows  
  where
    rows = map brkdwn $ lines ls
    colw = map (maximum. map length) . transpose $ rows
    align cw w =
      case j of
        'c' -> (replicate l ' ') ++ w ++ (replicate r ' ')
        'r' -> (replicate dl ' ') ++ w
        'l' -> w ++ (replicate dl ' ')
        where
           dl = cw-length w
           (l,r) = (dl `div` 2, dl-l)


maze :: Int -> Int -> StdGen -> ST s Maze
maze width height gen = do
    visited <- mazeArray False
    rWalls <- mazeArray True
    bWalls <- mazeArray True
    gen <- newSTRef gen
    liftM2 (,) (rand (0, maxX) gen) (rand (0, maxY) gen) >>=
        visit gen visited rWalls bWalls
    liftM2 Maze (freeze rWalls) (freeze bWalls)
  where visit gen visited rWalls bWalls here = do
            writeArray visited here True
            let ns = neighbors here
            i <- rand (0, length ns - 1) gen
            forM_ (ns !! i : take i ns ++ drop (i + 1) ns) $ \there -> do
                seen <- readArray visited there
                unless seen $ do
                    removeWall here there
                    visit gen visited rWalls bWalls there
          where removeWall (x1, y1) (x2, y2) = writeArray 
                    (if x1 == x2 then bWalls else rWalls)
                    (min x1 x2, min y1 y2)
                    False
 
        neighbors (x, y) = 
            (if x == 0    then [] else [(x - 1, y    )]) ++
            (if x == maxX then [] else [(x + 1, y    )]) ++
            (if y == 0    then [] else [(x,     y - 1)]) ++
            (if y == maxY then [] else [(x,     y + 1)])
 
        maxX = width - 1
        maxY = height - 1
 
        mazeArray = newArray ((0, 0), (maxX, maxY))
            :: Bool -> ST s (STArray s (Int, Int) Bool)
 
printMaze :: Maze -> IO ()
printMaze (Maze rWalls bWalls) = do
    putStrLn $ '+' : (concat $ replicate (maxX + 1) "---+")
    forM_ [0 .. maxY] $ \y -> do
        putStr "|"
        forM_ [0 .. maxX] $ \x -> do
            putStr "   "
            putStr $ if rWalls ! (x, y) then "|" else " "
        putStrLn ""
        forM_ [0 .. maxX] $ \x -> do
            putStr "+"
            putStr $ if bWalls ! (x, y) then "---" else "   "
        putStrLn "+"
  where maxX = fst (snd $ bounds rWalls)
        maxY = snd (snd $ bounds rWalls)



import System.Random (StdGen, getStdGen, randomR)
 
trials :: Int
trials = 10000
 
data Door = Car | Goat deriving Eq
 
play :: Bool -> StdGen -> (Door, StdGen)
play switch g = (prize, new_g)
  where (n, new_g) = randomR (0, 2) g
        d1 = [Car, Goat, Goat] !! n
        prize = case switch of
            False -> d1
            True  -> case d1 of
                Car  -> Goat
                Goat -> Car
 
cars :: Int -> Bool -> StdGen -> (Int, StdGen)
cars n switch g = f n (0, g)
  where f 0 (cs, g) = (cs, g)
        f n (cs, g) = f (n - 1) (cs + result, new_g)
          where result = case prize of Car -> 1; Goat -> 0
                (prize, new_g) = play switch g
 
main = do
    g <- getStdGen
    let (switch, g2) = cars trials True g
        (stay, _) = cars trials False g2
    putStrLn $ msg "switch" switch
    putStrLn $ msg "stay" stay
  where msg strat n = "The " ++ strat ++ " strategy succeeds " ++
            percent n ++ "% of the time."
        percent n = show $ round $
            100 * (fromIntegral n) / (fromIntegral trials)


As you see you are also allowed to nest where statements, as here:

cars n switch g = f n (0, g)
  where f 0 (cs, g) = (cs, g)
        f n (cs, g) = f (n - 1) (cs + result, new_g)
          where result = case prize of Car -> 1; Goat -> 0
                (prize, new_g) = play switch g


A possible D syntax, using a new "where" keyword:


do {
    int y = x + 5;
} where {
    auto x = foo();
}


Advantages:
- It allows a better top-down decomposition of the code, that sometimes is more natural and clear. You are able to express a complex formula at high level first, and give its details into the where clause. So it inverts the order of code, sometimes such code is simpler to understand.
- It helps to keep the namespace clean. In this example at the end only y is present in the namespace because x was created in a nested temporary namespace.


As in the do-while the brackets are optional if you have just one statement, but this is not good coding style:

do auto y = x * x + x; where auto x = foo();


Another usage example, showing a locally defined function:

do {
    auto r = map!(sqr)(items);
} where {
    int sqr(int x) pure nothrow {
        return x * x;
    }
}

In D you are able to simplify a complex function moving some of its code into smaller functions that you are allowed to put inside the original complex function (they are allowed to be pure and static too, if you want safety and more performance), this replaces some of the Haskell purposes of "where", but not all of them.

Haskell programmers don't criticize this where syntax (as they do with infix function syntax I've shown before).


If you don't want to add a new keywork, this is a alternative syntax:

do {
    int y = x + 5;
} with {
    auto x = foo();
}

Bye,
bearophile