Ternary logic: Difference between revisions
Content added Content deleted
m (→note added) |
m (→{{header|REXX}}: added whitespace, aligned statements.) |
||
| Line 4,514: | Line 4,514: | ||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
||
scan: procedure; parse arg x,at; L=length(x); t=L; lp=0; apost=0; quote=0 |
scan: procedure; parse arg x,at; L=length(x); t=L; lp=0; apost=0; quote=0 |
||
if at<0 then do; t=1; x=translate(x, '()', ")("); end |
if at<0 then do; t=1; x= translate(x, '()', ")("); end |
||
do j=abs(at) to t by sign(at); _=substr(x,j,1); __=substr(x,j,2) |
do j=abs(at) to t by sign(at); _=substr(x,j,1); __=substr(x,j,2) |
||
| Line 4,525: | Line 4,525: | ||
apost=0; iterate |
apost=0; iterate |
||
end |
end |
||
if _=='"' then do; quote=1; |
if _=='"' then do; quote=1; iterate; end |
||
if _=="'" then do; apost=1; |
if _=="'" then do; apost=1; iterate; end |
||
if _==' ' then iterate |
if _==' ' then iterate |
||
if _=='(' then do; lp=lp+1; |
if _=='(' then do; lp=lp+1; iterate; end |
||
if lp\==0 then do; if _==')' |
if lp\==0 then do; if _==')' then lp=lp-1; iterate; end |
||
if datatype(_,'U') then return j - (at<0) |
if datatype(_,'U') then return j - (at<0) |
||
if at<0 then return j + 1 |
if at<0 then return j + 1 |
||
| Line 4,535: | Line 4,535: | ||
return min(j,L) |
return min(j,L) |
||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
||
changeFunc: procedure; parse arg z,fC,newF; funcPos=0 |
changeFunc: procedure; parse arg z,fC,newF; funcPos= 0 |
||
do forever |
do forever |
||
funcPos=pos(fC, z, funcPos + 1); if funcPos==0 then return z |
funcPos= pos(fC, z, funcPos + 1); if funcPos==0 then return z |
||
origPos=funcPos |
origPos= funcPos |
||
z=changestr(fC, z, ",'"newF"',") |
z= changestr(fC, z, ",'"newF"',") |
||
funcPos=funcPos + length(newF) + 4 |
funcPos= funcPos + length(newF) + 4 |
||
where=scan(z, funcPos) ; z=insert( '}', z, where) |
where= scan(z, funcPos) ; z= insert( '}', z, where) |
||
where=scan(z, 1 - origPos) ; z=insert('trit{', z, where) |
where= scan(z, 1 - origPos) ; z= insert('trit{', z, where) |
||
end /*forever*/ |
end /*forever*/ |
||
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
/*──────────────────────────────────────────────────────────────────────────────────────*/ |
||
trit: procedure; arg a,$,b; |
trit: procedure; arg a,$,b; v= \(a==2 | b==2); o= (a==1 | b==1); z= (a==0 | b==0) |
||
select |
select |
||
when $=='FALSE' then return 0 |
when $=='FALSE' then return 0 |
||
when $=='AND' then if v then return a & b; else return 2 |
when $=='AND' then if v then return a & b; else return 2 |
||
when $=='NAIMPB' then if v then return \(\a & \b); else return 2 |
when $=='NAIMPB' then if v then return \(\a & \b); else return 2 |
||
when $=='BOOLB' then return b |
when $=='BOOLB' then return b |
||
when $=='NBIMPA' then if v then return \(\b & \a); else return 2 |
when $=='NBIMPA' then if v then return \(\b & \a); else return 2 |
||
when $=='BOOLA' then return a |
when $=='BOOLA' then return a |
||
when $=='XOR' then if v then return a && b ; else return 2 |
when $=='XOR' then if v then return a && b ; else return 2 |
||
when $=='OR' then if v then return a | b ; else if o then return 1 |
when $=='OR' then if v then return a | b ; else if o then return 1 |
||
else return 2 |
else return 2 |
||
when $=='NOR' then if v then return \(a | b) ; else return 2 |
when $=='NOR' then if v then return \(a | b) ; else return 2 |
||
when $=='XNOR' then if v then return \(a && b) ; else return 2 |
when $=='XNOR' then if v then return \(a && b) ; else return 2 |
||
when $=='NOTB' then if v then return \b ; else return 2 |
when $=='NOTB' then if v then return \b ; else return 2 |
||
when $=='NOTA' then if v then return \a ; else return 2 |
when $=='NOTA' then if v then return \a ; else return 2 |
||
when $=='AIMPB' then if v then return \(a & \b) ; else return 2 |
when $=='AIMPB' then if v then return \(a & \b) ; else return 2 |
||
when $=='NAND' then if v then return \(a & b) ; else if z then return 1 |
when $=='NAND' then if v then return \(a & b) ; else if z then return 1 |
||
else return 2 |
else return 2 |
||
when $=='TRUE' then return 1 |
when $=='TRUE' then return 1 |
||
otherwise return -13 |
otherwise return -13 /*error, unknown function.*/ |
||
end /*select*/ |
end /*select*/ |
||
</lang> |
|||
Some older REXXes don't have a '''changestr''' BIF, so one is included here ──► [[CHANGESTR.REX]]. |
Some older REXXes don't have a '''changestr''' BIF, so one is included here ──► [[CHANGESTR.REX]]. |
||
<br><br> |
<br><br> |
||