Execute HQ9+
Implement a HQ9+ interpreter or compiler for Rosetta Code.
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
Ada
see Execute HQ9+/Ada
AutoHotkey
<lang 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
}</lang>
BBC BASIC
<lang bbcbasic> 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</lang>
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
C
<lang c>void runCode(const char *code) {
int c_len = strlen(code); int i, accumulator, bottles; 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; } }
};</lang>
C++
Basically the same as the C example, although this has been C++'ified with strings and streams. <lang cpp>void runCode(string code) {
int c_len = code.length(); int accumulator, 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; } }
};</lang>
C#
<lang csharp> 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](); }
} </lang>
Clojure
<lang 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))))))</lang>
COBOL
<lang 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 .</lang>
Common Lisp
D
<lang 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; } }
}</lang>
DWScript
<lang dwscript>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;</lang>
E
See Execute HQ9+/E.
Ela
Standard approach
<lang ela>open console char 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 = 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</lang>
Pure version
An interpreter itself has no side effects:
<lang ela>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 = 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</lang>
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 like so:
<lang ela>open console imperative each writen <| eval "HQ9+"</lang>
Erlang
<lang 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).
</lang>
Forth
<lang 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 ;</lang>
Go
See RCHQ9+/Go.
Haskell
See Execute HQ9+/Haskell.
Inform 7
<lang inform7>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 N be 100 - iteration; say "[N] bottle[s] of beer on the wall[line break]"; say "[N] bottle[s] of beer[line break]"; say "Take one down, pass it around[line break]"; say "[N - 1] bottle[s] of beer on the wall[paragraph break]"; otherwise if C is "+": increase accumulator by 1.</lang>
Icon and Unicon
Process HQ9+ from command line arguments and input until an error or end-of file. <lang Icon>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</lang>
J
From 99 Bottles of Beer <lang J>bob =: ": , ' bottle' , (1 = ]) }. 's of beer'"_ bobw=: bob , ' on the wall'"_ beer=: bobw , ', ' , bob , '; take one down and pass it around, ' , bobw@<:</lang>
The rest of the interpreter: <lang J>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~</lang>
Example use:
<lang J> hq9p 'hqQQq' Hello, world! hqQQq hqQQq hqQQq hqQQq</lang>
Java
See RCHQ9+/Java.
JavaScript
The function below executes a HQ9+ program and returns the program output as a string. <lang javascript>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;
}</lang>
Liberty BASIC
<lang lb>'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</lang>
Mathematica
<lang>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]</lang>
NetRexx
See RCHQ9+/NetRexx.
Nimrod
Modify contents of the program variable as you see fit.
<lang nimrod> 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)
</lang>
PARI/GP
Unlike many other implementations, this version will not overflow when the accumulator hits 264 (or as low as 231 in some versions).
The lyrics are based on the reference implementation. The endline and case-insensitivity are from an example in the spec. <lang parigp>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")) )
};</lang>
Sample input/output:
>HQ9p("qqqq") qqqq qqqq qqqq qqqq
Perl
This implementation uses the switch feature. <lang perl>
- !/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';
} </lang>
Perl 6
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.
<lang perl6>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()!", } }
}</lang>
Feed it a command string: <lang perl6>my $hq9 = HQ9Interpreter.new; $hq9.run("hHq+++Qq"); say; $hq9.run("Jhq.k+hQ");</lang>
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: <lang perl6>my $hq9 = HQ9Interpreter.new; while 1 {
my $in = prompt('HQ9+>').chomp; last unless $in.chars; $hq9.run($in)
}</lang>
PicoLisp
<lang 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 ) )</lang>
PureBasic
<lang 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</lang>
Python
See RCHQ9+/Python.
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>#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' )</lang>
REXX
<lang rexx>/*REXX program to implement the HQ9+ language.*/ parse arg pgm . accumulator=0
do instructions=1 for length(pgm); ?=substr(pgm,instructions,1) select when ?=='H' then say "hello, world" /*this salutation varies. */ when ?=='Q' then do j=1 for sourceline(); say sourceline(j); end 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 done.*/ /*──────────────────────────────────99 subroutine───────────────────────*/ 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
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 subroutine────────────────────────*/ s: if arg(1)==1 then return ; return "s" /*a simple pluralizer.*/</lang> output when using the input of: H+Q
hello, world /*REXX program to implement the HQ9+ language.*/ parse arg pgm . accumulator=0 do instructions=1 for length(pgm); ?=substr(pgm,instructions,1) select when ?=='H' then say "hello, world" when ?=='Q' then do j=1 for sourceline(); say sourceline(j); end 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 done.*/ /*──────────────────────────────────99 subroutine───────────────────────*/ 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 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 subroutine────────────────────────*/ s: if arg(1)==1 then return ''; return "s" /*a simple pluralizer.*/
Ruby
See RCHQ9+/Ruby.
Scala
<lang 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+")) </lang>
Seed7
The program below accepts the HQ9+ program as command line parameter:
<lang seed7>$ 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;</lang>
Tcl
See RCHQ9+/Tcl.
Ursala
See RCHQ9+/Ursala.