%BEGIN; !TAKEON: CONVERT IMP15 GRAMMAR
%OWNINTEGER GRA=1, OLD=2;                   !IN STREAMS
%OWNINTEGER ERR=0, NEW=1, GLIST=2, DLIST=3; !OUT STREAMS
%OWNINTEGER SSBASE=92
%OWNINTEGER EOP=0, NMAX=-1
%INTEGER SYM,COUNT,ORDINAL,CHARMAX,GMIN,GMAX,KMAX
%INTEGERARRAY CHAR(1:600),INDEX(0:127)
%INTEGERARRAY ITEM,NEXT(0:255),PHRASE(SSBASE:111),ATOMIC(64:111)
%INTEGERARRAY KEYDICT(32:511)
%FAULT 9 ->99

%ROUTINE READ SYM
1:  READ SYMBOL(SYM);  ->1 %IF SYM = ' '
%END

%ROUTINE READ NAME(%INTEGERNAME N)
%INTEGER I,J,K
    I = CHARMAX
1:  I = I+1;  CHAR(I) = SYM
    READ SYMBOL(SYM)
    ->1 %IF 'A' <= SYM <= 'Z' %OR '0' <= SYM <= '9' %OR SYM = ''''
    I = I+1;  CHAR(I) = 0
    N = -1
2:  ->5 %IF N = NMAX
    N = N+1
    J = INDEX(N);  K = CHARMAX+1
3:  ->2 %IF J = 0 %OR CHAR(J) # CHAR(K)
    ->9 %IF CHAR(J) = 0
    J = J+1;  K = K+1
    ->3
5:  N = N+1;  NMAX = N
    INDEX(N) = CHARMAX+1;  CHARMAX = I
9:  READ SYM %IF SYM = ' '
%END

%ROUTINE PRINT NAME(%INTEGER N)
    N = INDEX(N&127)
1:  PRINT SYMBOL(CHAR(N));  N = N+1
    ->1 %IF CHAR(N) # 0
%END

%ROUTINE READ GRAMMAR
%INTEGER I,J,P,MIN,MAX,EXP,END,TERMINAL
%INTEGERARRAY CONVERTED(-100:125), HEAD,TAIL(-100:-1), TOKEN,LINK(1:125)
%INTEGERARRAY MAP(0:255)

%INTEGERFN NEW(%INTEGER H,T)
%INTEGER I
    I = T;  I = 0 %IF I > 0
1:  ->2 %IF I = MIN
    I = I-1
    %RESULT = I %IF HEAD(I) = H %AND TAIL(I) = T
    ->1
2:  MIN = MIN-1;  HEAD(MIN) = H;  TAIL(MIN) = T
    CONVERTED(MIN) = 0
    %RESULT = MIN
%END

%INTEGERFN UNION(%INTEGER X,Y)
%INTEGER HX,HY
    %RESULT = X %IF X = Y
    %RESULT = UNION(Y,X) %IF X < Y
    %IF X >= 0 %THEN %START
        %RESULT = NEW(X,Y) %IF Y >= 0
        HY = HEAD(Y)
        %RESULT = NEW(X,Y) %IF X > HY
        %RESULT = NEW(HY,UNION(X,TAIL(Y))) %IF X # HY
        %RESULT = UNION(X,TAIL(Y))
    %FINISH
    HX = HEAD(X);  HY = HEAD(Y)
    %RESULT = NEW(HX,UNION(TAIL(X),Y)) %IF HX > HY
    %RESULT = NEW(HY,UNION(X,TAIL(Y))) %IF HX # HY
    %RESULT = NEW(HX,UNION(TAIL(X),TAIL(Y)))
%END

%ROUTINE CONCATENATE(%INTEGER X,Y)
%INTEGER I,J
    I = X
1:  J = LINK(I);  LINK(I) = Y;  I = J
    ->1 %UNLESS I = X
%END

%ROUTINE ACCEPT EXP(%INTEGERNAME EXP,EXP END)
%INTEGER I,STRING,STRING END,UNIT,UNIT END
    EXP = 0
1:  STRING = 0
2:  %IF SYM = '(' %THEN %START
        READ SYM
        ACCEPT EXP(UNIT,UNIT END)
        ->9 %UNLESS UNIT # 0 %AND SYM = ')'
        READ SYM
    %FINISH %ELSE %START
        ->9 %UNLESS 'A' <= SYM <= 'Z'
        READ NAME(I)
3:      %IF SYM = '<' %THEN %START
            I = I+128
            READ SYM
            ->3
        %FINISH
        MAX = MAX+1;  TOKEN(MAX) = I;  LINK(MAX) = MAX
        UNIT = MAX;  UNIT END = MAX
    %FINISH
    %IF SYM = '*' %OR SYM = '!' %THEN %START
        MAX = MAX+1;  TOKEN(MAX) = 0;  LINK(MAX) = MAX
        MIN = MIN-1;  HEAD(MIN) = MAX;  TAIL(MIN) = UNIT
        CONCATENATE(UNIT END,MIN);  UNIT END = MAX
        UNIT = MIN %IF SYM = '*'
        READ SYM
    %FINISH
    %IF SYM = '?' %THEN %START
        MAX = MAX+1;  TOKEN(MAX) = 0
        LINK(MAX) = LINK(UNIT END);  LINK(UNIT END) = MAX
        MIN = MIN-1;  HEAD(MIN) = MAX;  TAIL(MIN) = UNIT
        UNIT = MIN
        READ SYM
    %FINISH
    %IF STRING=0 %THEN STRING=UNIT %ELSE CONCATENATE(STRING END,UNIT)
    STRING END = UNIT END
    ->2 %UNLESS SYM = ',' %OR SYM = ')' %OR SYM = NL
    %IF EXP = 0 %THEN %START
        EXP = STRING;  EXP END = STRING END
    %FINISH %ELSE %START
        EXP = UNION(STRING,EXP)
        I = LINK(EXP END);  LINK(EXP END) = LINK(STRING END)
        LINK(STRING END) = I
    %FINISH
    %RETURN %UNLESS SYM = ','
8:  READ SYM;  ->8 %IF SYM = NL
    ->1
9:  EXP = 0
%END

%ROUTINE CONVERT
%INTEGER I,J,K,L,M,N,GMAX1,LOOP STOP

%ROUTINE TCOUNT(%INTEGER X)
%INTEGER T
1:  %RETURN %IF X = 0
    %IF X < 0 %THEN %START
        TCOUNT(TAIL(X))
        X = HEAD(X)
    %FINISH
    T = TOKEN(X)
    %IF T <= 0 %THEN %START
        %RETURN %IF T = LOOP STOP
        TOKEN(X) = LOOP STOP
        X = LINK(X)
        ->1
    %FINISH
    K = K-1
%END

%ROUTINE ADD COMPONENTS(%INTEGER X)
%OWNINTEGER I,J,K,T
1:  %IF X # 0 %THEN %START
        %IF X < 0 %THEN %START
            ADD COMPONENTS(TAIL(X))
            X = HEAD(X)
        %FINISH
        T = TOKEN(X)
        %IF T <= 0 %THEN %START
            %RETURN %IF T = LOOP STOP
            TOKEN(X) = LOOP STOP;  X = LINK(X)
            ->1
        %FINISH
        I = GMAX1;  X = LINK(X)
2:      %IF I # GMAX %THEN %START
            I = I+1;  K = ITEM(I)
            %IF K # T %THEN %START
                K = K&127
                ->2 %UNLESS K>=96 %OR K=48 %OR (K>=64 %AND ATOMIC(K)=48)
                ->2 %UNLESS T&127 < K
                %CYCLE I = GMAX,-1,I
                    ITEM(I+1) = ITEM(I)
                    NEXT(I+1) = NEXT(I)
                %REPEAT
                GMAX = GMAX+1
                ITEM(I) = T;  NEXT(I) = X
            %FINISH %ELSE NEXT(I) = UNION(NEXT(I),X)
        %FINISH %ELSE %START
            GMAX = GMAX+1
            ITEM(GMAX) = T;  NEXT(GMAX) = X
        %FINISH
    %FINISH %ELSE TERMINAL = 512
%END

    LOOP STOP = 0;  GMIN = GMAX+1
    %CYCLE I = MIN,1,MAX
        CONVERTED(I) = 0
    %REPEAT
    N = NEXT(0)
1:  GMAX1 = GMAX
    LOOP STOP = LOOP STOP - 1
    TERMINAL = 0
    ADD COMPONENTS(N)
    %IF TERMINAL # 0 %THEN %START
        GMAX = GMAX+1
        ITEM(GMAX) = 0;  NEXT(GMAX) = 0
    %FINISH
    ITEM(GMAX) = ITEM(GMAX)+512
    CONVERTED(N) = GMAX1+1
    M = 0
    %CYCLE I = GMIN,1,GMAX
        J = NEXT(I)
        %IF J # 0 %THEN %START
            K = CONVERTED(J)
            %IF K = 0 %THEN %START
                LOOP STOP = LOOP STOP - 1
                TCOUNT(J)
                CONVERTED(J) = K
            %FINISH
            %IF K < M %THEN %START
                M = K;  N = J
            %FINISH
        %FINISH
    %REPEAT
    ->1 %IF M # 0
    %CYCLE I = GMIN,1,GMAX
        K = NEXT(I)
        %IF K # 0 %THEN K = CONVERTED(K) %ELSE K = EOP
        NEXT(I) = K
    %REPEAT
%END;  !CONVERT

%ROUTINE MINIMIZE
%INTEGER I,J,K,M,N
%INTEGERARRAY STACK(1:150)

%INTEGERFN ULT MAP(%INTEGER I)
%INTEGER J
1:  J = I;  I = MAP(I);  ->1 %UNLESS I = J %OR I = 0
    %RESULT = J
%END

%INTEGERFN EQUIVALENT(%INTEGER NN,MM)
%INTEGER I,J,K,POS1,POS2
    POS1 = 0;  POS2 = 0
1:  K = ITEM(MM)
    ->9 %UNLESS ITEM(NN) = K
    I = NEXT(NN);  J = NEXT(MM)
    ->9 %UNLESS I = J %OR (255#I#0 %AND 255#J#0)
    POS1 = POS1+1;  STACK(POS1) = NN;  MAP(NN) = MM
    NN = NN+1;  MM = MM+1
    ->1 %IF K&512 = 0
2:  %RESULT = 1 %IF POS2 = POS1
    POS2 = POS2+1;  I = STACK(POS2)
    NN = ULT MAP(NEXT(I));  MM = ULT MAP(NEXT(MAP(I)))
    ->2 %IF NN = MM
    %IF NN < MM %THEN %START
        I = NN;  NN = MM;  MM = I
    %FINISH
    ->1 %IF NN > N
9:  %RESULT = 0 %IF POS1 = 0
    I = STACK(POS1);  MAP(I) = I;  POS1 = POS1-1
    ->9
%END

    %CYCLE I = 0,1,255;  MAP(I) = I;  %REPEAT
    %CYCLE N = GMIN,1,GMAX
        %IF MAP(N) = N %THEN %START
            ->4 %IF N # GMIN %AND ITEM(N-1)&512 = 0
            M = 1
2:          %IF M # N %THEN %START
                ->4 %IF MAP(M) = M %AND EQUIVALENT(N,M) # 0
                M = M+1
                ->2
            %FINISH
        %FINISH %ELSE %START
            MAP(N) = ULT MAP(N)
        %FINISH
4:  %REPEAT
    J = GMIN-1
    %CYCLE I = GMIN,1,GMAX
        K = MAP(I)
        %IF K = I %THEN %START
            J = J+1;  MAP(I) = J
            ITEM(J) = ITEM(I);  NEXT(J) = NEXT(I)
        %FINISH %ELSE %START
            MAP(I) = MAP(K)
        %FINISH
    %REPEAT
    GMAX = J
    %CYCLE I = GMIN,1,GMAX
        K = NEXT(I)
        %IF K # 0 %THEN %START
            NEXT(I) = MAP(K)
        %FINISH
    %REPEAT
%END;  !MINIMIZE

    GMAX = 0
1:  READ SYM;  ->1 %IF SYM = NL
    %RETURN %IF SYM = '/'
    %IF SYM = 'S' %AND NEXT SYMBOL = 'S' %THEN %START
        SKIP SYMBOL;  READ(I);  P = SSBASE+I;  EOP = 0
    %FINISH %ELSE %START
        READ NAME(P);  EOP = 0255
    %FINISH
    MIN = 0;  MAX = 0
2:  READ SYM;  ->2 %IF SYM = NL %OR SYM = '-' %OR SYM = '>'
    ACCEPT EXP(EXP,END)
    %IF EXP = 0 %OR SYM # NL %THEN %START
        %PRINTTEXT 'WRONG FORMAT AT: '
3:      PRINT SYMBOL(SYM);  ->1 %IF SYM = NL
        READ SYM
        ->3
    %FINISH
    CONCATENATE(END,0)
    ITEM(0) = 1023;  NEXT(0) = EXP
    CONVERT
    MINIMIZE %UNLESS P = 111;               !APP
    PHRASE(P) = GMIN
    SELECT OUTPUT(GLIST)
    %CYCLE I = GMIN,1,GMAX
        %IF I = 1 %OR ITEM(I-1)&512 # 0 %THEN %START
            NEWLINE;  WRITE(I,3);  J = 0
        %FINISH
        J = J+1
        %IF J > 5 %THEN %START
            NEWLINE;  SPACES(4);  J = 1
        %FINISH
        SPACES(3)
        %IF ITEM(I)&511 # 0 %THEN %START
            PRINT NAME(ITEM(I)&127)
            WRITE(NEXT(I),1)
        %FINISH %ELSE %PRINTTEXT '*E*'
    %REPEAT
    NEWLINE;  SELECT OUTPUT(ERR)
    ->1
%END;  !READ GRAMMAR

%ROUTINE READ ATOMS
%INTEGER I,J,K,L,P,S,T
%INTEGERARRAY CHAR,CONT,ALT(0:450)

%ROUTINE READ S
    S = NEXT SYMBOL;  T = 0
    %IF S # ',' %AND S # NL %THEN %START
        %UNLESS '0' <= S <= '9' %THEN %START
            SKIP SYMBOL
            %RETURN %UNLESS S = '('
        %FINISH
        READ(T)
        SKIP SYMBOL %IF NEXT SYMBOL = ')'
    %FINISH
    S = K+128
%END

%ROUTINE INSERT IN(%INTEGERNAME X)
    %IF CHAR(X) < S %THEN %START
        CONT(X) = T %IF CONT(X) = 0
        INSERT IN(ALT(X));  %RETURN
    %FINISH
    %IF CHAR(X) # S %THEN %START
        J = J+1;  CHAR(J) = S
        CONT(J) = 0;  ALT(J) = X;  X = J
    %FINISH
    %IF S&128 = 0 %THEN %START
        READ S;  INSERT IN (CONT(X))
    %FINISH %ELSE %START
        T = CONT(ALT(J)) %IF T = 0 %AND ALT(J) # 0
        CONT(J) = T
    %FINISH
%END

%ROUTINE STORE(%INTEGER X)
%INTEGER M,N
1:  %RETURN %IF X = 0
2:  KMAX = KMAX+1;  M = KMAX
    ->2 %IF P # 0 %AND CHAR(X) > M
    %IF ALT(X) # 0 %THEN %START
        STORE(ALT(X));  N = \131071
    %FINISH %ELSE N = 0
    %IF CHAR(X)&128 = 0 %THEN %START
        KMAX = 95 %IF KMAX < 95
        KEYDICT(M) = N + (KMAX+1)<<7 + CHAR(X)
        X = CONT(X);  P = 0
        ->1
    %FINISH
    KEYDICT(M) = N + 65536 + CONT(X)<<6 + CHAR(X)&63
%END

    I = 0;  J = 0;  CHAR(0) = 999
1:  SYM = NEXT SYMBOL
    ->5 %IF SYM = '[' %OR SYM = NL
    ->6 %IF SYM = '/'
    READ(ORDINAL)
    %STOP %IF ORDINAL <= NMAX
    NMAX = ORDINAL-1
    READ SYM;  READ NAME(K)
    %STOP %IF K # ORDINAL
    %IF K >= 64 %THEN %START
        ->1 %UNLESS SYM = '/'
        READ SYM;  READ NAME(L)
        %STOP %IF L = NMAX
        ATOMIC(K) = L
        ->1
    %FINISH
    ->5 %IF SYM = '['
3:  S = SYM;  INSERT IN(I)
    ->1 %IF NEXT SYMBOL = NL
    SKIP SYMBOL
4:  READ SYMBOL(SYM);  ->4 %IF SYM = ' ' %OR SYM = NL
    ->3
5:  READ SYMBOL(SYM);  ->5 %UNLESS SYM = NL
    ->1
6:  %CYCLE J = 32,1,95;  KEYDICT(J) = 0;  %REPEAT
    KMAX = 32;  P = 1;  STORE(I)
    KEYDICT(94) = KEYDICT(92);  !EQUATE UPARROW TO BACKSLASH

%ROUTINE DISPLAY(%INTEGER I,S)
%INTEGER J
1:  J = KEYDICT(I)
    %IF I = 32 %THEN %START
        PRINT SYMBOL('?');  NEWLINE;  %RETURN
    %FINISH
    %IF J&65536 = 0 %THEN %START
        PRINT SYMBOL(J&127);  SPACE
        DISPLAY(J>>7&511,S+2)
    %FINISH %ELSE %START
        PRINT SYMBOL(':');  PRINT NAME(J&63)
        WRITE(J>>6&1023,1);  NEWLINE
    %FINISH
    %RETURN %IF J >= 0
    SPACES(S);  I = I+1
    ->1
%END
    SELECT OUTPUT(DLIST);  NEWLINES(2)
    %CYCLE I = 33,1,95
        J = (KEYDICT(I)>>7&511)<<2;  J = 32<<2 %IF J = 0
        J = J+3 %UNLESS 'A'<=I<='Z';  J = J-2 %IF '0'<=I<='9'
        J = J-1 %IF I = ';'
        KEYDICT(I) = J
        PRINT SYMBOL(I);  SPACE;  DISPLAY(J>>2,2)
    %REPEAT
    NEWLINES(2)
    SELECT OUTPUT(ERR)
%END

%INTEGER I,J,K
    CHARMAX = 0
    %CYCLE I = 1,1,127;  INDEX(I) = 0;  %REPEAT
    %CYCLE I = 64,1,111;  ATOMIC(I) = I;  %REPEAT
    %CYCLE I = 96,1,111;  PHRASE(I) = 0;  %REPEAT
1:  READ SYMBOL(I);  ->1 %UNLESS I = '/'
2:  READ SYMBOL(I);  ->2 %UNLESS I = NL
    READ ATOMS
3:  READ SYMBOL(I);  ->3 %UNLESS I = NL
    READ GRAMMAR
!WRITE REQUIRED VALUES
    SELECT OUTPUT(NEW)
    WRITE(GMAX,1);  WRITE(KMAX,1)
5:  WRITE(PHRASE(SSBASE),1)
    SSBASE = SSBASE+1
    ->5 %IF SSBASE < 96
    NEWLINE
    %CYCLE I = 96,1,111
        NEWLINE %IF I&7 = 0
        WRITE(PHRASE(I),3)
    %REPEAT
    NEWLINE
    %CYCLE I = 64,1,111
        NEWLINE %IF I&7 = 0
        WRITE(ATOMIC(I),7)
    %REPEAT
    NEWLINE
    %CYCLE I = 1,1,255
        NEWLINE %IF (I-1)&7 = 0
        K = 0
        %IF I <= GMAX %THEN %START
            J = ITEM(I)
            K = -131072 %IF J&512 = 0
            K = (J&384)<<8+K
            K = NEXT(I)<<7+K
            K = J&127+K
        %FINISH
        WRITE(K,7)
    %REPEAT
    NEWLINE
    %CYCLE I = 32,1,511
        NEWLINE %IF (I-1)&7 = 0
        WRITE(KEYDICT(I),7)
    %REPEAT
    NEWLINES(2)
    SELECT INPUT(OLD)
10: READ SYMBOL(I);  ->10 %UNLESS I = '%' %OR I = '!'
20: PRINT SYMBOL(I);  READ SYMBOL(I);  ->20
99:
%ENDOFPROGRAM