program Commatizing_numbers;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.RegularExpressions,
  system.StrUtils;

const
  PATTERN = '(\.[0-9]+|[1-9]([0-9]+)?(\.[0-9]+)?)';
  TESTS: array[0..13] of string = ('123456789.123456789', '.123456789',
    '57256.1D-4', 'pi=3.14159265358979323846264338327950288419716939937510582097494459231',
    'The author has two Z$100000000000000 Zimbabwe notes (100 trillion).',
    '-in Aus$+1411.8millions', '===US$0017440 millions=== (in 2000 dollars)',
    '123.e8000 is pretty big.',
    'The land area of the earth is 57268900(29% of the surface) square miles.',
    'Ain''t no numbers in this here words, nohow, no way, Jose.',
    'James was never known as 0000000007',
    'Arthur Eddington wrote: I believe there are ' +
    '15747724136275002577605653961181555468044717914527116709366231425076185631031296' +
    ' protons in the universe.', '   $-140000±100 millions.',
    '6/9/1946 was a good year for some.');

var
  regex: TRegEx;

function Commatize(s: string; startIndex, period: integer; sep: string): string;
var
  m: TMatch;
  s1, ip, pi, dp: string;
  splits: TArray<string>;
  i: integer;
begin
  regex := TRegEx.Create(PATTERN);

  if (startIndex < 0) or (startIndex >= s.Length) or (period < 1) or (sep.IsEmpty) then
    exit(s);
  m := regex.Match(s.Substring(startIndex, s.Length));
  if not m.Success then
    exit(s);

  s1 := m.Groups[0].Value;
  splits := s1.Split(['.']);

  ip := splits[0];

  if ip.Length > period then
  begin
    pi := ReverseString(ip);
    i := ((ip.Length - 1) div period) * period;

    while i >= period do
    begin
      pi := pi.Substring(0, i) + sep + pi.Substring(i);
      i := i - period;
    end;
    ip := ReverseString(pi);
  end;

  if s1.Contains('.') then
  begin
    dp := splits[1];
    if dp.Length > period then
    begin
      i := ((dp.Length - 1) div period) * period;
      while i >= period do
      begin
        dp := dp.Substring(0, i) + sep + dp.Substring(i);
        i := i - period;
      end;
    end;
    ip := ip + '.' + dp;
  end;
  Result := s.Substring(0, startIndex) + s.Substring(startIndex).Replace(s1, ip, []);
end;

var
  i: integer;

begin
  Writeln(commatize(TESTS[0], 0, 2, '*'));
  Writeln(commatize(TESTS[1], 0, 3, '-'));
  Writeln(commatize(TESTS[2], 0, 4, '__'));
  Writeln(commatize(TESTS[3], 0, 5, ' '));
  Writeln(commatize(TESTS[4], 0, 3, '.'));
  for i := 5 to High(TESTS) do
    Writeln(commatize(TESTS[i], 0, 3, ','));
  readln;
end.


#!/usr/bin/perl

# http://www.rosettacode.org/wiki/Compiler/virtual_machine_interpreter
use strict; # vm.pl - run rosetta code
use warnings;
use integer;

my ($binary, $pc, @stack, @data) = ('', 0);

<> =~ /Strings: (\d+)/ or die "bad header";
my @strings = map <> =~ tr/\n""//dr =~ s/\\(.)/$1 eq 'n' ? "\n" : $1/ger, 1..$1;

sub value { unpack 'l', substr $binary, ($pc += 4) - 4, 4 }

my @ops = (
  [ halt  => sub { exit } ],
  [ add   => sub { $stack[-2] += pop @stack } ],
  [ sub   => sub { $stack[-2] -= pop @stack } ],
  [ mul   => sub { $stack[-2] *= pop @stack } ],
  [ div   => sub { $stack[-2] /= pop @stack } ],
  [ mod   => sub { $stack[-2] %= pop @stack } ],
  [ not   => sub { $stack[-1] = $stack[-1] ? 0 : 1 } ],
  [ neg   => sub { $stack[-1] = - $stack[-1] } ],
  [ and   => sub { $stack[-2] &&= $stack[-1]; pop @stack } ],
  [ or    => sub { $stack[-2] ||= $stack[-1]; pop @stack } ],
  [ lt    => sub { $stack[-1] = $stack[-2] <  pop @stack ? 1 : 0 } ],
  [ gt    => sub { $stack[-1] = $stack[-2] >  pop @stack ? 1 : 0 } ],
  [ le    => sub { $stack[-1] = $stack[-2] <= pop @stack ? 1 : 0 } ],
  [ ge    => sub { $stack[-1] = $stack[-2] >= pop @stack ? 1 : 0 } ],
  [ ne    => sub { $stack[-1] = $stack[-2] != pop @stack ? 1 : 0 } ],
  [ eq    => sub { $stack[-1] = $stack[-2] == pop @stack ? 1 : 0 } ],
  [ prts  => sub { print $strings[pop @stack] } ],
  [ prti  => sub { print pop @stack } ],
  [ prtc  => sub { print chr pop @stack } ],
  [ store => sub { $data[value()] = pop @stack } ],
  [ fetch => sub { push @stack, $data[value()] // 0 } ],
  [ push  => sub { push @stack, value() } ],
  [ jmp   => sub { $pc += value() - 4 } ],
  [ jz    => sub { $pc += pop @stack ? 4 : value() - 4 } ],
  );
my %op2n = map { $ops[$_][0], $_ } 0..$#ops;            # map name to op number

while(<>)
  {
  /^ *\d+ +(\w+)/ or die "bad line $_";                 # format error
  $binary .= chr( $op2n{$1} // die "$1 not defined" ) . # op code
    (/\((-?\d+)\)|(\d+)]?$/ and pack 'l', $+);          # 4 byte value
  }

$ops[vec($binary, $pc++, 8)][1]->() while 1;            # run it


USING: accessors grouping io kernel math regexp sequences
splitting strings unicode ;

: numeric ( str -- new-str )
    R/ [1-9][0-9]*/ first-match >string ;

: commas ( numeric-str period separator -- str )
    [ reverse ] [ group ] [ reverse join reverse ] tri* ;

: (commatize) ( text from period separator -- str )
    [ cut dup numeric dup ] 2dip commas replace append ;

: commatize* ( text from period separator -- str )
    reach [ digit? ] any? [ (commatize) ] [ 3drop ] if ;

: commatize ( text -- str ) 0 3 "," commatize* ;

"pi=3.14159265358979323846264338327950288419716939937510582097494459231"
5 5 " " commatize* print

"The author has two Z$100000000000000 Zimbabwe notes (100 trillion)."
0 3 "." commatize* print

{
    "\"-in Aus$+1411.8millions\""
    "===US$0017440 millions=== (in 2000 dollars)"
    "123.e8000 is pretty big."
    "The land area of the earth is 57268900(29% of the surface) square miles."
    "Ain't no numbers in this here words, nohow, no way, Jose."
    "James was never known as 0000000007"
    "Arthur Eddington wrote: I believe there are 15747724136275002577605653961181555468044717914527116709366231425076185631031296 protons in the universe."
    "   $-140000±100 millions."
    "6/9/1946 was a good year for some."
} [ commatize print ] each


Sub commatize(s As String, sep As String = ",", start As Byte = 1, paso As Byte = 3)
    Dim As Integer l = Len(s)
    For i As Integer = start To l
        If Asc(Mid(s, i, 1)) >= Asc("1") And Asc(Mid(s, i, 1)) <= Asc("9") Then
            For j As Integer =i+1 To l+1
                If j>l Then
                    For k As Integer = j-1-paso To i Step -paso
                        s = Mid(s, 1, k) + sep + Mid(s, k+1, l-k+1)
                        l = Len(s)
                    Next k
                    Exit For
                Else
                    If (Asc(Mid(s, j, 1)) < Asc("0") Or Asc(Mid(s, j, 1)) > Asc("9")) Then
                        For k As Integer = j-1-paso To i Step -paso
                            s = Mid(s, 1, k) + sep + Mid(s, k+1, l-k+1)
                            l = Len(s)
                        Next k
                        Exit For
                    End If
                End If
            Next j
            Exit For
        End If
    Next i
    Print s
End Sub

commatize("pi=3.14159265358979323846264338327950288419716939937510582097494459231"," ",6,5)
commatize("The author has two Z$100000000000000 Zimbabwe notes (100 trillion).",".")
commatize("\'-in Aus$+1411.8millions\'",",")
commatize("===US$0017440 millions=== (in 2000 dollars)")
commatize("123.e8000 is pretty big.")
commatize("The land area of the earth is 57268900(29% of the surface) square miles.")
commatize("Ain't no numbers in this here words, nohow, no way, Jose.")
commatize("James was never known as 0000000007")
commatize("Arthur Eddington wrote: I believe there are 15747724136275002577605653961181555468044717914527116709366231425076185631031296 protons in the universe.")
commatize("   $-140000±100 millions.")
commatize("6/9/1946 was a good year for some.")

Sleep


--
-- demo\rosetta\Compiler\vm.exw
-- ============================
--
--  Since we have generated executable machine code, the virtual machine, such as it is, is just
--  the higher level implementations of printc/i/s, see setbuiltins() in cgen.e
--  Otherwise the only difference between this and cgen.exw is call(code_mem) instead of decode().
--
--  A quick test (calculating fib(44) 10^6 times) suggests ~500 times faster than interp.exw -
--  which is to be expected given that a single add instruction (1 clock) here is implemented as
--  at least three (and quite possibly five!) resursive calls to interp() in the other.

format PE32
--format ELF32
--  Note: cgen generates 32-bit machine code, which cannot be executed directly from a 64-bit interpreter.
--        You can however, via the magic of either the above format directives, use a 64-bit version of
--        Phix to compile this (just add a -c command line option) to a 32-bit executable, which can.
--        It would not be particularly difficult to emit 32 or 64 bit code, but some source code files
--        would, fairly obviously, then be very nearly twice as long, and a fair bit harder to read.

without js -- (machine code!)
include cgen.e

procedure main(sequence cl)
    open_files(cl)
    toks = lex()
    object t = parse()
    code_gen(t)
    fixup()
    if machine_bits()=32 then
        -- ^ as per note above
        call(code_mem)
    end if
    free({var_mem,code_mem})
    close_files()
end procedure

--main(command_line())
main({0,0,"count.c"})


package main

import (
    "fmt"
    "regexp"
    "strings"
)

var reg = regexp.MustCompile(`(\.[0-9]+|[1-9]([0-9]+)?(\.[0-9]+)?)`)

func reverse(s string) string {
    r := []rune(s)
    for i, j := 0, len(r)-1; i < len(r)/2; i, j = i+1, j-1 {
        r[i], r[j] = r[j], r[i]
    }
    return string(r)
}

func commatize(s string, startIndex, period int, sep string) string {
    if startIndex < 0 || startIndex >= len(s) || period < 1 || sep == "" {
        return s
    }
    m := reg.FindString(s[startIndex:]) // this can only contain ASCII characters
    if m == "" {
        return s
    }
    splits := strings.Split(m, ".")
    ip := splits[0]
    if len(ip) > period {
        pi := reverse(ip)
        for i := (len(ip) - 1) / period * period; i >= period; i -= period {
            pi = pi[:i] + sep + pi[i:]
        }
        ip = reverse(pi)
    }
    if strings.Contains(m, ".") {
        dp := splits[1]
        if len(dp) > period {
            for i := (len(dp) - 1) / period * period; i >= period; i -= period {
                dp = dp[:i] + sep + dp[i:]
            }
        }
        ip += "." + dp
    }
    return s[:startIndex] + strings.Replace(s[startIndex:], m, ip, 1)
}

func main() {
    tests := [...]string{
        "123456789.123456789",
        ".123456789",
        "57256.1D-4",
        "pi=3.14159265358979323846264338327950288419716939937510582097494459231",
        "The author has two Z$100000000000000 Zimbabwe notes (100 trillion).",
        "-in Aus$+1411.8millions",
        "===US$0017440 millions=== (in 2000 dollars)",
        "123.e8000 is pretty big.",
        "The land area of the earth is 57268900(29% of the surface) square miles.",
        "Ain't no numbers in this here words, nohow, no way, Jose.",
        "James was never known as 0000000007",
        "Arthur Eddington wrote: I believe there are " +
            "15747724136275002577605653961181555468044717914527116709366231425076185631031296" +
            " protons in the universe.",
        "   $-140000±100 millions.",
        "6/9/1946 was a good year for some.",
    }
    fmt.Println(commatize(tests[0], 0, 2, "*"))
    fmt.Println(commatize(tests[1], 0, 3, "-"))
    fmt.Println(commatize(tests[2], 0, 4, "__"))
    fmt.Println(commatize(tests[3], 0, 5, " "))
    fmt.Println(commatize(tests[4], 0, 3, "."))
    for _, test := range tests[5:] {
        fmt.Println(commatize(test, 0, 3, ","))
    }
}


# RC Compiler code generator #
COMMENT
    this writes a .NET IL assembler source to standard output.
    If the output is stored in a file called "rcsample.il",
    it could be compiled the command:
        ilasm /opt /out:rcsample.exe rcsample.il
    (Note ilasm may not be in the PATH by default(

    Note: The generated IL is *very* naive
COMMENT

# parse tree nodes #
MODE NODE = STRUCT( INT type, REF NODE left, right, INT value );
INT nidentifier   =  1, nstring    =  2, ninteger  =  3, nsequence  =  4, nif        =  5, nprtc     =  6, nprts   =  7
  , nprti         =  8, nwhile     =  9, nassign   = 10, nnegate    = 11, nnot       = 12, nmultiply = 13, ndivide = 14
  , nmod          = 15, nadd       = 16, nsubtract = 17, nless      = 18, nlessequal = 19, ngreater  = 20
  , ngreaterequal = 21, nequal     = 22, nnotequal = 23, nand       = 24, nor        = 25
  ;
# op codes #
INT ofetch =  1, ostore =  2, opush =  3, oadd =  4, osub  =  5, omul  =  6, odiv  =  7, omod     =  8
  , olt    =  9, ogt    = 10, ole   = 11, oge  = 12, oeq   = 13, one   = 14, oand  = 15, oor      = 16
  , oneg   = 17, onot   = 18, ojmp  = 19, ojz  = 20, oprtc = 21, oprts = 22, oprti = 23, opushstr = 24
  ;
[]INT    ndop
= ( -1               , -1             , -1            , -1             , -1             , -1            , -1
  , -1               , -1             , -1            , oneg           , -1             , omul          , odiv
  , omod             , oadd           , osub          , olt            , -1             , ogt
  , -1               , oeq            , -1            , oand           , oor
  ) ;
[]STRING ndname
= ( "Identifier"     , "String"       , "Integer"     , "Sequence"     , "If"           , "Prtc"        , "Prts"
  , "Prti"           , "While"        , "Assign"      , "Negate"       , "Not"          , "Multiply"    , "Divide"
  , "Mod"            , "Add"          , "Subtract"    , "Less"         , "LessEqual"    , "Greater"
  , "GreaterEqual"   , "Equal"        , "NotEqual"    , "And"          , "Or"
  ) ;
[]STRING opname
= ( "ldloc  ",  "stloc  ",   "ldc.i4 ",  "add    ",  "sub    ", "mul    ",  "div    ",  "rem    "
  , "clt    ",  "cgt    ",   "?le    ",  "?ge    ",  "ceq    ", "?ne    ",  "and    ",  "or     "
  , "neg    ",  "?not   ",   "br     ",  "brfalse",  "?prtc  ", "?prts  ",  "?prti  ",  "ldstr  "
  ) ;
# string and identifier arrays - a hash table might be better... #
INT max string number = 1024;
[ 0 : max string number ]STRING identifiers, strings;
FOR s pos FROM 0 TO max string number DO
    identifiers[ s pos ] := "";
    strings    [ s pos ] := ""
OD;
# label number for label generation #
INT next label number := 0;
# returns the next free label number #
PROC new label = INT: next label number +:= 1;

# returns a new node with left and right branches #
PROC op node      = ( INT op type, REF NODE left, right )REF NODE: HEAP NODE := NODE( op type, left, right, 0 );
# returns a new operand node #
PROC operand node = ( INT op type, value )REF NODE: HEAP NODE := NODE( op type, NIL, NIL, value );

# reports an error and stops #
PROC gen error = ( STRING message )VOID:
     BEGIN
        print( ( message, newline ) );
        stop
     END # gen error # ;

# reads a node from standard input #
PROC read node = REF NODE:
     BEGIN
        REF NODE result := NIL;

        # parses a string from line and stores it in a string in the text array #
        # - if it is not already present in the specified textElement list.     #
        # returns the position of the string in the text array                  #
        PROC read string = ( REF[]STRING text list, CHAR terminator )INT:
             BEGIN
                # get the text of the string #
                STRING str := line[ l pos ];
                l pos +:= 1;
                WHILE IF l pos <= UPB line THEN line[ l pos ] /= terminator ELSE FALSE FI DO
                    str   +:= line[ l pos ];
                    l pos +:= 1
                OD;
                IF l pos > UPB line THEN gen error( "Unterminated String in node file: (" + line + ")." ) FI;
                # attempt to find the text in the list of strings/identifiers #
                INT  t pos  := LWB text list;
                BOOL found  := FALSE;
                INT  result := LWB text list - 1;
                FOR t pos FROM LWB text list TO UPB text list WHILE NOT found DO
                    IF found := text list[ t pos ] = str THEN
                        # found the string #
                        result := t pos
                    ELIF text list[ t pos ] = "" THEN
                        # have an empty slot for ther string #
                        found := TRUE;
                        text list[ t pos ] := str;
                        result := t pos
                    FI
                OD;
                IF NOT found THEN gen error( "Out of string space." ) FI;
                result
             END # read string # ;
        # gets an integer from the line - no checks for valid digits #
        PROC read integer = INT:
             BEGIN
                 INT n := 0;
                 WHILE line[ l pos ] /= " " DO
                     ( n *:= 10 ) +:= ( ABS line[ l pos ] - ABS "0" );
                     l pos +:= 1
                 OD;
                 n
             END # read integer # ;

        STRING line, name;
        INT    l pos := 1, nd type := -1;
        read( ( line, newline ) );
        line +:= " ";
        # get the node type name #
        WHILE line[ l pos ] = " " DO l pos +:= 1 OD;
        name := "";
        WHILE IF l pos > UPB line THEN FALSE ELSE line[ l pos ] /= " " FI DO
            name +:= line[ l pos ];
            l pos +:= 1
        OD;
        # determine the node type #
        nd type := LWB nd name;
        IF name /= ";" THEN
            # not a null node #
            WHILE IF nd type <= UPB nd name THEN name /= nd name[ nd type ] ELSE FALSE FI DO nd type +:= 1 OD;
            IF nd type > UPB nd name THEN gen error( "Malformed node: (" + line + ")." ) FI;
            # handle the additional parameter for identifier/string/integer, or sub-nodes for operator nodes #
            IF nd type = ninteger OR nd type = nidentifier OR nd type = nstring THEN
                WHILE line[ l pos ] = " " DO l pos +:= 1 OD;
                IF     nd type = ninteger    THEN result := operand node( nd type, read integer )
                ELIF   nd type = nidentifier THEN result := operand node( nd type, read string( identifiers, " "  ) )
                ELSE # nd type = nString     #    result := operand node( nd type, read string( strings,     """" ) )
                FI
            ELSE
                # operator node #
                REF NODE left node = read node;
                result := op node( nd type, left node, read node )
            FI
        FI;
        result
     END # read node # ;

# returns a formatted op code for code generation #
PROC operation = ( INT op code )STRING: "            " + op name[ op code ] + "  ";
# defines the specified label #
PROC define label = ( INT label number )VOID: print( ( "lbl_", whole( label number, 0 ), ":", newline ) );
# generates code to load a string value #
PROC gen load string   = ( INT value )VOID:
     BEGIN
        print( ( operation( opushstr ), "  ", strings[ value ], """", newline ) )
     END # push string # ;
# generates code to load a constant value #
PROC gen load constant = ( INT value )VOID: print( ( operation( opush ), "  ", whole( value, 0 ), newline ) );
# generates an operation acting on an address #
PROC gen data op = ( INT op, address )VOID: print( ( operation( op ), "  l_", identifiers[ address ], newline ) );
# generates a nullary operation #
PROC gen op 0    = ( INT op )VOID:          print( ( operation( op ), newline ) );
# generates a "not" instruction sequence #
PROC gen not = VOID:
     BEGIN
        gen load constant( 0 );
        print( ( operation( oeq ), newline ) )
     END # gen not # ;
# generates a negated condition #
PROC gen not op = ( INT op, REF NODE n )VOID:
     BEGIN
        gen(  left OF n );
        gen( right OF n );
        gen op 0( op );
        gen not
     END # gen not op # ;
# generates a jump operation #
PROC gen jump = ( INT op, label )VOID: print( ( operation( op ), "  lbl_", whole( label, 0 ), newline ) );
# generates code to output something to System.Console.Out #
PROC gen output = ( REF NODE n, STRING output type )VOID:
     BEGIN
        print( ( "            call       " ) );
        print( ( "class [mscorlib]System.IO.TextWriter [mscorlib]System.Console::get_Out()", newline ) );
        gen( left OF n );
        print( ( "            callvirt   " ) );
        print( ( "instance void [mscorlib]System.IO.TextWriter::Write(", output type, ")", newline ) )
     END # gen output # ;

# generates the code header - assembly info, namespace, class and start of the Main method #
PROC code header = VOID:
     BEGIN
        print( ( ".assembly extern mscorlib { auto }",                                  newline ) );
        print( ( ".assembly RccSample {}",                                              newline ) );
        print( ( ".module RccSample.exe",                                               newline ) );
        print( ( ".namespace Rcc.Sample",                                               newline ) );
        print( ( "{",                                                                   newline ) );
        print( ( "    .class public auto ansi Program extends [mscorlib]System.Object", newline ) );
        print( ( "    {",                                                               newline ) );
        print( ( "        .method public static void Main() cil managed",               newline ) );
        print( ( "        {",                                                           newline ) );
        print( ( "           .entrypoint",                                              newline ) );
        # output the local variables #
        BOOL   have locals  := FALSE;
        STRING local prefix := "           .locals init (int32 l_";
        FOR s pos FROM LWB identifiers TO UPB identifiers WHILE identifiers[ s pos ] /= "" DO
            print( ( local prefix, identifiers[ s pos ], newline ) );
            local prefix := "                        ,int32 l_";
            have locals  := TRUE
        OD;
        IF have locals THEN
            # there were some local variables defined - output the terminator #
            print( ( "                        )", newline ) )
        FI
     END # code header # ;

# generates code for the node n #
PROC gen = ( REF NODE n )VOID:
     IF n IS REF NODE( NIL )        THEN # null node       #
        SKIP
     ELIF type OF n = nidentifier   THEN # load identifier #
        gen data op( ofetch, value OF n )
     ELIF type OF n = nstring       THEN # load string     #
        gen load string( value OF n )
     ELIF type OF n = ninteger      THEN # load integer    #
        gen load constant( value OF n )
     ELIF type OF n = nsequence     THEN # list            #
        gen(  left OF n );
        gen( right OF n )
     ELIF type OF n = nif           THEN # if-else         #
        INT else label := new label;
        gen( left OF n );
        gen jump( ojz, else label );
        gen( left OF right OF n );
        IF right OF right OF n IS REF NODE( NIL ) THEN
            # no "else" part #
            define label( else label )
        ELSE
            # have an "else" part #
            INT end if label := new label;
            gen jump( ojmp, end if label );
            define label( else label );
            gen( right OF right OF n );
            define label( end if label )
        FI
     ELIF type OF n = nwhile        THEN # while-loop      #
        INT loop label := new label;
        INT exit label := new label;
        define label( loop label );
        gen(  left OF n );
        gen jump( ojz,  exit label );
        gen( right OF n );
        gen jump( ojmp, loop label );
        define label( exit label )
     ELIF type OF n = nassign       THEN # assignment      #
        gen( right OF n );
        gen data op( ostore, value OF left OF n )
     ELIF type OF n = nnot          THEN # bolean not      #
        gen( left OF n );
        gen not
     ELIF type OF n = ngreaterequal THEN # compare >=      #
        gen not op( olt, n )
     ELIF type OF n = nnotequal     THEN # compare not =   #
        gen not op( oeq, n )
     ELIF type OF n = nlessequal    THEN # compare <=      #
        gen not op( ogt, n )
     ELIF type OF n = nprts         THEN # print string    #
        gen output( n, "string" )
     ELIF type OF n = nprtc         THEN # print character #
        gen output( n, "char" )
     ELIF type OF n = nprti         THEN # print integer   #
        gen output( n, "int32" )
     ELSE                                # everything else #
        gen(  left OF n );
        gen( right OF n ); # right will be null for a unary op so no code will be generated #
        print( ( operation( ndop( type OF n ) ), newline ) )
     FI # gen # ;

# generates the code trailer - return instruction, end of Main method, end of class and end of namespace #
PROC code trailer = VOID:
     BEGIN
        print( ( "            ret",           newline ) );
        print( ( "        } // Main method",  newline ) );
        print( ( "    } // Program class",    newline ) );
        print( ( "} // Rcc.Sample namespace", newline ) )
     END # code trailer # ;

# parse the output from the syntax analyser and generate code from the parse tree #
REF NODE code = read node;
code header;
gen( code );
code trailer


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%
%%% The Rosetta Code Virtual Machine, for GNU Prolog.
%%%
%%% The following code uses GNU Prolog's extensions for global
%%% variables.
%%%
%%% Usage: vm [INPUTFILE [OUTPUTFILE]]
%%% The notation "-" means to use standard input or standard output.
%%% Leaving out an argument is equivalent to specifying "-".
%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

make_and_run_machine(Input, Output) :-
  make_machine(Input),
  run_machine(Output).

run_machine(Output) :-
  repeat,
  next_instruction(Opcode, Arg),
  (Opcode == ('halt')
  -> true
  ; (run_instruction(Output, Opcode, Arg),
     fail                       % Backtracks to the 'repeat'.
    )).

run_instruction(Output, Opcode, Arg) :-
  (
    (Opcode == ('add'),
     pop_value(Y),
     pop_value(X),
     is(Z, X + Y),
     push_value(Z))
  ; (Opcode == ('sub'),
     pop_value(Y),
     pop_value(X),
     is(Z, X - Y),
     push_value(Z))
  ; (Opcode == ('mul'),
     pop_value(Y),
     pop_value(X),
     is(Z, X * Y),
     push_value(Z))
  ; (Opcode == ('div'),
     pop_value(Y),
     pop_value(X),
     is(Z, X // Y),
     push_value(Z))
  ; (Opcode == ('mod'),
     pop_value(Y),
     pop_value(X),
     is(Z, X rem Y),
     push_value(Z))
  ; (Opcode == ('lt'),
     pop_value(Y),
     pop_value(X),
     (X < Y -> Z = 1; Z = 0),
     push_value(Z))
  ; (Opcode == ('le'),
     pop_value(Y),
     pop_value(X),
     (X =< Y -> Z = 1; Z = 0),
     push_value(Z))
  ; (Opcode == ('gt'),
     pop_value(Y),
     pop_value(X),
     (X > Y -> Z = 1; Z = 0),
     push_value(Z))
  ; (Opcode == ('ge'),
     pop_value(Y),
     pop_value(X),
     (X >= Y -> Z = 1; Z = 0),
     push_value(Z))
  ; (Opcode == ('eq'),
     pop_value(Y),
     pop_value(X),
     (X =:= Y -> Z = 1; Z = 0),
     push_value(Z))
  ; (Opcode == ('ne'),
     pop_value(Y),
     pop_value(X),
     (X =\= Y -> Z = 1; Z = 0),
     push_value(Z))
  ; (Opcode == ('and'),
     pop_value(Y),
     pop_value(X),
     ((X =\= 0, Y =\= 0) -> Z = 1; Z = 0),
     push_value(Z))
  ; (Opcode == ('or'),
     pop_value(Y),
     pop_value(X),
     ((X =\= 0; Y =\= 0) -> Z = 1; Z = 0),
     push_value(Z))
  ; (Opcode == ('neg'),
     pop_value(X),
     is(Z, -X),
     push_value(Z))
  ; (Opcode == ('not'),
     pop_value(X),
     (X =:= 0 -> Z = 1; Z = 0),
     push_value(Z))
  ; (Opcode == ('prtc'),
     pop_value(X),
     char_code(C, X),
     write(Output, C))
  ; (Opcode == ('prti'),
     pop_value(X),
     write(Output, X))
  ; (Opcode == ('prts'),
     pop_value(K),
     g_read(the_strings(K), S),
     write(Output, S))
  ; (Opcode == ('fetch'),
     g_read(the_data(Arg), X),
     push_value(X),
     skip_argument)
  ; (Opcode == ('store'),
     pop_value(X),
     g_assign(the_data(Arg), X),
     skip_argument)
  ; (Opcode == ('push'),
     push_value(Arg),
     skip_argument)
  ; (Opcode == ('jmp'),
     relative_jump(Arg))
  ; (Opcode == ('jz'),
     pop_value(X),
     (X =:= 0
     -> relative_jump(Arg)
     ;  skip_argument))
  ).

relative_jump(Offset) :-
  g_read(the_program_counter, PC),
  is(PC1, PC + Offset),
  g_assign(the_program_counter, PC1).

skip_argument :-
  g_read(the_program_counter, PC),
  is(PC1, PC + 4),
  g_assign(the_program_counter, PC1).

next_instruction(Opcode, Arg) :-
  g_read(the_program_counter, PC),
  is(PC1, PC + 1),
  g_assign(the_program_counter, PC1),
  g_read(the_code(PC), {Opcode, Arg}).

push_value(X) :-
  g_read(the_stack_pointer, SP),
  is(SP1, SP + 1),
  g_assign(the_stack_pointer, SP1),
  g_assign(the_stack(SP), X).

pop_value(X) :-
  g_read(the_stack_pointer, SP),
  is(SP1, SP - 1),
  g_assign(the_stack_pointer, SP1),
  g_read(the_stack(SP1), X).

make_machine(Input) :-
  get_and_parse_the_header(Input, Datasize, Strings_Count),
  (Strings_Count =:= 0
  -> true
  ;  get_and_parse_the_strings(Input, Strings_Count)),
  get_and_parse_the_instructions(Input),
  (Datasize =:= 0
  -> true
  ;  g_assign(the_data, g_array(Datasize))),
  g_assign(the_stack, g_array(2048)),
  g_assign(the_stack_pointer, 0),
  g_assign(the_program_counter, 0).

get_and_parse_the_header(Stream, Datasize, Strings_Count) :-
  get_line(Stream, Line, ('\n')),
  parse_header(Line, Datasize, Strings_Count).

get_and_parse_the_strings(Stream, Strings_Count) :-
  % Make 'the_strings' an array of the string literals.
  get_and_parse_the_strings(Stream, Strings_Count, Lst),
  g_assign(the_strings, g_array(Lst)).
get_and_parse_the_strings(Stream, I, Lst) :-
  % Note: this implementation is non-tail recursive.
  (I == 0
  -> Lst = []
  ;  (get_line(Stream, Line, ('\n')),
      parse_string_literal(Line, S),
      is(I1, I - 1),
      get_and_parse_the_strings(Stream, I1, Lst1),
      Lst = [S | Lst1])).

get_and_parse_the_instructions(Stream) :-
  get_and_parse_the_instructions(Stream, Lst),
  keysort(Lst, Lst1),
  last(Lst1, Addr_Max-_),
  is(Code_Size, Addr_Max + 5),
  g_assign(the_code, g_array(Code_Size, {('halt'), 0})),
  maplist(fill_instruction, Lst1).
get_and_parse_the_instructions(Stream, Lst) :-
  get_and_parse_the_instructions(Stream, [], Lst).
get_and_parse_the_instructions(Stream, Lst0, Lst) :-
  % This implementation is tail recursive. We consider the order of
  % the resulting list to be arbitrary.
  (get_line(Stream, Line, Terminal),
   drop_spaces(Line, S),
   (S = []
   -> (Terminal = end_of_file
      -> Lst = Lst0
      ;  get_and_parse_the_instructions(Stream, Lst0, Lst))
   ;  (parse_instruction(S, Address, Opcode, Arg),
       Instr = Address-{Opcode, Arg},
       (Terminal = end_of_file
       -> reverse([Instr | Lst0], Lst)
       ;  get_and_parse_the_instructions(Stream, [Instr | Lst0],
                                         Lst))))).

fill_instruction(Addr-Instr) :-
  g_assign(the_code(Addr), Instr).

parse_header(Line, Datasize, Strings_Count) :-
  drop_nondigits(Line, Lst1),
  split_digits(Lst1, Datasize_Digits, Rest1),
  drop_nondigits(Rest1, Lst2),
  split_digits(Lst2, Strings_Digits, _Rest2),
  number_chars(Datasize, Datasize_Digits),
  number_chars(Strings_Count, Strings_Digits).

parse_string_literal(Line, S) :-
  drop_spaces(Line, Lst1),
  Lst1 = ['"' | Lst2],
  rework_escape_sequences(Lst2, Lst3),
  atom_chars(S, Lst3).

rework_escape_sequences(Lst0, Lst) :-
  (Lst0 = [('"') | _]
  -> Lst = []
  ;  (Lst0 = [('\\'), ('n') | Tail1]
     -> (rework_escape_sequences(Tail1, Lst1),
         Lst = [('\n') | Lst1])
     ;  (Lst0 = [('\\'), ('\\') | Tail1]
        -> (rework_escape_sequences(Tail1, Lst1),
            Lst = [('\\') | Lst1])
        ;  (Lst0 = [C | Tail1],
            rework_escape_sequences(Tail1, Lst1),
            Lst = [C | Lst1])))).

parse_instruction(Line, Address, Opcode, Arg) :-
  drop_spaces(Line, Lst1),
  split_digits(Lst1, Address_Digits, Rest1),
  number_chars(Address, Address_Digits),
  drop_spaces(Rest1, Lst2),
  split_nonspaces(Lst2, Opcode_Chars, Rest2),
  atom_chars(Opcode, Opcode_Chars),
  drop_spaces(Rest2, Lst3),
  (Lst3 = []
  -> Arg = 0
  ;  (Lst3 = [C | Rest3],
      (is_digit(C)
      -> (split_digits(Lst3, Arg_Chars, _),
          number_chars(Arg, Arg_Chars))
      ; (C = ('(')
        -> (split_before_char((')'), Rest3, Arg_Chars, _),
            number_chars(Arg, Arg_Chars))
        ; (C = ('['),
           split_before_char((']'), Rest3, Arg_Chars, _),
           number_chars(Arg, Arg_Chars)))))).

is_space(C) :-
  (C = (' '); C = ('\t'); C = ('\n');
   C = ('\v'); C = ('\f'); C = ('\r')).

is_digit(C) :-
  (C = ('0'); C = ('1'); C = ('2'); C = ('3'); C = ('4');
   C = ('5'); C = ('6'); C = ('7'); C = ('8'); C = ('9')).

drop_spaces([], Lst) :-
  Lst = [].
drop_spaces([C | Tail], Lst) :-
  (is_space(C)
  -> drop_spaces(Tail, Lst)
  ;  Lst = [C | Tail]).

drop_nondigits([], Lst) :-
  Lst = [].
drop_nondigits([C | Tail], Lst) :-
  (is_digit(C)
  -> Lst = [C | Tail]
  ;  drop_nondigits(Tail, Lst)).

split_nonspaces([], Word, Rest) :-
  (Word = [], Rest = []).
split_nonspaces([C | Tail], Word, Rest) :-
  (is_space(C)
  -> (Word = [], Rest = [C | Tail])
  ;  (split_nonspaces(Tail, Word1, Rest),
      Word = [C | Word1])).

split_digits([], Digits, Rest) :-
  (Digits = [], Rest = []).
split_digits([C | Tail], Digits, Rest) :-
  (is_digit(C)
  -> (split_digits(Tail, Digits1, Rest),
      Digits = [C | Digits1])
  ;  (Digits = [], Rest = [C | Tail])).

split_before_char(_, [], Before, After) :-
  (Before = [], After = []).
split_before_char(C, [C1 | Rest], Before, After) :-
  (C = C1
  -> (Before = [], After = [C1 | Rest])
  ;  (split_before_char(C, Rest, Before1, After),
      Before = [C1 | Before1])).

get_line(Stream, Line, Terminal) :-
  % Reads a line of input as a list of characters. The character that
  % terminates the line is returned separately; it may be either '\n'
  % or end_of_file.
  get_line_chars(Stream, [], Line, Terminal).

get_line_chars(Stream, Chars0, Chars, Terminal) :-
  % Helper predicate for get_line.
  get_char(Stream, C),
  ((C = end_of_file; C = ('\n'))
  -> (reverse(Chars0, Chars), Terminal = C)
  ;  get_line_chars(Stream, [C | Chars0], Chars, Terminal)).

main(Args) :-
  (Args = []
  -> current_input(Input),
     current_output(Output),
     make_and_run_machine(Input, Output)
  ; (Args = [Inp_Name]
    -> (Inp_Name = ('-')
       -> main([])
       ;  (open(Inp_Name, 'read', Input),
           current_output(Output),
           make_and_run_machine(Input, Output),
           close(Input)))
    ; (Args = [Inp_Name, Out_Name | _],
       (Inp_Name = ('-')
       -> (Out_Name = ('-')
          -> main([])
          ;  (current_input(Input),
              open(Out_Name, 'write', Output),
              make_and_run_machine(Input, Output),
              close(Output)))
       ;  (Out_Name = ('-')
          -> main([Inp_Name])
          ;  (open(Inp_Name, 'read', Input),
              open(Out_Name, 'write', Output),
              make_and_run_machine(Input, Output),
              close(Input),
              close(Output))))))).

main :-
  argument_list(Args),
  main(Args).

:- initialization(main).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Instructions for GNU Emacs--
%%% local variables:
%%% mode: prolog
%%% prolog-indent-width: 2
%%% end:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


#!/usr/bin/env runhaskell

import Control.Monad (forM_)
import Data.Char (isDigit)
import Data.List (intercalate)
import Data.Maybe (fromMaybe)

{-
I use the suffix "2" in identifiers in place of the more conventional
prime (single quote character), because Rosetta Code's syntax highlighter
still doesn't handle primes in identifiers correctly.
-}

isDigitOrPeriod :: Char -> Bool
isDigitOrPeriod '.' = True
isDigitOrPeriod c = isDigit c

chopUp :: Int -> String -> [String]
chopUp _ [] = []
chopUp by str
  | by < 1 = [str]              -- invalid argument, leave string unchanged
  | otherwise = let (pfx, sfx) = splitAt by str
                in pfx : chopUp by sfx

addSeps :: String -> Char -> Int -> (String -> String) -> String
addSeps str sep by rev =
  let (leading, number) = span (== '0') str
      number2 = rev $ intercalate [sep] $ chopUp by $ rev number
  in leading ++ number2

processNumber :: String -> Char -> Int -> String
processNumber str sep by =
  let (beforeDecimal, rest) = span isDigit str
      (decimal, afterDecimal) = splitAt 1 rest
      beforeDecimal2 = addSeps beforeDecimal sep by reverse
      afterDecimal2 = addSeps afterDecimal sep by id
  in beforeDecimal2 ++ decimal ++ afterDecimal2

commatize2 :: String -> Char -> Int -> String
commatize2 [] _ _ = []
commatize2 str sep by =
  let (pfx, sfx) = break isDigitOrPeriod str
      (number, sfx2) = span isDigitOrPeriod sfx
  in pfx ++ processNumber number sep by ++ sfx2

commatize :: String -> Maybe Char -> Maybe Int -> String
commatize str sep by = commatize2 str (fromMaybe ',' sep) (fromMaybe 3 by)

input :: [(String, Maybe Char, Maybe Int)]
input =
  [ ("pi=3.14159265358979323846264338327950288419716939937510582097494459231", Just ' ', Just 5)
  , ("The author has two Z$100000000000000 Zimbabwe notes (100 trillion).", Just '.', Nothing)
  , ("\"-in Aus$+1411.8millions\"", Nothing, Nothing)
  , ("===US$0017440 millions=== (in 2000 dollars)", Nothing, Nothing)
  , ("123.e8000 is pretty big.", Nothing, Nothing)
  , ("The land area of the earth is 57268900(29% of the surface) square miles.", Nothing, Nothing)
  , ("Ain't no numbers in this here words, nohow, no way, Jose.", Nothing, Nothing)
  , ("James was never known as 0000000007", Nothing, Nothing)
  , ("Arthur Eddington wrote: I believe there are 15747724136275002577605653961181555468044717914527116709366231425076185631031296 protons in the universe.", Nothing, Nothing)
  , ("   $-140000±100 millions.", Nothing, Nothing)
  , ("6/9/1946 was a good year for some.", Nothing, Nothing)
  ]

main :: IO ()
main =
  forM_ input $ \(str, by, sep) -> do
    putStrLn str
    putStrLn $ commatize str by sep
    putStrLn ""


begin % code generator %
    % parse tree nodes %
    record node( integer         type
               ; reference(node) left, right
               ; integer         iValue % nString/nIndentifier number or nInteger value %
               );
    integer    nIdentifier, nString, nInteger, nSequence, nIf,   nPrtc, nPrts
          ,    nPrti,       nWhile,  nAssign,  nNegate,   nNot,  nMultiply
          ,    nDivide,     nMod,    nAdd,     nSubtract, nLess, nLessEqual
          ,    nGreater,    nGreaterEqual,     nEqual,    nNotEqual,    nAnd, nOr
          ;
    string(14) array ndName ( 1 :: 25 );
    integer    array nOp    ( 1 :: 25 );
    integer    MAX_NODE_TYPE;
    % string literals and identifiers - uses a linked list - a hash table might be better... %
    string(1)  array text ( 0 :: 4095 );
    integer    textNext, TEXT_MAX;
    record textElement ( integer start, length; reference(textElement) next );
    reference(textElement) idList, stList;
    % op codes %
    integer    oFetch, oStore, oPush
          ,    oAdd,   oSub,   oMul, oDiv, oMod, oLt, oGt,   oLe,   oGe,   oEq,  oNe
          ,    oAnd,   oOr,    oNeg, oNot, oJmp, oJz, oPrtc, oPrts, oPrti, oHalt
          ;
    string(6)  array opName ( 1 :: 24 );
    % code - although this is intended to be byte code, as we are going to output    %
    %        an assembler source, we use integers for convenience                    %
    % labelLocations are: - ( referencing location + 1 ) if they have been referenced but not defined yet, %
    %                     zero     if they are unreferenced and undefined,                                 %
    %                     ( referencing location + 1 )   if they are defined                               %
    integer    array byteCode ( 0 :: 4095 );
    integer    array labelLocation( 1 :: 4096 );
    integer    nextLocation, MAX_LOCATION, nextLabelNumber, MAX_LABEL_NUMBER;

    % returns a new node with left and right branches %
    reference(node) procedure opNode ( integer value opType; reference(node) value opLeft, opRight ) ; begin
        node( opType, opLeft, opRight, 0 )
    end opNode ;

    % returns a new operand node %
    reference(node) procedure operandNode ( integer value opType, opValue ) ; begin
        node( opType, null, null, opValue )
    end operandNode ;

    % reports an error and stops %
    procedure genError( string(80) value message ); begin
        integer errorPos;
        write( s_w := 0, "**** Code generation error: " );
        errorPos := 0;
        while errorPos < 80 and message( errorPos // 1 ) not = "." do begin
            writeon( s_w := 0, message( errorPos // 1 ) );
            errorPos := errorPos + 1
        end while_not_at_end_of_message ;
        writeon( s_w := 0, "." );
        assert( false )
    end genError ;

    % reads a node from standard input %
    reference(node) procedure readNode ; begin
        reference(node) resultNode;

        % parses a string from line and stores it in a string in the text array %
        % - if it is not already present in the specified textElement list.     %
        % returns the position of the string in the text array                  %
        integer procedure readString ( reference(textElement) value result txList; string(1) value terminator ) ; begin
            string(256) str;
            integer     sLen, sPos, ePos;
            logical     found;
            reference(textElement) txPos, txLastPos;
            % get the text of the string %
            str  := " ";
            sLen := 0;
            str( sLen // 1 ) := line( lPos // 1 );
            sLen := sLen + 1;
            lPos := lPos + 1;
            while lPos <= 255 and line( lPos // 1 ) not = terminator do begin
                str( sLen // 1 ) := line( lPos // 1 );
                sLen := sLen + 1;
                lPos := lPos + 1
            end while_more_string ;
            if lPos > 255 then genError( "Unterminated String in node file." );
            % attempt to find the text in the list of strings/identifiers %
            txLastPos := txPos := txList;
            found := false;
            ePos := 0;
            while not found and txPos not = null do begin
                ePos  := ePos + 1;
                found := ( length(txPos) = sLen );
                sPos  := 0;
                while found and sPos < sLen do begin
                    found := str( sPos // 1 ) = text( start(txPos) + sPos );
                    sPos  := sPos + 1
                end while_not_found ;
                txLastPos := txPos;
                if not found then txPos := next(txPos)
            end while_string_not_found ;
            if not found then begin
                % the string/identifier is not in the list - add it %
                ePos := ePos + 1;
                if txList = null then txList := textElement( textNext, sLen, null )
                                 else next(txLastPos) := textElement( textNext, sLen, null );
                if textNext + sLen > TEXT_MAX then genError( "Text space exhausted." )
                else begin
                    for cPos := 0 until sLen - 1 do begin
                        text( textNext ) := str( cPos // 1 );
                        textNext := textNext + 1
                    end for_cPos
                end
            end if_not_found ;
            ePos
        end readString ;

        % gets an integer from the line - no checks for valid digits %
        integer procedure readInteger ; begin
            integer n;
            n := 0;
            while line( lPos // 1 ) not = " " do begin
                n    := ( n * 10 ) + ( decode( line( lPos // 1 ) ) - decode( "0" ) );
                lPos := lPos + 1
            end while_not_end_of_integer ;
            n
        end readInteger ;

        string(256) line;
        string(16)  name;
        integer     lPos, tPos, ndType;
        tPos := lPos := 0;
        readcard( line );
        % get the node type name %
        while line( lPos // 1 ) = " " do lPos := lPos + 1;
        name := "";
        while lPos < 256 and line( lPos // 1 ) not = " " do begin
            name( tPos // 1 ) := line( lPos // 1 );
            lPos := lPos + 1;
            tPos := tPos + 1
        end  while_more_name ;
        % determine the node type %
        ndType         := 1;
        resultNode     := null;
        if name not = ";" then begin
            % not a null node %
            while ndType <= MAX_NODE_TYPE and name not = ndName( ndType ) do ndType := ndType + 1;
            if ndType > MAX_NODE_TYPE then genError( "Malformed node." );
            % handle the additional parameter for identifier/string/integer, or sub-nodes for operator nodes %
            if ndType = nInteger or ndType = nIdentifier or ndType = nString then begin
                while line( lPos // 1 ) = " " do lPos := lPos + 1;
                if      ndType = nInteger    then resultNode := operandNode( ndType, readInteger )
                else if ndType = nIdentifier then resultNode := operandNode( ndType, readString( idList, " "  ) )
                else  % ndType = nString     %    resultNode := operandNode( ndType, readString( stList, """" ) )
                end
            else begin
                % operator node %
                reference(node) leftNode;
                leftNode   := readNode;
                resultNode := opNode( ndType, leftNode, readNode )
            end
        end if_non_null_node ;
        resultNode
    end readNode ;

    % returns the next free label number %
    integer procedure newLabel ; begin
        nextLabelNumber := nextLabelNumber + 1;
        if nextLabelNumber > MAX_LABEL_NUMBER then genError( "Program too complex" );
        nextLabelNumber
    end newLabel ;

    % defines the specified label to be at the next location %
    procedure defineLabel ( integer value labelNumber ) ; begin
        if labelLocation( labelNumber ) > 0 then genError( "Label already defined" )
        else begin
            % this is the first definition of the label, define it and if it has already been referenced, fill in the reference %
            integer currValue;
            currValue := labelLocation( labelNumber );
            labelLocation( labelNumber ) := nextLocation + 1; % we store pc + 1 to ensure the label location is positive %
            if currValue < 0 then % already referenced % byteCode( - ( currValue + 1 ) ) := labelLocation( labelNumber )
        end
    end defineLabel ;

    % stores a byte in the code %
    procedure genByte ( integer value byteValue ) ; begin
        if nextLocation > MAX_LOCATION then genError( "Program too large" );
        byteCode( nextLocation ) := byteValue;
        nextLocation := nextLocation + 1
    end genByte ;

    % stores an integer in the code %
    procedure genInteger ( integer value integerValue ) ; begin
        % we are storing the bytes of the code in separate integers for convenience %
        genByte( integerValue ); genByte( 0 ); genByte( 0 ); genByte( 0 )
    end genInteger ;

    % generates an operation acting on an address %
    procedure genDataOp ( integer value opCode, address ) ; begin
        genByte( opCode );
        genInteger( address )
    end genDataOp ;

    % generates a nullary operation %
    procedure genOp0  ( integer value opCode ) ; begin
        genByte( opCode )
    end genOp0 ;

    % generates a unary/binary operation %
    procedure genOp ( reference(node) value n ) ; begin
        gen(  left(n) );
        gen( right(n) ); % right will be null for a unary op so no code will be generated %
        genByte( nOp( type(n) ) )
    end genOp ;

    % generates a jump operation %
    procedure genJump   ( integer value opCode, labelNumber ) ; begin
        genByte( opCode );
        % if the label is not defined yet - set it's location to the negative of the referencing location %
        % so it can be resolved later %
        if labelLocation( labelNumber ) = 0 then labelLocation( labelNumber ) := - ( nextLocation + 1 );
        genInteger( labelLocation( labelNumber ) )
    end genJump ;

    % generates code for the node n %
    procedure gen ( reference(node) value n ) ; begin

        if           n  = null        then % empty node % begin end
        else if type(n) = nIdentifier then genDataOp( oFetch, iValue(n) )
        else if type(n) = nString     then genDataOp( oPush,  iValue(n) - 1 )
        else if type(n) = nInteger    then genDataOp( oPush,  iValue(n) )
        else if type(n) = nSequence   then begin
            gen(  left(n) );
            gen( right(n) )
            end
        else if type(n) = nIf         then % if-else         % begin
            integer elseLabel;
            elseLabel := newLabel;
            gen( left(n) );
            genJump( oJz, elseLabel );
            gen( left( right(n) ) );
            if right(right(n)) = null then % no "else" part % defineLabel( elseLabel )
            else begin
                % have an "else" part %
                integer endIfLabel;
                endIfLabel := newLabel;
                genJump( oJmp, endIfLabel );
                defineLabel( elseLabel );
                gen( right(right(n)) );
                defineLabel( endIfLabel )
            end
            end
        else if type(n) = nWhile      then % while-loop      % begin
            integer loopLabel, exitLabel;
            loopLabel := newLabel;
            exitLabel := newLabel;
            defineLabel( loopLabel );
            gen(  left(n) );
            genJump( oJz,  exitLabel );
            gen( right(n) );
            genJump( oJmp, loopLabel );
            defineLabel( exitLabel )
            end
        else if type(n) = nAssign     then % assignment      % begin
            gen( right( n ) );
            genDataOp( oStore, iValue(left(n)) )
            end
        else genOp( n )
    end gen ;

    % outputs the generated code to standard output %
    procedure emitCode ; begin

        % counts the number of elements in a text element list %
        integer procedure countElements ( reference(textElement) value txHead ) ; begin
            integer count;
            reference(textElement) txPos;
            count := 0;
            txPos := txHead;
            while txPos not = null do begin
                count := count + 1;
                txPos := next(txPos)
            end while_txPos_not_null ;
            count
        end countElements ;

        integer pc, op;
        reference(textElement) txPos;

        % code header %
        write( i_w := 1, s_w := 0
             , "Datasize: ", countElements( idList )
             , " Strings: ", countElements( stList )
             );
        % output the string literals %
        txPos := stList;
        while txPos not = null do begin
            integer cPos;
            write( """" );
            cPos := 1; % start from 1 to skip over the leading " %
            while cPos < length(txPos) do begin
                writeon( s_w := 0, text( start(txPos) + cPos ) );
                cPos := cPos + 1
            end while_not_end_of_string ;
            writeon( s_w := 0, """" );
            txPos := next(txPos)
        end while_not_at_end_of_literals ;

        % code body %
        pc := 0;
        while pc < nextLocation do begin
            op := byteCode( pc );
            write( i_w := 4, s_w := 0, pc, " ", opName( op ) );
            pc := pc + 1;
            if      op = oFetch or op = oStore then begin
                % data load/store - add the address in square brackets %
                writeon( i_w := 1, s_w := 0, "[", byteCode( pc ) - 1, "]" );
                pc := pc + 4
                end
            else if op = oPush                 then begin
                % push constant - add the constant %
                writeon( i_w := 1, s_w := 0, byteCode( pc ) );
                pc := pc + 4
                end
            else if op = oJmp   or op = oJz    then begin
                % jump - show the relative address in brackets and the absolute address %
                writeon( i_w := 1, s_w := 0, "(", ( byteCode( pc ) - 1 ) - pc, ") ", byteCode( pc ) - 1 );
                pc := pc + 4
            end
        end while_pc_lt_nextLocation
    end emitCode ;

    oFetch :=  1; opName( oFetch ) := "fetch"; oStore :=  2; opName( oStore ) := "store"; oPush :=  3; opName( oPush ) := "push";
    oAdd   :=  4; opName( oAdd   ) := "add";   oSub   :=  5; opName( oSub   ) := "sub";   oMul  :=  6; opName( oMul  ) := "mul";
    oDiv   :=  7; opName( oDiv   ) := "div";   oMod   :=  8; opName( oMod   ) := "mod";   oLt   :=  9; opName( oLt   ) := "lt";
    oGt    := 10; opName( oGt    ) := "gt";    oLe    := 11; opName( oLe    ) := "le";    oGe   := 12; opName( oGe   ) := "ge";
    oEq    := 13; opName( oEq    ) := "eq";    oNe    := 14; opName( oNe    ) := "ne";    oAnd  := 15; opName( oAnd  ) := "and";
    oOr    := 16; opName( oOr    ) := "or";    oNeg   := 17; opName( oNeg   ) := "neg";   oNot  := 18; opName( oNot  ) := "not";
    oJmp   := 19; opName( oJmp   ) := "jmp";   oJz    := 20; opName( oJz    ) := "jz";    oPrtc := 21; opName( oPrtc ) := "prtc";
    oPrts  := 22; opName( oPrts  ) := "prts";  oPrti  := 23; opName( oPrti  ) := "prti";  oHalt := 24; opName( oHalt ) := "halt";

    nIdentifier      :=  1; ndName( nIdentifier   ) := "Identifier";   nString   :=  2; ndName( nString   ) := "String";
    nInteger         :=  3; ndName( nInteger      ) := "Integer";      nSequence :=  4; ndName( nSequence ) := "Sequence";
    nIf              :=  5; ndName( nIf           ) := "If";           nPrtc     :=  6; ndName( nPrtc     ) := "Prtc";
    nPrts            :=  7; ndName( nPrts         ) := "Prts";         nPrti     :=  8; ndName( nPrti     ) := "Prti";
    nWhile           :=  9; ndName( nWhile        ) := "While";        nAssign   := 10; ndName( nAssign   ) := "Assign";
    nNegate          := 11; ndName( nNegate       ) := "Negate";       nNot      := 12; ndName( nNot      ) := "Not";
    nMultiply        := 13; ndName( nMultiply     ) := "Multiply";     nDivide   := 14; ndName( nDivide   ) := "Divide";
    nMod             := 15; ndName( nMod          ) := "Mod";          nAdd      := 16; ndName( nAdd      ) := "Add";
    nSubtract        := 17; ndName( nSubtract     ) := "Subtract";     nLess     := 18; ndName( nLess     ) := "Less";
    nLessEqual       := 19; ndName( nLessEqual    ) := "LessEqual";    nGreater  := 20; ndName( nGreater  ) := "Greater";
    nGreaterEqual    := 21; ndName( nGreaterEqual ) := "GreaterEqual"; nEqual    := 22; ndName( nEqual    ) := "Equal";
    nNotEqual        := 23; ndName( nNotEqual     ) := "NotEqual";     nAnd      := 24; ndName( nAnd      ) := "And";
    nOr              := 25; ndName( nOr           ) := "Or";
    MAX_NODE_TYPE    := 25; TEXT_MAX := 4095; textNext := 0;
    stList := idList := null;
    for nPos := 1 until MAX_NODE_TYPE do nOp( nPos ) := -1;
    nOp( nPrtc     ) := oPrtc; nOp( nPrts      ) := oPrts; nOp( nPrti    ) := oPrti; nOp( nNegate       ) := oNeg; nOp( nNot      ) := oNot;
    nOp( nMultiply ) := oMul;  nOp( nDivide    ) := oDiv;  nOp( nMod     ) := oMod;  nOp( nAdd          ) := oAdd; nOp( nSubtract ) := oSub;
    nOp( nLess     ) := oLt;   nOp( nLessEqual ) := oLe;   nOp( nGreater ) := oGt;   nOp( nGreaterEqual ) := oGe;  nOp( nEqual    ) := oEq;
    nOp( nNotEqual ) := oNe;   nOp( nAnd       ) := oAnd;  nOp( nOr      ) := oOr;
    nextLocation     := 0; MAX_LOCATION := 4095;
    for pc := 0 until MAX_LOCATION do byteCode( pc ) := 0;
    nextLabelNumber := 0; MAX_LABEL_NUMBER := 4096;
    for lPos := 1 until MAX_LABEL_NUMBER do labelLocation( lPos ) := 0;

    % parse the output from the syntax analyser and generate code from the parse tree %
    gen( readNode );
    genOp0( oHalt );
    emitCode
end.


function error(msg) {
  printf("%s\n", msg)
  exit(1)
}

function bytes_to_int(bstr,          i, sum) {
  sum = 0
  for (i=word_size-1; i>=0; i--) {
    sum *= 256
    sum += code[bstr+i]
  }
  return sum
}

function make_node(oper, left, right, value) {
  node_type [next_free_node_index] = oper
  node_left [next_free_node_index] = left
  node_right[next_free_node_index] = right
  node_value[next_free_node_index] = value
  return next_free_node_index ++
}

function make_leaf(oper, n) {
  return make_node(oper, 0, 0, n)
}

function emit_byte(x) {
  code[next_free_code_index++] = x
}

function emit_word(x,       i) {
  for (i=0; i<word_size; i++) {
    emit_byte(int(x)%256);
    x = int(x/256)
  }
}

function emit_word_at(at, n,             i) {
  for (i=0; i<word_size; i++) {
    code[at+i] = int(n)%256
    n = int(n/256)
  }
}

function hole(         t) {
  t = next_free_code_index
  emit_word(0)
  return t
}

function fetch_var_offset(name,       n) {
  if (name in globals) {
    n = globals[name]
  } else {
    globals[name] = globals_n
    n = globals_n
    globals_n += 1
  }
  return n
}

function fetch_string_offset(the_string,        n) {
  n = string_pool[the_string]
  if (n == "") {
    string_pool[the_string] = string_n
    n = string_n
    string_n += 1
  }
  return n
}

function code_gen(x,       n, p1, p2) {
  if (x == 0) {
    return
  } else if (node_type[x] == "nd_Ident") {
    emit_byte(FETCH)
    n = fetch_var_offset(node_value[x])
    emit_word(n)
  } else if (node_type[x] == "nd_Integer") {
    emit_byte(PUSH)
    emit_word(node_value[x])
  } else if (node_type[x] == "nd_String") {
    emit_byte(PUSH)
    n = fetch_string_offset(node_value[x])
    emit_word(n)
  } else if (node_type[x] == "nd_Assign") {
    n = fetch_var_offset(node_value[node_left[x]])
    code_gen(node_right[x])
    emit_byte(STORE)
    emit_word(n)
  } else if (node_type[x] == "nd_If") {
    code_gen(node_left[x])        # expr
    emit_byte(JZ)                 # if false, jump
    p1 = hole()                   # make room for jump dest
    code_gen(node_left[node_right[x]])        # if true statements
    if (node_right[node_right[x]] != 0) {
      emit_byte(JMP)            # jump over else statements
      p2 = hole()
    }
    emit_word_at(p1, next_free_code_index - p1)
    if (node_right[node_right[x]] != 0) {
      code_gen(node_right[node_right[x]])   # else statements
      emit_word_at(p2, next_free_code_index - p2)
    }
  } else if (node_type[x] == "nd_While") {
    p1 =next_free_code_index
    code_gen(node_left[x])
    emit_byte(JZ)
    p2 = hole()
    code_gen(node_right[x])
    emit_byte(JMP)                       # jump back to the top
    emit_word(p1 - next_free_code_index)
    emit_word_at(p2, next_free_code_index - p2)
  } else if (node_type[x] == "nd_Sequence") {
    code_gen(node_left[x])
    code_gen(node_right[x])
  } else if (node_type[x] == "nd_Prtc") {
    code_gen(node_left[x])
    emit_byte(PRTC)
  } else if (node_type[x] == "nd_Prti") {
    code_gen(node_left[x])
    emit_byte(PRTI)
  } else if (node_type[x] == "nd_Prts") {
    code_gen(node_left[x])
    emit_byte(PRTS)
  } else if (node_type[x] in operators) {
    code_gen(node_left[x])
    code_gen(node_right[x])
    emit_byte(operators[node_type[x]])
  } else if (node_type[x] in unary_operators) {
    code_gen(node_left[x])
    emit_byte(unary_operators[node_type[x]])
  } else {
    error("error in code generator - found '" node_type[x] "', expecting operator")
  }
}

function code_finish() {
  emit_byte(HALT)
}

function list_code() {
  printf("Datasize: %d Strings: %d\n", globals_n, string_n)
  # Make sure that arrays are sorted by value in ascending order.
  PROCINFO["sorted_in"] =  "@val_str_asc"
  # This is a dependency on GAWK.
  for (k in string_pool)
    print(k)
  pc = 0
  while (pc < next_free_code_index) {
    printf("%4d ", pc)
    op = code[pc]
    pc += 1
    if (op == FETCH) {
      x = bytes_to_int(pc)
      printf("fetch [%d]\n", x);
      pc += word_size
    } else if (op == STORE) {
      x = bytes_to_int(pc)
      printf("store [%d]\n", x);
      pc += word_size
    } else if (op == PUSH) {
      x = bytes_to_int(pc)
      printf("push  %d\n", x);
      pc += word_size
    } else if (op == ADD)  {  print("add")
    } else if (op == SUB)  {  print("sub")
    } else if (op == MUL)  {  print("mul")
    } else if (op == DIV)  {  print("div")
    } else if (op == MOD)  {  print("mod")
    } else if (op == LT)   {  print("lt")
    } else if (op == GT)   {  print("gt")
    } else if (op == LE)   {  print("le")
    } else if (op == GE)   {  print("ge")
    } else if (op == EQ)   {  print("eq")
    } else if (op == NE)   {  print("ne")
    } else if (op == AND)  {  print("and")
    } else if (op == OR)   {  print("or")
    } else if (op == NEG)  {  print("neg")
    } else if (op == NOT)  {  print("not")
    } else if (op == JMP)  {
      x = bytes_to_int(pc)
      printf("jmp    (%d) %d\n", x, pc + x);
      pc += word_size
    } else if (op == JZ)  {
      x = bytes_to_int(pc)
      printf("jz     (%d) %d\n", x, pc + x);
      pc += word_size
    } else if (op == PRTC) { print("prtc")
    } else if (op == PRTI) { print("prti")
    } else if (op == PRTS) { print("prts")
    } else if (op == HALT) { print("halt")
    } else                 { error("list_code: Unknown opcode '" op "'")
    }
  } # while pc
}

function load_ast(        line, line_list, text, n, node_type, value, left, right) {
  getline line
  n=split(line, line_list)
  text = line_list[1]
  if (text == ";")
    return 0
  node_type = all_syms[text]
  if (n > 1) {
    value = line_list[2]
    for (i=3;i<=n;i++)
      value = value " " line_list[i]
    if (value ~ /^[0-9]+$/)
      value = int(value)
    return make_leaf(node_type, value)
  }
  left = load_ast()
  right = load_ast()
  return make_node(node_type, left, right)
}

BEGIN {
  all_syms["Identifier"  ] = "nd_Ident"
  all_syms["String"      ] = "nd_String"
  all_syms["Integer"     ] = "nd_Integer"
  all_syms["Sequence"    ] = "nd_Sequence"
  all_syms["If"          ] = "nd_If"
  all_syms["Prtc"        ] = "nd_Prtc"
  all_syms["Prts"        ] = "nd_Prts"
  all_syms["Prti"        ] = "nd_Prti"
  all_syms["While"       ] = "nd_While"
  all_syms["Assign"      ] = "nd_Assign"
  all_syms["Negate"      ] = "nd_Negate"
  all_syms["Not"         ] = "nd_Not"
  all_syms["Multiply"    ] = "nd_Mul"
  all_syms["Divide"      ] = "nd_Div"
  all_syms["Mod"         ] = "nd_Mod"
  all_syms["Add"         ] = "nd_Add"
  all_syms["Subtract"    ] = "nd_Sub"
  all_syms["Less"        ] = "nd_Lss"
  all_syms["LessEqual"   ] = "nd_Leq"
  all_syms["Greater"     ] = "nd_Gtr"
  all_syms["GreaterEqual"] = "nd_Geq"
  all_syms["Equal"       ] = "nd_Eql"
  all_syms["NotEqual"    ] = "nd_Neq"
  all_syms["And"         ] = "nd_And"
  all_syms["Or"          ] = "nd_Or"

  FETCH=1; STORE=2; PUSH=3; ADD=4; SUB=5; MUL=6;
  DIV=7; MOD=8; LT=9; GT=10; LE=11; GE=12;
  EQ=13; NE=14; AND=15; OR=16; NEG=17; NOT=18;
  JMP=19; JZ=20; PRTC=21; PRTS=22; PRTI=23; HALT=24;

  operators["nd_Lss"] = LT
  operators["nd_Gtr"] = GT
  operators["nd_Leq"] = LE
  operators["nd_Geq"] = GE
  operators["nd_Eql"] = EQ
  operators["nd_Neq"] = NE
  operators["nd_And"] = AND
  operators["nd_Or" ] = OR
  operators["nd_Sub"] = SUB
  operators["nd_Add"] = ADD
  operators["nd_Div"] = DIV
  operators["nd_Mul"] = MUL
  operators["nd_Mod"] = MOD

  unary_operators["nd_Negate"] = NEG
  unary_operators["nd_Not"   ] = NOT

  next_free_node_index = 1
  next_free_code_index = 0
  globals_n   = 0
  string_n    = 0
  word_size   = 4
  input_file = "-"

  if (ARGC > 1)
    input_file = ARGV[1]
  n = load_ast()
  code_gen(n)
  code_finish()
  list_code()
}


from __future__ import print_function
import sys, struct

FETCH, STORE, PUSH, ADD, SUB, MUL, DIV, MOD, LT, GT, LE, GE, EQ, NE, AND, OR, NEG, NOT, \
JMP, JZ, PRTC, PRTS, PRTI, HALT = range(24)

code_map = {
    "fetch": FETCH,
    "store": STORE,
    "push":  PUSH,
    "add":   ADD,
    "sub":   SUB,
    "mul":   MUL,
    "div":   DIV,
    "mod":   MOD,
    "lt":    LT,
    "gt":    GT,
    "le":    LE,
    "ge":    GE,
    "eq":    EQ,
    "ne":    NE,
    "and":   AND,
    "or":    OR,
    "not":   NOT,
    "neg":   NEG,
    "jmp":   JMP,
    "jz":    JZ,
    "prtc":  PRTC,
    "prts":  PRTS,
    "prti":  PRTI,
    "halt":  HALT
}

input_file  = None
code        = bytearray()
string_pool = []
word_size   = 4

#*** show error and exit
def error(msg):
    print("%s" % (msg))
    exit(1)

def int_to_bytes(val):
    return struct.pack("<i", val)

def bytes_to_int(bstr):
    return struct.unpack("<i", bstr)

#***
def emit_byte(x):
    code.append(x)

#***
def emit_word(x):
    s = int_to_bytes(x)
    for x in s:
        code.append(x)

#***
def run_vm(data_size):
    stack = [0 for i in range(data_size + 1)]
    pc = 0
    while True:
        op = code[pc]
        pc += 1

        if op == FETCH:
            stack.append(stack[bytes_to_int(code[pc:pc+word_size])[0]]);
            pc += word_size
        elif op == STORE:
            stack[bytes_to_int(code[pc:pc+word_size])[0]] = stack.pop();
            pc += word_size
        elif op == PUSH:
            stack.append(bytes_to_int(code[pc:pc+word_size])[0]);
            pc += word_size
        elif op == ADD:   stack[-2] += stack[-1]; stack.pop()
        elif op == SUB:   stack[-2] -= stack[-1]; stack.pop()
        elif op == MUL:   stack[-2] *= stack[-1]; stack.pop()
        # use C like division semantics
        elif op == DIV:   stack[-2] = int(float(stack[-2]) / stack[-1]); stack.pop()
        elif op == MOD:   stack[-2] = int(float(stack[-2]) % stack[-1]); stack.pop()
        elif op == LT:    stack[-2] = stack[-2] <  stack[-1]; stack.pop()
        elif op == GT:    stack[-2] = stack[-2] >  stack[-1]; stack.pop()
        elif op == LE:    stack[-2] = stack[-2] <= stack[-1]; stack.pop()
        elif op == GE:    stack[-2] = stack[-2] >= stack[-1]; stack.pop()
        elif op == EQ:    stack[-2] = stack[-2] == stack[-1]; stack.pop()
        elif op == NE:    stack[-2] = stack[-2] != stack[-1]; stack.pop()
        elif op == AND:   stack[-2] = stack[-2] and stack[-1]; stack.pop()
        elif op == OR:    stack[-2] = stack[-2] or  stack[-1]; stack.pop()
        elif op == NEG:   stack[-1] = -stack[-1]
        elif op == NOT:   stack[-1] = not stack[-1]
        elif op == JMP:   pc += bytes_to_int(code[pc:pc+word_size])[0]
        elif op == JZ:
            if stack.pop():
                pc += word_size
            else:
                pc += bytes_to_int(code[pc:pc+word_size])[0]
        elif op == PRTC:  print("%c" % (stack[-1]), end=''); stack.pop()
        elif op == PRTS:  print("%s" % (string_pool[stack[-1]]), end=''); stack.pop()
        elif op == PRTI:  print("%d" % (stack[-1]), end=''); stack.pop()
        elif op == HALT:  break

def str_trans(srce):
    dest = ""
    i = 0
    while i < len(srce):
        if srce[i] == '\\' and i + 1 < len(srce):
            if srce[i + 1] == 'n':
                dest += '\n'
                i += 2
            elif srce[i + 1] == '\\':
                dest += '\\'
                i += 2
        else:
            dest += srce[i]
            i += 1

    return dest

#***
def load_code():
    global string_pool

    line = input_file.readline()
    if len(line) == 0:
        error("empty line")

    line_list = line.split()
    data_size = int(line_list[1])
    n_strings = int(line_list[3])

    for i in range(n_strings):
        string_pool.append(str_trans(input_file.readline().strip('"\n')))

    while True:
        line = input_file.readline()
        if len(line) == 0:
            break
        line_list = line.split()
        offset = int(line_list[0])
        instr  = line_list[1]
        opcode = code_map.get(instr)
        if opcode == None:
            error("Unknown instruction %s at %d" % (instr, offset))
        emit_byte(opcode)
        if opcode in [JMP, JZ]:
            p = int(line_list[3])
            emit_word(p - (offset + 1))
        elif opcode == PUSH:
            value = int(line_list[2])
            emit_word(value)
        elif opcode in [FETCH, STORE]:
            value = int(line_list[2].strip('[]'))
            emit_word(value)

    return data_size

#*** main driver
input_file = sys.stdin
if len(sys.argv) > 1:
    try:
        input_file = open(sys.argv[1], "r", 4096)
    except IOError as e:
        error(0, 0, "Can't open %s" % sys.argv[1])

data_size = load_code()
run_vm(data_size)


require'regex'
commatize=:3 :0"1 L:1 0
  (i.0) commatize y
:
NB. deal with all those rules about options
  opts=. boxopen x
  char=. (#~ ' '&[email protected]{[email protected](0&#)@>) opts
  num=. ;opts-.char
  delim=. 0 {:: char,<','
  'begin period'=. _1 0+2{.num,(#num)}.1 3
NB. initialize
  prefix=. begin {.y
  text=. begin }. y
NB. process
  'start len'=. ,'[1-9][0-9]*' rxmatch text
  if.0=len do. y return. end.
  number=. (start,:len) [;.0 text
  numb=. (>:period|<:#number){.number
  fixed=. numb,;delim&,each (-period)<\ (#numb)}.number
  prefix,(start{.text),fixed,(start+len)}.text
)


import java.io.File;
import java.util.*;
import java.util.regex.*;

public class CommatizingNumbers {

    public static void main(String[] args) throws Exception {
        commatize("pi=3.14159265358979323846264338327950288419716939937510582"
                + "097494459231", 6, 5, " ");

        commatize("The author has two Z$100000000000000 Zimbabwe notes (100 "
                + "trillion).", 0, 3, ".");

        try (Scanner sc = new Scanner(new File("input.txt"))) {
            while(sc.hasNext())
                commatize(sc.nextLine());
        }
    }

    static void commatize(String s) {
        commatize(s, 0, 3, ",");
    }

    static void commatize(String s, int start, int step, String ins) {
        if (start < 0 || start > s.length() || step < 1 || step > s.length())
            return;

        Matcher m = Pattern.compile("([1-9][0-9]*)").matcher(s.substring(start));
        StringBuffer result = new StringBuffer(s.substring(0, start));

        if (m.find()) {
            StringBuilder sb = new StringBuilder(m.group(1)).reverse();
            for (int i = step; i < sb.length(); i += step)
                sb.insert(i++, ins);
            m.appendReplacement(result, sb.reverse().toString());
        }

        System.out.println(m.appendTail(result));
    }
}


#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <stdarg.h>
#include <stdint.h>
#include <ctype.h>

typedef unsigned char uchar;

typedef enum {
    nd_Ident, nd_String, nd_Integer, nd_Sequence, nd_If, nd_Prtc, nd_Prts, nd_Prti, nd_While,
    nd_Assign, nd_Negate, nd_Not, nd_Mul, nd_Div, nd_Mod, nd_Add, nd_Sub, nd_Lss, nd_Leq,
    nd_Gtr, nd_Geq, nd_Eql, nd_Neq, nd_And, nd_Or
} NodeType;

typedef enum { FETCH, STORE, PUSH, ADD, SUB, MUL, DIV, MOD, LT, GT, LE, GE, EQ, NE, AND,
    OR, NEG, NOT, JMP, JZ, PRTC, PRTS, PRTI, HALT
} Code_t;

typedef uchar code;

typedef struct Tree {
    NodeType node_type;
    struct Tree *left;
    struct Tree *right;
    char *value;
} Tree;

#define da_dim(name, type)  type *name = NULL;          \
                            int _qy_ ## name ## _p = 0;  \
                            int _qy_ ## name ## _max = 0

#define da_redim(name)      do {if (_qy_ ## name ## _p >= _qy_ ## name ## _max) \
                                name = realloc(name, (_qy_ ## name ## _max += 32) * sizeof(name[0]));} while (0)

#define da_rewind(name)     _qy_ ## name ## _p = 0

#define da_append(name, x)  do {da_redim(name); name[_qy_ ## name ## _p++] = x;} while (0)
#define da_len(name)        _qy_ ## name ## _p
#define da_add(name)        do {da_redim(name); _qy_ ## name ## _p++;} while (0)

FILE *source_fp, *dest_fp;
static int here;
da_dim(object, code);
da_dim(globals, const char *);
da_dim(string_pool, const char *);

// dependency: Ordered by NodeType, must remain in same order as NodeType enum
struct {
    char       *enum_text;
    NodeType   node_type;
    Code_t     opcode;
} atr[] = {
    {"Identifier"  , nd_Ident,    -1 },
    {"String"      , nd_String,   -1 },
    {"Integer"     , nd_Integer,  -1 },
    {"Sequence"    , nd_Sequence, -1 },
    {"If"          , nd_If,       -1 },
    {"Prtc"        , nd_Prtc,     -1 },
    {"Prts"        , nd_Prts,     -1 },
    {"Prti"        , nd_Prti,     -1 },
    {"While"       , nd_While,    -1 },
    {"Assign"      , nd_Assign,   -1 },
    {"Negate"      , nd_Negate,   NEG},
    {"Not"         , nd_Not,      NOT},
    {"Multiply"    , nd_Mul,      MUL},
    {"Divide"      , nd_Div,      DIV},
    {"Mod"         , nd_Mod,      MOD},
    {"Add"         , nd_Add,      ADD},
    {"Subtract"    , nd_Sub,      SUB},
    {"Less"        , nd_Lss,      LT },
    {"LessEqual"   , nd_Leq,      LE },
    {"Greater"     , nd_Gtr,      GT },
    {"GreaterEqual", nd_Geq,      GE },
    {"Equal"       , nd_Eql,      EQ },
    {"NotEqual"    , nd_Neq,      NE },
    {"And"         , nd_And,      AND},
    {"Or"          , nd_Or,       OR },
};

void error(const char *fmt, ... ) {
    va_list ap;
    char buf[1000];

    va_start(ap, fmt);
    vsprintf(buf, fmt, ap);
    va_end(ap);
    printf("error: %s\n", buf);
    exit(1);
}

Code_t type_to_op(NodeType type) {
    return atr[type].opcode;
}

Tree *make_node(NodeType node_type, Tree *left, Tree *right) {
    Tree *t = calloc(sizeof(Tree), 1);
    t->node_type = node_type;
    t->left = left;
    t->right = right;
    return t;
}

Tree *make_leaf(NodeType node_type, char *value) {
    Tree *t = calloc(sizeof(Tree), 1);
    t->node_type = node_type;
    t->value = strdup(value);
    return t;
}

/*** Code generator ***/

void emit_byte(int c) {
    da_append(object, (uchar)c);
    ++here;
}

void emit_int(int32_t n) {
    union {
        int32_t n;
        unsigned char c[sizeof(int32_t)];
    } x;

    x.n = n;

    for (size_t i = 0; i < sizeof(x.n); ++i) {
        emit_byte(x.c[i]);
    }
}

int hole() {
    int t = here;
    emit_int(0);
    return t;
}

void fix(int src, int dst) {
    *(int32_t *)(object + src) = dst-src;
}

int fetch_var_offset(const char *id) {
    for (int i = 0; i < da_len(globals); ++i) {
        if (strcmp(id, globals[i]) == 0)
            return i;
    }
    da_add(globals);
    int n = da_len(globals) - 1;
    globals[n] = strdup(id);
    return n;
}

int fetch_string_offset(const char *st) {
    for (int i = 0; i < da_len(string_pool); ++i) {
        if (strcmp(st, string_pool[i]) == 0)
            return i;
    }
    da_add(string_pool);
    int n = da_len(string_pool) - 1;
    string_pool[n] = strdup(st);
    return n;
}

void code_gen(Tree *x) {
    int p1, p2, n;

    if (x == NULL) return;
    switch (x->node_type) {
        case nd_Ident:
            emit_byte(FETCH);
            n = fetch_var_offset(x->value);
            emit_int(n);
            break;
        case nd_Integer:
            emit_byte(PUSH);
            emit_int(atoi(x->value));
            break;
        case nd_String:
            emit_byte(PUSH);
            n = fetch_string_offset(x->value);
            emit_int(n);
            break;
        case nd_Assign:
            n = fetch_var_offset(x->left->value);
            code_gen(x->right);
            emit_byte(STORE);
            emit_int(n);
            break;
        case nd_If:
            code_gen(x->left);        // if expr
            emit_byte(JZ);                  // if false, jump
            p1 = hole();                    // make room for jump dest
            code_gen(x->right->left);   // if true statements
            if (x->right->right != NULL) {
                emit_byte(JMP);
                p2 = hole();
            }
            fix(p1, here);
            if (x->right->right != NULL) {
                code_gen(x->right->right);
                fix(p2, here);
            }
            break;
        case nd_While:
            p1 = here;
            code_gen(x->left);        // while expr
            emit_byte(JZ);                  // if false, jump
            p2 = hole();                    // make room for jump dest
            code_gen(x->right);       // statements
            emit_byte(JMP);                 // back to the top
            fix(hole(), p1);                // plug the top
            fix(p2, here);                  // plug the 'if false, jump'
            break;
        case nd_Sequence:
            code_gen(x->left);
            code_gen(x->right);
            break;
        case nd_Prtc:
            code_gen(x->left);
            emit_byte(PRTC);
            break;
        case nd_Prti:
            code_gen(x->left);
            emit_byte(PRTI);
            break;
        case nd_Prts:
            code_gen(x->left);
            emit_byte(PRTS);
            break;
        case nd_Lss: case nd_Gtr: case nd_Leq: case nd_Geq: case nd_Eql: case nd_Neq:
        case nd_And: case nd_Or: case nd_Sub: case nd_Add: case nd_Div: case nd_Mul:
        case nd_Mod:
            code_gen(x->left);
            code_gen(x->right);
            emit_byte(type_to_op(x->node_type));
            break;
        case nd_Negate: case nd_Not:
            code_gen(x->left);
            emit_byte(type_to_op(x->node_type));
            break;
        default:
            error("error in code generator - found %d, expecting operator\n", x->node_type);
    }
}

void code_finish() {
    emit_byte(HALT);
}

void list_code() {
    fprintf(dest_fp, "Datasize: %d Strings: %d\n", da_len(globals), da_len(string_pool));
    for (int i = 0; i < da_len(string_pool); ++i)
        fprintf(dest_fp, "%s\n", string_pool[i]);

    code *pc = object;

    again: fprintf(dest_fp, "%5d ", (int)(pc - object));
    switch (*pc++) {
        case FETCH: fprintf(dest_fp, "fetch [%d]\n", *(int32_t *)pc);
                    pc += sizeof(int32_t);  goto again;
        case STORE: fprintf(dest_fp, "store [%d]\n", *(int32_t *)pc);
                    pc += sizeof(int32_t);  goto again;
        case PUSH : fprintf(dest_fp, "push  %d\n", *(int32_t *)pc);
                    pc += sizeof(int32_t);    goto again;
        case ADD  : fprintf(dest_fp, "add\n");      goto again;
        case SUB  : fprintf(dest_fp, "sub\n");      goto again;
        case MUL  : fprintf(dest_fp, "mul\n");      goto again;
        case DIV  : fprintf(dest_fp, "div\n");      goto again;
        case MOD  : fprintf(dest_fp, "mod\n");      goto again;
        case LT   : fprintf(dest_fp, "lt\n");       goto again;
        case GT   : fprintf(dest_fp, "gt\n");       goto again;
        case LE   : fprintf(dest_fp, "le\n");       goto again;
        case GE   : fprintf(dest_fp, "ge\n");       goto again;
        case EQ   : fprintf(dest_fp, "eq\n");       goto again;
        case NE   : fprintf(dest_fp, "ne\n");       goto again;
        case AND  : fprintf(dest_fp, "and\n");      goto again;
        case OR   : fprintf(dest_fp, "or\n");       goto again;
        case NOT  : fprintf(dest_fp, "not\n");      goto again;
        case NEG  : fprintf(dest_fp, "neg\n");      goto again;
        case JMP  : fprintf(dest_fp, "jmp    (%d) %d\n",
                        *(int32_t *)pc, (int32_t)(pc + *(int32_t *)pc - object));
                    pc += sizeof(int32_t); goto again;
        case JZ   : fprintf(dest_fp, "jz     (%d) %d\n",
                        *(int32_t *)pc, (int32_t)(pc + *(int32_t *)pc - object));
                    pc += sizeof(int32_t); goto again;
        case PRTC : fprintf(dest_fp, "prtc\n");     goto again;
        case PRTI : fprintf(dest_fp, "prti\n");     goto again;
        case PRTS : fprintf(dest_fp, "prts\n");     goto again;
        case HALT : fprintf(dest_fp, "halt\n");     break;
        default:error("listcode:Unknown opcode %d\n", *(pc - 1));
    }
}

void init_io(FILE **fp, FILE *std, const char mode[], const char fn[]) {
    if (fn[0] == '\0')
        *fp = std;
    else if ((*fp = fopen(fn, mode)) == NULL)
        error(0, 0, "Can't open %s\n", fn);
}

NodeType get_enum_value(const char name[]) {
    for (size_t i = 0; i < sizeof(atr) / sizeof(atr[0]); i++) {
        if (strcmp(atr[i].enum_text, name) == 0) {
            return atr[i].node_type;
        }
    }
    error("Unknown token %s\n", name);
    return -1;
}

char *read_line(int *len) {
    static char *text = NULL;
    static int textmax = 0;

    for (*len = 0; ; (*len)++) {
        int ch = fgetc(source_fp);
        if (ch == EOF || ch == '\n') {
            if (*len == 0)
                return NULL;
            break;
        }
        if (*len + 1 >= textmax) {
            textmax = (textmax == 0 ? 128 : textmax * 2);
            text = realloc(text, textmax);
        }
        text[*len] = ch;
    }
    text[*len] = '\0';
    return text;
}

char *rtrim(char *text, int *len) {         // remove trailing spaces
    for (; *len > 0 && isspace(text[*len - 1]); --(*len))
        ;

    text[*len] = '\0';
    return text;
}

Tree *load_ast() {
    int len;
    char *yytext = read_line(&len);
    yytext = rtrim(yytext, &len);

    // get first token
    char *tok = strtok(yytext, " ");

    if (tok[0] == ';') {
        return NULL;
    }
    NodeType node_type = get_enum_value(tok);

    // if there is extra data, get it
    char *p = tok + strlen(tok);
    if (p != &yytext[len]) {
        for (++p; isspace(*p); ++p)
            ;
        return make_leaf(node_type, p);
    }

    Tree *left  = load_ast();
    Tree *right = load_ast();
    return make_node(node_type, left, right);
}

int main(int argc, char *argv[]) {
    init_io(&source_fp, stdin,  "r",  argc > 1 ? argv[1] : "");
    init_io(&dest_fp,   stdout, "wb", argc > 2 ? argv[2] : "");

    code_gen(load_ast());
    code_finish();
    list_code();

    return 0;
}