Execute HQ9+: Difference between revisions

Content added Content deleted

Inline

Revision as of 12:22, 10 December 2012

Implement a HQ9+ interpreter or compiler for Rosetta Code.

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

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>

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>

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 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. <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 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.

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"
       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.

@@ Line 218: / Line 218: @@
     }
-    size_t accumulator;
+    ulong accumulator;
     foreach (immutable c; args[1]) {
-        switch(c) {
+        final switch(c) {
             case 'Q', 'q':
                 writeln(args[1]);
@@ Line 242: / Line 242: @@
                 accumulator++;
                 break;
-            default:
-                assert(0);
         }
     }

Execute HQ9+: Difference between revisions

Revision as of 12:22, 10 December 2012

Ada

AutoHotkey

BBC BASIC

C

C++

C#

Clojure

Common Lisp

D

DWScript

E

Ela

Standard approach

Pure version

Erlang

Forth

Go

Haskell

Inform 7

Icon and Unicon

J

Java

JavaScript

Liberty BASIC

Mathematica

Nimrod

PARI/GP

Perl 6

PicoLisp

PureBasic

Python

REXX

Ruby

Scala

Seed7

Tcl

Ursala