MODULE Export;
TYPE
  a=RECORD
    b-:INTEGER;
  END;
VAR
  p-:POINTER TO a;
PROCEDURE Init*();
BEGIN
  NEW(p);
  p^.b:=100;
END Init;
BEGIN
END Export.

<*+MAIN*>
MODULE Import;
IMPORT STextIO,SWholeIO,Export;
VAR
  c:CHAR;
BEGIN
  Export.Init;
  SWholeIO.WriteInt(Export.p^.b,4);
  STextIO.WriteLn;
  STextIO.ReadChar(c);
END Import.

MODULE TestExport;
TYPE
  Item*=POINTER TO LIMITED RECORD
        b-:INTEGER;
  END;
PROCEDURE Init*():Item;
VAR
  temp:Item;
BEGIN
  NEW(temp);
  temp^.b:=100;
  RETURN temp;
END Init;
BEGIN
END TestExport.

MODULE TestImport;
IMPORT Log,TestExport;
VAR
  Item:TestExport.Item;
PROCEDURE Do*;
BEGIN
  Item:=TestExport.Init();
  Log.Int(Item^.b);
  Log.Ln;
END Do;
END TestImport.
TestImport.Do

MODULE export;
TYPE
  pa=POINTER TO a;
  a=RECORD
      b*:ARRAY 32 OF CHAR;
    END;
  exp*=RECORD
         c-:pa;
       END;
PROCEDURE Init*(VAR x:exp);
BEGIN
  NEW(x.c);
  x.c.b:="Hello, world!";
END Init;
BEGIN
END export.

<*+MAIN*>
MODULE test;
IMPORT st:=STextIO,e:=export;
VAR
  a:e.exp;
  b:CHAR;
BEGIN
  e.Init(a);
  st.WriteString(a.c.b);
  st.WriteLn;
  st.ReadChar(b);
END test.

MODULE Export;
TYPE
  p_abs=POINTER TO abs;
  proc=PROCEDURE(x:p_abs;x:BOOLEAN):LONGINT;
  abs*=RECORD
         init:BOOLEAN;
         pr-:proc;
       END;
PROCEDURE Init*(VAR x:abs;p:proc);
BEGIN
  IF p#NIL THEN
           x.pr:=p;
           x.init:=TRUE;
  ELSE
      x.init:=FALSE;
  END;
END Init;
PROCEDURE Do*(x:abs);
BEGIN
  ASSERT(x.init);
END Do;
BEGIN
END Export.

TYPE
  (* Аналог записи ABSTRACT с процедурами ABSTRACT *)
  p_abstract=POINTER TO abstract;
  pr_abstract=PROCEDURE(x:p_abstract;x:BOOLEAN):LONGINT;
  abstract*=RECORD
              init:BOOLEAN;
              pr-:pr_abstract;
            END;
  (* Аналог нерасширяемой записи *)
  p_final*=POINTER TO final;
  final=RECORD
          a*:LONGINT;
          b*:CHAR;
        END;
  (* Аналог записи LIMITED *)
  p_limited=POINTER TO limited;
  limited=RECORD
            a*:CHAR;
            b*:BOOLEAN;
          END;
  export*=RECORD
            p-:p_limited;
          END;
  (* Аналог метода read-only - только для имплементации *)
  p_read=POINTER TO read;
  pr_read=PROCEDURE(p:p_read;x:BOOLEAN):LONGINT;
  read*=RECORD
          a*:BOOLEAN;
          pr:pr_read;
        END;
PROCEDURE Init_abstract*(VAR x:abstract;p:pr_abstract);
BEGIN
  IF p#NIL THEN
           x.pr:=p;
           x.init:=TRUE;
  ELSE
      x.init:=FALSE;
  END;
END Init_abstract;
PROCEDURE Run_abstract*(x:abstract);
BEGIN
  ASSERT(x.init);
END Run_abstract;
PROCEDURE Do_read(x:p_read;y:BOOLEAN):LONGINT;
BEGIN
  x^.a:=y;
  RETURN 1;
END Do_read;
PROCEDURE Init_read*(VAR x:read;p:pr_read);
BEGIN
  IF p#NIL THEN
           x.pr:=p;
  ELSE
      x.pr:=Do_read;
  END;
END Init_read;
PROCEDURE Run_read*(x:read);
BEGIN
  IF x.pr=NIL THEN
              x.pr:=Do_read;
  END;
END Run_read;

MODULE abstract;
TYPE
  tbp*=RECORD
       END;
  pp*=RECORD
        pr*:PROCEDURE();
      END;
PROCEDURE (VAR a:tbp) proc*();
BEGIN
  HALT();
END proc;
BEGIN
END abstract.

MODULE limited;
TYPE
  pl=POINTER TO l;
  l=RECORD
      a*:LONGINT;
    END;
VAR
  p-:pl;
  vl*:l;
PROCEDURE Init*();
BEGIN
  NEW(p);
  p^.a:=1;
END Init;
BEGIN
  vl.a:=-1;
END limited.

MODULE final;
TYPE
  pf*=POINTER TO f;
  f=RECORD
      a*:LONGINT;
    END;
  exp*=RECORD
         b*:f;
       END;
BEGIN
END final.

MODULE readonly;
TYPE
  prro=PROCEDURE(x:BOOLEAN):SHORTINT;
  ro*=RECORD
        pr:prro;
      END;
PROCEDURE Default(x:BOOLEAN):SHORTINT;
BEGIN
  CASE x OF
       FALSE:RETURN 0;
       ELSE RETURN -1;
  END;
END Default;
PROCEDURE Init*(VAR a:ro;p:prro);
BEGIN
  IF p=NIL THEN
           a.pr:=Default;
  ELSE
      a.pr:=p;
  END;
END Init;
PROCEDURE Run*(a:ro):SHORTINT;
BEGIN
  IF a.pr=NIL THEN
              a.pr:=Default;
  END;
  RETURN a.pr(TRUE);
END Run;
BEGIN
END readonly.

<*+MAIN*>
MODULE record;
IMPORT st:=STextIO,sw:=SWholeIO,ma:=abstract,mf:=final,ml:=limited,mr:=readonly;
TYPE
  tbp=RECORD(ma.tbp)
      END;
VAR
  rtbp:tbp;
  rpp:ma.pp;
  pf:mf.pf;
  exp:mf.exp;
  ro:mr.ro;
  c:CHAR;
PROCEDURE procpp();
BEGIN
  st.WriteString('Procedure variable');
  st.WriteLn;
END procpp;
PROCEDURE (VAR a:tbp) proc();
BEGIN
  st.WriteString('Type-bound procedure');
  st.WriteLn;
END proc;
PROCEDURE New(x:BOOLEAN):SHORTINT;
BEGIN
  CASE x OF
       FALSE:RETURN 0;
       ELSE RETURN 1;
  END;
END New;
BEGIN
  (* Проверка работы с абстрактными записями (идентификатор ABSTRACT) *)
  st.WriteString('Checking work with abstract records');
  st.WriteLn;
  rtbp.proc();
  rpp.pr:=procpp;
  rpp.pr();
  (* Проверка работы с нерасширяемыми записями (без идентификатора) *)
  st.WriteString('Checking work with non-expandable records');
  st.WriteLn;
  NEW(pf);
  pf^.a:=-1;
  sw.WriteInt(pf^.a,0);
  st.WriteLn;
  exp.b.a:=1;
  sw.WriteInt(exp.b.a,0);
  st.WriteLn;
  (* Проверка работы с ограниченными записями (идентификатор LIMITED) *)
  st.WriteString('Checking work with limited records');
  st.WriteLn;
  ml.Init();
  sw.WriteInt(ml.p^.a,0);
  st.WriteLn;
  sw.WriteInt(ml.vl.a,0);
  st.WriteLn;
  (* Метод read-only - только для имплементации *)
  st.WriteString("Read-only method - for implementation only");
  st.WriteLn;
  sw.WriteInt(mr.Run(ro),0);
  st.WriteLn;
  mr.Init(ro,New);
  sw.WriteInt(mr.Run(ro),0);
  st.WriteLn;
  st.WriteString('Press any key to end the program');
  st.WriteLn;
  st.ReadChar(c);
END record.