Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.postscript > #1822

Lukasiewicz Logic Interpreter

Show all headers | View raw

https://gist.github.com/luser-dr00g/9519896


%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 = % => 0
(p) E = % => 0
(pKpqNr) E = => 101

Back to comp.lang.postscript | Previous | Next | Find similar | Unroll thread

Thread

Lukasiewicz Logic Interpreter luser- -droog <mijoryx@yahoo.com> - 2014-03-12 21:28 -0700

csiph-web