begin % AST interpreter %
    % parse tree nodes %
    record node( integer         type
               ; reference(node) left, right
               ; integer         iValue % nString/nIndentifier number or nInteger value %
               );
    integer     nIdentifier, nString, nInteger, nSequence, nIf,   nPrtc, nPrts
          ,     nPrti,       nWhile,  nAssign,  nNegate,   nNot,  nMultiply
          ,     nDivide,     nMod,    nAdd,     nSubtract, nLess, nLessEqual
          ,     nGreater,    nGreaterEqual,     nEqual,    nNotEqual,    nAnd, nOr
          ;
    string(14) array ndName ( 1 :: 25 );
    integer    MAX_NODE_TYPE;
    % string literals and identifiers - uses a linked list - a hash table might be better... %
    string(1)   array text ( 0 :: 4095 );
    integer     textNext, TEXT_MAX;
    record textElement ( integer start, length; reference(textElement) next );
    reference(textElement) idList, stList;
    % memory - identifiers hold indexes to locations here %
    integer array data ( 1 :: 4096 );

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

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

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

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

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

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

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

    % interprets the specified node and returns the value %
    integer procedure eval ( reference(node) value n ) ; begin
        integer v;

        % prints a string from text, escape sequences are interpreted %
        procedure writeOnText( reference(textElement) value txHead; integer value txNumber ) ;
        begin
            reference(textElement) txPos;
            integer                count;
            txPos := txHead;
            count := 1;
            while count < txNumber and txPos not = null do begin
                txPos := next(txPos);
                count := count + 1
            end while_text_element_not_found ;
            if txPos = null then rtError( "INTERNAL ERROR: text not found." )
            else begin
                % found the text - output it, handling escape sequences %
                integer cPos;
                cPos := 1; % start from 1 to skip over the leading " %
                while cPos < length(txPos) do begin
                    string(1) ch;
                    ch := text( start(txPos) + cPos );
                    if ch not = "\" then writeon( s_w := 0, ch )
                    else begin
                        % escaped character %
                        cPos := cPos + 1;
                        if      cPos > length(txPos) then rtError( "String terminates with ""\""." )
                        else begin
                            ch := text( start(txPos) + cPos );
                            if ch = "n" then % newline % write()
                                        else writeon( s_w := 0, ch )
                        end
                    end;
                    cPos := cPos + 1
                end while_not_end_of_string
            end
        end writeOnText ;

        % returns 1 if val is true, 0 otherwise %
        integer procedure booleanResult ( logical value val ) ; begin
            if val then 1 else 0
        end booleanResult ;

        v := 0;

        if      n = null                 then v := 0
        else if type(n) = nIdentifier    then v := data( iValue(n) )
        else if type(n) = nString        then v := iValue(n)
        else if type(n) = nInteger       then v := iValue(n)
        else if type(n) = nSequence      then begin
            % sequence - evaluate and discard the left branch and return the right branch %
            v := eval(  left(n) );
            v := eval( right(n) )
            end
        else if type(n) = nIf            then % if-else         % begin
            if eval( left(n) ) not = 0 then v := eval(  left(right(n)) )
                                       else v := eval( right(right(n)) );
            v := 0
            end
        else if type(n) = nPrtc          then % print character % writeon( s_w := 0, code( eval( left(n) ) ) )
        else if type(n) = nPrts          then % print string    % writeOnText( stList, eval( left(n) ) )
        else if type(n) = nPrti          then % print integer   % writeon( s_w := 0, i_w := 1, eval( left(n) ) )
        else if type(n) = nWhile         then % while-loop      % begin
            while eval( left(n) ) not = 0 do v := eval( right(n) );
            v := 0
            end
        else if type(n) = nAssign        then % assignment      % data( iValue(left(n)) ) := eval( right(n) )
        else if type(n) = nNegate        then % unary -         % v := - eval( left(n) )
        else if type(n) = nNot           then % unary not       % v := booleanResult( eval( left(n) ) = 0 )
        else if type(n) = nMultiply      then % multiply        % v := eval( left(n) ) * eval( right(n) )
        else if type(n) = nDivide        then % division        % begin
            integer lv, rv;
            lv := eval(  left(n) );
            rv := eval( right(n) );
            if rv = 0 then rtError( "Division by 0." )
            else v := lv div rv
            end
        else if type(n) = nMod           then % modulo          % begin
            integer lv, rv;
            lv := eval(  left(n) );
            rv := eval( right(n) );
            if rv = 0 then rtError( "Right operand of % is 0." )
            else v := lv rem rv
            end
        else if type(n) = nAdd           then % addition        % v := eval( left(n) ) + eval( right(n) )
        else if type(n) = nSubtract      then % subtraction     % v := eval( left(n) ) - eval( right(n) )
        else if type(n) = nLess          then % less-than       % v := booleanResult( eval( left(n) ) <     eval( right(n) ) )
        else if type(n) = nLessEqual     then % less or equal   % v := booleanResult( eval( left(n) ) <=    eval( right(n) ) )
        else if type(n) = nGreater       then % greater-than    % v := booleanResult( eval( left(n) ) >     eval( right(n) ) )
        else if type(n) = nGreaterEqual  then % greater or eq   % v := booleanResult( eval( left(n) ) >=    eval( right(n) ) )
        else if type(n) = nEqual         then % test equal      % v := booleanResult( eval( left(n) ) =     eval( right(n) ) )
        else if type(n) = nNotEqual      then % not-equal       % v := booleanResult( eval( left(n) ) not = eval( right(n) ) )
        else if type(n) = nAnd           then % boolean "and"   % begin
            v := eval( left(n) );
            if v not = 0 then v := eval( right(n) )
            end
        else if type(n) = nOr            then % boolean "or"    % begin
            v := eval( left(n) );
            if v = 0 then v := eval( right(n) );
            end
        else % unknown node % begin
            rtError( "Unknown node type in eval." )
        end;
        v
    end eval ;

    nIdentifier      :=  1; ndName( nIdentifier      ) := "Identifier";   nString    :=  2; ndName( nString   ) := "String";
    nInteger         :=  3; ndName( nInteger         ) := "Integer";      nSequence  :=  4; ndName( nSequence ) := "Sequence";
    nIf              :=  5; ndName( nIf              ) := "If";           nPrtc      :=  6; ndName( nPrtc     ) := "Prtc";
    nPrts            :=  7; ndName( nPrts            ) := "Prts";         nPrti      :=  8; ndName( nPrti     ) := "Prti";
    nWhile           :=  9; ndName( nWhile           ) := "While";        nAssign    := 10; ndName( nAssign   ) := "Assign";
    nNegate          := 11; ndName( nNegate          ) := "Negate";       nNot       := 12; ndName( nNot      ) := "Not";
    nMultiply        := 13; ndName( nMultiply        ) := "Multiply";     nDivide    := 14; ndName( nDivide   ) := "Divide";
    nMod             := 15; ndName( nMod             ) := "Mod";          nAdd       := 16; ndName( nAdd      ) := "Add";
    nSubtract        := 17; ndName( nSubtract        ) := "Subtract";     nLess      := 18; ndName( nLess     ) := "Less";
    nLessEqual       := 19; ndName( nLessEqual       ) := "LessEqual"  ;  nGreater   := 20; ndName( nGreater  ) := "Greater";
    nGreaterEqual    := 21; ndName( nGreaterEqual    ) := "GreaterEqual"; nEqual     := 22; ndName( nEqual    ) := "Equal";
    nNotEqual        := 23; ndName( nNotEqual        ) := "NotEqual";     nAnd       := 24; ndName( nAnd      ) := "And";
    nOr              := 25; ndName( nOr              ) := "Or";
    MAX_NODE_TYPE    := 25; TEXT_MAX := 4095; textNext := 0;
    stList := idList := null;

    % parse the output from the syntax analyser and intetrpret parse tree %
    eval( readNode )
end.


IT("Generation 0    ") IN
IT(".O.") IN
IT(".O.") IN
IT(".O.")

#9  = 2		  // number of generations to calculate
#10 = Cur_Line
#11 = Cur_Col-1
for (#2 = 1; #2 <= #9; #2++) {
    Update()
    Get_Key("Next gen...", STATLINE)
    Call("calculate")
    itoa(#2, 20, LEFT)
    GL(1) GC(12) Reg_Ins(20, OVERWRITE)
}
EOF
Return

// Calculate one generation
:calculate:
Goto_Line(2)
While (At_EOF == 0) {
  Search("|A",ERRBREAK)		// find next living cell
  #3 = Cur_Line
  #4 = #7 = #8 = Cur_Col
  if (#4 > 1) {			// increment cell at left
      #7 = #4-1
      Goto_Col(#7)
      Ins_Char(Cur_Char+1,OVERWRITE)
  }
  if (#4 < #11) {		// increment cell at right
      #8 = #4+1
      Goto_Col(#8)
      Ins_Char(Cur_Char+1,OVERWRITE)
  }
  if (#3 > 2) {			// increment 3 cells above
      Goto_Line(#3-1)
      Call("inc_3")
  }
  if (#3 < #10) {		// increment 3 cells below
      Goto_Line(#3+1)
      Call("inc_3")
  }
  Goto_Line(#3)
  Goto_Col(#4+1)
}

Replace("[1QR]", "O", REGEXP+BEGIN+ALL)	    // these cells alive
Replace("[/-7P-X]", ".", REGEXP+BEGIN+ALL)  // these cells dead
Return

// increment values of 3 characters in a row
:inc_3:
for (#1 = #7; #1 <= #8; #1++) {
  Goto_Col(#1)
  Ins_Char(Cur_Char+1,OVERWRITE)
}
Return


If condition1 Then
     statement
End If

If condition1 Then
    statement
ElseIf condition2 Then
    statement
...
ElseIf conditionN Then
    statement
Else
    statement
End If


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

#define da_dim(name, type)  type *name = NULL;          \
                            int _qy_ ## name ## _p = 0;  \
                            int _qy_ ## name ## _max = 0
#define da_rewind(name)     _qy_ ## name ## _p = 0
#define da_redim(name)      do {if (_qy_ ## name ## _p >= _qy_ ## name ## _max) \
                                name = realloc(name, (_qy_ ## name ## _max += 32) * sizeof(name[0]));} while (0)
#define da_append(name, x)  do {da_redim(name); name[_qy_ ## name ## _p++] = x;} while (0)
#define da_len(name)        _qy_ ## name ## _p
#define da_add(name)        do {da_redim(name); _qy_ ## name ## _p++;} while (0)

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

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

// dependency: Ordered by NodeType, must remain in same order as NodeType enum

struct {
    char       *enum_text;
    NodeType   node_type;
} atr[] = {
    {"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,     },
};

FILE *source_fp;
da_dim(string_pool, const char *);
da_dim(global_names, const char *);
da_dim(global_values, int);

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

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

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

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

int interp(Tree *x) {           /* interpret the parse tree */
    if (!x) return 0;
    switch(x->node_type) {
        case nd_Integer:  return x->value;
        case nd_Ident:    return global_values[x->value];
        case nd_String:   return x->value;

        case nd_Assign:   return global_values[x->left->value] = interp(x->right);
        case nd_Add:      return interp(x->left) +  interp(x->right);
        case nd_Sub:      return interp(x->left) -  interp(x->right);
        case nd_Mul:      return interp(x->left) *  interp(x->right);
        case nd_Div:      return interp(x->left) /  interp(x->right);
        case nd_Mod:      return interp(x->left) %  interp(x->right);
        case nd_Lss:      return interp(x->left) <  interp(x->right);
        case nd_Gtr:      return interp(x->left) >  interp(x->right);
        case nd_Leq:      return interp(x->left) <= interp(x->right);
        case nd_Eql:      return interp(x->left) == interp(x->right);
        case nd_Neq:      return interp(x->left) != interp(x->right);
        case nd_And:      return interp(x->left) && interp(x->right);
        case nd_Or:       return interp(x->left) || interp(x->right);
        case nd_Negate:   return -interp(x->left);
        case nd_Not:      return !interp(x->left);

        case nd_If:       if (interp(x->left))
                            interp(x->right->left);
                          else
                            interp(x->right->right);
                          return 0;

        case nd_While:    while (interp(x->left))
                            interp(x->right);
                          return 0;

        case nd_Prtc:     printf("%c", interp(x->left));
                          return 0;
        case nd_Prti:     printf("%d", interp(x->left));
                          return 0;
        case nd_Prts:     printf("%s", string_pool[interp(x->left)]);
                          return 0;

        case nd_Sequence: interp(x->left);
                          interp(x->right);
                          return 0;

        default:          error("interp: unknown tree type %d\n", x->node_type);
    }
    return 0;
}

void init_in(const char fn[]) {
    if (fn[0] == '\0')
        source_fp = stdin;
    else {
        source_fp = fopen(fn, "r");
        if (source_fp == NULL)
            error("Can't open %s\n", fn);
    }
}

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

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

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

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

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

int fetch_string_offset(char *st) {
    int len = strlen(st);
    st[len - 1] = '\0';
    ++st;
    char *p, *q;
    p = q = st;

    while ((*p++ = *q++) != '\0') {
        if (q[-1] == '\\') {
            if (q[0] == 'n') {
                p[-1] = '\n';
                ++q;
            } else if (q[0] == '\\') {
                ++q;
            }
        }
    }

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

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

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

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

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

    // if there is extra data, get it
    char *p = tok + strlen(tok);
    if (p != &yytext[len]) {
        int n;
        for (++p; isspace(*p); ++p)
            ;
        switch (node_type) {
            case nd_Ident:      n = fetch_var_offset(p);    break;
            case nd_Integer:    n = strtol(p, NULL, 0);     break;
            case nd_String:     n = fetch_string_offset(p); break;
            default:            error("Unknown node type: %s\n", p);
        }
        return make_leaf(node_type, n);
    }

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

int main(int argc, char *argv[]) {
    init_in(argc > 1 ? argv[1] : "");

    Tree *x = load_ast();
    interp(x);

    return 0;
}


if( expr_booleana ) command1;
else                command2;


If condition Then
     statement
End If

If condition Then
    statement
Else
    statement
End If

If condition1 Then
    statement
ElseIf condition2 Then
    statement
...
ElseIf conditionN Then
    statement
Else
    statement
End If


        >>SOURCE FORMAT IS FREE
identification division.
*> this code is dedicated to the public domain
*> (GnuCOBOL) 2.3-dev.0
program-id. astinterpreter.
environment division.
configuration section.
repository. function all intrinsic.
data division.
working-storage section.
01  program-name pic x(32) value spaces global.
01  input-name pic x(32) value spaces global.
01  input-status pic xx global.

01  ast-record global.
    03  ast-type pic x(14).
    03  ast-value pic x(48).
    03  filler redefines ast-value.
        05  asl-left pic 999.
        05  asl-right pic 999.

01  error-record pic x(64) value spaces global.

01  loadstack global.
    03  l pic 99 value 0.
    03  l-lim pic 99 value 64.
    03  load-entry occurs 64.
        05  l-node pic x(14).
        05  l-left pic 999.
        05  l-right pic 999.
        05  l-link pic 999.

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

01  interpreterstack global.
    03  stack1 pic 99 value 2.
    03  stack2 pic 99 value 1.
    03  stack-lim pic 99 value 32.
    03  stack-entry occurs 32.
         05  stack-source pic 99.
         05  stack usage binary-int.

01  variables global.
    03  v pic 99.
    03  v-max pic 99 value 0.
    03  v-lim pic 99 value 16.
    03  filler occurs 16.
        05  variable-value binary-int.
        05  variable-name pic x(48).

01  strings global.
    03  s pic 99.
    03  s-max pic 99 value 0.
    03  s-lim pic 99 value 16.
    03  filler occurs 16 value spaces.
        05  string-value pic x(48).

01  string-fields global.
    03  string-length pic 99.
    03  string1 pic 99.
    03  length1 pic 99.
    03  count1 pic 99.

01  display-fields global.
    03  display-number pic -(9)9.
    03  display-pending pic x value 'n'.
    03  character-value.
        05  character-number usage binary-char.

procedure division chaining program-name.
start-astinterpreter.
    call 'loadast'
    if program-name <> spaces
        call 'readinput' *> close the input-file
    end-if
    >>d perform print-ast
    call 'runast' using t
    if display-pending = 'y'
        display space
    end-if
    stop run
    .
print-ast.
    call 'printast' using t
    display 'ast:' upon syserr
    display 't=' t
    perform varying t1 from 1 by 1 until t1 > t
        if leaf-type(t1) = 'Identifier' or 'Integer' or 'String'
            display t1 space trim(leaf-type(t1)) space trim(leaf-value(t1)) upon syserr
        else
            display t1 space node-left(t1) space node-right(t1) space trim(node-type(t1))
                upon syserr
        end-if
    end-perform
    .

identification division.
program-id. runast common recursive.
data division.
working-storage section.
01  word-length constant as length of binary-int.
linkage section.
01  n pic 999.
procedure division using n.
start-runast.
    if n = 0
        exit program
    end-if
    evaluate node-type(n)
    when 'Integer'
        perform push-stack
        move numval(leaf-value(n)) to stack(stack1)
    when 'Identifier'
        perform get-variable-index
        perform push-stack
        move v to stack-source(stack1)
        move variable-value(v) to stack(stack1)
    when 'String'
        perform get-string-index
        perform push-stack
        move s to stack-source(stack1)
    when 'Assign'
        call 'runast' using node-left(n)
        call 'runast' using node-right(n)
        move stack-source(stack2) to v
        move stack(stack1) to variable-value(v)
        perform pop-stack
        perform pop-stack
    when 'If'
        call 'runast' using node-left(n)
        move node-right(n) to n1
        if stack(stack1) <> 0
            call 'runast' using node-left(n1)
        else
            call 'runast' using node-right(n1)
        end-if
        perform pop-stack
    when 'While'
        call 'runast' using node-left(n)
        perform until stack(stack1) = 0
            perform pop-stack
            call 'runast' using node-right(n)
            call 'runast' using node-left(n)
        end-perform
        perform pop-stack
    when 'Add'
        perform get-values
        add stack(stack1) to stack(stack2)
        perform pop-stack
    when 'Subtract'
        perform get-values
        subtract stack(stack1) from stack(stack2)
        perform pop-stack
    when 'Multiply'
        perform get-values
        multiply stack(stack1) by stack(stack2)
        perform pop-stack
    when 'Divide'
        perform get-values
        divide stack(stack1) into stack(stack2)
        perform pop-stack
    when 'Mod'
        perform get-values
        move mod(stack(stack2),stack(stack1)) to stack(stack2)
        perform pop-stack
    when 'Less'
        perform get-values
        if stack(stack2) < stack(stack1)
            move 1 to stack(stack2)
        else
            move 0 to stack(stack2)
        end-if
        perform pop-stack
    when 'Greater'
        perform get-values
        if stack(stack2) > stack(stack1)
            move 1 to stack(stack2)
        else
            move 0 to stack(stack2)
        end-if
        perform pop-stack
    when 'LessEqual'
        perform get-values
        if stack(stack2) <= stack(stack1)
            move 1 to stack(stack2)
        else
            move 0 to stack(stack2)
        end-if
        perform pop-stack
    when 'GreaterEqual'
        perform get-values
        if stack(stack2) >= stack(stack1)
            move 1 to stack(stack2)
        else
            move 0 to stack(stack2)
        end-if
        perform pop-stack
    when 'Equal'
        perform get-values
        if stack(stack2) = stack(stack1)
            move 1 to stack(stack2)
        else
            move 0 to stack(stack2)
        end-if
        perform pop-stack
    when 'NotEqual'
        perform get-values
        if stack(stack2) <> stack(stack1)
            move 1 to stack(stack2)
        else
            move 0 to stack(stack2)
        end-if
        perform pop-stack
    when 'And'
        perform get-values
        call "CBL_AND" using stack(stack1) stack(stack2) by value word-length
        perform pop-stack
    when 'Or'
        perform get-values
        call "CBL_OR" using stack(stack1) stack(stack2) by value word-length
        perform pop-stack
    when 'Not'
        call 'runast' using node-left(n)
        if stack(stack1) = 0
            move 1 to stack(stack1)
        else
            move 0 to stack(stack1)
        end-if
    when 'Negate'
        call 'runast' using node-left(n)
        compute stack(stack1) = - stack(stack1)
    when 'Prtc'
        call 'runast' using node-left(n)
        move stack(stack1) to character-number
        display character-value with no advancing
        move 'y' to display-pending
        perform pop-stack
    when 'Prti'
        call 'runast' using node-left(n)
        move stack(stack1) to display-number
        display trim(display-number) with no advancing
        move 'y' to display-pending
        perform pop-stack
    when 'Prts'
        call 'runast' using node-left(n)
        move stack-source(stack1) to s
        move length(trim(string-value(s))) to string-length
        move 2 to string1
        compute length1 = string-length - 2
        perform until string1 >= string-length
            move 0 to count1
            inspect string-value(s)(string1:length1)
                tallying count1 for characters before initial '\'   *> ' (workaround Rosetta Code highlighter problem)
            evaluate true
            when string-value(s)(string1 + count1 + 1:1) = 'n' *> \n
                display string-value(s)(string1:count1)
                move 'n' to display-pending
                compute string1 = string1 + 2 + count1
                compute length1 = length1 - 2 - count1
            when string-value(s)(string1 + count1 + 1:1) = '\' *> \\ '
                display string-value(s)(string1:count1 + 1) with no advancing
                move 'y' to display-pending
                compute string1 = string1 + 2 + count1
                compute length1 = length1 - 2 - count1
            when other
                display string-value(s)(string1:count1) with no advancing
                move 'y' to display-pending
                add count1 to string1
                subtract count1 from length1
            end-evaluate
        end-perform
        perform pop-stack
    when 'Sequence'
        call 'runast' using node-left(n)
        call 'runast' using node-right(n)
    when other
        string 'in astinterpreter unknown node type ' node-type(n) into error-record
        call 'reporterror'
    end-evaluate
    exit program
    .
push-stack.
    if stack1 >= s-lim
        string 'in astinterpreter at ' n ' stack overflow' into error-record
        call 'reporterror'
    end-if
    add 1 to stack1 stack2
    initialize stack-entry(stack1)
    .
pop-stack.
    if stack1 < 2
        string 'in astinterpreter at ' n ' stack underflow ' into error-record
        call 'reporterror'
    end-if
    subtract 1 from stack1 stack2
    .
get-variable-index.
    perform varying v from 1 by 1 until v > v-max
    or variable-name(v) = leaf-value(n)
        continue
    end-perform
    if v > v-max
        if v-max = v-lim
            string 'in astinterpreter number of variables exceeds ' v-lim into error-record
            call 'reporterror'
        end-if
        move v to v-max
        move leaf-value(n) to variable-name(v)
        move 0 to variable-value(v)
    end-if
    .
get-string-index.
    perform varying s from 1 by 1 until s > s-max
    or string-value(s) = leaf-value(n)
        continue
    end-perform
    if s > s-max
        if s-max = s-lim
            string 'in astinterpreter number of strings exceeds ' s-lim into error-record
            call 'reporterror'
        end-if
        move s to s-max
        move leaf-value(n) to string-value(s)
    end-if
    .
get-values.
    call 'runast' using node-left(n)
    call 'runast' using node-right(n)
    .
end program runast.

identification division.
program-id. loadast common recursive.
procedure division.
start-loadast.
    if l >= l-lim
        string 'in astinterpreter loadast l exceeds ' l-lim into error-record
        call 'reporterror'
    end-if
    add 1 to l
    call 'readinput'
    evaluate true
    when ast-record = ';'
    when input-status = '10'
        move 0 to return-code
    when ast-type = 'Identifier'
    when ast-type = 'Integer'
    when ast-type = 'String'
        call 'makeleaf' using ast-type ast-value
        move t to return-code
    when ast-type = 'Sequence'
        move ast-type to l-node(l)
        call 'loadast'
        move return-code to l-left(l)
        call 'loadast'
        move t to l-right(l)
        call 'makenode' using l-node(l) l-left(l) l-right(l)
        move t to return-code
    when other
        move ast-type to l-node(l)
        call 'loadast'
        move return-code to l-left(l)
        call 'loadast'
        move return-code to l-right(l)
        call 'makenode' using l-node(l) l-left(l) l-right(l)
        move t to return-code
    end-evaluate
    subtract 1 from l
    .
end program loadast.

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

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

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

identification division.
program-id. readinput common.
environment division.
input-output section.
file-control.
    select input-file assign using input-name
        status is input-status
        organization is line sequential.
data division.
file section.
fd  input-file.
01  input-record pic x(64).
procedure division.
start-readinput.
    if program-name = spaces
        move '00' to input-status
        accept ast-record on exception move '10' to input-status end-accept
        exit program
    end-if
    if input-name = spaces
        string program-name delimited by space '.ast' into input-name
        open input input-file
        if input-status = '35'
            string 'in astinterpreter ' trim(input-name) ' not found' into error-record
            call 'reporterror'
        end-if
    end-if
    read input-file into ast-record
    evaluate input-status
    when '00'
        continue
    when '10'
        close input-file
    when other
        string 'in astinterpreter ' trim(input-name) ' unexpected input-status: ' input-status
            into error-record
        call 'reporterror'
    end-evaluate
    .
end program readinput.

program-id. reporterror common.
procedure division.
start-reporterror.
report-error.
    display error-record upon syserr
    stop run with error status -1
    .
end program reporterror.
end program astinterpreter.


option explicit
const tlcr=3, tlcc=3
const maxdim=15

dim a(15,15)
dim b(15,15)
dim ans0:ans0=chr(27)&"["
dim gen,n

erase a
'glider
a(0,1)=true:a(1,2)=true:a(2,0)=true:a(2,1)=true:a(2,2)=true
'blinker
a(3,13)=true:a(4,13)=true:a(5,13)=true
'beacon
a(11,1)=true:a(11,2)=true: a(12,1)=true:a(12,2)=true
a(13,3)=true:a(13,4)=true: a(14,3)=true:a(14,4)=true

gen=0
doframe

do
  display
  wscript.sleep(100)
  n=newgen
loop until n=0
display

sub cls()  wscript.StdOut.Write ans0 &"2J"&ans0 &"?25l":end sub 'hide cursor too
sub toxy(r,c,s)  wscript.StdOut.Write ans0 & r & ";" & c & "f"  & s :end sub
function iif(a,b,c) if a then iif=b else iif=c end if :end function

sub doframe
  dim r,c,s
	const frame="@"
	cls
	toxy 1,tlcc-1, "Conway's Game of Life"
	toxy tlcr-1,tlcc-1,string(maxdim+3,frame)
	s=frame&space(maxdim+1)&frame
	for r=0 to maxdim
		toxy tlcr+r,tlcc-1,s
	next
	toxy tlcr+maxdim+1,tlcc-1,string(maxdim+3,frame)
end sub

sub display
dim r,c
const pix="#"
for r=0 to maxdim
   for c=0 to maxdim
	   toxy tlcr+r,tlcc+c,iif (a(r,c),pix," ")
	 next
next
toxy tlcr+maxdim+2,tlcc-1,gen & " " & n
toxy tlcr+maxdim+3,tlcc-1,""
gen=gen+1
end sub

function newgen
  dim r,c,cnt,cp,cm,rp,rm
	for r=0 to maxdim
	  for c=0 to maxdim
			cp=(c+1) and maxdim    'wrap around
			cm=(c-1) and maxdim
			rp=(r+1) and maxdim
			rm=(r-1) and maxdim
			cnt=0
			cnt=- a(rp,cp) - a(rp,c) - a(rp,cm)  'true =-1
			cnt=cnt- a(r,cp)-	 a(r,cm)
			cnt=cnt- a(rm,cp)- a(rm,c) - a(rm,cm)

			if a(r,c) then
				b(r,c)=iif (cnt=2 or cnt=3,true,false)
			else
				b(r,c)=iif (cnt=3,true,false)
			end if
	  next
	next
	for r=0 to maxdim
	  for c=0 to maxdim
		  a(r,c)=b(r,c)
		  newgen=newgen- b(r,c)
	  next
	next
end function


Dim result As String, a As String = "pants", b As String = "glasses"

If a = b Then
  result = "passed"
Else
  result = "failed"
End If


if boolean_expression {
    statements
}


CREATE BUF 0 ,              \ single-character look-ahead buffer
: PEEK   BUF @ 0= IF KEY BUF ! THEN BUF @ ;
: GETC   PEEK  0 BUF ! ;
: SPACE?   DUP BL = SWAP  9 14 WITHIN  OR ;
: >SPACE   BEGIN PEEK SPACE? WHILE GETC DROP REPEAT ;
: DIGIT?   48 58 WITHIN ;
: GETINT   >SPACE  0
   BEGIN  PEEK DIGIT?
   WHILE  GETC [CHAR] 0 -  SWAP 10 * +  REPEAT ;
: GETNAM   >SPACE PAD 1+
   BEGIN PEEK SPACE? INVERT
   WHILE GETC OVER C! CHAR+
   REPEAT  PAD TUCK - 1-  PAD C! ;
: GETSTR ( -- c-addr u)
   HERE >R 0  >SPACE GETC DROP  \ skip leading "
   BEGIN GETC DUP [CHAR] " <> WHILE C, 1+ REPEAT
   DROP R> SWAP ;
: \TYPE   BEGIN DUP 0> WHILE
   OVER [email protected] [CHAR] \ = IF
     1- >R CHAR+ R>
     OVER [email protected] [CHAR] n = IF CR ELSE
     OVER [email protected] [CHAR] \ = IF [CHAR] \ EMIT THEN THEN
   ELSE OVER [email protected] EMIT THEN  1- >R CHAR+ R> REPEAT
   DROP DROP ;
: .   S>D SWAP OVER DABS <# #S ROT SIGN #> TYPE ;

: CONS ( v l -- l)  HERE >R SWAP , , R> ;
: HEAD ( l -- v)  @ ;
: TAIL ( l -- l)  CELL+ @ ;
CREATE GLOBALS 0 ,
: DECLARE ( c-addr -- a-addr)  HERE TUCK
   OVER [email protected] CHAR+  DUP ALLOT CMOVE  HERE SWAP 0 ,
   GLOBALS @ CONS  GLOBALS ! ;
: LOOKUP ( c-addr -- a-addr)  DUP COUNT  GLOBALS @ >R
   BEGIN [email protected] 0<>
   WHILE [email protected] HEAD COUNT  2OVER COMPARE 0=
     IF 2DROP DROP  R> HEAD DUP [email protected] CHAR+ + EXIT
     THEN  R> TAIL >R
   REPEAT
   2DROP RDROP  DECLARE ;

DEFER GETAST
: >Identifier   GETNAM LOOKUP  0 ;
: >Integer   GETINT  0 ;
: >String   GETSTR ;
: >;   0 0 ;
: NODE ( xt left right -- addr)  HERE >R , , , R> ;
CREATE BUF' 12 ALLOT
: PREPEND ( c-addr c -- c-addr)  BUF' 1+ C!
   COUNT DUP 1+ BUF' C!  BUF' 2 + SWAP CMOVE  BUF' ;
: HANDLER ( c-addr -- xt)  [CHAR] $ PREPEND  FIND
   0= IF ." No handler for AST node '" COUNT TYPE ." '" THEN ;
: READER ( c-addr -- xt t | f)
   [CHAR] > PREPEND  FIND  DUP 0= IF NIP THEN ;
: READ ( c-addr -- left right)  READER
   IF EXECUTE ELSE GETAST GETAST THEN ;
: (GETAST)   GETNAM  DUP HANDLER SWAP  READ  NODE ;
' (GETAST) IS GETAST

: INTERP   DUP [email protected]  ROT [ 2 CELLS ]L + @ EXECUTE ;
: $;   DROP DROP ;
: $Identifier ( l r -- a-addr)  DROP @ ;
: $Integer ( l r -- n)  DROP ;
: $String ( l r -- c-addr u)  ( noop) ;
: $Prtc ( l r --)  DROP INTERP EMIT ;
: $Prti ( l r --)  DROP INTERP . ;
: $Prts ( l r --)  DROP INTERP \TYPE ;
: $Not ( l r --)  DROP INTERP 0= ;
: $Negate ( l r --) DROP INTERP NEGATE ;
: $Sequence ( l r --) SWAP INTERP INTERP ;
: $Assign ( l r --)  SWAP CELL+ @ >R  INTERP  R> ! ;
: $While ( l r --)
   >R BEGIN DUP INTERP WHILE [email protected] INTERP REPEAT  RDROP DROP ;
: $If ( l r --)  SWAP INTERP 0<> IF CELL+ THEN @ INTERP ;
: $Subtract ( l r -- n) >R INTERP R> INTERP - ;
: $Add   >R INTERP R> INTERP + ;
: $Mod   >R INTERP R> INTERP MOD ;
: $Multiply   >R INTERP R> INTERP * ;
: $Divide   >R INTERP S>D R> INTERP SM/REM SWAP DROP ;
: $Less   >R INTERP R> INTERP < ;
: $LessEqual   >R INTERP R> INTERP <= ;
: $Greater   >R INTERP R> INTERP > ;
: $GreaterEqual   >R INTERP R> INTERP >= ;
: $Equal   >R INTERP R> INTERP = ;
: $NotEqual   >R INTERP R> INTERP <> ;
: $And   >R INTERP IF R> INTERP 0<> ELSE RDROP 0 THEN ;
: $Or   >R INTERP IF RDROP -1 ELSE R> INTERP 0<> THEN ;

GETAST INTERP


!!!
!!! An implementation of the Rosetta Code interpreter task:
!!! https://rosettacode.org/wiki/Compiler/AST_interpreter
!!!
!!! The implementation is based on the published pseudocode.
!!!

module compiler_type_kinds
  use, intrinsic :: iso_fortran_env, only: int32
  use, intrinsic :: iso_fortran_env, only: int64

  implicit none
  private

  ! Synonyms.
  integer, parameter, public :: size_kind = int64
  integer, parameter, public :: length_kind = size_kind
  integer, parameter, public :: nk = size_kind

  ! Synonyms for character capable of storing a Unicode code point.
  integer, parameter, public :: unicode_char_kind = selected_char_kind ('ISO_10646')
  integer, parameter, public :: ck = unicode_char_kind

  ! Synonyms for integers capable of storing a Unicode code point.
  integer, parameter, public :: unicode_ichar_kind = int32
  integer, parameter, public :: ick = unicode_ichar_kind

  ! Synonyms for integers in the runtime code.
  integer, parameter, public :: runtime_int_kind = int64
  integer, parameter, public :: rik = runtime_int_kind
end module compiler_type_kinds

module helper_procedures
  use, non_intrinsic :: compiler_type_kinds, only: nk, ck

  implicit none
  private

  public :: new_storage_size
  public :: next_power_of_two
  public :: isspace

  character(1, kind = ck), parameter :: horizontal_tab_char = char (9, kind = ck)
  character(1, kind = ck), parameter :: linefeed_char = char (10, kind = ck)
  character(1, kind = ck), parameter :: vertical_tab_char = char (11, kind = ck)
  character(1, kind = ck), parameter :: formfeed_char = char (12, kind = ck)
  character(1, kind = ck), parameter :: carriage_return_char = char (13, kind = ck)
  character(1, kind = ck), parameter :: space_char = ck_' '

contains

  elemental function new_storage_size (length_needed) result (size)
    integer(kind = nk), intent(in) :: length_needed
    integer(kind = nk) :: size

    ! Increase storage by orders of magnitude.

    if (2_nk**32 < length_needed) then
       size = huge (1_nk)
    else
       size = next_power_of_two (length_needed)
    end if
  end function new_storage_size

  elemental function next_power_of_two (x) result (y)
    integer(kind = nk), intent(in) :: x
    integer(kind = nk) :: y

    !
    ! It is assumed that no more than 64 bits are used.
    !
    ! The branch-free algorithm is that of
    ! https://archive.is/nKxAc#RoundUpPowerOf2
    !
    ! Fill in bits until one less than the desired power of two is
    ! reached, and then add one.
    !

    y = x - 1
    y = ior (y, ishft (y, -1))
    y = ior (y, ishft (y, -2))
    y = ior (y, ishft (y, -4))
    y = ior (y, ishft (y, -8))
    y = ior (y, ishft (y, -16))
    y = ior (y, ishft (y, -32))
    y = y + 1
  end function next_power_of_two

  elemental function isspace (ch) result (bool)
    character(1, kind = ck), intent(in) :: ch
    logical :: bool

    bool = (ch == horizontal_tab_char) .or.  &
         & (ch == linefeed_char) .or.        &
         & (ch == vertical_tab_char) .or.    &
         & (ch == formfeed_char) .or.        &
         & (ch == carriage_return_char) .or. &
         & (ch == space_char)
  end function isspace

end module helper_procedures

module string_buffers
  use, intrinsic :: iso_fortran_env, only: error_unit
  use, intrinsic :: iso_fortran_env, only: int64
  use, non_intrinsic :: compiler_type_kinds, only: nk, ck, ick
  use, non_intrinsic :: helper_procedures

  implicit none
  private

  public :: strbuf_t
  public :: skip_whitespace
  public :: skip_non_whitespace
  public :: skip_whitespace_backwards
  public :: at_end_of_line

  type :: strbuf_t
     integer(kind = nk), private :: len = 0
     !
     ! ‘chars’ is made public for efficient access to the individual
     ! characters.
     !
     character(1, kind = ck), allocatable, public :: chars(:)
   contains
     procedure, pass, private :: ensure_storage => strbuf_t_ensure_storage
     procedure, pass :: to_unicode_full_string => strbuf_t_to_unicode_full_string
     procedure, pass :: to_unicode_substring => strbuf_t_to_unicode_substring
     procedure, pass :: length => strbuf_t_length
     procedure, pass :: set => strbuf_t_set
     procedure, pass :: append => strbuf_t_append
     generic :: to_unicode => to_unicode_full_string
     generic :: to_unicode => to_unicode_substring
     generic :: assignment(=) => set
  end type strbuf_t

contains

  function strbuf_t_to_unicode_full_string (strbuf) result (s)
    class(strbuf_t), intent(in) :: strbuf
    character(:, kind = ck), allocatable :: s

    !
    ! This does not actually ensure that the string is valid Unicode;
    ! any 31-bit ‘character’ is supported.
    !

    integer(kind = nk) :: i

    allocate (character(len = strbuf%len, kind = ck) :: s)
    do i = 1, strbuf%len
       s(i:i) = strbuf%chars(i)
    end do
  end function strbuf_t_to_unicode_full_string

  function strbuf_t_to_unicode_substring (strbuf, i, j) result (s)
    !
    ! ‘Extreme’ values of i and j are allowed, as shortcuts for ‘from
    ! the beginning’, ‘up to the end’, or ‘empty substring’.
    !
    class(strbuf_t), intent(in) :: strbuf
    integer(kind = nk), intent(in) :: i, j
    character(:, kind = ck), allocatable :: s

    !
    ! This does not actually ensure that the string is valid Unicode;
    ! any 31-bit ‘character’ is supported.
    !

    integer(kind = nk) :: i1, j1
    integer(kind = nk) :: n
    integer(kind = nk) :: k

    i1 = max (1_nk, i)
    j1 = min (strbuf%len, j)
    n = max (0_nk, (j1 - i1) + 1_nk)

    allocate (character(n, kind = ck) :: s)
    do k = 1, n
       s(k:k) = strbuf%chars(i1 + (k - 1_nk))
    end do
  end function strbuf_t_to_unicode_substring

  elemental function strbuf_t_length (strbuf) result (n)
    class(strbuf_t), intent(in) :: strbuf
    integer(kind = nk) :: n

    n = strbuf%len
  end function strbuf_t_length

  subroutine strbuf_t_ensure_storage (strbuf, length_needed)
    class(strbuf_t), intent(inout) :: strbuf
    integer(kind = nk), intent(in) :: length_needed

    integer(kind = nk) :: len_needed
    integer(kind = nk) :: new_size
    type(strbuf_t) :: new_strbuf

    len_needed = max (length_needed, 1_nk)

    if (.not. allocated (strbuf%chars)) then
       ! Initialize a new strbuf%chars array.
       new_size = new_storage_size (len_needed)
       allocate (strbuf%chars(1:new_size))
    else if (ubound (strbuf%chars, 1) < len_needed) then
       ! Allocate a new strbuf%chars array, larger than the current
       ! one, but containing the same characters.
       new_size = new_storage_size (len_needed)
       allocate (new_strbuf%chars(1:new_size))
       new_strbuf%chars(1:strbuf%len) = strbuf%chars(1:strbuf%len)
       call move_alloc (new_strbuf%chars, strbuf%chars)
    end if
  end subroutine strbuf_t_ensure_storage

  subroutine strbuf_t_set (dst, src)
    class(strbuf_t), intent(inout) :: dst
    class(*), intent(in) :: src

    integer(kind = nk) :: n
    integer(kind = nk) :: i

    select type (src)
    type is (character(*, kind = ck))
       n = len (src, kind = nk)
       call dst%ensure_storage(n)
       do i = 1, n
          dst%chars(i) = src(i:i)
       end do
       dst%len = n
    type is (character(*))
       n = len (src, kind = nk)
       call dst%ensure_storage(n)
       do i = 1, n
          dst%chars(i) = src(i:i)
       end do
       dst%len = n
    class is (strbuf_t)
       n = src%len
       call dst%ensure_storage(n)
       dst%chars(1:n) = src%chars(1:n)
       dst%len = n
    class default
       error stop
    end select
  end subroutine strbuf_t_set

  subroutine strbuf_t_append (dst, src)
    class(strbuf_t), intent(inout) :: dst
    class(*), intent(in) :: src

    integer(kind = nk) :: n_dst, n_src, n
    integer(kind = nk) :: i

    select type (src)
    type is (character(*, kind = ck))
       n_dst = dst%len
       n_src = len (src, kind = nk)
       n = n_dst + n_src
       call dst%ensure_storage(n)
       do i = 1, n_src
          dst%chars(n_dst + i) = src(i:i)
       end do
       dst%len = n
    type is (character(*))
       n_dst = dst%len
       n_src = len (src, kind = nk)
       n = n_dst + n_src
       call dst%ensure_storage(n)
       do i = 1, n_src
          dst%chars(n_dst + i) = src(i:i)
       end do
       dst%len = n
    class is (strbuf_t)
       n_dst = dst%len
       n_src = src%len
       n = n_dst + n_src
       call dst%ensure_storage(n)
       dst%chars((n_dst + 1):n) = src%chars(1:n_src)
       dst%len = n
    class default
       error stop
    end select
  end subroutine strbuf_t_append

  function skip_whitespace (strbuf, i) result (j)
    class(strbuf_t), intent(in) :: strbuf
    integer(kind = nk), intent(in) :: i
    integer(kind = nk) :: j

    logical :: done

    j = i
    done = .false.
    do while (.not. done)
       if (at_end_of_line (strbuf, j)) then
          done = .true.
       else if (.not. isspace (strbuf%chars(j))) then
          done = .true.
       else
          j = j + 1
       end if
    end do
  end function skip_whitespace

  function skip_non_whitespace (strbuf, i) result (j)
    class(strbuf_t), intent(in) :: strbuf
    integer(kind = nk), intent(in) :: i
    integer(kind = nk) :: j

    logical :: done

    j = i
    done = .false.
    do while (.not. done)
       if (at_end_of_line (strbuf, j)) then
          done = .true.
       else if (isspace (strbuf%chars(j))) then
          done = .true.
       else
          j = j + 1
       end if
    end do
  end function skip_non_whitespace

  function skip_whitespace_backwards (strbuf, i) result (j)
    class(strbuf_t), intent(in) :: strbuf
    integer(kind = nk), intent(in) :: i
    integer(kind = nk) :: j

    logical :: done

    j = i
    done = .false.
    do while (.not. done)
       if (j == -1) then
          done = .true.
       else if (.not. isspace (strbuf%chars(j))) then
          done = .true.
       else
          j = j - 1
       end if
    end do
  end function skip_whitespace_backwards

  function at_end_of_line (strbuf, i) result (bool)
    class(strbuf_t), intent(in) :: strbuf
    integer(kind = nk), intent(in) :: i
    logical :: bool

    bool = (strbuf%length() < i)
  end function at_end_of_line

end module string_buffers

module reading_one_line_from_a_stream
  use, intrinsic :: iso_fortran_env, only: input_unit
  use, intrinsic :: iso_fortran_env, only: error_unit
  use, non_intrinsic :: compiler_type_kinds, only: nk, ck, ick
  use, non_intrinsic :: string_buffers

  implicit none
  private

  ! get_line_from_stream: read an entire input line from a stream into
  ! a strbuf_t.
  public :: get_line_from_stream

  character(1, kind = ck), parameter :: linefeed_char = char (10, kind = ck)

  ! The following is correct for Unix and its relatives.
  character(1, kind = ck), parameter :: newline_char = linefeed_char

contains

  subroutine get_line_from_stream (unit_no, eof, no_newline, strbuf)
    integer, intent(in) :: unit_no
    logical, intent(out) :: eof ! End of file?
    logical, intent(out) :: no_newline ! There is a line but it has no
                                       ! newline? (Thus eof also must
                                       ! be .true.)
    class(strbuf_t), intent(inout) :: strbuf

    character(1, kind = ck) :: ch

    strbuf = ''
    call get_ch (unit_no, eof, ch)
    do while (.not. eof .and. ch /= newline_char)
       call strbuf%append (ch)
       call get_ch (unit_no, eof, ch)
    end do
    no_newline = eof .and. (strbuf%length() /= 0)
  end subroutine get_line_from_stream

  subroutine get_ch (unit_no, eof, ch)
    !
    ! Read a single code point from the stream.
    !
    ! Currently this procedure simply inputs ‘ASCII’ bytes rather than
    ! Unicode code points.
    !
    integer, intent(in) :: unit_no
    logical, intent(out) :: eof
    character(1, kind = ck), intent(out) :: ch

    integer :: stat
    character(1) :: c = '*'

    eof = .false.

    if (unit_no == input_unit) then
       call get_input_unit_char (c, stat)
    else
       read (unit = unit_no, iostat = stat) c
    end if

    if (stat < 0) then
       ch = ck_'*'
       eof = .true.
    else if (0 < stat) then
       write (error_unit, '("Input error with status code ", I0)') stat
       stop 1
    else
       ch = char (ichar (c, kind = ick), kind = ck)
    end if
  end subroutine get_ch

!!!
!!! If you tell gfortran you want -std=f2008 or -std=f2018, you likely
!!! will need to add also -fall-intrinsics or -U__GFORTRAN__
!!!
!!! The first way, you get the FGETC intrinsic. The latter way, you
!!! get the C interface code that uses getchar(3).
!!!
#ifdef __GFORTRAN__

  subroutine get_input_unit_char (c, stat)
    !
    ! The following works if you are using gfortran.
    !
    ! (FGETC is considered a feature for backwards compatibility with
    ! g77. However, I know of no way to reconfigure input_unit as a
    ! Fortran 2003 stream, for use with ordinary ‘read’.)
    !
    character, intent(inout) :: c
    integer, intent(out) :: stat

    call fgetc (input_unit, c, stat)
  end subroutine get_input_unit_char

#else

  subroutine get_input_unit_char (c, stat)
    !
    ! An alternative implementation of get_input_unit_char. This
    ! actually reads input from the C standard input, which might not
    ! be the same as input_unit.
    !
    use, intrinsic :: iso_c_binding, only: c_int
    character, intent(inout) :: c
    integer, intent(out) :: stat

    interface
       !
       ! Use getchar(3) to read characters from standard input. This
       ! assumes there is actually such a function available, and that
       ! getchar(3) does not exist solely as a macro. (One could write
       ! one’s own getchar() if necessary, of course.)
       !
       function getchar () result (c) bind (c, name = 'getchar')
         use, intrinsic :: iso_c_binding, only: c_int
         integer(kind = c_int) :: c
       end function getchar
    end interface

    integer(kind = c_int) :: i_char

    i_char = getchar ()
    !
    ! The C standard requires that EOF have a negative value. If the
    ! value returned by getchar(3) is not EOF, then it will be
    ! representable as an unsigned char. Therefore, to check for end
    ! of file, one need only test whether i_char is negative.
    !
    if (i_char < 0) then
       stat = -1
    else
       stat = 0
       c = char (i_char)
    end if
  end subroutine get_input_unit_char

#endif

end module reading_one_line_from_a_stream

module ast_reader

  !
  ! The AST will be read into an array. Perhaps that will improve
  ! locality, compared to storing the AST as many linked heap nodes.
  !
  ! In any case, implementing the AST this way is an interesting
  ! problem.
  !

  use, intrinsic :: iso_fortran_env, only: input_unit
  use, intrinsic :: iso_fortran_env, only: output_unit
  use, intrinsic :: iso_fortran_env, only: error_unit
  use, non_intrinsic :: compiler_type_kinds, only: nk, ck, ick, rik
  use, non_intrinsic :: helper_procedures, only: next_power_of_two
  use, non_intrinsic :: helper_procedures, only: new_storage_size
  use, non_intrinsic :: string_buffers
  use, non_intrinsic :: reading_one_line_from_a_stream

  implicit none
  private

  public :: symbol_table_t
  public :: interpreter_ast_node_t
  public :: interpreter_ast_t
  public :: read_ast

  integer, parameter, public :: node_Nil = 0
  integer, parameter, public :: node_Identifier = 1
  integer, parameter, public :: node_String = 2
  integer, parameter, public :: node_Integer = 3
  integer, parameter, public :: node_Sequence = 4
  integer, parameter, public :: node_If = 5
  integer, parameter, public :: node_Prtc = 6
  integer, parameter, public :: node_Prts = 7
  integer, parameter, public :: node_Prti = 8
  integer, parameter, public :: node_While = 9
  integer, parameter, public :: node_Assign = 10
  integer, parameter, public :: node_Negate = 11
  integer, parameter, public :: node_Not = 12
  integer, parameter, public :: node_Multiply = 13
  integer, parameter, public :: node_Divide = 14
  integer, parameter, public :: node_Mod = 15
  integer, parameter, public :: node_Add = 16
  integer, parameter, public :: node_Subtract = 17
  integer, parameter, public :: node_Less = 18
  integer, parameter, public :: node_LessEqual = 19
  integer, parameter, public :: node_Greater = 20
  integer, parameter, public :: node_GreaterEqual = 21
  integer, parameter, public :: node_Equal = 22
  integer, parameter, public :: node_NotEqual = 23
  integer, parameter, public :: node_And = 24
  integer, parameter, public :: node_Or = 25

  type :: symbol_table_element_t
     character(:, kind = ck), allocatable :: str
  end type symbol_table_element_t

  type :: symbol_table_t
     integer(kind = nk), private :: len = 0_nk
     type(symbol_table_element_t), allocatable, private :: symbols(:)
   contains
     procedure, pass, private :: ensure_storage => symbol_table_t_ensure_storage
     procedure, pass :: look_up_index => symbol_table_t_look_up_index
     procedure, pass :: look_up_name => symbol_table_t_look_up_name
     procedure, pass :: length => symbol_table_t_length
     generic :: look_up => look_up_index
     generic :: look_up => look_up_name
  end type symbol_table_t

  type :: interpreter_ast_node_t
     integer :: node_variety
     integer(kind = rik) :: int ! Runtime integer or symbol index.
     character(:, kind = ck), allocatable :: str ! String value.

     ! The left branch begins at the next node. The right branch
     ! begins at the address of the left branch, plus the following.
     integer(kind = nk) :: right_branch_offset
  end type interpreter_ast_node_t

  type :: interpreter_ast_t
     integer(kind = nk), private :: len = 0_nk
     type(interpreter_ast_node_t), allocatable, public :: nodes(:)
   contains
     procedure, pass, private :: ensure_storage => interpreter_ast_t_ensure_storage
  end type interpreter_ast_t

contains

  subroutine symbol_table_t_ensure_storage (symtab, length_needed)
    class(symbol_table_t), intent(inout) :: symtab
    integer(kind = nk), intent(in) :: length_needed

    integer(kind = nk) :: len_needed
    integer(kind = nk) :: new_size
    type(symbol_table_t) :: new_symtab

    len_needed = max (length_needed, 1_nk)

    if (.not. allocated (symtab%symbols)) then
       ! Initialize a new symtab%symbols array.
       new_size = new_storage_size (len_needed)
       allocate (symtab%symbols(1:new_size))
    else if (ubound (symtab%symbols, 1) < len_needed) then
       ! Allocate a new symtab%symbols array, larger than the current
       ! one, but containing the same symbols.
       new_size = new_storage_size (len_needed)
       allocate (new_symtab%symbols(1:new_size))
       new_symtab%symbols(1:symtab%len) = symtab%symbols(1:symtab%len)
       call move_alloc (new_symtab%symbols, symtab%symbols)
    end if
  end subroutine symbol_table_t_ensure_storage

  elemental function symbol_table_t_length (symtab) result (len)
    class(symbol_table_t), intent(in) :: symtab
    integer(kind = nk) :: len

    len = symtab%len
  end function symbol_table_t_length

  function symbol_table_t_look_up_index (symtab, symbol_name) result (index)
    class(symbol_table_t), intent(inout) :: symtab
    character(*, kind = ck), intent(in) :: symbol_name
    integer(kind = rik) :: index

    !
    ! This implementation simply stores the symbols sequentially into
    ! an array. Obviously, for large numbers of symbols, one might
    ! wish to do something more complex.
    !
    ! Standard Fortran does not come, out of the box, with a massive
    ! runtime library for doing such things. They are, however, no
    ! longer nearly as challenging to implement in Fortran as they
    ! used to be.
    !

    integer(kind = nk) :: i

    i = 1
    index = 0
    do while (index == 0)
       if (i == symtab%len + 1) then
          ! The symbol is new and must be added to the table.
          i = symtab%len + 1
          if (huge (1_rik) < i) then
             ! Symbol indices are assumed to be storable as runtime
             ! integers.
             write (error_unit, '("There are more symbols than can be handled.")')
             stop 1
          end if
          call symtab%ensure_storage(i)
          symtab%len = i
          allocate (symtab%symbols(i)%str, source = symbol_name)
          index = int (i, kind = rik)
       else if (symtab%symbols(i)%str == symbol_name) then
          index = int (i, kind = rik)
       else
          i = i + 1
       end if
    end do
  end function symbol_table_t_look_up_index

  function symbol_table_t_look_up_name (symtab, index) result (symbol_name)
    class(symbol_table_t), intent(inout) :: symtab
    integer(kind = rik), intent(in) :: index
    character(:, kind = ck), allocatable :: symbol_name

    !
    ! This is the reverse of symbol_table_t_look_up_index: given an
    ! index, it finds the symbol’s name.
    !

    if (index < 1 .or. symtab%len < index) then
       ! In correct code, this branch should never be reached.
       error stop
    else
       allocate (symbol_name, source = symtab%symbols(index)%str)
    end if
  end function symbol_table_t_look_up_name

  subroutine interpreter_ast_t_ensure_storage (ast, length_needed)
    class(interpreter_ast_t), intent(inout) :: ast
    integer(kind = nk), intent(in) :: length_needed

    integer(kind = nk) :: len_needed
    integer(kind = nk) :: new_size
    type(interpreter_ast_t) :: new_ast

    len_needed = max (length_needed, 1_nk)

    if (.not. allocated (ast%nodes)) then
       ! Initialize a new ast%nodes array.
       new_size = new_storage_size (len_needed)
       allocate (ast%nodes(1:new_size))
    else if (ubound (ast%nodes, 1) < len_needed) then
       ! Allocate a new ast%nodes array, larger than the current one,
       ! but containing the same nodes.
       new_size = new_storage_size (len_needed)
       allocate (new_ast%nodes(1:new_size))
       new_ast%nodes(1:ast%len) = ast%nodes(1:ast%len)
       call move_alloc (new_ast%nodes, ast%nodes)
    end if
  end subroutine interpreter_ast_t_ensure_storage

  subroutine read_ast (unit_no, strbuf, ast, symtab)
    integer, intent(in) :: unit_no
    type(strbuf_t), intent(inout) :: strbuf
    type(interpreter_ast_t), intent(inout) :: ast
    type(symbol_table_t), intent(inout) :: symtab

    logical :: eof
    logical :: no_newline
    integer(kind = nk) :: after_ast_address

    symtab%len = 0
    ast%len = 0
    call build_subtree (1_nk, after_ast_address)

  contains

    recursive subroutine build_subtree (here_address, after_subtree_address)
      integer(kind = nk), value :: here_address
      integer(kind = nk), intent(out) :: after_subtree_address

      integer :: node_variety
      integer(kind = nk) :: i, j
      integer(kind = nk) :: left_branch_address
      integer(kind = nk) :: right_branch_address

      ! Get a line from the parser output.
      call get_line_from_stream (unit_no, eof, no_newline, strbuf)

      if (eof) then
         call ast_error
      else
         ! Prepare to store a new node.
         call ast%ensure_storage(here_address)
         ast%len = here_address

         ! What sort of node is it?
         i = skip_whitespace (strbuf, 1_nk)
         j = skip_non_whitespace (strbuf, i)
         node_variety = strbuf_to_node_variety (strbuf, i, j - 1)

         ast%nodes(here_address)%node_variety = node_variety

         select case (node_variety)
         case (node_Nil)
            after_subtree_address = here_address + 1
         case (node_Identifier)
            i = skip_whitespace (strbuf, j)
            j = skip_non_whitespace (strbuf, i)
            ast%nodes(here_address)%int = &
                 &   strbuf_to_symbol_index (strbuf, i, j - 1, symtab)
            after_subtree_address = here_address + 1
         case (node_String)
            i = skip_whitespace (strbuf, j)
            j = skip_whitespace_backwards (strbuf, strbuf%length())
            ast%nodes(here_address)%str = strbuf_to_string (strbuf, i, j)
            after_subtree_address = here_address + 1
         case (node_Integer)
            i = skip_whitespace (strbuf, j)
            j = skip_non_whitespace (strbuf, i)
            ast%nodes(here_address)%int = strbuf_to_int (strbuf, i, j - 1)
            after_subtree_address = here_address + 1
         case default
            ! The node is internal, and has left and right branches.
            ! The left branch will start at left_branch_address; the
            ! right branch will start at left_branch_address +
            ! right_side_offset.
            left_branch_address = here_address + 1
            ! Build the left branch.
            call build_subtree (left_branch_address, right_branch_address)
            ! Build the right_branch.
            call build_subtree (right_branch_address, after_subtree_address)
            ast%nodes(here_address)%right_branch_offset = &
                 &   right_branch_address - left_branch_address
         end select

      end if
    end subroutine build_subtree

  end subroutine read_ast

  function strbuf_to_node_variety (strbuf, i, j) result (node_variety)
    class(strbuf_t), intent(in) :: strbuf
    integer(kind = nk), intent(in) :: i, j
    integer :: node_variety

    !
    ! This function has not been optimized in any way, unless the
    ! Fortran compiler can optimize it.
    !
    ! Something like a ‘radix tree search’ could be done on the
    ! characters of the strbuf. Or a perfect hash function. Or a
    ! binary search. Etc.
    !

    if (j == i - 1) then
       call ast_error
    else
       select case (strbuf%to_unicode(i, j))
       case (ck_";")
          node_variety = node_Nil
       case (ck_"Identifier")
          node_variety = node_Identifier
       case (ck_"String")
          node_variety = node_String
       case (ck_"Integer")
          node_variety = node_Integer
       case (ck_"Sequence")
          node_variety = node_Sequence
       case (ck_"If")
          node_variety = node_If
       case (ck_"Prtc")
          node_variety = node_Prtc
       case (ck_"Prts")
          node_variety = node_Prts
       case (ck_"Prti")
          node_variety = node_Prti
       case (ck_"While")
          node_variety = node_While
       case (ck_"Assign")
          node_variety = node_Assign
       case (ck_"Negate")
          node_variety = node_Negate
       case (ck_"Not")
          node_variety = node_Not
       case (ck_"Multiply")
          node_variety = node_Multiply
       case (ck_"Divide")
          node_variety = node_Divide
       case (ck_"Mod")
          node_variety = node_Mod
       case (ck_"Add")
          node_variety = node_Add
       case (ck_"Subtract")
          node_variety = node_Subtract
       case (ck_"Less")
          node_variety = node_Less
       case (ck_"LessEqual")
          node_variety = node_LessEqual
       case (ck_"Greater")
          node_variety = node_Greater
       case (ck_"GreaterEqual")
          node_variety = node_GreaterEqual
       case (ck_"Equal")
          node_variety = node_Equal
       case (ck_"NotEqual")
          node_variety = node_NotEqual
       case (ck_"And")
          node_variety = node_And
       case (ck_"Or")
          node_variety = node_Or
       case default
          call ast_error
       end select
    end if
  end function strbuf_to_node_variety

  function strbuf_to_symbol_index (strbuf, i, j, symtab) result (int)
    class(strbuf_t), intent(in) :: strbuf
    integer(kind = nk), intent(in) :: i, j
    type(symbol_table_t), intent(inout) :: symtab
    integer(kind = rik) :: int

    if (j == i - 1) then
       call ast_error
    else
       int = symtab%look_up(strbuf%to_unicode (i, j))
    end if
  end function strbuf_to_symbol_index

  function strbuf_to_int (strbuf, i, j) result (int)
    class(strbuf_t), intent(in) :: strbuf
    integer(kind = nk), intent(in) :: i, j
    integer(kind = rik) :: int

    integer :: stat
    character(:, kind = ck), allocatable :: str

    if (j < i) then
       call ast_error
    else
       allocate (character(len = (j - i) + 1_nk, kind = ck) :: str)
       str = strbuf%to_unicode (i, j)
       read (str, *, iostat = stat) int
       if (stat /= 0) then
          call ast_error
       end if
    end if
  end function strbuf_to_int

  function strbuf_to_string (strbuf, i, j) result (str)
    class(strbuf_t), intent(in) :: strbuf
    integer(kind = nk), intent(in) :: i, j
    character(:, kind = ck), allocatable :: str

    character(1, kind = ck), parameter :: linefeed_char = char (10, kind = ck)
    character(1, kind = ck), parameter :: backslash_char = char (92, kind = ck)

    ! The following is correct for Unix and its relatives.
    character(1, kind = ck), parameter :: newline_char = linefeed_char

    integer(kind = nk) :: k
    integer(kind = nk) :: count

    if (strbuf%chars(i) /= ck_'"' .or. strbuf%chars(j) /= ck_'"') then
       call ast_error
    else
       ! Count how many characters are needed.
       count = 0
       k = i + 1
       do while (k < j)
          count = count + 1
          if (strbuf%chars(k) == backslash_char) then
             k = k + 2
          else
             k = k + 1
          end if
       end do

       allocate (character(len = count, kind = ck) :: str)

       count = 0
       k = i + 1
       do while (k < j)
          if (strbuf%chars(k) == backslash_char) then
             if (k == j - 1) then
                call ast_error
             else
                select case (strbuf%chars(k + 1))
                case (ck_'n')
                   count = count + 1
                   str(count:count) = newline_char
                case (backslash_char)
                   count = count + 1
                   str(count:count) = backslash_char
                case default
                   call ast_error
                end select
                k = k + 2
             end if
          else
             count = count + 1
             str(count:count) = strbuf%chars(k)
             k = k + 1
          end if
       end do
    end if
  end function strbuf_to_string

  subroutine ast_error
    !
    ! It might be desirable to give more detail.
    !
    write (error_unit, '("The AST input seems corrupted.")')
    stop 1
  end subroutine ast_error

end module ast_reader

module ast_interpreter
  use, intrinsic :: iso_fortran_env, only: input_unit
  use, intrinsic :: iso_fortran_env, only: output_unit
  use, intrinsic :: iso_fortran_env, only: error_unit
  use, non_intrinsic :: compiler_type_kinds
  use, non_intrinsic :: ast_reader

  implicit none
  private

  public :: value_t
  public :: variable_table_t
  public :: nil_value
  public :: interpret_ast_node

  integer, parameter, public :: v_Nil = 0
  integer, parameter, public :: v_Integer = 1
  integer, parameter, public :: v_String = 2

  type :: value_t
     integer :: tag = v_Nil
     integer(kind = rik) :: int_val = -(huge (1_rik))
     character(:, kind = ck), allocatable :: str_val
  end type value_t

  type :: variable_table_t
     type(value_t), allocatable :: vals(:)
   contains
     procedure, pass :: initialize => variable_table_t_initialize
  end type variable_table_t

  ! The canonical nil value.
  type(value_t), parameter :: nil_value = value_t ()

contains

  elemental function int_value (int_val) result (val)
    integer(kind = rik), intent(in) :: int_val
    type(value_t) :: val

    val%tag = v_Integer
    val%int_val = int_val
  end function int_value

  elemental function str_value (str_val) result (val)
    character(*, kind = ck), intent(in) :: str_val
    type(value_t) :: val

    val%tag = v_String
    allocate (val%str_val, source = str_val)
  end function str_value

  subroutine variable_table_t_initialize (vartab, symtab)
    class(variable_table_t), intent(inout) :: vartab
    type(symbol_table_t), intent(in) :: symtab

    allocate (vartab%vals(1:symtab%length()), source = nil_value)
  end subroutine variable_table_t_initialize

  recursive subroutine interpret_ast_node (outp, ast, symtab, vartab, address, retval)
    integer, intent(in) :: outp
    type(interpreter_ast_t), intent(in) :: ast
    type(symbol_table_t), intent(in) :: symtab
    type(variable_table_t), intent(inout) :: vartab
    integer(kind = nk) :: address
    type(value_t), intent(inout) :: retval

    integer(kind = rik) :: variable_index
    type(value_t) :: val1, val2, val3

    select case (ast%nodes(address)%node_variety)

    case (node_Nil)
       retval = nil_value

    case (node_Integer)
       retval = int_value (ast%nodes(address)%int)

    case (node_Identifier)
       variable_index = ast%nodes(address)%int
       retval = vartab%vals(variable_index)

    case (node_String)
       retval = str_value (ast%nodes(address)%str)

    case (node_Assign)
       call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val1)
       variable_index = ast%nodes(left_branch (address))%int
       vartab%vals(variable_index) = val1
       retval = nil_value

    case (node_Multiply)
       call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
       call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val2)
       call multiply (val1, val2, val3)
       retval = val3

    case (node_Divide)
       call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
       call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val2)
       call divide (val1, val2, val3)
       retval = val3

    case (node_Mod)
       call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
       call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val2)
       call pseudo_remainder (val1, val2, val3)
       retval = val3

    case (node_Add)
       call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
       call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val2)
       call add (val1, val2, val3)
       retval = val3

    case (node_Subtract)
       call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
       call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val2)
       call subtract (val1, val2, val3)
       retval = val3

    case (node_Less)
       call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
       call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val2)
       call less_than (val1, val2, val3)
       retval = val3

    case (node_LessEqual)
       call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
       call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val2)
       call less_than_or_equal_to (val1, val2, val3)
       retval = val3

    case (node_Greater)
       call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
       call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val2)
       call greater_than (val1, val2, val3)
       retval = val3

    case (node_GreaterEqual)
       call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
       call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val2)
       call greater_than_or_equal_to (val1, val2, val3)
       retval = val3

    case (node_Equal)
       call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
       call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val2)
       call equal_to (val1, val2, val3)
       retval = val3

    case (node_NotEqual)
       call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
       call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val2)
       call not_equal_to (val1, val2, val3)
       retval = val3

    case (node_Negate)
      call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
      retval = int_value (-(rik_cast (val1, ck_'unary ''-''')))

    case (node_Not)
      call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
      retval = int_value (bool2int (rik_cast (val1, ck_'unary ''!''') == 0_rik))

    case (node_And)
      ! For similarity to C, we make this a ‘short-circuiting AND’,
      ! which is really a branching construct rather than a binary
      ! operation.
      call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
      if (rik_cast (val1, ck_'''&&''') == 0_rik) then
         retval = int_value (0_rik)
      else
         call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val2)
         retval = int_value (bool2int (rik_cast (val2, ck_'''&&''') /= 0_rik))
      end if

    case (node_Or)
      ! For similarity to C, we make this a ‘short-circuiting OR’,
      ! which is really a branching construct rather than a binary
      ! operation.
      call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
      if (rik_cast (val1, ck_'''||''') /= 0_rik) then
         retval = int_value (1_rik)
      else
         call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val2)
         retval = int_value (bool2int (rik_cast (val2, ck_'''||''') /= 0_rik))
      end if

    case (node_If)
      call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
      if (rik_cast (val1, ck_'''if-else'' construct') /= 0_rik) then
         call interpret_ast_node (outp, ast, symtab, vartab, &
              &                   left_branch (right_branch (address)), &
              &                   val2)
      else
         call interpret_ast_node (outp, ast, symtab, vartab, &
              &                   right_branch (right_branch (address)), &
              &                   val2)
      end if
      retval = nil_value

    case (node_While)
      call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
      do while (rik_cast (val1, ck_'''while'' construct') /= 0_rik)
         call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val2)
         call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
      end do
      retval = nil_value

    case (node_Prtc)
      call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
      write (outp, '(A1)', advance = 'no') &
           &    char (rik_cast (val1, ck_'''putc'''), kind = ck)
      retval = nil_value

    case (node_Prti, node_Prts)
      call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
      select case (val1%tag)
      case (v_Integer)
         write (outp, '(I0)', advance = 'no') val1%int_val
      case (v_String)
         write (outp, '(A)', advance = 'no') val1%str_val
      case (v_Nil)
         write (outp, '("(no value)")', advance = 'no')
      case default
         error stop
      end select
      retval = nil_value

    case (node_Sequence)
       call interpret_ast_node (outp, ast, symtab, vartab, left_branch (address), val1)
       call interpret_ast_node (outp, ast, symtab, vartab, right_branch (address), val2)
       retval = nil_value

    case default
       write (error_unit, '("unknown node type")')
       stop 1

    end select

  contains

    elemental function left_branch (here_addr) result (left_addr)
      integer(kind = nk), intent(in) :: here_addr
      integer(kind = nk) :: left_addr

      left_addr = here_addr + 1
    end function left_branch

    elemental function right_branch (here_addr) result (right_addr)
      integer(kind = nk), intent(in) :: here_addr
      integer(kind = nk) :: right_addr

      right_addr = here_addr + 1 + ast%nodes(here_addr)%right_branch_offset
    end function right_branch

  end subroutine interpret_ast_node

  subroutine multiply (x, y, z)
    type(value_t), intent(in) :: x, y
    type(value_t), intent(out) :: z

    character(*, kind = ck), parameter :: op = ck_'*'

    z = int_value (rik_cast (x, op) * rik_cast (y, op))
  end subroutine multiply

  subroutine divide (x, y, z)
    type(value_t), intent(in) :: x, y
    type(value_t), intent(out) :: z

    character(*, kind = ck), parameter :: op = ck_'/'

    ! Fortran integer division truncates towards zero, as C’s does.
    z = int_value (rik_cast (x, op) / rik_cast (y, op))
  end subroutine divide

  subroutine pseudo_remainder (x, y, z)
    type(value_t), intent(in) :: x, y
    type(value_t), intent(out) :: z

    !
    ! I call this ‘pseudo-remainder’ because I consider ‘remainder’ to
    ! mean the *non-negative* remainder in A = (B * Quotient) +
    ! Remainder. See https://doi.org/10.1145%2F128861.128862
    !
    ! The pseudo-remainder gives the actual remainder, if both
    ! operands are positive.
    !

    character(*, kind = ck), parameter :: op = ck_'binary ''%'''

    ! Fortran’s MOD intrinsic, when given integer arguments, works
    ! like C ‘%’.
    z = int_value (mod (rik_cast (x, op), rik_cast (y, op)))
  end subroutine pseudo_remainder

  subroutine add (x, y, z)
    type(value_t), intent(in) :: x, y
    type(value_t), intent(out) :: z

    character(*, kind = ck), parameter :: op = ck_'binary ''+'''

    z = int_value (rik_cast (x, op) + rik_cast (y, op))
  end subroutine add

  subroutine subtract (x, y, z)
    type(value_t), intent(in) :: x, y
    type(value_t), intent(out) :: z

    character(*, kind = ck), parameter :: op = ck_'binary ''-'''

    z = int_value (rik_cast (x, op) - rik_cast (y, op))
  end subroutine subtract

  subroutine less_than (x, y, z)
    type(value_t), intent(in) :: x, y
    type(value_t), intent(out) :: z

    character(*, kind = ck), parameter :: op = ck_'binary ''<'''

    z = int_value (bool2int (rik_cast (x, op) < rik_cast (y, op)))
  end subroutine less_than

  subroutine less_than_or_equal_to (x, y, z)
    type(value_t), intent(in) :: x, y
    type(value_t), intent(out) :: z

    character(*, kind = ck), parameter :: op = ck_'binary ''<='''

    z = int_value (bool2int (rik_cast (x, op) <= rik_cast (y, op)))
  end subroutine less_than_or_equal_to

  subroutine greater_than (x, y, z)
    type(value_t), intent(in) :: x, y
    type(value_t), intent(out) :: z

    character(*, kind = ck), parameter :: op = ck_'binary ''>'''

    z = int_value (bool2int (rik_cast (x, op) > rik_cast (y, op)))
  end subroutine greater_than

  subroutine greater_than_or_equal_to (x, y, z)
    type(value_t), intent(in) :: x, y
    type(value_t), intent(out) :: z

    character(*, kind = ck), parameter :: op = ck_'binary ''>='''

    z = int_value (bool2int (rik_cast (x, op) >= rik_cast (y, op)))
  end subroutine greater_than_or_equal_to

  subroutine equal_to (x, y, z)
    type(value_t), intent(in) :: x, y
    type(value_t), intent(out) :: z

    character(*, kind = ck), parameter :: op = ck_'binary ''=='''

    z = int_value (bool2int (rik_cast (x, op) == rik_cast (y, op)))
  end subroutine equal_to

  subroutine not_equal_to (x, y, z)
    type(value_t), intent(in) :: x, y
    type(value_t), intent(out) :: z

    character(*, kind = ck), parameter :: op = ck_'binary ''!='''

    z = int_value (bool2int (rik_cast (x, op) /= rik_cast (y, op)))
  end subroutine not_equal_to

  function rik_cast (val, operation_name) result (i_val)
    class(*), intent(in) :: val
    character(*, kind = ck), intent(in) :: operation_name
    integer(kind = rik) :: i_val

    select type (val)
    class is (value_t)
       if (val%tag == v_Integer) then
          i_val = val%int_val
       else
          call type_error (operation_name)
       end if
    type is (integer(kind = rik))
       i_val = val
    class default
       call type_error (operation_name)
    end select
  end function rik_cast

  elemental function bool2int (bool) result (int)
    logical, intent(in) :: bool
    integer(kind = rik) :: int

    if (bool) then
       int = 1_rik
    else
       int = 0_rik
    end if
  end function bool2int

  subroutine type_error (operation_name)
    character(*, kind = ck), intent(in) :: operation_name

    write (error_unit, '("type error in ", A)') operation_name
    stop 1
  end subroutine type_error

end module ast_interpreter

program Interp
  use, intrinsic :: iso_fortran_env, only: input_unit
  use, intrinsic :: iso_fortran_env, only: output_unit
  use, intrinsic :: iso_fortran_env, only: error_unit
  use, non_intrinsic :: compiler_type_kinds
  use, non_intrinsic :: string_buffers
  use, non_intrinsic :: ast_reader
  use, non_intrinsic :: ast_interpreter

  implicit none

  integer, parameter :: inp_unit_no = 100
  integer, parameter :: outp_unit_no = 101

  integer :: arg_count
  character(200) :: arg
  integer :: inp
  integer :: outp

  type(strbuf_t) :: strbuf
  type(interpreter_ast_t) :: ast
  type(symbol_table_t) :: symtab
  type(variable_table_t) :: vartab
  type(value_t) :: retval

  arg_count = command_argument_count ()
  if (3 <= arg_count) then
     call print_usage
  else
     if (arg_count == 0) then
        inp = input_unit
        outp = output_unit
     else if (arg_count == 1) then
        call get_command_argument (1, arg)
        inp = open_for_input (trim (arg))
        outp = output_unit
     else if (arg_count == 2) then
        call get_command_argument (1, arg)
        inp = open_for_input (trim (arg))
        call get_command_argument (2, arg)
        outp = open_for_output (trim (arg))
     end if

     call read_ast (inp, strbuf, ast, symtab)
     if (1 <= ubound (ast%nodes, 1)) then
        call vartab%initialize(symtab)
        call interpret_ast_node (outp, ast, symtab, vartab, 1_nk, retval)
     end if
  end if

contains

  function open_for_input (filename) result (unit_no)
    character(*), intent(in) :: filename
    integer :: unit_no

    integer :: stat

    open (unit = inp_unit_no, file = filename, status = 'old', &
         & action = 'read', access = 'stream', form = 'unformatted',  &
         & iostat = stat)
    if (stat /= 0) then
       write (error_unit, '("Error: failed to open ", 1A, " for input")') filename
       stop 1
    end if
    unit_no = inp_unit_no
  end function open_for_input

  function open_for_output (filename) result (unit_no)
    character(*), intent(in) :: filename
    integer :: unit_no

    integer :: stat

    open (unit = outp_unit_no, file = filename, action = 'write', iostat = stat)
    if (stat /= 0) then
       write (error_unit, '("Error: failed to open ", 1A, " for output")') filename
       stop 1
    end if
    unit_no = outp_unit_no
  end function open_for_output

  subroutine print_usage
    character(200) :: progname

    call get_command_argument (0, progname)
    write (output_unit, '("Usage: ", 1A, " [INPUT_FILE [OUTPUT_FILE]]")') &
         &      trim (progname)
  end subroutine print_usage

end program Interp


import rand
import strings
import time

struct Field {
mut:
	s    [][]bool
	w int
	h int
}

fn new_field(w int, h int) Field {
	s := [][]bool{len: h, init: []bool{len: w}}
	return Field{s, w, h}
}

fn (mut f Field) set(x int, y int, b bool) {
	f.s[y][x] = b
}

fn (f Field) next(x int, y int) bool {
	mut on := 0
	for i := -1; i <= 1; i++ {
		for j := -1; j <= 1; j++ {
			if f.state(x+i, y+j) && !(j == 0 && i == 0) {
				on++
			}
		}
	}
	return on == 3 || (on == 2 && f.state(x, y))
}

fn (f Field) state(xx int, yy int) bool {
	mut x, mut y := xx, yy
	for y < 0 {
		y += f.h
	}
	for x < 0 {
		x += f.w
	}
	return f.s[y%f.h][x%f.w]
}

struct Life {
mut:
	w int
	h int
	a Field
	b Field
}

fn new_life(w int, h int) Life {
	mut a := new_field(w, h)
	for _ in 0..(w * h / 2) {
		a.set(rand.intn(w) or {0}, rand.intn(h) or {0}, true)
	}
	return Life{
		a: a,
		b: new_field(w, h),
		w: w
		h: h,
	}
}

fn (mut l Life) step() {
	for y in 0..l.h {
		for x in 0.. l.w {
			l.b.set(x, y, l.a.next(x, y))
		}
	}
	l.a, l.b = l.b, l.a
}

fn (l Life) str() string {
	mut buf := strings.new_builder(128)
	for y in 0..l.h {
		for x in 0..l.w {
			mut b := ' '
			if l.a.state(x, y) {
				b = '*'
			}
			buf.write_string(b)
		}
		buf.write_string('\n')
	}
	return buf.str()
}

fn main() {
	mut l := new_life(80, 15)
	for i := 0; i < 300; i++ {
		l.step()
		//println("------------------------------------------------")
		print('\x0c')
		println(l)
		time.sleep(time.second / 30)
	}
}


if(condition){
   result = 'met'
}
else{
   result = 'not met'
}


package main

import (
    "bufio"
    "fmt"
    "log"
    "os"
    "strconv"
    "strings"
)

type NodeType int

const (
    ndIdent NodeType = iota
    ndString
    ndInteger
    ndSequence
    ndIf
    ndPrtc
    ndPrts
    ndPrti
    ndWhile
    ndAssign
    ndNegate
    ndNot
    ndMul
    ndDiv
    ndMod
    ndAdd
    ndSub
    ndLss
    ndLeq
    ndGtr
    ndGeq
    ndEql
    ndNeq
    ndAnd
    ndOr
)

type Tree struct {
    nodeType NodeType
    left     *Tree
    right    *Tree
    value    int
}

// dependency: Ordered by NodeType, must remain in same order as NodeType enum
type atr struct {
    enumText string
    nodeType NodeType
}

var atrs = []atr{
    {"Identifier", ndIdent},
    {"String", ndString},
    {"Integer", ndInteger},
    {"Sequence", ndSequence},
    {"If", ndIf},
    {"Prtc", ndPrtc},
    {"Prts", ndPrts},
    {"Prti", ndPrti},
    {"While", ndWhile},
    {"Assign", ndAssign},
    {"Negate", ndNegate},
    {"Not", ndNot},
    {"Multiply", ndMul},
    {"Divide", ndDiv},
    {"Mod", ndMod},
    {"Add", ndAdd},
    {"Subtract", ndSub},
    {"Less", ndLss},
    {"LessEqual", ndLeq},
    {"Greater", ndGtr},
    {"GreaterEqual", ndGeq},
    {"Equal", ndEql},
    {"NotEqual", ndNeq},
    {"And", ndAnd},
    {"Or", ndOr},
}

var (
    stringPool   []string
    globalNames  []string
    globalValues = make(map[int]int)
)

var (
    err     error
    scanner *bufio.Scanner
)

func reportError(msg string) {
    log.Fatalf("error : %s\n", msg)
}

func check(err error) {
    if err != nil {
        log.Fatal(err)
    }
}

func btoi(b bool) int {
    if b {
        return 1
    }
    return 0
}

func itob(i int) bool {
    if i == 0 {
        return false
    }
    return true
}

func makeNode(nodeType NodeType, left *Tree, right *Tree) *Tree {
    return &Tree{nodeType, left, right, 0}
}

func makeLeaf(nodeType NodeType, value int) *Tree {
    return &Tree{nodeType, nil, nil, value}
}

func interp(x *Tree) int { // interpret the parse tree
    if x == nil {
        return 0
    }
    switch x.nodeType {
    case ndInteger:
        return x.value
    case ndIdent:
        return globalValues[x.value]
    case ndString:
        return x.value
    case ndAssign:
        n := interp(x.right)
        globalValues[x.left.value] = n
        return n
    case ndAdd:
        return interp(x.left) + interp(x.right)
    case ndSub:
        return interp(x.left) - interp(x.right)
    case ndMul:
        return interp(x.left) * interp(x.right)
    case ndDiv:
        return interp(x.left) / interp(x.right)
    case ndMod:
        return interp(x.left) % interp(x.right)
    case ndLss:
        return btoi(interp(x.left) < interp(x.right))
    case ndGtr:
        return btoi(interp(x.left) > interp(x.right))
    case ndLeq:
        return btoi(interp(x.left) <= interp(x.right))
    case ndEql:
        return btoi(interp(x.left) == interp(x.right))
    case ndNeq:
        return btoi(interp(x.left) != interp(x.right))
    case ndAnd:
        return btoi(itob(interp(x.left)) && itob(interp(x.right)))
    case ndOr:
        return btoi(itob(interp(x.left)) || itob(interp(x.right)))
    case ndNegate:
        return -interp(x.left)
    case ndNot:
        if interp(x.left) == 0 {
            return 1
        }
        return 0
    case ndIf:
        if interp(x.left) != 0 {
            interp(x.right.left)
        } else {
            interp(x.right.right)
        }
        return 0
    case ndWhile:
        for interp(x.left) != 0 {
            interp(x.right)
        }
        return 0
    case ndPrtc:
        fmt.Printf("%c", interp(x.left))
        return 0
    case ndPrti:
        fmt.Printf("%d", interp(x.left))
        return 0
    case ndPrts:
        fmt.Print(stringPool[interp(x.left)])
        return 0
    case ndSequence:
        interp(x.left)
        interp(x.right)
        return 0
    default:
        reportError(fmt.Sprintf("interp: unknown tree type %d\n", x.nodeType))
    }
    return 0
}

func getEnumValue(name string) NodeType {
    for _, atr := range atrs {
        if atr.enumText == name {
            return atr.nodeType
        }
    }
    reportError(fmt.Sprintf("Unknown token %s\n", name))
    return -1
}

func fetchStringOffset(s string) int {
    var d strings.Builder
    s = s[1 : len(s)-1]
    for i := 0; i < len(s); i++ {
        if s[i] == '\\' && (i+1) < len(s) {
            if s[i+1] == 'n' {
                d.WriteByte('\n')
                i++
            } else if s[i+1] == '\\' {
                d.WriteByte('\\')
                i++
            }
        } else {
            d.WriteByte(s[i])
        }
    }
    s = d.String()
    for i := 0; i < len(stringPool); i++ {
        if s == stringPool[i] {
            return i
        }
    }
    stringPool = append(stringPool, s)
    return len(stringPool) - 1
}

func fetchVarOffset(name string) int {
    for i := 0; i < len(globalNames); i++ {
        if globalNames[i] == name {
            return i
        }
    }
    globalNames = append(globalNames, name)
    return len(globalNames) - 1
}

func loadAst() *Tree {
    var nodeType NodeType
    var s string
    if scanner.Scan() {
        line := strings.TrimRight(scanner.Text(), " \t")
        tokens := strings.Fields(line)
        first := tokens[0]
        if first[0] == ';' {
            return nil
        }
        nodeType = getEnumValue(first)
        le := len(tokens)
        if le == 2 {
            s = tokens[1]
        } else if le > 2 {
            idx := strings.Index(line, `"`)
            s = line[idx:]
        }
    }
    check(scanner.Err())
    if s != "" {
        var n int
        switch nodeType {
        case ndIdent:
            n = fetchVarOffset(s)
        case ndInteger:
            n, err = strconv.Atoi(s)
            check(err)
        case ndString:
            n = fetchStringOffset(s)
        default:
            reportError(fmt.Sprintf("Unknown node type: %s\n", s))
        }
        return makeLeaf(nodeType, n)
    }
    left := loadAst()
    right := loadAst()
    return makeNode(nodeType, left, right)
}

func main() {
    ast, err := os.Open("ast.txt")
    check(err)
    defer ast.Close()
    scanner = bufio.NewScanner(ast)
    x := loadAst()
    interp(x)
}