Execute HQ9+

Execute HQ9+
You are encouraged to solve this task according to the task description, using any language you may know.

Task

Implement a   HQ9+   interpreter or compiler.

11l

Translation of: Python

F hello()
   print(‘Hello, world!’)

String src
F quine()
   print(:src)

F bottles()
   L(i) (99.<2).step(-1)
      print(‘#. bottles of beer on the wall’.format(i))
      print(‘#. bottles of beer’.format(i))
      print(‘Take one down, pass it around’)
      print(‘#. bottles of beer on the wall’.format(i - 1))
      print()

   print(‘2 bottles of beer on the wall’)
   print(‘2 bottles of beer’)
   print(‘Take one down, pass it around’)
   print(‘1 bottle of beer on the wall’)
   print()

   print(‘1 bottle of beer on the wall’)
   print(‘1 bottle of beer’)
   print(‘Take one down, pass it around’)
   print(‘No more bottles of beer on the wall’)
   print()

   print(‘No more bottles of beer on the wall’)
   print(‘No more bottles of beer on the wall’)
   print(‘Go to the store and buy some more’)
   print(‘99 bottles of beer on the wall.’)
   print()

V acc = 0
F incr()
   :acc++

:start:
src = File(:argv[1]).read()

[Char = (() -> N)] dispatch
dispatch[Char(‘h’)] = hello
dispatch[Char(‘q’)] = quine
dispatch[Char(‘9’)] = bottles
dispatch[Char(‘+’)] = incr

L(i) src.lowercase()
   I i C dispatch
      dispatch[i]()

8080 Assembly

This program runs under CP/M. The HQ9+ source code is read from the file given on the command line. After the program is finished, the final value of the accumulator can be found at address 0252H. (If you are running the code on an emulator or on a machine that has a front panel, this is easy to do. Alternatively, DDT can be used, though you will have to set up the FCB by hand.)

putch:	equ	2	; Write character
puts:	equ	9	; Write string
fopen:	equ	15	; Open file
fread:	equ	20	; Read record
setdma:	equ	26	; Set DMA address
fcb:	equ	5Ch	; FCB for first file on command line
	org	100h
	;;;	Open source file given on command line
	lxi	d,fcb
	mvi	c,fopen
	call	5	; Open file
	inr	a	; A=FF = error
	lxi	d,efile
	jz	s_out	; If error, print error message and stop
	lxi	d,src	; Start reading file at src
	;;;	Load the entire source file into memory	
block:	push	d	; Set DMA address to next free location
	mvi	c,setdma
	call	5
	lxi	d,fcb	; Read 128-byte record
	mvi	c,fread
	call	5
	pop	d	; Advance pointer by 128 bytes
	lxi	h,128
	dad	d
	xchg
	dcr	a	; A=1 = end of file
	jz	block	; If not EOF, read next block
	xchg
	mvi	m,26	; Terminate last block with EOF byte to be sure
	lxi	b,src	; BC = source pointer
ins:	ldax	b	; Get current instruction
	cpi	26	; If EOF, stop
	rz
	ori	32	; Make lowercase
	push	b	; Keep source pointer
	cpi	'h'	; H=hello
	cz	hello
	cpi	'q'	; Q=quine
	cz	quine
	cpi	'9'	; 9=bottles
	cz	botls
	cpi	'+'	; +=increment
	cz	incr
	pop	b	; Restore source pointer
	inx	b	; Next instruction
	jmp 	ins
	;;;	Increment accumulator
incr:	lxi	h,accum
	inr	m
	ret
	;;;	Print "Hello, World"
hello:	lxi	d,histr
	jmp	s_out
	;;;	Print the source
quine:	lxi	h,src	; Pointer to source
qloop:	mov	a,m	; Load byte
	cpi	26	; Reached the end?
	rz		; If so, stop
	push	h	; Otherwise, keep pointer
	mov	e,a
	mvi	c,putch	; Print character
	call	5
	pop	h	; Restore pointer
	inx	h	; Next byte
	jmp	qloop
	;;;	99 bottles of beer
botls:	mvi	e,99	; 99 bottles
bverse:	call	nbeer	; _ bottle(s) of beer
	lxi	h,otw	; on the wall
	call	bstr
	call	nbeer	; _ bottle(s) of beer
	lxi	h,nl	; \r\n
	call	bstr
	lxi	h,tod	; Take one down and pass it around
	call	bstr
	dcr	e	; Decrement counter
	push	psw	; Keep status
	call 	nbeer	; _ bottle(s) of beer
	lxi	h,otw
	call	bstr	; on the wall
	lxi	h,nl	; \r\n
	call	bstr
	pop	psw	; restore status
	jnz	bverse	; If not at 0, next verse
	ret
nbeer:	push	d	; keep counter
	call	btlstr	; _ bottle(s)
	lxi	d,ofbeer
	call	s_out	; of beer
	pop 	d
	ret
bstr:	push	d	; keep counter
	xchg		; print string in HL
	call	s_out
	pop	d	; restore counter
	ret
	;;;	Print "N bottle(s)"
btlstr:	push	d	; Keep counter
	mov	a,e	; Print number
	call 	num
	lxi	d,bottle
	call	s_out	; Print " bottle"
	pop 	d	; Restore counter
	dcr	e	; If counter is 1,
	rz		; then stop,
	mvi	e,'s'	; otherwise, print S
	mvi	c,putch
	jmp	5
	;;;	Print number (0-99) in A
num:	ana	a	; If 0, print "no more"
	lxi	d,nomore
	jz	s_out
	mvi	b,'0'-1	; Tens digit
nloop:	inr	b	; Increment tens digit
	sui	10	; Subtract 10
	jnc	nloop
	adi	'0'+10	; Ones digit
	lxi	d,snum-1
	stax	d	; Store ones digit
	mov	a,b	; Tens digit zero?
	cpi	'0'
	jz	s_out	; If so, only print ones digit
	dcx	d	; Otherwise, store tens digit
	stax	d
s_out:	mvi	c,puts	; Print result
	jmp	5
efile:	db	'File error.$'
histr:	db	'Hello, world!',13,10,'$'
	db	'..'
snum:	db	'$'
nomore:	db	'No more$'
bottle:	db	' bottle$'
ofbeer:	db	' of beer$'
otw:	db	' on the wall',13,10,'$'
tod:	db	'Take one down and pass it around'
nl:	db	13,10,'$'
accum:	db	0 	; Accumulator
src:	equ	$	; Program source

Output:

This shows the code being run in SIMH and the accumulator checked afterwards. For brevity, no 9 instruction is included in the HQ9+ source file.

A>type test.hq
HQ+hq+
qh+QH+

A>hq9+ test.hq
Hello, world!
HQ+hq+
qh+QH+
Hello, world!
HQ+hq+
qh+QH+
HQ+hq+
qh+QH+
Hello, world!
HQ+hq+
qh+QH+
Hello, world!

A>^E
Simulation stopped, PC: 0F402 (JMP F3F8h)
sim> ex 0252
252:    04

Action!

PROC Run(CHAR ARRAY code)
  BYTE i,a
  CHAR c

  PrintF("Run ""%S""%E%E",code)
  a=0
  FOR i=1 TO code(0)
  DO
    c=code(i)
    IF c='q OR c='Q THEN
      PrintE(code)
    ELSEIF c='h OR c='H THEN
      PrintE("Hello, world!")
    ELSEIF c='9 THEN
      PrintE("99 bottles here...")
    ELSEIF c='+ THEN
      a==+1
    ELSE
      PrintF("Unrecognized character '%C'%E",c)
      Break()
    FI
  OD
  PrintF("%EAccumulator=%B%E",a)
RETURN

PROC Main()
  Run("9++hQ+q9H+")
RETURN

Output:

Screenshot from Atari 8-bit computer

Run "9++hQ+q9H+"

99 bottles here...
Hello, world!
9++hQ+q9H+
9++hQ+q9H+
99 bottles here...
Hello, world!

Accumulator=4

Ada

see Execute HQ9+/Ada

Agena

Tested with Agena 2.9.5 Win32

# HQ9+ interpreter

# execute an HQ9+ program in the code string - code is not case sensitive
hq9 := proc( code :: string ) is
    local hq9Accumulator := 0; # the HQ9+ accumulator
    local hq9Operations  :=    # table of HQ9+ operations and their implemntations
          [ "q" ~ proc() is print( code ) end
          , "h" ~ proc() is print( "Hello, world!" ) end
          , "9" ~ proc() is
                      local writeBottles := proc( bottleCount :: number, message :: string ) is
                                                print( bottleCount
                                                     & " bottle"
                                                     & if bottleCount <> 1 then "s " else " " fi
                                                     & message
                                                     )
                                            end;

                      for bottles from 99 to 1 by -1 do
                          writeBottles( bottles, "of beer on the wall" );
                          writeBottles( bottles, "of beer" );
                          print( "Take one down, pass it around," );
                          if bottles > 1 then
                              writeBottles( bottles - 1, "of beer on the wall." )
                          fi;
                          print()
                      od;
                      print( "No more bottles of beer on the wall." )
                  end
          , "+" ~ proc() is inc hq9Accumulator, 1 end
          ];
    for op in lower( code ) do
        if hq9Operations[ op ] <> null then
            hq9Operations[ op ]()
        else
            print( '"' & op & '" not implemented' )
        fi
    od
end;

# prompt for HQ9+ code and execute it, repeating until an empty code string is entered
scope
    local code;
    do
        write( "HQ9+> " );
        code := io.read();
        hq9( code )
    until code = ""
epocs;

ALGOL 68

Translation of DWScript. the accumulator is global.

# the increment-only accumulator #
INT hq9accumulator := 0;

# interpret a HQ9+ code string #
PROC hq9 = ( STRING code )VOID:
    FOR i TO UPB code
    DO
        CHAR   op = code[ i ];
        IF op = "Q" OR op = "q"
        THEN
            # display the program #
            print( ( code, newline ) )
        ELIF op = "H" OR op = "h"
        THEN
            print( ( "Hello, world!", newline ) )
        ELIF op = "9"
        THEN
            # 99 bottles of beer #
            FOR bottles FROM 99 BY -1 TO 1 DO
                 STRING bottle count = whole( bottles, 0 ) + IF bottles > 1 THEN " bottles" ELSE " bottle" FI;
                 print( ( bottle count, " of beer on the wall", newline ) );
                 print( ( bottle count, " bottles of beer.",    newline ) );
                 print( ( "Take one down, pass it around,",     newline ) );
                 IF bottles > 1
                 THEN
                     print( ( whole( bottles - 1, 0 ), " bottles of beer on the wall.", newline, newline ) )
                 FI
            OD;
            print( ( "No more bottles of beer on the wall.", newline ) )
        ELIF op = "+"
        THEN
            # increment the accumulator #
            hq9accumulator +:= 1
        ELSE
            # unimplemented operation #
            print( ( """", op, """ not implemented", newline ) )
        FI
    OD;


# test the interpreter #
BEGIN
    STRING code;
    print( ( "HQ9+> " ) );
    read( ( code, newline ) );
    hq9( code )
END

ALGOL W

Based on ALGOL 68 (which is a translation of DWScript)...

begin

    procedure writeBottles( integer value bottleCount ) ;
        begin
            write( bottleCount, " bottle" );
            if bottleCount not = 1 then writeon( "s " ) else writeon( " " );
        end writeBottles ;

    procedure hq9 ( string(32) value code   % code to execute %
                  ; integer    value length % length of code  %
                  ) ;
        for i := 0 until length - 1 do begin
            string(1) op;

            % the increment-only accumulator %
            integer   hq9accumulator;

            hq9accumulator := 0;
            op             := code(i//1);

            if op = "Q" or op = "q" then write( code )
            else if op = "H" OR op = "h" then write( "Hello, World!" )
            else if op = "9" then begin
                % 99 bottles of beer %
                i_w := 1; s_w := 0;
                for bottles := 99 step -1 until 1 do begin
                    writeBottles( bottles ); writeon( "of beer on the wall" );
                    writeBottles( bottles ); writeon( "of beer" );;
                    write( "Take one down, pass it around," );
                    if bottles > 1 then begin
                        writeBottles( bottles - 1 ); writeon( "of beer on the wall." )
                    end;
                    write()
                end;
                write( "No more bottles of beer on the wall." )
                end
            else if op = "+" then hq9accumulator := hq9accumulator + 1
            else write( """", op, """ not implemented" )
        end hq9 ;


    % test the interpreter %
    begin
        string(32) code;
        integer    codeLength;
        write( "HQ9+> " );
        read( code );
        codeLength := 31;
        while codeLength >= 0 and code(codeLength//1) = " " do codeLength := codeLength - 1;
        hq9( code, codeLength + 1 )
    end
end.

Applesoft BASIC

100 INPUT "HQ9+ : "; I$
110 LET J$ = I$ + CHR$(13)
120 LET H$ = "HELLO, WORLD!"
130 LET B$ = "BOTTLES OF BEER"
140 LET W$ = " ON THE WALL"
150 LET W$ = W$ + CHR$(13)
160 FOR I = 1 TO LEN(I$)
170     LET C$ = MID$(J$, I, 1)
180     IF C$ = "H" THEN PRINT H$
190     IF C$ = "Q" THEN PRINT I$
200     LET A = A + (C$ = "+")
210     IF C$ <> "9" THEN 280
220     FOR B = 99 TO 1 STEP -1
230         PRINT B " " B$ W$ B " " B$
240         PRINT "TAKE ONE DOWN, ";
250         PRINT "PASS IT AROUND"
260         PRINT B - 1 " " B$ W$
270     NEXT B
280 NEXT I

Arturo

hq9: function [source][
    acc: 0
    loop split source 'ch [
        case [(lower ch)=]
            when? ["h"]-> print "Hello, world!"
            when? ["q"]-> print source
            when? ["9"]-> print "99 bottles here ..."
            when? ["+"]-> acc: acc+1
            else       []

    ]
    return acc
]

acc: hq9 {+qhp;+9Q}
print ["accumulator:" acc]

Output:

+qhp;+9Q
Hello, world!
99 bottles here ...
+qhp;+9Q
accumulator: 2

AutoHotkey

; http://www.autohotkey.com/forum/viewtopic.php?p=356268#356268

testCode := "hq9+HqQ+Qq"

MsgBox % RunHQ9Plus(testCode)

;---------------------------------

RunHQ9Plus(input)
{
  Loop, Parse, input
    If ( A_LoopField = "+" )
      acc++
    Else If ( A_LoopField = "H" )
      output .= "Hello, world!`n"
    Else If ( A_LoopField = "Q" )
      output .= input "`n"
    Else If ( A_LoopField = "9" )
      Loop, 99
      {
        ; following 4 lines could be only 1 long line
        output .= (99+1-A_Index) " bottles of beer on the wall`n"
        output .= (99+1-A_Index) " bottles of beer`n"
        output .= "Take one down, pass it around`n"
        output .= (99-A_Index) " bottles of beer on the wall`n`n"
      }
  Return output
}

BASIC

BASIC256

Translation of: FreeBASIC

# Intérprete de HQ9+

global codigo
codigo = ""

function HQ9plus(codigo)
	acumulador = 0
	HQ9plus1 = ""
	for cont = 1 to length(codigo)
		op =  upper(mid(codigo, cont, 1))
		begin case
			case op = "H"
				HQ9plus1 = HQ9plus1 + "Hello, world!"
			case op = "Q"
				HQ9plus1 = HQ9plus1 + codigo
			case op = "9"
				for botellas = 99 to 1 step -1
					HQ9plus1 = HQ9plus1 + string(botellas) + " bottle"
					if (botellas > 1) then HQ9plus1 = HQ9plus1 + "s"
					HQ9plus1 = HQ9plus1 + " of beer on the wall, " + string(botellas) + " bottle"
					if (botellas > 1) then HQ9plus1 = HQ9plus1 + "s"
					HQ9plus1 = HQ9plus1 + " of beer,"  + chr(13) + chr(10) + "Take one down, pass it around, " + string(botellas - 1) + " bottle"
					if (botellas > 2) then HQ9plus1 = HQ9plus1 + "s"
					HQ9plus1 = HQ9plus1 + " of beer on the wall." + chr(13) + chr(10) + chr(10)
				next botellas
				HQ9plus1 = HQ9plus1 + "No more bottles of beer on the wall, no more bottles of beer." + chr(13) + chr(10) + "Go to the store and buy some more, 99 bottles of beer on the wall."
			case op = "+"
				acumulador = (acumulador + 1)
			case op = "E"
				end
		end case
		if mid(codigo, cont, 1) <> "+" then
			HQ9plus1 = HQ9plus1 + chr(13) + chr(10)
		end if
	next cont
	HQ9plus = left(HQ9plus1, (length(HQ9plus1) - 2))
end function


cls
do
	input codigo
	print HQ9plus(codigo): print
until false
end

BBC BASIC

      PROChq9plus("hq9+HqQ+Qq")
      END
      
      DEF PROChq9plus(code$)
      LOCAL accumulator%, i%, bottles%
      FOR i% = 1 TO LEN(code$)
        CASE MID$(code$, i%, 1) OF
          WHEN "h","H": PRINT "Hello, world!"
          WHEN "q","Q": PRINT code$
          WHEN "9":
            bottles% = 99
            WHILE bottles%
              PRINT ;bottles% " bottles of beer on the wall, ";
              PRINT ;bottles% " bottles of beer,"
              bottles% -= 1
              PRINT "Take one down, pass it around, ";
              PRINT ;bottles% " bottles of beer on the wall."
            ENDWHILE
          WHEN "+": accumulator% += 1
        ENDCASE
      NEXT i%
      ENDPROC

Output:

Hello, world!
hq9+HqQ+Qq
99 bottles of beer on the wall, 99 bottles of beer,
Take one down, pass it around, 98 bottles of beer on the wall.
98 bottles of beer on the wall, 98 bottles of beer,
Take one down, pass it around, 97 bottles of beer on the wall.
...
3 bottles of beer on the wall, 3 bottles of beer,
Take one down, pass it around, 2 bottles of beer on the wall.
2 bottles of beer on the wall, 2 bottles of beer,
Take one down, pass it around, 1 bottles of beer on the wall.
1 bottles of beer on the wall, 1 bottles of beer,
Take one down, pass it around, 0 bottles of beer on the wall.
Hello, world!
hq9+HqQ+Qq
hq9+HqQ+Qq
hq9+HqQ+Qq
hq9+HqQ+Qq

BQN

Works in: CBQN

Takes a single line HQ9+ program from stdin, and displays the output.

Pl ← {(𝕩≠1)/"s"}
Lwr ← +⟜(32×1="A["⊸⍋)
nn ← {(•Fmt 𝕨)∾" "∾𝕩}´¨∾{
  ⟨
    ⟨𝕩,"bottle"∾(Pl 𝕩)∾" of beer on the wall"⟩
    ⟨𝕩,"bottle"∾(Pl 𝕩)∾" of beer"⟩
    ⟨"Take one down, pass it around"⟩
    ⟨𝕩-1,"bottle"∾(Pl 𝕩-1)∾" of beer on the wall"⟩
  ⟩
}¨⌽1+↕99

HQ9 ← {
  out ← ⟨⟨"Hello, World!"⟩, ⟨𝕩⟩, nn⟩
  acc ← +´'+'=𝕩
  ∾out⊏˜3⊸≠⊸/"hq9"⊐Lwr 𝕩   
}

•Out¨HQ9 •GetLine@

C

void runCode(const char *code)
{
    int c_len = strlen(code);
    int i, bottles;
    unsigned accumulator=0;
    for(i=0;i<c_len;i++)
    {
        switch(code[i])
        {
            case 'Q':
                printf("%s\n", code);
                break;

            case 'H':
                printf("Hello, world!\n");
                break;

            case '9':
                //Nice bottles song alg. from RC :)
                bottles = 99;
                do {
                    printf("%d bottles of beer on the wall\n", bottles);
                    printf("%d bottles of beer\n", bottles);
                    printf("Take one down, pass it around\n");
                    printf("%d bottles of beer on the wall\n\n", --bottles);
                } while( bottles > 0 );
                break;

            case '+':
                //Am I the only one finding this one weird? :o
                accumulator++;
                break;
        }
    }
};

C#

using System;
using System.Collections.Generic;
using System.Linq;

class Program
{
    static void RunCode(string code)
    {
        int accumulator = 0;
        var opcodes = new Dictionary<char, Action>
        {
            {'H', () => Console.WriteLine("Hello, World!"))},
            {'Q', () => Console.WriteLine(code) },
            {'9', () => Console.WriteLine(Enumerable.Range(1,100).Reverse().Select(n => string.Format("{0} bottles of beer on the wall\n{0} bottles of beer\nTake one down, pass it around\n{1} bottles of beer on the wall\n", n, n-1)).Aggregate((a,b) => a + "\n" + b))},
            {'+', () => accumulator++ }
        }

        foreach(var c in code)
            opcodes[c]();
    }
}

C++

Basically the same as the C example, although this has been C++'ified with strings and streams.

void runCode(string code)
{
    int c_len = code.length();
    unsigned accumulator=0;
    int bottles;
    for(int i=0;i<c_len;i++)
    {
        switch(code[i])
        {
            case 'Q':
                cout << code << endl;
                break;

            case 'H':
                cout << "Hello, world!" << endl;
                break;

            case '9':
                //Nice bottles song alg. from RC :)
                bottles = 99;
                do {
                    cout << bottles << " bottles of beer on the wall" << endl;
                    cout << bottles << " bottles of beer" << endl;
                    cout << "Take one down, pass it around" << endl;
                    cout << --bottles << " bottles of beer on the wall" << endl << endl;
                } while( bottles > 0 );
                break;

            case '+':
                //Am I the only one finding this one weird? :o
                accumulator++;
                break;
        }
    }
};

Ceylon

shared void run() {
	
	void eval(String code) {

		variable value accumulator = 0;

		for(c in code.trimmed.lowercased) {
			switch(c)
			case('h') {
				print("Hello, world!");
			}
			case('q') {
				print(code);
			}
			case('9') {
				function bottles(Integer i) =>
						switch(i)
						case(0) "No bottles"
						case(1) "One bottle"
						else "``i`` bottles";
				for(i in 99..1) {
					print("``bottles(i)`` of beer on the wall,
					       ``bottles(i)`` of beer,
					       take one down and pass it around,
					       ``bottles(i - 1)`` of beer on the wall!");
				}
			}
			case('+') {
				accumulator++;
			}
			else {
				print("syntax error");
			}
		}
	}
	
	eval("hq9+");
}

Clojure

(ns anthony.random.hq9plus
  (:require [clojure.string :as str]))

(defn bottles []
  (loop [bottle 99]
    (if (== bottle 0)
      ()
      (do
        (println (str bottle " bottles of beer on the wall"))
        (println (str bottle " bottles of beer"))
        (println "Take one down, pass it around")
        (println (str bottle " bottles of beer on the wall"))
        (recur (dec bottle))))))

(defn execute-hq9plus [& commands]
  (let [accumulator (atom 0)]
    (loop [pointer 0]
      (condp = (nth commands pointer)
        \H (println "Hello, world!")
        \Q (println (str/join commands))
        \9 (bottles)
        \+ (reset! accumulator (inc @accumulator)))
      (if-not (= (inc pointer) (count commands)) (recur (inc pointer))))))

CLU

% This program uses the "get_argv" function from PCLU's "useful.lib"

hq9plus = cluster is load, run
    rep = string
    own po: stream := stream$primary_output()
    
    bottles = proc (n: int) returns (string)
        if n=0 then return("No more bottles ")
        elseif n=1 then return("1 bottle ")
        else return(int$unparse(n) || " bottles ")
        end
    end bottles

    beer = proc ()
        for i: int in int$from_to_by(99,1,-1) do
            stream$putl(po, bottles(i) || "of beer on the wall,")
            stream$putl(po, bottles(i) || "of beer,")
            stream$puts(po, "Take ")
            if i=1 
                then stream$puts(po, "it")
                else stream$puts(po, "one")
            end
            stream$putl(po, " down and pass it around,")
            stream$putl(po, bottles(i-1) || "of beer on the wall!\n")
        end
    end beer
    
    quine = proc (c: rep) stream$puts(po, c) end quine
    hello = proc () stream$putl(po, "Hello, world!") end hello
    
    load = proc (fn: file_name) returns (cvt) signals (not_possible(string))
        prog: array[char] := array[char]$[]
        s: stream := stream$open(fn, "read") resignal not_possible
        while true do
            array[char]$addh(prog, stream$getc(s))
            except when end_of_file: break end
        end
        stream$close(s)
        return(rep$ac2s(prog))
    end load
    
    run = proc (prog: cvt) returns (int)
        acc: int := 0
        for c: char in rep$chars(prog) do
            if     c='h' | c='H' then hello()
            elseif c='q' | c='Q' then quine(prog)
            elseif c='9'         then beer()
            elseif c='+'         then acc := acc + 1
            end
        end
        return(acc)
    end run
end hq9plus

start_up = proc ()
    fn: file_name := file_name$parse(sequence[string]$bottom(get_argv()))
    hq9plus$run(hq9plus$load(fn))
end start_up

Output:

$ cat test.hq
HQ+hq+
qh+QH+
$ ./hq9+ test.hq
Hello, world!
HQ+hq+
qh+QH+
Hello, world!
HQ+hq+
qh+QH+
HQ+hq+
qh+QH+
Hello, world!
HQ+hq+
qh+QH+
Hello, world!

COBOL

       IDENTIFICATION DIVISION.
       PROGRAM-ID. Exec-Hq9.

       DATA DIVISION.
       LOCAL-STORAGE SECTION.
       78  Code-Length VALUE 256.

       01  i           PIC 999.
       01  accumulator PIC 999.

       01  bottles     PIC 999.

       LINKAGE SECTION.
       01  hq9-code    PIC X(Code-Length).
       
       PROCEDURE DIVISION USING BY VALUE hq9-code.
           PERFORM VARYING i FROM 1 BY 1 UNTIL Code-Length < i
               EVALUATE hq9-code (i:1)
                   WHEN "Q"
                       DISPLAY FUNCTION TRIM(hq9-code)

                   WHEN "H"
                       DISPLAY "Hello, World!"

                   WHEN "9"
                       MOVE 99 TO bottles
                       PERFORM UNTIL bottles = ZERO
                           DISPLAY
                               bottles " bottles of beer on the wall"
                           DISPLAY bottles " bottles of beer"
                           DISPLAY "Take one down, pass it around"
                           SUBTRACT 1 FROM bottles
                           DISPLAY
                               bottles " bottles of beer on the wall"
                           DISPLAY SPACE
                       END-PERFORM

                   WHEN "+"
                       ADD 1 TO accumulator
               END-EVALUATE
           END-PERFORM

           GOBACK
           .

Common Lisp

See Execute HQ9+/Common Lisp.

D

import std.stdio, std.string;

void main(in string[] args) {
    if (args.length != 2 ||
        args[1].length != args[1].countchars("hHqQ9+")) {
        writeln("Not valid HQ9+ code.");
        return;
    }

    ulong accumulator;
    foreach (immutable c; args[1]) {
        final switch(c) {
            case 'Q', 'q':
                writeln(args[1]);
                break;
            case 'H', 'h':
                writeln("Hello, world!");
                break;
            case '9':
                int bottles = 99;
                while (bottles > 1) {
                    writeln(bottles, " bottles of beer on the wall,");
                    writeln(bottles, " bottles of beer.");
                    writeln("Take one down, pass it around,");
                    if (--bottles > 1)
                        writeln(bottles,
                                " bottles of beer on the wall.\n");
                }
                writeln("1 bottle of beer on the wall.\n");
                break;
            case '+':
                accumulator++;
                break;
        }
    }
}

Delphi

Library: System.SysUtils

Translation of: C

uses
  System.SysUtils;

procedure runCode(code: string);
var
  c_len, i, bottles: Integer;
  accumulator: Cardinal;
begin
  c_len := Length(code);
  accumulator := 0;
  for i := 1 to c_len do
  begin
    case code[i] of
      'Q':
        writeln(code);
      'H':
        Writeln('Hello, world!');
      '9':
        begin
          bottles := 99;
          repeat
            writeln(format('%d bottles of beer on the wall', [bottles]));
            writeln(format('%d bottles of beer', [bottles]));
            Writeln('Take one down, pass it around');
            dec(bottles);
            writeln(format('%d bottles of beer on the wall' + sLineBreak, [bottles]));
          until (bottles <= 0);
        end;
      '+':
        inc(accumulator);
    end;
  end;
end;

DWScript

Translation of: D

procedure RunCode(code : String);
var
   i : Integer;
   accum, bottles : Integer;
begin
   for i:=1 to Length(code) do begin
      case code[i] of
         'Q', 'q' : PrintLn(code);
         'H', 'h' : PrintLn('Hello, world!');
         '9' : begin
            bottles:=99;
            while bottles>1 do begin
               Print(bottles); PrintLn(' bottles of beer on the wall,');
               Print(bottles); PrintLn(' bottles of beer.');
               PrintLn('Take one down, pass it around,');
               Dec(bottles);
               if bottles>1 then begin
                  Print(bottles); PrintLn(' bottles of beer on the wall.'#13#10);
               end;
            end;
            PrintLn('1 bottle of beer on the wall.');
         end;
         '+' : Inc(accum);
      else
         PrintLn('Syntax Error');
      end;
   end;
end;

Dyalect

func eval(code) {
    var accumulator = 0
    var opcodes = (
        "h": () => print("Hello, World!"),
        "q": () => print(code),
        "9": () => {
                var quantity = 99
                while quantity > 1 {
                    print("\(quantity) bottles of beer on the wall, \(quantity) bottles of beer.")
                    print("Take one down and pass it around, \(quantity - 1) bottles of beer.")
                    quantity -= 1
                }
                print("1 bottle of beer on the wall, 1 bottle of beer.")
                print("Take one down and pass it around, no more bottles of beer on the wall.\n")
                print("No more bottles of beer on the wall, no more bottles of beer.")
                print("Go to the store and buy some more, 99 bottles of beer on the wall.")
            },
        "+": () => { accumulator += 1 }
    )
 
    for c in code {
        opcodes[c.Lower()]()
    }
}

E

See Execute HQ9+/E.

EasyLang

proc run code$ . .
   for c$ in strchars code$
      if c$ = "Q"
         print code$
      elif c$ = "H"
         print "Hello, world!"
      elif c$ = "9"
         for b = 99 downto 1
            print b & " bottles of beer on the wall"
            print b & " bottles of beer"
            print "Take one down, pass it around"
            print b & " bottles of beer on the wall"
            print ""
         .
      elif c$ = "+"
         acc += 1
         print acc
      .
   .
.
run "HQ9+"

Ela

Impure approach

open unsafe.console char unsafe.cell imperative
 
eval src = eval' src
     where eval' [] = ()
           eval' (x::xs) | be 'H' = h() `seq` eval' xs
                         | be 'Q' = q() `seq` eval' xs
                         | be '9' = n() `seq` eval' xs
                         | be '+' = p() `seq` eval' xs
                         | else = fail ("Unrecognized " ++ x)
                         where r = ref 0
                               be c = char.upper x == c
                               h () = writen "Hello, world!"
                               q () = writen src
                               p () = r.+
                               n () = bottles [99,98..1]
                                  where bottles [] = ()
                                        bottles (x::xs) = rec write 
                                          (show x) " bottles of beer of the wall\r\n"
                                          (show x) " bottles of beer\r\n"
                                          "Take one down, pass it around\r\n"
                                          `seq` bottles xs

Pure version

An interpreter itself has no side effects:

open list char
 
eval src = eval' src 0
     where eval' [] a = []
           eval' (x::xs) a | be 'H' = h :: eval' xs a
                           | be 'Q' = q :: eval' xs a
                           | be '9' = force n :: eval' xs a
                           | be '+' = eval' xs (a+1)
                           | else   = fail "Invalid instruction."
                           where be c = char.upper x == c
                                 h = "Hello, world!"
                                 q  = src
                                 n = (& bottles [99,98..1])
                                     where bottles [] = ""
                                           bottles (x::xs) = 
                                             show x ++ " bottles of beer of the wall\r\n"
                                             ++ show x ++ " bottles of beer\r\n"
                                             ++ "Take one down, pass it around\r\n"
                                             ++ bottles xs

It slightly alters an original HQ9+ specification. HQ9+ is an impure language that does console output. However console output is the only interaction that a user can see when executing HQ9+ program. This interpreter doesn't output to console but instead generates a list with all outputs. An accumulator is moved to the interpter arguments and the need for a reference cell is eliminated. Once an interpreter completes a client code can output to console using monads like so:

open imperative monad io

print_and_eval src = do
  res <- return $ eval src
  return $ each print res
  where print x = do putStrLn x

print_and_eval "HQ9+" ::: IO

Erlang

% hq9+ Erlang implementation (JWL)
% http://www.erlang.org/
-module(hq9p).
-export([main/1]).

%% bottle helper routine
bottle(0) ->
  io:format("No more bottles of beer ");

bottle(1) ->
  io:format("1 bottle of beer ");

bottle(N) when N > 0 ->
  io:format("~w bottles of beer ", [N]).

%% Implementation of instructions	
beer(0) ->
  bottle(0), io:format("on the wall~n"),
  bottle(0), io:format("on the wall~nGo to the store and buy some more~n"),
  io:format("99 bottles of beer on the wall.~n");
	
beer(N) ->
  bottle(N), io:format("on the wall~n"),
  bottle(N), io:format("~nTake one down and pass it around~n"),
  bottle(N-1), io:format("on the wall~n~n"),
  beer(N-1).

hello() ->
  io:format("Hello world!~n", []).

prog(Prog) ->
  io:format("~s~n", [Prog]).

inc(Acc) ->
  Acc+1.

%% Interpreter	
execute(Instruction, Prog, Acc) ->
  case Instruction of
    $H -> hello(), Acc;
    $Q -> prog(Prog), Acc;
    $9 -> beer(99), Acc;
    $+ -> inc(Acc);
       _ -> io:format("Invalid instruction: ~c~n", [Instruction]), Acc
  end.
	
main([], _Prog, Acc) ->
  Acc;
		
main([Instruction | Rest], Prog, Acc) ->
  NewAcc = execute(Instruction, Prog, Acc),
  main(Rest, Prog, NewAcc).
	
main(Prog) ->
  Compiled = string:to_upper(Prog),
  main(Compiled, Prog, 0).

Factor

USING: combinators command-line formatting interpolate io kernel
math math.ranges multiline namespaces sequences ;
IN: rosetta-code.hq9+

STRING: verse
${3} bottle${1} of beer on the wall
${3} bottle${1} of beer
Take one down, pass it around
${2} bottle${0} of beer on the wall
;

: bottles ( -- )
    99 1 [a,b]
    [ dup 1 - 2dup [ 1 = "" "s" ? ] bi@ verse interpolate nl ]
    each ;

SYMBOL: accumulator

CONSTANT: commands
{
    { CHAR: H [ drop "Hello, world!" print ] }
    { CHAR: Q [ print ] }
    { CHAR: 9 [ drop bottles ] }
    { CHAR: + [ drop accumulator inc ] }
    [ nip "Invalid command: %c" sprintf throw ]
}

: interpret-HQ9+ ( str -- )
    dup [ commands case ] with each accumulator off ;

: main ( -- ) command-line get first interpret-HQ9+ ;

MAIN: main

Output:

Test run on the command line:

>factor -run=rosetta-code.hq9+ H+Q+9+
Hello, world!
H+Q+9+
99 bottles of beer on the wall
99 bottles of beer
Take one down, pass it around
98 bottles of beer on the wall
. . .
1 bottle of beer on the wall
1 bottle of beer
Take one down, pass it around
0 bottles of beer on the wall

Forth

variable accumulator
: H cr ." Hello, world!" ;
: Q cr 2dup type ;
: 9 99 verses ;  \ http://rosettacode.org/wiki/99_Bottles_of_Beer#Forth
: + 1 accumulator +! ;

: hq9+ ( "code" -- )
  parse-word 2dup bounds ?do
    i 1 [ get-current literal ] search-wordlist
    if execute else true abort" invalid HQ9+ instruction"
  then loop 2drop ;

Fortran

This is F77 style except for the END SUBROUTINE HQ9, since F90+ allows the END statement to name its subroutine, and more seriously, the SELECT CASE construction that avoids interminable IF ... THEN ... ELSE IF ... sequences or even, a computed GO TO. The obvious data structure is the CHARACTER type, introduced with F77.

The only difficulty lies in the phasing of the various components of the recital (note the lines ending with commas or periods), and especially, producing correct grammar for the singular case. One could simply produce the likes of *"1 bottles of beer", or perhaps "1 bottle(s) of beer" but having been hounded for decades by compilers quibbling over syntax trivia, a certain sensitivity has arisen. For this case, the requirement is to append a "s" or not to "bottle" and the task is quite vexing because Fortran does not allow within expressions syntax such as

"bottle" // IF (B.NE.1) THEN "s" FI // " of beer"

so alternative schemes must be devised. There are many possibilities. The output line could be written piecemeal using the "non-advancing" options introduced in F90 with the "s" being written or not, or, the output line could be developed piecemeal in a CHARACTER variable in a similar way then written in one go. Alternatively, a character variable SUFFIX could be employed, which contains either "s" or " " with its usage being ..."bottle"//SUFFIX(1:LSTNB(SUFFIX))//... where function LSTNB fingers the last non-blank character (if function TRIM or LEN_TRIM are unavailable), or, with F2003 there is a facility whereby SUFFIX can be declared with a varying length so as to be either "s" or "". Still another ploy would be to replace the "s" by a "null" character (character code zero) that will be passed over by the device showing the output. Or maybe not...

However, because the tail end of the recital does not conform to the structure of the earlier verses, it seemed easier to combine the singular case with the coda, especially since "No bottles" is to be produced instead of "0 bottles". It would be easy enough to devise a function CARDINAL(N) that would return "Ninety-nine", ... "One", "No" but the required code would swamp the rest of the project.

So, there is a careful factorisation of the text phrases into FORMAT and WRITE statements. Note that "free-format" output (as with WRITE (6,*)) starts in the second column, whereas formatted output starts in the first column. Inspection of the code file HQ9.exe shows that the compiler has recognised that the multiple appearances of the text literals "bottles" (three) and "bottle" (two) are the same and there is only one value of each constant in the code file. However, it has not noticed that the text "bottle" can be extracted from "bottles", which could in turn be found within a larger text literal "No bottles of beer on the wall" which also contains the subsequence " on the wall" - perhaps the code to do this would consume more space than would be saved by having a single multiple-use text constant in the code for those, or perhaps the problem is just too difficult in general to be worth the effort of devising and executing a worthwhile analysis, given that only a few bytes might be saved in a code file of 480Kb. This of course must contain the format interpretation subsystem and so forth, not just the code for the Fortran source. Even so, this program (with minor changes to the syntax) could be written in Fortran IV for an IBM1130, and would run in a computer with a total memory size of 8Kb. On such systems, much thought would go in to minimising space lost to verbose texts and good exposition as well as such reuse opportunities: gaining access to 32Kb or even 64Kb systems would be a great relief. But these days, memory space is not at a premium, and we are told that modern compilers produce excellent code.

      SUBROUTINE HQ9(CODE)	!Implement the rather odd HQ9+ instruction set.
       CHARACTER*(*) CODE	!One operation code per character.
       INTEGER I,B	!Steppers.
       INTEGER A	!An accumulator.
        A = 0		!Initialised.
        DO I = 1,LEN(CODE)	!Step through the code.
          SELECT CASE(CODE(I:I))!Inspect the operation code.
           CASE(" ")		!Might as well do nothing.
           CASE("+")		!Increment the accumulator.
            A = A + 1		!Thus. Though, nothing refers to it...
           CASE("h","H")	!Might as well allow upper or lower case.
            WRITE (6,*) "Hello, world!"	!Hi there!
           CASE("q","Q")	!Show the (rather questionable) code.
            WRITE (6,*) CODE	!Thus.
           CASE("9")		!Recite "99 bottles of beer"...
            DO B = 99,2,-1	!Grammar is to be upheld, so the singular case is special.
              WRITE (6,1) B,"bottles"," on the wall,",B,"bottles","."	!Two lots: number, text, text.
    1         FORMAT (I2,1X,A," of beer",A)	!Exhausted by the first triplet, so a new line for the second.
              WRITE (6,2)			!Now for the reduction.
    2         FORMAT ("Take one down, pass it around,")	!Announce.
              IF (B.GT.2) WRITE (6,1) B - 1,"bottles"," on the wall."	!But, not for the singular state.
            END DO		!Recite the next stanza.
            WRITE (6,1) 1,"bottle"," on the wall,",1,"bottle","."	!The singular case. No longer "bottles".
            WRITE (6,2)						!There's nothing so lonesome, morbid or drear,
            WRITE (6,*) "No bottles of beer on the wall."	!Than to stand at the bar of a pub with no beer.
            WRITE (6,*) "Go to the store, buy some more."	!Take action.
           CASE DEFAULT		!Denounce any unknown operation codes.
            WRITE (6,*) "Unrecognised code:",CODE(I:I)	!This is why a space is treated separately.
          END SELECT		!So much for that operation code.
        END DO			!On to the next.
      END SUBROUTINE HQ9	!That was odd.

      PROGRAM POKE
      CALL HQ9("hq9")
      END

To show that the juggling works,

 Hello, world!
 hq9
99 bottles of beer on the wall,
99 bottles of beer.
Take one down, pass it around,
98 bottles of beer on the wall.
98 bottles of beer on the wall,
98 bottles of beer.
Take one down, pass it around,
97 bottles of beer on the wall.
...
Take one down, pass it around,
 2 bottles of beer on the wall.
 2 bottles of beer on the wall,
 2 bottles of beer.
Take one down, pass it around,
 1 bottle of beer on the wall,
 1 bottle of beer.
Take one down, pass it around,
 No bottles of beer on the wall.
 Go to the store, buy some more.

FreeBASIC

' Intérprete de HQ9+
' FB 1.05.0 Win64
'

Dim Shared codigo As String: codigo = ""

Function HQ9plus(codigo As String) As String
    Dim As Byte botellas, cont
    Dim acumulador As Uinteger = 0
    Dim HQ9plus1 As String
    For cont = 1 To Len(codigo)
        Select Case Ucase(Mid(codigo, cont, 1))
        Case "H"
            HQ9plus1 = HQ9plus1 + "Hello, world!"
        Case "Q"
            HQ9plus1 = HQ9plus1 + codigo
        Case "9"
            For botellas = 99 To 1 Step -1
                HQ9plus1 = HQ9plus1 + Str(botellas) + " bottle"
                If (botellas > 1) Then HQ9plus1 = HQ9plus1 + "s"
                HQ9plus1 = HQ9plus1 + " of beer on the wall, " + Str(botellas) + " bottle"
                If (botellas > 1) Then HQ9plus1 = HQ9plus1 + "s"
                HQ9plus1 = HQ9plus1 + " of beer,"  + Chr(13) + Chr(10) +_
                "Take one down, pass it around, " + Str(botellas - 1) + " bottle"
                If (botellas > 2) Then HQ9plus1 = HQ9plus1 + "s"
                HQ9plus1 = HQ9plus1 + " of beer on the wall." + Chr(13) + Chr(10) + Chr(10)
            Next botellas
            HQ9plus1 = HQ9plus1 + "No more bottles of beer on the wall, no more bottles of beer." +_
            Chr(13) + Chr(10) + "Go to the store and buy some more, 99 bottles of beer on the wall."
        Case "+"
            acumulador = (acumulador + 1)
        Case "E"
            End
        Case Else
            'no es una instrucción válida
        End Select
        If Mid(codigo, cont, 1) <> "+" Then
            HQ9plus1 = HQ9plus1 + Chr(13) + Chr(10)
        End If
    Next cont
    HQ9plus = Left(HQ9plus1, (Len(HQ9plus1) - 2))
End Function


Cls
Do
    Input codigo
    Print HQ9plus(codigo): Print
Loop While Inkey <> Chr(27)
End

Go

See RCHQ9+/Go.

Golo

module hq9plus

function main = |args| {
  var accumulator = 0
  let source = readln("please enter your source code: ")
  foreach ch in source: chars() {
    case {
      when ch == 'h' or ch == 'H' {
        println("Hello, world!")
      }
      when ch == 'q' or ch == 'Q' {
        println(source)
      }
      when ch == '9' {
        ninety9Bottles()
      }
      when ch == '+' {
        accumulator = accumulator + 1
      }
      otherwise {
        println("syntax error")
      }
    }
  }
}

function bottles = |amount| -> match {
  when amount == 1 then "One bottle"
  when amount == 0 then "No bottles"
  otherwise amount + " bottles"
}

function ninety9Bottles = {
  foreach n in [99..0]: decrementBy(1) {
    println(bottles(n) + " of beer on the wall,")
    println(bottles(n) + " of beer!")
    println("Take one down, pass it around,")
    println(bottles(n - 1) + " of beer on the wall!")
  }
}

Haskell

See Execute HQ9+/Haskell.

Haxe

// live demo: http://try.haxe.org/#2E7D4
static function hq9plus(code:String):String {
	var out:String = "";
	var acc:Int = 0;
	for (position in 0 ... code.length) switch (code.charAt(position)) {
		case "H", "h": out += "Hello, World!\n";
		case "Q", "q": out += '$code\n';
		case "9":
			var quantity:Int = 99;
			while (quantity > 1) {
				out += '$quantity bottles of beer on the wall, $quantity bottles of beer.\n';
				out += 'Take one down and pass it around, ${--quantity} bottles of beer.\n';
			}
			out += "1 bottle of beer on the wall, 1 bottle of beer.\n" +
				"Take one down and pass it around, no more bottles of beer on the wall.\n\n" +
				"No more bottles of beer on the wall, no more bottles of beer.\n" +
				"Go to the store and buy some more, 99 bottles of beer on the wall.\n";
		case "+": acc++;
	}
	return out;
}

Icon and Unicon

Process HQ9+ from command line arguments and input until an error or end-of file.

procedure main(A)
repeat writes("Enter HQ9+ code: ") & HQ9(get(A)|read()|break)
end

procedure HQ9(code)
static bnw,bcr
initial {  # number matching words and line feeds for the b-th bottle 
   bnw   := table(" bottles"); bnw[1] := " bottle"; bnw[0] := "No more bottles"
   bcr   := table("\n"); bcr[0]:=""
   }
every c := map(!code) do                         # ignore case 
   case c of {                                   # interpret
   "h"  : write("Hello, World!")                 # . hello
   "q"  : write(code)                            # . quine
   "9"  : {                                      # . 99 bottles 
          every b := 99 to 1 by -1 do writes(
             bcr[b],b,bnw[b]," of beer on the wall\n",
             b,bnw[b]," of beer\nTake one down, pass it around\n",
             1~=b|"",bnw[b-1]," of beer on the wall",bcr[b-1])            
          write(", ",map(bnw[b-1])," of beer.\nGo to the store ",
                "and buy some more, 99 bottles of beer on the wall.")               
          }
   "+"  : { /acc := 0 ; acc +:=1 }                # . yes it is weird
   default: stop("Syntax error in ",code)         # . error/exit
   }
return
end

Inform 7

HQ9+ is a room.

After reading a command:
	interpret the player's command;
	reject the player's command.

To interpret (code - indexed text):
	let accumulator be 0;
	repeat with N running from 1 to the number of characters in code:
		let C be character number N in code in upper case;
		if C is "H":
			say "Hello, world!";
		otherwise if C is "Q":
			say "[code][line break]";
		otherwise if C is "9":
			repeat with iteration running from 1 to 99:
				let M be 100 - iteration;
				say "[M] bottle[s] of beer on the wall[line break]";
				say "[M] bottle[s] of beer[line break]";
				say "Take one down, pass it around[line break]";
				say "[M - 1] bottle[s] of beer on the wall[paragraph break]";
		otherwise if C is "+":
			increase accumulator by 1.

J

From 99 Bottles of Beer

bob =: ": , ' bottle' , (1 = ]) }. 's of beer'"_
bobw=: bob , ' on the wall'"_
beer=: bobw , ', ' , bob , '; take one down and pass it around, ' , bobw@<:

The rest of the interpreter:

H=: smoutput bind 'Hello, world!'
Q=: smoutput @ [
hq9=: smoutput @: (beer"0) bind (1+i.-99)
hqp=: (A=:1)1 :'0 0$A=:A+m[y'@]

hq9p=: H`H`Q`Q`hq9`hqp@.('HhQq9+' i. ])"_ 0~

Example use:

   hq9p 'hqQQq'
Hello, world!
hqQQq
hqQQq
hqQQq
hqQQq

Java

See RCHQ9+/Java.

JavaScript

The function below executes a HQ9+ program and returns the program output as a string.

function hq9plus(code) {
  var out = '';
  var acc = 0;
  
  for (var i=0; i<code.length; i++) {
    switch (code.charAt(i)) {
      case 'H': out += "hello, world\n"; break;
      case 'Q': out += code + "\n"; break;
      case '9':
        for (var j=99; j>1; j--) {
          out += j + " bottles of beer on the wall, " + j + " bottles of beer.\n";
          out += "Take one down and pass it around, " + (j-1) + " bottles of beer.\n\n";
        }
        out += "1 bottle of beer on the wall, 1 bottle of beer.\n" +
            "Take one down and pass it around, no more bottles of beer on the wall.\n\n" +
            "No more bottles of beer on the wall, no more bottles of beer.\n" +
            "Go to the store and buy some more, 99 bottles of beer on the wall.\n";
        break;
      case '+': acc++; break;
    }
  }
  return out;
}

Julia

Works with: Julia version 0.6

hello()   = println("Hello, world!")
quine()   = println(src)
bottles() = for i = 99:-1:1 print("\n$i bottles of beer on the wall\n$i bottles of beer\nTake one down, pass it around\n$(i-1) bottles of beer on the wall\n") end
acc = 0
incr()    = global acc += 1

const dispatch = Dict(
'h' => hello,
'q' => quine,
'9' => bottles,
'+' => incr)

if length(ARGS) < 1
    println("Usage: julia ./HQ9+.jl file.hq9")
    exit(1)
else
    file = ARGS[1]
end

try
    open(file) do s
        global src = readstring(s)
    end
catch
    warning("can't open $file")
    exit(1)
end

for i in lowercase(src)
    if haskey(dispatch, i) dispatch[i]() end
end

Kotlin

// version 1.1.3

fun hq9plus(code: String) {
    var acc = 0
    val sb = StringBuilder()
    for (c in code) {
        sb.append(
            when (c) {
                'h', 'H' -> "Hello, world!\n"
                'q', 'Q' -> code + "\n"
                '9'-> {
                    val sb2 = StringBuilder()
                    for (i in 99 downTo 1) {
                        val s = if (i > 1) "s" else ""
                        sb2.append("$i bottle$s of beer on the wall\n")
                        sb2.append("$i bottle$s of beer\n")
                        sb2.append("Take one down, pass it around\n")
                    }
                    sb2.append("No more bottles of beer on the wall!\n")
                    sb2.toString()
                 }
                '+'  -> { acc++; "" }  // yeah, it's weird!
                else -> throw IllegalArgumentException("Code contains illegal operation '$c'")
            }
        )
    }
    println(sb)
}

fun main(args: Array<String>) {
    val code = args[0]  // pass in code as command line argument (using hq9+)
    hq9plus(code)
}

Output:

Hello, world!
hq9+
99 bottles of beer on the wall
99 bottles of beer
Take one down, pass it around
....
2 bottles of beer on the wall
2 bottles of beer
Take one down, pass it around
1 bottle of beer on the wall
1 bottle of beer
Take one down, pass it around
No more bottles of beer on the wall!

Liberty BASIC

'Try this hq9+ program - "hq9+HqQ+Qq"
Prompt "Please input your hq9+ program."; code$
Print hq9plus$(code$)
End

Function hq9plus$(code$)
    For i = 1 to Len(code$)
        Select Case
            Case Upper$(Mid$(code$, i, 1)) = "H"
                hq9plus$ = hq9plus$ + "Hello, world!"
            Case Upper$(Mid$(code$, i, 1)) = "Q"
                hq9plus$ = hq9plus$ + code$
            Case Mid$(code$, i, 1) = "9"
                For bottles = 99 To 1 Step -1
                     hq9plus$ = hq9plus$ + str$(bottles) + " bottle"
                     If (bottles > 1) Then hq9plus$ = hq9plus$ + "s"
                     hq9plus$ = hq9plus$ + " of beer on the wall, " + str$(bottles) + " bottle"
                     If (bottles > 1) Then hq9plus$ = hq9plus$ + "s"
                     hq9plus$ = hq9plus$ + " of beer,"  + chr$(13) + chr$(10) + "Take one down, pass it around, " + str$(bottles - 1) + " bottle"
                     If (bottles > 2) Or (bottles = 1) Then hq9plus$ = hq9plus$ + "s"
                     hq9plus$ = hq9plus$ + " of beer on the wall." + chr$(13) + chr$(10)
                Next bottles
                hq9plus$ = hq9plus$ + "No more bottles of beer on the wall, no more bottles of beer." _
                                    + chr$(13) + chr$(10) + "Go to the store and buy some more, 99 bottles of beer on the wall."
            Case Mid$(code$, i, 1) = "+"
                accumulator = (accumulator + 1)
        End Select
        If Mid$(code$, i, 1) <> "+" Then
            hq9plus$ = hq9plus$ + chr$(13) + chr$(10)
        End If
    Next i
    hq9plus$ = Left$(hq9plus$, (Len(hq9plus$) - 2))
End Function

Lua

function runCode( code )
    local acc, lc = 0
    for i = 1, #code do
        lc = code:sub( i, i ):upper()
        if lc == "Q" then print( lc )
        elseif lc == "H" then print( "Hello, World!" )
        elseif lc == "+" then acc = acc + 1
        elseif lc == "9" then
            for j = 99, 1, -1 do
                if j > 1 then
                    print( string.format( "%d bottles of beer on the wall\n%d bottles of beer\nTake one down, pass it around\n%d bottles of beer on the wall\n", j, j, j - 1 ) )
                else
                    print( "1 bottle of beer on the wall\n1 bottle of beer\nTake one down and pass it around\nno more bottles of beer on the wall\n\n"..
                           "No more bottles of beer on the wall\nNo more bottles of beer\n"..
                           "Go to the store and buy some more\n99 bottles of beer on the wall.\n" )
                end
            end
        end
    end
end

Mathematica / Wolfram Language

hq9plus[program_] := 
 Module[{accumulator = 0, bottle}, 
  bottle[n_] := 
   ToString[n] <> If[n == 1, " bottle", " bottles"] <> " of beer"; 
  Do[Switch[chr, "H", Print@"hello, world", "Q", Print@program, "9", 
    Print@StringJoin[
      Table[bottle[n] <> " on the wall\n" <> bottle[n] <> 
        "\ntake one down, pass it around\n" <> bottle[n - 1] <> 
        " on the wall" <> If[n == 1, "", "\n\n"], {n, 99, 1, -1}]], 
    "+", accumulator++], {chr, Characters@program}]; accumulator]

MiniScript

code = input("Enter HQ9+ program: ")

sing = function()
    for i in range(99,2)
        print i + " bottles of beer on the wall, " + i + " bottles of beer"
        print "Take one down, pass it around, " + (i-1) + " bottle" + "s"*(i>2) + " of beer on the wall"
    end for
    print "1 bottle of beer on the wall, 1 bottle of beer"
    print "Take one down, pass it around, no bottles of beer on the wall!"
end function

accumulator = 0
for c in code
    c = c.lower
    if c == "h" then print "Hello World"
    if c == "q" then print code
    if c == "9" then sing
    if c == "+" then accumulator = accumulator + 1
end for

Output:

Enter HQ9+ program: hq9+
Hello World
hq9+
99 bottles of beer on the wall, 99 bottles of beer
Take one down, pass it around, 98 bottles of beer on the wall
98 bottles of beer on the wall, 98 bottles of beer
Take one down, pass it around, 97 bottles of beer on the wall
...
2 bottles of beer on the wall, 2 bottles of beer
Take one down, pass it around, 1 bottle of beer on the wall
1 bottle of beer on the wall, 1 bottle of beer
Take one down, pass it around, no bottles of beer on the wall!

Nanoquery

import Nanoquery.IO

// a function to handle fatal errors
def fatal_error(errtext)
	println "%" + errtext
	println "usage: " + args[1] + " [filename.cp]"
	exit(1)
end

// a function to perform '99 bottles of beer'
def bottles(n)
	for bottles in range(n, 1, -1)
		bottlestr = ""
	 
		if bottles = 1
			bottlestr = "bottle"
		else
			bottlestr = "bottles"
		end if
	 
		println (bottles + " " + bottlestr + " of beer on the wall")
		println (bottles + " " + bottlestr + " of beer")
		println "Take one down, pass it around."
	 
		if !(bottles = 2)
			println (bottles - 1 + " bottles of beer on the wall.\n")
		else
			println "1 bottle of beer on the wall.\n"
		end if
	end for
end
 
// get a filename from the command line and read the file in
fname = null
source = null
try
	fname = args[2]
	source = new(Nanoquery.IO.File, fname).readAll()
catch
	fatal_error("error while trying to read from specified file")
end

// define an int to be the accumulator
accum = 0

// interpreter the hq9+
for char in source
	if char = "h"
		println "hello world!"
	else if char = "q"
		println source
	else if char = "9"
		bottles(99)
	else if char = "+"
		accum += 1
	end
end

NetRexx

See RCHQ9+/NetRexx.

Nim

Modify contents of the program variable as you see fit.

var program = "9hHqQ+"
var i = 0

proc bottle(n: int): string =
  case n
  of 0:
    result = "No more bottles"
  of 1:
    result = "1 bottle"
  else:
    result = $n & " bottles"

proc ninetyNineBottles =
  for n in countdown(99, 1):
    echo bottle(n), " bottle of beer on the wall"
    echo bottle(n), " bottle of beer"
    echo "Take one down, pass it around"
    echo bottle(n - 1), " of beer on the wall"

for token in items(program):
  case token
  of 'h', 'H':
    echo("Hello, world!")
  of 'q', 'Q':
    echo(program)
  of '9':
    ninetyNineBottles()
  of '+':
    inc(i)
  else:
    echo("Unknown command: ", token)

NS-HUBASIC

10 INPUT "INPUT HQ9+ CODE: ",I$
20 B$="S"
30 W$=" ON THE WALL"
40 FOR I=1 TO LEN(I$)
50 C$=MID$(I$,I,1)
60 IF C$="H" THEN PRINT "HELLO, WORLD!"
70 IF C$="Q" THEN PRINT I$
80 A=A+(C$="+")
90 IF C$<>"9" GOTO 200
100 FOR B=99 TO 1 STEP -1
110 IF B=1 THEN B$=""
120 PRINT B " BOTTLE"B$" OF BEER" W$
130 PRINT B " BOTTLE"B$" OF BEER"
140 PRINT "TAKE ONE DOWN,"
150 PRINT "PASS IT AROUND"
160 IF B=2 THEN B$=""
170 IF B=1 THEN B$="S"
180 PRINT B-1 " BOTTLE"B$" OF BEER" W$
190 NEXT
200 NEXT

OCaml

Regrettably, HQ9+ suffers from remarkably poor implementations, even though the spec nailed down every aspect of the language (apart from the exact lyrics of the '9' operation, this obviously to allow for localization.) What's worse, the only implementation linked from the spec, when it was accessible, was an OCaml work that refused to implement the '+' operation among its several other deviations. The following code borrows 'beer' from its page.

let hq9p line =
  let accumulator = ref 0 in
  for i = 0 to (String.length line - 1) do
    match line.[i] with
    | 'h' | 'H' -> print_endline "Hello, world!"
    | 'q' | 'Q' -> print_endline line
    | '9' -> beer 99
    | '+' -> incr accumulator
  done

PARI/GP

Unlike many other implementations, this version will not overflow when the accumulator hits 2⁶⁴ (or as low as 2³¹ in some versions).

The lyrics are based on the reference implementation. The endline and case-insensitivity are from an example in the spec.

beer(n)={
  if(n == 1,
    print("1 bottle of beer on the wall");
    print("1 bottle of beer");
    print("Take one down and pass it around");
    print("No bottles of beer on the wall")
  ,
    print(n" bottles of beer on the wall");
    print(n" bottles of beer");
    print("Take one down and pass it around");
    print(n-1," bottles of beer on the wall\n");
    beer(n-1)
  )
};
HQ9p(s)={
  my(accum=0,v=Vec(s));
  for(i=1,#s,
    if(v[i] == "H" || v[i] == "h", print("Hello, world!"); next);
    if(v[i] == "Q" || v[i] == "q", print(s); next);
    if(v[i] == "9", beer(99); next);
    if(v[i] == "+", accum++, error("Nasal demons"))
  )
};

Sample input/output:

>HQ9p("qqqq")
qqqq
qqqq
qqqq
qqqq

Pascal

Free Pascal

Translation of: Delphi

program HQ9;

procedure runCode(code: string);
var
  c_len, i, bottles: Integer;
  accumulator: Cardinal;
begin
  c_len := Length(code);
  accumulator := 0;
  for i := 1 to c_len do
  begin
    case code[i] of
      'Q','q':
        writeln(code);
      'H','h':
        Writeln('Hello, world!');
      '9':
        begin
          bottles := 99;
          repeat
            writeln(bottles,' bottles of beer on the wall');
            writeln(bottles,' bottles of beer');
            Writeln('Take one down, pass it around');
            dec(bottles);
            writeln(bottles,' bottles of beer on the wall',#13#10);
          until (bottles <= 0);
        end;
      '+':
        inc(accumulator);
    end;
  end;
end;
BEGIN
  runCode('QqQh');
  //runCode('HQ9+');// output to long
END.

Output:

QqQh
QqQh
QqQh
Hello, world!

Perl

This implementation uses the switch feature.

#!/usr/bin/perl
use warnings;
use strict;
use feature qw(say switch);

my @programme = <> or die "No input. Specify a program file or pipe it to the standard input.\n";

for (@programme) {
    for my $char (split //) {
        given ($char) {
            when ('H') { hello()             }
            when ('Q') { quinne(@programme)  }
            when ('9') { bottles()           }
            default    { die "Unknown instruction $char.\n" } # Comment this line to ignore other instructions.
        }
    }
}

sub hello {
    print 'Hello World';
}

sub quinne {
    print @programme;
}

sub bottles {
    for my $n (reverse 0 .. 99) {
        my $before = bottle_count($n);
        my $after  = bottle_count($n - 1);
        my $action = bottle_action($n);
        say "\u$before of beer on the wall, $before of beer.";
        say "$action, $after of beer on the wall.";
        say q() if $n;
    }
}

sub bottle_count {
    my $n = shift;
    given ($n) {
        when    (-1) { return '99 bottles'      }
        when    (0)  { return 'no more bottles' }
        when    (1)  { return '1 bottle'        }
        default      { return "$n bottles"      }
    }
}

sub bottle_action {
    my $n = shift;
    return 'Take one down and pass it around' if $n > 0;
    return 'Go to the store and buy some more';
}

Phix

with javascript_semantics
-- copied from 99_Bottles_of_Beer
constant ninetynine = 2 -- (set this to 9 for testing)

function bottles(integer count)
    if count=0 then     return "no more bottles"
    elsif count=1 then  return "1 bottle" end if
    if count=-1 then count = ninetynine end if
    return sprintf("%d bottles",count)
end function

function bob(integer count)
    return bottles(count)&" of beer"
end function

function up1(string bob)
-- Capitalise sentence start (needed just the once, "no more"=>"No more")
    bob[1] = upper(bob[1])
    return bob
end function

procedure ninetyninebottles()
    string thus = bob(ninetynine),
           that = "Take one down, pass it around,\n"
    for i=ninetynine to 0 by -1 do
        puts(1,up1(thus)&" on the wall,\n")
        puts(1,thus&".\n")
        if i=0 then that = "Go to the store, buy some more,\n"
        elsif i=1 then that[6..8] = "it" end if
        thus = bob(i-1)
        puts(1,that&thus&" on the wall.\n\n")
    end for
--  if getc(0) then end if
end procedure

-- the interpreter

procedure hq9(string code)
    integer accumulator = 0
    for i=1 to length(code) do
        switch(upper(code[i]))
            case 'H': printf(1,"Hello, world!\n")
            case 'Q': printf(1,"%s\n", code);
            case '9': ninetyninebottles()
            case '+': accumulator += 1
        end switch
    end for
end procedure

hq9("h9+HqQ+Qq")

Output:

Hello, world!
2 bottles of beer on the wall,
2 bottles of beer.
Take one down, pass it around,
1 bottle of beer on the wall.

1 bottle of beer on the wall,
1 bottle of beer.
Take it down, pass it around,
no more bottles of beer on the wall.

No more bottles of beer on the wall,
no more bottles of beer.
Go to the store, buy some more,
2 bottles of beer on the wall.

Hello, world!
h9+HqQ+Qq
h9+HqQ+Qq
h9+HqQ+Qq
h9+HqQ+Qq

PHP

/* 
H 	Prints "Hello, world!"
Q 	Prints the entire text of the source code file.
9 	Prints the complete canonical lyrics to "99 Bottles of Beer on the Wall"
+ 	Increments the accumulator. 
 */
$accumulator = 0;
echo 'HQ9+: ';
$program = trim(fgets(STDIN));

foreach (str_split($program) as $chr) {
    switch ($chr) {
        case 'H':
        case 'h':
            printHelloWorld();
            break;
        case 'Q':
        case 'q':
            printSource($program);
            break;
        case '9':
            print99Bottles();
            break;
        case '+':
            $accumulator = incrementAccumulator($accumulator);
            break;
        default:
            printError($chr);
    }
}

function printHelloWorld() {
    echo 'Hello, world!'. PHP_EOL;
}

function printSource($program) {
    echo var_export($program, true) . PHP_EOL;
}

function print99Bottles() {
    $n = 99;
    while($n >= 1) {
        echo $n;
        echo ' Bottles of Beer on the Wall ';
        echo $n;
        echo ' bottles of beer, take one down pass it around ';
        echo $n-1;
        echo ' bottles of beer on the wall.'. PHP_EOL;
        $n--;
    }
}

function incrementAccumulator($accumulator) {
    return ++$accumulator;
}

function printError($chr) {
    echo "Invalid input: ". $chr;
}

Output:

HQ9+: qqqq
'qqqq'
'qqqq'
'qqqq'
'qqqq'

PicoLisp

(de hq9+ (Code)
   (let Accu 0
      (for C (chop Code)
         (case C
            ("H" (prinl "Hello, world"))
            ("Q" (prinl Code))
            ("9"
               (for (N 99 (gt0 N))
                  (prinl N " bottles of beer on the wall")
                  (prinl N " bottles of beer")
                  (prinl "Take one down, pass it around")
                  (prinl (dec 'N) " bottles of beer on the wall")
                  (prinl) ) )
            ("+" (inc 'Accu)) ) )
      Accu ) )

PowerShell

I'm not sure why, but it bothered me that the '+' function of HQ9+ was completely useless. So I added the -Global switch option. When specified it creates and/or increments a variable named '+' in the global scope.

This program treats all text except for 'H','Q','9' and '+' as whitespace and when 'Q' is called, returns the exact text. This is only my preference and could be easily modified.

As far as I can tell, there are no errors in HQ9+; but, supposing there are, a 'Default' could be added to the switch statement.

function Invoke-HQ9PlusInterpreter ([switch]$Global)
{
    $sb = New-Object -TypeName System.Text.StringBuilder

    for ($i = 99; $i -gt 2; $i--)
    { 
        $sb.Append((("{0,2} bottles of beer on the wall, " +
                     "{0,2} bottles of beer! Take one down, pass it around, " +
                     "{1,2} bottles of beer on the wall.`n") -f $i, ($i - 1))) | Out-Null
    }
    $sb.Append((" 2 bottles of beer on the wall, " +
                " 2 bottles of beer! Take one down, pass it around, " +
                " 1 bottle  of beer on the wall.`n")) | Out-Null
    $sb.Append((" 1 bottle  of beer on the wall, " +
                " 1 bottle  of beer! Take one down, pass it around...`n")) | Out-Null
    $sb.Append(("No more bottles of beer on the wall, No more bottles of beer!`n" +
                "Go to the store and get us some more, 99 bottles of beer on the wall!")) | Out-Null

    $99BottlesOfBeer = $sb.ToString()

    $helloWorld = "Hello, world!"

    if ($Global) {New-Variable -Name "+" -Value 0 -Scope Global -ErrorAction SilentlyContinue}

    Write-Host "Press Ctrl-C or Enter nothing to exit." -ForegroundColor Cyan

    while ($code -ne "")
    {
        $code = Read-Host -Prompt "HQ9+"

        ($code.ToCharArray() | Select-String -Pattern "[HQ9+]").Matches.Value | ForEach-Object {
            switch ($_)
            {
                "H" {$helloWorld;           break}
                "Q" {$code;                 break}
                "9" {$99BottlesOfBeer;      break}
                "+" {if ($Global) {${global:+}++}}
            }
        }
    }
}

Set-Alias -Name HQ9+ -Value Invoke-HQ9PlusInterpreter

Example sessions:

PS C:\Scripts> HQ9+ -Global
Press Ctrl-C or Enter nothing to exit.
HQ9+: 9headquarters++
99 bottles of beer on the wall, 99 bottles of beer! Take one down, pass it around, 98 bottles of beer on the wall.
98 bottles of beer on the wall, 98 bottles of beer! Take one down, pass it around, 97 bottles of beer on the wall.
.
.
.
 3 bottles of beer on the wall,  3 bottles of beer! Take one down, pass it around,  2 bottles of beer on the wall.
 2 bottles of beer on the wall,  2 bottles of beer! Take one down, pass it around,  1 bottle  of beer on the wall.
 1 bottle  of beer on the wall,  1 bottle  of beer! Take one down, pass it around...
No more bottles of beer on the wall, No more bottles of beer!
Go to the store and get us some more, 99 bottles of beer on the wall!
Hello, world!
9headquarters++
HQ9+: 

PS C:\Scripts> ${+}
2

PS C:\Scripts> HQ9+ -Global
Press Ctrl-C or Enter nothing to exit.
HQ9+: hq++
Hello, world!
hq++
HQ9+: 

PS C:\Scripts> ${+}
4

PureBasic

Procedure hq9plus(code.s)
  Protected accumulator, i, bottles
  For i = 1 To Len(code)
    Select Mid(code, i, 1)
      Case "h", "H"
        PrintN("Hello, world!")
      Case "q", "Q"
        PrintN(code)
      Case "9"
        bottles = 99
        While bottles
          PrintN(Str(bottles) + " bottles of beer on the wall, " + Str(bottles) + " bottles of beer,")
          bottles - 1
          PrintN("Take one down, pass it around, " + Str(bottles) + " bottles of beer on the wall.")
        Wend
      Case "+"
        accumulator + 1
    EndSelect
  Next i
EndProcedure

If OpenConsole()
  Define testCode.s = "hq9+HqQ+Qq"
  hq9plus(testCode)
  
  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf

Python

See RCHQ9+/Python.

Quackery

$ "bottles.qky" loadfile ( if required, the source code for this can be found at 
                           http://rosettacode.org/wiki/99_bottles_of_beer#Quackery )

[ stack ]                  is accumulator (   --> s ) 

[ stack ]                  is sourcecode  (   --> s ) 

[ say "Hello, world!" cr ] is H.HQ9+      (   -->   )

[ sourcecode share 
  echo$ cr ]               is Q.HQ9+      (   -->   )

[ 99 song echo$ ]          is 9.HQ9+      (   -->   )

[ 1 accumulator tally ]    is +.HQ9+      (   -->   )

[ dup sourcecode put
  0 accumulator put
  witheach
    [ $ ".HQ9+" join
      quackery ]
  sourcecode release
  cr say "Accumulator = "
  accumulator take echo ]  is HQ9+        ( $ -->   )

$ "HH+QQQQ+" HQ9+

Output:

Hello, world!
Hello, world!
HH+QQQQ+
HH+QQQQ+
HH+QQQQ+
HH+QQQQ+

Accumulator = 2

Racket

Getting HQ9+ code from standard output is not easy without a trailing newline. So I've extended the language (maybe the program could do with a flag to allow/ disallow newlines). To make up for that slackness, this implementation is strictly case-sensitive.

#lang racket
; if we `for` over the port, we won't have the program in memory for 'Q'
(define (parse-HQ9+ the-program)
  (define oTW " on the wall")
  (and ; ensures the accumulator is never seen!
   (for/fold ((A 0))
     ((token (in-string the-program)))
     (case token
       ((#\H) (display "hello, world") A)
       ((#\Q) (display the-program) A)
       ;; official esolang version of 99-BoB at:
       ;;  http://esolangs.org/wiki/99_bottles_of_beer
       ((#\9)
        (displayln
        (let ((BoB (lambda (n)
                     (string-append
                      (case n ((1) "1 bottle") ((0) "No bottles")
                        (else (format "~a bottles" n)))
                      " of beer"))))
          (string-join
           (for/list ((btls (in-range 99 0 -1)))
            (string-append (BoB btls)oTW",\n"(BoB btls)
                           ".\nTake one down, pass it around,\n"
                           (BoB (sub1 btls))oTW"."))
           "\n\n"))) A)
       ((#\+) (add1 A))
       ((#\newline) ; language extension, makes getting standard in easier
        (eprintf "warning: HQ9+: language extension ~s" token)
        A)
       (else (error "syntax error: HQ9+: unrecognised token ~s" token))))
   (void)))

(module+ main (parse-HQ9+ (port->string)))

(module+ test
  (require rackunit)
  (check-equal? (with-output-to-string (lambda () (parse-HQ9+ ""))) "")
  (check-equal? (with-output-to-string (lambda () (parse-HQ9+ "H"))) "hello, world")
  (check-equal? (with-output-to-string (lambda () (parse-HQ9+ "Q"))) "Q")
  (check-equal? (with-output-to-string (lambda () (parse-HQ9+ "QQ"))) "QQQQ")
  (check-equal? (with-output-to-string (lambda () (parse-HQ9+ "+"))) "")
  (check-equal? (with-output-to-string (lambda () (parse-HQ9+ "+"))) "")
  (check-equal? (with-output-to-string (lambda () (parse-HQ9+ "++"))) "")
  (check-equal? (with-output-to-string (lambda () (parse-HQ9+ "+++"))) "")
  (check-equal? (with-output-to-string (lambda () (parse-HQ9+ "+++++++++++++++++"))) "")
  (check-equal? (with-output-to-string (lambda () (parse-HQ9+ (make-string 10000 #\+)))) "")
  ;;; you can jolly well read (and sing along to) the output of '9'
  )

Raku

(formerly Perl 6)

Works with: rakudo version 2015-09-10

The spec is kind of vague about how to do error handling... and whether white space is significant... and how the accumulator should be accessed... and pretty much everything else too.

class HQ9Interpreter {
    has @!code;
    has $!accumulator;
    has $!pointer;
 
    method run ($code) {
        @!code = $code.comb;
        $!accumulator = 0;
        $!pointer = 0;
        while $!pointer < @!code {
            given @!code[$!pointer].lc {
                when 'h' { say 'Hello world!' }
                when 'q' { say @!code }
                when '9' { bob(99) }
                when '+' { $!accumulator++ }
                default  { note "Syntax error: Unknown command \"{@!code[$!pointer]}\"" }
            }
	    $!pointer++;
        }
    }
    sub bob ($beer is copy) {
        sub what  { "{$beer??$beer!!'No more'} bottle{$beer-1??'s'!!''} of beer" };
        sub where { 'on the wall' };
        sub drink { $beer--; "Take one down, pass it around," }
        while $beer {
            .say for "&what() &where(),", "&what()!",
                     "&drink()", "&what() &where()!", ''
        }
    }
}

# Feed it a command string:

my $hq9 = HQ9Interpreter.new;
$hq9.run("hHq+++Qq");
say '';
$hq9.run("Jhq.k+hQ");

Output:

Hello world!
Hello world!
hHq+++Qq
hHq+++Qq
hHq+++Qq

Syntax error: Unknown command "J"
Hello world!
Jhq.k+hQ
Syntax error: Unknown command "."
Syntax error: Unknown command "k"
Hello world!
Jhq.k+hQ

Or start a REPL (Read Execute Print Loop) and interact at the command line:

my $hq9 = HQ9Interpreter.new;
while 1 {
    my $in = prompt('HQ9+>').chomp;
    last unless $in.chars;
    $hq9.run($in)
}

REXX

Note that the actual text of the   Hello, world!   message can differ among definitions.

/*REXX program implements the   HQ9+   language. ───────────────────────────────────────*/
arg pgm .                                                    /*obtain optional argument.*/
accumulator=0                                                /*assign default to accum. */

      do instructions=1  for length(pgm);               ?=substr(pgm, instructions, 1)
           select
           when ?=='H' then say "Hello, world!"              /*text varies on definition*/
           when ?=='Q' then do j=1  for sourceline();   say sourceline(j);   end  /*j*/
           when ?== 9  then call 99
           when ?=='+' then accumulator=accumulator+1
           otherwise say 'invalid HQ9+ instruction:' ?
           end   /*select*/
      end        /*instructions*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
99:           do j=99  by -1  to 1
              say j 'bottle's(j)  "of beer the wall,"
              say j 'bottle's(j)  "of beer."
              say 'Take one down, pass it around,'
              n=j-1
              if n==0 then n='no'                                 /*cheating to use  0. */
              say n  'bottle's(j-1)  "of beer the wall."
              say
              end   /*j*/
    say 'No more bottles of beer on the wall,'                    /*finally, last verse.*/
    say 'no more bottles of beer.'
    say 'Go to the store and buy some more,'
    say '99 bottles of beer on the wall.'
    return
/*──────────────────────────────────────────────────────────────────────────────────────*/
s:  if arg(1)==1  then return '';             return "s"          /*a simple pluralizer.*/

output   when using the input of:   HHH

Hello, world!
Hello, world!
Hello, world!

Ring

# Project : Execute HQ9

bottle("hq9+HqQ+Qq")
 
func bottle(code)
     accumulator = 0
     for i = 1 to len(code)
         switch code[i] 
                on "h"
                    see "Hello, world!" + nl
                on "H"
                    see "hello, world!" + nl
                on "q"
                    see code + nl
                on "Q"
                    see code + nl
                on "9"
                    bottles = 99
                    while bottles > 0
                          see "" + bottles + " bottles of beer on the wall, " 
                          see "" + bottles + " bottles of beer," + nl
                          bottles = bottles - 1
                          see "take one down, pass it around, "
                          see "" + bottles + " bottles of beer on the wall." + nl
                    end
                on "+"
                    accumulator = accumulator + 1
         off
     next

Output:

Hello, world!
hq9+HqQ+Qq
99 bottles of beer on the wall, 99 bottles of beer,
Take one down, pass it around, 98 bottles of beer on the wall.
98 bottles of beer on the wall, 98 bottles of beer,
Take one down, pass it around, 97 bottles of beer on the wall.
...
3 bottles of beer on the wall, 3 bottles of beer,
Take one down, pass it around, 2 bottles of beer on the wall.
2 bottles of beer on the wall, 2 bottles of beer,
Take one down, pass it around, 1 bottles of beer on the wall.
1 bottles of beer on the wall, 1 bottles of beer,
Take one down, pass it around, 0 bottles of beer on the wall.
Hello, world!
hq9+HqQ+Qq
hq9+HqQ+Qq
hq9+HqQ+Qq
hq9+HqQ+Qq

Ruby

See RCHQ9+/Ruby.

Rust

use std::env;

// HQ9+ requires that '+' increments an accumulator, but it's inaccessible (and thus, unused).
#[allow(unused_variables)]
fn execute(code: &str) {
    let mut accumulator = 0;

    for c in code.chars() {
        match c {
            'Q' => println!("{}", code),
            'H' => println!("Hello, World!"),
            '9' => {
                for n in (1..100).rev() {
                    println!("{} bottles of beer on the wall", n);
                    println!("{} bottles of beer", n);
                    println!("Take one down, pass it around");
                    if (n - 1) > 1 {
                        println!("{} bottles of beer on the wall\n", n - 1);
                    } else {
                        println!("1 bottle of beer on the wall\n");
                    }
                }
            }
            '+' => accumulator += 1,
            _ => panic!("Invalid character '{}' found in source.", c),
        }
    }
}

fn main() {
    execute(&env::args().nth(1).unwrap());
}

Scala

def hq9plus(code: String) : String = {
    var out = ""
    var acc = 0

    def bottle(num: Int) : Unit = {
        if (num > 1) {
            out += num + " bottles of beer on the wall, " + num + " bottles of beer.\n"
            out += "Take one down and pass it around, " + (num - 1) + " bottle"

            if (num > 2) out += "s"

            out += " of beer.\n\n"
            bottle(num - 1)
        }
        else {
            out += "1 bottle of beer on the wall, 1 bottle of beer.\n" +
                "Take one down and pass it around, no more bottles of beer on the wall.\n\n" +
                "No more bottles of beer on the wall, no more bottles of beer.\n" +
                "Go to the store and buy some more, 99 bottles of beer on the wall.\n"
        }
    }

    def handle(char: Char) = char match {
        case 'H' => out += "Hello world!\n"
        case 'Q' => out += code + "\n"
        case '+' => acc += 1
        case '9' => bottle(99)
    }

    code.toList foreach handle
    out
}

println(hq9plus("HQ9+"))

Seed7

The program below accepts the HQ9+ program as command line parameter:

$ include "seed7_05.s7i";

const proc: runCode (in string: code) is func
  local
    var char: ch is ' ';
    var integer: bottles is 0;
    var integer: accumulator is 0;
  begin
    for ch range code do
      case ch of
        when {'H'}: writeln("Hello, world!");
        when {'Q'}: writeln(code);
        when {'9'}: bottles := 99;
                    repeat
                      writeln(bottles <& " bottles of beer on the wall");
                      writeln(bottles <& " bottles of beer");
                      writeln("Take one down, pass it around");
                      decr(bottles);
                      writeln(bottles <& " bottles of beer on the wall");
                      writeln;
                    until bottles = 0;
        when {'+'}: incr(accumulator);
      end case;
    end for;
  end func;

const proc: main is func
  begin
    if length(argv(PROGRAM)) >= 1 then
      runCode(argv(PROGRAM)[1]);
    end if;
  end func;

Sidef

Translation of: Raku

class HQ9Interpreter {
    has pointer;
    has accumulator;

    func bob (beer) {
        func what  { "#{beer ? beer : 'No more'} bottle#{beer-1 ? 's' : ''} of beer" }
        func where { 'on the wall' }
        func drink { beer--; "Take one down, pass it around," }

        while (beer.is_pos) {
            [[what(), where()], [what()],
            [drink()], [what(), where()], []].each{.join(' ').say}
        }
    }

    method run (code) {
        var chars = code.chars;
        accumulator = 0;
        pointer = 0;
        while (pointer < chars.len) {
            given (chars[pointer].lc) {
                when ('h') { say 'Hello world!' }
                when ('q') { say code }
                when ('9') { bob(99) }
                when ('+') { accumulator++ }
                default    { warn %Q(Syntax error: Unknown command "#{chars[pointer]}") }
            }
            pointer++;
        }
    }
}

Usage:

var hq9 = HQ9Interpreter();
hq9.run("hHq+++Qq");

Output:

Hello world!
Hello world!
hHq+++Qq
hHq+++Qq
hHq+++Qq

Or start a REPL (Read Execute Print Loop) and interact at the command line:

var hq9 = HQ9Interpreter();
loop {
    var in = read('HQ9+>', String) \\ break;
    hq9.run(in)
}

Tcl

See RCHQ9+/Tcl.

Ursa

see Execute HQ9+/Ursa

Ursala

See RCHQ9+/Ursala.

Wren

Translation of: Kotlin

import "os" for Process

var hq9plus = Fn.new { |code|
    var acc = 0
    var sb = ""
    for (c in code) {
        if (c == "h" || c == "H") {
            sb = sb + "Hello, world!\n"
        } else if (c == "q" || c == "Q") {
            sb = sb + code + "\n"
        } else if (c == "9") {
            for (i in 99..1) {
                var s = (i > 1) ? "s" : ""
                sb = sb + "%(i) bottle%(s) of beer on the wall\n"
                sb = sb + "%(i) bottle%(s) of beer\n"
                sb = sb + "Take one down, pass it around\n"
            }
            sb = sb + "No more bottles of beer on the wall!\n"
        } else if (c == "+") {
            acc = acc + 1
        } else {
            Fiber.abort("Code contains illegal operation '%(c)'")
        }
    }
    System.print(sb)
}

var args = Process.arguments
if (args.count != 1) {
    System.print("Please pass in the HQ9+ code to be executed.")
} else {
    hq9plus.call(args[0])
}

Output:

If a command line argument of hq9+ is passed in, the output is the same as the Kotlin entry.

x86 Assembly

;ds:si: pointer to asciiz string containing HQ9++ source code
ExecuteHQ9:
	push ax
	push dx
	push si
	push di
	push es
	push bx
	mov bx, si
	.interpret:
		lodsb
		cmp al, 'H'
		je .doHelloWorld
		cmp al, 'Q'
		je .doPrintCode
		cmp al, '9'
		je .doDrinkBeer
		cmp al, '+'
		je .doCounter
		pop bx
		pop es
		pop di
		pop si
		pop dx
		pop ax
		ret
		
	.doHelloWorld:
		push ds
		mov ax, cs
		mov ds, ax
		push si
		mov si, .dataHelloWorld
		call .printString
		pop si
		pop ds
		jmp .interpret
		
	.doPrintCode:
		push si
		mov si, bx
		call .printString
		pop si
		jmp .interpret
		
	.doDrinkBeer:
		push ds
		push si
		push ax
		mov ax, cs
		mov ds, ax
		mov ax, 99
		.beer_loop:
			call .printHexNumber
			mov si, .dataBeerSong1
			call .printString
			call .printHexNumber
			mov si, .dataBeerSong2
			call .printString
			dec ax
			call .printHexNumber
			mov si, .dataBeerSong3
			call .printString
			test ax, ax
			jnz .beer_loop
		pop ax
		pop si
		pop ds
		jmp .interpret
		
	.doCounter:
		push ax
		inc ax
		pop ax
		jmp .interpret
	
	.printString:
		push ax
		push si
	 .looping:
		lodsb
		test al, al
		jz .done
		mov ah, 0Eh
		int 10h
		jmp .looping
	 .done:
		pop si
		pop ax
		ret
		
	.printHexNumber:
			pusha
			push ds
			mov ax, cs
			mov ds, ax
			push word 0
			mov bx, ax
			xor dx, dx
			mov cx, 4r
	 .convert_loop:
			mov ax, bx
			and ax, 0Fh
			cmp ax, 9
			ja  .greater_than_9
			add ax, '0'
			jmp .converted
	 .greater_than_9:
			add ax, 'A'-0Ah
	 .converted:
			push ax
			shr bx, 4
			dec cx
			jnz .convert_loop
	 .popoff:
			pop ax
			cmp ax, 0
			je .done
			mov ah, 0Eh
			int 10h
			jmp .popoff
		.done:
			pop ds
			popa
			ret

	.dataHelloWorld: db "Hello World!", 0
	.dataBeerSong1: db " bottles of beer on the wall ", 0
	.dataBeerSong2: db " bottles of beer", 13, 10, "Take one down, pass it around "
	.dataBeerSong3: db 0, " bottles of beer on the wall", 0

XSLT

XSLT 1.0

Basic implementation

Requires bottles.xsl (below).

<?xml version="1.0"?>
<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0">
	<!-- bottles.xsl defines $entire-bottles-song -->
	<xsl:import href="bottles.xsl"/>

	<xsl:output method="text" encoding="utf-8"/>

	<xsl:variable name="hello-world">
		<xsl:text>Hello, world!&#10;</xsl:text>
	</xsl:variable>

	<!-- Main template -->
	<xsl:template match="/">
		<xsl:call-template name="run">
			<xsl:with-param name="code" select="string(.)"/>
		</xsl:call-template>
	</xsl:template>

	<!-- Runs HQ9+ code from string starting at given index (default 1) -->
	<xsl:template name="run">
		<xsl:param name="code"/>
		<xsl:param name="starting-at" select="1"/>

		<!-- Fetches instruction and forces to upper-case -->
		<xsl:variable name="inst" select="translate(substring($code, $starting-at, 1), 'hq', 'HQ')"/>

		<!-- Only if not at end -->
		<xsl:if test="$inst != ''">
			<xsl:choose>
				<xsl:when test="$inst = 'H'">
					<xsl:value-of select="$hello-world"/>
				</xsl:when>
				<xsl:when test="$inst = 'Q'">
					<xsl:value-of select="$code"/>
					<xsl:text>&#10;</xsl:text>
				</xsl:when>
				<xsl:when test="$inst = '9'">
					<xsl:value-of select="$entire-bottles-song"/>
				</xsl:when>
				<xsl:when test="$inst = '+'">
					<!-- XSLT has no meaningful equivalent of write-only variables -->
				</xsl:when>
				<!-- Otherwise, do nothing -->
			</xsl:choose>

			<!-- Proceed with next instruction -->
			<xsl:call-template name="run">
				<xsl:with-param name="code" select="$code"/>
				<xsl:with-param name="starting-at" select="$starting-at + 1"/>
			</xsl:call-template>
		</xsl:if>
	</xsl:template>
</xsl:stylesheet>

Details

Input to this sheet is given by placing the entire source as a single <code/> element. For example, to run the example program qqqq, use the sheet to transform the document

<code>qqqq</code>

Newlines are added in roughly the same places as in the C version. For example, the program qqqq results in four lines of output rather than one long line.

XSLT has no meaningful way to process a write-only variable like the accumulator, so + is a no-op.

Characters other than HQhq9+ are no-ops, but are echoed verbatim by Q/q.

Implementation supporting multiple programs and accumulator output

Requires bottles.xsl (below)

<?xml version="1.0"?>
<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0">
	<!-- bottles.xsl defines $entire-bottles-song -->
	<xsl:import href="bottles.xsl"/>

	<xsl:output method="xml" encoding="utf-8"/>

	<xsl:variable name="hello-world">
		<xsl:text>Hello, world!&#10;</xsl:text>
	</xsl:variable>

	<!-- Main template -->
	<xsl:template match="/">
		<results>
			<xsl:apply-templates select="//code"/>
		</results>
	</xsl:template>

	<!-- <code/> template -->
	<xsl:template match="code">
		<xsl:call-template name="run">
			<xsl:with-param name="code" select="string(.)"/>
		</xsl:call-template>
	</xsl:template>

	<!-- Runs HQ9+ code from string -->
	<xsl:template name="run">
		<xsl:param name="code"/>

		<xsl:call-template name="_run-remaining-code">
			<!-- Initial value is the entire input program plus a newline -->
			<xsl:with-param name="quine" select="concat($code,'&#10;')"/>

			<!-- Initial value is the entire input program with [hq] changed to upper-case -->
			<xsl:with-param name="code" select="translate($code, 'hq', 'HQ')"/>

			<!-- Initial value is empty -->
			<xsl:with-param name="output"/>

			<!-- Initial value is 0 -->
			<xsl:with-param name="accumulator" select="0"/>
		</xsl:call-template>
	</xsl:template>

	<!-- Runs the remainder of some already-started HQ9+ code -->
	<!-- Tail recursion allows this function to effectively update its own state -->
	<xsl:template name="_run-remaining-code">
		<!-- The text to be output on 'Q' -->
		<xsl:param name="quine"/>
		<!-- The remaining instructions for the program, already upper-case -->
		<xsl:param name="code"/>
		<!-- Output that has already been collected -->
		<xsl:param name="output"/>
		<!-- Current accumulator value -->
		<xsl:param name="accumulator"/>

		<!--
			 If there are instructions remaining, runs the next instruction and then recurses.
			 If there are no instructions left, produces the final output and accumulator before exiting.
		-->
		<xsl:choose>
			<xsl:when test="$code = ''">
				<!-- Reached the end of the program; output results -->
				<result>
					<xsl:if test="$accumulator != 0">
						<xsl:attribute name="accumulator"><xsl:value-of select="$accumulator"/></xsl:attribute>
					</xsl:if>
					<xsl:copy-of select="$output"/>
				</result>
			</xsl:when>
			<xsl:otherwise>
				<!-- At least one more instruction; run and recurse -->
				<xsl:variable name="inst" select="substring($code, 1, 1)"/>
				<xsl:variable name="remaining" select="substring($code, 2)"/>

				<!-- Decide what to add to accumulator -->
				<xsl:variable name="accumulator-inc">
					<xsl:choose>
						<xsl:when test="$inst = '+'">1</xsl:when>
						<xsl:otherwise>0</xsl:otherwise>
					</xsl:choose>
				</xsl:variable>

				<!-- Decide what to append to output -->
				<xsl:variable name="output-inc">
					<xsl:choose>
						<xsl:when test="$inst = 'H'"><xsl:value-of select="$hello-world"/></xsl:when>
						<xsl:when test="$inst = 'Q'"><xsl:value-of select="$quine"/></xsl:when>
						<xsl:when test="$inst = '9'"><xsl:value-of select="$entire-bottles-song"/></xsl:when>
					</xsl:choose>
				</xsl:variable>

				<!-- Recurse to continue processing program -->
				<xsl:call-template name="_run-remaining-code">
					<!-- $quine is the $quine originally passed without changes -->
					<xsl:with-param name="quine" select="$quine"/>
					<!-- $code is the $code from this invocation with the first character removed -->
					<xsl:with-param name="code" select="$remaining"/>
					<!-- $output is the $output from this invocation with $output-inc appended -->
					<xsl:with-param name="output">
						<xsl:copy-of select="$output"/>
						<xsl:copy-of select="$output-inc"/>
					</xsl:with-param>
					<!-- $accumulator is the $accumulator from this invocation with $accumulator-inc added -->
					<xsl:with-param name="accumulator" select="$accumulator + $accumulator-inc"/>
				</xsl:call-template>
			</xsl:otherwise>
		</xsl:choose>
	</xsl:template>
</xsl:stylesheet>

Details

This sheet demonstrates the use of a tail-recursive template to simulate a narrowly mutable state, which is used for both the output and the accumulator.

Input to this sheet is given by placing one or more sources as <code/> elements. For example, to run the example program qqqq, use the sheet to transform the document

<code>qqqq</code>

or the programs qqqq and ++++ can be run in the same pass by transforming

<programs>
  <code>qqqq</code>
  <code>++++</code>
</programs>

The output document is a <results/> element containing a <result/> element for each <code/> element processed from the input. If a + appeared in the program, the <result/> element will indicate the final value of the accumulator in its accumulator attribute. For example, the output for the latter example, would be

<results><result>qqqq
qqqq
qqqq
qqqq
</result><result accumulator="4"/></results>

bottles.xsl

This sheet defines a value for the variable $entire-bottles-song (see 99 Bottles of Beer for the general idea).

<?xml version="1.0"?>
<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0" xmlns:lo="urn:uuid:59afd337-03a8-49d9-a7a8-8e2cbc4ef9cc">
	<!-- Note: xmlns:lo is defined as a sort of pseudo-private namespace -->

	<!-- Given a count and a suffix (default " on the wall"), renders one number-containing line of the bottles song -->
	<xsl:template name="lo:line">
		<xsl:param name="count"/>
		<xsl:param name="suffix"> on the wall</xsl:param>
		<xsl:value-of select="$count"/>
		<xsl:text> bottle</xsl:text>
		<xsl:if test="$count != 1">s</xsl:if>
		<xsl:text> of beer</xsl:text>
		<xsl:value-of select="$suffix"/>
		<xsl:text>&#10;</xsl:text>
	</xsl:template>

	<!-- Given a count, renders one verse of the bottles song -->
	<xsl:template name="lo:verse">
		<xsl:param name="count"/>
		<xsl:call-template name="lo:line">
			<xsl:with-param name="count" select="$count"/>
		</xsl:call-template>
		<xsl:call-template name="lo:line">
			<xsl:with-param name="count" select="$count"/>
			<!-- empty suffix for this line -->
			<xsl:with-param name="suffix"/>
		</xsl:call-template>
		<xsl:text>Take one down, pass it around&#10;</xsl:text>
		<xsl:call-template name="lo:line">
			<xsl:with-param name="count" select="$count - 1"/>
		</xsl:call-template>
		<xsl:text>&#10;</xsl:text>
	</xsl:template>

	<!-- Given a starting count, renders the entire bottles song -->
	<xsl:template name="lo:song">
		<xsl:param name="count"/>
		<xsl:if test="$count &gt; 0">
			<xsl:call-template name="lo:verse">
				<xsl:with-param name="count" select="$count"/>
			</xsl:call-template>
			<xsl:call-template name="lo:song">
				<xsl:with-param name="count" select="$count - 1"/>
			</xsl:call-template>
		</xsl:if>
	</xsl:template>

	<!-- The entire bottles song -->
	<xsl:variable name="entire-bottles-song">
		<xsl:call-template name="lo:song">
			<xsl:with-param name="count" select="99"/>
		</xsl:call-template>
	</xsl:variable>

</xsl:stylesheet>

zkl

fcn runHQ9(code){
   acc:=0;
   foreach c in (code){
      switch(c){
	 case("H"){ println("hello, world"); }
	 case("Q"){ print(code); }
	 case("+"){ acc+=1; }
	 case("9"){ wall_O_beer(); }
      }
   }
}
fcn wall_O_beer(){
   [99..0,-1].pump(fcn(n){
      println(beers(n), " on the wall, ", beers(n).toLower(), ".\n",
	 n==0 and ("Go to the store and buy some more, 99 bottles of beer") or
	 ("Take one down and pass it around, " + beers(n-1).toLower()),
	 " on the wall.\n")
   });
}
fcn beers(n){
    (n==0 and "No more bottles" or (n==1 and "1 bottle" or "" + n + " bottles"))
    + " of beer"
}

runHQ9("90HQ+junk");

Output:

99 bottles of beer on the wall, 99 bottles of beer.
Take one down and pass it around, 98 bottles of beer on the wall.

98 bottles of beer on the wall, 98 bottles of beer.
Take one down and pass it around, 97 bottles of beer on the wall.
...
No more bottles of beer on the wall, no more bottles of beer.
Go to the store and buy some more, 99 bottles of beer on the wall.

hello, world
90HQ+junk