BEGIN; !TAKEON: CONVERT IMP15 GRAMMAR
CONSTINTEGER GRAMMAR=1, OLDFILE=2; !IN STREAMS
CONSTINTEGER REPORT=0, NEWFILE=1, GLIST=2, DLIST=3; !OUT STREAMS
CONSTINTEGER IDENT=70
CONSTINTEGER LASTBIT=512, EXIT=0
OWNINTEGER CHARMAX=0, NMAX=-1, INITS=0
OWNINTEGER NEWNAME=0
INTEGER SYM,GMIN,GMAX,KMAX
BYTEINTEGERARRAY CHAR(1:600)
INTEGERARRAY INDEX(0:127)
INTEGERARRAY ITEM,NEXT(0:255)
INTEGERARRAY INITIAL(1:79)
INTEGERARRAY KEYDICT(32:511)
const integer phrase min = 112
const integer atom max = 111
integer array phrase(phrase min:255)
integer array atomic(80:111)
ROUTINE READ SYM
CYCLE
READ SYMBOL(SYM) UNTIL SYM # ' '
RETURN UNLESS SYM = '-' AND NEXTSYMBOL = NL
SKIP SYMBOL
REPEAT
END
ROUTINE PRINT CHARS(INTEGER P)
PRINT SYMBOL(CHAR(P)) AND P=P+1 WHILE CHAR(P) # 0
END
ROUTINE PRINT NAME(INTEGER N)
PRINT CHARS(INDEX(N&127))
WHILE N&384 # 0 CYCLE
PRINT SYMBOL('<'); N = N-128
REPEAT
END
ROUTINE READ NAME(INTEGERNAME N)
INTEGER I,J,K,M
I = CHARMAX
CYCLE
I = I+1; CHAR(I) = SYM
READ SYMBOL(SYM)
EXIT UNLESS 'A'<=SYM<='Z' OR '0'<=SYM<='9' OR SYM=''''
REPEAT
I = I+1; CHAR(I) = 0
READ SYM IF SYM = ' '
M = NMAX
WHILE M >= 0 CYCLE
J = INDEX(m); K = CHARMAX+1
WHILE J # 0 AND CHAR(J) = CHAR(K) CYCLE
->OK IF CHAR(J) = 0
J = J+1; K = K+1
REPEAT
M = M-1
REPEAT
OK: IF NEWNAME # 0 START
IF M >= 0 START
PRINTTEXT 'DUPLICATE: '
PRINT CHARS(CHARMAX+1)
NEWLINE
FINISH
INDEX(N) = CHARMAX+1; CHARMAX = I
NMAX = N IF NMAX < N
FINISH ELSE START
IF M < 0 START
PRINTTEXT 'UNKNOWN: '
PRINT CHARS(CHARMAX+1)
NEWLINE
M = 0
FINISH
N = M
FINISH
END
ROUTINE READ GRAMMAR
OWNINTEGER MINMIN=0, MAXMAX=0
INTEGER I,J,K,L,P,MIN,MAX,EXP,END
INTEGERARRAY CONVERTED(-100:150), HEAD,TAIL(-100:-1), TOKEN,LINK(1:150)
INTEGERARRAY MAP(0:255)
INTEGERFN CELL(INTEGER H,T)
!CREATES A LIST CELL, IF NECESSARY, WITH HEAD H AND TAIL T
INTEGER I
I = T; I = 0 IF I > 0
WHILE I # MIN CYCLE
I = I-1
RESULT = I IF HEAD(I) = H AND TAIL(I) = T
REPEAT
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
HX=X AND X=Y AND Y=HX IF X < Y
IF X >= 0 START
RESULT = CELL(X,Y) IF Y >= 0
HY = HEAD(Y)
RESULT = CELL(X,Y) IF X > HY
RESULT = CELL(HY,UNION(X,TAIL(Y))) IF X # HY
RESULT = Y
FINISH
HX = HEAD(X); HY = HEAD(Y)
RESULT = CELL(HX,UNION(TAIL(X),Y)) IF HX > HY
RESULT = CELL(HY,UNION(X,TAIL(Y))) IF HX # HY
RESULT = CELL(HX,UNION(TAIL(X),TAIL(Y)))
END
ROUTINE CONCATENATE(INTEGER X,Y)
INTEGER I,J
I = X
UNTIL I = X CYCLE
J = LINK(I); LINK(I) = Y; I = J
REPEAT
END
ROUTINE ACCEPT EXP(INTEGERNAME EXP,EXP END)
!INPUTS A REGULAR EXPRESSION AND CREATES INTERMEDIATE GRAPH REPRESENTATION
INTEGER I,STRING,STRING END,UNIT,UNIT END
EXP = 0
S: STRING = 0
U: IF SYM = '(' START
READ SYM
ACCEPT EXP(UNIT,UNIT END)
->ERR IF UNIT = 0 OR SYM # ')'
READ SYM
FINISH ELSE START
IF 'A' <= SYM <= 'Z' START
READ NAME(I)
I = I+128 AND READ SYM WHILE SYM = '<'
FINISH ELSE START
->ERR IF SYM # '+'
I = 0
I = I+128 AND READ SYM WHILE SYM = '+'
FINISH
MAX = MAX+1; TOKEN(MAX) = I; LINK(MAX) = MAX
UNIT = MAX; UNIT END = MAX
FINISH
IF SYM = '*' OR SYM = '!' START
MAX = MAX+1; TOKEN(MAX) = -1; 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 = '?' START
MAX = MAX+1; TOKEN(MAX) = -1
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
->U UNLESS SYM = ',' OR SYM = ')' OR SYM = NL
IF EXP = 0 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 = ','
READ SYM UNTIL SYM # NL
->S
ERR:EXP = 0
END
ROUTINE CONVERT
INTEGER I,J,COUNT,M,N,GMAX1,LOOPSTOP
ROUTINE TCOUNT(INTEGER X)
INTEGER T
CYCLE
RETURN IF X = 0
IF X < 0 START
TCOUNT(TAIL(X))
X = HEAD(X)
FINISH
T = TOKEN(X)
EXIT IF T >= 0
RETURN IF T = LOOPSTOP
TOKEN(X) = LOOPSTOP
X = LINK(X)
REPEAT
COUNT = COUNT-1
END
ROUTINE ADD COMPONENTS(INTEGER X)
OWNINTEGER I,T,TC,U,UC
WHILE X # 0 CYCLE
IF X < 0 START
ADD COMPONENTS(TAIL(X))
X = HEAD(X)
FINISH
T = TOKEN(X)
EXIT IF T >= 0
RETURN IF T = LOOPSTOP
TOKEN(X) = LOOPSTOP
X = LINK(X)
REPEAT
IF X # 0 THEN X = LINK(X) ELSE T = EXIT
TC = T&127
I = GMAX1
CYCLE
I = I+1
EXIT IF I > GMAX
U = ITEM(I)
NEXT(I)=UNION(NEXT(I),X) AND RETURN IF U = T
UC = U&127
IF UC = TC OR (UC > ATOMMAX AND TC > ATOMMAX) START
PRINTTEXT 'CLASH: ';
PRINT NAME(U); SPACE; PRINT NAME(T)
NEWLINE
FINISH
IF TC = IDENT OR (TC<UC AND UC>=PHRASEMIN) OR UC = 0 START
CYCLE I = GMAX,-1,I
ITEM(I+1) = ITEM(I)
NEXT(I+1) = NEXT(I)
REPEAT
EXIT
FINISH
REPEAT
GMAX = GMAX+1
ITEM(I) = T; NEXT(I) = X
END
LOOPSTOP = -1; GMIN = GMAX+1
CYCLE I = MIN,1,MAX
CONVERTED(I) = 0
REPEAT
N = NEXT(0)
1: GMAX1 = GMAX
LOOPSTOP = LOOPSTOP-1
ADD COMPONENTS(N)
ITEM(GMAX) = ITEM(GMAX)+LASTBIT
IF GMAX1 = 0 START
INITS = GMAX
INITS = INITS-1 WHILE INITS # 0 AND ITEM(INITS)&127 >= PHRASEMIN
FINISH
CONVERTED(N) = GMAX+1
M = 0
CYCLE I = GMIN,1,GMAX
J = NEXT(I)
IF J # 0 START
COUNT = CONVERTED(J)
IF COUNT = 0 START
LOOPSTOP = LOOPSTOP-1
TCOUNT(J)
CONVERTED(J) = COUNT
FINISH
IF COUNT < M START
M = COUNT; N = J
FINISH
FINISH
REPEAT
->1 IF M # 0
CYCLE I = GMIN,1,GMAX
J = NEXT(I)
J = CONVERTED(J) IF J # 0
NEXT(I) = J
REPEAT
END; !CONVERT
ROUTINE MINIMIZE
INTEGER I,J,K,M,N
INTEGERARRAY STACK(1:150)
INTEGERFN ULT MAP(INTEGER I)
INTEGER J
J=I AND I=MAP(I) UNTIL I = J OR I = 0
RESULT = J
END
INTEGERFN EQUIVALENT(INTEGER NN,MM)
INTEGER I,J,K,POS1,POS2
POS1 = 0; POS2 = 0
1: CYCLE
K = ITEM(MM)
->9 UNLESS ITEM(NN) = K
I = NEXT(NN); J = NEXT(MM)
->9 IF (I=0 AND J#0) OR (I#0 AND J=0)
POS1 = POS1+1; STACK(POS1) = NN; MAP(NN) = MM
NN = NN+1; MM = MM+1
EXIT IF K&LASTBIT # 0
REPEAT
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 START
I = NN; NN = MM; MM = I
FINISH
->1 IF NN > N
9: WHILE POS1 # 0 CYCLE
I = STACK(POS1); MAP(I) = I
POS1 = POS1-1
REPEAT
RESULT = 0
END
CYCLE I = 0,1,GMAX
MAP(I) = I
REPEAT
CYCLE N = GMIN,1,GMAX
IF MAP(N) = N START
IF N = GMIN OR ITEM(N-1)&LASTBIT # 0 START
M = 1
WHILE M # N CYCLE
EXIT IF MAP(M) = M AND EQUIVALENT(N,M) # 0
M = M+1
REPEAT
FINISH
FINISH ELSE START
MAP(N) = ULT MAP(N)
FINISH
REPEAT
J = GMIN-1
CYCLE I = GMIN,1,GMAX
K = MAP(I)
IF K = I 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)
NEXT(I) = MAP(K) IF K # 0
REPEAT
END; !MINIMIZE
GMAX = 0
1: READ SYM UNTIL SYM # NL
->10 IF SYM = '/'
IF SYM = 'S' AND NEXT SYMBOL = 'S' START
SKIP SYMBOL; P = 0
FINISH ELSE START
READ NAME(P); ->9 UNLESS PHRASEMIN <= P <= 127
FINISH
MIN = 0; MAX = 0
READ SYM UNTIL SYM # NL AND SYM # '-' AND SYM # '>'
ACCEPT EXP(EXP,END)
->9 IF EXP = 0 OR SYM # NL
CONCATENATE(END,0)
ITEM(0) = 1023; NEXT(0) = EXP
CONVERT
MINMIN = MIN IF MIN < MINMIN
MAXMAX = MAX IF MAX > MAXMAX
I = GMIN
MINIMIZE AND I=MAP(GMIN) UNLESS P = 112; !APP
SELECT OUTPUT(GLIST)
IF P = 0 START; !SS
CYCLE I = 1,1,GMAX
J = ITEM(I); K = NEXT(I)
IF K # 0 START
K = K-INITS; STOP IF K <= 0
FINISH
IF I <= INITS START
L = J&127
->99 IF L >= PHRASEMIN
L = ATOMIC(L) IF L >= 80
MONITOR 25 IF INITIAL(L) # 0
INITIAL(L) = j<<8+K;! j was jj ***
FINISH ELSE START
ITEM(I-INITS) = J; NEXT(I-INITS) = K
FINISH
99: REPEAT
GMAX = GMAX-INITS
FINISH ELSE START
PHRASE(P) = I
PRINT NAME(P); PRINTTEXT ' =>'
WRITE(I,1)
FINISH
K = LASTBIT
CYCLE I = GMIN,1,GMAX
IF K&LASTBIT # 0 START
NEWLINE; WRITE(I,3); J = 0
FINISH
J = J+1
IF J > 5 START
NEWLINE; SPACES(4); J = 1
FINISH
SPACES(3)
K = ITEM(I)
IF K&127 # 0 START
PRINT NAME(K)
FINISH ELSE START
PRINTTEXT '*E'
PRINT SYMBOL('+') AND K=K-128 WHILE K&384 # 0
FINISH
WRITE(NEXT(I),1)
REPEAT
NEWLINE
SELECT OUTPUT(REPORT)
->1
9: PRINT NAME(P) AND NEWLINE IF P # 0
PRINTTEXT 'WRONG FORMAT AT: '
K = 0
WHILE SYM # NL OR K = ',' OR K = '-' CYCLE
PRINT SYMBOL(SYM); K = SYM; READ SYMBOL(SYM)
REPEAT
NEWLINE
->1
10: PRINTTEXT 'MIN ='; WRITE(MINMIN,1)
PRINTTEXT ' MAX ='; WRITE(MAXMAX,1)
NEWLINE
!DEAL WITH INITIAL PHRASE
!ASSUMES EXACTLY ONE (IMP)
P = PHRASE(ITEM(1)&127)
MONITOR 26 IF P = 0
CYCLE
J = ITEM(P); K = J&127
MONITOR 27 IF K >= PHRASEMIN
K = ATOMIC(K) IF K >= 80
MONITOR 28 IF INITIAL(K) # 0
INITIAL(K) = (J&127+LASTBIT)<<8+NEXT(P)
EXIT IF J&LASTBIT # 0
P = P+1
REPEAT
SELECT OUTPUT(GLIST)
NEWLINES(2)
CYCLE I = 1,1,79
K = INITIAL(I)
IF K # 0 START
WRITE(I,2); PRINTTEXT ': '
PRINT NAME(K>>8); WRITE(K&255,3)
NEWLINE
FINISH
REPEAT
SELECT OUTPUT(REPORT)
END; !READ GRAMMAR
ROUTINE READ ATOMS
INTEGER I,J,K,DICT,DMAX,CODE,CLASS,SUB
INTEGERARRAY CHAR,CONT,ALT(0:450)
ROUTINE READ CODE
CODE = NEXT SYMBOL; SUB = 0
IF CODE # ',' AND CODE # NL START
SKIP SYMBOL
RETURN UNLESS CODE = '('
READ(SUB)
SKIP SYMBOL
FINISH
CODE = CLASS+128
END
ROUTINE INSERT WORD(INTEGERNAME X)
CYCLE
CODE = NL IF CODE = '$'
WHILE CHAR(X) < CODE CYCLE
CONT(X) = SUB IF CONT(X) = 0
X == ALT(X)
REPEAT
IF CHAR(X) # CODE START
DMAX = DMAX+1; CHAR(DMAX) = CODE
CONT(DMAX) = 0; ALT(DMAX) = X; X = DMAX
FINISH
EXIT IF CODE&128 # 0
READ CODE
X == CONT(X)
REPEAT
CONT(X) = SUB
END
ROUTINE STORE(INTEGER X)
INTEGER M,N,V
CYCLE
KMAX = KMAX+1; N = KMAX
M = ALT(X)
STORE(M) AND M=-131072 IF M # 0
V = CHAR(X); X = CONT(X)
EXIT IF V&128 # 0
IF M = 0 START; !NO ALTERNATIVES
IF ALT(X) = 0 AND CHAR(X)&128 = 0 START
V = CHAR(X)<<7+V; X = CONT(X)
FINISH
FINISH ELSE START
V = (KMAX+1)<<7+V-131072
FINISH
KEYDICT(N) = V
REPEAT
KEYDICT(N) = M + 65536 + X<<6 + V&63
END
DICT = 0; DMAX = 0; CHAR(0) = 999
1: CYCLE
SYM = NEXT SYMBOL
EXIT UNLESS SYM = '[' OR SYM = NL
READ SYMBOL(SYM) UNTIL SYM = NL
REPEAT
->10 IF SYM = '/'
READ(CLASS)
NEWNAME = 1
READ SYM; READ NAME(CLASS)
NEWNAME = 0
IF CLASS < 80 START
IF SYM # '[' START
CYCLE
CODE = SYM; INSERT WORD(DICT)
READ SYMBOL(SYM)
EXIT IF SYM # ','
READ SYMBOL(SYM) UNTIL SYM # ' ' AND SYM # NL
REPEAT
FINISH
FINISH ELSE START
IF CLASS < PHRASEMIN AND SYM = '=' START
READ SYM; READ NAME(ATOMIC(CLASS))
FINISH
FINISH
READ SYMBOL(SYM) WHILE SYM # NL
->1
ROUTINE DISPLAY(INTEGER I,S)
INTEGER J
1: J = KEYDICT(I)
IF J&65536 = 0 START
PRINT SYMBOL(J&127)
IF J > 0 START
J = J>>7
PRINT SYMBOL(J) AND S=S+1 IF J # 0
SPACE
I = I+1; S = S+2
->1
FINISH
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
10: SELECT OUTPUT(DLIST); NEWLINES(2)
KMAX = 95; KEYDICT(32) = 0
CYCLE I = 33,1,95
PRINT SYMBOL(I); SPACE
IF CHAR(DICT) = I START
J = (KMAX+1)<<2
STORE(CONT(DICT))
DICT = ALT(DICT)
DISPLAY(J>>2,2)
FINISH ELSE START
PRINT SYMBOL('?'); NEWLINE
J = 32<<2
FINISH
!LET:0 DIG:1 TERM:2 OTHER:3
J = J+3 UNLESS 'A'<=I<='Z'
J = J-2 IF '0'<=I<='9'
J = J-1 IF I = ';'
KEYDICT(I) = J
REPEAT
NEWLINES(2)
SELECT OUTPUT(REPORT)
END
INTEGER I,J,K
CHARMAX = 0
CYCLE I = 1,1,127; INDEX(I) = 0; REPEAT
CYCLE I = 1,1,79; INITIAL(I) = 0; REPEAT
SELECT OUTPUT(REPORT)
READ SYMBOL(I) UNTIL I = '/'
READ SYMBOL(I) UNTIL I = NL
READ ATOMS
READ SYMBOL(I) UNTIL I = NL
READ GRAMMAR
!WRITE REQUIRED VALUES
SELECT OUTPUT(NEWFILE)
SELECT INPUT(OLDFILE); FAULT 9 ->EOF
I = 0
CYCLE
READ SYMBOL(K); PRINT SYMBOL(K)
I = 1 IF K = '!' AND NEXT SYMBOL = '*'
EXIT IF I = 1 AND K = NL
REPEAT
EOF:PRINTTEXT '%OWNINTEGER GMAX1='; WRITE(GMAX,0)
NEWLINE
PRINTTEXT '%OWNINTEGER GMAX='; WRITE(GMAX,0)
NEWLINES(2)
PRINTTEXT '%OWNINTEGERARRAY PHRASE(112:127) = %C'
CYCLE I = 112,1,127
NEWLINE IF I&7 = 0
WRITE(phrase(I),3)
PRINT SYMBOL(',') UNLESS I = 127
REPEAT
NEWLINES(2)
PRINTTEXT '%OWNINTEGERARRAY ATOMIC(80:111) = %C'
CYCLE I = 80,1,111
NEWLINE IF I&7 = 0
WRITE(atomic(I),3)
PRINT SYMBOL(',') UNLESS I = 111
REPEAT
NEWLINES(2)
INTEGERFN PACKED(INTEGER J,K)
K = (J&896)<<1+K
J = J&127
RESULT = K<<7+J
END
PRINTTEXT '%OWNINTEGERARRAY INITIAL(1:79) = %C'
NEWLINE; SPACES(9)
CYCLE I = 1,1,79
NEWLINE IF I&7 = 0
WRITE(PACKED(INITIAL(I)>>8,INITIAL(I)&255),7)
PRINT SYMBOL(',') UNLESS I = 79
REPEAT
NEWLINES(2)
PRINTTEXT '%OWNINTEGERARRAY GRAM(0:255) = %C'
CYCLE I = 0,1,255
NEWLINE IF I&7 = 0
K = 0
K = PACKED(ITEM(I)!!512,NEXT(I)) IF I # 0 AND I <= GMAX
WRITE(K,7)
PRINT SYMBOL(',') UNLESS I = 255
REPEAT
NEWLINES(2)
PRINTTEXT '%OWNINTEGERARRAY KDICT(32:'; WRITE(KMAX,0)
PRINTTEXT ') = %C'
CYCLE I = 32,1,KMAX
NEWLINE IF I&7 = 0
WRITE(KEYDICT(I),7)
PRINT SYMBOL(',') UNLESS I = KMAX
REPEAT
NEWLINES(2)
FAULT 9 ->99
CYCLE
EXIT IF NEXT SYMBOL = '!'
READ SYMBOL(K) UNTIL K = NL
REPEAT
CYCLE
READ SYMBOL(K); PRINT SYMBOL(K)
REPEAT
99:
ENDOFPROGRAM