struct ASTnode
    nodetype::Int
    left::Union{Nothing, ASTnode}
    right::Union{Nothing, ASTnode}
    value::Union{Nothing, Int, String}
end

function syntaxanalyzer(inputfile)
    tkEOI, tkMul, tkDiv, tkMod, tkAdd, tkSub, tkNegate, tkNot, tkLss, tkLeq, tkGtr, tkGeq,
    tkEql, tkNeq, tkAssign, tkAnd, tkOr, tkIf, tkElse, tkWhile, tkPrint, tkPutc, tkLparen, tkRparen,
    tkLbrace, tkRbrace, tkSemi, tkComma, tkIdent, tkInteger, tkString = collect(1:31)

    ndIdent, ndString, ndInteger, ndSequence, ndIf, ndPrtc, ndPrts, ndPrti, ndWhile,
    ndAssign, ndNegate, ndNot, ndMul, ndDiv, ndMod, ndAdd, ndSub, ndLss, ndLeq,
    ndGtr, ndGeq, ndEql, ndNeq, ndAnd, ndOr = collect(1:25)

    TK_NAME, TK_RIGHT_ASSOC, TK_IS_BINARY, TK_IS_UNARY, TK_PRECEDENCE, TK_NODE = collect(1:6) # label Token columns
    Tokens = [
    ["EOI"             , false, false, false, -1, -1       ],
    ["*"               , false, true,  false, 13, ndMul    ],
    ["/"               , false, true,  false, 13, ndDiv    ],
    ["%"               , false, true,  false, 13, ndMod    ],
    ["+"               , false, true,  false, 12, ndAdd    ],
    ["-"               , false, true,  false, 12, ndSub    ],
    ["-"               , false, false, true,  14, ndNegate ],
    ["!"               , false, false, true,  14, ndNot    ],
    ["<"               , false, true,  false, 10, ndLss    ],
    ["<="              , false, true,  false, 10, ndLeq    ],
    [">"               , false, true,  false, 10, ndGtr    ],
    [">="              , false, true,  false, 10, ndGeq    ],
    ["=="              , false, true,  false,  9, ndEql    ],
    ["!="              , false, true,  false,  9, ndNeq    ],
    ["="               , false, false, false, -1, ndAssign ],
    ["&&"              , false, true,  false,  5, ndAnd    ],
    ["||"              , false, true,  false,  4, ndOr     ],
    ["if"              , false, false, false, -1, ndIf     ],
    ["else"            , false, false, false, -1, -1       ],
    ["while"           , false, false, false, -1, ndWhile  ],
    ["print"           , false, false, false, -1, -1       ],
    ["putc"            , false, false, false, -1, -1       ],
    ["("               , false, false, false, -1, -1       ],
    [")"               , false, false, false, -1, -1       ],
    ["{"               , false, false, false, -1, -1       ],
    ["}"               , false, false, false, -1, -1       ],
    [";"               , false, false, false, -1, -1       ],
    [","               , false, false, false, -1, -1       ],
    ["Ident"           , false, false, false, -1, ndIdent  ],
    ["Integer literal" , false, false, false, -1, ndInteger],
    ["String literal"  , false, false, false, -1, ndString ]]

    allsyms = Dict(
        "End_of_input" => tkEOI, "Op_multiply" => tkMul, "Op_divide" => tkDiv,
        "Op_mod" => tkMod, "Op_add" => tkAdd, "Op_subtract" => tkSub,
        "Op_negate" => tkNegate, "Op_not" => tkNot, "Op_less" => tkLss,
        "Op_lessequal" => tkLeq, "Op_greater" => tkGtr, "Op_greaterequal" => tkGeq,
        "Op_equal" => tkEql, "Op_notequal" => tkNeq, "Op_assign" => tkAssign,
        "Op_and" => tkAnd, "Op_or" => tkOr, "Keyword_if" => tkIf, "Keyword_else" => tkElse,
        "Keyword_while" => tkWhile, "Keyword_print" => tkPrint, "Keyword_putc" => tkPutc,
        "LeftParen" => tkLparen, "RightParen" => tkRparen, "LeftBrace" => tkLbrace,
        "RightBrace" => tkRbrace, "Semicolon" => tkSemi, "Comma" => tkComma,
        "Identifier" => tkIdent, "Integer" => tkInteger, "String" => tkString)

    displaynodes = ["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"]

    errline, errcol, tok, toktext = fill("", 4)
    error(msg) = throw("Error in syntax: $msg.")
    nilnode = ASTnode(0, nothing, nothing, nothing)
    tokother = ""

    function gettok()
        s = readline(inputfile)
        if length(s) == 0
            error("empty line")
        end
        linelist = split(strip(s), r"\s+", limit = 4)
        # line col Ident varname
        # 0    1   2     3
        errline, errcol, toktext = linelist[1:3]
        if !haskey(allsyms, toktext)
            error("Unknown token $toktext")
        end
        tok = allsyms[toktext]
        tokother = (tok in [tkInteger, tkIdent, tkString]) ? linelist[4] : ""
     end

    makenode(oper, left, right = nilnode) = ASTnode(oper, left, right, nothing)
    makeleaf(oper, n::Int) = ASTnode(oper, nothing, nothing, n)
    makeleaf(oper, n) = ASTnode(oper, nothing, nothing, string(n))
    expect(msg, s) = if tok != s error("msg: Expecting $(Tokens[s][TK_NAME]), found $(Tokens[tok][TK_NAME])") else gettok() end

    function expr(p)
        x = nilnode
        if tok == tkLparen
            x = parenexpr()
        elseif tok in [tkSub, tkAdd]
            op = tok == tkSub ? tkNegate : tkAdd
            gettok()
            node = expr(Tokens[tkNegate][TK_PRECEDENCE])
            x = (op == tkNegate) ? makenode(ndNegate, node) : node
        elseif tok == tkNot
            gettok()
            x = makenode(ndNot, expr(Tokens[tkNot][TK_PRECEDENCE]))
        elseif tok == tkIdent
            x = makeleaf(ndIdent, tokother)
            gettok()
        elseif tok == tkInteger
            x = makeleaf(ndInteger, tokother)
            gettok()
        else
            error("Expecting a primary, found: $(Tokens[tok][TK_NAME])")
        end
        while Tokens[tok][TK_IS_BINARY] && (Tokens[tok][TK_PRECEDENCE] >= p)
            op = tok
            gettok()
            q = Tokens[op][TK_PRECEDENCE]
            if !Tokens[op][TK_RIGHT_ASSOC]
                q += 1
            end
            node = expr(q)
            x = makenode(Tokens[op][TK_NODE], x, node)
        end
        x
    end

    parenexpr() = (expect("paren_expr", tkLparen); node = expr(0); expect("paren_expr", tkRparen); node)

    function stmt()
        t = nilnode
        if tok == tkIf
            gettok()
            e = parenexpr()
            s = stmt()
            s2 = nilnode
            if tok == tkElse
                gettok()
                s2 = stmt()
            end
            t = makenode(ndIf, e, makenode(ndIf, s, s2))
        elseif tok == tkPutc
            gettok()
            e = parenexpr()
            t = makenode(ndPrtc, e)
            expect("Putc", tkSemi)
        elseif tok == tkPrint
            gettok()
            expect("Print", tkLparen)
            while true
                if tok == tkString
                    e = makenode(ndPrts, makeleaf(ndString, tokother))
                    gettok()
                else
                    e = makenode(ndPrti, expr(0))
                end
                t = makenode(ndSequence, t, e)
                if tok != tkComma
                    break
                end
                gettok()
            end
            expect("Print", tkRparen)
            expect("Print", tkSemi)
        elseif tok == tkSemi
            gettok()
        elseif tok == tkIdent
            v = makeleaf(ndIdent, tokother)
            gettok()
            expect("assign", tkAssign)
            e = expr(0)
            t = makenode(ndAssign, v, e)
            expect("assign", tkSemi)
        elseif tok == tkWhile
            gettok()
            e = parenexpr()
            s = stmt()
            t = makenode(ndWhile, e, s)
        elseif tok == tkLbrace
            gettok()
            while (tok != tkRbrace) && (tok != tkEOI)
                t = makenode(ndSequence, t, stmt())
            end
            expect("Lbrace", tkRbrace)
        elseif tok != tkEOI
            error("Expecting start of statement, found: $(Tokens[tok][TK_NAME])")
        end
        return t
    end

    function parse()
        t = nilnode
        gettok()
        while true
            t = makenode(ndSequence, t, stmt())
            if (tok == tkEOI) || (t == nilnode)
                break
            end
        end
        t
    end

    function prtASTnode(t)
        if t == nothing
            return
        elseif t == nilnode
            println(";")
        elseif t.nodetype in [ndIdent, ndInteger, ndString]
            println(rpad(displaynodes[t.nodetype], 14), t.value)
        else
            println(rpad(displaynodes[t.nodetype], 14))
        end
        prtASTnode(t.left)
        prtASTnode(t.right)
    end

    # runs the function
    prtASTnode(parse())
end

testtxt = """
    1      1 Identifier      count
    1      7 Op_assign
    1      9 Integer             1
    1     10 Semicolon
    2      1 Keyword_while
    2      7 LeftParen
    2      8 Identifier      count
    2     14 Op_less
    2     16 Integer            10
    2     18 RightParen
    2     20 LeftBrace
    3      5 Keyword_print
    3     10 LeftParen
    3     11 String          \"count is: \"
    3     23 Comma
    3     25 Identifier      count
    3     30 Comma
    3     32 String          \"\\n\"
    3     36 RightParen
    3     37 Semicolon
    4      5 Identifier      count
    4     11 Op_assign
    4     13 Identifier      count
    4     19 Op_add
    4     21 Integer             1
    4     22 Semicolon
    5      1 RightBrace
    6      1 End_of_input           """

syntaxanalyzer(IOBuffer(testtxt))  # for isolated testing

# syntaxanalyzer(length(ARGS) > 1 ? ARGS[1] : stdin) # for use as in the Python code


include "cowgol.coh";
include "argv.coh";

ArgvInit();
var i: uint8 := 0;

loop
    var arg := ArgvNext();
    if arg == 0 as [uint8] then break; end if;
    i := i + 1;
    print_i8(i);
    print(": '");
    print(arg);
    print("'\n");
end loop;


void main(in string[] args) {
    import std.stdio;

    foreach (immutable i, arg; args[1 .. $])
        writefln("#%2d : %s", i + 1, arg);
}


main(List<String> args) {
    for(var arg in args)
        print(arg);
}


$ i = 1
$ loop:
$  write sys$output "the value of P''i' is ", p'i
$  i = i + 1
$  if i .le. 8 then $ goto loop


(import (scheme base)
        (scheme file)
        (scheme process-context)
        (scheme write)
        (only (srfi 1) delete-duplicates list-index)
        (only (srfi 13) string-delete string-index string-trim))

(define *names* '((Add add) (Subtract sub) (Multiply mul) (Divide div) (Mod mod)
                            (Less lt) (Greater gt) (LessEqual le) (GreaterEqual ge)
                            (Equal eq) (NotEqual ne) (And and) (Or or) (Negate neg)
                            (Not not) (Prts prts) (Prti prti) (Prtc prtc)))

(define (change-name name)
  (if (assq name *names*)
    (cdr (assq name *names*))
    (error "Cannot find name" name)))

;; Read AST from given filename
;; - return as an s-expression
(define (read-code filename)
  (define (read-expr)
    (let ((line (string-trim (read-line))))
      (if (string=? line ";")
        '()
        (let ((space (string-index line #\space)))
          (if space
            (list (string->symbol (string-trim (substring line 0 space)))
                  (string-trim (substring line space (string-length line))))
            (list (string->symbol line) (read-expr) (read-expr)))))))
  ;
  (with-input-from-file filename (lambda () (read-expr))))

;; run a three-pass assembler
(define (generate-code ast)
  (define new-address ; create a new unique address - for jump locations
    (let ((count 0))
      (lambda ()
        (set! count (+ 1 count))
        (string->symbol (string-append "loc-" (number->string count))))))
  ; define some names for fields
  (define left cadr)
  (define right (lambda (x) (cadr (cdr x))))
  ;
  (define (extract-values ast)
    (if (null? ast)
      (values '() '())
      (case (car ast)
        ((Integer)
         (values '() '()))
        ((Negate Not Prtc Prti Prts)
         (extract-values (left ast)))
        ((Assign Add Subtract Multiply Divide Mod Less Greater LessEqual GreaterEqual
                 Equal NotEqual And Or If While Sequence)
         (let-values (((a b) (extract-values (left ast)))
                      ((c d) (extract-values (right ast))))
                     (values (delete-duplicates (append a c) string=?)
                             (delete-duplicates (append b d) string=?))))
        ((String)
         (values '() (list (left ast))))
        ((Identifier)
         (values (list (left ast)) '())))))
  ;
  (let-values (((constants strings) (extract-values ast)))
              (define (constant-idx term)
                (list-index (lambda (s) (string=? s term)) constants))
              (define (string-idx term)
                (list-index (lambda (s) (string=? s term)) strings))
              ;
              (define (pass-1 ast asm) ; translates ast into a list of basic operations
                (if (null? ast)
                  asm
                  (case (car ast)
                    ((Integer)
                     (cons (list 'push (left ast)) asm))
                    ((Identifier)
                     (cons (list 'fetch (constant-idx (left ast))) asm))
                    ((String)
                     (cons (list 'push (string-idx (left ast))) asm))
                    ((Assign)
                     (cons (list 'store (constant-idx (left (left ast)))) (pass-1 (right ast) asm)))
                    ((Add Subtract Multiply Divide Mod Less Greater LessEqual GreaterEqual
                          Equal NotEqual And Or) ; binary operators
                     (cons (change-name (car ast))
                           (pass-1 (right ast) (pass-1 (left ast) asm))))
                    ((Negate Not Prtc Prti Prts) ; unary operations
                     (cons (change-name (car ast))
                           (pass-1 (left ast) asm)))
                    ((If)
                     (let ((label-else (new-address))
                           (label-end (new-address)))
                       (if (null? (right (right ast)))
                         (cons (list 'label label-end) ; label for end of if statement
                               (pass-1 (left (right ast)) ; output the 'then block
                                       (cons (list 'jz label-end) ; jump to end when test is false
                                             (pass-1 (left ast) asm))))
                         (cons (list 'label label-end) ; label for end of if statement
                               (pass-1 (right (right ast)) ; output the 'else block
                                       (cons (list 'label label-else)
                                             (cons (list 'jmp label-end) ; jump past 'else, after 'then
                                                   (pass-1 (left (right ast)) ; output the 'then block
                                                           (cons (list 'jz label-else) ; jumpt to else when false
                                                                 (pass-1 (left ast) asm))))))))))
                    ((While)
                     (let ((label-test (new-address))
                           (label-end (new-address)))
                       (cons (list 'label label-end) ; introduce a label for end of while block
                             (cons (list 'jmp label-test) ; jump back to repeat test
                                   (pass-1 (right ast)  ; output the block
                                           (cons (list 'jz label-end) ; test failed, jump around block
                                                 (pass-1 (left ast) ; output the test
                                                         (cons (list 'label label-test) ; introduce a label for test
                                                               asm))))))))
                    ((Sequence)
                     (pass-1 (right ast) (pass-1 (left ast) asm)))
                    (else
                      "Unknown token type"))))
              ;
              (define (pass-2 asm) ; adds addresses and fills in jump locations
                (define (fill-addresses)
                  (let ((addr 0))
                    (map (lambda (instr)
                           (let ((res (cons addr instr)))
                             (unless (eq? (car instr) 'label)
                               (set! addr (+ addr (if (= 1 (length instr)) 1 5))))
                             res))
                         asm)))
                ;
                (define (extract-labels asm)
                  (let ((labels '()))
                    (for-each (lambda (instr)
                                (when (eq? (cadr instr) 'label)
                                  (set! labels (cons (cons (cadr (cdr instr)) (car instr))
                                                     labels))))
                              asm)
                    labels))
                ;
                (define (add-jump-locations asm labels rec)
                  (cond ((null? asm)
                         (reverse rec))
                        ((eq? (cadr (car asm)) 'label) ; ignore the labels
                         (add-jump-locations (cdr asm) labels rec))
                        ((memq (cadr (car asm)) '(jmp jz)) ; replace labels with addresses for jumps
                         (add-jump-locations (cdr asm)
                                             labels
                                             (cons (list (car (car asm)) ; previous address
                                                         (cadr (car asm)) ; previous jump type
                                                         (cdr (assq (cadr (cdar asm)) labels))) ; actual address
                                                   rec)))
                        (else
                          (add-jump-locations (cdr asm) labels (cons (car asm) rec)))))
                ;
                (let ((asm+addr (fill-addresses)))
                  (add-jump-locations asm+addr (extract-labels asm+addr) '())))
              ;
              (define (output-instruction instr)
                   (display (number->string (car instr))) (display #\tab)
                   (display (cadr instr)) (display #\tab)
                (case (cadr instr)
                  ((fetch store)
                   (display "[") (display (number->string (cadr (cdr instr)))) (display "]\n"))
                  ((jmp jz)
                   (display
                     (string-append "("
                                    (number->string (- (cadr (cdr instr)) (car instr) 1))
                                    ")"))
                   (display #\tab)
                   (display (number->string (cadr (cdr instr)))) (newline))
                  ((push)
                   (display (cadr (cdr instr))) (newline))
                  (else
                    (newline))))
              ; generate the code and output to stdout
              (display
                (string-append "Datasize: "
                               (number->string (length constants))
                               " Strings: "
                               (number->string (length strings))))
              (newline)
              (for-each (lambda (str) (display str) (newline))
                        strings)
              (for-each output-instruction
                        (pass-2 (reverse (cons (list 'halt) (pass-1 ast '())))))))

;; read AST from file and output code to stdout
(if (= 2 (length (command-line)))
  (generate-code (read-code (cadr (command-line))))
  (display "Error: pass an ast filename\n"))


--This is a single line comment

display dialog "ok" --it can go at the end of a line

# Hash style comments are also supported

(* This is a multi
line comment*)

(* This is a comment. --comments can be nested
  (* Nested block comment *)
*)


/* ARM assembly Raspberry PI comment one line */
/*  comment line 1
    comment line 2
*/

	mov r0,#0    @ this comment on end of line
	mov r1,#0    //  authorized comment


using Colors, FileIO

const colors = [colorant"black", colorant"red", colorant"green", colorant"blue",
                colorant"magenta", colorant"cyan", colorant"yellow", colorant"white"]

function getnumberwithprompt(prompt, t::Type)
    s = ""
    while (x = tryparse(t, s)) == nothing
        print("\n", prompt, ": -> ")
        s = strip(readline())
    end
    return x
end

function colorstripepng(filename)
    dpi = getnumberwithprompt("Printer DPI (dots per inch)", Int)
    pwidth, plength = getnumberwithprompt("Printer width (inches)", Float64), 10
    imgwidth, imgheight = Int(round(pwidth * dpi)), plength * dpi
    img = fill(colorant"black", imgheight, imgwidth)

    for row in 1:imgheight
        stripenum, stripewidth, colorindex = 1, div(row, dpi) + 1, 1
        for col in 1:imgwidth
            img[row, col] = colors[colorindex]
            if (stripenum += 1) % stripewidth == 0
                colorindex = mod1(colorindex + 1, length(colors))
            end
        end
    end
    save(filename, img)
end

colorstripepng("temp.png")
run(`print temp.png`)  # the run statement may need to be set up for the installed device


import gintro/[glib, gobject, gtk, gio, cairo]

const Colors = [[0.0, 0.0, 0.0], [255.0, 0.0, 0.0],
                [0.0, 255.0, 0.0], [0.0, 0.0, 255.0],
                [255.0, 0.0, 255.0], [0.0, 255.0, 255.0],
                [255.0, 255.0, 0.0], [255.0, 255.0, 255.0]]

#---------------------------------------------------------------------------------------------------

proc beginPrint(op: PrintOperation; printContext: PrintContext; data: pointer) =
  ## Process signal "begin_print", that is set the number of pages to print.
  op.setNPages(1)

#---------------------------------------------------------------------------------------------------

proc drawPage(op: PrintOperation; printContext: PrintContext; pageNum: int; data: pointer) =
  ## Draw a page.

  let context = printContext.getCairoContext()
  let lineHeight = printContext.height / 4

  var y = 0.0
  for lineWidth in [1.0, 2.0, 3.0, 4.0]:
    context.setLineWidth(lineWidth)
    var x = 0.0
    var colorIndex = 0
    while x < printContext.width:
      context.setSource(Colors[colorIndex])
      context.moveTo(x, y)
      context.lineTo(x, y + lineHeight)
      context.stroke()
      colorIndex = (colorIndex + 1) mod Colors.len
      x += lineWidth
    y += lineHeight

#---------------------------------------------------------------------------------------------------

proc activate(app: Application) =
  ## Activate the application.

  # Launch a print operation.
  let op = newPrintOperation()
  op.connect("begin_print", beginPrint, pointer(nil))
  op.connect("draw_page", drawPage, pointer(nil))

  # Run the print dialog.
  discard op.run(printDialog)

#———————————————————————————————————————————————————————————————————————————————————————————————————

let app = newApplication(Application, "Rosetta.ColorPinstripe")
discard app.connect("activate", activate)
discard app.run()


(load "@lib/ps.l")

# Using circular lists for an endless supply of colors
#      (black  red  green blue magenta cyan yellow white)
(setq
   Red   (0    100    0     0    100    0    100   100 .)
   Green (0     0    100    0     0    100   100   100 .)
   Blue  (0     0     0    100   100   100    0    100 .) )

(call 'lpr
   (pdf "pinstripes"
      (a4)  # 595 x 842 dots
      (let (I 0  Step 1)
         (for X 595
            (color (car Red) (car Green) (car Blue)
               (vline X 0 842) )
            (when (= Step (inc 'I))
               (zero I)
               (pop 'Red)
               (pop 'Green)
               (pop 'Blue) )
            (when (=0 (% X 72))  # 1 inch
               (zero I)
               (inc 'Step) ) ) )
      (page) ) )


from turtle import *
from PIL import Image
import time
import subprocess

"""

Only works on Windows. Assumes that you have Ghostscript
installed and in your path.

https://www.ghostscript.com/download/gsdnld.html

Hard coded to 100 pixels per inch.

"""

colors = ["black", "red", "green", "blue", "magenta", "cyan", "yellow", "white"]

screen = getscreen()

# width and height in pixels
# aspect ratio for 11 by 8.5 paper

inch_width = 11.0
inch_height = 8.5

pixels_per_inch = 100

pix_width = int(inch_width*pixels_per_inch)
pix_height = int(inch_height*pixels_per_inch)

screen.setup (width=pix_width, height=pix_height, startx=0, starty=0)

screen.screensize(pix_width,pix_height)

# center is 0,0

# get coordinates of the edges

left_edge = -screen.window_width()//2

right_edge = screen.window_width()//2

bottom_edge = -screen.window_height()//2

top_edge = screen.window_height()//2

# draw quickly

screen.delay(0)
screen.tracer(5)

for inch in range(int(inch_width)-1):
    line_width = inch + 1
    pensize(line_width)
    colornum = 0

    min_x = left_edge + (inch * pixels_per_inch)
    max_x = left_edge + ((inch+1) * pixels_per_inch)

    for y in range(bottom_edge,top_edge,line_width):
        penup()
        pencolor(colors[colornum])
        colornum = (colornum + 1) % len(colors)
        setposition(min_x,y)
        pendown()
        setposition(max_x,y)

screen.getcanvas().postscript(file="striped.eps")

# convert to jpeg
# won't work without Ghostscript.

im = Image.open("striped.eps")
im.save("striped.jpg")

# Got idea from http://rosettacode.org/wiki/Colour_pinstripe/Printer#Go

subprocess.run(["mspaint", "/pt", "striped.jpg"])


Module syntax_analyzer(b$){
	enum tokens {
		Op_add, Op_subtract, Op_not=5, Op_multiply=10, Op_divide, Op_mod,
		Op_negate,  Op_less, Op_lessequal, Op_greater, Op_greaterequal,
		Op_equal, Op_notequal, Op_and, Op_or, Op_assign=100, Keyword_if=110,
		Keyword_else, Keyword_while, Keyword_print, Keyword_putc, LeftParen, RightParen,
		LeftBrace, RightBrace, Semicolon, Comma, Identifier, Integer, String, End_of_input
	}

	Inventory precedence=Op_multiply:=13, Op_divide:=13, Op_mod:=13, Op_add:=12, Op_subtract:=12
	Append  precedence, Op_negate:=14, Op_not:=14, Op_less:=10, Op_lessequal:=10, Op_greater:=10
	Append  precedence, Op_greaterequal:=10, Op_equal:=9, Op_notequal:=9, Op_assign:=-1, Op_and:=5
	Append  precedence, Op_or:=4

	Inventory symbols=Op_multiply:="Multiply", Op_divide:="Divide", Op_mod:="Mod", Op_add:="Add"
	Append  symbols, Op_negate:="Negate", Op_not:="Not", Op_less:="Less", Op_subtract:="Subtract"
	Append  symbols, Op_lessequal:="LessEqual", Op_greater:="Greater", Op_greaterequal:="GreaterEqual"
	Append  symbols, Op_equal:="Equal", Op_notequal:="NotEqual",  Op_and:="And", Op_or:="Or"

	def lineNo, ColumnNo, m, line$, a, lim, cur=-1
	const nl$=chr$(13)+chr$(10), Ansi=3
	Dim lex$()
	lex$()=piece$(b$,chr$(13)+chr$(10))
	lim=dimension(lex$(),1)-1
	op=End_of_input
	flush
	k=0
	Try {
		push (,)   ' Null
		getone(&op)
		repeat
		stmt(&op)
		shift 2  ' swap two top items
		push ("Sequence", array, array)
		k++
		until op=End_of_Input
	}
	er$=error$
	if er$<>"" then print er$ : flush: break
	Print "Ast"
	Document Output$
	prt_ast()
	clipboard Output$
	Save.Doc Output$, "parse.t", Ansi
	document parse$
	Load.Doc parse$,"parse.t", Ansi
	Report parse$

	sub prt_ast(t)
		if len(t)<1 then
			Output$=";"+nl$
		else.if len(t)=3 then
			Output$=t#val$(0) +nl$
			prt_ast(t#val(1)) : prt_ast(t#val(2))
		else
			Output$=t#val$(0) +nl$
		end if
	end sub
	sub expr(p)   ' only a number
		local x=(,), prev=op
		if  op>=Identifier then
			x=(line$,)
			getone(&op)
		else.if op=LeftParen then
			paren_exp()
			x=array
		else.if op<10 then
			getone(&op)
			expr(precedence(int(Op_negate)))
			read local y
			if prev=Op_add then
				x=y
			else
				if prev=Op_subtract then prev=Op_negate
				x=(symbols(prev), y,(,))
			End if
		else
			 {error "??? "+eval$(op)}
		end if
		local prec
		while exist(precedence, int(op))
			prev=op : prec=eval(precedence)
			if prec<14 and prec>=p else exit
			getone(&op)
			expr(prec+1)  ' all operators are left associative (use prec for right a.)
			x=(symbols(int(prev)), x, array)
		End While
		Push x
	end sub
	sub paren_exp()
		expected(LeftParen)
		getone(&op)
		expr(0)
		expected(RightParen)
		getone(&op)
	end sub
	sub stmt(&op)
		local t=(,)
		if op=Identifier then
			t=(line$)
			getone(&op)
			expected(Op_assign)
			getone(&op)
			expr(0)
			read local rightnode
			Push ("Assign",t,rightnode)
			expected(Semicolon)
			getone(&op)
		else.if op=Semicolon then
			getone(&op)
			Push (";",)
		else.if op=Keyword_print then
			getone(&op)
			expected(LeftParen)
			repeat
				getone(&op)
				if op=String then
					Push ("Prts",(line$,),(,))
					getone(&op)
				else
					expr(0)
					Push ("Prti", array,(,))
				end if
				t=("Sequence", t, array)
			until op<>Comma
			expected(RightParen)
			getone(&op)
			expected(Semicolon)
			getone(&op)
			push t
		else.if op=Keyword_while then
			getone(&op)
			paren_exp()
			stmt(&op)
			shift 2
			Push ("While",array, array)
		else.if op=Keyword_if then
			getone(&op)
			paren_exp()
			stmt(&op)
			local s2=(,)
			if op=Keyword_else then
				getone(&op)
				stmt(&op)
				read s2
			end if
			shift 2
			Push ("If",array ,("If",array,s2))
		else.if op=Keyword_putc then
			getone(&op)
			paren_exp()
			Push ("Prtc",array,t)
			expected(Semicolon)
			getone(&op)
		else.if op=LeftBrace then
			Brace()
		else
			error "Unkown Op"
		end if
	end sub
	Sub Brace()
			getone(&op)
			while op<>RightBrace and op<>End_of_input
				stmt(&op)
				t=("Sequence", t, array)
			end while
			expected(RightBrace)
			getone(&op)
			push t
	End Sub
	Sub expected(what)
		if not op=what then {Error "Expected "+eval$(what)+str$(LineNo)+","+Str$(ColumnNo)}
	End Sub
	sub getone(&op)
		op=End_of_input
		while cur<lim
		cur++
		line$=trim$(lex$(cur))
		if line$<>"" then exit
		end while
		if cur=lim then exit sub
		LineNo=Val(line$,"int",m)
		line$=mid$(line$, m)
		ColumnNo=Val(line$,"int",m)
		line$=trim$(mid$(line$, m))
		Rem : Print LineNo, ColumnNo
		m=instr(line$," ")
		if m>0 then op=Eval("."+leftpart$(line$, " ")) else op=Eval("."+line$)
	end sub
}

syntax_analyzer {
         1         1 LeftBrace
         5         5 Identifier left_edge
         5        17 Op_assign
         5        19 Op_subtract
         5        20 Integer 420
         5        23 Semicolon
         6         5 Identifier right_edge
         6        17 Op_assign
         6        20 Integer 300
         6        23 Semicolon
         7         5 Identifier top_edge
         7        17 Op_assign
         7        20 Integer 300
         7        23 Semicolon
         8         5 Identifier bottom_edge
         8        17 Op_assign
         8        19 Op_subtract
         8        20 Integer 300
         8        23 Semicolon
         9         5 Identifier x_step
         9        17 Op_assign
         9        22 Integer 7
         9        23 Semicolon
        10         5 Identifier y_step
        10        17 Op_assign
        10        21 Integer 15
        10        23 Semicolon
        12         5 Identifier max_iter
        12        17 Op_assign
        12        20 Integer 200
        12        23 Semicolon
        14         5 Identifier y0
        14         8 Op_assign
        14        10 Identifier top_edge
        14        18 Semicolon
        15         5 Keyword_while
        15        11 LeftParen
        15        12 Identifier y0
        15        15 Op_greater
        15        17 Identifier bottom_edge
        15        28 RightParen
        15        30 LeftBrace
        16         9 Identifier x0
        16        12 Op_assign
        16        14 Identifier left_edge
        16        23 Semicolon
        17         9 Keyword_while
        17        15 LeftParen
        17        16 Identifier x0
        17        19 Op_less
        17        21 Identifier right_edge
        17        31 RightParen
        17        33 LeftBrace
        18        13 Identifier y
        18        15 Op_assign
        18        17 Integer 0
        18        18 Semicolon
        19        13 Identifier x
        19        15 Op_assign
        19        17 Integer 0
        19        18 Semicolon
        20        13 Identifier the_char
        20        22 Op_assign
        20        24 Integer 32
        20        27 Semicolon
        21        13 Identifier i
        21        15 Op_assign
        21        17 Integer 0
        21        18 Semicolon
        22        13 Keyword_while
        22        19 LeftParen
        22        20 Identifier i
        22        22 Op_less
        22        24 Identifier max_iter
        22        32 RightParen
        22        34 LeftBrace
        23        17 Identifier x_x
        23        21 Op_assign
        23        23 LeftParen
        23        24 Identifier x
        23        26 Op_multiply
        23        28 Identifier x
        23        29 RightParen
        23        31 Op_divide
        23        33 Integer 200
        23        36 Semicolon
        24        17 Identifier y_y
        24        21 Op_assign
        24        23 LeftParen
        24        24 Identifier y
        24        26 Op_multiply
        24        28 Identifier y
        24        29 RightParen
        24        31 Op_divide
        24        33 Integer 200
        24        36 Semicolon
        25        17 Keyword_if
        25        20 LeftParen
        25        21 Identifier x_x
        25        25 Op_add
        25        27 Identifier y_y
        25        31 Op_greater
        25        33 Integer 800
        25        37 RightParen
        25        39 LeftBrace
        26        21 Identifier the_char
        26        30 Op_assign
        26        32 Integer 48
        26        36 Op_add
        26        38 Identifier i
        26        39 Semicolon
        27        21 Keyword_if
        27        24 LeftParen
        27        25 Identifier i
        27        27 Op_greater
        27        29 Integer 9
        27        30 RightParen
        27        32 LeftBrace
        28        25 Identifier the_char
        28        34 Op_assign
        28        36 Integer 64
        28        39 Semicolon
        29        21 RightBrace
        30        21 Identifier i
        30        23 Op_assign
        30        25 Identifier max_iter
        30        33 Semicolon
        31        17 RightBrace
        32        17 Identifier y
        32        19 Op_assign
        32        21 Identifier x
        32        23 Op_multiply
        32        25 Identifier y
        32        27 Op_divide
        32        29 Integer 100
        32        33 Op_add
        32        35 Identifier y0
        32        37 Semicolon
        33        17 Identifier x
        33        19 Op_assign
        33        21 Identifier x_x
        33        25 Op_subtract
        33        27 Identifier y_y
        33        31 Op_add
        33        33 Identifier x0
        33        35 Semicolon
        34        17 Identifier i
        34        19 Op_assign
        34        21 Identifier i
        34        23 Op_add
        34        25 Integer 1
        34        26 Semicolon
        35        13 RightBrace
        36        13 Keyword_putc
        36        17 LeftParen
        36        18 Identifier the_char
        36        26 RightParen
        36        27 Semicolon
        37        13 Identifier x0
        37        16 Op_assign
        37        18 Identifier x0
        37        21 Op_add
        37        23 Identifier x_step
        37        29 Semicolon
        38         9 RightBrace
        39         9 Keyword_putc
        39        13 LeftParen
        39        14 Integer 10
        39        18 RightParen
        39        19 Semicolon
        40         9 Identifier y0
        40        12 Op_assign
        40        14 Identifier y0
        40        17 Op_subtract
        40        19 Identifier y_step
        40        25 Semicolon
        41         5 RightBrace
        42         1 RightBrace
        43         1 End_of_Input
}


// The program name and the directory it was called from are in
// param[0] , so given the axample of myprogram -c "alpha beta" -h "gamma"

  for x := 0 to paramcount do
      writeln('param[',x,'] = ',param[x]);

// will yield ( assuming windows and the c drive as the only drive) :

//  param[0] = c:\myprogram
//  param[1] = -c
//  param[2] = alpha beta
//  param[3] = -h
//  param[4] = gamma


for i range 0 -- len !args:
	print\( "Argument #" i " is " )
	. get-from !args i

if has !opts :c:
	!print "Ah, the -c option."

if has !opts :four:
	!. get-from !opts :four


\util.g

proc nonrec main() void:
    *char par;
    word i;
    i := 0;
    while par := GetPar(); par ~= nil do
        i := i + 1;
        writeln(i:3, ": '", par, "'")
    od
corp


class
    APPLICATION
inherit
    ARGUMENTS
create
    make
feature {NONE} -- Initialization
    make
            -- Print values for arguments with options 'c' and 'h'.
        do
            print ("Command line argument value for option 'c' is: ")
            print (separate_character_option_value ('c') + "%N")
            print ("Command line argument value for option 'h' is: ")
            print (separate_character_option_value ('h') + "%N")
            io.read_line    -- Keep console window open
        end
end


import "/dynamic" for Enum, Struct, Tuple
import "/crypto" for Bytes
import "/fmt" for Fmt
import "/ioutil" for FileUtil

var nodes = [
    "Ident",
    "String",
    "Integer",
    "Sequence",
    "If",
    "Prtc",
    "Prts",
    "Prti",
    "While",
    "Assign",
    "Negate",
    "Not",
    "Mul",
    "Div",
    "Mod",
    "Add",
    "Sub",
    "Lss",
    "Leq",
    "Gtr",
    "Geq",
    "Eql",
    "Neq",
    "And",
    "Or"
]

var Node = Enum.create("Node", nodes)

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 Tree = Struct.create("Tree", ["nodeType", "left", "right", "value"])

// dependency: Ordered by Node value, must remain in same order as Node enum
var Atr = Tuple.create("Atr", ["enumText", "nodeType", "opcode"])

var atrs = [
    Atr.new("Identifier", Node.Ident, 255),
    Atr.new("String", Node.String, 255),
    Atr.new("Integer", Node.Integer, 255),
    Atr.new("Sequence", Node.Sequence, 255),
    Atr.new("If", Node.If, 255),
    Atr.new("Prtc", Node.Prtc, 255),
    Atr.new("Prts", Node.Prts, 255),
    Atr.new("Prti", Node.Prti, 255),
    Atr.new("While", Node.While, 255),
    Atr.new("Assign", Node.Assign, 255),
    Atr.new("Negate", Node.Negate, Code.neg),
    Atr.new("Not", Node.Not, Code.not),
    Atr.new("Multiply", Node.Mul, Code.mul),
    Atr.new("Divide", Node.Div, Code.div),
    Atr.new("Mod", Node.Mod, Code.mod),
    Atr.new("Add", Node.Add, Code.add),
    Atr.new("Subtract", Node.Sub, Code.sub),
    Atr.new("Less", Node.Lss, Code.lt),
    Atr.new("LessEqual", Node.Leq, Code.le),
    Atr.new("Greater", Node.Gtr, Code.gt),
    Atr.new("GreaterEqual", Node.Geq, Code.ge),
    Atr.new("Equal", Node.Eql, Code.eq),
    Atr.new("NotEqual", Node.Neq, Code.ne),
    Atr.new("And", Node.And, Code.and),
    Atr.new("Or", Node.Or, Code.or),
]

var stringPool = []
var globals    = []
var object     = []

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

var nodeToOp = Fn.new { |nodeType| atrs[nodeType].opcode }

var makeNode = Fn.new { |nodeType, left, right| Tree.new(nodeType, left, right, "") }

var makeLeaf = Fn.new { |nodeType, value| Tree.new(nodeType, null, null, value) }

/* Code generator */

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

var emitWordAt = Fn.new { |at, n|
    var bs = Bytes.fromIntLE(n)
    for (i in at...at+4) object[i] = bs[i-at]
}

var hole = Fn.new {
    var t = object.count
    emitWord.call(0)
    return t
}

var fetchVarOffset = Fn.new { |id|
    for (i in 0...globals.count) {
        if (globals[i] == id) return i
    }
    globals.add(id)
    return globals.count - 1
}

var fetchStringOffset = Fn.new { |st|
    for (i in 0...stringPool.count) {
        if (stringPool[i] == st) return i
    }
    stringPool.add(st)
    return stringPool.count - 1
}

var binOpNodes = [
    Node.Lss, Node.Gtr, Node.Leq, Node.Geq, Node.Eql, Node.Neq,
    Node.And, Node.Or, Node.Sub, Node.Add, Node.Div, Node.Mul, Node.Mod
]

var codeGen // recursive function
codeGen = Fn.new { |x|
    if (!x) return
    var n
    var p1
    var p2
    var nt = x.nodeType
    if (nt == Node.Ident) {
        emitByte.call(Code.fetch)
        n = fetchVarOffset.call(x.value)
        emitWord.call(n)
    } else if (nt == Node.Integer) {
        emitByte.call(Code.push)
        n = Num.fromString(x.value)
        emitWord.call(n)
    } else if (nt == Node.String) {
        emitByte.call(Code.push)
        n = fetchStringOffset.call(x.value)
        emitWord.call(n)
    } else if (nt == Node.Assign) {
        n = fetchVarOffset.call(x.left.value)
        codeGen.call(x.right)
        emitByte.call(Code.store)
        emitWord.call(n)
    } else if (nt == Node.If) {
        codeGen.call(x.left)       // if expr
        emitByte.call(Code.jz)     // if false, jump
        p1 = hole.call()           // make room forjump dest
        codeGen.call(x.right.left) // if true statements
        if (x.right.right) {
            emitByte.call(Code.jmp)
            p2 = hole.call()
        }
        emitWordAt.call(p1, object.count-p1)
        if (x.right.right) {
            codeGen.call(x.right.right)
            emitWordAt.call(p2, object.count-p2)
        }
    } else if (nt == Node.While) {
        p1 = object.count
        codeGen.call(x.left)                 // while expr
        emitByte.call(Code.jz)               // if false, jump
        p2 = hole.call()                     // make room for jump dest
        codeGen.call(x.right)                // statements
        emitByte.call(Code.jmp)              // back to the top
        emitWord.call(p1 - object.count)     // plug the top
        emitWordAt.call(p2, object.count-p2) // plug the 'if false, jump'
    } else if (nt == Node.Sequence) {
        codeGen.call(x.left)
        codeGen.call(x.right)
    } else if (nt == Node.Prtc) {
        codeGen.call(x.left)
        emitByte.call(Code.prtc)
    } else if (nt == Node.Prti) {
        codeGen.call(x.left)
        emitByte.call(Code.prti)
    } else if (nt == Node.Prts) {
        codeGen.call(x.left)
        emitByte.call(Code.prts)
    } else if (binOpNodes.contains(nt)) {
        codeGen.call(x.left)
        codeGen.call(x.right)
        emitByte.call(nodeToOp.call(x.nodeType))
    } else if (nt == Node.negate || nt == Node.Not) {
        codeGen.call(x.left)
        emitByte.call(nodeToOp.call(x.nodeType))
    } else {
        var msg = "error in code generator - found %(x.nodeType) expecting operator"
        reportError.call(msg)
    }
}

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

var codeFinish = Fn.new { emitByte.call(Code.halt) }

var listCode = Fn.new {
    Fmt.print("Datasize: $d Strings: $d", globals.count, stringPool.count)
    for (s in stringPool) System.print(s)
    var pc = 0
    while (pc < object.count) {
        Fmt.write("$5d ", pc)
        var op = object[pc]
        pc = pc + 1
        if (op == Code.fetch) {
            var x = toInt32LE.call(pc)
            Fmt.print("fetch [$d]", x)
            pc = pc + 4
        } else if (op == Code.store) {
            var x = toInt32LE.call(pc)
            Fmt.print("store [$d]", x)
            pc = pc + 4
        } else if (op == Code.push) {
            var x = toInt32LE.call(pc)
            Fmt.print("push  $d", x)
            pc = pc + 4
        } else if (op == Code.add) {
            System.print("add")
        } else if (op == Code.sub) {
            System.print("sub")
        } else if (op == Code.mul) {
            System.print("mul")
        } else if (op == Code.div) {
            System.print("div")
        } else if (op == Code.mod) {
            System.print("mod")
        } else if (op == Code.lt) {
            System.print("lt")
        } else if (op == Code.gt) {
            System.print("gt")
        } else if (op == Code.le) {
            System.print("le")
        } else if (op == Code.ge) {
            System.print("ge")
        } else if (op == Code.eq) {
            System.print("eq")
        } else if (op == Code.ne) {
            System.print("ne")
        } else if (op == Code.and) {
            System.print("and")
        } else if (op == Code.or) {
            System.print("or")
        } else if (op == Code.neg) {
            System.print("neg")
        } else if (op == Code.not) {
            System.print("not")
        } else if (op == Code.jmp) {
            var x = toInt32LE.call(pc)
            Fmt.print("jmp    ($d) $d", x, pc+x)
            pc = pc + 4
        } else if (op == Code.jz) {
            var x = toInt32LE.call(pc)
            Fmt.print("jz     ($d) $d", x, pc+x)
            pc = pc + 4
        } else if (op == Code.prtc) {
            System.print("prtc")
        } else if (op == Code.prti){
            System.print("prti")
        } else if (op == Code.prts) {
            System.print("prts")
        } else if (op == Code.halt) {
            System.print("halt")
        } else {
            reportError.call("listCode: Unknown opcode %(op)")
        }
    }
}

var getEnumValue = Fn.new { |name|
    for (atr in atrs) {
        if (atr.enumText == name) return atr.nodeType
    }
    reportError.call("Unknown token %(name)")
}

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

var loadAst  // recursive function
loadAst = Fn.new {
    var nodeType = 0
    var s = ""
    if (lineNum < lineCount) {
        var line = lines[lineNum].trimEnd(" \t")
        lineNum = lineNum + 1
        var tokens = line.split(" ").where { |s| s != "" }.toList
        var first = tokens[0]
        if (first[0] == ";") return null
        nodeType = getEnumValue.call(first)
        var le = tokens.count
        if (le == 2) {
            s = tokens[1]
        } else if (le > 2) {
            var idx = line.indexOf("\"")
            s = line[idx..-1]
        }
    }
    if (s != "") return makeLeaf.call(nodeType, s)
    var left  = loadAst.call()
    var right = loadAst.call()
    return makeNode.call(nodeType, left, right)
}

lines = FileUtil.readLines("ast.txt")
lineCount = lines.count
codeGen.call(loadAst.call())
codeFinish.call()
listCode.call()


; This is a simple single-line comment

a: 10 ; another single-line comment

; Now, this is a
; multi-line comment


Msgbox, comments demo ; end of line comment
/*
multiline comment1
multiline comment2
*/


#lang racket/gui

(define parts 4)

(define dc (new printer-dc%))
(send* dc (start-doc "Colour Pinstripe") (start-page))

(define-values [W H] (send dc get-size))
(define parts 4)
(define colors
  '("Black" "Red" "Green" "Blue" "Magenta" "Cyan" "Yellow" "White"))
(send dc set-pen "black" 0 'transparent)
(send dc set-brush "black" 'solid)
(define H* (round (/ H parts)))
(for ([row parts])
  (define Y (* row H*))
  (for ([X (in-range 0 W (add1 row))] [c (in-cycle colors)])
    (send dc set-brush c 'solid)
    (send dc draw-rectangle X Y (add1 row) H*)))

(send* dc (end-page) (end-doc))


unit sub MAIN ($dpi = 300, $size = 'letter');

my $filename = './Color-pinstripe-printer-perl6.png';

my %paper = (
    'letter' => { :width(8.5),    :height(11.0) }
    'A4'     => { :width(8.2677), :height(11.6929)}
);

my ($w, $h) = %paper{$size}<width height> »*» $dpi;

# ROYGBIVK
my @color = (1,0,0),(1,.598,0),(1,1,0),(0,1,0),(0,0,1),(.294,0,.51),(.58,0,.827),(0,0,0);

my $gap = floor $w % ($dpi * +@color) / 2;

my $rows = (1, * * 2 … * > $dpi).elems;

my $height = $dpi;

use Cairo;

my @colors = @color.map: { Cairo::Pattern::Solid.new.create(|$_) };

given Cairo::Image.create(Cairo::FORMAT_ARGB32, $w, $h) -> $image {
    given Cairo::Context.new($image) {
        my Cairo::Pattern::Solid $bg .= create(1,1,1);
        .rectangle(0, 0, $w, $h);
        .pattern($bg);
        .fill;
        $bg.destroy;

        my $y = $gap;
        for ^$rows -> $row {
            my $x = $gap;
            my $width = $dpi / (2 ** $row);
            for @colors -> $this {
                my $v = 0;
                while $v++ < (2 ** ($row - 1)) {
                    given Cairo::Context.new($image) -> $block {
                        $block.rectangle($x, $y, $width, $height);
                        $block.pattern($this);
                        $block.fill;
                        $block.destroy;
                    }
                    $x += $width;
                    $x += $width if $row;
                }
            }
        $y += $height;
        }
    }
    $image.write_png($filename);
}

# Uncomment next line if you actually want to print it
#run('lp', $filename)


import ast_lexer

type NodeKind* = enum
                    nIdentifier = "Identifier"
                    nString = "String"
                    nInteger = "Integer"
                    nSequence = "Sequence"
                    nIf = "If"
                    nPrtc = "Prtc"
                    nPrts = "Prts"
                    nPrti = "Prti"
                    nWhile = "While"
                    nAssign = "Assign"
                    nNegate = "Negate"
                    nNot = "Not"
                    nMultiply = "Multiply"
                    nDivide = "Divide"
                    nMod = "Mod"
                    nAdd = "Add"
                    nSubtract = "Subtract"
                    nLess = "Less"
                    nLessEqual = "LessEqual"
                    nGreater = "Greater"
                    nGreaterEqual = "GreaterEqual"
                    nEqual = "Equal"
                    nNotEqual = "NotEqual"
                    nAnd = "And"
                    nOr = "Or"

type Node* = ref object
  left*: Node
  right*: Node
  case kind*: NodeKind
  of nString: stringVal*: string
  of nInteger: intVal*: int
  of nIdentifier: name*: string
  else: nil

type Operator = range[tokMult..tokOr]

const

  Precedences: array[Operator, int] = [13,  # tokMult
                                       13,  # tokDiv
                                       13,  # tokMod
                                       12,  # tokAdd
                                       12,  # tokSub
                                       10,  # tokLess
                                       10,  # tokLessEq
                                       10,  # tokGreater
                                       10,  # tokGreaterEq
                                        9,  # tokEq
                                        9,  # tokNeq
                                       14,  # tokNot
                                       -1,  # tokAssign
                                        5,  # tokAnd
                                        4]  # tokOr
  UnaryPrecedence = 14
  BinaryOperators = {tokMult, tokDiv, tokMod, tokAdd, tokSub, tokLess, tokLessEq,
                    tokGreater, tokGreaterEq, tokEq, tokNotEq, tokAnd, tokOr}

  # Mapping of operators from TokenKind to NodeKind.
  NodeKinds: array[Operator, NodeKind] = [nMultiply, nDivide, nMod, nAdd, nSubtract,
                                          nLess, nLessEqual, nGreater, nGreaterEqual,
                                          nEqual, nNotEqual, nNot, nAssign, nAnd, nOr]

type SyntaxError* = object of CatchableError

####################################################################################################

template expect(token: Token; expected: TokenKind; errmsg: string) =
  ## Check if a token is of the expected kind.
  ## Raise a SyntaxError if this is not the case.
  if token.kind != expected:
    raise newException(SyntaxError, "line " & $token.ln & ": " & errmsg)
  token = lexer.next()

#---------------------------------------------------------------------------------------------------

proc newNode*(kind: NodeKind; left: Node; right: Node = nil): Node =
  ## Create a new node with given left and right children.
  result = Node(kind: kind, left: left, right: right)

#---------------------------------------------------------------------------------------------------

# Forward reference.
proc parExpr(lexer: var Lexer; token: var Token): Node

#---------------------------------------------------------------------------------------------------

proc expr(lexer: var Lexer; token: var Token; p: int): Node =
  ## Parse an expression.

  case token.kind

  of tokLPar:
    result = parExpr(lexer, token)

  of tokAdd, tokSub, tokNot:
    # Unary operators.
    let savedToken = token
    token = lexer.next()
    let e = expr(lexer, token, UnaryPrecedence)
    if savedToken.kind == tokAdd:
      result = e
    else:
      result = newNode(if savedToken.kind == tokSub: nNegate else: nNot, e)

  of tokIdent:
    result = Node(kind: nIdentifier, name: token.ident)
    token = lexer.next()

  of tokInt:
    result = Node(kind:nInteger, intVal: token.intVal)
    token = lexer.next()

  of tokChar:
    result = Node(kind:nInteger, intVal: ord(token.charVal))
    token = lexer.next()

  else:
    raise newException(SyntaxError, "Unexpected symbol at line " & $token.ln)

  # Process the binary operators in the expression.
  while token.kind in BinaryOperators and Precedences[token.kind] >= p:
    let savedToken = token
    token = lexer.next()
    let q = Precedences[savedToken.kind] + 1  # No operator is right associative.
    result = newNode(NodeKinds[savedToken.kind], result, expr(lexer, token, q))

#---------------------------------------------------------------------------------------------------

proc parExpr(lexer: var Lexer; token: var Token): Node =
  ## Parse a parenthetized expression.
  token.expect(tokLPar, "'(' expected")
  result = expr(lexer, token, 0)
  token.expect(tokRPar, "')' expected")

#---------------------------------------------------------------------------------------------------

proc stmt(lexer: var Lexer; token: var Token): Node =
  ## Parse a statement.

  case token.kind:

  of tokIf:
    token = lexer.next()
    let e = parExpr(lexer, token)
    let thenNode = stmt(lexer, token)
    var elseNode: Node = nil
    if token.kind == tokElse:
      token = lexer.next()
      elseNode = stmt(lexer, token)
    result = newNode(nIf, e, newNode(nIf, thenNode, elseNode))

  of tokPutc:
    token = lexer.next()
    result = newNode(nPrtc, parExpr(lexer, token))
    token.expect(tokSemi, "';' expected")

  of tokPrint:
    token = lexer.next()
    token.expect(tokLPar, "'(' expected")
    while true:
      var e: Node
      if token.kind == tokString:
        e = newNode(nPrts, Node(kind: nString, stringVal: token.stringVal))
        token = lexer.next()
      else:
        e = newNode(nPrti, expr(lexer, token, 0))
      result = newNode(nSequence, result, e)
      if token.kind == tokComma:
        token = lexer.next()
      else:
        break
    token.expect(tokRPar, "')' expected")
    token.expect(tokSemi, "';' expected")

  of tokSemi:
    token = lexer.next()

  of tokIdent:
    let v = Node(kind: nIdentifier, name: token.ident)
    token = lexer.next()
    token.expect(tokAssign, "'=' expected")
    result = newNode(nAssign, v, expr(lexer, token, 0))
    token.expect(tokSemi, "';' expected")

  of tokWhile:
    token = lexer.next()
    let e = parExpr(lexer, token)
    result = newNode(nWhile, e, stmt(lexer, token))

  of tokLBrace:
    token = lexer.next()
    while token.kind notin {tokRBrace, tokEnd}:
      result = newNode(nSequence, result, stmt(lexer, token))
    token.expect(tokRBrace, "'}' expected")

  of tokEnd:
    discard

  else:
    raise newException(SyntaxError, "Unexpected symbol at line " & $token.ln)

#---------------------------------------------------------------------------------------------------

proc parse*(code: string): Node =
  ## Parse the code provided.

  var lexer = initLexer(code)
  var token = lexer.next()
  while true:
    result = newNode(nSequence, result, stmt(lexer, token))
    if token.kind == tokEnd:
      break

#———————————————————————————————————————————————————————————————————————————————————————————————————

when isMainModule:

  import os, strformat, strutils

  proc printAst(node: Node) =
    ## Print tha AST in linear form.

    if node.isNil:
      echo ';'

    else:
      stdout.write &"{$node.kind:<14}"
      case node.kind
      of nIdentifier:
        echo node.name
      of nInteger:
        echo node.intVal
      of nString:
        # Need to escape and to replace hexadecimal \x0A by \n.
        echo escape(node.stringVal).replace("\\x0A", "\\n")
      else:
        echo ""
        node.left.printAst()
        node.right.printAst()

  let code = if paramCount() < 1: stdin.readAll() else: paramStr(1).readFile()
  let tree = parse(code)
  tree.printAst()


import system'routines;
import extensions;

public program()
{
    program_arguments.forEvery:(int i)
        { console.printLine("Argument ",i," is ",program_arguments[i]) }
}


#!/usr/bin/env elixir
IO.puts 'Arguments:'
Enum.map(System.argv(),&IO.puts(&1))


(while argv
  (message "Argument: %S" (pop argv)))


constant cmd = command_line()
printf(1,"Interpreter/executable name: %s\n",{cmd[1]})
printf(1,"Program file name: %s\n",{cmd[2]})
if length(cmd)>2 then
  puts(1,"Command line arguments:\n")
  for i = 3 to length(cmd) do
    printf(1,"#%d : %s\n",{i,cmd[i]})
  end for
end if


const std = @import("std");

pub const CodeGeneratorError = error{OutOfMemory};

pub const CodeGenerator = struct {
    allocator: std.mem.Allocator,
    string_pool: std.ArrayList([]const u8),
    globals: std.ArrayList([]const u8),
    bytecode: std.ArrayList(u8),

    const Self = @This();
    const word_size = @sizeOf(i32);

    pub fn init(
        allocator: std.mem.Allocator,
        string_pool: std.ArrayList([]const u8),
        globals: std.ArrayList([]const u8),
    ) Self {
        return CodeGenerator{
            .allocator = allocator,
            .string_pool = string_pool,
            .globals = globals,
            .bytecode = std.ArrayList(u8).init(allocator),
        };
    }

    pub fn gen(self: *Self, ast: ?*Tree) CodeGeneratorError!void {
        try self.genH(ast);
        try self.emitHalt();
    }

    // Helper function to allow recursion.
    pub fn genH(self: *Self, ast: ?*Tree) CodeGeneratorError!void {
        if (ast) |t| {
            switch (t.typ) {
                .sequence => {
                    try self.genH(t.left);
                    try self.genH(t.right);
                },
                .kw_while => {
                    const condition_address = self.currentAddress();
                    try self.genH(t.left);
                    try self.emitByte(.jz);
                    const condition_address_hole = self.currentAddress();
                    try self.emitHole();
                    try self.genH(t.right);
                    try self.emitByte(.jmp);
                    try self.emitInt(condition_address);
                    self.insertInt(condition_address_hole, self.currentAddress());
                },
                .kw_if => {
                    try self.genH(t.left);
                    try self.emitByte(.jz);
                    const condition_address_hole = self.currentAddress();
                    try self.emitHole();
                    try self.genH(t.right.?.left);
                    if (t.right.?.right) |else_tree| {
                        try self.emitByte(.jmp);
                        const else_address_hole = self.currentAddress();
                        try self.emitHole();
                        const else_address = self.currentAddress();
                        try self.genH(else_tree);
                        self.insertInt(condition_address_hole, else_address);
                        self.insertInt(else_address_hole, self.currentAddress());
                    } else {
                        self.insertInt(condition_address_hole, self.currentAddress());
                    }
                },
                .assign => {
                    try self.genH(t.right);
                    try self.emitByte(.store);
                    try self.emitInt(self.fetchGlobalsOffset(t.left.?.value.?.string));
                },
                .prts => {
                    try self.genH(t.left);
                    try self.emitByte(.prts);
                },
                .prti => {
                    try self.genH(t.left);
                    try self.emitByte(.prti);
                },
                .prtc => {
                    try self.genH(t.left);
                    try self.emitByte(.prtc);
                },
                .string => {
                    try self.emitByte(.push);
                    try self.emitInt(self.fetchStringsOffset(t.value.?.string));
                },
                .integer => {
                    try self.emitByte(.push);
                    try self.emitInt(t.value.?.integer);
                },
                .identifier => {
                    try self.emitByte(.fetch);
                    try self.emitInt(self.fetchGlobalsOffset(t.value.?.string));
                },
                .negate, .not => {
                    try self.genH(t.left);
                    try self.emitByte(Op.fromNodeType(t.typ).?);
                },
                .add,
                .multiply,
                .subtract,
                .divide,
                .mod,
                .less,
                .less_equal,
                .greater,
                .greater_equal,
                .equal,
                .not_equal,
                .bool_and,
                .bool_or,
                => try self.genBinOp(t),
                .unknown => {
                    std.debug.print("\nINTERP: UNKNOWN {}\n", .{t.typ});
                    std.os.exit(1);
                },
            }
        }
    }

    fn genBinOp(self: *Self, tree: *Tree) CodeGeneratorError!void {
        try self.genH(tree.left);
        try self.genH(tree.right);
        try self.emitByte(Op.fromNodeType(tree.typ).?);
    }

    fn emitByte(self: *Self, op: Op) CodeGeneratorError!void {
        try self.bytecode.append(@enumToInt(op));
    }

    fn emitInt(self: *Self, n: i32) CodeGeneratorError!void {
        var n_var = n;
        var n_bytes = @ptrCast(*[4]u8, &n_var);
        for (n_bytes) |byte| {
            try self.bytecode.append(byte);
        }
    }

    // Holes are later populated via `insertInt` because they can't be known when
    // we populate the bytecode array sequentially.
    fn emitHole(self: *Self) CodeGeneratorError!void {
        try self.emitInt(std.math.maxInt(i32));
    }

    // Populates the "hole" produced by `emitHole`.
    fn insertInt(self: *Self, address: i32, n: i32) void {
        var i: i32 = 0;
        var n_var = n;
        var n_bytes = @ptrCast(*[4]u8, &n_var);
        while (i < word_size) : (i += 1) {
            self.bytecode.items[@intCast(usize, address + i)] = n_bytes[@intCast(usize, i)];
        }
    }

    fn emitHalt(self: *Self) CodeGeneratorError!void {
        try self.bytecode.append(@enumToInt(Op.halt));
    }

    fn currentAddress(self: Self) i32 {
        return @intCast(i32, self.bytecode.items.len);
    }

    fn fetchStringsOffset(self: Self, str: []const u8) i32 {
        for (self.string_pool.items) |string, idx| {
            if (std.mem.eql(u8, string, str)) {
                return @intCast(i32, idx);
            }
        }
        unreachable;
    }

    fn fetchGlobalsOffset(self: Self, str: []const u8) i32 {
        for (self.globals.items) |global, idx| {
            if (std.mem.eql(u8, global, str)) {
                return @intCast(i32, idx);
            }
        }
        unreachable;
    }

    pub fn print(self: Self) ![]u8 {
        var result = std.ArrayList(u8).init(self.allocator);
        var writer = result.writer();
        try writer.print(
            "Datasize: {d} Strings: {d}\n",
            .{ self.globals.items.len, self.string_pool.items.len },
        );
        for (self.string_pool.items) |string| {
            try writer.print("{s}\n", .{string});
        }

        var pc: usize = 0;
        while (pc < self.bytecode.items.len) : (pc += 1) {
            try writer.print("{d:>5} ", .{pc});
            switch (@intToEnum(Op, self.bytecode.items[pc])) {
                .push => {
                    try writer.print("push  {d}\n", .{self.unpackInt(pc + 1)});
                    pc += word_size;
                },
                .store => {
                    try writer.print("store [{d}]\n", .{self.unpackInt(pc + 1)});
                    pc += word_size;
                },
                .fetch => {
                    try writer.print("fetch [{d}]\n", .{self.unpackInt(pc + 1)});
                    pc += word_size;
                },
                .jz => {
                    const address = self.unpackInt(pc + 1);
                    try writer.print("jz     ({d}) {d}\n", .{ address - @intCast(i32, pc) - 1, address });
                    pc += word_size;
                },
                .jmp => {
                    const address = self.unpackInt(pc + 1);
                    try writer.print("jmp    ({d}) {d}\n", .{ address - @intCast(i32, pc) - 1, address });
                    pc += word_size;
                },
                else => try writer.print("{s}\n", .{Op.toString(@intToEnum(Op, self.bytecode.items[pc]))}),
            }
        }

        return result.items;
    }

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

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_node = std.enums.directEnumArray(NodeType, ?Op, 0, .{
        .unknown = null,
        .identifier = null,
        .string = null,
        .integer = null,
        .sequence = null,
        .kw_if = null,
        .prtc = null,
        .prts = null,
        .prti = null,
        .kw_while = null,
        .assign = null,
        .negate = .neg,
        .not = .not,
        .multiply = .mul,
        .divide = .div,
        .mod = .mod,
        .add = .add,
        .subtract = .sub,
        .less = .lt,
        .less_equal = .le,
        .greater = .gt,
        .greater_equal = .ge,
        .equal = .eq,
        .not_equal = .ne,
        .bool_and = [email protected]"and",
        .bool_or = [email protected]"or",
    });

    pub fn fromNodeType(node_type: NodeType) ?Op {
        return from_node[@enumToInt(node_type)];
    }

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

    pub fn toString(self: Op) []const u8 {
        return to_string[@enumToInt(self)];
    }
};

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([]const u8).init(allocator);
    const ast = try loadAST(allocator, input_content, &string_pool, &globals);
    var code_generator = CodeGenerator.init(allocator, string_pool, globals);
    try code_generator.gen(ast);
    const result: []const u8 = try code_generator.print();
    _ = try std.io.getStdOut().write(result);
}

pub const NodeType = enum {
    unknown,
    identifier,
    string,
    integer,
    sequence,
    kw_if,
    prtc,
    prts,
    prti,
    kw_while,
    assign,
    negate,
    not,
    multiply,
    divide,
    mod,
    add,
    subtract,
    less,
    less_equal,
    greater,
    greater_equal,
    equal,
    not_equal,
    bool_and,
    bool_or,

    const from_string_map = std.ComptimeStringMap(NodeType, .{
        .{ "UNKNOWN", .unknown },
        .{ "Identifier", .identifier },
        .{ "String", .string },
        .{ "Integer", .integer },
        .{ "Sequence", .sequence },
        .{ "If", .kw_if },
        .{ "Prtc", .prtc },
        .{ "Prts", .prts },
        .{ "Prti", .prti },
        .{ "While", .kw_while },
        .{ "Assign", .assign },
        .{ "Negate", .negate },
        .{ "Not", .not },
        .{ "Multiply", .multiply },
        .{ "Divide", .divide },
        .{ "Mod", .mod },
        .{ "Add", .add },
        .{ "Subtract", .subtract },
        .{ "Less", .less },
        .{ "LessEqual", .less_equal },
        .{ "Greater", .greater },
        .{ "GreaterEqual", .greater_equal },
        .{ "Equal", .equal },
        .{ "NotEqual", .not_equal },
        .{ "And", .bool_and },
        .{ "Or", .bool_or },
    });

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

pub const NodeValue = union(enum) {
    integer: i32,
    string: []const u8,
};

pub const Tree = struct {
    left: ?*Tree,
    right: ?*Tree,
    typ: NodeType = .unknown,
    value: ?NodeValue = null,

    fn makeNode(allocator: std.mem.Allocator, typ: NodeType, left: ?*Tree, right: ?*Tree) !*Tree {
        const result = try allocator.create(Tree);
        result.* = Tree{ .left = left, .right = right, .typ = typ };
        return result;
    }

    fn makeLeaf(allocator: std.mem.Allocator, typ: NodeType, value: ?NodeValue) !*Tree {
        const result = try allocator.create(Tree);
        result.* = Tree{ .left = null, .right = null, .typ = typ, .value = value };
        return result;
    }
};

const LoadASTError = error{OutOfMemory} || std.fmt.ParseIntError;

fn loadAST(
    allocator: std.mem.Allocator,
    str: []const u8,
    string_pool: *std.ArrayList([]const u8),
    globals: *std.ArrayList([]const u8),
) LoadASTError!?*Tree {
    var line_it = std.mem.split(u8, str, "\n");
    return try loadASTHelper(allocator, &line_it, string_pool, globals);
}

fn loadASTHelper(
    allocator: std.mem.Allocator,
    line_it: *std.mem.SplitIterator(u8),
    string_pool: *std.ArrayList([]const u8),
    globals: *std.ArrayList([]const u8),
) LoadASTError!?*Tree {
    if (line_it.next()) |line| {
        var tok_it = std.mem.tokenize(u8, line, " ");
        const tok_str = tok_it.next().?;
        if (tok_str[0] == ';') return null;

        const node_type = NodeType.fromString(tok_str);
        const pre_iteration_index = tok_it.index;

        if (tok_it.next()) |leaf_value| {
            const node_value = blk: {
                switch (node_type) {
                    .integer => break :blk NodeValue{ .integer = try std.fmt.parseInt(i32, leaf_value, 10) },
                    .identifier => {
                        var already_exists = false;
                        for (globals.items) |global| {
                            if (std.mem.eql(u8, global, leaf_value)) {
                                already_exists = true;
                                break;
                            }
                        }
                        if (!already_exists) try globals.append(leaf_value);
                        break :blk NodeValue{ .string = leaf_value };
                    },
                    .string => {
                        tok_it.index = pre_iteration_index;
                        const str = tok_it.rest();
                        var already_exists = false;
                        for (string_pool.items) |string| {
                            if (std.mem.eql(u8, string, str)) {
                                already_exists = true;
                                break;
                            }
                        }
                        if (!already_exists) try string_pool.append(str);
                        break :blk NodeValue{ .string = str };
                    },
                    else => unreachable,
                }
            };
            return try Tree.makeLeaf(allocator, node_type, node_value);
        }

        const left = try loadASTHelper(allocator, line_it, string_pool, globals);
        const right = try loadASTHelper(allocator, line_it, string_pool, globals);
        return try Tree.makeNode(allocator, node_type, left, right);
    } else {
        return null;
    }
}


// This is a little endian machine

const WORD_SIZE=4;
const{ var _n=-1; var[proxy]N=fcn{ _n+=1 }; }  // enumerator
const FETCH=N, STORE=N, PUSH=N, ADD=N,  SUB=N,  MUL=N, DIV=N, MOD=N,
      LT=N,    GT=N,    LE=N,   GE=N,   EQ=N,   NE=N,
      AND=N,   OR=N,    NEG=N,  NOT=N,
      JMP=N,   JZ=N,    PRTC=N, PRTS=N, PRTI=N, HALT=N;
const nd_String=N, nd_Sequence=N, nd_If=N, nd_While=N;
var all_syms=Dictionary(
    "Identifier"  ,FETCH,       "String"      ,nd_String,
    "Integer"     ,PUSH,        "Sequence"    ,nd_Sequence,
    "If"          ,nd_If,       "Prtc"        ,PRTC,
    "Prts"        ,PRTS,        "Prti"        ,PRTI,
    "While"       ,nd_While,    "Assign"      ,STORE,
    "Negate"      ,NEG,         "Not"         ,NOT,
    "Multiply"    ,MUL,         "Divide"      ,DIV,
    "Mod"         ,MOD,         "Add"         ,ADD,
    "Subtract"    ,SUB,         "Less"        ,LT,
    "LessEqual"   ,LE,          "Greater"     ,GT,
    "GreaterEqual",GE,          "Equal"       ,EQ,
    "NotEqual"    ,NE,          "And"         ,AND,
    "Or"          ,OR,		"halt"	      ,HALT);
var binOps=T(LT,GT,LE,GE,EQ,NE, AND,OR, SUB,ADD,DIV,MUL,MOD),
    unaryOps=T(NEG,NOT);

class Node{
   fcn init(_node_type, _value, _left=Void, _right=Void){
      var type=_node_type, left=_left, right=_right, value=_value;
   }
}

var vars=Dictionary(), strings=Dictionary(); // ( value:offset, ...)
fcn doVar(value){
   var offset=-1;  // fcn local static var
   offset=_doValue(value,vars,offset)
}
fcn doString(str){ str=str[1,-1];	// str is \"text\"
   var offset=-1;  // fcn local static var
   str=str.replace("\\n","\n");
   offset=_doValue(str,strings,offset)
}
fcn _doValue(value,vars,offset){  //--> offset of value in vars
   if(Void!=(n:=vars.find(value))) return(n);	// fetch existing value
   vars[value]=offset+=1;			// store new value
}

fcn asm(node,code){
   if(Void==node) return(code);
   emitB:='wrap(n){ code.append(n) };
   emitW:='wrap(n){ code.append(n.toLittleEndian(WORD_SIZE)) }; // signed
   switch(node.type){
      case(FETCH)    { emitB(FETCH); emitW(doVar(node.value));    }
      case(PUSH)     { emitB(PUSH);  emitW(node.value);           }
      case(nd_String){ emitB(PUSH);  emitW(doString(node.value)); }
      case(STORE){
         asm(node.right,code);
	 emitB(STORE); emitW(doVar(node.left.value));
      }
      case(nd_If){
	 asm(node.left,code);		# expr
	 emitB(JZ);			# if false, jump
	 p1,p2 := code.len(),0;
	 emitW(0);			# place holder for jump dest
	 asm(node.right.left,code);	# if true statements
	 if (node.right.right!=Void){
	    emitB(JMP);			# jump over else statements
	    p2=code.len();
	    emitW(0);
	 }
	 code[p1,WORD_SIZE]=(code.len() - p1).toLittleEndian(WORD_SIZE);
	 if(node.right.right!=Void){
	    asm(node.right.right,code);	# else statements
	    code[p2,WORD_SIZE]=(code.len() - p2).toLittleEndian(WORD_SIZE)
	 }
      }
      case(nd_While){
	 p1:=code.len();
	 asm(node.left,code);
	 emitB(JZ);
	 p2:=code.len();
	 emitW(0);			# place holder
	 asm(node.right,code);
	 emitB(JMP);			# jump back to the top
	 emitW(p1 - code.len());
	 code[p2,WORD_SIZE]=(code.len() - p2).toLittleEndian(WORD_SIZE);
      }
      case(nd_Sequence){ asm(node.left,code); asm(node.right,code); }
      case(PRTC,PRTI,PRTS){ asm(node.left,code); emitB(node.type); }
      else{
	 if(binOps.holds(node.type)){
	    asm(node.left,code); asm(node.right,code);
	    emitB(node.type);
	 }
	 else if(unaryOps.holds(node.type))
	    { asm(node.left,code); emitB(node.type); }
	 else throw(Exception.AssertionError(
	    "error in code generator - found %d, expecting operator"
	    .fmt(node.type)))
      }
   }
   code
}
fcn code_finish(code){
   code.append(HALT);
   // prepend the strings to the code,
   // using my magic [66,1 byte len,text], no trailing '\0' needed
   idxs:=strings.pump(Dictionary(),"reverse");
   idxs.keys.sort().reverse().pump(Void,'wrap(n){
      text:=idxs[n];
      code.insert(0,66,text.len(),text);
   })
}


#cs
Everything between the cs and and the ce is commented.
Commented code is not used by the computer.
#ce
;individual lines after a semicolon are commented.


BEGIN { # this code does something
  # do something
}


package require Tk
# Allocate a temporary drawing surface
canvas .c
# The cycle of colors we want to use
set colors {black red green blue magenta cyan yellow white}
# Draw the output we want
for {set y 0;set dx 1} {$y < 11*72} {incr y 72;incr dx} {
    for {set x 0;set c 0} {$x < 8.5*72} {incr x $dx;incr c} {
	.c create rectangle $x $y [expr {$x+$dx+1}] [expr {$y+73}] \
	    -fill [lindex $colors [expr {$c%[llength $colors]}]] -outline {}
    }
}
# Send postscript to default printer, scaled 1 pixel -> 1 point
exec lp - << [.c postscript -height $y -width $x -pageheight $y -pagewidth $x]
# Explicit exit; no GUI desired
exit


import "graphics" for Canvas, Color, ImageData
import "dome" for Window
import "plugin" for Plugin

Plugin.load("printer")

import "printer" for Printer

class Main {
    construct new() {
        Window.title = "Color pinstripe - printer"
        _width = 842
        _height = 595
        Canvas.resize(_width, _height)
        Window.resize(_width, _height)
        var colors = [
            Color.hex("000000"), // black
            Color.hex("FF0000"), // red
            Color.hex("00FF00"), // green
            Color.hex("0000FF"), // blue
            Color.hex("FF00FF"), // magenta
            Color.hex("00FFFF"), // cyan
            Color.hex("FFFF00"), // yellow
            Color.hex("FFFFFF")  // white
        ]
        pinstripe(colors)
    }

    pinstripe(colors) {
        var w = _width
        var h = (_height/7).floor
        for (b in 1..11) {
            var x = 0
            var ci = 0
            while (x < w) {
                var y = h * (b - 1)
                Canvas.rectfill(x, y, b, h, colors[ci%8])
                x = x + b
                ci = ci + 1
            }
        }
    }

    init() {
        var img = ImageData.create("color_pinstripe", _width, _height)
        for (x in 0..._width) {
            for (y in 0..._height) img.pset(x, y, Canvas.pget(x, y))
        }
        img.saveToFile("color_pinstripe.png")
        Printer.printFile("color_pinstripe.png")
    }

    update() {}

    draw(alpha) {}
}

var Game = Main.new()


# -*- ObjectIcon -*-
#
# The Rosetta Code Tiny-Language Parser, in Object Icon.
#
# This implementation is based closely on the pseudocode and the C
# reference implementation.
#

import io

record token_record (line_no, column_no, tok, tokval)
record token_getter (nxt, curr)

procedure main (args)
  local inpf_name, outf_name
  local inpf, outf
  local nexttok, currtok, current_token, gettok
  local ast

  inpf_name := "-"
  outf_name := "-"
  if 1 <= *args then inpf_name := args[1]
  if 2 <= *args then outf_name := args[2]

  inpf :=
      if inpf_name == "-" then
         FileStream.stdin
      else
        (FileStream(inpf_name, FileOpt.RDONLY) | stop(&why))
  outf :=
      if outf_name == "-" then
         FileStream.stdout
      else
        (FileStream(outf_name, ior(FileOpt.WRONLY,
                                   FileOpt.TRUNC,
                                   FileOpt.CREAT)) | stop(&why))

  current_token := [&null]
  nexttok := create generate_tokens(inpf, current_token)
  currtok := create get_current_token (current_token)
  gettok := token_getter(nexttok, currtok)
  ast := parse(gettok)
  prt_ast(outf, ast)

  close(inpf)
  close(outf)
end

procedure prt_ast (outf, ast)
  if *ast = 0 then {
    write(outf, ";")
  } else {
    writes(outf, ast[1])
    if ast[1] == ("Identifier" | "Integer" | "String") then {
      write(outf, " ", ast[2])
    } else {
      write(outf)
      prt_ast(outf, ast[2])
      prt_ast(outf, ast[3])
    }
  }
end

procedure generate_tokens (inpf, current_token)
  local s

  while s := read(inpf) do {
    if trim(s) ~== "" then {
      current_token[1] := string_to_token_record(s)
      suspend current_token[1]
    }
  }
end

procedure get_current_token (current_token)
  repeat (suspend current_token[1])
end

procedure string_to_token_record (s)
  local line_no, column_no, tok, tokval

  static spaces

  initial {
    spaces := ' \t\f\v\r\n'
  }

  trim(s) ? {
    tab(many(spaces))
    line_no := integer(tab(many(&digits)))
    tab(many(spaces))
    column_no := integer(tab(many(&digits)))
    tab(many(spaces))
    tok := tab(many(&letters ++ '_'))
    tab(many(spaces))
    tokval := tab(0)
  }
  return token_record(line_no, column_no, tok, tokval)
end

procedure parse (gettok)
  local tok
  local t

  t := []
  @gettok.nxt
  tok := "Not End_of_input"
  while tok ~== "End_of_input" do {
    t := ["Sequence", t, stmt(gettok)]
    tok := (@gettok.curr).tok
  }
  return t
end

procedure stmt (gettok)
  local e, s, t, v
  local tok
  local done

  t := []
  if accept(gettok, "Keyword_if") then {
    e := paren_expr(gettok)
    s := stmt(gettok)
    t := ["If", e, ["If", s,
                    if accept(gettok, "Keyword_else")
                    then stmt(gettok) else []]]
  } else if accept(gettok, "Keyword_putc") then {
    t := ["Prtc", paren_expr(gettok), []]
    expect(gettok, "Putc", "Semicolon")
  } else if accept(gettok, "Keyword_print") then {
    expect(gettok, "Print", "LeftParen")
    done := &no
    while /done do {
      tok := @gettok.curr
      if tok.tok == "String" then {
        e := ["Prts", ["String", tok.tokval], []]
        @gettok.nxt
      } else {
        e := ["Prti", expr(gettok, 0), []]
      }
      t := ["Sequence", t, e]
      accept(gettok, "Comma") | (done := &yes)
    }
    expect(gettok, "Print", "RightParen")
    expect(gettok, "Print", "Semicolon")
  } else if (@gettok.curr).tok == "Semicolon" then {
    @gettok.nxt
  } else if (@gettok.curr).tok == "Identifier" then {
    v := ["Identifier", (@gettok.curr).tokval]
    @gettok.nxt
    expect(gettok, "assign", "Op_assign")
    t := ["Assign", v, expr(gettok, 0)]
    expect(gettok, "assign", "Semicolon")
  } else if accept(gettok, "Keyword_while") then {
    e := paren_expr(gettok)
    t := ["While", e, stmt(gettok)]
  } else if accept(gettok, "LeftBrace") then {
    until (@gettok.curr).tok == ("RightBrace" | "End_of_input") do {
      t := ["Sequence", t, stmt(gettok)]
    }
    expect(gettok, "Lbrace", "RightBrace")
  } else if (@gettok.curr).tok ~== "End_of_input" then {
    tok := @gettok.curr
    error(tok, ("expecting start of statement, found '" ||
                tok_text(tok.tok) || "'"))
  }
  return t
end

procedure paren_expr (gettok)
  local x

  expect(gettok, "paren_expr", "LeftParen");
  x := expr(gettok, 0);
  expect(gettok, "paren_expr", "RightParen");
  return x
end

procedure expr (gettok, p)
  local tok, save_tok
  local x, y
  local q

  tok := @gettok.curr
  case tok.tok of {
    "LeftParen" : {
      x := paren_expr(gettok)
    }
    "Op_subtract" : {
      @gettok.nxt
      y := expr(gettok, precedence("Op_negate"))
      x := ["Negate", y, []]
    }
    "Op_add" : {
      @gettok.nxt
      x := expr(gettok, precedence("Op_negate"))
    }
    "Op_not" : {
      @gettok.nxt
      y := expr(gettok, precedence("Op_not"))
      x := ["Not", y, []]
    }
    "Identifier" : {
      x := ["Identifier", tok.tokval]
      @gettok.nxt
    }
    "Integer" : {
      x := ["Integer", tok.tokval]
      @gettok.nxt
    }
    default : {
      error(tok, "Expecting a primary, found: " || tok_text(tok.tok))
    }
  }

  while (tok := @gettok.curr &
         is_binary(tok.tok) &
         p <= precedence(tok.tok)) do
      {
        save_tok := tok
        @gettok.nxt
        q := precedence(save_tok.tok)
        if not is_right_associative(save_tok.tok) then q +:= 1
        x := [operator(save_tok.tok), x, expr(gettok, q)]
      }

  return x
end

procedure accept (gettok, tok)
  local nxt

  if (@gettok.curr).tok == tok then nxt := @gettok.nxt else fail
  return nxt
end

procedure expect (gettok, msg, tok)
  if (@gettok.curr).tok ~== tok then {
    error(@gettok.curr,
          msg || ": Expecting '" || tok_text(tok) || "', found '" ||
          tok_text((@gettok.curr).tok) || "'")
  }
  return @gettok.nxt
end

procedure error (token, msg)
  write("(", token.line_no, ", ", token.column_no, ") error: ", msg)
  exit(1)
end

procedure precedence (tok)
  local p

  case tok of {
    "Op_multiply" : p := 13
    "Op_divide" : p := 13
    "Op_mod" : p := 13
    "Op_add" : p := 12
    "Op_subtract" : p := 12
    "Op_negate" : p := 14
    "Op_not" : p := 14
    "Op_less" : p := 10
    "Op_lessequal" : p := 10
    "Op_greater" : p := 10
    "Op_greaterequal" : p := 10
    "Op_equal" : p := 9
    "Op_notequal" : p := 9
    "Op_and" : p := 5
    "Op_or" : p := 4
    default : p := -1
  }
  return p
end

procedure is_binary (tok)
  return ("Op_add" |
          "Op_subtract" |
          "Op_multiply" |
          "Op_divide" |
          "Op_mod" |
          "Op_less" |
          "Op_lessequal" |
          "Op_greater" |
          "Op_greaterequal" |
          "Op_equal" |
          "Op_notequal" |
          "Op_and" |
          "Op_or") == tok
  fail
end

procedure is_right_associative (tok)
  # None of the current operators is right associative.
  fail
end

procedure operator (tok)
  local s

  case tok of {
    "Op_multiply" : s := "Multiply"
    "Op_divide" : s := "Divide"
    "Op_mod" : s := "Mod"
    "Op_add" : s := "Add"
    "Op_subtract" : s := "Subtract"
    "Op_negate" : s := "Negate"
    "Op_not" : s := "Not"
    "Op_less" : s := "Less"
    "Op_lessequal" : s := "LessEqual"
    "Op_greater" : s := "Greater"
    "Op_greaterequal" : s := "GreaterEqual"
    "Op_equal" : s := "Equal"
    "Op_notequal" : s := "NotEqual"
    "Op_and" : s := "And"
    "Op_or" : s := "Or"
  }
  return s
end

procedure tok_text (tok)
  local s

  case tok of {
    "Keyword_else"    :  s := "else"
    "Keyword_if"      :  s := "if"
    "Keyword_print"   :  s := "print"
    "Keyword_putc"    :  s := "putc"
    "Keyword_while"   :  s := "while"
    "Op_multiply"     :  s := "*"
    "Op_divide"       :  s := "/"
    "Op_mod"          :  s := "%"
    "Op_add"          :  s := "+"
    "Op_subtract"     :  s := "-"
    "Op_negate"       :  s := "-"
    "Op_less"         :  s := "<"
    "Op_lessequal"    :  s := "<="
    "Op_greater"      :  s := ">"
    "Op_greaterequal" :  s := ">="
    "Op_equal"        :  s := "=="
    "Op_notequal"     :  s := "!="
    "Op_not"          :  s := "!"
    "Op_assign"       :  s := "="
    "Op_and"          :  s := "&&"
    "Op_or"           :  s := "||"
    "LeftParen"       :  s := "("
    "RightParen"      :  s := ")"
    "LeftBrace"       :  s := "{"
    "RightBrace"      :  s := "}"
    "Semicolon"       :  s := ";"
    "Comma"           :  s := ","
    "Identifier"      :  s := "Ident"
    "Integer"         :  s := "Integer literal"
    "String"          :  s := "String literal"
    "End_of_input"    :  s := "EOI"
  }
  return s
end


#light
[<EntryPoint>]
let main args =
    Array.iter (fun x -> printfn "%s" x) args
    0


USING: io sequences command-line ;
(command-line) [ print ] each


ARGV each: |a| {
  a println # print each given command line argument
}


class Main
{
  public static Void main (Str[] args)
  {
    echo ("command-line args are: " + args)
  }
}


\ args.f: print each command line argument on a separate line
: main
  argc @ 0 do i arg type cr loop ;

main bye


-- This is a line-comment

#
    This is a block-comment
    It goes until de-dent

dedent: 0x42 -- The comment block above is now closed


100 REM Standard BASIC comments begin with "REM" (remark) and extend to the end of the line
110 PRINT "this is code": REM comment after statement


      REM This is a comment which is ignored by the compiler
      *| This is a comment which is compiled but ignored at run time


#!/usr/bin/perl

use strict;   # parse.pl - inputs lex, outputs flattened ast
use warnings; # http://www.rosettacode.org/wiki/Compiler/syntax_analyzer

my $h = qr/\G\s*\d+\s+\d+\s+/;  # header of each line

sub error { die "*** Expected @_ at " . (/\G(.*\n)/ ?
  $1 =~ s/^\s*(\d+)\s+(\d+)\s+/line $1 character $2 got /r : "EOF\n") }

sub want { /$h \Q$_[1]\E.*\n/gcx ? shift : error "'$_[1]'" }

local $_ = join '', <>;
print want stmtlist(), 'End_of_input';

sub stmtlist
  {
  /(?=$h (RightBrace|End_of_input))/gcx and return ";\n";
  my ($stmt, $stmtlist) = (stmt(), stmtlist());
  $stmtlist eq ";\n" ? $stmt : "Sequence\n$stmt$stmtlist";
  }

sub stmt
  {
  /$h Semicolon\n/gcx ? ";\n" :
    /$h Identifier \s+ (\w+) \n/gcx ? want("Assign\nIdentifier\t$1\n",
      'Op_assign') . want expr(0), 'Semicolon' :
    /$h Keyword_while \n/gcx ? "While\n" . parenexp() . stmt() :
    /$h Keyword_if \n/gcx ?  "If\n" . parenexp() . "If\n" . stmt() .
      (/$h Keyword_else \n/gcx ? stmt() : ";\n") :
    /$h Keyword_print \n/gcx ? want('', 'LeftParen') .
      want want(printlist(), 'RightParen'), 'Semicolon' :
    /$h Keyword_putc \n/gcx ? want "Prtc\n" . parenexp() . ";\n", 'Semicolon' :
    /$h LeftBrace \n/gcx ? want stmtlist(), 'RightBrace' :
    error 'A STMT';
  }

sub parenexp { want('', 'LeftParen') . want expr(0), 'RightParen' } # (expr)

sub printlist
  {
  my $ast = /$h String \s+ (".*") \n/gcx ?
    "Prts\nString\t\t$1\n;\n" : "Prti\n" . expr(0) . ";\n";
  /$h Comma \n/gcx ? "Sequence\n$ast" . printlist() : $ast;
  }

sub expr               # (sort of EBNF) expr = operand { operator expr }
  {
  my $ast =                                        # operand
    /$h Integer \s+ (\d+) \n/gcx ? "Integer\t\t$1\n" :
    /$h Identifier \s+ (\w+) \n/gcx ? "Identifier\t$1\n" :
    /$h LeftParen \n/gcx ? want expr(0), 'RightParen' :
    /$h Op_(negate|subtract) \n/gcx ? "Negate\n" . expr(8) . ";\n" :
    /$h Op_not \n/gcx ? "Not\n" . expr(8) . ";\n" :
    /$h Op_add \n/gcx ? expr(8) :
    error "A PRIMARY";
  $ast =                                           # { operator expr }
    $_[0] <= 7 && /$h Op_multiply \n/gcx ? "Multiply\n$ast" . expr(8) :
    $_[0] <= 7 && /$h Op_divide \n/gcx ? "Divide\n$ast" . expr(8) :
    $_[0] <= 7 && /$h Op_mod \n/gcx ? "Mod\n$ast" . expr(8) :
    $_[0] <= 6 && /$h Op_add \n/gcx ? "Add\n$ast" . expr(7) :
    $_[0] <= 6 && /$h Op_subtract \n/gcx ? "Subtract\n$ast" . expr(7) :
    $_[0] == 5 && /(?=$h Op_(less|greater)(equal)? \n)/gcx ? error 'NO ASSOC' :
    $_[0] <= 5 && /$h Op_lessequal \n/gcx ? "LessEqual\n$ast" . expr(5) :
    $_[0] <= 5 && /$h Op_less \n/gcx ? "Less\n$ast" . expr(5) :
    $_[0] <= 5 && /$h Op_greater \n/gcx ? "Greater\n$ast" . expr(5) :
    $_[0] <= 5 && /$h Op_greaterequal \n/gcx ?  "GreaterEqual\n$ast" . expr(5) :
    $_[0] == 3 && /(?=$h Op_(not)?equal \n)/gcx ? error 'NO ASSOC' :
    $_[0] <= 3 && /$h Op_equal \n/gcx ? "Equal\n$ast" . expr(3) :
    $_[0] <= 3 && /$h Op_notequal \n/gcx ? "NotEqual\n$ast" . expr(3) :
    $_[0] <= 1 && /$h Op_and \n/gcx ? "And\n$ast" . expr(2) :
    $_[0] <= 0 && /$h Op_or \n/gcx ? "Or\n$ast" . expr(1) :
    return $ast while 1;
  }


program command_line_arguments

  implicit none
  integer, parameter :: len_max = 256
  integer :: i , nargs
  character (len_max) :: arg

  nargs = command_argument_count()
  !nargs = iargc()
  do i = 0, nargs
    call get_command_argument (i, arg)
    !call getarg (i, arg)
    write (*, '(a)') trim (arg)
  end do

end program command_line_arguments


' FB 1.05.0 Win64

' Program (myprogram.exe) invoke as follows:
' myprogram -c "alpha beta" -h "gamma"

Print "The program was invoked like this => "; Command(0) + " " + Command(-1)
Print
Print "Press any key to quit"
Sleep


Program listArguments(input, output, stdErr);

Var
  i: integer;
Begin
  writeLn('program was called from: ',paramStr(0));
  For i := 1 To paramCount() Do
    Begin
      writeLn('argument',i:2,' : ', paramStr(i));
    End;
End.


/* This is a comment. */

2 + /* Comment between tokens. */ 3

"This is a string, /* NOT a comment */."

/*
 * A comment can have multiple lines. These asterisks in the middle
 * of the comment are only for style. You must not nest a comment
 * inside another comment; the first asterisk-slash ends the comment.
 */


& read a number 2+ add two [email protected] display result and exit
  ^- inline comments -^     <-^- other comments


# A hash symbol at the beginning of a line marks the line as a comment


--
-- demo\rosetta\Compiler\parse.e
-- =============================
--
--  The reusable part of parse.exw
--
with javascript_semantics
include lex.e

sequence tok

procedure errd(sequence msg, sequence args={})
    {tok_line,tok_col} = tok
    error(msg,args)
end procedure

global sequence toks
integer next_tok = 1

function get_tok()
    sequence tok = toks[next_tok]
    next_tok += 1
    return tok
end function

procedure expect(string msg, integer s)
    integer tk = tok[3]
    if tk!=s then
        errd("%s: Expecting '%s', found '%s'\n", {msg, tkNames[s], tkNames[tk]})
    end if
    tok = get_tok()
end procedure

function expr(integer p)
    object x = NULL, node
    integer op = tok[3]

    switch op do
        case tk_LeftParen:
            tok = get_tok()
            x = expr(0)
            expect("expr",tk_RightParen)
        case tk_sub:
        case tk_add:
            tok = get_tok()
            node = expr(precedences[tk_neg]);
            x = iff(op==tk_sub?{tk_neg, node, NULL}:node)
        case tk_not:
            tok = get_tok();
            x = {tk_not, expr(precedences[tk_not]), NULL}
        case tk_Identifier:
            x = {tk_Identifier, tok[4]}
            tok = get_tok();
        case tk_Integer:
            x = {tk_Integer, tok[4]}
            tok = get_tok();
        default:
            errd("Expecting a primary, found: %s\n", tkNames[op])
    end switch

    op = tok[3]
    while narys[op]=BINARY
      and precedences[op]>=p do
        tok = get_tok()
        x = {op, x, expr(precedences[op]+1)}
        op = tok[3]
    end while
    return x;
end function

function paren_expr(string msg)
    expect(msg, tk_LeftParen);
    object t = expr(0)
    expect(msg, tk_RightParen);
    return t
end function

function stmt()
    object t = NULL, e, s

    switch tok[3] do
        case tk_if:
            tok = get_tok();
            object condition = paren_expr("If-cond");
            object ifblock = stmt();
            object elseblock = NULL;
            if tok[3] == tk_else then
                tok = get_tok();
                elseblock = stmt();
            end if
            t = {tk_if, condition, {tk_if, ifblock, elseblock}}
        case tk_putc:
            tok = get_tok();
            e = paren_expr("Prtc")
            t = {tk_putc, e, NULL}
            expect("Putc", tk_Semicolon);
        case tk_print:
            tok = get_tok();
            expect("Print",tk_LeftParen)
            while 1 do
                if tok[3] == tk_String then
                    e = {tk_Prints, {tk_String, tok[4]}, NULL}
                    tok = get_tok();
                else
                    e = {tk_Printi, expr(0), NULL}
                end if
                t = {tk_Sequence, t, e}
                if tok[3]!=tk_Comma then exit end if
                expect("Print", tk_Comma)
            end while
            expect("Print", tk_RightParen);
            expect("Print", tk_Semicolon);
        case tk_Semicolon:
            tok = get_tok();
        case tk_Identifier:
            object v
            v = {tk_Identifier, tok[4]}
            tok = get_tok();
            expect("assign", tk_assign);
            e = expr(0);
            t = {tk_assign, v, e}
            expect("assign", tk_Semicolon);
        case tk_while:
            tok = get_tok();
            e = paren_expr("while");
            s = stmt();
            t = {tk_while, e, s}
        case tk_LeftBrace:      /* {stmt} */
            expect("LeftBrace", tk_LeftBrace)
            while not find(tok[3],{tk_RightBrace,tk_EOI}) do
                t = {tk_Sequence, t, stmt()}
            end while
            expect("LeftBrace", tk_RightBrace);
            break;
        case tk_EOI:
            break;
        default:
            errd("expecting start of statement, found '%s'\n", tkNames[tok[3]]);
    end switch
    return t
end function

global function parse()
    object t = NULL
    tok = get_tok()
    while 1 do
        object s = stmt()
        if s=NULL then exit end if
        t = {tk_Sequence, t, s}
    end while
    return t
end function


PUBLIC SUB main()
  DIM l AS Integer
  DIM numparms AS Integer
  DIM parm AS String
  numparms = Application.Args.Count
  FOR l = 0 TO numparms - 1
    parm = Application.Args[l]
    PRINT l; " : "; parm
  NEXT
END


[indent=4]
/*
   Command line arguments, in Genie

   valac commandLine.gs
   ./commandLine sample arguments 'four in total here, including args 0'
*/

init

    // Output the number of arguments
    print "%d command line argument(s):", args.length

    // Enumerate all command line arguments
    for s in args
        print s

    // to reiterate, args[0] is the command
    if args[0] is not null
        print "\nWith Genie, args[0] is the command: %s", args[0]