Execute HQ9+/Haskell: Difference between revisions

From Rosetta Code
Content added Content deleted
(Added the case to deal with the increment instruction, and removed the notice)
m (Fixed syntax highlighting.)
 
Line 3: Line 3:
We use [https://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Traversable.html#v:mapAccumR mapAccumR] to maintain the accumulator.
We use [https://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Traversable.html#v:mapAccumR mapAccumR] to maintain the accumulator.
However, the specification doesn't say what to do with said accumulator on completion.
However, the specification doesn't say what to do with said accumulator on completion.
<lang haskell>module Main where
<syntaxhighlight lang="haskell">module Main where


import Data.Char (toLower, toUpper)
import Data.Char (toLower, toUpper)
Line 37: Line 37:
pass n = case n of
pass n = case n of
0 -> "Go to the store and buy some more, "
0 -> "Go to the store and buy some more, "
_ -> "Take one down and pass it around, "</lang>
_ -> "Take one down and pass it around, "</syntaxhighlight>

Latest revision as of 10:15, 1 September 2022

Execute HQ9+/Haskell is an implementation of HQ9+. Other implementations of HQ9+.
Execute HQ9+/Haskell is part of RCHQ9+. You may find other members of RCHQ9+ at Category:RCHQ9+.

This HQ9+ interpreter is written in Haskell. We use mapAccumR to maintain the accumulator. However, the specification doesn't say what to do with said accumulator on completion.

module Main where

import Data.Char (toLower, toUpper)
import Data.List        -- for concat
import Data.Traversable -- for mapAccumR

main :: IO ()
main = do
  s <- getLine
  putStrLn (snd (hq9p s))

hq9p :: String -> (Int,String)
hq9p src = fin $ mapAccumR run 0 $ map toLower src
  where
    fin (acc,log) = (acc,concat log)
    run acc ch = case ch of
      'h' -> (acc,"Hello, world!")
      'q' -> (acc,src)
      '9' -> (acc,bottles)
      '+' -> (acc + 1,"")
      '_' -> (acc,"")

bottles :: String
bottles = [99, 98 .. 0] >>= beers
  where
    beers n = unlines [
      bob n ++ " on the wall, " ++ bob n ++ ".",
      pass n ++ bob (n - 1) ++ " on the wall.\n"]
    bob n =
      let nu = case n of { (-1) -> "99"; 0 -> "No more"; n -> show n; }
          s  = if n == 1 then "" else "s"
      in nu ++ " bottle" ++ s ++ " of beer"
    pass n = case n of
      0 -> "Go to the store and buy some more, "
      _ -> "Take one down and pass it around, "