Skip to content

Instantly share code, notes, and snippets.

@luser-dr00g
Last active August 29, 2015 13:57
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save luser-dr00g/9519896 to your computer and use it in GitHub Desktop.
Save luser-dr00g/9519896 to your computer and use it in GitHub Desktop.
%1 http://www.ams.org/journals/mcom/1954-08-046/
/init{
P{ %check P for validity
W 1 ne {ERROR:W_p!=1} if
}forall
/Ptab <<
P {
dup
} forall
>>def
}def
%2 The Language.
/L{length}def % length of string
/T{ % i D tail(i) of string
2 copy L le{ % i<=L(D)
dup length 2 index sub % i D L(D)-i
3 2 roll getinterval % D[L-i.*i]
}{ % i>L(D)
exch pop % D
}ifelse
}def
/H{ % i D head(i) of string
2 copy L le{ % i<=L(D)
0 % i D 0
3 2 roll getinterval % D[0.*i]
}{
exch pop % D
}ifelse
}def
/W{ % weight of string or char
dup type /integertype eq {
Wtab exch get
}{
0 exch { W add } forall
}ifelse
}def
%Wtab{exch =only( )=only =}forall
%(KAxyz)W =
/D{ % D(d) = 1 - W(d) degree of operator or 0 for constant
1 exch W sub
}def
/Wmax{ % Wmax(D) = Max(W[T_i(D)]) for i > 0
[ exch
1 1 2 index L { % [ ... D i
1 index T % [ ... D T(i,D)
W
exch % [ ... W(T(i,D)) D
} for
pop % [ ... W(T(i,D))
counttomark 0 eq { pop 0 }{
{
counttomark 1 eq { exch pop exit } if
2 copy lt { exch } if pop
}loop
}ifelse
}def
/Wmin{ % Wmin(D) = Min(W[T_i(D)]) for i > 0
[ exch
1 1 2 index L { % [ ... D i
1 index T % [ ... D T(i,D)
W
exch % [ ... W(T(i,D)) D
} for
pop % [ ... W(T(i,D))
counttomark 0 eq { pop 0 }{
{
counttomark 1 eq { exch pop exit } if
2 copy gt { exch } if pop
} loop
}ifelse
}def
%(KAxyz) Wmax =
%(KAxyz) Wmin =
/PF{ % D is positive formula
Wmin 0 gt
}def
/WFF{ % D is well-formed formula
dup PF exch W 1 eq and
}def
/Ptoi{ % P -> i
P exch search {
length exch pop exch pop
}{
pop -1
}ifelse
}def
/itoP{ % i -> P
P exch 1 getinterval
}def
/F{
dup 0 get
D 0 gt { % ie. an operator
dup 0 get % (...) K|A|N
exch % K|A|N (...)
1 1 index length 1 sub getinterval % kan (..)
exch Ftab exch get exec % F(d,..)
}{ % leave it alone. F(p)=p
}ifelse
}def
%(K00) F =
%(K01) F =
%(K10) F =
%(K11) F =
/is-var{
dup W 1 eq exch Ptoi 0 lt and
}def
%3 The Machine.
/G{
dup is-var { % d is a variable G(d).within.P
S exch get
itoP
}{ % do nothing G(d)=d
} ifelse
}def
/cat{
2 copy length exch length add string % a b s
3 1 roll 3 copy pop % s a b s a
0 exch putinterval % s' a b
3 copy exch length exch putinterval % s'' a b
pop pop
}def
/E{ % dDel|()
dup L 0 eq {
% do nothing
}{
dup PF {
dup 0 1 getinterval exch % d dDel
1 1 index length 1 sub getinterval % d Del
1 index D exch % d D(d) Del
E % d D(d) E(Del)
dup dup L 3 index sub % d D(d) E(Del) E(Del) L(E(Del))-D(d)
exch T % d D(d) E(Del) T_a(E(Del))
4 1 roll % T_a(E(Del)) d D(d) E(Del)
H % T_a(E(Del)) d H_D(E(Del))
exch G % T_a(E(Del)) H_D(E(Del)) S(d)
exch cat F % T_a(E(Del)) F(S(d)H_D(E(Del)))
exch cat % F(S(d)H_D(E(Del)))T_a(E(Del))
} if
}ifelse
}def
% Parameters
/Wtab 1 dict def % weights of alphabet
1 0 1 255{Wtab exch 2 index put}for pop
0 (N) {Wtab exch 2 index put}forall pop
-1 (KA) {Wtab exch 2 index put}forall pop
/P(01)def % constants (data alphabet)
/Ftab << % definition of functions
(K)0 get { % crack 2 args from string and convert to indices
dup 0 1 getinterval Ptoi
exch 1 1 getinterval Ptoi
and % perform function
itoP % convert result back to alphabet P
}
(A)0 get {
dup 0 1 getinterval Ptoi
exch 1 1 getinterval Ptoi
xor
itoP
}
(N)0 get {
0 1 getinterval Ptoi
1 add 2 mod
itoP
}
>>def
/S<< % specification of variables
(p) 1
(q) 0
(r) 0
>>def
init
(0) E =
(p) E =
(pKpqNr) E =
@luser-dr00g
Copy link
Author

It produces the desired output:
0
1
101

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment