import "random" for Random
import "timer" for Timer

var Rand = Random.new(0) // using a constant seed to produce same output on each run

// patterns
var BLINKER = 0
var GLIDER  = 1
var RANDOM  = 2

class Field {
    construct new(w, h) {
        _w = w
        _h = h
        _s = List.filled(h, null)
        for (i in 0...h) _s[i] = List.filled(w, false)
    }

    [x, y]=(b) { _s[y][x] = b }

    state(x, y) {
        if (!(0..._w).contains(x) || !(0..._h).contains(y)) return false
        return _s[y][x]
    }

    next(x, y) {
        var on = 0
        for (i in -1..1) {
            for (j in -1..1) {
                 if (state(x + i, y + j) && !(j == 0 && i == 0)) on = on + 1
            }
        }
        return on == 3 || (on == 2 && state(x, y))
    }
}

class Life {
    construct new(pattern) {
        if (pattern == BLINKER) {
            _w = 3
            _h = 3
            _a = Field.new(_w, _h)
            _b = Field.new(_w, _h)
            _a[0, 1] = true
            _a[1, 1] = true
            _a[2, 1] = true
        } else if (pattern == GLIDER) {
            _w = 4
            _h = 4
            _a = Field.new(_w, _h)
            _b = Field.new(_w, _h)
            _a[1, 0] = true
            _a[2, 1] = true
            for (i in 0..2) _a[i, 2] = true
        } else if(pattern == RANDOM) {
             _w = 80
             _h = 15
             _a = Field.new(_w, _h)
             _b = Field.new(_w, _h)
            for (i in 0...(_w * _h).floor / 2) {
                _a[Rand.int(_w), Rand.int(_h)] = true
            }
        }
    }

    step() {
        for (y in 0..._h) {
            for (x in 0..._w) _b[x, y] = _a.next(x, y)
        }
        var t = _a
        _a = _b
        _b = t
    }

    toString {
        var sb = ""
        for (y in 0..._h) {
            for (x in 0..._w) {
                var c = _a.state(x, y) ? "#" : "."
                sb = sb + c
            }
            sb = sb + "\n"
        }
        return sb
    }
}

var lives = [
    [Life.new(BLINKER),  3, "BLINKER"],
    [Life.new(GLIDER),   4, "GLIDER" ],
    [Life.new(RANDOM), 100, "RANDOM" ]
]

for (t in lives) {
    var game  = t[0]
    var gens  = t[1]
    var title = t[2]
    System.print("%(title):\n")
    for (i in 0..gens) {
        System.print("Generation: %(i)\n%(game)")
        Timer.sleep(30)
        game.step()
    }
    System.print()
}


condition => success // failure
condition => success
condition // failure


for (b in [true, false]) {
    if (b) {
        System.print(true)
    } else {
        System.print(false)
    }

    // equivalent code using ternary operator
    System.print(b ? true : false)

    // equivalent code using && operator
    System.print(b && true)

    // equivalent code using || operator
    System.print(b || false)

    System.print()
}


outbuf=: ''
emit=:{{
  outbuf=: outbuf,y
  if.LF e. outbuf do.
    ndx=. outbuf i:LF
    echo ndx{.outbuf
    outbuf=: }.ndx}.outbuf
  end.
}}

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

make_leaf=: ;
typ=: 0&{::
val=: left=: 1&{::
right=: 2&{::
make_node=: {{m;n;<y}}
id2var=: 'var_',rplc&('z';'zz';'_';'_z')

interp=:{{
  if.y-:'' do.'' return.end.
  V=. val y
  W=. ;2}.y
  select.typ y
    case.'Integer'do._".V
    case.'String'do.rplc&('\\';'\';'\n';LF) V-.'"'
    case.'Identifier'do.".id2var V
    case.'Assign'do.''[(id2var left V)=: interp W
    case.'Multiply'do.V *&interp W
    case.'Divide'do.V (*&* * <[email protected]%&|)&interp W
    case.'Mod'do.V (*&* * |~&|)&interp W
    case.'Add'do.V +&interp W
    case.'Subtract'do.V -&interp W
    case.'Negate'do.-interp V
    case.'Less'do.V <&interp W
    case.'LessEqual'do.V <:&interp W
    case.'Greater'do.V >&interp W
    case.'GreaterEqual'do.V >&interp W
    case.'Equal'do.V =&interp W
    case.'NotEqual'do.V ~:&interp W
    case.'Not'do.0=interp V
    case.'And'do.V *.&interp W
    case.'Or' do.V +.&interp W
    case.'If'do.if.interp V do.interp left W else.interp right W end.''
    case.'While'do.while.interp V do.interp W end.''
    case.'Prtc'do.emit u:interp V
    case.'Prti'do.emit rplc&'_-'":interp V
    case.'Prts'do.emit interp V
    case.'Sequence'do.
      interp V
      interp W
      ''
    case.do.error'unknown node type ',typ y
  end.
}}


def     M=3;                    \array size
char    NowGen(M+2, M+2),       \size with surrounding borders
        NewGen(M+2, M+2);
int     X, Y, I, J, N, Gen;
code    ChOut=8, CrLf=9;

[for Y:= 0 to M+1 do            \set up initial state
    for X:= 0 to M+1 do
        [NowGen(X,Y):= ^ ;  NewGen(X,Y):= ^ ];
NowGen(1,2):= ^#;  NowGen(2,2):= ^#;  NowGen(3,2):= ^#;

for Gen:= 1 to 3 do
        [for Y:= 1 to M do                      \show current generation
            [for X:= 1 to M do [ChOut(0, NowGen(X,Y));  ChOut(0,^ )];
            CrLf(0);
            ];
        CrLf(0);

        for Y:= 1 to M do                       \determine next generation
            for X:= 1 to M do
                [N:= 0;                         \count adjacent live (#) cells
                for J:= Y-1 to Y+1 do
                    for I:= X-1 to X+1 do
                        if NowGen(I,J) = ^# then N:= N+1;
                if NowGen(X,Y) = ^# then N:= N-1;       \don't count center
                NewGen(X,Y):= ^ ;                       \assume death
                if N=2 then NewGen(X,Y):= NowGen(X,Y)   \actually no change
                else if N=3 then NewGen(X,Y):= ^#;      \actually birth
                ];
        I:= NowGen;  NowGen:= NewGen;  NewGen:= I;      \swap arrays
        ];
]


if(i>1)
   DoSomething

FailedSoContinueCodeExecution.


(if (eq s "Rosetta Code")
    "The well-known programming chrestomathy site"
    "Some other website, maybe, I dunno" )


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

class Interpreter {
	static Map<String, Integer> globals = new HashMap<>();
	static Scanner s;
	static List<Node> list = new ArrayList<>();
	static Map<String, NodeType> str_to_nodes = new HashMap<>();

	static class Node {
		public NodeType nt;
		public Node left, right;
		public String value;

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

		private final String name;

		NodeType(String name) {	this.name = name; }

		@Override
		public String toString() { return this.name; }
	}
	static String str(String s) {
		String result = "";
		int i = 0;
		s = s.replace("\"", "");
		while (i < s.length()) {
			if (s.charAt(i) == '\\' && i + 1 < s.length()) {
				if (s.charAt(i + 1) == 'n') {
					result += '\n';
					i += 2;
				} else if (s.charAt(i) == '\\') {
					result += '\\';
					i += 2;
				}
			} else {
				result += s.charAt(i);
				i++;
			}
		}
		return result;
	}
	static boolean itob(int i) {
		return i != 0;
	}
	static int btoi(boolean b) {
		return b ? 1 : 0;
	}
	static int fetch_var(String name) {
		int result;
		if (globals.containsKey(name)) {
			result = globals.get(name);
		} else {
			globals.put(name, 0);
			result = 0;
		}
		return result;
	}
	static Integer interpret(Node n) throws Exception {
		if (n == null) {
			return 0;
		}
		switch (n.nt) {
			case nd_Integer:
				return Integer.parseInt(n.value);
			case nd_Ident:
				return fetch_var(n.value);
			case nd_String:
				return 1;//n.value;
			case nd_Assign:
				globals.put(n.left.value, interpret(n.right));
				return 0;
			case nd_Add:
				return interpret(n.left) + interpret(n.right);
			case nd_Sub:
				return interpret(n.left) - interpret(n.right);
			case nd_Mul:
				return interpret(n.left) * interpret(n.right);
			case nd_Div:
				return interpret(n.left) / interpret(n.right);
			case nd_Mod:
				return interpret(n.left) % interpret(n.right);
			case nd_Lss:
				return btoi(interpret(n.left) < interpret(n.right));
			case nd_Leq:
				return btoi(interpret(n.left) <= interpret(n.right));
			case nd_Gtr:
				return btoi(interpret(n.left) > interpret(n.right));
			case nd_Geq:
				return btoi(interpret(n.left) >= interpret(n.right));
			case nd_Eql:
				return btoi(interpret(n.left) == interpret(n.right));
			case nd_Neq:
				return btoi(interpret(n.left) != interpret(n.right));
			case nd_And:
				return btoi(itob(interpret(n.left)) && itob(interpret(n.right)));
			case nd_Or:
				return btoi(itob(interpret(n.left)) || itob(interpret(n.right)));
			case nd_Not:
				if (interpret(n.left) == 0) {
					return 1;
				} else {
					return 0;
				}
			case nd_Negate:
				return -interpret(n.left);
			case nd_If:
				if (interpret(n.left) != 0) {
					interpret(n.right.left);
				} else {
					interpret(n.right.right);
				}
				return 0;
			case nd_While:
				while (interpret(n.left) != 0) {
					interpret(n.right);
				}
				return 0;
			case nd_Prtc:
				System.out.printf("%c", interpret(n.left));
				return 0;
			case nd_Prti:
				System.out.printf("%d", interpret(n.left));
				return 0;
			case nd_Prts:
				System.out.print(str(n.left.value));//interpret(n.left));
				return 0;
			case nd_Sequence:
				interpret(n.left);
				interpret(n.right);
				return 0;
			default:
				throw new Exception("Error: '" + n.nt + "' found, expecting operator");
		}
	}
	static Node load_ast() throws Exception {
		String command, value;
		String line;
		Node left, right;

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

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

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


<xsl:template match="/table">

        <xsl:apply-templates />

</xsl:template>

<xsl:template match="tr">

<xsl:apply-templates />

</xsl:template>

<xsl:template match="td">
    <xsl:variable name="liveNeighbours">
        <xsl:apply-templates select="current()" mode="countLiveNeighbours" />
    </xsl:variable>

    <xsl:choose>
        <xsl:when test="(current() = 'X' and $liveNeighbours = 2) or $liveNeighbours = 3">
            <xsl:call-template name="live" />
        </xsl:when>
        <xsl:otherwise>
            <xsl:call-template name="die" />
        </xsl:otherwise>
    </xsl:choose>
</xsl:template>

<xsl:template match="td" mode="countLiveNeighbours">
    <xsl:variable name="currentX" select="count(preceding-sibling::td) + 1" />
    <xsl:variable name="precedingRow" select="parent::tr/preceding-sibling::tr[1]" />
    <xsl:variable name="followingRow" select="parent::tr/following-sibling::tr[1]" />

    <xsl:variable name="neighbours" select="$precedingRow/td[$currentX - 1] |
                                            $precedingRow/td[$currentX] |
                                            $precedingRow/td[$currentX + 1] |
                                            preceding-sibling::td[1] |
                                            following-sibling::td[1] |
                                            $followingRow/td[$currentX - 1] |
                                            $followingRow/td[$currentX] |
                                            $followingRow/td[$currentX + 1]" />

    <xsl:value-of select="count($neighbours[text() = 'X'])" />
</xsl:template>

<xsl:template name="die">
    _
</xsl:template>

<xsl:template name="live">
    X
</xsl:template>


     if BOOLEAN EXPRESSION then STATEMENT
     if BOOLEAN EXPRESSION then STATEMENT else STATEMENT
     if BOOLEAN EXPRESSION then EXPRESSION else EXPRESSION
     case INTEGER EXPRESSION of
             INTEGER EXPRESSION, ... INTEGER EXPRESSION: STATEMENT;
             ...
             INTEGER EXPRESSION, ... INTEGER EXPRESSION: STATEMENT
             other STATEMENT
     case of
             BOOLEAN EXPRESSION, ... BOOLEAN EXPRESSION: STATEMENT;
             ...
             BOOLEAN EXPRESSION, ... BOOLEAN EXPRESSION: STATEMENT
             other STATEMENT


<xsl:if test="condition">
  <!-- executed if XPath expression evaluates to true -->
</xsl:if>


struct Anode
    node_type::String
    left::Union{Nothing, Anode}
    right::Union{Nothing, Anode}
    value::Union{Nothing, String}
end

make_leaf(t, v) = Anode(t, nothing, nothing, v)
make_node(t, l, r) = Anode(t, l, r, nothing)

const OP2 = Dict("Multiply" => "*", "Divide" => "/", "Mod" => "%", "Add" => "+", "Subtract" => "-",
                 "Less" => "<", "Greater" => ">", "LessEqual" => "<=", "GreaterEqual" => ">=",
                 "Equal" => "==", "NotEqual" => "!=", "And" => "&&", "Or" => "||")
const OP1 = Dict("Not" => "!", "Minus" => "-")

tobool(i::Bool) = i
tobool(i::Int) = (i != 0)
tobool(s::String) = eval(Symbol(s)) != 0

const stac = Vector{Any}()

function call2(op, x, y)
    if op in ["And", "Or"]
        x, y = tobool(x), tobool(y)
    end
    eval(Meta.parse("push!(stac, $(x) $(OP2[op]) $(y))"))
    return Int(floor(pop!(stac)))
end

call1(op, x) = (if op in ["Not"] x = tobool(x) end; eval(Meta.parse("$(OP1[op]) $(x)")))
evalpn(op, x, y = nothing) = (haskey(OP2, op) ? call2(op, x, y) : call1(op, x))

function load_ast(io)
    line = strip(readline(io))
    line_list = filter(x -> x != nothing, match(r"(?:(\w+)\s+(\d+|\w+|\".*\")|(\w+|;))", line).captures)
    text = line_list[1]
    if text == ";"
        return nothing
    end
    node_type = text
    if length(line_list) > 1
        return make_leaf(line_list[1], line_list[2])
    end
    left = load_ast(io)
    right = load_ast(io)
    return make_node(line_list[1], left, right)
end

function interp(x)
    if x == nothing return nothing
    elseif x.node_type == "Integer" return parse(Int, x.value)
    elseif x.node_type == "Identifier" return "_" * x.value
    elseif x.node_type == "String" return replace(replace(x.value, "\"" => ""), "\\n" => "\n")
    elseif x.node_type == "Assign" s = "$(interp(x.left)) = $(interp(x.right))"; eval(Meta.parse(s)); return nothing
    elseif x.node_type in keys(OP2) return evalpn(x.node_type, interp(x.left), interp(x.right))
    elseif x.node_type in keys(OP1) return evalpn(x.node_type, interp(x.left))
    elseif x.node_type ==  "If" tobool(eval(interp(x.left))) ? interp(x.right.left) : interp(x.right.right); return nothing
    elseif x.node_type == "While" while tobool(eval(interp(x.left))) interp(x.right) end; return nothing
    elseif x.node_type == "Prtc" print(Char(eval(interp(x.left)))); return nothing
    elseif x.node_type == "Prti" s = interp(x.left); print((i = tryparse(Int, s)) == nothing ? eval(Symbol(s)) : i); return nothing
    elseif x.node_type == "Prts" print(eval(interp(x.left))); return nothing
    elseif x.node_type == "Sequence" interp(x.left); interp(x.right); return nothing
    else
        throw("unknown node type: $x")
    end
end

const testparsed = """
Sequence
Sequence
Sequence
Sequence
Sequence
;
Assign
Identifier    count
Integer       1
Assign
Identifier    n
Integer       1
Assign
Identifier    limit
Integer       100
While
Less
Identifier    n
Identifier    limit
Sequence
Sequence
Sequence
Sequence
Sequence
;
Assign
Identifier    k
Integer       3
Assign
Identifier    p
Integer       1
Assign
Identifier    n
Add
Identifier    n
Integer       2
While
And
LessEqual
Multiply
Identifier    k
Identifier    k
Identifier    n
Identifier    p
Sequence
Sequence
;
Assign
Identifier    p
NotEqual
Multiply
Divide
Identifier    n
Identifier    k
Identifier    k
Identifier    n
Assign
Identifier    k
Add
Identifier    k
Integer       2
If
Identifier    p
If
Sequence
Sequence
;
Sequence
Sequence
;
Prti
Identifier    n
;
Prts
String        \" is prime\\n\"
;
Assign
Identifier    count
Add
Identifier    count
Integer       1
;
Sequence
Sequence
Sequence
;
Prts
String        \"Total primes found: \"
;
Prti
Identifier    count
;
Prts
String        \"\\n\"
;  """

const lio = IOBuffer(testparsed)

interp(load_ast(lio))


import os, strutils, streams, tables

import ast_parser

type

  ValueKind = enum valNil, valInt, valString

  # Representation of a value.
  Value = object
    case kind: ValueKind
    of valNil: nil
    of valInt: intVal: int
    of valString: stringVal: string

  # Range of binary operators.
  BinaryOperator = range[nMultiply..nOr]

# Table of variables.
var variables: Table[string, Value]

type RunTimeError = object of CatchableError

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

template newInt(val: typed): Value =
  ## Create an integer value.
  Value(kind: valInt, intVal: val)

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

proc interp(node: Node): Value =
  ## Interpret code starting at "node".

  if node.isNil:
    return Value(kind: valNil)

  case node.kind

  of nInteger:
    result = Value(kind: valInt, intVal: node.intVal)

  of nIdentifier:
    if node.name notin variables:
      raise newException(RunTimeError, "Variable {node.name} is not initialized.")
    result = variables[node.name]

  of nString:
    result = Value(kind: valString, stringVal: node.stringVal)

  of nAssign:
    variables[node.left.name] = interp(node.right)

  of nNegate:
    result = newInt(-interp(node.left).intVal)

  of nNot:
    result = newInt(not interp(node.left).intVal)

  of BinaryOperator.low..BinaryOperator.high:

    let left = interp(node.left)
    let right = interp(node.right)

    case BinaryOperator(node.kind)
    of nMultiply:
      result = newInt(left.intVal * right.intVal)
    of nDivide:
      result = newInt(left.intVal div right.intVal)
    of nMod:
      result = newInt(left.intVal mod right.intVal)
    of nAdd:
      result = newInt(left.intVal + right.intVal)
    of nSubtract:
      result = newInt(left.intVal - right.intVal)
    of nLess:
      result = newInt(ord(left.intVal < right.intVal))
    of nLessEqual:
      result = newInt(ord(left.intVal <= right.intVal))
    of nGreater:
      result = newInt(ord(left.intVal > right.intVal))
    of nGreaterEqual:
      result = newInt(ord(left.intVal >= right.intVal))
    of nEqual:
      result = newInt(ord(left.intVal == right.intVal))
    of nNotEqual:
      result = newInt(ord(left.intVal != right.intVal))
    of nAnd:
      result = newInt(left.intVal and right.intVal)
    of nOr:
      result = newInt(left.intVal or right.intVal)

  of nIf:
    if interp(node.left).intVal != 0:
      discard interp(node.right.left)
    else:
      discard interp(node.right.right)

  of nWhile:
    while interp(node.left).intVal != 0:
      discard interp(node.right)

  of nPrtc:
    stdout.write(chr(interp(node.left).intVal))

  of nPrti:
    stdout.write(interp(node.left).intVal)

  of nPrts:
    stdout.write(interp(node.left).stringVal)

  of nSequence:
    discard interp(node.left)
    discard interp(node.right)

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

import re

proc loadAst(stream: Stream): Node =
  ## Load a linear AST and build a binary tree.

  let line = stream.readLine().strip()
  if line.startsWith(';'):
    return nil

  var fields = line.split(' ', 1)
  let kind = parseEnum[NodeKind](fields[0])
  if kind in {nIdentifier, nString, nInteger}:
    if fields.len < 2:
      raise newException(ValueError, "Missing value field for " & fields[0])
    else:
      fields[1] = fields[1].strip()
  case kind
  of nIdentifier:
    return Node(kind: nIdentifier, name: fields[1])
  of nString:
    str = fields[1].replacef(re"([^\\])(\\n)", "$1\n").replace(r"\\", r"\").replace("\"", "")
    return Node(kind: nString, stringVal: str)
  of nInteger:
    return Node(kind: nInteger, intVal: parseInt(fields[1]))
  else:
    if fields.len > 1:
      raise newException(ValueError, "Extra field for " & fields[0])

  let left = stream.loadAst()
  let right = stream.loadAst()
  result = newNode(kind, left, right)

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

var stream: Stream
var toClose = false

if paramCount() < 1:
  stream = newFileStream(stdin)
else:
  stream = newFileStream(paramStr(1))
  toClose = true

let ast = loadAst(stream)
if toClose: stream.close()

discard ast.interp()


;MSX Bios calls
CHPUT     equ 000A2H          ;print character A
CHGET     equ 0009FH          ;wait for keyboard input
INITXT    equ 0006CH          ;init TEXT1 mode (40 x 24), based on TXTNAM,TXTCGP and LINL40
LDIRVM    equ 0005CH          ;write BC times MEM(HL++) to VRAM(DE++)

;MSX system variables
TXTNAM    equ 0F3B3H          ;pattern name table
TXTCGP    equ 0F3B7H          ;pattern generator table
LINL40    equ 0F3AEH          ;line length

;defines
LIFE_CHAR equ 0xDB            ;MSX all-pixels-on character

;variables
screen    equ 0E000H          ;40x24 bytes
scratch   equ screen+(40*24)  ;table for calculations

          org 04000H
;*********************************************************************
HEADER    ;first 16 bytes of the rom. (as specified by MSX standard)
;*********************************************************************
          db "AB"             ;id
          dw Main             ;init
          dw 0                ;statement
          dw 0                ;device
          dw 0                ;text
          dw 0                ;reserved
          dw 0                ;reserved
          dw 0                ;reserved

init_tab1 db 0x18
          dc 7, 0x17
          db " Conway's Game Of Life "
          dc 8, 0x17
          db 0x19
          db 0x16
          dc 38, " "
          db 0x16, 0x1A
          dc 38, 0x17
          db 0x1B
init_tab2 dc 41, 0x80
          dc 38, 0
          dc 41, 0x80

INITLINES equ 10
init_tab3 db "                                        "
          db "                          X             "
          db "                        X X             "
          db "              XX      XX            XX  "
          db "             X   X    XX            XX  "
          db "  XX        X     X   XX                "
          db "  XX        X   X XX    X X             "
          db "            X     X       X             "
          db "             X   X                      "
          db "              XX                        "

Expand    ld bc, 40
          ldir                ;copy top line
          push de
          ld bc, 40
          ldir                ;copy first middle line
          ex (sp), hl
          ld bc, 40*21
          ldir                ;repeat middle line
          pop hl
          ld bc, 40           ;copy bottom line
          ldir
          ret

InitGOL   ;create empty screen
          ld hl, init_tab1
          ld de, screen
          call Expand
          ;Now add intial pattern
if INITLINES
          ld hl, init_tab3    ;glider gun start pattern
          ld de, init_tab3    ;de=hl, so ldi does not change RAM
          ld bc, 40*INITLINES
          ld ix, screen+40
InitGOLl  ld a, (hl)
          cp 'X'
          jr nz, InitGOLe
          ld (ix), LIFE_CHAR
InitGOLe  inc ix
          ldi                 ;hl++ and bc-- (with flag!)
          jp pe, InitGOLl
else
          ld hl, screen+(4*40)+18
          ld a, LIFE_CHAR     ;blinker start pattern
          ld (hl), a
          inc hl
          ld (hl), a
          inc hl
          ld (hl), a
endif
          ret

DoGOL     ld hl, init_tab2    ;initialize scratchpad (sums to zero, borders marked)
          ld de, scratch
          call Expand
          ;first loop: create sums in scratchpad
          ld bc, 40*24
          ld hl, screen
          ld de, screen       ;de=hl, so ldi does not change RAM
          ld ix, scratch
DoGOLsuml ld a, (hl)
          cp LIFE_CHAR        ;if cell is alive increase sums of all surrounding cells
          jr nz, DoGOLsume
          inc (ix-41)
          inc (ix-40)
          inc (ix-39)
          inc (ix-1)
          inc (ix+1)
          inc (ix+39)
          inc (ix+40)
          inc (ix+41)
DoGOLsume inc ix
          ldi                 ;hl++, bc-- (with flag!)
          jp pe, DoGOLsuml
          ;second loop: update cell based on current state and sum
          ld bc, 40*24
          ld hl, screen
          ld de, screen       ;de=hl, so ldi does not change RAM
          ld ix, scratch
DoGOLupdl ld a, (ix)
          cp 0x7f             ;border -> keep the same
          jr nc, DoGOLupde
          cp 3                ;3 neighbors-> always live
          jr z, DoGOLlive
          cp 2
          jr z, DoGOLupde     ;2 -> stay the same
DoGOLdie  ld (hl), 0x20       ;1,4,5,6,7,8 -> always die
          jr DoGoLupde
DoGOLlive ld (hl), LIFE_CHAR
DoGOLupde inc ix
          ldi                 ;hl++, bc-- (with flag!)
          jp pe, DoGOLupdl
          ret

;*********************************************************************
Main
;*********************************************************************
          call INITXT
          call InitGOL
Mainloop  ld hl, screen
          ld de, (TXTNAM)
          ld bc, 40*24
          call LDIRVM
          ;call CHGET
          call DoGOL
          jr Mainloop

          ;force 16k ROM size binary output
EndOfCode dc 0x8000 - EndOfCode, 0xFF
          end


// if-then-endif, switch / end switch
// on gosub, on goto
// repeat / until, do / loop, while / end while

if expr_booleana then
   sentencia(s)
endif

if expr_booleana sentencia(s)

if expr_booleana1 then
   sentencia(s)
elsif expr_booleana2
   sentencia(s)
elsif expr_booleana3 then
   sentencia(s)
else
   sentencia(s)
endif

switch expr_booleana
   case valor1
      sentencia(s)
   case valor2
      sentencia(s)
   default
      sentencia(s)
end switch

on expresion gosub label1, label2
   sentencia(s)
label label1
   sentencia(s)
return
label label2
   sentencia(s)
return

on expresion goto label1, label2
   sentencia(s)
label label1
   sentencia(s)
label label2
   sentencia(s)

repeat
   sentencia(s)
until valor1

do
   sentencia(s)
loop

while expr_booleana
   sentencia(s)
end while


char x;
if (x == 20)
{
   doThis();
}
else
{
   doThat();
}


#!/usr/bin/perl

use strict;   # interpreter.pl - execute a flatAST
use warnings; # http://www.rosettacode.org/wiki/Compiler/AST_interpreter
use integer;

my %variables;

tree()->run;

sub tree
  {
  my $line = <> // die "incomplete tree\n";
  (local $_, my $arg) = $line =~ /^(\w+|;)\s+(.*)/ or die "bad input $line";
  /String/ ? bless [$arg =~ tr/""//dr =~ s/\\(.)/$1 eq 'n' ? "\n" : $1/ger], $_ :
    /Identifier|Integer/ ? bless [ $arg ], $_ :
    /;/ ? bless [], 'Null' :
    bless [ tree(), tree() ], $_;
  }

sub Add::run { $_[0][0]->run + $_[0][1]->run }
sub And::run { $_[0][0]->run && $_[0][1]->run }
sub Assign::run { $variables{$_[0][0][0]} = $_[0][1]->run }
sub Divide::run { $_[0][0]->run / $_[0][1]->run }
sub Equal::run { $_[0][0]->run == $_[0][1]->run ? 1 : 0 }
sub Greater::run { $_[0][0]->run > $_[0][1]->run ? 1 : 0 }
sub GreaterEqual::run { $_[0][0]->run >= $_[0][1]->run ? 1 : 0 }
sub Identifier::run { $variables{$_[0][0]} // 0 }
sub If::run { $_[0][0]->run ? $_[0][1][0]->run : $_[0][1][1]->run }
sub Integer::run { $_[0][0] }
sub Less::run { $_[0][0]->run < $_[0][1]->run ? 1 : 0 }
sub LessEqual::run { $_[0][0]->run <= $_[0][1]->run ? 1 : 0 }
sub Mod::run { $_[0][0]->run % $_[0][1]->run }
sub Multiply::run { $_[0][0]->run * $_[0][1]->run }
sub Negate::run { - $_[0][0]->run }
sub Not::run { $_[0][0]->run ? 0 : 1 }
sub NotEqual::run { $_[0][0]->run != $_[0][1]->run ? 1 : 0 }
sub Null::run {}
sub Or::run { $_[0][0]->run || $_[0][1]->run }
sub Prtc::run { print chr $_[0][0]->run }
sub Prti::run { print $_[0][0]->run }
sub Prts::run { print $_[0][0][0] }
sub Sequence::run { $_->run for $_[0]->@* }
sub Subtract::run { $_[0][0]->run - $_[0][1]->run }
sub While::run { $_[0][1]->run while $_[0][0]->run }


// Conway's_Game_of_Life

X = 59 : Y = 35 : H = 4

open window X*H,Y*H
backcolor 0, 0, 0

dim c(X,Y) : dim cn(X,Y) : dim cl(X,Y)

// Thunderbird methuselah
c(X/2-1,Y/3+1) = 1 : c(X/2,Y/3+1) = 1 : c(X/2+1,Y/3+1) = 1
c(X/2,Y/3+3) = 1 : c(X/2,Y/3+4) = 1 : c(X/2,Y/3+5) = 1

s = 0
repeat
    clear window
    alive = 0 : stable = 1
    s = s + 1
    for y = 0 to Y-1
        for x = 0 to X-1
            xm1 = mod(x-1+X, X) : xp1 = mod(x+1+X, X)
            ym1 = mod(y-1+Y, Y) : yp1 = mod(y+1+Y, Y)
            cn(x,y) = c(xm1,y) + c(xp1,y)
            cn(x,y) = c(xm1,ym1) + c(x,ym1) + c(xp1,ym1) + cn(x,y)
            cn(x,y) = c(xm1,yp1) + c(x,yp1) + c(xp1,yp1) + cn(x,y)
            if c(x,y) = 1 then
                if cn(x,y) < 2 or cn(x,y) > 3 then
                    cn(x,y) = 0
                else
                    cn(x,y) = 1
                    alive = alive + 1
                end if
            else
                if cn(x,y) = 3 then
                    cn(x,y) = 1
                    alive = alive + 1
                else
                    cn(x,y) = 0
                end if
            end if
            if c(x,y) then
                if cn(x,y) then
                    if cl(x,y) color 0, 0, 255          // adult
                    if not cl(x,y) color 0, 255, 0      // newborn
                else
                    if cl(x,y) color 255, 0, 0          // old
                    if not cl(x,y) color 255, 255, 0    // shortlived
                end if
                fill rect x*H,y*H,x*H+H,y*H+H
            end if
        next x
    next y

    pause 0.06
    // Copy arrays
    for i = 0 to X-1
        for j = 0 to Y-1
            if cl(i,j)<>cn(i,j) stable = 0
            cl(i,j) = c(i,j)
            c(i,j) = cn(i,j)
        next j
    next i
until(not alive or stable)

if not alive then
    print "Died in ", s, " iterations"
    clear window
else
    print "Stabilized in ", s-2, " iterations"
end if


if (x) y else z;
if(a)b else if (c) else d; etc
x:=(if (a) b else c);

a and b or c  // usually the same as if(a) b else c, beware if b evals to False

switch(x){
  case(1){...}
  case("2"){...}  // matches anything
  case(a)[fallthrough]{...}  // no break, no break has to be explicit
  case(b){...}
  else {...} // case a C's default, has to be at the end
}


const std = @import("std");
const builtin = @import("builtin");

fn printOpenSource(comptime is_open_source: bool) !void {
    if (is_open_source) {
        try std.io.getStdOut().writer().writeAll("Open source.\n");
    } else {
        try std.io.getStdOut().writer().writeAll("No open source.\n");
    }
}
fn printYesOpenSource() !void {
    try std.io.getStdOut().writer().writeAll("Open source.\n");
}
fn printNoOpenSource() !void {
    try std.io.getStdOut().writer().writeAll("No open source.\n");
}
const fnProto = switch (builtin.zig_backend) {
    .stage1 => fn () anyerror!void,
    else => *const fn () anyerror!void,
};
const Vtable = struct {
    fnptrs: [2]fnProto,
};

// dynamic dispatch: logic(this function) + vtable + data
fn printBySelectedType(data: bool, vtable: Vtable) !void {
    if (data) {
        try @call(.{}, vtable.fnptrs[0], .{});
    } else {
        try @call(.{}, vtable.fnptrs[1], .{});
    }
}

pub fn main() !void {
    // if-else
    if (true) {
        std.debug.assert(true);
    } else {
        std.debug.assert(false);
    }
    // comptime switch
    const open_source = comptime switch (builtin.os.tag) {
        .freestanding => true,
        .linux => true,
        .macos => false,
        .windows => false,
        else => unreachable,
    };
    // conditional compilation
    std.debug.assert(builtin.zig_backend != .stage2_llvm);
    // static dispatch (more complex examples work typically via comptime enums)
    try printOpenSource(open_source);
    // dynamic dispatch (runtime attach function pointer)
    var vtable = Vtable{
        .fnptrs = undefined,
    };
    // runtime-attach function pointers (dynamic dispatch)
    vtable.fnptrs[0] = printYesOpenSource;
    vtable.fnptrs[1] = printNoOpenSource;
    try printBySelectedType(open_source, vtable);

    // TODO Arithmetic if once https://github.com/ziglang/zig/issues/8220 is finished
}


--
-- demo\rosetta\Compiler\interp.exw
-- ================================
--
with javascript_semantics
include parse.e

sequence vars = {},
         vals = {}

function var_idx(sequence inode)
    if inode[1]!=tk_Identifier then ?9/0 end if
    string ident = inode[2]
    integer n = find(ident,vars)
    if n=0 then
        vars = append(vars,ident)
        vals = append(vals,0)
        n = length(vars)
    end if
    return n
end function

function interp(object t)
    if t!=NULL then
        integer ntype = t[1]
        object t2 = t[2],
               t3 = iff(length(t)=3?t[3]:0)
        switch ntype do
            case tk_Sequence:       {} = interp(t2) {} = interp(t3)
            case tk_assign:         vals[var_idx(t2)] = interp(t3)
            case tk_Identifier:     return vals[var_idx(t)]
            case tk_Integer:        return t2
            case tk_String:         return t2
            case tk_lt:             return interp(t2) < interp(t3)
            case tk_add:            return interp(t2) + interp(t3)
            case tk_sub:            return interp(t2) - interp(t3)
            case tk_while:          while interp(t2) do {} = interp(t3) end while
            case tk_Prints:         puts(1,interp(t2))
            case tk_Printi:         printf(1,"%d",interp(t2))
            case tk_putc:           printf(1,"%c",interp(t2))
            case tk_and:            return interp(t2) and interp(t3)
            case tk_or:             return interp(t2) or interp(t3)
            case tk_le:             return interp(t2) <= interp(t3)
            case tk_ge:             return interp(t2) >= interp(t3)
            case tk_ne:             return interp(t2) != interp(t3)
            case tk_gt:             return interp(t2) > interp(t3)
            case tk_mul:            return interp(t2) * interp(t3)
            case tk_div:            return trunc(interp(t2)/interp(t3))
            case tk_mod:            return remainder(interp(t2),interp(t3))
            case tk_if:             {} = interp(t3[iff(interp(t2)?2:3)])
            case tk_not:            return not interp(t2)
            case tk_neg:            return - interp(t2)
            else
                error("unknown node type")
        end switch
    end if
    return NULL
end function

procedure main(sequence cl)
    open_files(cl)
    toks = lex()
    object t = parse()
    {} = interp(t)
    close_files()
end procedure

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


class Life{
   fcn init(n, r1,c1, r2,c2, etc){
      var N=n, cells=Data(n*n), tmp=Data(n*n),
        ds=T(T(-1,-1),T(-1,0),T(-1,1), T(0,-1),T(0,1), T(1,-1),T(1,0),T(1,1));
      icells:=vm.arglist[1,*];
      (N*N).pump(Void,cells.append.fpM("1-",0));	// clear board
      icells.pump(Void,Void.Read,fcn(row,col){ cells[row*N+col]=1 });
   }
   fcn get(row,col){
      if((0<=row<N) and (0<=col<N)) return(cells[row*N+col]);
      return(0);
   }
   fcn postToastie(row,col){
      n:=ds.reduce('wrap(n,[(r,c)]){n+get(r+row,c+col)},0);
      c:=get(row,col);
      ((n==2 and c==1) or n==3).toInt()
   }
   fcn cycle{
      tmp.clear();
      foreach row in (N){ foreach col in (N) {
         tmp.append(postToastie(row,col)) } }
      t:=cells; cells=tmp; tmp=t;
   }
   fcn toString{
      cells.pump(0,String,fcn(c,rn){
         (if(c)"*" else "-") + (if(rn.inc()%N) "" else "\n")
      }.fp1(Ref(1)));
   }
   fcn toAnsi{
      cells.pump(0,"\e[H",fcn(c,rn){
         (if(c)"\e[07m  \e[m" else "  ") + (if(rn.inc()%N) "" else "\e[E")
      }.fp1(Ref(1)));
   }
   fcn dance(n=300){ do(n){ toAnsi().print(); Atomic.sleep(0.2); cycle(); } }
}


from __future__ import print_function
import sys, shlex, operator

nd_Ident, nd_String, nd_Integer, nd_Sequence, nd_If, nd_Prtc, nd_Prts, nd_Prti, nd_While, \
nd_Assign, nd_Negate, nd_Not, nd_Mul, nd_Div, nd_Mod, nd_Add, nd_Sub, nd_Lss, nd_Leq,     \
nd_Gtr, nd_Geq, nd_Eql, nd_Neq, nd_And, nd_Or = range(25)

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

input_file  = None
globals     = {}

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

class Node:
    def __init__(self, node_type, left = None, right = None, value = None):
        self.node_type  = node_type
        self.left  = left
        self.right = right
        self.value = value

#***
def make_node(oper, left, right = None):
    return Node(oper, left, right)

#***
def make_leaf(oper, n):
    return Node(oper, value = n)

#***
def fetch_var(var_name):
    n = globals.get(var_name, None)
    if n == None:
        globals[var_name] = n = 0
    return n

#***
def interp(x):
    global globals

    if x == None: return None
    elif x.node_type == nd_Integer: return int(x.value)
    elif x.node_type == nd_Ident:   return fetch_var(x.value)
    elif x.node_type == nd_String:  return x.value

    elif x.node_type == nd_Assign:
                    globals[x.left.value] = interp(x.right)
                    return None
    elif x.node_type == nd_Add:     return interp(x.left) +   interp(x.right)
    elif x.node_type == nd_Sub:     return interp(x.left) -   interp(x.right)
    elif x.node_type == nd_Mul:     return interp(x.left) *   interp(x.right)
    # use C like division semantics
    # another way: abs(x) / abs(y) * cmp(x, 0) * cmp(y, 0)
    elif x.node_type == nd_Div:     return int(float(interp(x.left)) / interp(x.right))
    elif x.node_type == nd_Mod:     return int(float(interp(x.left)) % interp(x.right))
    elif x.node_type == nd_Lss:     return interp(x.left) <   interp(x.right)
    elif x.node_type == nd_Gtr:     return interp(x.left) >   interp(x.right)
    elif x.node_type == nd_Leq:     return interp(x.left) <=  interp(x.right)
    elif x.node_type == nd_Geq:     return interp(x.left) >=  interp(x.right)
    elif x.node_type == nd_Eql:     return interp(x.left) ==  interp(x.right)
    elif x.node_type == nd_Neq:     return interp(x.left) !=  interp(x.right)
    elif x.node_type == nd_And:     return interp(x.left) and interp(x.right)
    elif x.node_type == nd_Or:      return interp(x.left) or  interp(x.right)
    elif x.node_type == nd_Negate:  return -interp(x.left)
    elif x.node_type == nd_Not:     return not interp(x.left)

    elif x.node_type ==  nd_If:
                    if (interp(x.left)):
                        interp(x.right.left)
                    else:
                        interp(x.right.right)
                    return None

    elif x.node_type == nd_While:
                    while (interp(x.left)):
                        interp(x.right)
                    return None

    elif x.node_type == nd_Prtc:
                    print("%c" % (interp(x.left)), end='')
                    return None

    elif x.node_type == nd_Prti:
                    print("%d" % (interp(x.left)), end='')
                    return None

    elif x.node_type == nd_Prts:
                    print(interp(x.left), end='')
                    return None

    elif x.node_type == nd_Sequence:
                    interp(x.left)
                    interp(x.right)
                    return None
    else:
        error("error in code generator - found %d, expecting operator" % (x.node_type))

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

    return dest

def load_ast():
    line = input_file.readline()
    line_list = shlex.split(line, False, False)

    text = line_list[0]

    value = None
    if len(line_list) > 1:
        value = line_list[1]
        if value.isdigit():
            value = int(value)

    if text == ";":
        return None
    node_type = all_syms[text]
    if value != None:
        if node_type == nd_String:
            value = str_trans(value)

        return make_leaf(node_type, value)
    left = load_ast()
    right = load_ast()
    return make_node(node_type, left, right)

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

n = load_ast()
interp(n)


program Life;

config var
     n : integer = 100;

region
     BigR = [0 .. n+1, 0 .. n+1];
     R    = [1 .. n,   1 .. n  ];

direction
     nw   = [-1, -1]; north = [-1, 0]; ne   = [-1, 1];
     west = [ 0, -1];                  east = [ 0, 1];
     sw   = [ 1, -1]; south = [ 1, 0]; se   = [ 1, 1];

var
     TW   : [BigR] boolean; -- The World
     NN   : [R]    integer; -- Number of Neighbours

procedure Life();
begin
     -- Initialize world
     [R]  repeat
          NN := [email protected]   + [email protected] + [email protected]   +
                [email protected] +            [email protected] +
                [email protected]   + [email protected] + [email protected];
          TW := (TW & NN = 2) | ( NN = 3);
     until !(|<< TW);
end;


L(strings_s) [‘AA AA AA AA’, ‘AA ACB BB CC’]
   V strings = strings_s.split(‘ ’)
   print(strings)
   print(all(zip(strings, strings[1..]).map(a -> a[0] == a[1])))
   print(all(zip(strings, strings[1..]).map(a -> a[0]  < a[1])))
   print()


######################################################################
#
# The Rosetta Code AST interpreter in Ratfor 77.
#
#
# In FORTRAN 77 and therefore in Ratfor 77, there is no way to specify
# that a value should be put on a call stack. Therefore there is no
# way to implement recursive algorithms in Ratfor 77 (although see the
# Ratfor for the "syntax analyzer" task, where a recursive language is
# implemented *in* Ratfor). Thus we cannot simply follow the
# recursive pseudocode, and instead use non-recursive algorithms.
#
# How to deal with FORTRAN 77 input is another problem. I use
# formatted input, treating each line as an array of type
# CHARACTER--regrettably of no more than some predetermined, finite
# length. It is a very simple method and presents no significant
# difficulties, aside from the restriction on line length of the
# input.
#
# Output is a bigger problem. If one uses gfortran, "advance='no'" is
# available, but not if one uses f2c. The method employed here is to
# construct the output in lines--regrettably, again, of fixed length.
#
#
# On a POSIX platform, the program can be compiled with f2c and run
# somewhat as follows:
#
#    ratfor77 interp-in-ratfor.r > interp-in-ratfor.f
#    f2c -C -Nc80 interp-in-ratfor.f
#    cc interp-in-ratfor.c -lf2c
#    ./a.out < compiler-tests/primes.ast
#
# With gfortran, a little differently:
#
#    ratfor77 interp-in-ratfor.r > interp-in-ratfor.f
#    gfortran -fcheck=all -std=legacy interp-in-ratfor.f
#    ./a.out < compiler-tests/primes.ast
#
#
# I/O is strictly from default input and to default output, which, on
# POSIX systems, usually correspond respectively to standard input and
# standard output. (I did not wish to have to deal with unit numbers;
# these are now standardized in ISO_FORTRAN_ENV, but that is not
# available in FORTRAN 77.)
#
#---------------------------------------------------------------------

# Some parameters you may wish to modify.

define(LINESZ, 256)           # Size of an input line.
define(OUTLSZ, 1024)          # Size of an output line.
define(STRNSZ, 4096)          # Size of the string pool.
define(NODSSZ, 4096)          # Size of the nodes pool.
define(STCKSZ, 4096)          # Size of stacks.
define(MAXVAR, 256)           # Maximum number of variables.

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

define(NEWLIN, 10)            # The Unix newline character (ASCII LF).
define(DQUOTE, 34)            # The double quote character.
define(BACKSL, 92)            # The backslash character.

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

define(NODESZ, 3)
define(NNEXTF, 1)               # Index for next-free.
define(NTAG,   1)               # Index for the tag.
                                # For an internal node --
define(NLEFT,  2)               #   Index for the left node.
define(NRIGHT, 3)               #   Index for the right node.
                                # For a leaf node --
define(NITV,   2)               #   Index for the string pool index.
define(NITN,   3)               #   Length of the value.

define(NIL, -1)                 # Nil node.

define(RGT, 10000)
define(STAGE2, 20000)

# The following all must be less than RGT.
define(NDID,    0)
define(NDSTR,   1)
define(NDINT,   2)
define(NDSEQ,   3)
define(NDIF,    4)
define(NDPRTC,  5)
define(NDPRTS,  6)
define(NDPRTI,  7)
define(NDWHIL,  8)
define(NDASGN,  9)
define(NDNEG,  10)
define(NDNOT,  11)
define(NDMUL,  12)
define(NDDIV,  13)
define(NDMOD,  14)
define(NDADD,  15)
define(NDSUB,  16)
define(NDLT,   17)
define(NDLE,   18)
define(NDGT,   19)
define(NDGE,   20)
define(NDEQ,   21)
define(NDNE,   22)
define(NDAND,  23)
define(NDOR,   24)

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

function issp (c)

  # Is a character a space character?

  implicit none

  character c
  logical issp

  integer ic

  ic = ichar (c)
  issp = (ic == 32 || (9 <= ic && ic <= 13))
end

function skipsp (str, i, imax)

  # Skip past spaces in a string.

  implicit none

  character str(*)
  integer i
  integer imax
  integer skipsp

  logical issp

  logical done

  skipsp = i
  done = .false.
  while (!done)
    {
      if (imax <= skipsp)
        done = .true.
      else if (!issp (str(skipsp)))
        done = .true.
      else
        skipsp = skipsp + 1
    }
end

function skipns (str, i, imax)

  # Skip past non-spaces in a string.

  implicit none

  character str(*)
  integer i
  integer imax
  integer skipns

  logical issp

  logical done

  skipns = i
  done = .false.
  while (!done)
    {
      if (imax <= skipns)
        done = .true.
      else if (issp (str(skipns)))
        done = .true.
      else
        skipns = skipns + 1
    }
end

function trimrt (str, n)

  # Find the length of a string, if one ignores trailing spaces.

  implicit none

  character str(*)
  integer n
  integer trimrt

  logical issp

  logical done

  trimrt = n
  done = .false.
  while (!done)
    {
      if (trimrt == 0)
        done = .true.
      else if (!issp (str(trimrt)))
        done = .true.
      else
        trimrt = trimrt - 1
    }
end

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

subroutine addstq (strngs, istrng, src, i0, n0, i, n)

  # Add a quoted string to the string pool.

  implicit none

  character strngs(STRNSZ)      # String pool.
  integer istrng                # String pool's next slot.
  character src(*)              # Source string.
  integer i0, n0                # Index and length in source string.
  integer i, n                  # Index and length in string pool.

  integer j
  logical done

1000 format ('attempt to treat an unquoted string as a quoted string')

  if (src(i0) != char (DQUOTE) || src(i0 + n0 - 1) != char (DQUOTE))
    {
      write (*, 1000)
      stop
    }

  i = istrng

  n = 0
  j = i0 + 1
  done = .false.
  while (j != i0 + n0 - 1)
    if (i == STRNSZ)
      {
        write (*, '(''string pool exhausted'')')
        stop
      }
    else if (src(j) == char (BACKSL))
      {
        if (j == i0 + n0 - 1)
          {
            write (*, '(''incorrectly formed quoted string'')')
            stop
          }
        if (src(j + 1) == 'n')
          strngs(istrng) = char (NEWLIN)
        else if (src(j + 1) == char (BACKSL))
          strngs(istrng) = src(j + 1)
        else
          {
            write (*, '(''unrecognized escape sequence'')')
            stop
          }
        istrng = istrng + 1
        n = n + 1
        j = j + 2
      }
    else
      {
        strngs(istrng) = src(j)
        istrng = istrng + 1
        n = n + 1
        j = j + 1
      }
end

subroutine addstu (strngs, istrng, src, i0, n0, i, n)

  # Add an unquoted string to the string pool.

  implicit none

  character strngs(STRNSZ)      # String pool.
  integer istrng                # String pool's next slot.
  character src(*)              # Source string.
  integer i0, n0                # Index and length in source string.
  integer i, n                  # Index and length in string pool.

  integer j

  if (STRNSZ < istrng + (n0 - 1))
    {
      write (*, '(''string pool exhausted'')')
      stop
    }
  for (j = 0; j < n0; j = j + 1)
    strngs(istrng + j) = src(i0 + j)
  i = istrng
  n = n0
  istrng = istrng + n0
end

subroutine addstr (strngs, istrng, src, i0, n0, i, n)

  # Add a string (possibly given as a quoted string) to the string
  # pool.

  implicit none

  character strngs(STRNSZ)      # String pool.
  integer istrng                # String pool's next slot.
  character src(*)              # Source string.
  integer i0, n0                # Index and length in source string.
  integer i, n                  # Index and length in string pool.

  if (n0 == 0)
    {
      i = 0
      n = 0
    }
  else if (src(i0) == char (DQUOTE))
    call addstq (strngs, istrng, src, i0, n0, i, n)
  else
    call addstu (strngs, istrng, src, i0, n0, i, n)
end

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

subroutine push (stack, sp, i)

  implicit none

  integer stack(STCKSZ)
  integer sp                    # Stack pointer.
  integer i                     # Value to push.

  if (sp == STCKSZ)
    {
      write (*, '(''stack overflow in push'')')
      stop
    }
  stack(sp) = i
  sp = sp + 1
end

function pop (stack, sp)

  implicit none

  integer stack(STCKSZ)
  integer sp                    # Stack pointer.
  integer pop

  if (sp == 1)
    {
      write (*, '(''stack underflow in pop'')')
      stop
    }
  sp = sp - 1
  pop = stack(sp)
end

function nstack (sp)

  implicit none

  integer sp                    # Stack pointer.
  integer nstack

  nstack = sp - 1               # Current cardinality of the stack.
end

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

subroutine initnd (nodes, frelst)

  # Initialize the nodes pool.

  implicit none

  integer nodes (NODESZ, NODSSZ)
  integer frelst                # Head of the free list.

  integer i

  for (i = 1; i < NODSSZ; i = i + 1)
    nodes(NNEXTF, i) = i + 1
  nodes(NNEXTF, NODSSZ) = NIL
  frelst = 1
end

subroutine newnod (nodes, frelst, i)

  # Get the index for a new node taken from the free list.

  integer nodes (NODESZ, NODSSZ)
  integer frelst                # Head of the free list.
  integer i                     # Index of the new node.

  integer j

  if (frelst == NIL)
    {
      write (*, '(''nodes pool exhausted'')')
      stop
    }
  i = frelst
  frelst = nodes(NNEXTF, frelst)
  for (j = 1; j <= NODESZ; j = j + 1)
    nodes(j, i) = 0
end

subroutine frenod (nodes, frelst, i)

  # Return a node to the free list.

  integer nodes (NODESZ, NODSSZ)
  integer frelst                # Head of the free list.
  integer i                     # Index of the node to free.

  nodes(NNEXTF, i) = frelst
  frelst = i
end

function strtag (str, i, n)

  implicit none

  character str(*)
  integer i, n
  integer strtag

  character*16 s
  integer j

  for (j = 0; j < 16; j = j + 1)
    if (j < n)
      s(j + 1 : j + 1) = str(i + j)
    else
      s(j + 1 : j + 1) = ' '

  if (s == "Identifier      ")
    strtag = NDID
  else if (s == "String          ")
    strtag = NDSTR
  else if (s == "Integer         ")
    strtag = NDINT
  else if (s == "Sequence        ")
    strtag = NDSEQ
  else if (s == "If              ")
    strtag = NDIF
  else if (s == "Prtc            ")
    strtag = NDPRTC
  else if (s == "Prts            ")
    strtag = NDPRTS
  else if (s == "Prti            ")
    strtag = NDPRTI
  else if (s == "While           ")
    strtag = NDWHIL
  else if (s == "Assign          ")
    strtag = NDASGN
  else if (s == "Negate          ")
    strtag = NDNEG
  else if (s == "Not             ")
    strtag = NDNOT
  else if (s == "Multiply        ")
    strtag = NDMUL
  else if (s == "Divide          ")
    strtag = NDDIV
  else if (s == "Mod             ")
    strtag = NDMOD
  else if (s == "Add             ")
    strtag = NDADD
  else if (s == "Subtract        ")
    strtag = NDSUB
  else if (s == "Less            ")
    strtag = NDLT
  else if (s == "LessEqual       ")
    strtag = NDLE
  else if (s == "Greater         ")
    strtag = NDGT
  else if (s == "GreaterEqual    ")
    strtag = NDGE
  else if (s == "Equal           ")
    strtag = NDEQ
  else if (s == "NotEqual        ")
    strtag = NDNE
  else if (s == "And             ")
    strtag = NDAND
  else if (s == "Or              ")
    strtag = NDOR
  else if (s == ";               ")
    strtag = NIL
  else
    {
      write (*, '(''unrecognized input line: '', A16)') s
      stop
    }
end

subroutine readln (strngs, istrng, tag, iarg, narg)

  # Read a line of the AST input.

  implicit none

  character strngs(STRNSZ) # String pool.
  integer istrng           # String pool's next slot.
  integer tag              # The node tag or NIL.
  integer iarg             # Index of an argument in the string pool.
  integer narg             # Length of an argument in the string pool.

  integer trimrt
  integer strtag
  integer skipsp
  integer skipns

  character line(LINESZ)
  character*20 fmt
  integer i, j, n

  # Read a line of text as an array of characters.
  write (fmt, '(''('', I10, ''A)'')') LINESZ
  read (*, fmt) line

  n = trimrt (line, LINESZ)

  i = skipsp (line, 1, n + 1)
  j = skipns (line, i, n + 1)
  tag = strtag (line, i, j - i)

  i = skipsp (line, j, n + 1)
  call addstr (strngs, istrng, line, i, (n + 1) - i, iarg, narg)
end

function hasarg (tag)

  implicit none

  integer tag
  logical hasarg

  hasarg = (tag == NDID || tag == NDINT || tag == NDSTR)
end

subroutine rdast (strngs, istrng, nodes, frelst, iast)

  # Read in the AST. A non-recursive algorithm is used.

  implicit none

  character strngs(STRNSZ)       # String pool.
  integer istrng                 # String pool's next slot.
  integer nodes (NODESZ, NODSSZ) # Nodes pool.
  integer frelst                 # Head of the free list.
  integer iast                   # Index of root node of the AST.

  integer nstack
  integer pop
  logical hasarg

  integer stack(STCKSZ)
  integer sp                    # Stack pointer.
  integer tag, iarg, narg
  integer i, j, k

  sp = 1

  call readln (strngs, istrng, tag, iarg, narg)
  if (tag == NIL)
    iast = NIL
  else
    {
      call newnod (nodes, frelst, i)
      iast = i
      nodes(NTAG, i) = tag
      nodes(NITV, i) = 0
      nodes(NITN, i) = 0
      if (hasarg (tag))
        {
          nodes(NITV, i) = iarg
          nodes(NITN, i) = narg
        }
      else
        {
          call push (stack, sp, i + RGT)
          call push (stack, sp, i)
          while (nstack (sp) != 0)
            {
              j = pop (stack, sp)
              k = mod (j, RGT)
              call readln (strngs, istrng, tag, iarg, narg)
              if (tag == NIL)
                i = NIL
              else
                {
                  call newnod (nodes, frelst, i)
                  nodes(NTAG, i) = tag
                  if (hasarg (tag))
                    {
                      nodes(NITV, i) = iarg
                      nodes(NITN, i) = narg
                    }
                  else
                    {
                      call push (stack, sp, i + RGT)
                      call push (stack, sp, i)
                    }
                }
              if (j == k)
                nodes(NLEFT, k) = i
              else
                nodes(NRIGHT, k) = i
            }
        }
    }
end

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

subroutine flushl (outbuf, noutbf)

  # Flush a line from the output buffer.

  implicit none

  character outbuf(OUTLSZ)      # Output line buffer.
  integer noutbf                # Number of characters in outbuf.

  character*20 fmt
  integer i

  if (noutbf == 0)
    write (*, '()')
  else
    {
      write (fmt, 1000) noutbf
1000  format ('(', I10, 'A)')
      write (*, fmt) (outbuf(i), i = 1, noutbf)
      noutbf = 0
    }
end

subroutine wrtchr (outbuf, noutbf, ch)

  # Write a character to output.

  implicit none

  character outbuf(OUTLSZ)      # Output line buffer.
  integer noutbf                # Number of characters in outbuf.
  character ch                  # The character to output.

  # This routine silently truncates anything that goes past the buffer
  # boundary.

  if (ch == char (NEWLIN))
    call flushl (outbuf, noutbf)
  else if (noutbf < OUTLSZ)
    {
      noutbf = noutbf + 1
      outbuf(noutbf) = ch
    }
end

subroutine wrtstr (outbuf, noutbf, str, i, n)

  # Write a substring to output.

  implicit none

  character outbuf(OUTLSZ)      # Output line buffer.
  integer noutbf                # Number of characters in outbuf.
  character str(*)              # The string from which to output.
  integer i, n                  # Index and length of the substring.

  integer j

  for (j = 0; j < n; j = j + 1)
    call wrtchr (outbuf, noutbf, str(i + j))
end

subroutine wrtint (outbuf, noutbf, ival)

  # Write a non-negative integer to output.

  implicit none

  character outbuf(OUTLSZ)      # Output line buffer.
  integer noutbf                # Number of characters in outbuf.
  integer ival                  # The non-negative integer to print.

  integer skipsp

  character*40 buf
  integer i

  # Using "write" probably is the slowest way one could think of to do
  # this, but people do formatted output all the time, anyway. :) The
  # reason, of course, is that output tends to be slow anyway.
  write (buf, '(I40)') ival
  for (i = skipsp (buf, 1, 41); i <= 40; i = i + 1)
    call wrtchr (outbuf, noutbf, buf(i:i))
end

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

define(VARSZ,  3)
define(VNAMEI, 1)          # Variable name's index in the string pool.
define(VNAMEN, 2)          # Length of the name.
define(VVALUE, 3)          # Variable's value.

function fndvar (vars, numvar, strngs, istrng, i0, n0)

  implicit none

  integer vars(VARSZ, MAXVAR)   # Variables.
  integer numvar                # Number of variables.
  character strngs(STRNSZ)      # String pool.
  integer istrng                # String pool's next slot.
  integer i0, n0                # Index and length in the string pool.
  integer fndvar                # The location of the variable.

  integer j, k
  integer i, n
  logical done1
  logical done2

  j = 1
  done1 = .false.
  while (!done1)
    if (j == numvar + 1)
      done1 = .true.
    else if (n0 == vars(VNAMEN, j))
      {
        k = 0
        done2 = .false.
        while (!done2)
          if (n0 <= k)
            done2 = .true.
          else if (strngs(i0 + k) == strngs(vars(VNAMEI, j) + k))
            k = k + 1
          else
            done2 = .true.
        if (k < n0)
          j = j + 1
        else
          {
            done2 = .true.
            done1 = .true.
          }
      }
    else
      j = j + 1

  if (j == numvar + 1)
    {
      if (numvar == MAXVAR)
        {
          write (*, '(''too many variables'')')
          stop
        }
      numvar = numvar + 1
      call addstu (strngs, istrng, strngs, i0, n0, i, n)
      vars(VNAMEI, numvar) = i
      vars(VNAMEN, numvar) = n
      vars(VVALUE, numvar) = 0
      fndvar = numvar
    }
  else
    fndvar = j
end

function strint (strngs, i, n)

  # Convert a string to a non-negative integer.

  implicit none

  character strngs(STRNSZ)       # String pool.
  integer i, n
  integer strint

  integer j

  strint = 0
  for (j = 0; j < n; j = j + 1)
    strint = (10 * strint) + (ichar (strngs(i + j)) - ichar ('0'))
end

function logl2i (u)

  # Convert LOGICAL to INTEGER.

  implicit none

  logical u
  integer logl2i

  if (u)
    logl2i = 1
  else
    logl2i = 0
end

subroutine run (vars, numvar, _
                strngs, istrng, _
                nodes, frelst, _
                outbuf, noutbf, iast)

  # Run (interpret) the AST. The algorithm employed is non-recursive.

  implicit none

  integer vars(VARSZ, MAXVAR)    # Variables.
  integer numvar                 # Number of variables.
  character strngs(STRNSZ)       # String pool.
  integer istrng                 # String pool's next slot.
  integer nodes (NODESZ, NODSSZ) # Nodes pool.
  integer frelst                 # Head of the free list.
  character outbuf(OUTLSZ)       # Output line buffer.
  integer noutbf                 # Number of characters in outbuf.
  integer iast                   # Root node of the AST.

  integer fndvar
  integer logl2i
  integer nstack
  integer pop
  integer strint

  integer dstack(STCKSZ)        # Data stack.
  integer idstck                # Data stack pointer.
  integer xstack(STCKSZ)        # Execution stack.
  integer ixstck                # Execution stack pointer.
  integer i
  integer i0, n0
  integer tag
  integer ivar
  integer ival1, ival2
  integer inode1, inode2

  idstck = 1
  ixstck = 1
  call push (xstack, ixstck, iast)
  while (nstack (ixstck) != 0)
    {
      i = pop (xstack, ixstck)
      if (i == NIL)
        tag = NIL
      else
        tag = nodes(NTAG, i)
      if (tag == NIL)
        continue
      else if (tag == NDSEQ)
        {
          if (nodes(NRIGHT, i) != NIL)
            call push (xstack, ixstck, nodes(NRIGHT, i))
          if (nodes(NLEFT, i) != NIL)
            call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDID)
        {
          # Push the value of a variable.
          i0 = nodes(NITV, i)
          n0 = nodes(NITN, i)
          ivar = fndvar (vars, numvar, strngs, istrng, i0, n0)
          call push (dstack, idstck, vars(VVALUE, ivar))
        }
      else if (tag == NDINT)
        {
          # Push the value of an integer literal.
          i0 = nodes(NITV, i)
          n0 = nodes(NITN, i)
          call push (dstack, idstck, strint (strngs, i0, n0))
        }
      else if (tag == NDNEG)
        {
          # Evaluate the argument and prepare to negate it.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDNEG + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDNEG + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # Negate the evaluated argument.
          ival1 = pop (dstack, idstck)
          call push (dstack, idstck, -ival1)
        }
      else if (tag == NDNOT)
        {
          # Evaluate the argument and prepare to NOT it.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDNOT + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDNOT + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # NOT the evaluated argument.
          ival1 = pop (dstack, idstck)
          call push (dstack, idstck, logl2i (ival1 == 0))
        }
      else if (tag == NDAND)
        {
          # Evaluate the arguments and prepare to AND them.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDAND + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NRIGHT, i))
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDAND + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # AND the evaluated arguments.
          ival2 = pop (dstack, idstck)
          ival1 = pop (dstack, idstck)
          call push (dstack, idstck, _
                     logl2i (ival1 != 0 && ival2 != 0))
        }
      else if (tag == NDOR)
        {
          # Evaluate the arguments and prepare to OR them.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDOR + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NRIGHT, i))
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDOR + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # OR the evaluated arguments.
          ival2 = pop (dstack, idstck)
          ival1 = pop (dstack, idstck)
          call push (dstack, idstck, _
                     logl2i (ival1 != 0 || ival2 != 0))
        }
      else if (tag == NDADD)
        {
          # Evaluate the arguments and prepare to add them.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDADD + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NRIGHT, i))
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDADD + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # Add the evaluated arguments.
          ival2 = pop (dstack, idstck)
          ival1 = pop (dstack, idstck)
          call push (dstack, idstck, ival1 + ival2)
        }
      else if (tag == NDSUB)
        {
          # Evaluate the arguments and prepare to subtract them.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDSUB + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NRIGHT, i))
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDSUB + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # Subtract the evaluated arguments.
          ival2 = pop (dstack, idstck)
          ival1 = pop (dstack, idstck)
          call push (dstack, idstck, ival1 - ival2)
        }
      else if (tag == NDMUL)
        {
          # Evaluate the arguments and prepare to multiply them.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDMUL + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NRIGHT, i))
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDMUL + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # Multiply the evaluated arguments.
          ival2 = pop (dstack, idstck)
          ival1 = pop (dstack, idstck)
          call push (dstack, idstck, ival1 * ival2)
        }
      else if (tag == NDDIV)
        {
          # Evaluate the arguments and prepare to compute the quotient
          # after division.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDDIV + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NRIGHT, i))
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDDIV + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # Divide the evaluated arguments.
          ival2 = pop (dstack, idstck)
          ival1 = pop (dstack, idstck)
          call push (dstack, idstck, ival1 / ival2)
        }
      else if (tag == NDMOD)
        {
          # Evaluate the arguments and prepare to compute the
          # remainder after division.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDMOD + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NRIGHT, i))
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDMOD + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # MOD the evaluated arguments.
          ival2 = pop (dstack, idstck)
          ival1 = pop (dstack, idstck)
          call push (dstack, idstck, mod (ival1, ival2))
        }
      else if (tag == NDEQ)
        {
          # Evaluate the arguments and prepare to test their equality.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDEQ + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NRIGHT, i))
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDEQ + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # Test for equality.
          ival2 = pop (dstack, idstck)
          ival1 = pop (dstack, idstck)
          call push (dstack, idstck, logl2i (ival1 == ival2))
        }
      else if (tag == NDNE)
        {
          # Evaluate the arguments and prepare to test their
          # inequality.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDNE + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NRIGHT, i))
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDNE + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # Test for inequality.
          ival2 = pop (dstack, idstck)
          ival1 = pop (dstack, idstck)
          call push (dstack, idstck, logl2i (ival1 != ival2))
        }
      else if (tag == NDLT)
        {
          # Evaluate the arguments and prepare to test their
          # order.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDLT + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NRIGHT, i))
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDLT + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # Do the test.
          ival2 = pop (dstack, idstck)
          ival1 = pop (dstack, idstck)
          call push (dstack, idstck, logl2i (ival1 < ival2))
        }
      else if (tag == NDLE)
        {
          # Evaluate the arguments and prepare to test their
          # order.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDLE + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NRIGHT, i))
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDLE + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # Do the test.
          ival2 = pop (dstack, idstck)
          ival1 = pop (dstack, idstck)
          call push (dstack, idstck, logl2i (ival1 <= ival2))
        }
      else if (tag == NDGT)
        {
          # Evaluate the arguments and prepare to test their
          # order.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDGT + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NRIGHT, i))
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDGT + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # Do the test.
          ival2 = pop (dstack, idstck)
          ival1 = pop (dstack, idstck)
          call push (dstack, idstck, logl2i (ival1 > ival2))
        }
      else if (tag == NDGE)
        {
          # Evaluate the arguments and prepare to test their
          # order.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDGE + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NRIGHT, i))
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDGE + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # Do the test.
          ival2 = pop (dstack, idstck)
          ival1 = pop (dstack, idstck)
          call push (dstack, idstck, logl2i (ival1 >= ival2))
        }
      else if (tag == NDASGN)
        {
          # Prepare a new node to do the actual assignment.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDASGN + STAGE2
          nodes(NITV, inode1) = nodes(NITV, nodes(NLEFT, i))
          nodes(NITN, inode1) = nodes(NITN, nodes(NLEFT, i))
          call push (xstack, ixstck, inode1)
          # Evaluate the expression.
          call push (xstack, ixstck, nodes(NRIGHT, i))
        }
      else if (tag == NDASGN + STAGE2)
        {
          # Do the actual assignment, and free the STAGE2 node.
          i0 = nodes(NITV, i)
          n0 = nodes(NITN, i)
          call frenod (nodes, frelst, i)
          ival1 = pop (dstack, idstck)
          ivar = fndvar (vars, numvar, strngs, istrng, i0, n0)
          vars(VVALUE, ivar) = ival1
        }
      else if (tag == NDIF)
        {
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDIF + STAGE2
          # The "then" and "else" clauses, respectively:
          nodes(NLEFT, inode1) = nodes(NLEFT, nodes(NRIGHT, i))
          nodes(NRIGHT, inode1) = nodes(NRIGHT, nodes(NRIGHT, i))
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDIF + STAGE2)
        {
          inode1 = nodes(NLEFT, i)  # "Then" clause.
          inode2 = nodes(NRIGHT, i) # "Else" clause.
          call frenod (nodes, frelst, i)
          ival1 = pop (dstack, idstck)
          if (ival1 != 0)
            call push (xstack, ixstck, inode1)
          else if (inode2 != NIL)
            call push (xstack, ixstck, inode2)
        }
      else if (tag == NDWHIL)
        {
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDWHIL + STAGE2
          nodes(NLEFT, inode1) = nodes(NRIGHT, i) # Loop body.
          nodes(NRIGHT, inode1) = i               # Top of loop.
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDWHIL + STAGE2)
        {
          inode1 = nodes(NLEFT, i)  # Loop body.
          inode2 = nodes(NRIGHT, i) # Top of loop.
          call frenod (nodes, frelst, i)
          ival1 = pop (dstack, idstck)
          if (ival1 != 0)
            {
              call push (xstack, ixstck, inode2) # Top of loop.
              call push (xstack, ixstck, inode1) # The body.
            }
        }
      else if (tag == NDPRTS)
        {
          # Print a string literal. (String literals occur only--and
          # always--within Prts nodes; therefore one need not devise a
          # way push strings to the stack.)
          i0 = nodes(NITV, nodes(NLEFT, i))
          n0 = nodes(NITN, nodes(NLEFT, i))
          call wrtstr (outbuf, noutbf, strngs, i0, n0)
        }
      else if (tag == NDPRTC)
        {
          # Evaluate the argument and prepare to print it.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDPRTC + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDPRTC + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # Print the evaluated argument.
          ival1 = pop (dstack, idstck)
          call wrtchr (outbuf, noutbf, char (ival1))
        }
      else if (tag == NDPRTI)
        {
          # Evaluate the argument and prepare to print it.
          call newnod (nodes, frelst, inode1)
          nodes(NTAG, inode1) = NDPRTI + STAGE2
          call push (xstack, ixstck, inode1)
          call push (xstack, ixstck, nodes(NLEFT, i))
        }
      else if (tag == NDPRTI + STAGE2)
        {
          # Free the STAGE2 node.
          call frenod (nodes, frelst, i)
          # Print the evaluated argument.
          ival1 = pop (dstack, idstck)
          call wrtint (outbuf, noutbf, ival1)
        }
    }
end

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

program interp

  implicit none

  integer vars(VARSZ, MAXVAR)    # Variables.
  integer numvar                 # Number of variables.
  character strngs(STRNSZ)       # String pool.
  integer istrng                 # String pool's next slot.
  integer nodes (NODESZ, NODSSZ) # Nodes pool.
  integer frelst                 # Head of the free list.
  character outbuf(OUTLSZ)       # Output line buffer.
  integer noutbf                 # Number of characters in outbuf.
  integer iast                   # Root node of the AST.

  numvar = 0
  istrng = 1
  noutbf = 0

  call initnd (nodes, frelst)
  call rdast (strngs, istrng, nodes, frelst, iast)

  call run (vars, numvar, _
            strngs, istrng, _
            nodes, frelst, _
            outbuf, noutbf, iast)

  if (noutbf != 0)
    call flushl (outbuf, noutbf)
end

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


package xyz.hyperreal.rosettacodeCompiler

import scala.collection.mutable
import scala.io.Source

object ASTInterpreter {

  def fromStdin = fromSource(Source.stdin)

  def fromString(src: String) = fromSource(Source.fromString(src))

  def fromSource(s: Source) = {
    val lines = s.getLines

    def load: Node =
      if (!lines.hasNext)
        TerminalNode
      else
        lines.next.split(" +", 2) match {
          case Array(name, value) => LeafNode(name, value)
          case Array(";")         => TerminalNode
          case Array(name)        => BranchNode(name, load, load)
        }

    val vars = new mutable.HashMap[String, Any]

    def interpInt(n: Node) = interp(n).asInstanceOf[Int]

    def interpBoolean(n: Node) = interp(n).asInstanceOf[Boolean]

    def interp(n: Node): Any =
      n match {
        case TerminalNode => null
        case LeafNode("Identifier", name) =>
          vars get name match {
            case None =>
              vars(name) = 0
              0
            case Some(v) => v
          }
        case LeafNode("Integer", "'\\n'")                               => '\n'.toInt
        case LeafNode("Integer", "'\\\\'")                              => '\\'.toInt
        case LeafNode("Integer", value: String) if value startsWith "'" => value(1).toInt
        case LeafNode("Integer", value: String)                         => value.toInt
        case LeafNode("String", value: String)                          => unescape(value.substring(1, value.length - 1))
        case BranchNode("Assign", LeafNode(_, name), exp)               => vars(name) = interp(exp)
        case BranchNode("Sequence", l, r)                               => interp(l); interp(r)
        case BranchNode("Prts" | "Prti", a, _)                          => print(interp(a))
        case BranchNode("Prtc", a, _)                                   => print(interpInt(a).toChar)
        case BranchNode("Add", l, r)                                    => interpInt(l) + interpInt(r)
        case BranchNode("Subtract", l, r)                               => interpInt(l) - interpInt(r)
        case BranchNode("Multiply", l, r)                               => interpInt(l) * interpInt(r)
        case BranchNode("Divide", l, r)                                 => interpInt(l) / interpInt(r)
        case BranchNode("Mod", l, r)                                    => interpInt(l) % interpInt(r)
        case BranchNode("Negate", a, _)                                 => -interpInt(a)
        case BranchNode("Less", l, r)                                   => interpInt(l) < interpInt(r)
        case BranchNode("LessEqual", l, r)                              => interpInt(l) <= interpInt(r)
        case BranchNode("Greater", l, r)                                => interpInt(l) > interpInt(r)
        case BranchNode("GreaterEqual", l, r)                           => interpInt(l) >= interpInt(r)
        case BranchNode("Equal", l, r)                                  => interpInt(l) == interpInt(r)
        case BranchNode("NotEqual", l, r)                               => interpInt(l) != interpInt(r)
        case BranchNode("And", l, r)                                    => interpBoolean(l) && interpBoolean(r)
        case BranchNode("Or", l, r)                                     => interpBoolean(l) || interpBoolean(r)
        case BranchNode("Not", a, _)                                    => !interpBoolean(a)
        case BranchNode("While", l, r)                                  => while (interpBoolean(l)) interp(r)
        case BranchNode("If", cond, BranchNode("If", yes, no))          => if (interpBoolean(cond)) interp(yes) else interp(no)
      }

    interp(load)
  }

  abstract class Node
  case class BranchNode(name: String, left: Node, right: Node) extends Node
  case class LeafNode(name: String, value: String)             extends Node
  case object TerminalNode                                     extends Node

}


*        Compare a list of strings 31/01/2017
COMPLIST CSECT
         USING  COMPLIST,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         " <-
         ST     R15,8(R13)         " ->
         LR     R13,R15            " addressability
         MVC    SNAME,=C'ABC'
         LA     R1,SNAME
         LA     R2,ABC
         BAL    R14,TEST           call test('ABC',abc)
         MVC    SNAME,=C'AAA'
         LA     R1,SNAME
         LA     R2,AAA
         BAL    R14,TEST           call test('AAA',aaa)
         MVC    SNAME,=C'ACB'
         LA     R1,SNAME
         LA     R2,ACB
         BAL    R14,TEST           call test('ACB',acb)
         L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    " restore
         XR     R15,R15            " rc=0
         BR     R14                exit
*------- ----   test(name,xlist) -----------------------
TEST     MVC    NAME,0(R1)         store argument #1
         MVC    XLIST(6),0(R2)     store argument #2
         MVI    ALLEQ,X'01'        alleq=true
         MVI    INCRE,X'01'        incre=true
         LA     R6,1               i=1
LOOPI    LA     R2,NXLIST          hbound(xlist)
         BCTR   R2,0               -1
         CR     R6,R2              do i to hbound(xlist)-1
         BH     ELOOPI
         MVC    XBOOL,ALLEQ
         OC     XBOOL,INCRE        or
         CLI    XBOOL,X'01'        and while alleq or incre
         BNE    ELOOPI
         LA     R2,1(R6)           i+1
         SLA    R2,1               *2
         LA     R3,XLIST-2(R2)     @xlist(i+1)
         LR     R1,R6              i
         SLA    R1,1               *2
         LA     R4,XLIST-2(R1)     @xlist(i)
         CLC    0(2,R3),0(R4)      if xlist(i+1)=xlist(i)
         BNE    SEL1B
         MVI    INCRE,X'00'        incre=false
         B      SEL1END
SEL1B    CLC    0(2,R3),0(R4)      if xlist(i+1)<xlist(i)
         BNL    SEL1OTH
         MVI    INCRE,X'00'        incre=false
         MVI    ALLEQ,X'00'        alleq=false
         B      SEL1END
SEL1OTH  MVI    ALLEQ,X'00'        alleq=false
SEL1END  LA     R6,1(R6)           i=i+1
         B      LOOPI
ELOOPI   CLI    ALLEQ,X'01'        if alleq
         BNE    SEL2B
         MVC    TXT,=CL40'all elements are equal'
         B      SEL2END
SEL2B    CLI    INCRE,X'01'        if incre
         BNE    SEL2OTH
         MVC    TXT,=CL40'elements are in increasing order'
         B      SEL2END
SEL2OTH  MVC    TXT,=CL40'neither equal nor in increasing order'
SEL2END  MVI    PG,C' '
         MVC    PG+1(79),PG        clear buffer
         MVC    PG(3),NAME
         MVC    PG+3(3),=C' : '
         MVC    PG+6(40),TXT
         XPRNT  PG,L'PG
         BR     R14                return to caller
*        ----   ----------------------------------------
SNAME    DS     CL3
ABC      DC     CL2'AA',CL2'BB',CL2'CC'
AAA      DC     CL2'AA',CL2'AA',CL2'AA'
ACB      DC     CL2'AA',CL2'CC',CL2'BB'
NAME     DS     CL3
XLIST    DS     3CL2
NXLIST   EQU    (*-XLIST)/L'XLIST
ALLEQ    DS     X
INCRE    DS     X
TXT      DS     CL40
XBOOL    DS     X
PG       DS     CL80
         YREGS
         END    COMPLIST


DEFINE PTR="CARD"

BYTE FUNC AreEqual(PTR ARRAY a BYTE len)
  INT i

  FOR i=1 TO len-1
  DO
    IF SCompare(a(0),a(i))#0 THEN
      RETURN (0)
    FI
  OD
RETURN (1)

BYTE FUNC IsAscendingOrder(PTR ARRAY a BYTE len)
  INT i

  FOR i=1 TO len-1
  DO
    IF SCompare(a(i-1),a(i))>=0 THEN
      RETURN (0)
    FI
  OD
RETURN (1)

PROC Test(PTR ARRAY a BYTE len)
  INT i

  Print("Input array: [")
  FOR i=0 TO len-1
  DO
    Print(a(i))
    IF i<len-1 THEN
      Put(32)
    FI
  OD
  PrintE("]")

  IF AreEqual(a,len) THEN
    PrintE("All strings are lexically equal.")
  ELSE
    PrintE("Not all strings are lexically equal.")
  FI

  IF IsAscendingOrder(a,len) THEN
    PrintE("The list is in strict ascending order.")
  ELSE
    PrintE("The list is not in strict ascending order.")
  FI
  PutE()
RETURN

PROC Main()
  PTR ARRAY a1(4),a2(4),a3(4),a4(1)

  a1(0)="aaa" a1(1)="aaa" a1(2)="aaa" a1(3)="aaa"
  Test(a1,4)

  a2(0)="aaa" a2(1)="aab" a2(2)="aba" a2(3)="baa"
  Test(a2,4)

  a3(0)="aaa" a3(1)="aab" a3(2)="aba" a3(3)="aba"
  Test(a3,4)

  a4(0)="aaa"
  Test(a4,1)
RETURN


  package String_Vec is new Ada.Containers.Indefinite_Vectors
     (Index_Type => Positive, Element_Type => String);

   use type String_Vec.Vector;


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

;; Mappings from operation symbols to internal procedures.
;; We define operations appropriate to virtual machine:
;; e.g. division must return an int, not a rational
;; boolean values are treated as numbers: 0 is false, other is true
(define *unary-ops*
  (list (cons 'Negate (lambda (a) (- a)))
        (cons 'Not (lambda (a) (if (zero? a) 1 0)))))
(define *binary-ops*
  (let ((number-comp (lambda (op) (lambda (a b) (if (op a b) 1 0)))))
    (list (cons 'Add +)
          (cons 'Subtract -)
          (cons 'Multiply *)
          (cons 'Divide (lambda (a b) (truncate (/ a b)))) ; int division
          (cons 'Mod modulo)
          (cons 'Less (number-comp <))
          (cons 'Greater (number-comp >))
          (cons 'LessEqual (number-comp <=))
          (cons 'GreaterEqual (number-comp >=))
          (cons 'Equal (lambda (a b) (if (= a b) 1 0)))
          (cons 'NotEqual (lambda (a b) (if (= a b) 0 1)))
          (cons 'And (lambda (a b) ; make "and" work on numbers
                       (if (and (not (zero? a)) (not (zero? b))) 1 0)))
          (cons 'Or (lambda (a b) ; make "or" work on numbers
                      (if (or (not (zero? a)) (not (zero? b))) 1 0))))))

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

;; interpret AST provided as an s-expression
(define run-program
  (let ((env '())) ; env is an association list for variable names
    (lambda (expr)
      (define (tidy-string str)
        (string-delete ; remove any quote marks
          #\" ; " (to appease Rosetta code's syntax highlighter)
          (list->string
            (let loop ((chars (string->list str))) ; replace newlines, obeying \\n
              (cond ((< (length chars) 2) ; finished list
                     chars)
                    ((and (>= (length chars) 3) ; preserve \\n
                          (char=? #\\ (car chars))
                          (char=? #\\ (cadr chars))
                          (char=? #\n (cadr (cdr chars))))
                     (cons (car chars)
                           (cons (cadr chars)
                                 (cons (cadr (cdr chars))
                                       (loop (cdr (cdr (cdr chars))))))))
                    ((and (char=? #\\ (car chars)) ; replace \n with newline
                          (char=? #\n (cadr chars)))
                     (cons #\newline (loop (cdr (cdr chars)))))
                    (else ; keep char and look further
                      (cons (car chars) (loop (cdr chars)))))))))
      ; define some more meaningful names for fields
      (define left cadr)
      (define right (lambda (x) (cadr (cdr x))))
      ;
      (if (null? expr)
        '()
        (case (car expr) ; interpret AST from the head node
          ((Integer)
           (string->number (left expr)))
          ((Identifier)
           (let ((val (assq (string->symbol (left expr)) env)))
             (if val
               (cdr val)
               (error "Variable not in environment"))))
          ((String)
           (left expr))
          ((Assign)
           (set! env (cons (cons (string->symbol (left (left expr)))
                                 (run-program (right expr)))
                           env)))
          ((Add Subtract Multiply Divide Mod
                Less Greater LessEqual GreaterEqual Equal NotEqual
                And Or)
           (let ((binop (assq (car expr) *binary-ops*)))
             (if binop
               ((cdr binop) (run-program (left expr))
                            (run-program (right expr)))
               (error "Could not find binary operator"))))
          ((Negate Not)
           (let ((unaryop (assq (car expr) *unary-ops*)))
             (if unaryop
               ((cdr unaryop) (run-program (left expr)))
               (error "Could not find unary operator"))))
          ((If)
           (if (not (zero? (run-program (left expr)))) ; 0 means false
             (run-program (left (right expr)))
             (run-program (right (right expr))))
           '())
          ((While)
           (let loop ()
             (unless (zero? (run-program (left expr)))
               (run-program (right expr))
               (loop)))
           '())
          ((Prtc)
           (display (integer->char (run-program (left expr))))
           '())
          ((Prti)
           (display (run-program (left expr)))
           '())
          ((Prts)
           (display (tidy-string (run-program (left expr))))
           '())
          ((Sequence)
           (run-program (left expr))
           (run-program (right expr))
           '())
          (else
            (error "Unknown node type")))))))

;; read AST from file and interpret, from filename passed on command line
(if (= 2 (length (command-line)))
  (run-program (read-code (cadr (command-line))))
  (display "Error: pass an ast filename\n"))


[]STRING list1 = ("AA","BB","CC");
[]STRING list2 = ("AA","AA","AA");
[]STRING list3 = ("AA","CC","BB");
[]STRING list4 = ("AA","ACB","BB","CC");
[]STRING list5 = ("single_element");

[][]STRING all lists to test = (list1, list2, list3, list4, list5);

PROC equal = ([]STRING list) BOOL:
   BEGIN
      BOOL ok := TRUE;
      FOR i TO UPB list - 1 WHILE ok DO
	 ok := list[i] = list[i+1]
      OD;
      ok
   END;

PROC less than = ([]STRING list) BOOL:
   BEGIN
      BOOL ok := TRUE;
      FOR i TO UPB list - 1 WHILE ok DO
	 ok := list[i] < list[i + 1]
      OD;
      ok
   END;

FOR i TO UPB all lists to test DO
   []STRING list = all lists to test[i];
   print (("list:", (STRING s; FOR i TO UPB list DO s +:= " " + list[i] OD; s), new line));
   IF equal (list) THEN
      print (("...is lexically equal", new line))
   ELSE
      print (("...is not lexically equal", new line))
   FI;
   IF less than (list) THEN
      print (("...is in strict ascending order", new line))
   ELSE
      print (("...is not in strict ascending order", new line))
   FI
OD