
(********************************************************************)
(*                                                                  *)
(*  seed7_05.s7i  Standard Seed7 library                            *)
(*  Copyright (C) 1989 - 2007  Thomas Mertes                        *)
(*                                                                  *)
(*  This file is part of the Seed7 Runtime Library.                 *)
(*                                                                  *)
(*  The Seed7 Runtime Library is free software; you can             *)
(*  redistribute it and/or modify it under the terms of the GNU     *)
(*  Lesser General Public License as published by the Free Software *)
(*  Foundation; either version 2.1 of the License, or (at your      *)
(*  option) any later version.                                      *)
(*                                                                  *)
(*  The Seed7 Runtime Library is distributed in the hope that it    *)
(*  will be useful, but WITHOUT ANY WARRANTY; without even the      *)
(*  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR *)
(*  PURPOSE.  See the GNU Lesser General Public License for more    *)
(*  details.                                                        *)
(*                                                                  *)
(*  You should have received a copy of the GNU Lesser General       *)
(*  Public License along with this program; if not, write to the    *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


$ include "syntax.s7i";

(*
$ const $ type: type is                            $ newtype;

$ const type: void is                              $ newtype;
$ const type: proc is                              $ func void;
$ const void: empty is                             $ enumlit;

$ const type: expr is                              $ newtype;
$ const type: object is                            $ newtype;
$ const type: string is                            $ subtype object;
$ const type: ACTION is                            $ newtype;
$ const type: f_param is                           $ newtype;
*)

$ const $ func type: $ func (ref type param)    is $ action "TYP_FUNC";
$ const $ func type: $ varfunc (ref type param) is $ action "TYP_VARFUNC";

$ const func ACTION: $ action (ref string param)        is $ action "ACT_GEN";
$ const proc: $ (ref proc param) ::= (ref ACTION param) is $ action "ACT_CREATE";
$ const proc: $ destroy (ref string param)              is   action "STR_DESTR";

$ const proc: $ (ref func f_param param) ::= (ref ACTION param) is action "ACT_CREATE";
$ const func f_param: $ ref (ref type param) param              is action "DCL_REF1";

$ const proc: const (ref type param) : (ref expr param) is (ref expr param) is action "DCL_CONST";

const proc: const (ref type param) : (ref expr param) is forward            is action "DCL_FWD";
const proc: var   (ref type param) : (ref expr param) is (ref expr param)   is action "DCL_VAR";

const func f_param: ref (ref type param) : (ref expr param)     is action "DCL_REF2";
const func f_param: val (ref type param) param                  is action "DCL_VAL1";
const func f_param: val (ref type param) : (ref expr param)     is action "DCL_VAL2";
const func f_param: in var (ref type param) param               is action "DCL_IN1VAR";
const func f_param: in var (ref type param) : (ref expr param)  is action "DCL_IN2VAR";
const func f_param: inout (ref type param) param                is action "DCL_INOUT1";
const func f_param: inout (ref type param) : (ref expr param)   is action "DCL_INOUT2";
const func f_param: in (ref type param) param                   is action "DCL_REF1";
const func f_param: attr (ref type param)                       is action "DCL_ATTR";
const func f_param: attr (ref f_param param)                    is action "DCL_PARAM_ATTR";

const proc: (ref type param) ::= (ref type param)            is action "TYP_CREATE";
const proc: destroy (ref type param)                         is action "TYP_DESTR";

const proc: (inout type param) := (ref type param)           is action "TYP_CPY";
const proc: (ref func proc param) ::= (ref ACTION param)     is action "ACT_CREATE";
const proc: (ref varfunc proc param) ::= (ref ACTION param)  is action "ACT_CREATE";
const func proc: func begin (ref expr param) end func        is action "PRC_BEGIN";
const func proc: func local (ref proc param)
                 begin (ref expr param) end func             is action "PRC_LOCAL";
const proc: (ref proc param) ::= (ref proc param)            is action "PRC_CREATE";
const proc: (inout proc param) := (ref proc param)           is action "PRC_CPY";
const proc: destroy (ref proc param)                         is action "PRC_NOOP";
const proc: noop                                             is action "PRC_NOOP";
const proc: (ref void param) ; (ref void param)              is noop;

const proc: PRINT (ref string param)                         is action "FIL_PRINT";

const proc: IN_PARAM_IS_VALUE (ref type: aType) is func
  begin
    const func f_param: in (attr aType) param                is action "DCL_VAL1";
    const func f_param: in (attr aType) : (ref expr param)   is action "DCL_VAL2";
  end func;

const proc: IN_PARAM_IS_REFERENCE (ref type: aType) is func
  begin
    const func f_param: in (attr aType) param                is action "DCL_REF1";
    const func f_param: in (attr aType) : (ref expr param)   is action "DCL_REF2";
  end func;

IN_PARAM_IS_REFERENCE(type);
IN_PARAM_IS_REFERENCE(proc);
IN_PARAM_IS_REFERENCE(object);
IN_PARAM_IS_REFERENCE(string);
IN_PARAM_IS_REFERENCE(ACTION);

const proc: BASIC_TYPE_DECLS (in type: aType) is func
  begin
(*    PRINT("in BASIC_TYPE_DECLS\n"); *)
    const proc: TRACE (ref aType param)                                  is action "REF_TRACE";
    const proc: ignore (ref aType param)                                 is noop;
    const proc: (ref func aType param) ::= (ref ACTION param)            is action "ACT_CREATE";
    const proc: (ref varfunc aType param) ::= (ref ACTION param)         is action "ACT_CREATE";
    const proc: (ref func aType param) ::= (ref func aType param)        is action "PRC_CREATE";
    const proc: (ref varfunc aType param) ::= (ref varfunc aType param)  is action "PRC_CREATE";
    const proc: (inout func aType param) := (ref func aType param)       is action "PRC_CPY";
    const proc: (inout varfunc aType param) := (ref varfunc aType param) is action "PRC_CPY";
    const type: typeof (ref aType param)                                 is aType;
    const proc: (ref func func aType param) ::= (ref ACTION param)       is action "ACT_CREATE";
    const proc: (ref func varfunc aType param) ::= (ref ACTION param)    is action "ACT_CREATE";

    const func func aType: func
                           result
                             var (attr aType) : (ref expr param) is (ref aType param)
                           local
                             (ref proc param)
                           begin
                             (ref expr param)
                           end func                                   is action "PRC_RES_LOCAL";

    const func func aType: func
                           result
                             var (attr aType) : (ref expr param) is (ref func aType param)
                           local
                             (ref proc param)
                           begin
                             (ref expr param)
                           end func                                   is action "PRC_RES_LOCAL";

    const func func aType: func
                           result
                             var (attr aType) : (ref expr param) is (ref aType param)
                           begin
                             (ref expr param)
                           end func                                   is action "PRC_RES_BEGIN";

    const func func aType: func
                           result
                             var (attr aType) : (ref expr param) is (ref func aType param)
                           begin
                             (ref expr param)
                           end func                                   is action "PRC_RES_BEGIN";

    const func func aType: return (ref func aType param)              is action "PRC_RETURN";
    const func func aType: return (ref aType param)                   is action "PRC_RETURN";
    const func varfunc aType: return var (ref varfunc aType param)    is action "PRC_VARFUNC";
    const func varfunc aType: return var (inout aType param)          is action "PRC_VARFUNC";

    const func func aType: (attr aType) return (ref func aType param)           is action "PRC_RETURN2";
    const func func aType: (attr aType) return (ref aType param)                is action "PRC_RETURN2";
    const func varfunc aType: (attr aType) return var (ref varfunc aType param) is action "PRC_VARFUNC2";
    const func varfunc aType: (attr aType) return var (inout aType param)       is action "PRC_VARFUNC2";

    const func f_param: in (attr func aType) : (ref expr param)       is action "DCL_REF2";
  end func;

BASIC_TYPE_DECLS(type);
BASIC_TYPE_DECLS(string);
BASIC_TYPE_DECLS(ACTION);


const proc: var (ref type: aType) : (ref expr: name) is default is func
  begin
    var aType: name is aType.value;
  end func;

const func string: str (in type param)                     is action "TYP_STR";
const func string: (in string param) & (in string param)   is action "STR_CAT";
const func type: gentype                                   is action "TYP_GENTYPE";
const func type: gensub (in type param)                    is action "TYP_GENSUB";

const func type: newtype is func
  result
    var type: aType is void;
  begin
    aType := gentype;
(*    PRINT("GENERATE type: newtype as "); PRINT(str(aType)); PRINT("\n"); *)
    BASIC_TYPE_DECLS(aType);
(*  TRACE(aType);
    PRINT("\n"); *)
  end func;

const func type: subtype (in type: baseType) is func
  result
    var type: aType is void;
  begin
    aType := gensub(baseType);
(*    PRINT("GENERATE type: subtype "); PRINT(str(baseType)); PRINT(" as "); PRINT(str(aType)); PRINT("\n"); *)
    BASIC_TYPE_DECLS(aType);

    const type: base_type (attr aType) is baseType;
    const func func aType: func
                           result
                             var (attr aType) : (ref expr param) is (ref baseType param)
                           local
                             (ref proc param)
                           begin
                             (ref expr param)
                           end func                                   is action "PRC_RES_LOCAL";

    const func func aType: func
                           result
                             var (attr aType) : (ref expr param) is (ref func baseType param)
                           local
                             (ref proc param)
                           begin
                             (ref expr param)
                           end func                                   is action "PRC_RES_LOCAL";

    const func func aType: func
                           result
                             var (attr aType) : (ref expr param) is (ref baseType param)
                           begin
                             (ref expr param)
                           end func                                   is action "PRC_RES_BEGIN";

    const func func aType: func
                           result
                             var (attr aType) : (ref expr param) is (ref func baseType param)
                           begin
                             (ref expr param)
                           end func                                   is action "PRC_RES_BEGIN";

    const func func aType: (attr aType) return (ref func baseType param)           is action "PRC_RETURN2";
    const func func aType: (attr aType) return (ref baseType param)                is action "PRC_RETURN2";
    const func varfunc aType: (attr aType) return var (ref varfunc baseType param) is action "PRC_VARFUNC2";
    const func varfunc aType: (attr aType) return var (inout baseType param)       is action "PRC_VARFUNC2";

(*  TRACE(aType);
    PRINT("\n"); *)
(*
    pixel conv 25
    pixel conv number
    pixel conv (number)
    pixel conv (2 + number)
    pixel.conv 25
    pixel.conv number
    pixel.conv (number)
    pixel.conv (2 + number)
    pixel`25
    pixel`number
    pixel`(number)
    pixel`(2 + number)
    pixel^25
    pixel^number
    pixel^(number)
    pixel^(2 + number)
    pixel<-25
    pixel<-number
    pixel<-(number)
    pixel<-(2 + number)
    pixel~25
    pixel~number
    pixel~(number)
    pixel~(2 + number)
    pixel\25
    pixel\number
    pixel\(number)
    pixel\(2 + number)
    pixel$25
    pixel$number
    pixel$(number)
    pixel$(2 + number)
    pixel!25
    pixel!number
    pixel!(number)
    pixel!(2 + number)
    pixel%25
    pixel%number
    pixel%(number)
    pixel%(2 + number)
    pixel|25
    pixel|number
    pixel|(number)
    pixel|(2 + number)
    pixel.25
    pixel.number
    pixel.(number)
    pixel.(2 + number)
    pixel@25
    pixel@number
    pixel@(number)
    pixel@(2 + number)
*)
  end func;


(*
const func type: func (in type: baseType) is func
  result
    var type: aType is void;
  begin
    aType := gentype;
    const func type: func baseType                        is aType;
    const proc: TRACE (ref aType param)                   is action "REF_TRACE";
    const proc: (ref aType param) ::= (ref ACTION param)  is action "ACT_CREATE";
    const proc: (ref aType param) ::= (ref aType param)   is action "PRC_CREATE";
  end func;
*)


const type: EXCEPTION      is newtype;
const type: LEGAL          is newtype;

const type: DISCRETE       is subtype object;
const type: integer        is subtype DISCRETE;
$ system "integer" is integer;
IN_PARAM_IS_VALUE(integer);
const type: char           is subtype DISCRETE;
$ system "char" is char;
IN_PARAM_IS_VALUE(char);
const type: ENUMERATION    is subtype DISCRETE;
IN_PARAM_IS_VALUE(ENUMERATION);
const type: INDEXABLE      is subtype object;
const type: MODULE         is subtype object;

const proc: destroy (ref ACTION param)      is noop;
const proc: destroy (ref ENUMERATION param) is noop;
const proc: destroy (ref integer param)     is noop;
const proc: destroy (ref char param)        is noop;
const proc: destroy (ref EXCEPTION param)   is noop;

const proc: (ref ACTION param) ::= (in ACTION param)            is action "ACT_CREATE";
const proc: destroy (ref func ACTION param)                     is noop;
const proc: (inout ACTION param) := (in ACTION param)           is action "ACT_CPY";
const proc: (ref ENUMERATION param) ::= (ref ENUMERATION param) is action "ENU_CREATE";
const proc: (ref ENUMERATION param) ::= enumlit                 is action "ENU_GENLIT";
const proc: (ref integer param) ::= (ref integer param)         is action "INT_CREATE";
const proc: (ref char param) ::= (in char param)                is action "CHR_CREATE";
const proc: (ref string param) ::= (in string param)            is action "STR_CREATE";
const proc: (ref func object param) ::= (in ACTION param)       is action "ACT_CREATE";
const proc: (ref EXCEPTION param) ::= (ref EXCEPTION param)     is action "ENU_CREATE";
const proc: (ref EXCEPTION param) ::= enumlit                   is action "ENU_GENLIT";
const proc: (inout EXCEPTION param) := (ref EXCEPTION param)    is action "ENU_CPY";

const EXCEPTION: MEMORY_ERROR   is enumlit;
const EXCEPTION: NUMERIC_ERROR  is enumlit;
const EXCEPTION: RANGE_ERROR    is enumlit;
const EXCEPTION: FILE_ERROR     is enumlit;
const EXCEPTION: ILLEGAL_ACTION is enumlit;

$ system "memory_error"   is MEMORY_ERROR;
$ system "numeric_error"  is NUMERIC_ERROR;
$ system "range_error"    is RANGE_ERROR;
$ system "file_error"     is FILE_ERROR;
$ system "illegal_action" is ILLEGAL_ACTION;

const proc: raise (ref EXCEPTION param)     is action "PRC_RAISE";

const func string: str (in ACTION param)    is action "ACT_STR";

const ACTION: DYNAMIC is action "PRC_DYNAMIC";


const proc: exit (in integer param)         is action "PRC_EXIT";
const proc: exit (PROGRAM) is func
  begin
    exit(0);
  end func;

const proc: TRACE_OPTIONS (in string param) is action "PRC_SETTRACE";
const proc: TRACE_OBJ (in object param)     is action "REF_TRACE";
const proc: TRACE_PROC (in proc param)      is action "REF_TRACE";
const proc: DECLS                           is action "PRC_DECLS";


(* boolean *)

const type: boolean is subtype ENUMERATION;
IN_PARAM_IS_VALUE(boolean);

const proc: (ref boolean param) ::= (in boolean param)   is action "BLN_CREATE";
const proc: destroy (ref boolean param)                  is noop;
const proc: (inout boolean param) := (in boolean param)  is action "BLN_CPY";

const boolean: FALSE is enumlit;
const boolean: TRUE is enumlit;

$ system "true" is TRUE;
$ system "false" is FALSE;

const boolean: (attr boolean) . value is FALSE;
const boolean: (attr boolean) . first is FALSE;
const boolean: (attr boolean) . last  is TRUE;

const func boolean: not (in boolean param) is action "BLN_NOT";

const func boolean: (in boolean param) and (in func boolean param)    is action "BLN_AND";
const func boolean: (in boolean param) and (in varfunc boolean param) is action "BLN_AND";
const func boolean: (in boolean param) and (in boolean param)         is action "BLN_AND";
const func boolean: (in boolean param) or (in func boolean param)     is action "BLN_OR";
const func boolean: (in boolean param) or (in varfunc boolean param)  is action "BLN_OR";
const func boolean: (in boolean param) or (in boolean param)          is action "BLN_OR";

const func boolean: (in boolean param) = (in boolean param)           is action "ENU_EQ";
const func boolean: (in boolean param) < (in boolean param)           is action "BLN_LT";
const func boolean: (in boolean param) > (in boolean param)           is action "BLN_GT";
const func boolean: (in boolean param) <= (in boolean param)          is action "BLN_LE";
const func boolean: (in boolean param) >= (in boolean param)          is action "BLN_GE";
const func boolean: (in boolean param) <> (in boolean param)          is action "ENU_NE";

const func integer: hashCode (in boolean param)                       is action "BLN_ORD";
const func integer: ord (in boolean param)                            is action "BLN_ORD";
const func boolean: (attr boolean) conv (in integer param)            is action "BLN_ICONV";
const varfunc boolean: (attr boolean) varConv (inout integer param)   is action "TYP_VARCONV";


const boolean: succ (FALSE) is TRUE;
const boolean: pred (TRUE) is  FALSE;

const func boolean: succ(ref boolean param) is DYNAMIC;
const func boolean: pred(ref boolean param) is DYNAMIC;

const proc: incr (inout boolean: bool_value) is func
  begin
    bool_value := succ(bool_value);
  end func;

const proc: decr (inout boolean: bool_value) is func
  begin
    bool_value := pred(bool_value);
  end func;

(*
const func boolean: not (attr TRUE) is          FALSE;
const func boolean: not (attr FALSE) is         TRUE;

const func boolean: (attr FALSE) and (func boolean) is FALSE;
const func boolean: (attr FALSE) and boolean is        FALSE;
const func boolean: (attr FALSE) or (attr FALSE) is    FALSE;
const func boolean: (attr FALSE) or (attr TRUE) is     TRUE;
const func boolean: (attr FALSE) = (attr FALSE) is     TRUE;
const func boolean: (attr FALSE) = (attr TRUE) is      FALSE;
const func boolean: (attr FALSE) < (attr FALSE) is     FALSE;
const func boolean: (attr FALSE) < (attr TRUE) is      TRUE;
const func boolean: (attr FALSE) > boolean is          FALSE;
const func boolean: (attr FALSE) <= boolean is         TRUE;
const func boolean: (attr FALSE) >= (attr FALSE) is    TRUE;
const func boolean: (attr FALSE) >= (attr TRUE) is     FALSE;
const func boolean: (attr FALSE) <> (attr FALSE) is    FALSE;
const func boolean: (attr FALSE) <> (attr TRUE) is     TRUE;

const integer: ord (attr FALSE) is       0;
const func boolean: succ (attr FALSE) is TRUE;
const EXCEPTION: pred (attr FALSE) is    RANGE_ERROR;
const string: str (attr FALSE) is        "FALSE";

const func boolean: (attr TRUE) and (attr FALSE) is    FALSE;
const func boolean: (attr TRUE) and (attr TRUE) is     TRUE;
const func boolean: (attr TRUE) or (func boolean) is   TRUE;
const func boolean: (attr TRUE) or boolean is          TRUE;
const func boolean: (attr TRUE) = (attr FALSE) is      FALSE;
const func boolean: (attr TRUE) = (attr TRUE) is       TRUE;
const func boolean: (attr TRUE) < boolean is           FALSE;
const func boolean: (attr TRUE) > (attr FALSE) is      TRUE;
const func boolean: (attr TRUE) > (attr TRUE) is       FALSE;
const func boolean: (attr TRUE) <= (attr FALSE) is     FALSE;
const func boolean: (attr TRUE) <= (attr TRUE) is      TRUE;
const func boolean: (attr TRUE) >= boolean is          TRUE;
const func boolean: (attr TRUE) <> (attr FALSE) is     TRUE;
const func boolean: (attr TRUE) <> (attr TRUE) is      FALSE;

const integer: ord (attr TRUE) is        1;
const EXCEPTION: succ (attr TRUE) is     RANGE_ERROR;
const func boolean: pred (attr TRUE) is  FALSE;
const string: str (attr TRUE) is         "TRUE";
*)

const type: (attr type) . value is void;
const func boolean: (in type param) = (in type param)      is action "TYP_EQ";
const func boolean: (in type param) <> (in type param)     is action "TYP_NE";
const func integer: compare (in type param, in type param) is action "TYP_CMP";
const func integer: hashCode (in type param)               is action "TYP_HASHCODE";
const func boolean: is_func (in type param)                is action "TYP_ISFUNC";
const func boolean: is_varfunc (in type param)             is action "TYP_ISVARFUNC";
const func type: result_type (in type param)               is action "TYP_RESULT";
const func boolean: is_derived (in type param)             is action "TYP_ISDERIVED";
const func type: meta (in type param)                      is action "TYP_META";
const proc: addInterface (in type param, in type param)    is action "TYP_ADDINTERFACE";


(* IF *)

const type: ELSIF_RESULT is newtype;
const proc: (ref ELSIF_RESULT param) ::= enumlit is  action "ENU_GENLIT";
const ELSIF_RESULT: ELSIF_EMPTY is enumlit;
const type: ELSIF_PROC is                            func ELSIF_RESULT;
# IN_PARAM_IS_REFERENCE(ELSIF_PROC);
const proc: (ref ELSIF_PROC param) ::= (ref ELSIF_RESULT param) is action "ENU_CREATE";

const proc:       if (in boolean param) then
                    (in proc param)
                  end if is                          action "PRC_IF";
const proc:       if (in boolean param) then
                    (in proc param)
                  (in ELSIF_PROC param)
                  end if is                          action "PRC_IF_ELSIF";
const ELSIF_PROC: elsif (in boolean param) then
                    (in proc param) is               action "PRC_IF";
const ELSIF_PROC: elsif (in boolean param) then
                    (in proc param)
                  (in ELSIF_PROC param) is           action "PRC_IF_ELSIF";
const ELSIF_PROC: else
                    (in void param) is               ELSIF_EMPTY;

(*
const proc: if TRUE  then (in void param) end if is                           noop;
const proc: if TRUE  then (in void param) (in ELSIF_PROC param) end if is     noop;
const proc: if FALSE then (in proc param) end if is                           noop;
const proc: if FALSE then (in proc param) (in ELSIF_RESULT param) end if is   noop;
const ELSIF_PROC: elsif TRUE  then (in void param) is                         ELSIF_EMPTY;
const ELSIF_PROC: elsif TRUE then (in void param) (in ELSIF_PROC param)   is  ELSIF_EMPTY;
const ELSIF_PROC: elsif FALSE then (in proc param) is                         ELSIF_EMPTY;
const ELSIF_PROC: elsif FALSE then (in proc param) (in ELSIF_RESULT param) is ELSIF_EMPTY;
*)


(* WHILE + REPEAT *)

const proc: while (in func boolean param) do (in proc param) end while is     action "PRC_WHILE";
const proc: while (in varfunc boolean param) do (in proc param) end while is  action "PRC_WHILE";
const proc: while (ref boolean param)  do (in proc param) end while is        action "PRC_WHILE";

const proc: repeat (in proc param) until (in func boolean param) is           action "PRC_REPEAT";
const proc: repeat (in proc param) until (in varfunc boolean param) is        action "PRC_REPEAT";
const proc: repeat (in proc param) until (ref boolean param) is               action "PRC_REPEAT";

const proc: global (in proc param) end global is                              action "DCL_GLOBAL";


(* integer *)

const integer: (attr integer) . value is 0;

const func integer: + (in integer param)                         is action "INT_PLUS";
const func integer: - (in integer param)                         is action "INT_MINUS";
const func integer: ! (in integer param)                         is action "INT_FACT";

const proc: (inout integer param) := (in integer param)          is action "INT_CPY";
const proc: (inout integer param) +:= (in integer param)         is action "INT_GROW";
const proc: (inout integer param) -:= (in integer param)         is action "INT_SHRINK";
const proc: (inout integer param) *:= (in integer param)         is action "INT_MULT_ASSIGN";
const proc: (inout integer param) <<:= (in integer param)        is action "INT_LSHIFT_ASSIGN";
const proc: (inout integer param) >>:= (in integer param)        is action "INT_RSHIFT_ASSIGN";
const func integer: (in integer param) + (in integer param)      is action "INT_ADD";
const func integer: (in integer param) - (in integer param)      is action "INT_SBTR";
const func integer: (in integer param) * (in integer param)      is action "INT_MULT";
const func integer: (in integer param) div (in integer param)    is action "INT_DIV";
const func integer: (in integer param) rem (in integer param)    is action "INT_REM";
const func integer: (in integer param) mdiv (in integer param)   is action "INT_MDIV";
const func integer: (in integer param) mod (in integer param)    is action "INT_MOD";
const func integer: (in integer param) ** (in integer param)     is action "INT_POW";
const func integer: (in integer param) << (in integer param)     is action "INT_LSHIFT";
const func integer: (in integer param) >> (in integer param)     is action "INT_RSHIFT";
const func integer: (in integer param) ! (in integer param)      is action "INT_BINOM";
const func boolean: (in integer param) = (in integer param)      is action "INT_EQ";
const func boolean: (in integer param) < (in integer param)      is action "INT_LT";
const func boolean: (in integer param) > (in integer param)      is action "INT_GT";
const func boolean: (in integer param) <= (in integer param)     is action "INT_LE";
const func boolean: (in integer param) >= (in integer param)     is action "INT_GE";
const func boolean: (in integer param) <> (in integer param)     is action "INT_NE";
const func integer: compare (in integer param, in integer param) is action "INT_CMP";
const func integer: hashCode (in integer param)                  is action "INT_HASHCODE";

const func integer: succ (in integer param)                      is action "INT_SUCC";
const func integer: pred (in integer param)                      is action "INT_PRED";
const func integer: abs (in integer param)                       is action "INT_ABS";
const func integer: sqrt (in integer param)                      is action "INT_SQRT";
const func integer: log2 (in integer param)                      is action "INT_LOG2";
const func boolean: odd (in integer param)                       is action "INT_ODD";
const func integer: ord (in integer param)                       is action "INT_ORD";
const func integer: (attr integer) conv (in integer param)       is action "INT_CONV";
const func string: str (in integer param)                        is action "INT_STR";
const func string: literal (in integer param)                    is action "INT_STR";
const func string: str (in integer param, in integer param)      is action "INT_STR_BASED";
const func string: (in integer param) lpad0 (in integer param)   is action "INT_LPAD0";
const proc: incr (inout integer param)                           is action "INT_INCR";
const proc: decr (inout integer param)                           is action "INT_DECR";

const func integer: rand (in integer param, in integer param)    is action "INT_RAND";
const func integer: bitLength (in integer param)                 is action "INT_BIT_LENGTH";
const func integer: lowestSetBit (in integer param)              is action "INT_LOWEST_SET_BIT";
const func integer: (attr integer) parse (in string param)       is action "INT_PARSE";

const func boolean: rand (in boolean: low, in boolean: high) is
  return odd(rand(ord(low), ord(high)));

const func integer: compare (in boolean: aBoolean1, in boolean: aBoolean2) is
  return compare(ord(aBoolean1), ord(aBoolean2));


(* char *)

const char: (attr char) . value is ' ';
const char: (attr char) . first is '\0\';
const char: (attr char) . last is  '\512\';

const proc: (inout char param) := (in char param)             is action "CHR_CPY";
const func boolean: (in char param) = (in char param)         is action "CHR_EQ";
const func boolean: (in char param) < (in char param)         is action "CHR_LT";
const func boolean: (in char param) > (in char param)         is action "CHR_GT";
const func boolean: (in char param) <= (in char param)        is action "CHR_LE";
const func boolean: (in char param) >= (in char param)        is action "CHR_GE";
const func boolean: (in char param) <> (in char param)        is action "CHR_NE";
const func integer: compare (in char param, in char param)    is action "CHR_CMP";
const func integer: hashCode (in char param)                  is action "CHR_HASHCODE";

const func integer: ord (in char param)                       is action "CHR_ORD";
const func char: (attr char) conv (in integer param)          is action "CHR_ICONV";
const varfunc char: (attr char) varConv (inout integer param) is action "TYP_VARCONV";
const func char: chr (in integer param)                       is action "CHR_CHR";
const func char: succ (in char param)                         is action "CHR_SUCC";
const func char: pred (in char param)                         is action "CHR_PRED";
const func string: str (in char param)                        is action "CHR_STR";
const func char: lower (in char param)                        is action "CHR_LOW";
const func char: upper (in char param)                        is action "CHR_UP";
const proc: incr (inout char param)                           is action "CHR_INCR";
const proc: decr (inout char param)                           is action "CHR_DECR";
const func string: c_literal (in char: ch)                    is action "CHR_CLIT";

const func char: rand (in char: low, in char: high) is
  return chr(rand(ord(low), ord(high)));

(* Procedures literal and c_literal defined after string *)

(* Procedure read defined after operations for IN and OUT *)


(* string *)

const string: (attr string) . value is "";

const func string: (in string param) mult (in integer param)   is action "STR_MULT";

const proc: (inout string param) := (in string param)          is action "STR_CPY";
const proc: (inout string param) &:= (in string param)         is action "STR_APPEND";
const proc: (inout string param) &:= (in char param)           is action "STR_PUSH";
const proc: (inout string param) @:= [ (in integer param) ] (in char param) is action "STR_ELEMCPY";
const func string: (in string param) lpad (in integer param)   is action "STR_LPAD";
const func string: (in string param) lpad0 (in integer param)  is action "STR_LPAD0";
const func string: (in string param) rpad (in integer param)   is action "STR_RPAD";
const func string: (in string param) <& (in string param)      is action "STR_CAT";
const func char: (in string param) [ (in integer param) ]      is action "STR_IDX";
const func string: (in string param) [ (in integer param) .. ] is action "STR_TAIL";
const func string: (in string param) [ .. (in integer param) ] is action "STR_HEAD";
const func string: (in string param) [ (in integer param) ..
                                       (in integer param) ]    is action "STR_RANGE";
const func string: (in string param) [ (in integer param) len
                                       (in integer param) ]    is action "STR_SUBSTR";
const func boolean: (in string param) = (in string param)      is action "STR_EQ";
const func boolean: (in string param) < (in string param)      is action "STR_LT";
const func boolean: (in string param) > (in string param)      is action "STR_GT";
const func boolean: (in string param) <= (in string param)     is action "STR_LE";
const func boolean: (in string param) >= (in string param)     is action "STR_GE";
const func boolean: (in string param) <> (in string param)     is action "STR_NE";
const func integer: compare (in string param, in string param) is action "STR_CMP";
const func integer: hashCode (in string param)                 is action "STR_HASHCODE";

const func integer: length (in string param)                   is action "STR_LNG";
const func integer: pos (in string param, in string param)     is action "STR_POS";
const func integer: pos (in string param, in char param)       is action "STR_CHPOS";
const func integer: pos (in string param, in string param,
                         in integer param)                     is action "STR_IPOS";
const func integer: pos (in string param, in char param,
                         in integer param)                     is action "STR_CHIPOS";
const func integer: rpos (in string param, in string param)    is action "STR_RPOS";
const func integer: rpos (in string param, in char param)      is action "STR_RCHPOS";
const func integer: rpos (in string param, in char param,
                          in integer param)                    is action "STR_RCHIPOS";
(* const proc: count (in string param, in string param)        is action "STR_CNT"; *)
const func string: replace (in string param, in string param, in string param) is action "STR_REPL";
const func string: upper (in string param)                     is action "STR_UP";
const func string: lower (in string param)                     is action "STR_LOW";
const func string: trim (in string param)                      is action "STR_TRIM";
const func string: striToUtf8 (in string param)                is action "STR_TOUTF8";
const func string: utf8ToStri (in string param)                is action "STR_UTF8TOSTRI";
const func string: str (in string param)                       is action "STR_STR";
const func string: literal (in string param)                   is action "STR_LIT";
const func string: c_literal (in string param)                 is action "STR_CLIT";

const func string: replace2 (in string: main_stri, in string: search1,
    in string: search2, in string: repl_stri) is func
  result
    var string: result is "";
  local
    var integer: start_pos is 0;
    var integer: end_pos is 0;
  begin
    result := main_stri;
    start_pos := pos(result, search1);
    while start_pos <> 0 do
      end_pos := pos(result, search2, start_pos + length(search1));
      if end_pos <> 0 then
        end_pos +:= length(search2);
        result := result[ .. pred(start_pos)] &
            repl_stri & result[end_pos .. ];
        end_pos := start_pos + length(repl_stri);
        start_pos := pos(result, search1, end_pos);
      else
        start_pos := 0;
      end if;
    end while;
  end func;

const func boolean: startsWith (in string: stri, in string: prefix) is
  return stri[.. length(prefix)] = prefix;

const func boolean: startsWith (in string: stri, in string: prefix, in integer: index) is
  return stri[index len length(prefix)] = prefix;

const func boolean: endsWith (in string: stri, in string: suffix) is
  return stri[succ(length(stri) - length(suffix)) ..] = suffix;

const func string: getint (inout string: stri) is func
  result
    var string: result is "";
  local
    var integer: leng is 0;
    var integer: pos is 1;
  begin
    leng := length(stri);
    while pos <= leng and stri[pos] >= '0' and stri[pos] <= '9' do
      incr(pos);
    end while;
    result := stri[.. pred(pos)];
    stri := stri[pos ..];
  end func;

const func string: gets (inout string: stri, in integer: leng) is func
  result
    var string: result is "";
  begin
    result := stri[.. leng];
    stri := stri[succ(leng) ..];
  end func;

const func string: (attr string) parse (in string: stri) is func
  result
    var string: result is "";
  begin
    result := stri;
  end func;

const func char: (attr char) parse (in string: stri) is
  return stri[1];

const func boolean: (attr boolean) parse (in string: stri) is func
  result
    var boolean: result is FALSE;
  begin
    if stri = "TRUE" then
      result := TRUE;
    elsif stri = "FALSE" then
      result := FALSE;
    else
      raise RANGE_ERROR;
    end if;
  end func;

const func string: str (in boolean: aBool) is func
  result
    var string: result is "";
  begin
    if aBool then
      result := "TRUE";
    else
      result := "FALSE";
    end if;
  end func;

(* Procedure literal from char *)

const func string: literal (in char: ch) is func
  result
    var string: result is "";
  begin
    if ch = ''' then
      result := "'\\''";
    elsif ch <= chr(255) then
      result := literal(str(ch));
      result := "'" & result[2 .. length(result) - 1] & "'";
    else
      result := "'\\" & str(ord(ch)) & "\\'";
    end if;
  end func;


(* REFERENCE *)

const type: reference is subtype object;
IN_PARAM_IS_VALUE(reference);

const proc: (ref reference param) ::= (in reference param) is           action "REF_CREATE";
const proc: destroy (ref reference param) is                            noop;
const proc: (inout reference param) := (in reference param) is          action "REF_CPY";
(* Deactivated since it allows 'reference' := anything which is aggainst type checking *)
(* const proc: (inout reference param) := (in object param) is           action "REF_MKREF"; *)
const func boolean: (in reference param) = (in reference param) is      action "REF_EQ";
const func boolean: (in reference param) <> (in reference param) is     action "REF_NE";
const func integer: compare (in reference param, in reference param) is action "REF_CMP";
const func integer: hashCode (in reference param) is                    action "REF_HASHCODE";
const func string: str (ref reference param) is                         action "REF_STR";

const func reference: _GENERATE_NIL is                                  action "REF_NIL";
const reference: NIL is                                                 _GENERATE_NIL;
const reference: (attr reference) . value is                            NIL;

const func type: getType (in reference param) is                        action "REF_TYPE";
const proc: setType (in reference param, in type param) is              action "REF_SETTYPE";
const func boolean: is_symb (in reference param) is                     action "REF_ISSYMB";
const func f_param: symb (in reference param) is                        action "REF_SYMB";
const func type: getValue (in reference param, attr type) is            action "TYP_VALUE";
const func reference: getfunc (in expr param) is                        action "DCL_GETFUNC";
const func reference: getobj (in expr param) is                         action "DCL_GETOBJ";

const proc: TRACE_REF (in reference param) is  action "REF_TRACE";

const func type: get_type (in reference: type_ref) is func
  result
    var type: result is void;
  begin
    if type_ref <> NIL and getType(type_ref) = type then
      result := getValue(type_ref, type);
    end if;
  end func;


(* REF_LIST *)

const type: ref_list is subtype object;
IN_PARAM_IS_REFERENCE(ref_list);

const proc: (ref ref_list param) ::= (in ref_list param) is              action "RFL_CREATE";
const proc: destroy (ref ref_list param) is                              action "RFL_DESTR";
const proc: (inout ref_list param) := (in ref_list param) is             action "RFL_CPY";
const proc: (inout ref_list param) &:= (in ref_list param) is            action "RFL_APPEND";
const proc: (inout ref_list param) @:= [ (in integer param) ] (in reference param) is action "RFL_ELEMCPY";

const func ref_list: _GENERATE_EMPTY_REFLIST is                          action "RFL_EMPTY";
const ref_list: (attr ref_list) . EMPTY is                               _GENERATE_EMPTY_REFLIST;
const ref_list: (attr ref_list) . value is                               ref_list.EMPTY;

const func ref_list: make_list (in reference param) is                   action "RFL_MKLIST";

const func boolean: (in ref_list param) = (in ref_list param) is         action "RFL_EQ";
const func boolean: (in ref_list param) <> (in ref_list param) is        action "RFL_NE";

const func reference: (in ref_list param) [ (in integer param) ] is      action "RFL_IDX";
const func ref_list: (in ref_list param) [ (in integer param) .. ] is    action "RFL_TAIL";
const func ref_list: (in ref_list param) [ .. (in integer param) ] is    action "RFL_HEAD";
const func ref_list: (in ref_list param) [ (in integer param) ..
                                           (in integer param) ] is       action "RFL_RANGE";
const func ref_list: (in ref_list param) & (in ref_list param) is        action "RFL_CAT";

const func boolean: (in reference param) in (in ref_list param) is       action "RFL_ELEM";
const func boolean: (in reference param) not in (in ref_list param) is   action "RFL_NOT_ELEM";
const func integer: pos (in ref_list param, in reference param) is       action "RFL_POS";
const func integer: pos (in ref_list param, in reference param,
                         in integer param) is                            action "RFL_IPOS";
const proc: incl (in ref_list param, in reference param) is              action "RFL_INCL";
const proc: excl (in ref_list param, in reference param) is              action "RFL_EXCL";
const func integer: length (in ref_list param) is                        action "RFL_LNG";

const proc: TRACE_LIST (in ref_list param) is                            action "RFL_TRACE";

const proc: for (inout reference param) range (ref ref_list param) do
              (ref proc param)
            end for                                                   is action "RFL_FOR";
const proc: for (inout reference param) range (ref ref_list param) until (in func boolean param) do
              (ref proc param)
            end for                                                   is action "RFL_FOR_UNTIL";
const proc: for (inout reference param) range (ref ref_list param) until (in varfunc boolean param) do
              (ref proc param)
            end for                                                   is action "RFL_FOR_UNTIL";
const proc: for (inout reference param) range (ref ref_list param) until (ref boolean param) do
              (ref proc param)
            end for                                                   is action "RFL_FOR_UNTIL";


(* POINTER *)

var type: CURR_STRUCT_PTR is void;
var type: FORWARD_PTR is void;

const func boolean: is_declared (in type param) is                    action "TYP_ISDECLARED";
const func boolean: is_forward (in type param) is                     action "TYP_ISFORWARD";

const func type: forward_ptr (ref expr: baseTypeName) is func
  result
    var type: ptrType is void;
  begin
    PRINT("forward_ptr\n");
(*
    TRACE(baseTypeName);
*)
    const type: baseTypeName is forward;
    ptrType := newtype;
    FORWARD_PTR := ptrType;
    IN_PARAM_IS_VALUE(ptrType);
    const proc: (ref ptrType param) ::= (in ptrType param) is         action "REF_CREATE";
    const proc: destroy (ref ptrType param) is                        noop;
    const proc: (inout ptrType param) := (in ptrType param) is        action "REF_CPY";
    const func boolean: (in ptrType param) = (in ptrType param) is    action "REF_EQ";
    const func boolean: (in ptrType param) <> (in ptrType param) is   action "REF_NE";
    const func ptrType: (attr ptrType) conv (in reference param) is   action "REF_CONV";
    const func reference: (attr reference) conv (in ptrType param) is action "REF_CONV";
    const ptrType: (attr ptrType) . NIL is                            ptrType conv NIL;
    const ptrType: (attr ptrType) . value is                          ptrType.NIL;
  end func;


const proc: finish_ptr (in type: baseType, in type: ptrType) is func
  begin
    if FORWARD_PTR <> void then
      PRINT("finish_ptr\n");
      FORWARD_PTR := void;
      const type: ptr (attr baseType) is                              ptrType;
      const type: base_type (attr ptrType) is                         baseType;
      const func ptrType: & (in baseType param) is                    action "REF_ADDR";
      const func baseType: (in ptrType param) ^ is                    action "REF_DEREF";
    end if;
  end func;


const func type: ptr (in type: baseType) is func
  result
    var type: ptrType is void;
  begin
    if FORWARD_PTR <> void then
      if is_declared(baseType) then
        PRINT("declared\n");
       elsif is_forward(baseType) then
        PRINT("forward\n");
      else
        PRINT("undeclared\n");
      end if;
      ptrType := FORWARD_PTR;
      finish_ptr(baseType, ptrType);
    else
      if is_declared(baseType) then
        PRINT("declared\n");
        ptrType := CURR_STRUCT_PTR;
      elsif is_forward(baseType) then
        PRINT("forward\n");
      else
        ptrType := get_type(getobj(ptr (attr baseType)));
      end if;
    end if;
    if ptrType = void then
      global
      ptrType := newtype;
      IN_PARAM_IS_VALUE(ptrType);
      const type: ptr (attr baseType) is                                ptrType;
      const type: base_type (attr ptrType) is                           baseType;
      const proc: (ref ptrType param) ::= (in ptrType param) is         action "REF_CREATE";
      const proc: destroy (ref ptrType param) is                        noop;
      const proc: (inout ptrType param) := (in ptrType param) is        action "REF_CPY";
      const func boolean: (in ptrType param) = (in ptrType param) is    action "REF_EQ";
      const func boolean: (in ptrType param) <> (in ptrType param) is   action "REF_NE";
      const func ptrType: & (in baseType param) is                      action "REF_ADDR";
      const func baseType: (in ptrType param) ^ is                      action "REF_DEREF";
      const func ptrType: (attr ptrType) conv (in reference param) is   action "REF_CONV";
      const func reference: (attr reference) conv (in ptrType param) is action "REF_CONV";
      const ptrType: (attr ptrType) . NIL is                            ptrType conv NIL;
      const ptrType: (attr ptrType) . value is                          ptrType.NIL;
      end global;
    end if;
  end func;


const func type: varptr (in type: baseType) is func
  result
    var type: varptrType is void;
  begin
    varptrType := get_type(getobj(varptr (attr baseType)));
    if varptrType = void then
      global
      varptrType := newtype;
      IN_PARAM_IS_VALUE(varptrType);
      const type: varptr (attr baseType) is                                 varptrType;
      const type: base_type (attr varptrType) is                            baseType;
      const proc: (ref varptrType param) ::= (in varptrType param) is       action "REF_CREATE";
      const proc: destroy (ref varptrType param) is                         noop;
      const proc: (inout varptrType param) := (in varptrType param) is      action "REF_CPY";
      const func boolean: (in varptrType param) = (in varptrType param) is  action "REF_EQ";
      const func boolean: (in varptrType param) <> (in varptrType param) is action "REF_NE";
      const func varptrType: & (inout baseType param) is                    action "REF_ADDR";
      const varfunc baseType: (in varptrType param) ^ is                    action "REF_DEREF";
      const func varptrType: (attr varptrType) conv (in reference param) is action "REF_CONV";
      const func reference: (attr reference) conv (in varptrType param) is  action "REF_CONV";
      const varptrType: (attr varptrType) . NIL is                          varptrType conv NIL;
      const varptrType: (attr varptrType) . value is                        varptrType.NIL;
      end global;
    end if;
  end func;


(* FOR *)

const proc: for (inout integer param) range (in integer param) to (in integer param) do
              (in proc param)
            end for is                                                      action "PRC_FOR_TO";
const proc: for (inout integer param) range (in integer param) downto (in integer param) do
              (in proc param)
            end for is                                                      action "PRC_FOR_DOWNTO";

const proc: FOR_STEP_DECLS (in type: aType) is func
  begin
    if getobj((inout aType param) +:= (in integer param)) <> NIL then

      const proc: for (inout aType: variable) range (in aType: lower_limit) to (in aType: upper_limit)
          step (in integer: incr_step) do
          (in proc: statements) end for is func
        begin
          variable := lower_limit;
          while variable <= upper_limit do
            statements;
            variable +:= incr_step;
          end while;
        end func;

    end if;
    if getobj((inout aType param) -:= (in integer param)) <> NIL then

      const proc: for (inout aType: variable) range (in aType: upper_limit) downto (in aType: lower_limit)
          step (in integer: decr_step) do
          (in proc: statements) end for is func
        begin
          variable := upper_limit;
          while variable >= lower_limit do
            statements;
            variable -:= decr_step;
          end while;
        end func;

    end if;
  end func;

const proc: FOR_DECLS (in type: aType) is func
  begin

    const proc: for (inout aType: variable) range (in aType: lower_limit) to (in aType: upper_limit) do
        (in proc: statements) end for is func
      begin
        variable := lower_limit;
        if variable <= upper_limit then
          statements;
          while variable < upper_limit do
            incr(variable);
            statements;
          end while;
        end if;
      end func;

    const proc: for (inout aType: variable) range (in aType: upper_limit) downto (in aType: lower_limit) do
        (in proc: statements) end for is func
      begin
        variable := upper_limit;
        if variable >= lower_limit then
          statements;
          while variable > lower_limit do
            decr(variable);
            statements;
          end while;
        end if;
      end func;

    FOR_STEP_DECLS(aType);
  end func;

FOR_STEP_DECLS(integer);
FOR_DECLS(char);
FOR_DECLS(boolean);

const proc: for (inout char: variable) range (in string: stri) do
              (in proc: statements)
            end for is func
  local
    var integer: number is 0;
  begin
    for number range 1 to length(stri) do
      variable := stri[number];
      statements;
    end for;
  end func;


(* STRUCT *)

const type: STRUCT is newtype;
IN_PARAM_IS_REFERENCE(STRUCT);
const proc: (ref STRUCT param) ::= (in STRUCT param) is                         action "SCT_CREATE";
const proc: destroy (ref STRUCT param) is                                       action "SCT_DESTR";
const proc: (inout STRUCT param) := (in STRUCT param) is                        action "SCT_CPY";
const func integer: length (in STRUCT param) is                                 action "SCT_LNG";
(* const func STRUCT: elem (in type param) : (in expr param) is (in expr param) is action "SCT_ELEM"; *)
const func STRUCT: (in STRUCT param) & (in STRUCT param) is                     action "SCT_CAT";
const proc: incl (inout STRUCT param, in reference param) is                    action "SCT_INCL";
const func STRUCT: empty (attr STRUCT) is                                       action "SCT_EMPTY";

(* const func reference: (in STRUCT param) [ (in integer param) ] is               action "SCT_REFIDX"; *)

const func ref_list: declare_elements (ref proc param) is                       action "DCL_ELEMENTS";

(*
const proc: (attr integer) <- ( (in integer param) ) is noop;
integer<-(1);
*)

const func type: new struct (ref proc: elem_decl) end struct is func
  result
    var type: structType is void;
  local
    var type: ptrType is void;
    var type: varptrType is void;
    var ref_list: elem_list is ref_list.EMPTY;
    var STRUCT: struct_value is empty(STRUCT);
    var integer: number is 0;
    var reference: elem_obj is NIL;
  begin
    structType := newtype;
    IN_PARAM_IS_REFERENCE(structType);
    ptrType := ptr structType;
    CURR_STRUCT_PTR := ptrType;
    varptrType := varptr structType;
    elem_list := declare_elements(elem_decl);
    const proc: (ref structType param) ::= (in structType param) is    action "SCT_CREATE";
    const proc: destroy (ref structType param) is                      action "SCT_DESTR";
    const proc: (inout structType param) := (in structType param) is   action "SCT_CPY";
    const func ptrType: alloc (in structType param) is                 action "SCT_ALLOC";
    const func varptrType: varalloc (in structType param) is           action "SCT_ALLOC";
    const func structType: (attr structType) conv (in STRUCT param) is action "SCT_CONV";
    const func STRUCT: (attr STRUCT) conv (in structType param) is     action "SCT_CONV";
    for number range 1 to length(elem_list) do
      elem_obj := elem_list[number];
      if is_symb(elem_obj) then
        (* TRACE(elem_obj); PRINT("\n"); *)
        incl(struct_value, elem_obj);
        const func    getType(elem_obj):    (in structType param) .  (symb elem_obj) is action "SCT_SELECT";
        const varfunc getType(elem_obj): (inout structType param) .  (symb elem_obj) is action "SCT_SELECT";
        const func    getType(elem_obj):    (in ptrType    param) -> (symb elem_obj) is action "REF_SELECT";
        const varfunc getType(elem_obj):    (in varptrType param) -> (symb elem_obj) is action "REF_SELECT";
      end if;
    end for;
    const structType: (attr structType) . value is                     structType conv struct_value;
  end func;

const func type: new struct end struct is func
  result
    var type: structType is void;
  local
    var type: ptrType is void;
    var type: varptrType is void;
  begin
    structType := newtype;
    IN_PARAM_IS_REFERENCE(structType);
    ptrType := ptr structType;
    varptrType := varptr structType;
    const proc: (ref structType param) ::= (in structType param) is    action "SCT_CREATE";
    const proc: destroy (ref structType param) is                      action "SCT_DESTR";
    const proc: (inout structType param) := (in structType param) is   action "SCT_CPY";
    const func ptrType: alloc (in structType param) is                 action "SCT_ALLOC";
    const func varptrType: varalloc (in structType param) is           action "SCT_ALLOC";
    const func structType: (attr structType) conv (in STRUCT param) is action "SCT_CONV";
    const func STRUCT: (attr STRUCT) conv (in structType param) is     action "SCT_CONV";
    const structType: (attr structType) . value is                     structType conv empty(STRUCT);
  end func;

const func type: new (in type: baseType) struct (ref proc: elem_decl) end struct is func
  result
    var type: structType is void;
  local
    var type: ptrType is void;
    var type: varptrType is void;
    var ref_list: elem_list is ref_list.EMPTY;
    var STRUCT: struct_value is empty(STRUCT);
    var integer: number is 0;
    var reference: elem_obj is NIL;
  begin
    structType := subtype baseType;
    IN_PARAM_IS_REFERENCE(structType);
    ptrType := ptr structType;
    varptrType := varptr structType;
    elem_list := declare_elements(elem_decl);
    const proc: (ref structType param) ::= (in structType param) is    action "SCT_CREATE";
    const proc: destroy (ref structType param) is                      action "SCT_DESTR";
    const proc: (inout structType param) := (in structType param) is   action "SCT_CPY";
    const func ptrType: alloc (in structType param) is                 action "SCT_ALLOC";
    const func varptrType: varalloc (in structType param) is           action "SCT_ALLOC";
    const func structType: (attr structType) conv (in STRUCT param) is action "SCT_CONV";
    const func STRUCT: (attr STRUCT) conv (in structType param) is     action "SCT_CONV";
    for number range 1 to length(elem_list) do
      elem_obj := elem_list[number];
      if is_symb(elem_obj) then
        incl(struct_value, elem_obj);
        const func    getType(elem_obj):    (in structType param) .  (symb elem_obj) is action "SCT_SELECT";
        const varfunc getType(elem_obj): (inout structType param) .  (symb elem_obj) is action "SCT_SELECT";
        const func    getType(elem_obj):    (in ptrType    param) -> (symb elem_obj) is action "REF_SELECT";
        const varfunc getType(elem_obj):    (in varptrType param) -> (symb elem_obj) is action "REF_SELECT";
      end if;
    end for;
    const structType: (attr structType) . value is                     structType conv struct_value;
  end func;

const func type: new (in type: baseType) struct end struct is func
  result
    var type: structType is void;
  local
    var type: ptrType is void;
    var type: varptrType is void;
  begin
    structType := subtype baseType;
    IN_PARAM_IS_REFERENCE(structType);
    ptrType := ptr structType;
    varptrType := varptr structType;
    const proc: (ref structType param) ::= (in structType param) is    action "SCT_CREATE";
    const proc: destroy (ref structType param) is                      action "SCT_DESTR";
    const proc: (inout structType param) := (in structType param) is   action "SCT_CPY";
    const func ptrType: alloc (in structType param) is                 action "SCT_ALLOC";
    const func varptrType: varalloc (in structType param) is           action "SCT_ALLOC";
    const func structType: (attr structType) conv (in STRUCT param) is action "SCT_CONV";
    const func STRUCT: (attr STRUCT) conv (in structType param) is     action "SCT_CONV";
    const structType: (attr structType) . value is                     structType conv empty(STRUCT);
  end func;

const func type: sub (in type: baseType) struct (ref proc: elem_decl) end struct is func
  result
    var type: structType is void;
  local
    var type: ptrType is void;
    var type: varptrType is void;
    var ref_list: elem_list is ref_list.EMPTY;
    var STRUCT: struct_value is empty(STRUCT);
    var integer: number is 0;
    var reference: elem_obj is NIL;
  begin
    structType := subtype baseType;
    IN_PARAM_IS_REFERENCE(structType);
    ptrType := ptr structType;
    varptrType := varptr structType;
    elem_list := declare_elements(elem_decl);
    const proc: (ref structType param) ::= (in structType param) is    action "SCT_CREATE";
    const proc: destroy (ref structType param) is                      action "SCT_DESTR";
    const proc: (inout structType param) := (in structType param) is   action "SCT_CPY";
    const func ptrType: alloc (in structType param) is                 action "SCT_ALLOC";
    const func varptrType: varalloc (in structType param) is           action "SCT_ALLOC";
    const func structType: (attr structType) conv (in STRUCT param) is action "SCT_CONV";
    const func STRUCT: (attr STRUCT) conv (in structType param) is     action "SCT_CONV";
    for number range 1 to length(elem_list) do
      elem_obj := elem_list[number];
      if is_symb(elem_obj) then
        incl(struct_value, elem_obj);
        const func    getType(elem_obj):    (in structType param) .  (symb elem_obj) is action "SCT_SELECT";
        const varfunc getType(elem_obj): (inout structType param) .  (symb elem_obj) is action "SCT_SELECT";
        const func    getType(elem_obj):    (in ptrType    param) -> (symb elem_obj) is action "REF_SELECT";
        const varfunc getType(elem_obj):    (in varptrType param) -> (symb elem_obj) is action "REF_SELECT";
      end if;
    end for;
    const structType: (attr structType) . value is      structType conv (STRUCT conv (baseType.value) & struct_value);
  end func;

const func type: sub (in type: baseType) struct end struct is func
  result
    var type: structType is void;
  local
    var type: ptrType is void;
    var type: varptrType is void;
  begin
    structType := subtype baseType;
    IN_PARAM_IS_REFERENCE(structType);
    ptrType := ptr structType;
    varptrType := varptr structType;
    const proc: (ref structType param) ::= (in structType param) is    action "SCT_CREATE";
    const proc: destroy (ref structType param) is                      action "SCT_DESTR";
    const proc: (inout structType param) := (in structType param) is   action "SCT_CPY";
    const func ptrType: alloc (in structType param) is                 action "SCT_ALLOC";
    const func varptrType: varalloc (in structType param) is           action "SCT_ALLOC";
    const func structType: (attr structType) conv (in STRUCT param) is action "SCT_CONV";
    const func STRUCT: (attr STRUCT) conv (in structType param) is     action "SCT_CONV";
    const structType: (attr structType) . value is     structType conv (STRUCT conv (baseType.value));
  end func;


(* SUBRANGE *)

const proc: SUBRANGE_TYPES (in type: baseType) is func
  begin

    const func type: subrange (in baseType: first) .. (in baseType: last) is func
      result
        var type: subrangeType is void;
      begin
        global
        subrangeType := subtype baseType;
        IN_PARAM_IS_REFERENCE(subrangeType);

        const subrangeType: (attr subrangeType) . first is first;
        const subrangeType: (attr subrangeType) . last  is last;

        if baseType.value >= first and baseType.value <= last then
          const subrangeType: (attr subrangeType) . value is baseType.value;
        else
          const subrangeType: (attr subrangeType) . value is first;
        end if;

        if baseType <> integer then
          const func subrangeType: (attr subrangeType) conv (in baseType: enum) is action "ENU_CONV";
        end if;

        const func subrangeType: (attr subrangeType) conv (in integer: number) is
          return subrangeType conv baseType conv number;

        end global;
      end func;

  end func;

SUBRANGE_TYPES(integer);
SUBRANGE_TYPES(char);
SUBRANGE_TYPES(boolean);


(* TUPLE *)

const func type: tuple (in type: baseType) is func
  result
    var type: tupleType is void;
  begin
    tupleType := get_type(getfunc(tuple (attr baseType)));
    if tupleType = void then
      global
      tupleType := newtype;
      IN_PARAM_IS_REFERENCE(tupleType);
      const type: tuple (attr baseType) is tupleType;
      const proc: (ref tupleType param) ::= (in tupleType param)         is action "ARR_CREATE";
      const proc: destroy (ref tupleType param)                          is action "ARR_DESTR";
      const func tupleType: (in baseType param) , (in baseType param)    is action "ARR_GEN";
      const func tupleType: (in tupleType param) , (in baseType param)   is action "ARR_EXTEND";
(*
      const func tupleType: (in baseType: lower_limit) .. (in baseType: upper_limit) is func
        result
          var tupleType: result is
        local
          var baseType: element is baseType.value;
       begin
          element := lower_limit;
          if variable <= upper_limit then
            result &:= element;
            while element < upper_limit then
              result &:= element;
              incr(element);
            end while;
          end if;
        end func;
*)
      end global;
    end if;
  end func;

const type: TST_1 is tuple integer;
const type: TST_2 is tuple integer;


const type: ARRAY_IDX_RANGE is new struct
    var integer: minIdx is 1;
    var integer: maxIdx is 0;
  end struct;

const func ARRAY_IDX_RANGE: [ (in integer: minIdx) .. (in integer: maxIdx) ] is func
  result
    var ARRAY_IDX_RANGE: result is ARRAY_IDX_RANGE.value;
  begin
    result.minIdx := minIdx;
    result.maxIdx := maxIdx;
  end func;


(* ARRAY *)

const func type: array (in type: baseType) is func
  result
    var type: arrayType is void;
  local
    var type: tupleType is void;
  begin
    arrayType := get_type(getfunc(array (attr baseType)));
    if arrayType = void then
      global
      arrayType := newtype;
      IN_PARAM_IS_REFERENCE(arrayType);
      tupleType := tuple(baseType);
      const type: array (attr baseType)                                       is arrayType;
      const type: base_type (attr arrayType)                                  is baseType;

      const proc: (ref arrayType param) ::= (in arrayType param)              is action "ARR_CREATE";
      const proc: destroy (ref arrayType param)                               is action "ARR_DESTR";
      const proc: (inout arrayType param) := (in arrayType param)             is action "ARR_CPY";
      const proc: (inout arrayType param) &:= (in arrayType param)            is action "ARR_APPEND";
      const proc: (inout arrayType: arr) &:= (in baseType: element)           is action "ARR_PUSH";

      const func arrayType: [] (in tupleType param)                           is action "ARR_ARRLIT";
      const func arrayType: [] (in baseType param)                            is action "ARR_BASELIT";
      const func arrayType: [ (in integer param) ] (in tupleType param)       is action "ARR_ARRLIT2";
      const func arrayType: [ (in integer param) ] (in baseType param)        is action "ARR_BASELIT2";

      const func arrayType: (in arrayType param) & (in arrayType param)       is action "ARR_CAT";
      const func baseType: (in arrayType param) [ (in integer param) ]        is action "ARR_IDX";
      const varfunc baseType: (inout arrayType param) [ (in integer param) ]  is action "ARR_IDX";
      const func arrayType: (in arrayType param) [ (in integer param) .. ]    is action "ARR_TAIL";
      const func arrayType: (in arrayType param) [ .. (in integer param) ]    is action "ARR_HEAD";
      const func arrayType: (in arrayType param) [ (in integer param) ..
                                                   (in integer param) ]       is action "ARR_RANGE";
      const func baseType: remove (inout arrayType param, in integer param)   is action "ARR_REMOVE";
      const func integer: length (in arrayType param)                         is action "ARR_LNG";
      const func integer: minIdx (in arrayType param)                         is action "ARR_MINIDX";
      const func integer: maxIdx (in arrayType param)                         is action "ARR_MAXIDX";
      const func arrayType: (in integer param) times (in baseType param)      is action "ARR_TIMES";
      const func arrayType: (attr arrayType) . _GENERATE_EMPTY_ARRAY          is action "ARR_EMPTY";
      const arrayType: (attr arrayType) . value                               is arrayType._GENERATE_EMPTY_ARRAY;

      const func tupleType: (attr tupleType) conv (in arrayType param)        is action "ARR_CONV";

      const func arrayType: (in ARRAY_IDX_RANGE: arrayIdxRange) times
          (in baseType: base_value) is func
        result
          var arrayType: result is arrayType.value;
        begin
          result := succ(arrayIdxRange.maxIdx - arrayIdxRange.minIdx) times base_value;
          result := [arrayIdxRange.minIdx] (tupleType conv result);
        end func;

      const proc: for (inout baseType: variable) range (in arrayType: arr) do
                    (in proc: statements)
                  end for is func
        local
          var integer: number is 0;
        begin
          for number range minIdx(arr) to maxIdx(arr) do
            variable := arr[number];
            statements;
          end for;
        end func;

      const proc: for key (inout integer: keyVar) range (in arrayType: arr) do
                    (in proc: statements)
                  end for is func
        begin
          for keyVar range minIdx(arr) to maxIdx(arr) do
            statements;
          end for;
        end func;

      const func baseType: rand (in arrayType: arr) is
        baseType return arr[rand(minIdx(arr), maxIdx(arr))];

      const proc: insert (inout arrayType: arr, in integer: index, in baseType: element) is func
        begin
          if index >= minIdx(arr) and index <= succ(maxIdx(arr)) then
            arr := arr[.. pred(index)] & [] (element) & arr[index ..];
          else
            raise RANGE_ERROR;
          end if;
        end func;

      if getobj((in baseType param) = (in baseType param)) <> NIL and
          getobj((in baseType param) <> (in baseType param)) <> NIL then

        const func boolean: (in arrayType: arr1) = (in arrayType: arr2) is func
          result
            var boolean: isEqual is FALSE;
          local
            var integer: number is 1;
          begin
            if minIdx(arr1) = minIdx(arr2) and maxIdx(arr1) = maxIdx(arr2) then
              isEqual := TRUE;
              number := minIdx(arr1);
              while number <= maxIdx(arr1) and isEqual do
                isEqual := arr1[number] = arr2[number];
                incr(number);
              end while;
            end if;
          end func;

        const func boolean: (in arrayType: arr1) <> (in arrayType: arr2) is func
          result
            var boolean: isNotEqual is TRUE;
          local
            var integer: number is 1;
          begin
            if minIdx(arr1) = minIdx(arr2) and maxIdx(arr1) = maxIdx(arr2) then
              isNotEqual := FALSE;
              number := minIdx(arr1);
              while number <= maxIdx(arr1) and not isNotEqual do
                isNotEqual := arr1[number] <> arr2[number];
                incr(number);
              end while;
            end if;
          end func;

      end if;

      if getobj((in baseType param) < (in baseType param)) <> NIL and
          getobj((in baseType param) > (in baseType param)) <> NIL then

        const proc: insert (inout arrayType: arr, in baseType: element) is func
          local
            var integer: number is 1;
          begin
            number := minIdx(arr);
            while number <= maxIdx(arr) and arr[number] < element do
              incr(number);
            end while;
            if number > maxIdx(arr) then
              arr := arr & [] (element);
            elsif arr[number] > element then
              arr := arr[.. pred(number)] & [] (element) & arr[number ..];
            end if;
          end func;

      end if;

      if getobj(compare(in baseType param, in baseType param)) <> NIL then

        const reference: (attr arrayType) . dataCompare  is getobj(compare(in baseType param, in baseType param));

        const func arrayType: SORT (in arrayType param, in reference param) is   action "ARR_SORT";

        const func arrayType: sort (in arrayType: arr_obj) is
          return SORT(arr_obj, arrayType.dataCompare);

      end if;
      end global;

    end if;
  end func;

const type: TEST_1 is array integer;
const type: TEST_2 is array integer;
const type: TEST_3 is array string;
(*
const type: TEST_4 is array char;
const type: TEST_5 is array boolean;
const type: TEST_6 is array array char;
const type: TEST_7 is array array string;
*)


const func type: array [ (in type: indexType) ] (in type: baseType) is func
  result
    var type: arrayType is void;
  local
    var type: stdArrayType is void;
    var type: tupleType is void;
  begin
    arrayType := get_type(getfunc(array [ (attr indexType) ] (attr baseType)));
    if arrayType = void then
      global
      arrayType := newtype;
      IN_PARAM_IS_REFERENCE(arrayType);
      stdArrayType := array baseType;
      tupleType := tuple(baseType);
      const type: array [ (attr indexType) ] (attr baseType) is                  arrayType;
      const type: base_type (attr arrayType) is                                  baseType;

      const proc: (ref arrayType param) ::= (in arrayType param) is              action "ARR_CREATE";
      const proc: destroy (ref arrayType param) is                               action "ARR_DESTR";
      const proc: (inout arrayType param) := (in arrayType param) is             action "ARR_CPY";
      const proc: (inout arrayType param) &:= (in arrayType param) is            action "ARR_APPEND";

      const func arrayType: (in arrayType param) & (in arrayType param) is       action "ARR_CAT";
      const func integer: length (in arrayType param) is                         action "ARR_LNG";
      const func integer: minIntIdx (in arrayType param) is                      action "ARR_MINIDX";
      const func integer: maxIntIdx (in arrayType param) is                      action "ARR_MAXIDX";
      const func stdArrayType: (attr stdArrayType) conv (in arrayType param) is  action "ARR_CONV";
      const func arrayType: (attr arrayType) conv (in stdArrayType param) is     action "ARR_CONV";
      const func tupleType: (attr tupleType) conv (in arrayType param) is        action "ARR_CONV";
      const varfunc stdArrayType: (attr stdArrayType) conv (inout arrayType param) is action "TYP_VARCONV";
      const func arrayType: (attr arrayType) . _GENERATE_EMPTY_ARRAY is          action "ARR_EMPTY";
      const arrayType: (attr arrayType) . value is                               arrayType._GENERATE_EMPTY_ARRAY;

      const func arrayType: [ (attr indexType) ] (in tupleType: arr_tuple) is
        return arrayType conv ([ord(indexType.value)] arr_tuple);

      const func arrayType: [ (attr indexType) ] (in baseType: base_elem) is
        return arrayType conv ([ord(indexType.value)] base_elem);

      const func baseType: (in arrayType: an_array) [ (in indexType: an_index) ] is
        baseType return stdArrayType conv an_array[ord(an_index)];

      const varfunc baseType: (inout arrayType: an_array) [ (in indexType: an_index) ] is
        baseType return var stdArrayType conv an_array[ord(an_index)];

      const func arrayType: (in arrayType: an_array) [ (in indexType: an_index) .. ] is
        return arrayType conv (stdArrayType conv an_array[ord(an_index) .. ]);

      const func arrayType: (in arrayType: an_array) [ .. (in indexType: an_index) ] is
        return arrayType conv (stdArrayType conv an_array[ .. ord(an_index)]);

      const func arrayType: (in arrayType: an_array) [ (in indexType: index1) .. (in indexType: index2) ] is
        return arrayType conv (stdArrayType conv an_array[ord(index1) .. ord(index2)]);

      const func indexType: minIdx (in arrayType: arr) is
        return indexType conv minIntIdx(arr);

      const func indexType: maxIdx (in arrayType: arr) is
        return indexType conv maxIntIdx(arr);

      const proc: for (inout baseType: variable) range (in arrayType: arr) do
          (in proc: statements) end for is func
        local
          var integer: number is 0;
        begin
          for number range minIntIdx(arr) to maxIntIdx(arr) do
            variable := stdArrayType conv arr[number];
            statements;
          end for;
        end func;

      const proc: for key (inout indexType: keyVar) range (in arrayType: arr) do
                    (in proc: statements)
                  end for is func
        begin
          for keyVar range minIdx(arr) to maxIdx(arr) do
            statements;
          end for;
        end func;

      if getobj((attr indexType) . first) <> NIL and
          getobj((attr indexType) . last) <> NIL then

        const func arrayType: (attr indexType) times (in baseType: base_value) is func
          result
            var arrayType: result is arrayType.value;
          begin
            result := arrayType conv (succ(ord(indexType.last) - ord(indexType.first)) times base_value);
            result := arrayType conv ([ord(indexType.first)] (tupleType conv result));
          end func;

      end if;
(*
PRINT(str(arrayType));
PRINT(" = array [");
PRINT(str(indexType));
PRINT("] ");
PRINT(str(baseType));
PRINT("\n");
*)
      end global;
    end if;
  end func;

(*
const type: test_x is array [char] string;
const type: test_y is array [char] string;
const type: test_z is array [integer] string;
*)

const proc: ENABLE_SORT (in type: arrayType) is func
  begin
    const reference: (attr arrayType) . dataCompare  is getobj(compare(in base_type(arrayType) param, in base_type(arrayType) param));

    const func arrayType: SORT (in arrayType param, in reference param) is   action "ARR_SORT";

    const func arrayType: sort (in arrayType: arr_obj) is
      return SORT(arr_obj, arrayType.dataCompare);
  end func;


(* Functions with arrays of strings *)

const func array string: split (in string param, in char param) is   action "STR_CHSPLIT";
const func array string: split (in string param, in string param) is action "STR_SPLIT";

const func string: join (in array string: striArray, in char: delimiter) is func
  result
    var string: result is "";
  local
    var integer: pos is 0;
  begin
    result := striArray[minIdx(striArray)];
    for pos range succ(minIdx(striArray)) to maxIdx(striArray) do
      result &:= delimiter;
      result &:= striArray[pos];
    end for;
  end func;

const func string: join (in array string: striArray, in string: delimiter) is func
  result
    var string: result is "";
  local
    var integer: pos is 0;
  begin
    result := striArray[minIdx(striArray)];
    for pos range succ(minIdx(striArray)) to maxIdx(striArray) do
      result &:= delimiter;
      result &:= striArray[pos];
    end for;
  end func;

const func boolean: isDigitString (in string: stri) is func
  result
    var boolean: result is TRUE;
  local
    var char: ch is ' ';
  begin
    result := stri <> "";
    for ch range stri do
      if ch < '0' or ch > '9' then
        result := FALSE;
      end if;
    end for;
  end func;

const func boolean: isDigitString (in string: stri, in integer: base) is func
  result
    var boolean: result is TRUE;
  local
    var char: ch is ' ';
  begin
    result := stri <> "";
    if base <= 10 then
      for ch range stri do
        if ch < '0' or ch >= chr(base) then
          result := FALSE;
        end if;
      end for;
    else
      for ch range stri do
        if (ch < '0' or ch > '9') and
            (ch < 'a' or ch >= chr(ord('a') + base - 10)) and
            (ch < 'A' or ch >= chr(ord('A') + base - 10)) then
          result := FALSE;
        end if;
      end for;
    end if;
  end func;


(* LIST

const func type: list (in type: baseType) is func
  result
    var type: LST is void;
  local
    var type: tupleType is void;
  begin
    LST := get_type(getobj(list (attr baseType)));
    if LST = void then
      global
      LST := newtype;
      IN_PARAM_IS_REFERENCE(LST);
      tupleType := tuple(baseType);
      const type: list (attr baseType) is                                        LST;
      const type: base_type (attr LST) is                                        baseType;
      const proc: (ref LST param) ::= (in LST param) is                          action "LST_CREATE";
      const proc: destroy (ref LST param) is                                     action "LST_DESTR";
      const proc: (inout LST param) := (in LST param) is                         action "LST_CPY";
      const proc: (inout LST param) &:= (in LST param) is                        action "LST_APPEND";

      const func LST: [] (in tupleType param) is                                 action "LST_LSTLIT";
      const func LST: [] (in baseType param) is                                  action "LST_BASELIT";
      const func LST: [ (in integer param) ] (in tupleType param) is             action "LST_LSTLIT2";
      const func LST: [ (in integer param) ] (in baseType param) is              action "LST_BASELIT2";

      const func LST: (in LST param) & (in LST param) is                         action "LST_CAT";
      const func baseType: (in LST param) [ (in integer param) ] is              action "LST_IDX";
      const varfunc baseType: (inout LST param) [ (in integer param) ] is        action "LST_IDX";
      const func LST: (in LST param) [ (in integer param) .. ] is                action "LST_TAIL";
      const func LST: (in LST param) [ .. (in integer param) ] is                action "LST_HEAD";
      const func LST: (in LST param) [ (in integer param) ..
                                       (in integer param) ] is                   action "LST_RANGE";
      const func integer: length (in LST param) is                               action "LST_LNG";
      const func LST: (in integer param) times (in baseType param) is            action "LST_TIMES";
      const LST: (attr LST) . value is                                           0 times baseType.value;
      end global;
    end if;
  end func;
*)


(* HASH *)

const func type: hash [ (in type: keyType) ] (in type: baseType) is func
  result
    var type: hashType is void;
  begin
    hashType := get_type(getfunc(hash [ (attr keyType) ] (attr baseType)));
    if hashType = void then
      global
      hashType := newtype;
      IN_PARAM_IS_REFERENCE(hashType);
      const type: hash [ (attr keyType) ] (attr baseType) is                     hashType;
      const type: key_type (attr hashType) is                                    keyType;
      const type: base_type (attr hashType) is                                   baseType;

      const reference: (attr hashType) . keyCreate   is getfunc((ref keyType param) ::= (in keyType param));
      const reference: (attr hashType) . keyDestroy  is getfunc(destroy(ref keyType param));
      const reference: (attr hashType) . keyCopy     is getfunc((inout keyType param) := (in keyType param));
      const reference: (attr hashType) . keyCompare  is getfunc(compare(in keyType param, in keyType param));
      const reference: (attr hashType) . dataCreate  is getfunc((ref baseType param) ::= (in baseType param));
      const reference: (attr hashType) . dataDestroy is getfunc(destroy(ref baseType param));
      const reference: (attr hashType) . dataCopy    is getfunc((inout baseType param) := (in baseType param));

      const proc: CREATE (ref hashType param, in hashType param,
                          in reference param, in reference param,
                          in reference param, in reference param) is             action "HSH_CREATE";
      const proc: DESTROY (ref hashType param, in reference param,
                           in reference param) is                                action "HSH_DESTR";
      const proc: COPY (inout hashType param, in hashType param,
                        in reference param, in reference param,
                        in reference param, in reference param) is               action "HSH_CPY";
      const proc: FOR_DATA (inout baseType param, in hashType param,
                            in proc param, in reference param) is                action "HSH_FOR";
      const proc: FOR_KEY (inout keyType param, in hashType param,
                           in proc param, in reference param) is                 action "HSH_FOR_KEY";
      const proc: FOR_DATA_KEY (inout baseType param, inout keyType param,
                                in hashType param, in proc param,
                                in reference param, in reference param) is       action "HSH_FOR_DATA_KEY";
      const func array keyType: KEYS (in hashType param, in reference param,
                                      in reference param) is                     action "HSH_KEYS";
      const func array baseType: VALUES (in hashType param, in reference param,
                                         in reference param) is                  action "HSH_VALUES";

      const proc: (ref hashType: dest) ::= (in hashType: source) is func
        begin
          CREATE(dest, source, hashType.keyCreate, hashType.keyDestroy,
              hashType.dataCreate, hashType.dataDestroy);
        end func;

      const proc: destroy (ref hashType: oldHash) is func
        begin
          DESTROY(oldHash, hashType.keyDestroy, hashType.dataDestroy);
        end func;

      const proc: (inout hashType: dest) := (in hashType: source) is func
        begin
          COPY(dest, source, hashType.keyCreate, hashType.keyDestroy,
              hashType.dataCreate, hashType.dataDestroy);
        end func;

      const func integer: length (in hashType param) is                          action "HSH_LNG";
      const func baseType: INDEX (in hashType param, in keyType param,
                                  in integer param, in reference param) is       action "HSH_IDX";
      const varfunc baseType: INDEX (inout hashType param, in keyType param,
                                       in integer param, in reference param) is  action "HSH_IDX";

      const func baseType: INDEX2 (in hashType param, in keyType param,
                                   in baseType param, in integer param,
                                   in reference param, in reference param,
                                   in reference param) is                        action "HSH_IDX2";
      const varfunc baseType: INDEX2 (inout hashType param, in keyType param,
                                      in baseType param, in integer param,
                                      in reference param, in reference param,
                                      in reference param) is                     action "HSH_IDX2";

      const func ptr baseType: REFINDEX (in hashType param, in keyType param,
                                         in integer param, in reference param) is action "HSH_REFIDX";
      const proc: INCL (inout hashType param, in keyType param,
                        in baseType param, in integer param,
                        in reference param, in reference param,
                        in reference param, in reference param) is               action "HSH_INCL";
      const proc: EXCL (inout hashType param, in keyType param,
                        in integer param, in reference param,
                        in reference param, in reference param) is               action "HSH_EXCL";
(*
      const func ptr baseType: @ (in hashType param) [ (in string param) ] is    action "HSH_REFIDX";
      const func varptr baseType: @ (inout hashType param) [ (in string param) ] is action "HSH_REFIDX";
      const varfunc baseType: table (inout hashType param, in baseType param) is action "HSH_NEW";
      const func baseType: free (inout hashType param, in baseType param) is     action "HSH_FREE";
*)
      const func boolean: CONTAINS (in hashType param, in keyType param,
                                    in integer param, in reference param) is     action "HSH_CONTAINS";
(*
      const func hashType: (attr hashType) conv (in hashType param) is           action "HSH_CONV";
      const varfunc hashType: (attr hashType) conv (inout hashType param) is     action "TYP_VARCONV";
*)
      const func hashType: (attr hashType) . _GENERATE_EMPTY_HASH is             action "HSH_EMPTY";
      const hashType: (attr hashType) . EMPTY_HASH is                            hashType._GENERATE_EMPTY_HASH;
      const hashType: (attr hashType) . value is                                 hashType._GENERATE_EMPTY_HASH;

      const func baseType: (in hashType: aHash) [ (in keyType: aKey) ] is
        return INDEX(aHash, aKey, hashCode(aKey), hashType.keyCompare);

      const varfunc baseType: (inout hashType: aHash) [ (in keyType: aKey) ] is
        return var INDEX(aHash, aKey, hashCode(aKey), hashType.keyCompare);

      const func boolean: (in keyType: aKey) in (in hashType: aHash) is
        return CONTAINS(aHash, aKey, hashCode(aKey), hashType.keyCompare);

      const func boolean: (in keyType: aKey) not in (in hashType: aHash) is
        return not CONTAINS(aHash, aKey, hashCode(aKey), hashType.keyCompare);

      const proc: incl (inout hashType: aHash, in keyType: aKey, in baseType: anElem) is func
        begin
          INCL(aHash, aKey, anElem, hashCode(aKey), hashType.keyCompare,
              hashType.keyCreate, hashType.dataCreate, hashType.dataCopy);
        end func;

      const proc: excl (inout hashType: aHash, in keyType: aKey) is func
        begin
          EXCL(aHash, aKey, hashCode(aKey), hashType.keyCompare,
              hashType.keyDestroy, hashType.dataDestroy);
        end func;

      const proc: (inout hashType: aHash) @:= [ (in keyType: aKey) ] (in baseType: anElem) is func
        begin
          INCL(aHash, aKey, anElem, hashCode(aKey), hashType.keyCompare,
              hashType.keyCreate, hashType.dataCreate, hashType.dataCopy);
        end func;

(*
      const proc: clear (inout hashType: aHash) is func
        local
          var baseType: anElem is baseType.value;
        begin
          for anElem range source do
            excl(dest, anElem);
          end for;
        end func;
*)

      const proc: for (inout baseType: forVar) range (in hashType: aHash) do
                    (in proc: statements)
                  end for is func
        begin
          FOR_DATA(forVar, aHash, statements, hashType.dataCopy);
        end func;

      const proc: for key (inout keyType: keyVar) range (in hashType: aHash) do
                    (in proc: statements)
                  end for is func
        begin
          FOR_KEY(keyVar, aHash, statements, hashType.keyCopy);
        end func;

      const proc: for (inout baseType: forVar) key (inout keyType: keyVar) range (in hashType: aHash) do
                    (in proc: statements)
                  end for is func
        begin
          FOR_DATA_KEY(forVar, keyVar, aHash, statements, hashType.dataCopy, hashType.keyCopy);
        end func;

      const func array keyType: keys (in hashType: aHash) is
        return KEYS(aHash, hashType.keyCreate, hashType.keyDestroy);

      const func array baseType: values (in hashType: aHash) is
        return VALUES(aHash, hashType.dataCreate, hashType.dataDestroy);

      if getfunc(hashCode(in baseType param)) <> NIL and
          getfunc(compare(in baseType param, in baseType param)) <> NIL then

        const func hash [baseType] array keyType: flip (in hashType: aHash) is func
          result
            var hash [baseType] array keyType: result is (hash [baseType] array keyType).value;
          local
            var keyType: aKey is keyType.value;
            var baseType: aValue is baseType.value;
          begin
            for aValue key aKey range aHash do
              if aValue in result then
                result[aValue] &:= aKey;
              else
                result @:= [aValue] [] (aKey);
              end if;
            end for;
          end func;
      end if;

      end global;
    end if;
  end func;

(*
const type: TEST_100 is hash [string] integer;
const type: TEST_101 is hash [integer] string;
const type: TEST_102 is hash [char] boolean;
const type: TEST_103 is hash [string] reference;
const type: TEST_104 is hash [string] hash [integer] reference;
const type: TEST_105 is hash [string] array integer;
ignore(flip(TEST_101.value));
*)
(*
var TEST_100: TEST_HASH is TEST_100.EMPTY_HASH;
incl(TEST_HASH, "asdf", 25);
incl(TEST_HASH, "gold", 1000);
PRINT(str(TEST_HASH["asdf"]));
PRINT(str(TEST_HASH["gold"]));
PRINT(str(TEST_HASH["silver"]));
var TEST_100: TEST_HASH2 is TEST_HASH;
excl(TEST_HASH, "gold");
PRINT(str(TEST_HASH["gold"]));
PRINT(str(TEST_HASH2["gold"]));
*)


(* SET *)

const type: bitset is subtype object;
IN_PARAM_IS_REFERENCE(bitset);

const proc: (ref bitset param) ::= (in bitset param)            is action "SET_CREATE";
const proc: destroy (ref bitset param)                          is action "SET_DESTR";
const proc: (inout bitset param) := (in bitset param)           is action "SET_CPY";
const func bitset: (in bitset param) | (in bitset param)        is action "SET_UNION";
const func bitset: (in bitset param) >< (in bitset param)       is action "SET_SYMDIFF";
const func bitset: (in bitset param) & (in bitset param)        is action "SET_INTERSECT";
const func bitset: (in bitset param) - (in bitset param)        is action "SET_DIFF";
const func boolean: (in bitset param) = (in bitset param)       is action "SET_EQ";
const func boolean: (in bitset param) < (in bitset param)       is action "SET_LT";
const func boolean: (in bitset param) > (in bitset param)       is action "SET_GT";
const func boolean: (in bitset param) <= (in bitset param)      is action "SET_LE";
const func boolean: (in bitset param) >= (in bitset param)      is action "SET_GE";
const func boolean: (in bitset param) <> (in bitset param)      is action "SET_NE";
const func integer: compare (in bitset param, in bitset param)  is action "SET_CMP";
const func integer: hashCode (in bitset param)                  is action "SET_HASHCODE";
const func boolean: (in integer param) in (in bitset param)     is action "SET_ELEM";
const func boolean: (in integer param) not in (in bitset param) is action "SET_NOT_ELEM";
const proc: incl (inout bitset param, in integer param)         is action "SET_INCL";
const proc: excl (inout bitset param, in integer param)         is action "SET_EXCL";
const func integer: card (in bitset param)                      is action "SET_CARD";
const func integer: rand (in bitset param)                      is action "SET_RAND";
const func integer: min (in bitset param)                       is action "SET_MIN";
const func integer: max (in bitset param)                       is action "SET_MAX";
const func bitset: { (in integer param) }                       is action "SET_BASELIT";
const func bitset: { (in tuple integer param) }                 is action "SET_ARRLIT";
const func integer: (attr integer) conv (in bitset param)       is action "SET_SCONV";
const func bitset: (attr bitset) conv (in integer param)        is action "SET_ICONV";


const func bitset: _GENERATE_EMPTY_SET                          is action "SET_EMPTY";
const bitset: EMPTY_SET                                         is _GENERATE_EMPTY_SET;
const bitset: (attr bitset) . EMPTY_SET                         is EMPTY_SET;
const bitset: (attr bitset) . value                             is EMPTY_SET;

(*
const func bitset: { (in tuple integer: value) } is func
  result
    var bitset: result is EMPTY_SET;
  local
    var integer: number is 0;
  begin
    for number range 1 to length([] value) do
      incl(result, ([] value)[number]);
    end for;
  end func;
*)

const func bitset: { (in integer: lower_value) .. (in integer: upper_value) } is func
  result
    var bitset: result is EMPTY_SET;
  local
    var integer: value is 0;
  begin
    for value range lower_value to upper_value do
      incl(result, value);
    end for;
  end func;

const proc: for (inout integer: variable) range (in bitset: aSet) do
              (in proc: statements)
            end for is func
  begin
    if card(aSet) > 0 then
      for variable range min(aSet) to max(aSet) do
        if variable in aSet then
          statements;
        end if;
      end for;
    end if;
  end func;

const func string: str (in bitset: aSet) is func
  result
    var string: result is "{";
  local
    var integer: setElement is 0;
  begin
    for setElement range aSet do
      if result <> "{" then
        result &:= ", ";
      end if;
      result &:= str(setElement);
    end for;
    result &:= "}";
  end func;

const func bitset: (attr bitset) parse (in var string: stri) is func
  result
    var bitset: result is EMPTY_SET;
  begin
    if stri[1] = '{' then
      repeat
        repeat
          stri := stri[2 ..];
        until stri[1] <> ' ';
        if stri[1] >= '0' and stri[1] <= '9' then
          incl(result, integer parse getint(stri));
        elsif stri[1] <> '}' then
          raise RANGE_ERROR;
        end if;
      until stri[1] <> ',';
      if stri <> "}" then
        raise RANGE_ERROR;
      end if;
    else
      raise RANGE_ERROR;
    end if;
  end func;

const type: set of (attr integer) is bitset;


const func type: BITSET_OF (in type: baseType) is func
  result
    var type: setType is void;
  local
    var type: tupleType is void;
    var type: array_type is void;
  begin
    setType := get_type(getfunc(BITSET_OF(attr baseType)));
    if setType = void then
      global
      setType := newtype;
      IN_PARAM_IS_REFERENCE(setType);
      const type: BITSET_OF (attr baseType)                              is setType;
      const type: base_type (attr setType)                               is baseType;
      const proc: (ref setType param) ::= (in setType param)             is action "SET_CREATE";
      const proc: destroy (ref setType param)                            is action "SET_DESTR";
      const proc: (inout setType param) := (in setType param)            is action "SET_CPY";
      const func setType: (in setType param) | (in setType param)        is action "SET_UNION";
      const func setType: (in setType param) >< (in setType param)       is action "SET_SYMDIFF";
      const func setType: (in setType param) & (in setType param)        is action "SET_INTERSECT";
      const func setType: (in setType param) - (in setType param)        is action "SET_DIFF";
      const func boolean: (in setType param) = (in setType param)        is action "SET_EQ";
      const func boolean: (in setType param) < (in setType param)        is action "SET_LT";
      const func boolean: (in setType param) > (in setType param)        is action "SET_GT";
      const func boolean: (in setType param) <= (in setType param)       is action "SET_LE";
      const func boolean: (in setType param) >= (in setType param)       is action "SET_GE";
      const func boolean: (in setType param) <> (in setType param)       is action "SET_NE";
      const func integer: compare (in setType param, in setType param)   is action "SET_CMP";
      const func integer: hashCode (in setType param)                    is action "SET_HASHCODE";
      const func integer: card (in setType param)                        is action "SET_CARD";
      const func bitset: (attr bitset) conv (in setType param)           is action "SET_CONV";
      const varfunc bitset: (attr bitset) varConv (inout setType param)  is action "TYP_VARCONV";
      const func setType: (attr setType) conv (in bitset param)          is action "SET_CONV";
      const setType: (attr setType) . EMPTY_SET                          is setType conv EMPTY_SET;
      const setType: (attr setType) . value                              is setType conv EMPTY_SET;

      const func boolean: (in baseType: aValue) in (in setType: aSet) is
        return ord(aValue) in bitset conv aSet;

      const func boolean: (in baseType: aValue) not in (in setType: aSet) is
        return ord(aValue) not in bitset conv aSet;

      const proc: incl (inout setType: aSet, in baseType: aValue) is func
        begin
          incl(bitset varConv aSet, ord(aValue));
        end func;

      const proc: excl (inout setType: aSet, in baseType: aValue) is func
        begin
          excl(bitset varConv aSet, ord(aValue));
        end func;

      const func baseType: rand (in setType: aSet) is
        return baseType conv rand(bitset conv aSet);

      const func baseType: min (in setType: aSet) is
        return baseType conv min(bitset conv aSet);

      const func baseType: max (in setType: aSet) is
        return baseType conv max(bitset conv aSet);

      const func setType: { (in baseType: value) } is
        return setType conv ( { ord(value) } );

      tupleType := tuple baseType;
      array_type := array baseType;

      const func setType: { (in tupleType: value) } is func
        result
          var setType: result is setType.EMPTY_SET;
        local
          var integer: number is 0;
        begin
          for number range 1 to length([] value) do
            incl(result, ([] value)[number]);
          end for;
        end func;

      const func setType: { (in baseType: lower_value) .. (in baseType: upper_value) } is func
        result
          var setType: result is setType.EMPTY_SET;
        local
          var baseType: value is baseType.value;
        begin
          for value range lower_value to upper_value do
            incl(result, value);
          end for;
        end func;

      const proc: for (inout baseType: variable) range (in setType: aSet) do
                    (in proc: statements)
                  end for is func
        begin
          if card(aSet) > 0 then
            for variable range min(aSet) to max(aSet) do
              if variable in aSet then
                statements;
              end if;
            end for;
          end if;
        end func;

      if getobj(str(ref baseType param)) <> NIL then
        const func string: str (in setType: aSet) is func
          result
            var string: result is "{";
          local
            var baseType: setElement is baseType.value;
          begin
            for setElement range aSet do
              if result <> "{" then
                result &:= ", ";
              end if;
              result &:= str(setElement);
            end for;
            result &:= "}";
          end func;

      end if;
      end global;
    end if;
  end func;


const func type: HASHSET_OF (in type: baseType) is func
  result
    var type: setType is void;
  local
    var type: tupleType is void;
    var type: array_type is void;
  begin
    setType := get_type(getfunc(HASHSET_OF(attr baseType)));
    if setType = void then
      global
      setType := newtype;
      IN_PARAM_IS_REFERENCE(setType);
      const type: HASHSET_OF (attr baseType) is                             setType;
      const type: base_type (attr setType) is                               baseType;

      const reference: (attr setType) . keyCreate   is getfunc((ref baseType param) ::= (in baseType param));
      const reference: (attr setType) . keyDestroy  is getfunc(destroy(ref baseType param));
      const reference: (attr setType) . keyCopy     is getfunc((inout baseType param) := (in baseType param));
      const reference: (attr setType) . keyCompare  is getfunc(compare(in baseType param, in baseType param));
      const reference: (attr setType) . dataCreate  is getfunc((ref boolean param) ::= (in boolean param));
      const reference: (attr setType) . dataDestroy is getfunc(destroy(ref boolean param));
      const reference: (attr setType) . dataCopy    is getfunc((inout boolean param) := (in boolean param));

      const proc: CREATE (ref setType param, in setType param,
                          in reference param, in reference param,
                          in reference param, in reference param) is             action "HSH_CREATE";
      const proc: DESTROY (ref setType param, in reference param,
                           in reference param) is                                action "HSH_DESTR";
      const proc: COPY (inout setType param, in setType param,
                        in reference param, in reference param,
                        in reference param, in reference param) is               action "HSH_CPY";
      const proc: FOR_KEY (inout baseType param, in setType param,
                           in proc param, in reference param) is                 action "HSH_FOR_KEY";

      const proc: (ref setType: dest) ::= (in setType: source) is func
        begin
          CREATE(dest, source, setType.keyCreate, setType.keyDestroy,
              setType.dataCreate, setType.dataDestroy);
        end func;

      const proc: destroy (ref setType: oldSet) is func
        begin
          DESTROY(oldSet, setType.keyDestroy, setType.dataDestroy);
        end func;

      const proc: (inout setType: dest) := (in setType: source) is func
        begin
          COPY(dest, source, setType.keyCreate, setType.keyDestroy,
              setType.dataCreate, setType.dataDestroy);
        end func;

      const func integer: card (in setType param) is                             action "HSH_LNG";
      const func setType: (attr setType) . _GENERATE_EMPTY_SET is                action "HSH_EMPTY";
      const setType: (attr setType) . EMPTY_SET is                               setType._GENERATE_EMPTY_SET;
      const setType: (attr setType) . value is                                   setType._GENERATE_EMPTY_SET;

      const proc: INCL (inout setType param, in baseType param,
                        in boolean param, in integer param,
                        in reference param, in reference param,
                        in reference param, in reference param) is               action "HSH_INCL";
      const proc: EXCL (inout setType param, in baseType param,
                        in integer param, in reference param,
                        in reference param, in reference param) is               action "HSH_EXCL";
      const func boolean: CONTAINS (in setType param, in baseType param,
                                    in integer param, in reference param) is     action "HSH_CONTAINS";

      const func boolean: (in baseType: aValue) in (in setType: aSet) is
        return CONTAINS(aSet, aValue, hashCode(aValue), setType.keyCompare);

      const func boolean: (in baseType: aValue) not in (in setType: aSet) is
        return not CONTAINS(aSet, aValue, hashCode(aValue), setType.keyCompare);

      const proc: incl (inout setType: aSet, in baseType: aValue) is func
        begin
          INCL(aSet, aValue, TRUE, hashCode(aValue), setType.keyCompare,
              setType.keyCreate, setType.dataCreate, setType.dataCopy);
        end func;

      const proc: excl (inout setType: aSet, in baseType: aValue) is func
        begin
          EXCL(aSet, aValue, hashCode(aValue), setType.keyCompare,
              setType.keyDestroy, setType.dataDestroy);
        end func;

      const proc: for (inout baseType: variable) range (in setType: aSet) do
                    (in proc: statements)
                  end for is func
        begin
          FOR_KEY(variable, aSet, statements, setType.keyCopy);
        end func;

      const func setType: (in setType: set1) | (in setType: set2) is func
        result
          var setType: result is setType.EMPTY_SET;
        local
          var baseType: element is baseType.value;
        begin
          result := set1;
          for element range set2 do
            incl(result, element);
          end for;
        end func;

      const func setType: (in setType: set1) - (in setType: set2) is func
        result
          var setType: result is setType.EMPTY_SET;
        local
          var baseType: element is baseType.value;
        begin
          result := set1;
          for element range set2 do
            excl(result, element);
          end for;
        end func;

      const func setType: (in setType: set1) & (in setType: set2) is func
        result
          var setType: result is setType.EMPTY_SET;
        local
          var baseType: element is baseType.value;
        begin
          for element range set1 do
            if element in set2 then
              incl(result, element);
            end if;
          end for;
        end func;

      const func setType: (in setType: set1) >< (in setType: set2) is func
        result
          var setType: result is setType.EMPTY_SET;
        local
          var baseType: element is baseType.value;
        begin
          for element range set1 do
            if element not in set2 then
              incl(result, element);
            end if;
          end for;
          for element range set2 do
            if element not in set1 then
              incl(result, element);
            end if;
          end for;
        end func;

      const func boolean: (in setType: set1) = (in setType: set2) is func
        result
          var boolean: result is TRUE;
        local
          var baseType: element is baseType.value;
        begin
          for element range set1 do
            if element not in set2 then
              result := FALSE;
            end if;
          end for;
          for element range set2 do
            if element not in set1 then
              result := FALSE;
            end if;
          end for;
        end func;

      const func setType: { (in baseType: value) } is func
        result
          var setType: result is setType.EMPTY_SET;
        begin
          incl(result, value);
        end func;

      tupleType := tuple baseType;
      array_type := array baseType;

      const func setType: { (in tupleType: value) } is func
        result
          var setType: result is setType.EMPTY_SET;
        local
          var integer: number is 0;
        begin
          for number range 1 to length([] value) do
            incl(result, ([] value)[number]);
          end for;
        end func;

      if getobj(str(ref baseType param)) <> NIL then
        const func string: str (in setType: aSet) is func
          result
            var string: result is "{";
          local
            var baseType: setElement is baseType.value;
          begin
            for setElement range aSet do
              if result <> "{" then
                result &:= ", ";
              end if;
              result &:= str(setElement);
            end for;
            result &:= "}";
          end func;

      end if;
      end global;
    end if;
  end func;


const func type: set of (in type: baseType) is func
  result
    var type: setType is void;
  begin
    setType := get_type(getfunc(set of (attr baseType)));
    if setType = void then
      if getobj(ord(ref baseType param)) <> NIL and
          getobj(ord(ref baseType param, mayRaiseRangeError)) = NIL then
        setType := BITSET_OF(baseType);
      else
        setType := HASHSET_OF(baseType);
      end if;
      global

      const type: set of (attr baseType) is setType;

      end global;
    end if;
  end func;


const type: TEST_A is set of integer;
const type: TEST_B is set of char;
const type: TEST_C is set of char;
const type: TEST_D is set of boolean;
const type: TEST_E is set of string;

const set of char: alpha is {'A' .. 'Z'} | {'a' .. 'z'};
const set of char: alnum is {'A' .. 'Z'} | {'a' .. 'z'} | {'0' .. '9'};
const set of char: digit is {'0' .. '9'};


const func integer: toInt (in string: stri, in integer: base) is func
  result
    var integer: result is 0;
  local
    const array integer: digitval is [] (                    # -1 is illegal
         0,  1,  2,  3,  4,  5,  6,  7,  8,  9,              # 0 - 9
        -1, -1, -1, -1, -1, -1, -1,                          #
        10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22,  # A - M
        23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35,  # N - Z
        -1, -1, -1, -1, -1, -1,
        10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22,  # a - m
        23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35); # n - z
    var integer: pos is 1;
    var integer: digit is 0;
  begin
    for pos range 1 to length(stri) do
      digit := digitval[ord(stri[pos]) - 47];
      if digit = -1 then
        raise RANGE_ERROR;
      end if;
      result := result * base + digit;
    end for;
  end func;


(* INTERFACE *)

const func type: new interface is func
  result
    var type: interfaceType is void;
  begin
    interfaceType := newtype;
    IN_PARAM_IS_REFERENCE(interfaceType);
    const proc: (ref interfaceType param) ::= (ref interfaceType param) is      action "ITF_CREATE";
    const proc: destroy (ref interfaceType param) is                            noop;
    const proc: (inout interfaceType param) := (ref interfaceType param) is     action "ITF_CPY";
    const func boolean: (in interfaceType param) = (in interfaceType param) is  action "ITF_EQ";
    const func boolean: (in interfaceType param) <> (in interfaceType param) is action "ITF_NE";
  end func;

const func type: sub (in type: baseType) interface is func
  result
    var type: interfaceType is void;
  begin
    interfaceType := subtype baseType;
    IN_PARAM_IS_REFERENCE(interfaceType);
    const proc: (ref interfaceType param) ::= (ref interfaceType param) is      action "ITF_CREATE";
    const proc: destroy (ref interfaceType param) is                            noop;
    const proc: (inout interfaceType param) := (ref interfaceType param) is     action "ITF_CPY";
    const func boolean: (in interfaceType param) = (in interfaceType param) is  action "ITF_EQ";
    const func boolean: (in interfaceType param) <> (in interfaceType param) is action "ITF_NE";
  end func;


(* body *)
(*
const proc: body (ref type: STRU) is (ref expr: DECLS) end body is func
  begin
    const proc: DECL_BODY (attr STRU) is func
        DECLS;
      end func;
    DECL_BODY(STRU);
  end func;
*)

(* CLASS *)

const func type: new class (ref proc: elem_decl) end class is func
  result
    var type: classType is void;
  local
    var type: ptrType is void;
    var type: varptrType is void;
    var ref_list: elem_list is ref_list.EMPTY;
    var STRUCT: struct_value is empty(STRUCT);
    var integer: number is 0;
    var reference: elem_obj is NIL;
  begin
    classType := newtype;
    IN_PARAM_IS_REFERENCE(classType);
    ptrType := ptr classType;
    CURR_STRUCT_PTR := ptrType;
    varptrType := varptr classType;
    elem_list := declare_elements(elem_decl);
    const func boolean: (ref classType param) = (ref classType param) is         action "ENU_EQ";
    const func boolean: (ref classType param) <> (ref classType param) is        action "ENU_NE";

    const proc: (ref classType param) ::= (in classType param) is                action "SCT_CREATE";
    const proc: destroy (ref classType param) is                                 action "SCT_DESTR";
    const proc: (inout classType param) := (in classType param) is               action "SCT_CPY";
    const func ptrType: alloc (in classType param) is                            action "SCT_ALLOC";
    const func varptrType: varalloc (in classType param) is                      action "SCT_ALLOC";
    const func classType: (attr classType) conv (in STRUCT param) is             action "SCT_CONV";
    const func STRUCT: (attr STRUCT) conv (in classType param) is                action "SCT_CONV";
    for number range 1 to length(elem_list) do
      elem_obj := elem_list[number];
      if is_symb(elem_obj) then
        (* TRACE(elem_obj); PRINT("\n"); *)
        incl(struct_value, elem_obj);
        const func    getType(elem_obj):    (in classType param) .  (symb elem_obj) is action "SCT_SELECT";
        const varfunc getType(elem_obj): (inout classType param) .  (symb elem_obj) is action "SCT_SELECT";
        const func    getType(elem_obj):    (in ptrType    param) -> (symb elem_obj) is action "REF_SELECT";
        const varfunc getType(elem_obj):    (in varptrType param) -> (symb elem_obj) is action "REF_SELECT";
      end if;
    end for;
    const classType: (attr classType) . value is                     classType conv struct_value;
  end func;

(*
const func type: MAKE_CLASS (ref type: STRU) is func
  result
    var type: CLS is void;
  local
    var integer: number is 0;
    var reference: elem_obj is NIL;
  begin
    CLS := newtype;
    for number range 1 to length(elem_list) do
      elem_obj := elem_list[number];
      const func getType(elem_obj): (ref CLS param) . (symb elem_obj) is  action "CLS_SELECT";
    end for;
    const proc: (ref CLS param) ::= (ref CLS param) is          action "CLS_CREATE";
    const proc: (ref CLS param) ::= (ref STRU param) is         action "CLS_CREATE2";
    const proc: (inout CLS param) := (ref CLS param) is         action "CLS_CPY";
    const proc: (inout CLS param) := (ref STRU param) is        action "CLS_CPY2";
    const proc: (ref CLS param) = (ref CLS param) is            action "CLS_EQ";
    const proc: (ref CLS param) <> (ref CLS param) is           action "CLS_NE";
    const func type: (attr CLS) . struct_type is                STRU;
  end func;

const func type: new class (ref STRUCT: elem_list) end class is func
  result
    var type: CLS is void;
  local
    var type: STRU is void;
    var integer: number is 0;
    var reference: elem_obj is NIL;
  begin
    CLS := newtype;
    STRU := newtype;
    const proc: (ref func STRU param) ::= (ref STRUCT param) is action "SCT_CREATE";
    const func STRU: (attr STRU) . value is                     elem_list;
    const func STRU: (attr CLS) . value is                      elem_list;
    const func STRUCT: (ref STRU param) & (ref STRUCT param) is action "SCT_CAT";
    const proc: (ref STRU param) ::= (ref STRU param) is        action "SCT_CREATE";
    const proc: (inout STRU param) := (ref STRU param) is       action "SCT_CPY";
    for number range 1 to length(elem_list) do
      elem_obj := elem_list[number];
      const func getType(elem_obj): (ref STRU param) . (symb elem_obj) is action "SCT_SELECT";
      const func getType(elem_obj): (ref CLS param) . (symb elem_obj) is  action "CLS_SELECT";
    end for;
    const proc: (ref CLS param) ::= (ref CLS param) is          action "CLS_CREATE";
    const proc: (ref CLS param) ::= (ref STRU param) is         action "CLS_CREATE2";
    const proc: (inout CLS param) := (ref CLS param) is         action "CLS_CPY";
    const proc: (inout CLS param) := (ref STRU param) is        action "CLS_CPY2";
    const proc: (ref CLS param) = (ref CLS param) is            action "CLS_EQ";
    const proc: (ref CLS param) <> (ref CLS param) is           action "CLS_NE";
    const func type: (attr CLS) . struct_type is                STRU;
  end func;
*)

const type: linkedList is new struct
    var reference: next is NIL;
  end struct;


const proc: type_implements_interface (in type: aType, in type: interfaceType) is func
  begin
    const proc: (ref interfaceType param) ::= (ref aType param) is           action "ITF_CREATE2";
    const proc: (inout interfaceType param) := (ref aType param) is          action "ITF_CPY2";
    const func interfaceType: (attr interfaceType) conv (ref aType param) is action "ITF_CONV2";

    const func aType: xalloc (in aType: newStuct) is func
      result
        var aType: result is aType.value;
      begin
        result := newStuct;
      end func;

    addInterface(aType, interfaceType);
  end func;


(* LIST

const type: LIST is           subtype INDEXABLE;
IN_PARAM_IS_REFERENCE(LIST);

const proc: destroy (ref LIST param) is                         action "LST_DESTR";
const proc: (ref LIST param) ::= (ref LIST param) is            action "LST_CREATE";

const proc: (inout LIST param) := (ref LIST param) is           action "LST_CPY";
const func LIST: (ref LIST param) & (ref LIST param) is         action "LST_CAT";
const func object: (ref LIST param) [ (ref integer param) ] is  action "LST_IDX";
const func LIST: (ref LIST param) [ (ref integer param) .. ] is action "LST_TAIL";
const func LIST: (ref LIST param) [ .. (ref integer param) ] is action "LST_HEAD";
const func integer: length (ref LIST param) is                  action "LST_LNG";

const func LIST: _GENERATE_EMPTY_LIST is                        action "LST_EMPTY";
const LIST: (attr LIST) . EMPTY is                              _GENERATE_EMPTY_LIST;
const LIST: (attr LIST) . value is                              _GENERATE_EMPTY_LIST;

(* const proc: object in (ref LIST param) is        action "LST_ELEM"; *)
const proc: incl(ref LIST param, ref object param) is    action "LST_INCL";
const proc: excl(ref LIST param, ref object param) is    action "LST_EXCL";

(* const proc: INDEX_EXPR := (ref LIST param) is action "LST_CPY"; *)

const proc: for (inout object: variable) range (ref LIST: obj_list) do
    (ref proc: statements) end for is func
  local
    var integer: number is 0;
  begin
    for number range 1 to length(obj_list) do
      variable := obj_list[number];
      statements;
    end for;
  end func;

const proc: str (ref LIST: aList) is func
  result
    var string: result is "";
  local
    var reference: obj is NIL;
    var boolean: FIRST_OBJ is TRUE;
  begin
    result := "{";
    for obj range aList do
      if FIRST_OBJ then
        FIRST_OBJ := FALSE;
      else
        result := result & ", ";
      end if;
      result := result & str(obj);
    end for;
    result := result & "}";
  end func;

const proc: literal (ref LIST: aList) is func
  result
    var string: result is "";
  local
    var reference: obj is NIL;
    var boolean: FIRST_OBJ is TRUE;
  begin
    result := "{";
    for obj range aList do
      if FIRST_OBJ then
        FIRST_OBJ := FALSE;
      else
        result := result & ", ";
      end if;
      result := result & str(obj);
    end for;
    result := result & "}";
  end func;
*)


(* INDEXABLE *)

(*
const func integer: length (ref INDEXABLE param) is DYNAMIC;
const func object: (ref INDEXABLE param) [ (ref integer param) ] is DYNAMIC;

const func boolean: (ref object: obj) in (ref INDEXABLE: AREA1) is func
  result
    var boolean: result is FALSE;
  local
    var integer: number is 0;
  begin
    for number range 1 to length(AREA1) do
      if obj = AREA1[number] then
        result := TRUE;
      end if;
    end for;
  end func;

const func boolean: (ref INDEXABLE: AREA1) = (ref INDEXABLE: AREA2) is func
  result
    var boolean: result is TRUE;
  local
    var integer: leng is 0;
    var integer: INDEX is 1;
  begin
    leng := length(AREA1);
    if leng <> length(AREA2) then
      result := FALSE;
    else
      for INDEX range 1 to leng do
        if AREA1[INDEX] <> AREA2[INDEX] then
          result := FALSE;
        end if;
      end for;
    end if;
  end func;

const func boolean: (ref INDEXABLE: AREA1) <> (ref INDEXABLE: AREA2) is func
  result
    var boolean: result is FALSE;
  local
    var integer: leng is 0;
    var integer: INDEX is 1;
  begin
    leng := length(AREA1);
    if leng <> length(AREA2) then
      result := TRUE;
    else
      for INDEX range 1 to leng do
        if AREA1[INDEX] = AREA2[INDEX] then
          result := TRUE;
        end if;
      end for;
    end if;
  end func;
*)

(* CASE_DECLS *)

const proc: CASE_DECLS (in type: aType) is func
  local
    var type: WHEN_RESULT is void;
    var type: WHEN_PROC is void;
    var type: SELECTOR_TYPE is void;
  begin
(*    PRINT("in CASE_DECLS "); PRINT(str(aType)); PRINT("\n"); *)
    WHEN_RESULT := newtype;
    WHEN_PROC := (func WHEN_RESULT);
    SELECTOR_TYPE := set of aType;
    const proc: case (ref aType param) of end case                      is noop;
    const proc: case (ref aType param) of
                  (ref WHEN_PROC param)
                end case                                                is action "PRC_CASE";
    const proc: case (ref aType param) of
                  (ref WHEN_PROC param)
                  otherwise : (ref proc param)
                end case                                                is action "PRC_CASE_DEF";
    const proc: (ref WHEN_RESULT param) ::= enumlit                     is action "ENU_GENLIT";
    const WHEN_RESULT: WHEN_EMPTY (attr aType) is enumlit;
    const proc: (ref WHEN_PROC param) ::= (ref WHEN_RESULT param)       is action "ENU_CREATE";
    const WHEN_PROC: when (ref SELECTOR_TYPE param) : (ref proc param)  is WHEN_EMPTY(aType);
    const WHEN_PROC: when (ref SELECTOR_TYPE param) : (ref proc param)
                       (ref WHEN_PROC param)                            is WHEN_EMPTY(aType);
  end func;

CASE_DECLS(integer);
CASE_DECLS(char);
CASE_DECLS(boolean);
(* CASE_DECLS(string); *)

const func ref_list: expr_to_list (ref expr: elem_expr) is action "RFL_EXPR";
const proc: TRACE (ref expr param)                      is action "REF_TRACE";

const func type: new enum (ref expr: elem_expr) end enum is func
  result
    var type: enumType is void;
  local
    var ref_list: elem_list is ref_list.EMPTY;
    var integer: number is 0;
    var reference: elem_obj is NIL;
    var ref_list: literal_list is ref_list.EMPTY;
  begin
    global
    enumType := subtype ENUMERATION;
    IN_PARAM_IS_REFERENCE(enumType);
    elem_list := expr_to_list(elem_expr);
    const proc: (ref enumType param) ::= (in enumType param)         is action "ENU_CREATE";
    const proc: (ref enumType param) ::= enumlit                     is action "ENU_GENLIT";
    const proc: destroy (ref enumType param)                         is noop;
    const proc: (inout enumType param) := (in enumType param)        is action "ENU_CPY";
    const func boolean: (in enumType param) = (in enumType param)    is action "ENU_EQ";
    const func boolean: (in enumType param) <> (in enumType param)   is action "ENU_NE";
    const func enumType: getValue(in reference param, attr enumType) is action "ENU_VALUE";
    const func enumType: ICONV2(in integer param, in ref_list param,
                                attr enumType)                       is action "ENU_ICONV2";
    const func integer: ORD2(in enumType param, in ref_list param)   is action "ENU_ORD2";
    literal_list := ref_list.EMPTY;
    for number range 1 to length(elem_list) do
      elem_obj := elem_list[number];
      # const integer: ord(symb elem_obj) is pred(number);
      const enumType: .(symb elem_obj) is enumlit;
      elem_obj := getobj(. (symb elem_obj));
      if elem_obj <> NIL and getType(elem_obj) = enumType then
        literal_list := literal_list & make_list(elem_obj);
      end if;
    end for;
    const ref_list: (attr enumType) . literal_list                   is literal_list;
    if length(literal_list) >= 1 then
      const enumType: (attr enumType) . value is  getValue(literal_list[1], enumType);
      const enumType: (attr enumType) . first is  getValue(literal_list[1], enumType);
      const enumType: (attr enumType) . last is   getValue(literal_list[length(literal_list)], enumType);
    end if;

    const func enumType: (attr enumType) conv (in integer: number) is
      return ICONV2(number, enumType.literal_list, enumType);

    const func integer: ord (in enumType: enum_val) is
      return ORD2(enum_val, enumType.literal_list);

    const func integer: (attr integer) conv (in enumType: enum_val) is
      return ord(enum_val);

    const func enumType: succ (ref enumType: enum_val) is
      return enumType conv succ(ord(enum_val));

    const func enumType: pred (ref enumType: enum_val) is
      return enumType conv pred(ord(enum_val));

    const proc: incr (inout enumType: enum_val) is func
      begin
        enum_val := succ(enum_val);
      end func;

    const proc: decr (inout enumType: enum_val) is func
      begin
        enum_val := pred(enum_val);
      end func;

    const func boolean: (in enumType: enum_val1) < (in enumType: enum_val2) is
      return ord(enum_val1) < ord(enum_val2);

    const func boolean: (in enumType: enum_val1) <= (in enumType: enum_val2) is
      return ord(enum_val1) <= ord(enum_val2);

    const func boolean: (in enumType: enum_val1) > (in enumType: enum_val2) is
      return ord(enum_val1) > ord(enum_val2);

    const func boolean: (in enumType: enum_val1) >= (in enumType: enum_val2) is
      return ord(enum_val1) >= ord(enum_val2);

    FOR_DECLS(enumType);(* Necessary for this is <= < >= > *)
    CASE_DECLS(enumType);
    SUBRANGE_TYPES(enumType);
    end global;
  end func;


(* COLOR *)

const type: color is new struct
    var integer: red_part is 0;
    var integer: green_part is 0;
    var integer: blue_part is 0;
  end struct;


const func boolean: (in color: col1) = (in color: col2) is
  return col1.red_part = col2.red_part and
         col1.green_part = col2.green_part and
         col1.blue_part = col2.blue_part;


const func boolean: (in color: col1) <> (in color: col2) is
  return col1.red_part <> col2.red_part or
         col1.green_part <> col2.green_part or
         col1.blue_part <> col2.blue_part;


const func color: (in color: col1) + (in color: col2) is func
  result
    var color: result is color.value;
  begin
    result.red_part :=   (col1.red_part   + col2.red_part)   div 2;
    result.green_part := (col1.green_part + col2.green_part) div 2;
    result.blue_part :=  (col1.blue_part  + col2.blue_part)  div 2;
  end func;


const func color: color (in integer: red, in integer: green, in integer: blue) is func
  result
    var color: result is color.value;
  begin
    result.red_part := red;
    result.green_part := green;
    result.blue_part := blue;
  end func;


const func color: gray (in integer: brightness) is func
  result
    var color: result is color.value;
  begin
    result.red_part := brightness;
    result.green_part := brightness;
    result.blue_part := brightness;
  end func;


const func integer: compare (in color: col1, in color: col2) is func
  result
    var integer: result is 0;
  begin
    if col1.red_part < col2.red_part then
      result := -1;
    elsif col1.red_part > col2.red_part then
      result := 1;
    elsif col1.green_part < col2.green_part then
      result := -1;
    elsif col1.green_part > col2.green_part then
      result := 1;
    elsif col1.blue_part < col2.blue_part then
      result := -1;
    elsif col1.blue_part > col2.blue_part then
      result := 1;
    end if;
  end func;


const func integer: hashCode (in color: col) is
  return col.red_part + col.green_part + col.blue_part;


(* BLOCK *)

const proc: BLOCK_DECLS (in type: unusedType) is func
  local
    var type: CATCH_RESULT is void;
    var type: CATCH_PROC is void;
  begin
(*    PRINT("in BLOCK_DECLS\n"); *)
    CATCH_RESULT := new enum CATCH_EMPTY end enum;
    CATCH_PROC := (func CATCH_RESULT);
    const proc: block (ref proc param) exception end block            is noop;
    const proc: block (ref proc param) exception
                  (ref CATCH_PROC param)
                end block                                             is action "PRC_BLOCK";
    (*const proc: block (ref proc param) exception
                  (ref CATCH_PROC param)
                  otherwise : (ref proc param)
                end block                                             is action "PRC_BLOCK_DEF"; *)
    const proc: (ref CATCH_PROC param) ::= (ref CATCH_RESULT param)   is action "ENU_CREATE";
    const CATCH_PROC: catch (ref EXCEPTION param) : (ref proc param)  is CATCH_RESULT.value;
    const CATCH_PROC: catch (ref EXCEPTION param) : (ref proc param)
                       (ref CATCH_PROC param)                         is CATCH_RESULT.value;
  end func;

BLOCK_DECLS(void);


(* PRIMITIVE_FILE *)

const type: PRIMITIVE_FILE is newtype;
IN_PARAM_IS_VALUE(PRIMITIVE_FILE);

const proc: (ref PRIMITIVE_FILE param) ::= (ref PRIMITIVE_FILE param)        is action "FIL_CREATE";
const proc: destroy (ref PRIMITIVE_FILE param)                               is noop;
const proc: (inout PRIMITIVE_FILE param) := (ref PRIMITIVE_FILE param)       is action "FIL_CPY";

const func boolean: (ref PRIMITIVE_FILE param) = (ref PRIMITIVE_FILE param)  is action "FIL_EQ";
const func boolean: (ref PRIMITIVE_FILE param) <> (ref PRIMITIVE_FILE param) is action "FIL_NE";

const func PRIMITIVE_FILE: _GENERATE_EMPTY_PRIMITIVE_FILE                    is action "FIL_EMPTY";
const PRIMITIVE_FILE: (attr PRIMITIVE_FILE) . value                          is _GENERATE_EMPTY_PRIMITIVE_FILE;
const PRIMITIVE_FILE: PRIMITIVE_NULL_FILE                                    is PRIMITIVE_FILE.value;

const func PRIMITIVE_FILE: PRIMITIVE_INPUT  is action "FIL_IN";
const func PRIMITIVE_FILE: PRIMITIVE_OUTPUT is action "FIL_OUT";
const func PRIMITIVE_FILE: PRIMITIVE_ERROR  is action "FIL_ERR";

const integer: IO_FULL_BUFFERING is 0;
const integer: IO_LINE_BUFFERING is 1;
const integer: IO_NO_BUFFERING   is 2;

const func PRIMITIVE_FILE: PRIMITIVE_FILE_OPEN (in string param, in string param)   is action "FIL_OPEN";
const proc: setbuf (ref PRIMITIVE_FILE param, ref integer param, ref integer param) is action "FIL_SETBUF";
const proc: close (ref PRIMITIVE_FILE param)                              is action "FIL_CLOSE";
const func boolean: eof (ref PRIMITIVE_FILE param)                        is action "FIL_EOF";
const func boolean: hasNext (ref PRIMITIVE_FILE param)                    is action "FIL_HAS_NEXT";
const proc: flush (ref PRIMITIVE_FILE param)                              is action "FIL_FLUSH";
const func char: getc (ref PRIMITIVE_FILE param)                          is action "FIL_GETC";
const func string: gets (ref PRIMITIVE_FILE param, ref integer param)     is action "FIL_GETS";
const func string: word_read (ref PRIMITIVE_FILE param, inout char param) is action "FIL_WORD_READ";
const func string: line_read (ref PRIMITIVE_FILE param, inout char param) is action "FIL_LINE_READ";
const proc: write (ref PRIMITIVE_FILE param, in string param)             is action "FIL_WRITE";
const func integer: length (ref PRIMITIVE_FILE param)                     is action "FIL_LNG";
const proc: seek (ref PRIMITIVE_FILE param, ref integer param)            is action "FIL_SEEK";
const func integer: tell (ref PRIMITIVE_FILE param)                       is action "FIL_TELL";
const func string: literal (ref PRIMITIVE_FILE param)                     is action "FIL_LIT";

const char: EOF is chr(-1);

(* Procedures and Elements granted for every file *)

const type: file is sub object interface;

const proc: write (inout file param, in string param)        is DYNAMIC;
const proc: writeln (inout file param)                       is DYNAMIC;
const proc: backSpace (inout file param)                     is DYNAMIC;
const proc: close (inout file param)                         is DYNAMIC;
const proc: flush (inout file param)                         is DYNAMIC;
const func char: getc (inout file param)                     is DYNAMIC;
const func string: gets (inout file param, in integer param) is DYNAMIC;
const func string: getln (inout file param)                  is DYNAMIC;
const func string: getwd (inout file param)                  is DYNAMIC;
const func string: getk (ref file param)                     is DYNAMIC;
const func boolean: eoln (ref file param)                    is DYNAMIC;

(**
 *  Return TRUE if the end-of-file indicator is set, FALSE otherwise.
 *  The end-of-file indicator is set when at least one request to read
 *  from the file failed.
 *  @return the state of the end-of-file indicator.
 *)
const func boolean: eof (ref file param) is DYNAMIC;

(**
 *  Return FALSE if 'getc' would return EOF, TRUE otherwise.
 *  This function allows a file to be handled like an iterator.
 *  @return a boolean value indicating if 'getc' would not return EOF.
 *)
const func boolean: hasNext (ref file param) is DYNAMIC;

(**
 *  Return the length of a file.
 *)
const func integer: length (ref file param) is DYNAMIC;

const proc: seek (inout file param, in integer param) is DYNAMIC;
const func integer: tell (ref file param)             is DYNAMIC;
const func char: (ref file param).bufferChar          is DYNAMIC;
const varfunc char: (inout file param).bufferChar     is DYNAMIC;
const func boolean: (ref file param).io_empty         is DYNAMIC;
const varfunc boolean: (inout file param).io_empty    is DYNAMIC;
const func boolean: (ref file param).io_ok            is DYNAMIC;
const varfunc boolean: (inout file param).io_ok       is DYNAMIC;

const func boolean: io_ok (in file: aFile) is
  return aFile.io_ok;

const func boolean: io_error (in file: aFile) is
  return not aFile.io_ok;

const func boolean: io_empty (in file: aFile) is
  return aFile.io_empty;

const func boolean: io_filled (in file: aFile) is
  return not aFile.io_empty;

const proc: readln (inout file: aFile) is func
  local
    var string: stri is "";
  begin
    stri := getln(aFile);
    aFile.io_empty := stri = "";
    aFile.io_ok := TRUE;
  end func;


(* null_file *)

const type: null_file is new struct
    var char: bufferChar is '\n';
    var boolean: io_empty is FALSE;
    var boolean: io_ok is TRUE;
  end struct;

type_implements_interface(null_file, file);

const func boolean: (ref null_file param) = (ref null_file param)   is action "ENU_EQ";
const func boolean: (ref null_file param) <> (ref null_file param)  is action "ENU_NE";

var null_file: STD_NULL is null_file.value;
const file: (attr file) . value is STD_NULL;

const proc: write (in null_file param, in string param) is noop;
const string: gets (in null_file param, in integer param) is "";

const func char: getc (inout null_file: aFile) is func
  result
    var char: ch is ' ';
  local
    var string: buffer is "";
  begin
    buffer := gets(aFile, 1);
    if buffer = "" then
      ch := EOF;
    else
      ch := buffer[1];
    end if;
  end func;

const func string: getwd (inout null_file: aFile) is func
  result
    var string: stri is "";
  local
    var string: buffer is "";
  begin
    repeat
      buffer := gets(aFile, 1);
    until buffer <> " " and buffer <> "\t";
    while buffer <> " " and buffer <> "\t" and
        buffer <> "\n" and buffer <> "" do
      stri &:= buffer;
      buffer := gets(aFile, 1);
    end while;
    if buffer = "" then
      aFile.bufferChar := EOF;
    else
      aFile.bufferChar := buffer[1];
    end if;
  end func;

const func string: getln (inout null_file: aFile) is func
  result
    var string: stri is "";
  local
    var string: buffer is "";
  begin
    buffer := gets(aFile, 1);
    while buffer <> "\n" and buffer <> "" do
      stri &:= buffer;
      buffer := gets(aFile, 1);
    end while;
    if buffer = "" then
      aFile.bufferChar := EOF;
    else
      aFile.bufferChar := buffer[1];
    end if;
  end func;

const proc: writeln (inout null_file: aFile) is func
  begin
    write(aFile, "\n");
  end func;

const boolean: eof (ref null_file param) is TRUE;

const boolean: hasNext (ref null_file param) is FALSE;

const func boolean: eoln (ref null_file: aFile) is
  return aFile.bufferChar = '\n';

const integer: length (ref null_file param) is 0;

const proc: seek (ref null_file param, in integer param) is noop;

const integer: tell (ref null_file param) is 1;

const proc: backSpace (ref null_file: aFile) is noop;

const proc: close (ref null_file param) is noop;
const proc: flush (ref null_file param) is noop;

(* Set of operations for external_file *)

const type: external_file is sub null_file struct
    var PRIMITIVE_FILE: ext_file is PRIMITIVE_NULL_FILE;
    var string: name is "";
  end struct;

type_implements_interface(external_file, file);

const func external_file: malloc (ref external_file: ext_file) is func
  result
    var external_file: result is external_file.value;
  begin
    result := ext_file;
  end func;

const func file: open (in string: file_name, in string: access) is func
  result
    var file: result is STD_NULL;
  local
    var PRIMITIVE_FILE: open_file is PRIMITIVE_NULL_FILE;
    var external_file: new_file is external_file.value;
  begin
    open_file := PRIMITIVE_FILE_OPEN(file_name, access);
    if open_file <> PRIMITIVE_NULL_FILE then
      new_file.ext_file := open_file;
      new_file.name := file_name;
      result := malloc(new_file);
    end if;
  end func;

(*
const func external_file: open (in string: file_name, in string: access) is func
  result
    var external_file: result is external_file.value;
  local
    var PRIMITIVE_FILE: open_file is PRIMITIVE_NULL_FILE;
  begin
    open_file := PRIMITIVE_FILE_OPEN(file_name, access);
    if open_file <> PRIMITIVE_NULL_FILE then
      result := external_file.value;
      result.ext_file := open_file;
      result.name := file_name;
    end if;
  end func;
*)

const proc: close (ref external_file: aFile) is func
  begin
    close(aFile.ext_file);
  end func;

const proc: flush (ref external_file: aFile) is func
  begin
    flush(aFile.ext_file);
  end func;

const proc: write (in external_file: aFile, in string: stri) is func
  begin
    write(aFile.ext_file, stri);
  end func;

const proc: writeln (in external_file: aFile) is func
  begin
    write(aFile.ext_file, "\n");
  end func;

const proc: backSpace (ref external_file: aFile) is func
  begin
    write(aFile.ext_file, "\b \b");
  end func;

const func char: getc (in external_file: aFile) is
  return getc(aFile.ext_file);

const func string: gets (in external_file: aFile, in integer: leng) is
  return gets(aFile.ext_file, leng);

const func string: getwd (inout external_file: aFile) is
  return word_read(aFile.ext_file, aFile.bufferChar);

const func string: getln (inout external_file: aFile) is
  return line_read(aFile.ext_file, aFile.bufferChar);

const func boolean: eof (ref external_file: aFile) is
  return eof(aFile.ext_file);

const func boolean: hasNext (ref external_file: aFile) is
  return hasNext(aFile.ext_file);

const func integer: length (ref external_file: aFile) is
  return length(aFile.ext_file);

const proc: seek (ref external_file: aFile, in integer: pos) is func
  begin
    seek(aFile.ext_file, pos);
  end func;

const func integer: tell (ref external_file: aFile) is
  return tell(aFile.ext_file);

(* System STD_IN, STD_OUT and STD_ERR files *)

const func external_file: INIT_STD_FILE (ref PRIMITIVE_FILE: primitive_file,
    in string: file_name) is func
  result
    var external_file: result is external_file.value;
  begin
    result.ext_file := primitive_file;
    result.name := file_name;
  end func;

var external_file: STD_IN is  INIT_STD_FILE(PRIMITIVE_INPUT,  "STD_IN");
var external_file: STD_OUT is INIT_STD_FILE(PRIMITIVE_OUTPUT, "STD_OUT");
var external_file: STD_ERR is INIT_STD_FILE(PRIMITIVE_ERROR,  "STD_ERR");

(* Set of operations for IN and OUT *)

var file: IN is STD_IN;
var file: OUT is STD_OUT;
var file: PROT_OUTFILE is STD_OUT;

const proc: writeln is func
  begin
    writeln(OUT);
  end func;

const proc: write (NL) is func
  begin
    writeln(OUT);
  end func;

const proc: readln is func
  local
    var string: stri is "";
  begin
    stri := getln(IN);
    IN.io_empty := stri = "";
    IN.io_ok := TRUE;
  end func;

const proc: read (NL) is func
  begin
    readln;
  end func;


(* io definitions for string *)

const proc: writeln (inout file: aFile, in string: stri) is func
  begin
    write(aFile, stri);
    writeln(aFile);
  end func;

const proc: read (inout file: aFile, inout string: stri) is func
  begin
    stri := getwd(aFile);
    aFile.io_empty := stri = "";
    aFile.io_ok := TRUE;
  end func;

const proc: readln (inout file: aFile, inout string: stri) is func
 begin
    stri := getln(aFile);
    aFile.io_empty := stri = "";
    aFile.io_ok := TRUE;
  end func;

const proc: write (in string: stri) is func
  begin
    write(OUT, stri);
  end func;

const proc: writeln (in string: stri) is func
  begin
    write(OUT, stri);
    writeln(OUT);
  end func;

const proc: read (inout string: stri) is func
  begin
    read(IN, stri);
  end func;

const proc: readln (inout string: stri) is func
  begin
    readln(IN, stri);
  end func;


(* enable_io *)

const proc: enable_input (in type: aType) is func
  begin
    const proc: read (inout file: aFile, inout aType: aValue) is func
      local
        var string: stri is "";
      begin
        stri := getwd(aFile);
        aFile.io_empty := stri = "";
        block
          aValue := aType parse stri;
          aFile.io_ok := TRUE;
        exception
          catch RANGE_ERROR:
            aFile.io_ok := FALSE;
        end block;
      end func;

    const proc: readln (inout file: aFile, inout aType: aValue) is func
      local
        var string: stri is "";
      begin
        stri := getln(aFile);
        aFile.io_empty := stri = "";
        block
          aValue := aType parse stri;
          aFile.io_ok := TRUE;
        exception
          catch RANGE_ERROR:
            aFile.io_ok := FALSE;
        end block;
      end func;

    const proc: read (inout aType: aValue) is func
      begin
        read(IN, aValue);
      end func;

    const proc: readln (inout aType: aValue) is func
      begin
        readln(IN, aValue);
      end func;

  end func;

const proc: enable_output (in type: aType) is func
  begin
    const proc: write (inout file: aFile, in aType: aValue) is func
      begin
        write(aFile, str(aValue));
      end func;

    const proc: writeln (inout file: aFile, in aType: aValue) is func
      begin
        write(aFile, str(aValue));
        writeln(aFile);
      end func;

    const proc: write (in aType: aValue) is func
      begin
        write(OUT, aValue);
      end func;

    const proc: writeln (in aType: aValue) is func
      begin
        write(OUT, aValue);
        writeln(OUT);
      end func;

    const func string: (in aType: aValue) lpad (in integer: leng) is
      return str(aValue) lpad leng;

    const func string: (in aType: aValue) rpad (in integer: leng) is
      return str(aValue) rpad leng;

    const func string: (in string: stri) <& (in aType: aValue) is
      return stri & str(aValue);

    const func string: (in aType: aValue) <& (in string: stri) is
      return str(aValue) & stri;

  end func;

const proc: enable_io (in type: aType) is func
  begin
    enable_input(aType);
    enable_output(aType);
  end func;

enable_io(char);
enable_io(integer);
enable_io(boolean);
enable_io(bitset);
# enable_output(type);
# enable_output(ACTION);


(* text *)

const type: text is subtype file;

(* Procedures and Elements granted for every text *)

# const proc: write (inout text param, in string param) is DYNAMIC;
# const proc: write (inout text param, in char param) is DYNAMIC;
# const proc: writeln (inout text param) is DYNAMIC;
# const proc: backSpace (ref text param) is DYNAMIC;
const func integer: height (ref text param) is DYNAMIC;
const func integer: width (ref text param) is DYNAMIC;
const func integer: line (ref text param) is DYNAMIC;
const func integer: column (ref text param) is DYNAMIC;
const proc: clear (inout text param) is DYNAMIC;
const proc: clear (in text param, in integer param, in integer param,
    in integer param, in integer param) is DYNAMIC;
const proc: v_scroll (inout text param, in integer param) is DYNAMIC;
const proc: v_scroll (inout text param, in integer param, in integer param,
    in integer param, in integer param, in integer param) is DYNAMIC;
const proc: h_scroll (ref text param, in integer param) is DYNAMIC;
const proc: h_scroll (ref text param, in integer param, in integer param,
    in integer param, in integer param, in integer param) is DYNAMIC;
const proc: color (inout text param, in color param) is DYNAMIC;
const proc: color (inout text param, in color param, in color param) is DYNAMIC;
const proc: setPos (inout text param, in integer param, in integer param) is DYNAMIC;
const proc: setPosXY (inout text param, in integer param, in integer param) is DYNAMIC;
const proc: setLine (ref text param, ref integer param) is DYNAMIC;
const proc: setColumn (ref text param, ref integer param) is DYNAMIC;
const proc: setXY (ref text param, ref integer param, ref integer param) is DYNAMIC;
const proc: flush (inout text param) is DYNAMIC;
const proc: cursor (ref text param, ref boolean param) is DYNAMIC;
const proc: cursor_on (ref text param) is DYNAMIC;
const proc: cursor_off (ref text param) is DYNAMIC;
const proc: box (ref text param) is DYNAMIC;
const proc: clear_box (ref text param) is DYNAMIC;

(* ARGS + ENV *)

const func array string: argv (PROGRAM)               is action "PRC_ARGS";
const func string: name (PROGRAM)                     is action "PRG_NAME";
const func string: path (PROGRAM)                     is action "PRG_PATH";
const func string: getenv (in string param)           is action "CMD_GETENV";
const proc: setenv (in string param, in string param) is action "CMD_SETENV";

const func string: dir (PROGRAM) is func
  result
    var string: result is "";
  local
    var integer: slashPos is 0;
  begin
    result := path(PROGRAM);
    slashPos := rpos(result, '/');
    if slashPos > 1 then
      result := result[.. pred(slashPos)];
    end if;
  end func;

const func string: file (PROGRAM) is func
  result
    var string: result is "";
  local
    var integer: slashPos is 0;
  begin
    result := path(PROGRAM);
    slashPos := rpos(result, '/');
    if slashPos <> 0 then
      result := result[succ(slashPos) ..];
    end if;
  end func;

(* DIRECTORY *)

const integer: FILE_ABSENT  is 0; # A component of path does not exist
const integer: FILE_UNKNOWN is 1; # File exists but has an unknown type
const integer: FILE_REGULAR is 2;
const integer: FILE_DIR     is 3;
const integer: FILE_CHAR    is 4;
const integer: FILE_BLOCK   is 5;
const integer: FILE_FIFO    is 6;
const integer: FILE_SYMLINK is 7;
const integer: FILE_SOCKET  is 8;

const type: filePermission is new enum
    EXEC_OTHER,
    WRITE_OTHER,
    READ_OTHER,
    EXEC_GROUP,
    WRITE_GROUP,
    READ_GROUP,
    EXEC_USER,
    WRITE_USER,
    READ_USER
  end enum;

const type: fileMode is set of filePermission;

const func integer: (attr integer) conv (in fileMode: mode) is
  return integer conv (bitset conv mode);

const func fileMode: (attr fileMode) conv (in integer: int_mode) is
  return fileMode conv (bitset conv int_mode);

const func string: str (in fileMode: aFileMode) is func
  result
    var string: result is "";
  local
    const array [filePermission] string: name is
        [filePermission] ("x", "w", "r", "x", "w", "r", "x", "w", "r");
    var filePermission: aPermission is READ_USER;
  begin
    for aPermission range READ_USER downto EXEC_OTHER do
      if aPermission in aFileMode then
        result &:= name[aPermission];
      else
        result &:= "-";
      end if;
    end for;
  end func;

enable_output(fileMode);

const proc: chdir (in string param) is                          action "CMD_CHDIR";
const proc: mkdir (in string param) is                          action "CMD_MKDIR";
const func string: getcwd is                                    action "CMD_GETCWD";
const func integer: fileType (in string param) is               action "CMD_FILETYPE";
const func integer: fileTypeSL (in string param) is             action "CMD_FILETYPE_SL";
const func fileMode: fileMode (in string param) is              action "CMD_FILEMODE";
const proc: setFileMode (in string param, in fileMode param) is action "CMD_SET_FILEMODE";
const func integer: fileSize (in string param) is               action "CMD_FILESIZE";
const func array string: read_dir (in string param) is          action "CMD_LS";
const proc: removeFile (in string param) is                     action "CMD_REMOVE";
const proc: removeAnyFile (in string param) is                  action "CMD_REMOVE_ANY_FILE";
const proc: copyFile (in string param, in string param) is      action "CMD_COPY_FILE";
const proc: cloneFile (in string param, in string param) is     action "CMD_CLONE_FILE";
const proc: moveFile (in string param, in string param) is      action "CMD_MOVE";
const func string: readlink (in string param) is                action "CMD_READLINK";
const proc: symlink (in string param, in string param) is       action "CMD_SYMLINK";
const func string: configValue (in string param) is             action "CMD_CONFIG_VALUE";

const func string: convDosPath (in string: path) is func
  result
    var string: result is "";
  local
    var integer: length is 0;
  begin
    # Path delimiter is slash
    result := replace(path, "\\", "/");
    # Convert drive letters to standard path
    if (length(result) = 2 or (length(result) >= 3 and result[3] = '/')) and
        result[2] = ':' and lower(result[1]) >= 'a' and lower(result[1]) <= 'z' then
      result @:= [2] lower(result[1]);
      result @:= [1] '/';
    end if;
    # Remove double slashes
    repeat
      length := length(result);
      result := replace(result, "//", "/");
    until length(result) = length;
    # Remove slash at end of path
    while result <> "/" and endsWith(result, "/") do
      result := result[.. pred(length(result))];
    end while;
  end func;

const func string: toStdPath (in string: path) is func
  result
    var string: result is "";
  local
    var integer: length is 0;
  begin
    result := path;
    # Remove double slashes
    repeat
      length := length(result);
      result := replace(result, "//", "/");
    until length(result) = length;
    # Remove slash at end of path
    while result <> "/" and endsWith(result, "/") do
      result := result[.. pred(length(result))];
    end while;
  end func;

const func boolean: fileExists (in string: file_name) is func
  result
    var boolean: result is FALSE;
  local
    var file: a_file is STD_NULL;
  begin
    a_file := open(file_name, "r");
    if a_file <> STD_NULL then
      close(a_file);
      result := TRUE;
    end if;
  end func;

const proc: heapstat (PROGRAM) is                         action "PRC_HEAPSTAT";
const func integer: heapsize (PROGRAM) is                 action "PRC_HSIZE";
const proc: PRIMITIVE_INCLUDE (in string param) is        action "PRC_INCLUDE";

var set of string: INCLUDED_LIBRARY_LIST is (set of string).value;

const proc: include (in string: library) is func
  local
    var string: libraryName is "";
  begin
    if rpos(library, '/') <> 0 then
      libraryName := library[succ(rpos(library, '/')) ..];
    else
      libraryName := library;
    end if;
    if libraryName not in INCLUDED_LIBRARY_LIST then
      incl(INCLUDED_LIBRARY_LIST, libraryName);
      PRIMITIVE_INCLUDE(library);
    end if;
  end func;

(*
const proc: var (ref expr: typeExpr) : (ref expr: nameExpr) is (ref expr: initExpr) is action "PRC_TRACE";
*)

const proc: main is forward;

$ system "main" is main;
