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

#define NELEMS(arr) (sizeof(arr) / sizeof(arr[0]))

typedef enum {
    tk_EOI, tk_Mul, tk_Div, tk_Mod, tk_Add, tk_Sub, tk_Negate, tk_Not, tk_Lss, tk_Leq, tk_Gtr,
    tk_Geq, tk_Eql, tk_Neq, tk_Assign, tk_And, tk_Or, tk_If, tk_Else, tk_While, tk_Print,
    tk_Putc, tk_Lparen, tk_Rparen, tk_Lbrace, tk_Rbrace, tk_Semi, tk_Comma, tk_Ident,
    tk_Integer, tk_String
} TokenType;

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 struct {
    TokenType tok;
    int err_ln;
    int err_col;
    char *text;             /* ident or string literal or integer value */
} tok_s;

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

// dependency: Ordered by tok, must remain in same order as TokenType enum
struct {
    char       *text, *enum_text;
    TokenType   tok;
    bool        right_associative, is_binary, is_unary;
    int         precedence;
    NodeType    node_type;
} atr[] = {
    {"EOI",             "End_of_input"   , tk_EOI,     false, false, false, -1, -1        },
    {"*",               "Op_multiply"    , tk_Mul,     false, true,  false, 13, nd_Mul    },
    {"/",               "Op_divide"      , tk_Div,     false, true,  false, 13, nd_Div    },
    {"%",               "Op_mod"         , tk_Mod,     false, true,  false, 13, nd_Mod    },
    {"+",               "Op_add"         , tk_Add,     false, true,  false, 12, nd_Add    },
    {"-",               "Op_subtract"    , tk_Sub,     false, true,  false, 12, nd_Sub    },
    {"-",               "Op_negate"      , tk_Negate,  false, false, true,  14, nd_Negate },
    {"!",               "Op_not"         , tk_Not,     false, false, true,  14, nd_Not    },
    {"<",               "Op_less"        , tk_Lss,     false, true,  false, 10, nd_Lss    },
    {"<=",              "Op_lessequal"   , tk_Leq,     false, true,  false, 10, nd_Leq    },
    {">",               "Op_greater"     , tk_Gtr,     false, true,  false, 10, nd_Gtr    },
    {">=",              "Op_greaterequal", tk_Geq,     false, true,  false, 10, nd_Geq    },
    {"==",              "Op_equal"       , tk_Eql,     false, true,  false,  9, nd_Eql    },
    {"!=",              "Op_notequal"    , tk_Neq,     false, true,  false,  9, nd_Neq    },
    {"=",               "Op_assign"      , tk_Assign,  false, false, false, -1, nd_Assign },
    {"&&",              "Op_and"         , tk_And,     false, true,  false,  5, nd_And    },
    {"||",              "Op_or"          , tk_Or,      false, true,  false,  4, nd_Or     },
    {"if",              "Keyword_if"     , tk_If,      false, false, false, -1, nd_If     },
    {"else",            "Keyword_else"   , tk_Else,    false, false, false, -1, -1        },
    {"while",           "Keyword_while"  , tk_While,   false, false, false, -1, nd_While  },
    {"print",           "Keyword_print"  , tk_Print,   false, false, false, -1, -1        },
    {"putc",            "Keyword_putc"   , tk_Putc,    false, false, false, -1, -1        },
    {"(",               "LeftParen"      , tk_Lparen,  false, false, false, -1, -1        },
    {")",               "RightParen"     , tk_Rparen,  false, false, false, -1, -1        },
    {"{",               "LeftBrace"      , tk_Lbrace,  false, false, false, -1, -1        },
    {"}",               "RightBrace"     , tk_Rbrace,  false, false, false, -1, -1        },
    {";",               "Semicolon"      , tk_Semi,    false, false, false, -1, -1        },
    {",",               "Comma"          , tk_Comma,   false, false, false, -1, -1        },
    {"Ident",           "Identifier"     , tk_Ident,   false, false, false, -1, nd_Ident  },
    {"Integer literal", "Integer"        , tk_Integer, false, false, false, -1, nd_Integer},
    {"String literal",  "String"         , tk_String,  false, false, false, -1, nd_String },
};

char *Display_nodes[] = {"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"};

static tok_s tok;
static FILE *source_fp, *dest_fp;

Tree *paren_expr();

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

    va_start(ap, fmt);
    vsprintf(buf, fmt, ap);
    va_end(ap);
    printf("(%d, %d) error: %s\n", err_line, err_col, buf);
    exit(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;
}

TokenType get_enum(const char *name) {      // return internal version of name
    for (size_t i = 0; i < NELEMS(atr); i++) {
        if (strcmp(atr[i].enum_text, name) == 0)
            return atr[i].tok;
    }
    error(0, 0, "Unknown token %s\n", name);
    return 0;
}

tok_s gettok() {
    int len;
    tok_s tok;
    char *yytext = read_line(&len);
    yytext = rtrim(yytext, &len);

    // [ ]*{lineno}[ ]+{colno}[ ]+token[ ]+optional

    // get line and column
    tok.err_ln  = atoi(strtok(yytext, " "));
    tok.err_col = atoi(strtok(NULL, " "));

    // get the token name
    char *name = strtok(NULL, " ");
    tok.tok = get_enum(name);

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

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;
}

void expect(const char msg[], TokenType s) {
    if (tok.tok == s) {
        tok = gettok();
        return;
    }
    error(tok.err_ln, tok.err_col, "%s: Expecting '%s', found '%s'\n", msg, atr[s].text, atr[tok.tok].text);
}

Tree *expr(int p) {
    Tree *x = NULL, *node;
    TokenType op;

    switch (tok.tok) {
        case tk_Lparen:
            x = paren_expr();
            break;
        case tk_Sub: case tk_Add:
            op = tok.tok;
            tok = gettok();
            node = expr(atr[tk_Negate].precedence);
            x = (op == tk_Sub) ? make_node(nd_Negate, node, NULL) : node;
            break;
        case tk_Not:
            tok = gettok();
            x = make_node(nd_Not, expr(atr[tk_Not].precedence), NULL);
            break;
        case tk_Ident:
            x = make_leaf(nd_Ident, tok.text);
            tok = gettok();
            break;
        case tk_Integer:
            x = make_leaf(nd_Integer, tok.text);
            tok = gettok();
            break;
        default:
            error(tok.err_ln, tok.err_col, "Expecting a primary, found: %s\n", atr[tok.tok].text);
    }

    while (atr[tok.tok].is_binary && atr[tok.tok].precedence >= p) {
        TokenType op = tok.tok;

        tok = gettok();

        int q = atr[op].precedence;
        if (!atr[op].right_associative)
            q++;

        node = expr(q);
        x = make_node(atr[op].node_type, x, node);
    }
    return x;
}

Tree *paren_expr() {
    expect("paren_expr", tk_Lparen);
    Tree *t = expr(0);
    expect("paren_expr", tk_Rparen);
    return t;
}

Tree *stmt() {
    Tree *t = NULL, *v, *e, *s, *s2;

    switch (tok.tok) {
        case tk_If:
            tok = gettok();
            e = paren_expr();
            s = stmt();
            s2 = NULL;
            if (tok.tok == tk_Else) {
                tok = gettok();
                s2 = stmt();
            }
            t = make_node(nd_If, e, make_node(nd_If, s, s2));
            break;
        case tk_Putc:
            tok = gettok();
            e = paren_expr();
            t = make_node(nd_Prtc, e, NULL);
            expect("Putc", tk_Semi);
            break;
        case tk_Print: /* print '(' expr {',' expr} ')' */
            tok = gettok();
            for (expect("Print", tk_Lparen); ; expect("Print", tk_Comma)) {
                if (tok.tok == tk_String) {
                    e = make_node(nd_Prts, make_leaf(nd_String, tok.text), NULL);
                    tok = gettok();
                } else
                    e = make_node(nd_Prti, expr(0), NULL);

                t = make_node(nd_Sequence, t, e);

                if (tok.tok != tk_Comma)
                    break;
            }
            expect("Print", tk_Rparen);
            expect("Print", tk_Semi);
            break;
        case tk_Semi:
            tok = gettok();
            break;
        case tk_Ident:
            v = make_leaf(nd_Ident, tok.text);
            tok = gettok();
            expect("assign", tk_Assign);
            e = expr(0);
            t = make_node(nd_Assign, v, e);
            expect("assign", tk_Semi);
            break;
        case tk_While:
            tok = gettok();
            e = paren_expr();
            s = stmt();
            t = make_node(nd_While, e, s);
            break;
        case tk_Lbrace:         /* {stmt} */
            for (expect("Lbrace", tk_Lbrace); tok.tok != tk_Rbrace && tok.tok != tk_EOI;)
                t = make_node(nd_Sequence, t, stmt());
            expect("Lbrace", tk_Rbrace);
            break;
        case tk_EOI:
            break;
        default: error(tok.err_ln, tok.err_col, "expecting start of statement, found '%s'\n", atr[tok.tok].text);
    }
    return t;
}

Tree *parse() {
    Tree *t = NULL;

    tok = gettok();
    do {
        t = make_node(nd_Sequence, t, stmt());
    } while (t != NULL && tok.tok != tk_EOI);
    return t;
}

void prt_ast(Tree *t) {
    if (t == NULL)
        printf(";\n");
    else {
        printf("%-14s ", Display_nodes[t->node_type]);
        if (t->node_type == nd_Ident || t->node_type == nd_Integer || t->node_type == nd_String) {
            printf("%s\n", t->value);
        } else {
            printf("\n");
            prt_ast(t->left);
            prt_ast(t->right);
        }
    }
}

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);
}

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] : "");
    prt_ast(parse());
}


(import (scheme base)
        (scheme char)
        (scheme file)
        (scheme process-context)
        (scheme write)
        (only (srfi 13) string-contains string-delete string-filter
              string-replace string-tokenize))

(define *word-size* 4)

;; Mappings from operation symbols to internal procedures.
;; We define operations appropriate to virtual machine:
;; e.g. division must return an int, not a rational
;; boolean values are treated as numbers: 0 is false, other is true
(define *unary-ops*
  (list (cons 'neg (lambda (a) (- a)))
        (cons 'not (lambda (a) (if (zero? a) 1 0)))))
(define *binary-ops*
  (let ((number-comp (lambda (op) (lambda (a b) (if (op a b) 1 0)))))
    (list (cons 'add +)
          (cons 'sub -)
          (cons 'mul *)
          (cons 'div (lambda (a b) (truncate (/ a b)))) ; int division
          (cons 'mod modulo)
          (cons 'lt (number-comp <))
          (cons 'gt (number-comp >))
          (cons 'le (number-comp <=))
          (cons 'ge (number-comp >=))
          (cons 'eq (lambda (a b) (if (= a b) 1 0)))
          (cons 'ne (lambda (a b) (if (= a b) 0 1)))
          (cons 'and (lambda (a b) ; make "and" work on numbers
                       (if (and (not (zero? a)) (not (zero? b))) 1 0)))
          (cons 'or (lambda (a b) ; make "or" work on numbers
                      (if (or (not (zero? a)) (not (zero? b))) 1 0))))))

;; read information from file, returning vectors for data and strings
;; and a list of the code instructions
(define (read-code filename)
  (define (setup-definitions str)
    (values ; return vectors for (data strings) of required size
      (make-vector (string->number (list-ref str 1)) #f)
      (make-vector (string->number (list-ref str 3)) #f)))
  (define (read-strings strings) ; read constant strings into data structure
    (define (replace-newlines chars) ; replace newlines, obeying \\n
      (cond ((< (length chars) 2) ; finished list
             chars)
            ((and (>= (length chars) 3) ; preserve \\n
                  (char=? #\\ (car chars))
                  (char=? #\\ (cadr chars))
                  (char=? #\n (cadr (cdr chars))))
             (cons (car chars)
                   (cons (cadr chars)
                         (cons (cadr (cdr chars))
                               (replace-newlines (cdr (cdr (cdr chars))))))))
            ((and (char=? #\\ (car chars)) ; replace \n with newline
                  (char=? #\n (cadr chars)))
             (cons #\newline (replace-newlines (cdr (cdr chars)))))
            (else ; keep char and look further
              (cons (car chars) (replace-newlines (cdr chars))))))
    (define (tidy-string str) ; remove quotes, map newlines to actual newlines
      (list->string
        (replace-newlines
          (string->list
            (string-delete #\" str))))) ; " (needed to satisfy rosettacode's scheme syntax highlighter)
    ;
    (do ((i 0 (+ i 1)))
      ((= i (vector-length strings)) )
      (vector-set! strings i (tidy-string (read-line)))))
  (define (read-code)
    (define (cleanup-code opn) ; tidy instructions, parsing numbers
      (let ((addr (string->number (car opn)))
            (instr (string->symbol (cadr opn))))
        (cond ((= 2 (length opn))
               (list addr instr))
              ((= 3 (length opn))
               (list addr
                     instr
                     (string->number
                       (string-filter char-numeric? (list-ref opn 2)))))
              (else ; assume length 4, jump instructions
                (list addr instr (string->number (list-ref opn 3)))))))
    ;
    (let loop ((result '()))
      (let ((line (read-line)))
        (if (eof-object? line)
          (reverse (map cleanup-code result))
          (loop (cons (string-tokenize line) result))))))
  ;
  (with-input-from-file
    filename
    (lambda ()
      (let-values (((data strings)
                    (setup-definitions (string-tokenize (read-line)))))
                  (read-strings strings)
                  (values data
                          strings
                          (read-code))))))

;; run the virtual machine
(define (run-program data strings code)
  (define (get-instruction n)
    (if (assq n code)
      (cdr (assq n code))
      (error "Could not find instruction")))
  ;
  (let loop ((stack '())
             (pc 0))
    (let ((op (get-instruction pc)))
      (case (car op)
        ((fetch)
         (loop (cons (vector-ref data (cadr op)) stack)
               (+ pc 1 *word-size*)))
        ((store)
         (vector-set! data (cadr op) (car stack))
         (loop (cdr stack)
               (+ pc 1 *word-size*)))
        ((push)
         (loop (cons (cadr op) stack)
               (+ pc 1 *word-size*)))
        ((add sub mul div mod lt gt le eq ne and or)
         (let ((instr (assq (car op) *binary-ops*)))
           (if instr
             (loop (cons ((cdr instr) (cadr stack) ; replace top two with result
                                      (car stack))
                         (cdr (cdr stack)))
                   (+ pc 1))
             (error "Unknown binary operation"))))
        ((neg not)
         (let ((instr (assq (car op) *unary-ops*)))
           (if instr
             (loop (cons ((cdr instr) (car stack)) ; replace top with result
                         (cdr stack))
                   (+ pc 1))
             (error "Unknown unary operation"))))
        ((jmp)
         (loop stack
               (cadr op)))
        ((jz)
         (loop (cdr stack)
               (if (zero? (car stack))
                 (cadr op)
                 (+ pc 1 *word-size*))))
        ((prtc)
         (display (integer->char (car stack)))
         (loop (cdr stack)
               (+ pc 1)))
        ((prti)
         (display (car stack))
         (loop (cdr stack)
               (+ pc 1)))
        ((prts)
         (display (vector-ref strings (car stack)))
         (loop (cdr stack)
               (+ pc 1)))
        ((halt)
         #t)))))

;; create and run virtual machine from filename passed on command line
(if (= 2 (length (command-line)))
  (let-values (((data strings code) (read-code (cadr (command-line)))))
              (run-program data strings code))
  (display "Error: pass a .asm filename\n"))


import java.io.File
import java.util.Scanner
import java.util.regex.Pattern

object CommatizingNumbers extends App {

  def commatize(s: String): Unit = commatize(s, 0, 3, ",")

  def commatize(s: String, start: Int, step: Int, ins: String): Unit = {
    if (start >= 0 && start <= s.length && step >= 1 && step <= s.length) {
      val m = Pattern.compile("([1-9][0-9]*)").matcher(s.substring(start))
      val result = new StringBuffer(s.substring(0, start))
      if (m.find) {
        val sb = new StringBuilder(m.group(1)).reverse
        for (i <- step until sb.length by step) sb.insert(i, ins)
        m.appendReplacement(result, sb.reverse.toString)
      }
      println(m.appendTail(result))
    }
  }

  commatize("pi=3.14159265358979323846264338327950288419716939937510582" + "097494459231", 6, 5, " ")
  commatize("The author has two Z$100000000000000 Zimbabwe notes (100 " + "trillion).", 0, 3, ".")

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


import Foundation

extension String {
  private static let commaReg = try! NSRegularExpression(pattern: "(\\.[0-9]+|[1-9]([0-9]+)?(\\.[0-9]+)?)")

  public func commatize(start: Int = 0, period: Int = 3, separator: String = ",") -> String {
    guard separator != "" else {
      return self
    }

    let sep = Array(separator)
    let startIdx = index(startIndex, offsetBy: start)
    let matches = String.commaReg.matches(in: self, range: NSRange(startIdx..., in: self))

    guard !matches.isEmpty else {
      return self
    }

    let fullMatch = String(self[Range(matches.first!.range(at: 0), in: self)!])
    let splits = fullMatch.components(separatedBy: ".")
    var ip = splits[0]

    if ip.count > period {
      var builder = Array(ip.reversed())

      for i in stride(from: (ip.count - 1) / period * period, through: period, by: -period) {
        builder.insert(contentsOf: sep, at: i)
      }

      ip = String(builder.reversed())
    }

    if fullMatch.contains(".") {
      var dp = splits[1]

      if dp.count > period {
        var builder = Array(dp)

        for i in stride(from: (dp.count - 1) / period * period, through: period, by: -period) {
          builder.insert(contentsOf: sep, at: i)
        }

        dp = String(builder)
      }

      ip += "." + dp
    }

    return String(prefix(start)) + String(dropFirst(start)).replacingOccurrences(of: fullMatch, with: ip)
  }
}

let tests = [
  "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."
]

print(tests[0].commatize(period: 2, separator: "*"))
print(tests[1].commatize(period: 3, separator: "-"))
print(tests[2].commatize(period: 4, separator: "__"))
print(tests[3].commatize(period: 5, separator: " "))
print(tests[4].commatize(separator: "."))

for testCase in tests.dropFirst(5) {
  print(testCase.commatize())
}


:start:
print(‘Program name: ’:argv[0])
print("Arguments:\n":argv[1..].join("\n"))


require'format/printf'

(opcodes)=: opcodes=: ;:{{)n
 fetch store push add sub mul div mod lt gt le ge
 eq ne and or neg not jmp jz prtc prts prti halt
}}-.LF

(ndDisp)=: ndDisp=:;:{{)n
 Sequence Multiply Divide Mod Add Subtract Negate Less LessEqual Greater
 GreaterEqual Equal NotEqual Not And Or Prts Assign Prti x If x x x While
 x x Prtc x Identifier String Integer
}}-.LF

ndDisp,.ndOps=:;: {{)n
 x mul div mod add sub neg lt le gt ge eq ne not and or
 x x x x x x x x x x x x x x x x
}} -.LF

load_ast=: {{
  'node_types node_values'=: 2{.|:(({.,&<&<}[email protected]}.)~ i.&' ');._2 y
  1{::0 load_ast ''
:
  node_type=. x{::node_types
  if. node_type-:,';' do. x;a: return.end.
  node_value=. x{::node_values
  if. -.''-:node_value do.x;<node_type make_leaf node_value return.end.
  'x left'=.(x+1) load_ast''
  'x right'=.(x+1) load_ast''
  x;<node_type make_node left right
}}

make_leaf=: ;
make_node=: {{m;n;<y}}
typ=: 0&{::
val=: left=: 1&{::
right=: 2&{::

gen_code=: {{
  if.y-:'' do.'' return.end.
  V=. val y
  W=. ;2}.y
  select.op=.typ y
    case.'Integer'do.gen_int _".V [ gen_op push
    case.'String'do.gen_string V [ gen_op push
    case.'Identifier'do.gen_var V [ gen_op fetch
    case.'Assign'do.gen_var left V [ gen_op store [ gen_code W
    case.;:'Multiply Divide Mod Add Subtract Less LessEqual Greater GreaterEqual Equal NotEqual And Or'do.
      gen_op op [ gen_code W [ gen_code V
    case.;:'Not Negate'do.
      gen_op op [ gen_code V
    case.'If'do.
      p1=. gen_int 0 [ gen_op jz [ gen_code V
      gen_code left W
      if.#right W do.
        p2=. gen_int 0 [ gen_op jmp
        gen_code right W [ p1 patch #object
        p2 patch #object
      else.
        p1 patch #object
      end.
    case.'While'do.
      p1=. #object
      p2=. gen_int 0 [ gen_op jz [ gen_code V
      gen_int p1 [ gen_op jmp [ gen_code W
      p2 patch #object
    case.'Prtc'do.gen_op prtc [ gen_code V
    case.'Prti'do.gen_op prti [ gen_code V
    case.'Prts'do.gen_op prts [ gen_code V
    case.'Sequence'do.
      gen_code W [ gen_code V
    case.do.error'unknown node type ',typ y
  end.
}}

gen_op=:{{
   arg=. boxopen y
   if. -.arg e. opcodes do.
     arg=. (ndDisp i. arg){ndOps
   end.
   assert. arg e. opcodes
   object=: object,opcodes i.arg
}}

gen_int=:{{
   if.#$y do.num=. _ ".y
   else.num=. y end.
   r=. #object
   object=: object,(4#256)#:num
   r
}}

gen_string=: {{
   strings=:~.strings,<y
   gen_int strings i.<y
}}

gen_var=: {{
   vars=:~.vars,<y
   gen_int vars i.<y
}}

patch=: {{ #object=: ((4#256)#:y) (x+i.4)} object }}
error=: {{echo y throw.}}
getint=: _2147483648+4294967296|2147483648+256#.]

list_code=: {{
  r=.'Datasize: %d Strings: %d\n' sprintf vars;&#strings
  r=.r,;strings,each LF
  pc=. 0
  lim=.<:#object
  while.do.
    op=.(pc{object){::opcodes
    r=.r,'%5d %s'sprintf pc;op
    pc=. pc+1
    i=. getint (lim<.pc+i.4){object
    k=. 0
    select.op
      case.fetch;store do.k=.4[r=.r,' [%d]'sprintf i
      case.push do.k=.4[r=.r,'  %d'sprintf i
      case.jmp;jz do.k=.4[r=.r,'    (%d) %d'sprintf (i-pc);i
      case.halt do.r=.r,LF return.
    end.
    pc=.pc+k
    r=.r,LF
  end.
}}

gen=: {{
  object=:strings=:vars=:i.0
  gen_code load_ast y
  list_code gen_op halt
}}


        >>SOURCE FORMAT IS FREE
identification division.
*> this code is dedicated to the public domain
*> (GnuCOBOL) 2.3-dev.0
*> for extra credit, generate this program directly from the EBNF
program-id. parser.
environment division.
configuration section.
repository.  function all intrinsic.
input-output section.
file-control.
    select input-file assign using input-name
        status is input-status
        organization is line sequential.
data division.
file section.
fd  input-file global.
01  input-record global.
    03  input-line pic zzzz9.
    03  input-column pic zzzzzz9.
    03  filler pic x(3).
    03  input-token pic x(16).
    03  input-value pic x(48).

working-storage section.
01  program-name pic x(32) value spaces global.
01  input-name pic x(32) value spaces global.
01  input-status pic xx global.

01  line-no pic 999 value 0.
01  col-no pic 99 value 0.

01  error-record global.
    03  error-line-no pic zzzz9.
    03  error-col-no pic zzzzzz9.
    03  filler pic x value space.
    03  error-message pic x(64) value spaces.

01  token global.
    03  token-type pic x(16).
    03  token-line pic 999.
    03  token-column pic 99.
    03  token-value pic x(48).

01  parse-stack global.
    03  p pic 999 value 0.
    03  p-lim pic 999 value 200.
    03  p-zero pic 999 value 0.
    03  parse-entry occurs 200.
        05  parse-name pic x(24).
        05  parse-token pic x(16).
        05  parse-left pic 999.
        05  parse-right pic 999.
        05  parse-work pic 999.
        05  parse-work1 pic 999.

01  abstract-syntax-tree global.
    03  t pic 999 value 0.
    03  t1 pic 999.
    03  t-lim pic 999 value 998.
    03  filler occurs 998.
        05  leaf.
            07  leaf-type pic x(14).
            07  leaf-value pic x(48).
        05  node redefines leaf.
            07  node-type pic x(14).
            07  node-left pic 999.
            07  node-right pic 999.

01  indent pic x(200) value all '|   ' global.

procedure division chaining program-name.
start-parser.
    if program-name <> spaces
        string program-name delimited by space '.lex' into input-name
        open input input-file
        if input-status <> '00'
            string 'in parser ' trim(input-name) ' open status ' input-status
                into error-message
            call 'reporterror'
        end-if
    end-if
    call 'gettoken'
    call 'stmt_list'
    if input-name <> spaces
        close input-file
    end-if

    call 'printast' using t

    >>d perform dump-ast

    stop run
    .
dump-ast.
    display '==========' upon syserr
    display 'ast:' upon syserr
    display 't=' t upon syserr
    perform varying t1 from 1 by 1 until t1 > t
        if leaf-type(t1) = 'Identifier' or 'Integer' or 'String'
            display t1 space trim(leaf-type(t1)) space trim(leaf-value(t1)) upon syserr
        else
            display t1 space node-left(t1) space node-right(t1) space trim(node-type(t1))
                upon syserr
        end-if
    end-perform
    .

identification division.
program-id. stmt_list common recursive.
data division.
procedure division.
start-stmt_list.
    call 'push' using module-id
    move p-zero to parse-left(p)
    perform forever
        call 'stmt'
        move return-code to parse-right(p)
        call 'makenode' using 'Sequence' parse-left(p) parse-right(p)
        move return-code to parse-left(p)
        if parse-right(p) = 0
        or token-type = 'End_of_input'
            exit perform
        end-if
    end-perform
    call 'pop'
    .
end program stmt_list.

identification division.
program-id. stmt common recursive.
procedure division.
start-stmt.
    call 'push' using module-id
    move p-zero to parse-left(p)
    evaluate token-type
    when 'Semicolon'
        call 'gettoken'
    when 'Identifier'
        *>Identifier '=' expr ';'
        call 'makeleaf' using 'Identifier' token-value
        move return-code to parse-left(p)
        call 'gettoken'
        call 'expect' using 'Op_assign'
        call 'expr'
        move return-code to parse-right(p)
        call 'expect' using 'Semicolon'
        call 'makenode' using 'Assign' parse-left(p) parse-right(p)
        move return-code to parse-left(p)
    when 'Keyword_while'
        *>'while' paren_expr '{' stmt '}'
        call 'gettoken'
        call 'paren_expr'
        move return-code to parse-work(p)
        call 'stmt'
        move return-code to parse-right(p)
        call 'makenode' using 'While' parse-work(p) parse-right(p)
        move return-code to parse-left(p)
    when 'Keyword_if'
        *>'if' paren_expr stmt ['else' stmt]
        call 'gettoken'
        call 'paren_expr'
        move return-code to parse-left(p)
        call 'stmt'
        move return-code to parse-work(p)
        move p-zero to parse-work1(p)
        if token-type = 'Keyword_else'
            call 'gettoken'
            call 'stmt'
            move return-code to parse-work1(p)
        end-if
        call 'makenode' using 'If' parse-work(p) parse-work1(p)
        move return-code to parse-right(p)
        call 'makenode' using 'If' parse-left(p) parse-right(p)
        move return-code to parse-left(p)
    when 'Keyword_print'
        *>'print' '(' prt_list ')' ';'
        call 'gettoken'
        call 'expect' using 'LeftParen'
        call 'prt_list'
        move return-code to parse-left(p)
        call 'expect' using 'RightParen'
        call 'expect' using 'Semicolon'
    when 'Keyword_putc'
        *>'putc' paren_expr ';'
        call 'gettoken'
        call 'paren_expr'
        move return-code to parse-left(p)
        call 'makenode' using 'Prtc' parse-left(p) p-zero
        move return-code to parse-left(p)
        call 'expect' using 'Semicolon'
    when 'LeftBrace'
        *>'{' stmt '}'
        call 'gettoken'
        move p-zero to parse-left(p)
        perform until token-type = 'RightBrace' or 'End_of_input'
            call 'stmt'
            move return-code to parse-right(p)
            call 'makenode' using 'Sequence' parse-left(p) parse-right(p)
            move return-code to parse-left(p)
        end-perform
        if token-type <> 'End_of_input'
            call 'gettoken'
        end-if
    when other
        move 0 to parse-left(p)
    end-evaluate
    move parse-left(p) to return-code
    call 'pop'
    .
end program stmt.

identification division.
program-id. paren_expr common recursive.
procedure division.
start-paren_expr.
    *>'(' expr ')' ;
    call 'push' using module-id
    call 'expect' using 'LeftParen'
    call 'expr'
    call 'expect' using 'RightParen'
    call 'pop'
    .
end program paren_expr.

identification division.
program-id. prt_list common.
procedure division.
start-prt_list.
    *>(string | expr) {',' (String | expr)} ;
    call 'push' using module-id
    move p-zero to parse-work(p)
    perform prt_entry
    perform until token-type <> 'Comma'
        call 'gettoken'
        perform prt_entry
    end-perform
    call 'pop'
    exit program
    .
prt_entry.
    if token-type = 'String'
        call 'makeleaf' using token-type token-value
        move return-code to parse-left(p)
        call 'makenode' using 'Prts' parse-left(p) p-zero
        call 'gettoken'
    else
        call 'expr'
        move return-code to parse-left(p)
        call 'makenode' using 'Prti' parse-left(p) p-zero
    end-if
    move return-code to parse-right(p)
    call 'makenode' using 'Sequence' parse-work(p) parse-right(p)
    move return-code to parse-work(p)
    .
end program prt_list.

identification division.
program-id. expr common recursive.
procedure division.
start-expr.
    *>and_expr {'||' and_expr} ;
    call 'push' using module-id
    call 'and_expr'
    move return-code to parse-left(p)
    perform forever
       if token-type <> 'Op_or'
           exit perform
       end-if
       call 'gettoken'
       call 'and_expr'
       move return-code to parse-right(p)
       call 'makenode' using 'Or' parse-left(p) parse-right(p)
       move return-code to parse-left(p)
    end-perform
    move parse-left(p) to return-code
    call 'pop'
    .
end program expr.

identification division.
program-id. and_expr common recursive.
procedure division.
start-and_expr.
    *>equality_expr {'&&' equality_expr} ;
    call 'push' using module-id
    call 'equality_expr'
    move return-code to parse-left(p)
    perform forever
        if token-type <> 'Op_and'
            exit perform
        end-if
        call 'gettoken'
        call 'equality_expr'
        move return-code to parse-right(p)
        call 'makenode' using 'And' parse-left(p) parse-right(p)
        move return-code to parse-left(p)
    end-perform
    call 'pop'
    .
end program and_expr.

identification division.
program-id. equality_expr common recursive.
procedure division.
start-equality_expr.
    *>relational_expr [('==' | '!=') relational_expr] ;
    call 'push' using module-id
    call 'relational_expr'
    move return-code to parse-left(p)
    evaluate token-type
    when 'Op_equal'
        move 'Equal' to parse-token(p)
    when 'Op_notequal'
        move 'NotEqual' to parse-token(p)
    end-evaluate
    if parse-token(p) <> spaces
        call 'gettoken'
        call 'relational_expr'
        move return-code to parse-right(p)
        call 'makenode' using parse-token(p) parse-left(p) parse-right(p)
        move return-code to parse-left(p)
    end-if
    call 'pop'
    .
end program equality_expr.

identification division.
program-id. relational_expr common recursive.
procedure division.
start-relational_expr.
    *>addition_expr [('<' | '<=' | '>' | '>=') addition_expr] ;
    call 'push' using module-id
    call 'addition_expr'
    move return-code to parse-left(p)
    evaluate token-type
    when 'Op_less'
        move 'Less' to parse-token(p)
    when 'Op_lessequal'
        move 'LessEqual' to parse-token(p)
    when 'Op_greater'
        move 'Greater' to parse-token(p)
    when 'Op_greaterequal'
        move 'GreaterEqual' to parse-token(p)
    end-evaluate
    if parse-token(p) <> spaces
        call 'gettoken'
        call 'addition_expr'
        move return-code to parse-right(p)
        call 'makenode' using parse-token(p) parse-left(p) parse-right(p)
        move return-code to parse-left(p)
    end-if
    call 'pop'
    .
end program relational_expr.

identification division.
program-id. addition_expr common recursive.
procedure division.
start-addition_expr.
    *>multiplication_expr {('+' | '-') multiplication_expr} ;
    call 'push' using module-id
    call 'multiplication_expr'
    move return-code to parse-left(p)
    perform forever
        evaluate token-type
        when 'Op_add'
            move 'Add' to parse-token(p)
        when 'Op_subtract'
            move 'Subtract' to parse-token(p)
        when other
            exit perform
        end-evaluate
        call 'gettoken'
        call 'multiplication_expr'
        move return-code to parse-right(p)
        call 'makenode' using parse-token(p) parse-left(p) parse-right(p)
        move return-code to parse-left(p)
    end-perform
    call 'pop'
    .
end program addition_expr.

identification division.
program-id.  multiplication_expr common recursive.
procedure division.
start-multiplication_expr.
    *>primary {('*' | '/' | '%') primary } ;
    call 'push' using module-id
    call 'primary'
    move return-code to parse-left(p)
    perform forever
        evaluate token-type
        when 'Op_multiply'
            move 'Multiply' to parse-token(p)
        when 'Op_divide'
            move 'Divide' to parse-token(p)
        when 'Op_mod'
            move 'Mod' to parse-token(p)
        when other
            exit perform
        end-evaluate
        call 'gettoken'
        call 'primary'
        move return-code to parse-right(p)
        call 'makenode' using parse-token(p) parse-left(p) parse-right(p)
        move return-code to parse-left(p)
    end-perform
    call 'pop'
    .
end program multiplication_expr.

identification division.
program-id. primary common recursive.
procedure division.
start-primary.
    *>  Identifier
    *>| Integer
    *>| 'LeftParen' expr 'RightParen'
    *>| ('+' | '-' | '!') primary
    *>;
    call 'push' using module-id
    evaluate token-type
    when 'Identifier'
        call 'makeleaf' using 'Identifier' token-value
        call 'gettoken'
    when 'Integer'
        call 'makeleaf' using 'Integer' token-value
        call 'gettoken'
    when 'LeftParen'
        call 'gettoken'
        call 'expr'
        call 'expect' using 'RightParen'
        move t to return-code
    when 'Op_add'
        call 'gettoken'
        call 'primary'
    when 'Op_subtract'
        call 'gettoken'
        call 'primary'
        move return-code to parse-left(p)
        call 'makenode' using 'Negate' parse-left(p) p-zero
    when 'Op_not'
        call 'gettoken'
        call 'primary'
        move return-code to parse-left(p)
        call 'makenode' using 'Not' parse-left(p) p-zero
    when other
        move 0 to return-code
    end-evaluate
    call 'pop'
    .
end program primary.

program-id. reporterror common.
procedure division.
start-reporterror.
report-error.
    move token-line to error-line-no
    move token-column to error-col-no
    display error-record upon syserr
    stop run with error status -1
    .
end program reporterror.

identification division.
program-id. gettoken common.
procedure division.
start-gettoken.
    if program-name = spaces
        move '00' to input-status
        accept input-record on exception move '10' to input-status end-accept
    else
        read input-file
    end-if

    evaluate input-status
    when '00'
        move input-token to token-type
        move input-value to token-value
        move numval(input-line) to token-line
        move numval(input-column) to token-column
        >>d display indent(1:min(4 * p,length(indent))) 'new token: ' token-type upon syserr
    when '10'
        string 'in parser ' trim(input-name) ' unexpected end of input'
            into error-message
        call 'reporterror'
    when other
        string 'in parser ' trim(input-name) ' unexpected input-status ' input-status
            into error-message
        call 'reporterror'
    end-evaluate
    .
end program gettoken.

identification division.
program-id. expect common.
data division.
linkage section.
01  what any length.
procedure division using what.
start-expect.
    if token-type <> what
        string 'in parser expected ' what ' found ' token-type into error-message
        call 'reporterror'
    end-if
    >>d display indent(1:min(4 * p,length(indent))) 'match: ' token-type upon syserr
    call 'gettoken'
    .
end program expect.

identification division.
program-id. push common.
data division.
linkage section.
01  what any length.
procedure division using what.
start-push.
    >>d display indent(1:min(4 * p,length(indent))) 'push ' what upon syserr
    if p >= p-lim
        move 'in parser stack overflow' to error-message
        call 'reporterror'
    end-if
    add 1 to p
    initialize parse-entry(p)
    move what to parse-name(p)
    .
end program push.

identification division.
program-id. pop common.
procedure division.
start-pop.
    if p < 1
        move 'in parser stack underflow' to error-message
        call 'reporterror'
    end-if
    >>d display indent(1:4 * p - 4) 'pop ' parse-name(p) upon syserr
    subtract 1 from p
    .
end program pop.

identification division.
program-id. makenode common.
data division.
linkage section.
01  parm-type any length.
01  parm-left pic 999.
01  parm-right pic 999.
procedure division using parm-type parm-left parm-right.
start-makenode.
    if t >= t-lim
        string 'in parser makenode tree index t exceeds ' t-lim into error-message
        call 'reporterror'
    end-if
    add 1 to t
    move parm-type to node-type(t)
    move parm-left to node-left(t)
    move parm-right to node-right(t)
    move t to return-code
    .
end program makenode.

identification division.
program-id. makeleaf common.
data division.
linkage section.
01  parm-type any length.
01  parm-value pic x(48).
procedure division using parm-type parm-value.
start-makeleaf.
    if t >= t-lim
        string 'in parser makeleaf tree index t exceeds ' t-lim into error-message
        call 'reporterror'
    end-if
    add 1 to t
    move parm-type to leaf-type(t)
    move parm-value to leaf-value(t)
    move t to return-code
    .
end program makeleaf.

identification division.
program-id. printast recursive.
data division.
linkage section.
01  n pic 999.
procedure division using n.
start-printast.
    if n = 0
        display ';'
        exit program
    end-if
    evaluate leaf-type(n)
    when 'Identifier'
    when 'Integer'
    when 'String'
        display leaf-type(n) trim(leaf-value(n))
    when other
        display node-type(n)
        call 'printast' using node-left(n)
        call 'printast' using node-right(n)
    end-evaluate
    .
end program printast.
end program parser.


import "/dynamic" for Enum
import "/crypto" for Bytes
import "/fmt" for Conv
import "/ioutil" for FileUtil

var codes = [
    "fetch",
    "store",
    "push",
    "add",
    "sub",
    "mul",
    "div",
    "mod",
    "lt",
    "gt",
    "le",
    "ge",
    "eq",
    "ne",
    "and",
    "or",
    "neg",
    "not",
    "jmp",
    "jz",
    "prtc",
    "prts",
    "prti",
    "halt"
]

var Code = Enum.create("Code", codes)

var codeMap = {
    "fetch": Code.fetch,
    "store": Code.store,
    "push":  Code.push,
    "add":   Code.add,
    "sub":   Code.sub,
    "mul":   Code.mul,
    "div":   Code.div,
    "mod":   Code.mod,
    "lt":    Code.lt,
    "gt":    Code.gt,
    "le":    Code.le,
    "ge":    Code.ge,
    "eq":    Code.eq,
    "ne":    Code.ne,
    "and":   Code.and,
    "or":    Code.or,
    "neg":   Code.neg,
    "not":   Code.not,
    "jmp":   Code.jmp,
    "jz":    Code.jz,
    "prtc":  Code.prtc,
    "prts":  Code.prts,
    "prti":  Code.prti,
    "halt":  Code.halt
}

var object     = []
var stringPool = []

var reportError = Fn.new { |msg| Fiber.abort("error : %(msg)") }

var emitByte = Fn.new { |c| object.add(c) }

var emitWord = Fn.new { |n|
    var bs = Bytes.fromIntLE(n)
    for (b in bs) emitByte.call(b)
}

// Converts the 4 bytes starting at object[pc] to an unsigned 32 bit integer
// and thence to a signed 32 bit integer
var toInt32LE = Fn.new { |pc|
    var x = Bytes.toIntLE(object[pc...pc+4])
    if (x >= 2.pow(31)) x = x - 2.pow(32)
    return x
}

/* Virtual Machine interpreter */

var runVM = Fn.new { |dataSize|
    var stack = List.filled(dataSize + 1, 0)
    var pc = 0
    while (true) {
        var op = object[pc]
        pc = pc + 1
        if (op == Code.fetch) {
            var x = toInt32LE.call(pc)
            stack.add(stack[x])
            pc = pc + 4
        } else if (op == Code.store) {
            var x = toInt32LE.call(pc)
            var ln = stack.count
            stack[x] = stack[ln-1]
            stack = stack[0...ln-1]
            pc = pc + 4
        } else if (op == Code.push) {
            var x = toInt32LE.call(pc)
            stack.add(x)
            pc = pc + 4
        } else if (op == Code.add) {
            var ln = stack.count
            stack[ln-2] = stack[ln-2] + stack[ln-1]
            stack = stack[0...ln-1]
        } else if (op == Code.sub) {
            var ln = stack.count
            stack[ln-2] = stack[ln-2] - stack[ln-1]
            stack = stack[0...ln-1]
        } else if (op == Code.mul) {
            var ln = stack.count
            stack[ln-2] = stack[ln-2] * stack[ln-1]
            stack = stack[0...ln-1]
        } else if (op == Code.div) {
            var ln = stack.count
            stack[ln-2] = (stack[ln-2] / stack[ln-1]).truncate
            stack = stack[0...ln-1]
        } else if (op == Code.mod) {
            var ln = stack.count
            stack[ln-2] = stack[ln-2] % stack[ln-1]
            stack = stack[0...ln-1]
        } else if (op == Code.lt) {
            var ln = stack.count
            stack[ln-2] = Conv.btoi(stack[ln-2] < stack[ln-1])
            stack = stack[0...ln-1]
        } else if (op == Code.gt) {
            var ln = stack.count
            stack[ln-2] = Conv.btoi(stack[ln-2] > stack[ln-1])
            stack = stack[0...ln-1]
        } else if (op == Code.le) {
            var ln = stack.count
            stack[ln-2] = Conv.btoi(stack[ln-2] <= stack[ln-1])
            stack = stack[0...ln-1]
        } else if (op == Code.ge) {
            var ln = stack.count
            stack[ln-2] = Conv.btoi(stack[ln-2] >= stack[ln-1])
            stack = stack[0...ln-1]
        } else if (op == Code.eq) {
            var ln = stack.count
            stack[ln-2] = Conv.btoi(stack[ln-2] == stack[ln-1])
            stack = stack[0...ln-1]
        } else if (op == Code.ne) {
            var ln = stack.count
            stack[ln-2] = Conv.btoi(stack[ln-2] != stack[ln-1])
            stack = stack[0...ln-1]
        } else if (op == Code.and) {
            var ln = stack.count
            stack[ln-2] = Conv.btoi(Conv.itob(stack[ln-2]) && Conv.itob(stack[ln-1]))
            stack = stack[0...ln-1]
        } else if (op == Code.or) {
            var ln = stack.count
            stack[ln-2] = Conv.btoi(Conv.itob(stack[ln-2]) || Conv.itob(stack[ln-1]))
            stack = stack[0...ln-1]
        } else if (op == Code.neg) {
            var ln = stack.count
            stack[ln-1] = -stack[ln-1]
        } else if (op == Code.not) {
            var ln = stack.count
            stack[ln-1] = Conv.btoi(!Conv.itob(stack[ln-1]))
        } else if (op == Code.jmp) {
            var x = toInt32LE.call(pc)
            pc = pc + x
        } else if (op == Code.jz) {
            var ln = stack.count
            var v = stack[ln-1]
            stack = stack[0...ln-1]
            if (v != 0) {
                pc = pc + 4
            } else {
                var x = toInt32LE.call(pc)
                pc = pc + x
            }
        } else if (op == Code.prtc) {
            var ln = stack.count
            System.write(String.fromByte(stack[ln-1]))
            stack = stack[0...ln-1]
        } else if (op == Code.prts) {
            var ln = stack.count
            System.write(stringPool[stack[ln-1]])
            stack = stack[0...ln-1]
        } else if (op == Code.prti) {
            var ln = stack.count
            System.write(stack[ln-1])
            stack = stack[0...ln-1]
        } else if (op == Code.halt) {
            return
        } else {
            reportError.call("Unknown opcode %(op)")
        }
    }
}

var translate = Fn.new { |s|
    var d = ""
    var i = 0
    while (i < s.count) {
        if (s[i] == "\\" && (i+1) < s.count) {
            if (s[i+1] == "n") {
                d = d + "\n"
                i = i + 1
            } else if (s[i+1] == "\\") {
                d = d + "\\"
                i = i + 1
            }
        } else {
            d = d + s[i]
        }
        i = i + 1
    }
    return d
}

var lines = []
var lineCount = 0
var lineNum = 0

var loadCode = Fn.new {
    var dataSize
    var firstLine = true
    while (lineNum < lineCount) {
        var line = lines[lineNum].trimEnd(" \t")
        lineNum = lineNum + 1
        if (line.count == 0) {
            if (firstLine) {
                reportError.call("empty line")
            } else {
                break
            }
        }
        var lineList = line.split(" ").where { |s| s != "" }.toList
        if (firstLine) {
            dataSize = Num.fromString(lineList[1])
            var nStrings = Num.fromString(lineList[3])
            for (i in 0...nStrings) {
                var s = lines[lineNum].trim("\"\n")
                lineNum = lineNum + 1
                stringPool.add(translate.call(s))
            }
            firstLine = false
            continue
        }
        var offset = Num.fromString(lineList[0])
        var instr = lineList[1]
        var opCode = codeMap[instr]
        if (!opCode) {
            reportError.call("Unknown instruction %(instr) at %(opCode)")
        }
        emitByte.call(opCode)
        if (opCode == Code.jmp || opCode == Code.jz) {
            var p = Num.fromString(lineList[3])
            emitWord.call(p - offset - 1)
        } else if (opCode == Code.push) {
            var value = Num.fromString(lineList[2])
            emitWord.call(value)
        } else if (opCode == Code.fetch || opCode == Code.store) {
            var value = Num.fromString(lineList[2].trim("[]"))
            emitWord.call(value)
        }
    }
    return dataSize
}

lines = FileUtil.readLines("codegen.txt")
lineCount = lines.count
runVM.call(loadCode.call())


Public Sub commatize(s As String, Optional sep As String = ",", Optional start As Integer = 1, Optional step As Integer = 3)
    Dim l As Integer: l = Len(s)
        For i = start To l
            If Asc(Mid(s, i, 1)) >= Asc("1") And Asc(Mid(s, i, 1)) <= Asc("9") Then
                For j = i + 1 To l + 1
                    If j > l Then
                        For k = j - 1 - step To i Step -step
                            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 = j - 1 - step To i Step -step
                                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
        Debug.Print s
    End Sub
Public Sub main()
    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."
End Sub


var commatize = Fn.new { |s, start, step, sep|
    var addSeps = Fn.new { |n, dp|
        var lz = ""
        if (!dp && n.startsWith("0") && n != "0") {
            var k = n.trimStart("0")
            if (k == "") k = "0"
            lz = "0" * (n.count - k.count)
            n = k
        }
        if (dp) n = n[-1..0] // invert if after decimal point
        var i = n.count - step
        while (i >= 1) {
            n = n[0...i] + sep + n[i..-1]
            i = i - step
        }
        if (dp) n = n[-1..0] // invert back
        return lz + n
    }

    var t = s.toList
    var isExponent = Fn.new { |c| "eEdDpP^∙x↑*⁰¹²³⁴⁵⁶⁷⁸⁹".contains(c) }
    var acc = (start == 0) ? "" : t.toList[0...start].join()
    var n = ""
    var dp = false
    for (j in start...t.count) {
        var c = t[j].codePoints[0]
        if (c >= 48 && c <= 57) {
            n = n + t[j]
            if (j == t.count-1) {
                if (acc != "" && isExponent.call(acc[-1])) {
                    acc = s
                } else {
                    acc = acc + addSeps.call(n, dp)
                }
            }
        } else if (n != "") {
            if (acc != "" && isExponent.call(acc[-1])) {
                acc = s
                break
            } else if (t[j] != ".") {
                acc = acc + addSeps.call(n, dp) + t[j..-1].join()
                break
            } else {
                acc = acc + addSeps.call(n, dp) + t[j]
                dp = true
                n = ""
            }
        } else {
            acc = acc + t[j]
        }
    }

    System.print(s)
    System.print(acc)
    System.print()
}

// special version of the above which uses defaults for start, step and sep.
var commatize2 = Fn.new { |s| commatize.call(s, 0, 3, ",") }

commatize.call("123456789.123456789", 0, 2, "*")
commatize.call(".123456789", 0, 3, "-")
commatize.call("57256.1D-4", 0, 4, "__")
commatize.call("pi=3.14159265358979323846264338327950288419716939937510582097494459231", 0, 5, " ")
commatize.call("The author has two Z$100000000000000 Zimbabwe notes (100 trillion).", 0, 3, ".")

var defaults = [
    "\"-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."
]

defaults.each { |d| commatize2.call(d) }


putch:	equ	2	; CP/M syscall to print character
puts:	equ	9	; CP/M syscall to print $-terminated string
arglen:	equ	80h	; Length of argument
argmt:	equ	81h	; Argument string
fcb1:	equ	5Ch	; FCBs
fcb2:	equ	6Ch
	org	100h
	;;;	Print all argument(s) as given
	lxi	d,cmdln	; Print 'Command line: '
	mvi	c,puts
	call	5
	lda	arglen	; Retrieve the length of the argument
	lxi	h,argmt	; Pointer to argument string
	call	plstr
	;;;	CP/M also assumes that the first two words on the command
	;;;	line are filenames, and prepares two FCBs with the filenames
	;;;	in them. If there are no filenames, they will be blank.
	lxi	d,file1	; Print the first one
	mvi	c,puts
	call	5
	mvi	a,11	; Filenames are 8+3 characters long and padded with
	lxi	h,fcb1+1	; spaces
	call	plstr
	lxi	d,file2	; Print the second one
	mvi	c,puts
	call	5
	mvi	a,11
	lxi	h,fcb2+1
	; ... fall through - on small systems saving bytes is a virtue
	;;;	This subroutine prints a length-A string in HL.
plstr:	ana	a	; If A=0, print nothing.
	rz
	push	psw	; Save A and HL registers on the stack
	push	h	; (CP/M syscalls clobber all registers)
	mov	e,m	; Print character under HL
	mvi	c,putch
	call	5
	pop	h	; Restore A and HL registers
	pop	psw
	inx	h	; Increment string pointer
	dcr	a	; Decrement character counter
	jnz	plstr	; Print next character if not zero
	ret
cmdln:	db	'Command line: $'
file1:	db	13,10,'File 1: $'
file2:	db	13,10,'File 2: $'


with Ada.Command_line; use Ada.Command_Line;
with Ada.Text_IO; use Ada.Text_IO;

procedure Print_Commands is
begin
   -- The number of command line arguments is retrieved from the function Argument_Count
   -- The actual arguments are retrieved from the function Argument
   -- The program name is retrieved from the function Command_Name
   Put(Command_Name & " ");
   for Arg in 1..Argument_Count loop
      Put(Argument(Arg) & " ");
   end loop;
   New_Line;
end Print_Commands;


foreach arg in args {
    println ("arg: " + arg)
}


package codegenerator;

import java.io.File;
import java.util.ArrayList;
import java.util.Arrays;
import java.util.HashMap;
import java.util.List;
import java.util.Map;
import java.util.Scanner;

public class CodeGenerator {
    final static int WORDSIZE = 4;

    static byte[] code = {};

    static Map<String, NodeType> str_to_nodes = new HashMap<>();
    static List<String> string_pool = new ArrayList<>();
    static List<String> variables = new ArrayList<>();
    static int string_count = 0;
    static int var_count = 0;

    static Scanner s;
    static NodeType[] unary_ops = {
        NodeType.nd_Negate, NodeType.nd_Not
    };
    static NodeType[] operators = {
        NodeType.nd_Mul, NodeType.nd_Div, NodeType.nd_Mod, NodeType.nd_Add, NodeType.nd_Sub,
        NodeType.nd_Lss, NodeType.nd_Leq, NodeType.nd_Gtr, NodeType.nd_Geq,
        NodeType.nd_Eql, NodeType.nd_Neq, NodeType.nd_And, NodeType.nd_Or
    };

    static enum Mnemonic {
        NONE, FETCH, STORE, PUSH, ADD, SUB, MUL, DIV, MOD, LT, GT, LE, GE, EQ, NE, AND, OR, NEG, NOT,
        JMP, JZ, PRTC, PRTS, PRTI, HALT
    }
    static class Node {
        public NodeType nt;
        public Node left, right;
        public String value;

        Node() {
            this.nt = null;
            this.left = null;
            this.right = null;
            this.value = null;
        }
        Node(NodeType node_type, Node left, Node right, String value) {
            this.nt = node_type;
            this.left = left;
            this.right = right;
            this.value = value;
        }
        public static Node make_node(NodeType nodetype, Node left, Node right) {
            return new Node(nodetype, left, right, "");
        }
        public static Node make_node(NodeType nodetype, Node left) {
            return new Node(nodetype, left, null, "");
        }
        public static Node make_leaf(NodeType nodetype, String value) {
            return new Node(nodetype, null, null, value);
        }
    }
    static enum NodeType {
        nd_None("", Mnemonic.NONE), nd_Ident("Identifier", Mnemonic.NONE), nd_String("String", Mnemonic.NONE), nd_Integer("Integer", Mnemonic.NONE), nd_Sequence("Sequence", Mnemonic.NONE),
        nd_If("If", Mnemonic.NONE),
        nd_Prtc("Prtc", Mnemonic.NONE), nd_Prts("Prts", Mnemonic.NONE), nd_Prti("Prti", Mnemonic.NONE), nd_While("While", Mnemonic.NONE),
        nd_Assign("Assign", Mnemonic.NONE),
        nd_Negate("Negate", Mnemonic.NEG), nd_Not("Not", Mnemonic.NOT), nd_Mul("Multiply", Mnemonic.MUL), nd_Div("Divide", Mnemonic.DIV), nd_Mod("Mod", Mnemonic.MOD), nd_Add("Add", Mnemonic.ADD),
        nd_Sub("Subtract", Mnemonic.SUB), nd_Lss("Less", Mnemonic.LT), nd_Leq("LessEqual", Mnemonic.LE),
        nd_Gtr("Greater", Mnemonic.GT), nd_Geq("GreaterEqual", Mnemonic.GE), nd_Eql("Equal", Mnemonic.EQ),
        nd_Neq("NotEqual", Mnemonic.NE), nd_And("And", Mnemonic.AND), nd_Or("Or", Mnemonic.OR);

        private final String name;
        private final Mnemonic m;

        NodeType(String name, Mnemonic m) {
            this.name = name;
            this.m = m;
        }
        Mnemonic getMnemonic() { return this.m; }

        @Override
        public String toString() { return this.name; }
    }
    static void appendToCode(int b) {
        code = Arrays.copyOf(code, code.length + 1);
        code[code.length - 1] = (byte) b;
    }
    static void emit_byte(Mnemonic m) {
        appendToCode(m.ordinal());
    }
    static void emit_word(int n) {
        appendToCode(n >> 24);
        appendToCode(n >> 16);
        appendToCode(n >> 8);
        appendToCode(n);
    }
    static void emit_word_at(int pos, int n) {
        code[pos] = (byte) (n >> 24);
        code[pos + 1] = (byte) (n >> 16);
        code[pos + 2] = (byte) (n >> 8);
        code[pos + 3] = (byte) n;
    }
    static int get_word(int pos) {
        int result;
        result = ((code[pos] & 0xff) << 24) + ((code[pos + 1] & 0xff)  << 16) + ((code[pos + 2] & 0xff)  << 8) + (code[pos + 3] & 0xff) ;

        return result;
    }
    static int fetch_var_offset(String name) {
        int n;
        n = variables.indexOf(name);
        if (n == -1) {
            variables.add(name);
            n = var_count++;
        }
        return n;
    }
    static int fetch_string_offset(String str) {
        int n;
        n = string_pool.indexOf(str);
        if (n == -1) {
            string_pool.add(str);
            n = string_count++;
        }
        return n;
    }
    static int hole() {
        int t = code.length;
        emit_word(0);
        return t;
    }
    static boolean arrayContains(NodeType[] a, NodeType n) {
        boolean result = false;
        for (NodeType test: a) {
            if (test.equals(n)) {
                result = true;
                break;
            }
        }
        return result;
    }
    static void code_gen(Node x) throws Exception {
        int n, p1, p2;
        if (x == null) return;

        switch (x.nt) {
            case nd_None: return;
            case nd_Ident:
                emit_byte(Mnemonic.FETCH);
                n = fetch_var_offset(x.value);
                emit_word(n);
                break;
            case nd_Integer:
                emit_byte(Mnemonic.PUSH);
                emit_word(Integer.parseInt(x.value));
                break;
            case nd_String:
                emit_byte(Mnemonic.PUSH);
                n = fetch_string_offset(x.value);
                emit_word(n);
                break;
            case nd_Assign:
                n = fetch_var_offset(x.left.value);
                code_gen(x.right);
                emit_byte(Mnemonic.STORE);
                emit_word(n);
                break;
            case nd_If:
                p2 = 0; // to avoid NetBeans complaining about 'not initialized'
                code_gen(x.left);
                emit_byte(Mnemonic.JZ);
                p1 = hole();
                code_gen(x.right.left);
                if (x.right.right != null) {
                    emit_byte(Mnemonic.JMP);
                    p2 = hole();
                }
                emit_word_at(p1, code.length - p1);
                if (x.right.right != null) {
                    code_gen(x.right.right);
                    emit_word_at(p2, code.length - p2);
                }
                break;
            case nd_While:
                p1 = code.length;
                code_gen(x.left);
                emit_byte(Mnemonic.JZ);
                p2 = hole();
                code_gen(x.right);
                emit_byte(Mnemonic.JMP);
                emit_word(p1 - code.length);
                emit_word_at(p2, code.length - p2);
                break;
            case nd_Sequence:
                code_gen(x.left);
                code_gen(x.right);
                break;
            case nd_Prtc:
                code_gen(x.left);
                emit_byte(Mnemonic.PRTC);
                break;
            case nd_Prti:
                code_gen(x.left);
                emit_byte(Mnemonic.PRTI);
                break;
            case nd_Prts:
                code_gen(x.left);
                emit_byte(Mnemonic.PRTS);
                break;
            default:
                if (arrayContains(operators, x.nt)) {
                    code_gen(x.left);
                    code_gen(x.right);
                    emit_byte(x.nt.getMnemonic());
                } else if (arrayContains(unary_ops, x.nt)) {
                    code_gen(x.left);
                    emit_byte(x.nt.getMnemonic());
                } else {
                    throw new Exception("Error in code generator! Found " + x.nt + ", expecting operator.");
                }
        }
    }
    static void list_code() throws Exception {
        int pc = 0, x;
        Mnemonic op;
        System.out.println("Datasize: " + var_count + " Strings: " + string_count);
        for (String s: string_pool) {
            System.out.println(s);
        }
        while (pc < code.length) {
            System.out.printf("%4d ", pc);
            op = Mnemonic.values()[code[pc++]];
            switch (op) {
                case FETCH:
                    x = get_word(pc);
                    System.out.printf("fetch [%d]", x);
                    pc += WORDSIZE;
                    break;
                case STORE:
                    x = get_word(pc);
                    System.out.printf("store [%d]", x);
                    pc += WORDSIZE;
                    break;
                case PUSH:
                    x = get_word(pc);
                    System.out.printf("push  %d", x);
                    pc += WORDSIZE;
                    break;
                case ADD: case SUB: case MUL: case DIV: case MOD:
                case LT: case GT: case LE: case GE: case EQ: case NE:
                case AND: case OR: case NEG: case NOT:
                case PRTC: case PRTI: case PRTS: case HALT:
                    System.out.print(op.toString().toLowerCase());
                    break;
                case JMP:
                    x = get_word(pc);
                    System.out.printf("jmp     (%d) %d", x, pc + x);
                    pc += WORDSIZE;
                    break;
                case JZ:
                    x = get_word(pc);
                    System.out.printf("jz      (%d) %d", x, pc + x);
                    pc += WORDSIZE;
                    break;
                default:
                    throw new Exception("Unknown opcode " + code[pc] + "@" + (pc - 1));
            }
            System.out.println();
        }
    }
    static Node load_ast() throws Exception {
        String command, value;
        String line;
        Node left, right;

        while (s.hasNext()) {
            line = s.nextLine();
            value = null;
            if (line.length() > 16) {
                command = line.substring(0, 15).trim();
                value = line.substring(15).trim();
            } else {
                command = line.trim();
            }
            if (command.equals(";")) {
                return null;
            }
            if (!str_to_nodes.containsKey(command)) {
                throw new Exception("Command not found: '" + command + "'");
            }
            if (value != null) {
                return Node.make_leaf(str_to_nodes.get(command), value);
            }
            left = load_ast(); right = load_ast();
            return Node.make_node(str_to_nodes.get(command), left, right);
        }
        return null; // for the compiler, not needed
    }
    public static void main(String[] args) {
        Node n;

        str_to_nodes.put(";", NodeType.nd_None);
        str_to_nodes.put("Sequence", NodeType.nd_Sequence);
        str_to_nodes.put("Identifier", NodeType.nd_Ident);
        str_to_nodes.put("String", NodeType.nd_String);
        str_to_nodes.put("Integer", NodeType.nd_Integer);
        str_to_nodes.put("If", NodeType.nd_If);
        str_to_nodes.put("While", NodeType.nd_While);
        str_to_nodes.put("Prtc", NodeType.nd_Prtc);
        str_to_nodes.put("Prts", NodeType.nd_Prts);
        str_to_nodes.put("Prti", NodeType.nd_Prti);
        str_to_nodes.put("Assign", NodeType.nd_Assign);
        str_to_nodes.put("Negate", NodeType.nd_Negate);
        str_to_nodes.put("Not", NodeType.nd_Not);
        str_to_nodes.put("Multiply", NodeType.nd_Mul);
        str_to_nodes.put("Divide", NodeType.nd_Div);
        str_to_nodes.put("Mod", NodeType.nd_Mod);
        str_to_nodes.put("Add", NodeType.nd_Add);
        str_to_nodes.put("Subtract", NodeType.nd_Sub);
        str_to_nodes.put("Less", NodeType.nd_Lss);
        str_to_nodes.put("LessEqual", NodeType.nd_Leq);
        str_to_nodes.put("Greater", NodeType.nd_Gtr);
        str_to_nodes.put("GreaterEqual", NodeType.nd_Geq);
        str_to_nodes.put("Equal", NodeType.nd_Eql);
        str_to_nodes.put("NotEqual", NodeType.nd_Neq);
        str_to_nodes.put("And", NodeType.nd_And);
        str_to_nodes.put("Or", NodeType.nd_Or);

        if (args.length > 0) {
            try {
                s = new Scanner(new File(args[0]));
                n = load_ast();
                code_gen(n);
                emit_byte(Mnemonic.HALT);
                list_code();
            } catch (Exception e) {
                System.out.println("Ex: "+e);//.getMessage());
            }
        }
    }
}


#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "[email protected]"
|#
(progn ;;init forms
  (ros:ensure-asdf)
  #+quicklisp(ql:quickload '() :silent t))

(defpackage :ros.script.parse.3859374047
  (:use :cl))
(in-package :ros.script.parse.3859374047)

;;;
;;; The Rosetta Code Tiny-Language Parser, in Common Lisp.
;;;

(require "cl-ppcre")
(require "trivia")

(defstruct tokstruc line-no column-no tok tokval)

(defconstant re-blank-line
  (ppcre:create-scanner "^\\s*$"))

(defconstant re-token-1
  (ppcre:create-scanner
   "^\\s*(\\d+)\\s+(\\d+)\\s+(\\S+)\\s*$"))

(defconstant re-token-2
  (ppcre:create-scanner
   "^\\s*(\\d+)\\s+(\\d+)\\s+(\\S+)\\s+(\\S(.*\\S)?)\\s*$"))

(defun string-to-tok (s)
  (trivia:match s
    ("Keyword_else" 'TOK-ELSE)
    ("Keyword_if" 'TOK-IF)
    ("Keyword_print" 'TOK-PRINT)
    ("Keyword_putc" 'TOK-PUTC)
    ("Keyword_while" 'TOK-WHILE)
    ("Op_multiply" 'TOK-MULTIPLY)
    ("Op_divide" 'TOK-DIVIDE)
    ("Op_mod" 'TOK-MOD)
    ("Op_add" 'TOK-ADD)
    ("Op_subtract" 'TOK-SUBTRACT)
    ("Op_negate" 'TOK-NEGATE)
    ("Op_less" 'TOK-LESS)
    ("Op_lessequal" 'TOK-LESSEQUAL)
    ("Op_greater" 'TOK-GREATER)
    ("Op_greaterequal" 'TOK-GREATEREQUAL)
    ("Op_equal" 'TOK-EQUAL)
    ("Op_notequal" 'TOK-NOTEQUAL)
    ("Op_not" 'TOK-NOT)
    ("Op_assign" 'TOK-ASSIGN)
    ("Op_and" 'TOK-AND)
    ("Op_or" 'TOK-OR)
    ("LeftParen" 'TOK-LEFTPAREN)
    ("RightParen" 'TOK-RIGHTPAREN)
    ("LeftBrace" 'TOK-LEFTBRACE)
    ("RightBrace" 'TOK-RIGHTBRACE)
    ("Semicolon" 'TOK-SEMICOLON)
    ("Comma" 'TOK-COMMA)
    ("Identifier" 'TOK-IDENTIFIER)
    ("Integer" 'TOK-INTEGER)
    ("String" 'TOK-STRING)
    ("End_of_input" 'TOK-END-OF-INPUT)
    (_ (warn "unparseable token line")
       (uiop:quit 1))))

(defun precedence (tok)
  (case tok
    (TOK-MULTIPLY 13)
    (TOK-DIVIDE 13)
    (TOK-MOD 13)
    (TOK-ADD 12)
    (TOK-SUBTRACT 12)
    (TOK-NEGATE 14)
    (TOK-NOT 14)
    (TOK-LESS 10)
    (TOK-LESSEQUAL 10)
    (TOK-GREATER 10)
    (TOK-GREATEREQUAL 10)
    (TOK-EQUAL 9)
    (TOK-NOTEQUAL 9)
    (TOK-AND 5)
    (TOK-OR 4)
    (otherwise -1)))

(defun binary-p (tok)
  (case tok
    (TOK-ADD t)
    (TOK-SUBTRACT t)
    (TOK-MULTIPLY t)
    (TOK-DIVIDE t)
    (TOK-MOD t)
    (TOK-LESS t)
    (TOK-LESSEQUAL t)
    (TOK-GREATER t)
    (TOK-GREATEREQUAL t)
    (TOK-EQUAL t)
    (TOK-NOTEQUAL t)
    (TOK-AND t)
    (TOK-OR t)
    (otherwise nil)))

(defun right-associative-p (tok)
  (declare (ignorable tok))
  nil)           ; None of the current operators is right associative.

(defun tok-text (tok)
  (ecase tok
    (TOK-ELSE          "else")
    (TOK-IF            "if")
    (TOK-PRINT         "print")
    (TOK-PUTC          "putc")
    (TOK-WHILE         "while")
    (TOK-MULTIPLY      "*")
    (TOK-DIVIDE        "/")
    (TOK-MOD           "%")
    (TOK-ADD           "+")
    (TOK-SUBTRACT      "-")
    (TOK-NEGATE        "-")
    (TOK-LESS          "<")
    (TOK-LESSEQUAL     "<=")
    (TOK-GREATER       ">")
    (TOK-GREATEREQUAL  ">=")
    (TOK-EQUAL         "==")
    (TOK-NOTEQUAL      "!=")
    (TOK-NOT           "!")
    (TOK-ASSIGN        "=")
    (TOK-AND           "&&")
    (TOK-OR            "((")
    (TOK-LEFTPAREN     "(")
    (TOK-RIGHTPAREN    ")")
    (TOK-LEFTBRACE     "{")
    (TOK-RIGHTBRACE    "}")
    (TOK-SEMICOLON     ";")
    (TOK-COMMA         ",")
    (TOK-IDENTIFIER    "Ident")
    (TOK-INTEGER       "Integer literal")
    (TOK-STRING        "String literal")
    (TOK-END_OF_INPUT  "EOI")))

(defun operator (tok)
  (ecase tok
    (TOK-MULTIPLY "Multiply")
    (TOK-DIVIDE "Divide")
    (TOK-MOD "Mod")
    (TOK-ADD "Add")
    (TOK-SUBTRACT "Subtract")
    (TOK-NEGATE "Negate")
    (TOK-NOT "Not")
    (TOK-LESS "Less")
    (TOK-LESSEQUAL "LessEqual")
    (TOK-GREATER "Greater")
    (TOK-GREATEREQUAL "GreaterEqual")
    (TOK-EQUAL "Equal")
    (TOK-NOTEQUAL "NotEqual")
    (TOK-AND "And")
    (TOK-OR "Or")))

(defun join (&rest args)
  (apply #'concatenate 'string args))

(defun nxt (gettok)
  (funcall gettok :nxt))

(defun curr (gettok)
  (funcall gettok :curr))

(defun err (token msg)
  (format t "(~A, ~A) error: ~A~%"
          (tokstruc-line-no token)
          (tokstruc-column-no token)
          msg)
  (uiop:quit 1))

(defun prt-ast (outf ast)
  ;;
  ;; For fun, let us do prt-ast *non*-recursively, with a stack and a
  ;; loop.
  ;;
  (let ((stack `(,ast)))
    (loop while stack
          do (let ((x (car stack)))
               (setf stack (cdr stack))
               (cond ((not x) (format outf ";~%"))
                     ((or (string= (car x) "Identifier")
                          (string= (car x) "Integer")
                          (string= (car x) "String"))
                      (format outf "~A ~A~%" (car x) (cadr x)))
                     (t (format outf "~A~%" (car x))
                        (setf stack (cons (caddr x) stack))
                        (setf stack (cons (cadr x) stack))))))))

(defun accept (gettok tok)
  (if (eq (tokstruc-tok (curr gettok)) tok)
      (nxt gettok)
      nil))

(defun expect (gettok msg tok)
  (let ((curr-tok (tokstruc-tok (curr gettok))))
    (if (eq curr-tok tok)
        (nxt gettok)
        (err (curr gettok)
             (join msg ": Expecting '"
                   (tok-text tok) "', found '"
                   (tok-text curr-tok) "'")))))

(defun parse (gettok)
  (defun paren-expr (gettok)
    (expect gettok "paren_expr" 'TOK-LEFTPAREN)
    (let ((x (expr gettok 0)))
      (expect gettok "paren_expr" 'TOK-RIGHTPAREN)
      x))

  (defun expr (gettok p)
    (let* ((tok (curr gettok))
           (x (case (tokstruc-tok tok)
                (TOK-LEFTPAREN (paren-expr gettok))
                (TOK-SUBTRACT
                 (nxt gettok)
                 (let ((y (expr gettok (precedence 'TOK-NEGATE))))
                   `("Negate" ,y ())))
                (TOK-ADD
                 (nxt gettok)
                 (expr gettok (precedence 'TOK-NEGATE)))
                (TOK-NOT
                 (nxt gettok)
                 (let ((y (expr gettok (precedence 'TOK-NOT))))
                   `("Not" ,y ())))
                (TOK-IDENTIFIER
                 (let ((y `("Identifier" ,(tokstruc-tokval tok))))
                   (nxt gettok)
                   y))
                (TOK-INTEGER
                 (let ((y `("Integer" ,(tokstruc-tokval tok))))
                   (nxt gettok)
                   y))
                (otherwise
                 (err tok (join "Expecting a primary, found: "
                                (tok-text (tokstruc-tok tok))))))))
      ;;
      ;; Precedence climbing for binary operators.
      ;;
      (loop for tok = (curr gettok)
            for toktok = (tokstruc-tok tok)
            while (and (binary-p toktok) (<= p (precedence toktok)))
            do (progn (nxt gettok)
                      (let ((q (if (right-associative-p toktok)
                                   (precedence toktok)
                                   (1+ (precedence toktok)))))
                        (setf x `(,(operator toktok) ,x
                                  ,(expr gettok q))))))
      x))

  (defun stmt (gettok)
    (cond ((accept gettok 'TOK-IF)
           (let* ((e (paren-expr gettok))
                  (s (stmt gettok))
                  (x (if (accept gettok 'TOK-ELSE)
                         `("If" ,s ,(stmt gettok))
                         `("If" ,s ()))))
             `("If" ,e ,x)))

          ((accept gettok 'TOK-PUTC)
           (let ((x `("Prtc" ,(paren-expr gettok) ())))
             (expect gettok "Putc" 'TOK-SEMICOLON)
             x))

          ((accept gettok 'TOK-PRINT)
           (expect gettok "Print" 'TOK-LEFTPAREN)
           (let ((x '()))
             (loop for tok = (curr gettok)
                   for toktok = (tokstruc-tok tok)
                   for e = (if (eq toktok 'TOK-STRING)
                               (let* ((tokval (tokstruc-tokval tok))
                                      (leaf `("String" ,tokval))
                                      (e `("Prts" ,leaf ())))
                                 (nxt gettok)
                                 e)
                               `("Prti" ,(expr gettok 0) ()))
                   do (setf x `("Sequence" ,x ,e))
                   while (accept gettok 'TOK-COMMA))
             (expect gettok "Print" 'TOK-RIGHTPAREN)
             (expect gettok "Print" 'TOK-SEMICOLON)
             x))

          ((eq (tokstruc-tok (curr gettok)) 'TOK-SEMICOLON)
           (nxt gettok))

          ((eq (tokstruc-tok (curr gettok)) 'TOK-IDENTIFIER)
           (let ((v `("Identifier" ,(tokstruc-tokval (curr gettok)))))
             (nxt gettok)
             (expect gettok "assign" 'TOK-ASSIGN)
             (let ((x `("Assign" ,v ,(expr gettok 0))))
               (expect gettok "assign" 'TOK-SEMICOLON)
               x)))

          ((accept gettok 'TOK-WHILE)
           (let ((e (paren-expr gettok)))
             `("While" ,e ,(stmt gettok))))

          ((accept gettok 'TOK-LEFTBRACE)
           (let ((x '()))
             (loop for tok = (curr gettok)
                   for toktok = (tokstruc-tok tok)
                   until (or (eq toktok 'TOK-RIGHTBRACE)
                             (eq toktok 'TOK-END-OF-INPUT))
                   do (setf x `("Sequence" ,x ,(stmt gettok))))
             (expect gettok "Lbrace" 'TOK-RIGHTBRACE)
             x))

          ((eq (tokstruc-tok (curr gettok)) 'TOK-END-OF-INPUT)
           '())

          (t (let* ((tok (curr gettok))
                    (toktok (tokstruc-tok tok)))
               (err tok (join "expecting start of statement, found '"
                              (tok-text toktok) "'"))))))

  ;;
  ;; Parsing of the top-level statement sequence.
  ;;
  (let ((x '()))
    (nxt gettok)
    (loop do (setf x `("Sequence" ,x ,(stmt gettok)))
          until (eq (tokstruc-tok (curr gettok)) 'TOK-END-OF-INPUT))
    x))

(defun string-to-tokstruc (s)
  (let ((strings
          (nth-value 1 (ppcre:scan-to-strings re-token-1 s))))
    (if strings
        (make-tokstruc :line-no (elt strings 0)
                       :column-no (elt strings 1)
                       :tok (string-to-tok (elt strings 2))
                       :tokval nil)
        (let ((strings
                (nth-value 1 (ppcre:scan-to-strings re-token-2 s))))
          (if strings
              (make-tokstruc :line-no (elt strings 0)
                             :column-no (elt strings 1)
                             :tok (string-to-tok (elt strings 2))
                             :tokval (elt strings 3))
              (progn
                (warn "unparseable token line")
                (uiop:quit 1)))))))

(defun read-token-line (inpf)
  (loop for line = (read-line inpf nil "End_of_input")
        while (ppcre:scan re-blank-line line)
        finally (return line)))

(defun open-inpf (inpf-filename)
  (if (string= inpf-filename "-")
      *standard-input*
      (open inpf-filename :direction :input)))

(defun open-outf (outf-filename)
  (if (string= outf-filename "-")
      *standard-output*
      (open outf-filename :direction :output
                          :if-exists :overwrite
                          :if-does-not-exist :create)))

(defun usage-error ()
  (princ "Usage: parse [INPUTFILE [OUTPUTFILE]]" *standard-output*)
  (terpri *standard-output*)
  (princ "If either INPUTFILE or OUTPUTFILE is \"-\", the respective"
         *standard-output*)
  (princ " standard I/O is used." *standard-output*)
  (terpri *standard-output*)
  (uiop:quit 1))

(defun get-filenames (argv)
  (trivia:match argv
    ((list) '("-" "-"))
    ((list inpf-filename) `(,inpf-filename "-"))
    ((list inpf-filename outf-filename) `(,inpf-filename
                                          ,outf-filename))
    (_ (usage-error))))

(defun main (&rest argv)
  (let* ((filenames (get-filenames argv))
         (inpf-filename (car filenames))
         (inpf (open-inpf inpf-filename))
         (outf-filename (cadr filenames))
         (outf (open-outf outf-filename)))

    (let* ((current-token (list nil))
           (gettok-curr (lambda () (elt current-token 0)))
           (gettok-nxt (lambda ()
                         (let* ((s (read-token-line inpf))
                                (tok (string-to-tokstruc s)))
                           (setf (elt current-token 0) tok)
                           tok)))
           (gettok (lambda (instruction)
                     (trivia:match instruction
                       (:curr (funcall gettok-curr))
                       (:nxt (funcall gettok-nxt)))))
           (ast (parse gettok)))
      (prt-ast outf ast))

    (unless (string= inpf-filename "-")
      (close inpf))
    (unless (string= outf-filename "-")
      (close outf))

    (uiop:quit 0)))

;;; vim: set ft=lisp lisp:


const std = @import("std");

pub const VirtualMachineError = error{OutOfMemory};

pub const VirtualMachine = struct {
    allocator: std.mem.Allocator,
    stack: [stack_size]i32,
    program: std.ArrayList(u8),
    sp: usize, // stack pointer
    pc: usize, // program counter
    string_pool: std.ArrayList([]const u8), // all the strings in the program
    globals: std.ArrayList(i32), // all the variables in the program, they are global
    output: std.ArrayList(u8), // Instead of outputting to stdout, we do it here for better testing.

    const Self = @This();
    const stack_size = 32; // Can be arbitrarily increased/decreased as long as we have enough.
    const word_size = @sizeOf(i32);

    pub fn init(
        allocator: std.mem.Allocator,
        program: std.ArrayList(u8),
        string_pool: std.ArrayList([]const u8),
        globals: std.ArrayList(i32),
    ) Self {
        return VirtualMachine{
            .allocator = allocator,
            .stack = [_]i32{std.math.maxInt(i32)} ** stack_size,
            .program = program,
            .sp = 0,
            .pc = 0,
            .string_pool = string_pool,
            .globals = globals,
            .output = std.ArrayList(u8).init(allocator),
        };
    }

    pub fn interp(self: *Self) VirtualMachineError!void {
        while (true) : (self.pc += 1) {
            switch (@intToEnum(Op, self.program.items[self.pc])) {
                .push => self.push(self.unpackInt()),
                .store => self.globals.items[@intCast(usize, self.unpackInt())] = self.pop(),
                .fetch => self.push(self.globals.items[@intCast(usize, self.unpackInt())]),
                .jmp => self.pc = @intCast(usize, self.unpackInt() - 1),
                .jz => {
                    if (self.pop() == 0) {
                        // -1 because `while` increases it with every iteration.
                        // This doesn't allow to jump to location 0 because we use `usize` for `pc`,
                        // just arbitrary implementation limitation.
                        self.pc = @intCast(usize, self.unpackInt() - 1);
                    } else {
                        self.pc += word_size;
                    }
                },
                .prts => try self.out("{s}", .{self.string_pool.items[@intCast(usize, self.pop())]}),
                .prti => try self.out("{d}", .{self.pop()}),
                .prtc => try self.out("{c}", .{@intCast(u8, self.pop())}),
                .lt => self.binOp(lt),
                .le => self.binOp(le),
                .gt => self.binOp(gt),
                .ge => self.binOp(ge),
                .eq => self.binOp(eq),
                .ne => self.binOp(ne),
                .add => self.binOp(add),
                .mul => self.binOp(mul),
                .sub => self.binOp(sub),
                .div => self.binOp(div),
                .mod => self.binOp(mod),
                [email protected]"and" => self.binOp(@"and"),
                [email protected]"or" => self.binOp(@"or"),
                .not => self.push(@boolToInt(self.pop() == 0)),
                .neg => self.push(-self.pop()),
                .halt => break,
            }
        }
    }

    fn push(self: *Self, n: i32) void {
        self.sp += 1;
        self.stack[self.sp] = n;
    }

    fn pop(self: *Self) i32 {
        std.debug.assert(self.sp != 0);
        self.sp -= 1;
        return self.stack[self.sp + 1];
    }

    fn unpackInt(self: *Self) i32 {
        const arg_ptr = @ptrCast(*[4]u8, self.program.items[self.pc + 1 .. self.pc + 1 + word_size]);
        self.pc += word_size;
        var arg_array = arg_ptr.*;
        const arg = @ptrCast(*i32, @alignCast(@alignOf(i32), &arg_array));
        return arg.*;
    }

    pub fn out(self: *Self, comptime format: []const u8, args: anytype) VirtualMachineError!void {
        try self.output.writer().print(format, args);
    }

    fn binOp(self: *Self, func: fn (a: i32, b: i32) i32) void {
        const a = self.pop();
        const b = self.pop();
        // Note that arguments are in reversed order because this is how we interact with
        // push/pop operations of the stack.
        const result = func(b, a);
        self.push(result);
    }

    fn lt(a: i32, b: i32) i32 {
        return @boolToInt(a < b);
    }
    fn le(a: i32, b: i32) i32 {
        return @boolToInt(a <= b);
    }
    fn gt(a: i32, b: i32) i32 {
        return @boolToInt(a > b);
    }
    fn ge(a: i32, b: i32) i32 {
        return @boolToInt(a >= b);
    }
    fn eq(a: i32, b: i32) i32 {
        return @boolToInt(a == b);
    }
    fn ne(a: i32, b: i32) i32 {
        return @boolToInt(a != b);
    }
    fn add(a: i32, b: i32) i32 {
        return a + b;
    }
    fn sub(a: i32, b: i32) i32 {
        return a - b;
    }
    fn mul(a: i32, b: i32) i32 {
        return a * b;
    }
    fn div(a: i32, b: i32) i32 {
        return @divTrunc(a, b);
    }
    fn mod(a: i32, b: i32) i32 {
        return @mod(a, b);
    }
    fn @"or"(a: i32, b: i32) i32 {
        return @boolToInt((a != 0) or (b != 0));
    }
    fn @"and"(a: i32, b: i32) i32 {
        return @boolToInt((a != 0) and (b != 0));
    }
};

pub fn main() !void {
    var arena = std.heap.ArenaAllocator.init(std.heap.page_allocator);
    defer arena.deinit();
    const allocator = arena.allocator();

    var arg_it = std.process.args();
    _ = try arg_it.next(allocator) orelse unreachable; // program name
    const file_name = arg_it.next(allocator);
    // We accept both files and standard input.
    var file_handle = blk: {
        if (file_name) |file_name_delimited| {
            const fname: []const u8 = try file_name_delimited;
            break :blk try std.fs.cwd().openFile(fname, .{});
        } else {
            break :blk std.io.getStdIn();
        }
    };
    defer file_handle.close();
    const input_content = try file_handle.readToEndAlloc(allocator, std.math.maxInt(usize));

    var string_pool = std.ArrayList([]const u8).init(allocator);
    var globals = std.ArrayList(i32).init(allocator);
    const bytecode = try loadBytecode(allocator, input_content, &string_pool, &globals);
    var vm = VirtualMachine.init(allocator, bytecode, string_pool, globals);
    try vm.interp();
    const result: []const u8 = vm.output.items;
    _ = try std.io.getStdOut().write(result);
}

pub const Op = enum(u8) {
    fetch,
    store,
    push,
    add,
    sub,
    mul,
    div,
    mod,
    lt,
    gt,
    le,
    ge,
    eq,
    ne,
    @"and",
    @"or",
    neg,
    not,
    jmp,
    jz,
    prtc,
    prts,
    prti,
    halt,

    const from_string = std.ComptimeStringMap(Op, .{
        .{ "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", [email protected]"and" },
        .{ "or", [email protected]"or" },
        .{ "neg", .neg },
        .{ "not", .not },
        .{ "jmp", .jmp },
        .{ "jz", .jz },
        .{ "prtc", .prtc },
        .{ "prts", .prts },
        .{ "prti", .prti },
        .{ "halt", .halt },
    });

    pub fn fromString(str: []const u8) Op {
        return from_string.get(str).?;
    }
};

// 100 lines of code to load serialized bytecode, eh
fn loadBytecode(
    allocator: std.mem.Allocator,
    str: []const u8,
    string_pool: *std.ArrayList([]const u8),
    globals: *std.ArrayList(i32),
) !std.ArrayList(u8) {
    var result = std.ArrayList(u8).init(allocator);
    var line_it = std.mem.split(u8, str, "\n");
    while (line_it.next()) |line| {
        if (std.mem.indexOf(u8, line, "halt")) |_| {
            var tok_it = std.mem.tokenize(u8, line, " ");
            const size = try std.fmt.parseInt(usize, tok_it.next().?, 10);
            try result.resize(size + 1);
            break;
        }
    }

    line_it.index = 0;
    const first_line = line_it.next().?;
    const strings_index = std.mem.indexOf(u8, first_line, " Strings: ").?;
    const globals_size = try std.fmt.parseInt(usize, first_line["Datasize: ".len..strings_index], 10);
    const string_pool_size = try std.fmt.parseInt(usize, first_line[strings_index + " Strings: ".len ..], 10);
    try globals.resize(globals_size);
    try string_pool.ensureTotalCapacity(string_pool_size);
    var string_cnt: usize = 0;
    while (string_cnt < string_pool_size) : (string_cnt += 1) {
        const line = line_it.next().?;
        var program_string = try std.ArrayList(u8).initCapacity(allocator, line.len);
        var escaped = false;
        // Skip double quotes
        for (line[1 .. line.len - 1]) |ch| {
            if (escaped) {
                escaped = false;
                switch (ch) {
                    '\\' => try program_string.append('\\'),
                    'n' => try program_string.append('\n'),
                    else => {
                        std.debug.print("unknown escape sequence: {c}\n", .{ch});
                        std.os.exit(1);
                    },
                }
            } else {
                switch (ch) {
                    '\\' => escaped = true,
                    else => try program_string.append(ch),
                }
            }
        }
        try string_pool.append(program_string.items);
    }
    while (line_it.next()) |line| {
        if (line.len == 0) break;

        var tok_it = std.mem.tokenize(u8, line, " ");
        const address = try std.fmt.parseInt(usize, tok_it.next().?, 10);
        const op = Op.fromString(tok_it.next().?);
        result.items[address] = @enumToInt(op);
        switch (op) {
            .fetch, .store => {
                const index_bracketed = tok_it.rest();
                const index = try std.fmt.parseInt(i32, index_bracketed[1 .. index_bracketed.len - 1], 10);
                insertInt(&result, address + 1, index);
            },
            .push => {
                insertInt(&result, address + 1, try std.fmt.parseInt(i32, tok_it.rest(), 10));
            },
            .jmp, .jz => {
                _ = tok_it.next();
                insertInt(&result, address + 1, try std.fmt.parseInt(i32, tok_it.rest(), 10));
            },
            else => {},
        }
    }
    return result;
}

fn insertInt(array: *std.ArrayList(u8), address: usize, n: i32) void {
    const word_size = @sizeOf(i32);
    var i: usize = 0;
    var n_var = n;
    var n_bytes = @ptrCast(*[4]u8, &n_var);
    while (i < word_size) : (i += 1) {
        array.items[@intCast(usize, address + i)] = n_bytes[@intCast(usize, i)];
    }
}


integer i;

i = 0;
while (i < argc()) {
    o_text(argv(i));
    o_byte('\n');
    i += 1;
}


main:(
  FOR i TO argc DO
    printf(($"the argument #"g(-0)" is "gl$, i, argv(i)))
  OD
)


#defn main(_V_,_N_)  #RAND, main:, V#RNDV=1,_V_={#VOID}, \
                     _N_=0,totalarg,mov(_N_), \
                     LOOPGETARG_#RNDV:, {[ V#RNDV ]},push(_V_),++V#RNDV,\
                     {_N_,V#RNDV},jle(LOOPGETARG_#RNDV),clear(V#RNDV)


#!/usr/bin/env osascript
-- Print first argument
on run argv
  return (item 1 of argv)
end run


import Base.show

mutable struct Asm32
    offset::Int32
    code::String
    arg::Int32
    targ::Int32
end
Asm32(code, arg = 0) = Asm32(0, code, arg, 0)

show(io::IO, a::Asm32) = print(io, lpad("$(a.offset)", 6), lpad(a.code, 8),
    a.targ > 0 ? (lpad("($(a.arg))", 8) * lpad("$(a.targ)", 4)) :
    (a.code in ["store", "fetch"] ? lpad("[$(a.arg)]", 8) :
    (a.code in ["push"] ? lpad("$(a.arg)", 8) : "")))

const ops32 = Dict{String,String}("Multiply" => "mul", "Divide" => "div", "Mod" => "mod", "Add" => "add",
    "Subtract" => "sub", "Less" => "lt", "Greater" => "gt", "LessEqual" => "le", "GreaterEqual" => "ge",
    "Equal" => "eq", "NotEqual" => "ne", "And" => "and", "or" => "or", "Not" => "not", "Minus" => "neg",
    "Prtc" => "prtc", "Prti" => "prti", "Prts" => "prts")

function compiletoasm(io)
    identifiers = Vector{String}()
    strings = Vector{String}()
    labels = Vector{Int}()

    function cpile(io, islefthandside = false)
        arr = Vector{Asm32}()
        jlabel() = (push!(labels, length(labels) + 1); labels[end])
        m = match(r"^(\w+|;)\s*([\d\w\"\\ \S]+)?", strip(readline(io)))
        x, val = m == nothing ? Pair(";", 0) : m.captures
        if x == ";" return arr
        elseif x == "Assign"
            lhs = cpile(io, true)
            rhs = cpile(io)
            append!(arr, rhs)
            append!(arr, lhs)
            if length(arr) > 100 exit() end
        elseif x == "Integer" push!(arr, Asm32("push", parse(Int32, val)))
        elseif x == "String"
            if !(val in strings)
                push!(strings, val)
            end
            push!(arr, Asm32("push", findfirst(x -> x == val, strings) - 1))
        elseif x == "Identifier"
            if !(val in identifiers)
                if !islefthandside
                    throw("Identifier $val referenced before it is assigned")
                end
                push!(identifiers, val)
            end
            push!(arr, Asm32(islefthandside ? "store" : "fetch", findfirst(x -> x == val, identifiers) - 1))
        elseif haskey(ops32, x)
            append!(arr, cpile(io))
            append!(arr, cpile(io))
            push!(arr, Asm32(ops32[x]))
        elseif x ==  "If"
            append!(arr, cpile(io))
            x, y = jlabel(), jlabel()
            push!(arr, Asm32("jz", x))
            append!(arr, cpile(io))
            push!(arr, Asm32("jmp", y))
            a = cpile(io)
            if length(a) < 1
                push!(a, Asm32("nop", 0))
            end
            a[1].offset = x
            append!(arr, a)
            push!(arr, Asm32(y, "nop", 0, 0)) # placeholder
        elseif x == "While"
            x, y = jlabel(), jlabel()
            a = cpile(io)
            if length(a) < 1
                push!(a, Asm32("nop", 0))
            end
            a[1].offset = x
            append!(arr, a)
            push!(arr, Asm32("jz", y))
            append!(arr, cpile(io))
            push!(arr, Asm32("jmp", x), Asm32(y, "nop", 0, 0))
        elseif x == "Sequence"
            append!(arr, cpile(io))
            append!(arr, cpile(io))
        else
            throw("unknown node type: $x")
        end
        arr
    end

    # compile AST
    asmarr = cpile(io)
    push!(asmarr, Asm32("halt"))
    # move address markers to working code and prune nop code
    for (i, acode) in enumerate(asmarr)
        if acode.code == "nop" && acode.offset != 0 && i < length(asmarr)
            asmarr[i + 1].offset = asmarr[i].offset
        end
    end
    filter!(x -> x.code != "nop", asmarr)
    # renumber offset column with actual offsets
    pos = 0
    jmps = Dict{Int, Int}()
    for acode in asmarr
        if acode.offset > 0
            jmps[acode.offset] = pos
        end
        acode.offset = pos
        pos += acode.code in ["push", "store", "fetch", "jz", "jmp"] ? 5 : 1
    end
    # fix up jump destinations
    for acode in asmarr
        if acode.code in ["jz", "jmp"]
            if haskey(jmps, acode.arg)
                acode.targ = jmps[acode.arg]
                acode.arg = acode.targ - acode.offset -1
            else
                throw("unknown jump location: $acode")
            end
        end
    end
    # print Datasize and Strings header
    println("Datasize: $(length(identifiers)) Strings: $(length(strings))\n" *
        join(strings, "\n") )
    # print assembly lines
    foreach(println, asmarr)
end

const testAST = raw"""
Sequence
Sequence
;
Assign
Identifier    count
Integer       1
While
Less
Identifier    count
Integer       10
Sequence
Sequence
;
Sequence
Sequence
Sequence
;
Prts
String        "count is: "
;
Prti
Identifier    count
;
Prts
String        "\n"
;
Assign
Identifier    count
Add
Identifier    count
Integer       1    """

iob = IOBuffer(testAST) # use an io buffer here for testing, but could use stdin instead of iob

compiletoasm(iob)