Truth table: Difference between revisions

m
m (→‎{{header|Wren}}: Minor tidy)
 
(30 intermediate revisions by 13 users not shown)
Line 19:
*   [http://www.google.co.uk/search?q=truth+table&hl=en&client=firefox-a&hs=Om7&rls=org.mozilla:en-GB:official&prmd=imvns&tbm=isch&tbo=u&source=univ&sa=X&ei=C0uuTtjuH4Wt8gOF4dmYCw&ved=0CDUQsAQ&biw=941&bih=931&sei=%20Jk-uTuKKD4Sg8QOFkPGcCw some "truth table" examples from Google].
<br><br>
 
=={{header|11l}}==
<syntaxhighlight lang="11l">T Symbol
String id
Int lbp
Int nud_bp
Int led_bp
(ASTNode -> ASTNode) nud
((ASTNode, ASTNode) -> ASTNode) led
 
F set_nud_bp(nud_bp, nud)
.nud_bp = nud_bp
.nud = nud
 
F set_led_bp(led_bp, led)
.led_bp = led_bp
.led = led
 
T Var
String name
Int value
F (name)
.name = name
[Var] vars
 
T ASTNode
Symbol& symbol
Int var_index
ASTNode? first_child
ASTNode? second_child
 
F eval()
S .symbol.id
‘(var)’
R :vars[.var_index].value
‘|’
R .first_child.eval() [|] .second_child.eval()
‘^’
R .first_child.eval() (+) .second_child.eval()
‘&’
R .first_child.eval() [&] .second_child.eval()
‘!’
R ~.first_child.eval() [&] 1
‘(’
R .first_child.eval()
E
assert(0B)
R 0
 
[String = Symbol] symbol_table
[String] tokens
V tokeni = -1
ASTNode token_node
 
F advance(sid = ‘’)
I sid != ‘’
assert(:token_node.symbol.id == sid)
:tokeni++
:token_node = ASTNode()
I :tokeni == :tokens.len
:token_node.symbol = :symbol_table[‘(end)’]
R
V token = :tokens[:tokeni]
I token[0].is_alpha()
:token_node.symbol = :symbol_table[‘(var)’]
L(v) :vars
I v.name == token
:token_node.var_index = L.index
L.break
L.was_no_break
:token_node.var_index = :vars.len
:vars.append(Var(token))
E
:token_node.symbol = :symbol_table[token]
 
F expression(rbp = 0)
ASTNode t = move(:token_node)
advance()
V left = t.symbol.nud(move(t))
L rbp < :token_node.symbol.lbp
t = move(:token_node)
advance()
left = t.symbol.led(t, move(left))
R left
 
F parse(expr_str) -> ASTNode
:tokens = re:‘\s*(\w+|.)’.find_strings(expr_str)
:tokeni = -1
:vars.clear()
advance()
R expression()
 
F symbol(id, bp = 0) -> &
I id !C :symbol_table
V s = Symbol()
s.id = id
s.lbp = bp
:symbol_table[id] = s
R :symbol_table[id]
 
F infix(id, bp)
F led(ASTNode self, ASTNode left)
self.first_child = left
self.second_child = expression(self.symbol.led_bp)
R self
symbol(id, bp).set_led_bp(bp, led)
 
F prefix(id, bp)
F nud(ASTNode self)
self.first_child = expression(self.symbol.nud_bp)
R self
symbol(id).set_nud_bp(bp, nud)
 
infix(‘|’, 1)
infix(‘^’, 2)
infix(‘&’, 3)
prefix(‘!’, 4)
 
F nud(ASTNode self)
R self
symbol(‘(var)’).nud = nud
symbol(‘(end)’)
 
F nud_parens(ASTNode self)
V expr = expression()
advance(‘)’)
R expr
symbol(‘(’).nud = nud_parens
symbol(‘)’)
 
L(expr_str) [‘!A | B’, ‘A ^ B’, ‘S | ( T ^ U )’, ‘A ^ (B ^ (C ^ D))’]
print(‘Boolean expression: ’expr_str)
print()
ASTNode p = parse(expr_str)
print(vars.map(v -> v.name).join(‘ ’)‘ : ’expr_str)
L(i) 0 .< (1 << vars.len)
L(v) vars
v.value = (i >> (vars.len - 1 - L.index)) [&] 1
print(v.value, end' ‘ ’)
print(‘: ’p.eval())
print()</syntaxhighlight>
 
{{out}}
<pre style="height: 40ex; overflow: scroll">
Boolean expression: !A | B
 
A B : !A | B
0 0 : 1
0 1 : 1
1 0 : 0
1 1 : 1
 
Boolean expression: A ^ B
 
A B : A ^ B
0 0 : 0
0 1 : 1
1 0 : 1
1 1 : 0
 
Boolean expression: S | ( T ^ U )
 
S T U : S | ( T ^ U )
0 0 0 : 0
0 0 1 : 1
0 1 0 : 1
0 1 1 : 0
1 0 0 : 1
1 0 1 : 1
1 1 0 : 1
1 1 1 : 1
 
Boolean expression: A ^ (B ^ (C ^ D))
 
A B C D : A ^ (B ^ (C ^ D))
0 0 0 0 : 0
0 0 0 1 : 1
0 0 1 0 : 1
0 0 1 1 : 0
0 1 0 0 : 1
0 1 0 1 : 0
0 1 1 0 : 0
0 1 1 1 : 1
1 0 0 0 : 1
1 0 0 1 : 0
1 0 1 0 : 0
1 0 1 1 : 1
1 1 0 0 : 0
1 1 0 1 : 1
1 1 1 0 : 1
1 1 1 1 : 0
 
</pre>
 
=={{header|8080 Assembly}}==
 
This program runs under CP/M and takes the Boolean expression on the command line.
 
<syntaxhighlight lang="8080asm"> ;;; CP/M truth table generator
;;; Supported operators:
;;; ~ (not), & (and), | (or), ^ (xor) and => (implies)
;;; Variables are A-Z, constants are 0 and 1.
putch: equ 2
puts: equ 9
TVAR: equ 32
TCONST: equ 64
TOP: equ 96
TPAR: equ 128
TMASK: equ 31
TTYPE: equ 224
org 100h
lxi h,80h ; Have we got a command line argument?
mov a,m
ana a
lxi d,noarg ; If not, print error message and stop.
mvi c,puts
jz 5
add l ; Otherwise, 0-terminate the argument string
inr a
mov l,a
mvi m,0
inx h
mvi m,'$' ; And $-terminate it also for error messages
lxi h,opstk ; Pointer to operator stack on the system stack
push h
lxi h,80h ; Start of command line
lxi b,expr ; Start of expression (output queue for shunting yard)
parse: inx h
mvi a,' ' ; Ignore all whitespace
cmp m
jz parse
mov a,m ; Load current character
ana a ; Done?
jz pdone
mov d,a ; Store copy in D
ori 32 ; Check for variable
sui 'a'
cpi 26
jnc pconst ; If not variable, go check constants
ori TVAR ; It _is_ a variable
stax b ; Store token
inx b
jmp parse ; Next token
pconst: mov a,d ; Restore character
sui '0' ; 0 or 1 are constants
cpi 2
jnc pparen ; If not constant, go check parenthesis
ori TCONST ; It _is_ a constant
stax b ; Store token
inx b
jmp parse
pparen: mov a,d ; Restore character
sui '(' ; ( and ) are parentheses
jz ppopen ; Open parenthesis
dcr a
jnz poper ; If not ( or ), check operators
xthl ; Closing parenthesis - get operator stack
closep: mov a,l ; If at beginning, missing ( - give error
ana a
jz emiss
dcx h ; Back up pointer
mov a,m ; Found it?
cpi TPAR
jnz closes ; If not, keep scanning
xthl ; Get input string back
jmp parse ; Keep parsing
closes: stax b ; Not parenthesis - put token in output queue
inx b
jmp closep ; And keep going
ppopen: xthl ; Get operator stack
mvi m,TPAR ; Store open parenthesis
inx h
xthl ; Get input string
jmp parse
poper: push h ; Check tokens - keep input string
mvi e,0 ; Counter
lxi h,opers ; Operator pointer
opscan: mov a,m ; Check against character
cmp d ; Found it?
jz opfind
inr e ; Increment counter
ana a ; Otherwise, is it zero?
inx h
jnz opscan ; If not, keep scanning
eparse: lxi d,pserr ; It is zero - print a parse error
mvi c,puts
call 5
pop d
mvi c,puts
call 5
rst 0
opfind: cpi '=' ; Special case - is it '='?
jnz opfin2 ; If so it should be followed by '>'
xthl
inx h
mov a,m
xthl
cpi '>'
jnz eparse ; '=' not part of '=>' is parse error
opfin2: mvi d,0 ; Look up the precedence for this operator
lxi h,prec
dad d
mov d,m ; Store it in D (D=prec E=operator number)
pop h ; Restore input string
xthl ; Get operator stack pointer
oppop: mov a,l ; At beginning of operator stack?
ana a
jz oppush ; Then done - push current operator
dcx h ; Check what's on top
mov a,m
inx h
cpi TPAR ; Parenthesis?
jz oppush ; Then done - push current operator
push b ; Store output pointer for a while
push h ; As well as operator stack pointer
mvi b,0 ; Get index of operator from stack
ani TMASK
mov c,a
lxi h,prec ; Find precedence
dad b
mov a,m ; Load precedence into A
pop h ; Restore operator stack pointer
pop b ; As well as output pointer
cmp d ; Compare to operator from input
jc oppush ; If input precedence higher, then push operator
dcx h ; Otherwise, pop from operator stack,
mov a,m
stax b ; And store in output queue
inx b
jmp oppop ; Keep popping from operator stack
oppush: mov a,e ; Get input operator
ori TOP
mov m,a ; Store on operator stack
inx h
xthl ; Switch to input string
jmp parse
emiss: lxi d,missp ; Error message for missing parentheses
mvi c,puts
call 5
rst 0
pdone: pop h ; Get operator stack pointer
ppop: mov a,l ; Pop whatever is left off
ana a
jz cntvar
dcx h
mov a,m ; Get value
cpi TPAR ; If we find a paranthesis then the parentheses
jz emiss ; don't match
stax b ; Store in output queue
inx b
jmp ppop
cntvar: stax b ; Zero-terminate the expression
lxi h,vused+25 ; See which variables are used in the expr
xra a
vzero: mov m,a
dcr l
jp vzero
lxi d,expr
vscan: ldax d ; Load expression element
inx d ; Next one next time
ana a ; Was it zero?
jz vdone ; Then we're done
mov b,a ; Store copy
ani TTYPE ; Is it a variable?
cpi TVAR
jnz vscan ; If not, ignore it
mov a,b
ani TMASK
mov l,a ; If so, mark it
inr m
jmp vscan
vdone: call eval ; Run the evaluation once to catch errors
lxi h,vused ; Print header
mvi b,0 ; Character counter
varhdr: mov a,m ; Current variable used?
ana a
jz varnxt ; If not, skip it
inr b ; Two characters
inr b
push h ; Keep registers
push b
mvi c,putch ; Print letter
mov a,l
adi 'A'
mov e,a
call 5
mvi c,putch ; Print space
mvi e,' '
call 5
pop b ; Restore registers
pop h
varnxt: inr l
mov a,l
cpi 26
jnz varhdr
inr b ; Two characters for "| "
inr b
push b
lxi d,dvdr
mvi c,puts
call 5
pop b
lxi h,81h ; Print expression
exhdr: inr b ; One character
push b
push h
mov e,m
mvi c,putch
call 5
pop h
pop b
mov a,m ; Until zero reached
ana a
inx h
jnz exhdr
push b ; Keep count
lxi d,nwln ; Print newline
mvi c,puts
call 5
pop b
linhdr: push b ; Print dashes
mvi c,putch
mvi e,'-'
call 5
pop b
dcr b
jnz linhdr
lxi h,vars ; Set all variables to 0
xra a
zero: mov m,a
inr l
jnz zero
mloop: lxi d,nwln ; Print newline
mvi c,puts
call 5
lxi h,vars ; Print current state
lxi d,vused
lxi b,1A00h
pstate: ldax d ; Is variable in use?
ana a
jz pnext ; If not, try next one
mov c,e ; Keep highest used variable
mov a,m ; Otherwise, get value
ani 1 ; 0 or 1
ori '0'
push b ; Keep state
push d
push h
mvi c,putch ; Print variable
mov e,a
call 5
mvi c,putch ; And space
mvi e,' '
call 5
pop h ; Restore state
pop d
pop b
pnext: inx h ; Print next one
inx d
dcr b
jnz pstate
push b ; Keep last variable
lxi d,dvdr ; Print "| "
mvi c,puts
call 5
call eval ; Evaluate expr using current state
ani 1 ; Print result
ori '0'
mvi c,putch
mov e,a
call 5
pop b ; Restore last used variable
inr c
lxi h,vars ; Find next state
lxi d,vused
istate: ldax d ; Is variable in use?
ana a
jz inext ; If not, try next one
mov a,m ; Otherwise, get value
ana a ; Is it zero?
jnz iinc ; If not, keep going,
inr m ; But if so, set it to one
jmp mloop ; And print next state
iinc: dcr m ; If one, set it to zero
inext: inx d ; And try next variable
inx h
dcr c ; Test if we have variables left
jnz istate ; If not, try next one
rst 0 ; But if so, we're done
eval: lxi b,expr ; Evaluate the expression
lxi h,opstk ; Evaluation stack
eloop: ldax b ; Load expression element
inx b
ana a ; Done?
jz edone
mov d,a ; Keep copy
ani TTYPE
cpi TCONST ; Constant?
jz econst
cpi TVAR ; Variable?
jz evar
mov a,d ; Otherwise it's an operator
ani TMASK
mov d,a
ana a ; Not?
jnz e2
dcr l ; Error if stack empty
jm errop
mov a,m ; Not
cma
mov m,a
inr l
jmp eloop
e2: dcr l ; 2 values needed - error if stack empty
mov e,m ; Right hand value
dcr l
mov a,m ; Left hand value
jm errop
dcr d ; And?
jz eand
dcr d ; Or?
jz eor
dcr d ; Xor?
jz exor
eimpl: ana a ; Implies - if A=1 then E else 1
jnz e_lde
mvi m,-1
inr l
jmp eloop
e_lde: mov m,e
inr l
jmp eloop
exor: xra e
jmp estore
eor: ora e
jmp estore
eand: ana e
estore: mov m,a
inr l
jmp eloop
econst: mov a,d ; Constant
ani TMASK
mov m,a
inr l
jmp eloop
evar: mov a,d ; Variable
ani TMASK
push h
mvi h,vars/256
mov l,a
mov a,m
pop h
mov m,a
inr l
jmp eloop
edone: dcr l ; Should be at 0
mov a,m
rz
lxi d,mop ; Missing operator (not all values used)
jmp errop+3
errop: lxi d,mval ; Missing operand (stack underflow)
mvi c,puts
call 5
rst 0
nwln: db 13,10,'$'
dvdr: db '| $'
noarg: db 'Please enter a boolean expression on the command line.$'
missp: db 'Missing parenthesis.$'
pserr: db 'Parse error at: $'
mval: db 'Missing operand.$'
mop: db 'Missing operator.$'
opers: db '~&|^=',0 ; Operators - note that impl is actually =>
prec: db 4,3,2,2,1 ; Precedence
opstk: equ ($/256)*256+256 ; Operator stack (for shunting yard)
vars: equ opstk+256 ; Space for variables
vused: equ vars+256 ; Marks which variables are used
expr: equ vused+26 ; Parsed expression is stored here</syntaxhighlight>
 
{{out}}
 
<pre>A>truth80 A & B
A B | A & B
-------------
0 0 | 0
1 0 | 0
0 1 | 0
1 1 | 1
A>truth80 (S=>H) & (H=>M) => (S=>M)
H M S | (S=>H) & (H=>M) => (S=>M)
-----------------------------------
0 0 0 | 1
1 0 0 | 1
0 1 0 | 1
1 1 0 | 1
0 0 1 | 1
1 0 1 | 1
0 1 1 | 1
1 1 1 | 1</pre>
 
=={{header|ALGOL 68}}==
{{works with|ALGOL 68G|Any - tested with release 2.8.3.win32}}
Uses the Algol 68G specific evaluate procedure to evaluate the Boolean expressions. The expressions must therefore be infix and valid Algol 68 boolean expressions.
<langsyntaxhighlight lang="algol68"># prints the truth table of a boolean expression composed of the 26 lowercase variables a..z, #
# the boolean operators AND, OR, XOR and NOT and the literal values TRUE and FALSE #
# The evaluation is done with the Algol 68G evaluate function which is an extension #
Line 104 ⟶ 702:
DO
print truth table( expr )
OD</langsyntaxhighlight>
{{out}}
<pre>
Line 145 ⟶ 743:
expression>
</pre>
 
=={{header|Amazing Hopper}}==
<p>Hopper can be converted into a dedicated application, making use of macro substitution.</p>
<p>Main program:<p>
<syntaxhighlight lang="c">
#include basica/booleanos.h
 
#include <basico.h>
 
 
algoritmo
 
variables( R0,R1,R2,R3,R4,T0,T1,T2,T3,T4,T5,T6 )
 
VARS=3
preparar valores de verdad
 
preparar cabecera {
"A","B","C","|","[A=>B","&","B=>C]","=>","A=>C"
 
} enlistar en 'cabecera'
 
expresión lógica a evaluar {
 
OP=>( A, B ), :: 'R1'
OP=>( B, C ), :: 'R2'
OP&( R1, R2 ), :: 'R0'
OP=>( A, C ), :: 'R3'
OP=>( R0, R3 )
 
} :: 'R4'
 
unir columnas( tabla, tabla, separador tabla, R1, R0, R2, R4, R3 )
 
insertar cabecera y desplegar tabla
/* =============== otro ================== */
VARS=2, preparar valores de verdad
 
preparar cabecera {
"A","B","|","value: A=>B <=> ~AvB"
} enlistar en 'cabecera'
expresión lógica a evaluar {
OP<=>( OP=>(A,B), OP|(OP~(A), B) )
 
} :: 'R0'
unir columnas( tabla, tabla, separador tabla, R0 )
 
insertar cabecera y desplegar tabla
 
/* =============== otro ================== */
VARS=4, preparar valores de verdad
preparar cabecera {
"A","B","C","D","|","[~AvB","&","A=>C","&","(B","=>","(C=>D))]","=>","A=>C"
} enlistar en 'cabecera'
expresión lógica a evaluar {
OP|( OP~(A), B) :: 'R0'
OP=>(A,C) :: 'R1'
OP&( R0, R1 ) :: 'T0'
OP=>( C,D ) :: 'R2'
OP=>( B, R2 ) :: 'T2'
OP&( T0, T2 ) :: 'T3'
OP=>( T3, R1)
 
} :: 'T4'
unir columnas( tabla, tabla, separador tabla, R0, T0,R1, T3, B, T2, R2, T4, R1)
 
insertar cabecera y desplegar tabla
 
/* =============== otro ================== */
 
VARS=2, preparar valores de verdad
preparar cabecera {
"A","B","~A","~B","A&B","AvB","A^B","A=>B","A<=>B","A~&B","A~vB"
} enlistar en 'cabecera'
expresión lógica a evaluar {
OP~(A) :: 'R0'
OP~(B) :: 'R1'
OP&(A,B) :: 'T0'
OP|(A,B) :: 'T1'
OP^(A,B) :: 'T2'
OP=>(A,B) :: 'T3'
OP<=>(A,B) :: 'T4'
OP~&(A,B) :: 'T5'
OP~|(A,B) :: 'T6'
 
}
unir columnas( tabla, tabla, R0,R1,T0,T1,T2,T3,T4, T5, T6)
 
insertar cabecera y desplegar tabla
 
/* =============== otro ================== */
VARS=1, preparar valores de verdad
preparar cabecera { "A","~A" } enlistar en 'cabecera'
unir columnas( tabla, tabla, OP~(A) )
 
insertar cabecera y desplegar tabla
terminar
</syntaxhighlight>
<p>"booleano.h" header file:</p>
<syntaxhighlight lang="c">
/* BOOLEANOS.H */
#context-free preparaciondedatos
fijar separador (NULO)
 
c=""
tamaño binario (VARS)
#( lpad("0",VARS,"0") ), separar para (tabla)
#( TOTCOMB = 2^VARS )
iterar para (i=1, #(i< TOTCOMB), ++i)
i, cambiar a base(2), quitar laterales, mover a 'c',
#( lpad("0",VARS,c) ); separar para (fila)
unir filas ( tabla, tabla, fila )
 
siguiente
replicar( "|", TOTCOMB ), separar para (separador tabla)
 
retornar\\
 
#define A V(1)
#define B V(2)
#define C V(3)
#define D V(4)
#define E V(5)
#define F V(6)
#define G V(7)
#define H V(8)
// etcétera
#define V(_X_) {1}{_X_}loc2;{TOTCOMB}{0}offset2;get(tabla);xtonum
 
#define-a :: mov
 
#defn OP<=>(_X_,_Y_) #RAND; _V1_#RNDV_=0;_V2_#RNDV_=0;#ATOM#CMPLX;\
cpy(_V1_#RNDV_);\
#ATOM#CMPLX;cpy(_V2_#RNDV_);and;{_V1_#RNDV_}not;\
{_V2_#RNDV_}not;and;or; %RAND;
#defn OP=>(_X_,_Y_) #ATOM#CMPLX;not;#ATOM#CMPLX;or;
#defn OP&(_X_,_Y_) #ATOM#CMPLX;#ATOM#CMPLX;and;
#defn OP|(_X_,_Y_) #ATOM#CMPLX;#ATOM#CMPLX;or;
#defn OP^(_X_,_Y_) #ATOM#CMPLX;#ATOM#CMPLX;xor;
#defn OP~&(_X_,_Y_) #ATOM#CMPLX;#ATOM#CMPLX;nand;
#defn OP~|(_X_,_Y_) #ATOM#CMPLX;#ATOM#CMPLX;nor;
#defn OP~(_X_) #ATOM#CMPLX;not;
 
#defn variables(*) #GENCODE $$$*$$$ #LIST={#VOID};#ENDGEN
 
#define expresiónlógicaaevaluar {1}do
#synon expresiónlógicaaevaluar prepararcabecera
 
#define centrar ;padcenter;
 
#define insertarcabeceraydesplegartabla {cabecera}length;\
mov(LENTABLA); \
dim (LENTABLA) matriz rellena ("-----",vsep),\
unir filas ( cabecera, cabecera, vsep,tabla ) \
{" ",7,cabecera}, convertir a cadena, centrar,\
mover a 'cabecera'\
transformar("1","T", transformar("0","F", cabecera)) \
guardar en 'cabecera',\
imprimir( cabecera, NL )
 
#define prepararvaloresdeverdad decimales '0' \
tabla={#VOID}, fila={#VOID}, separador tabla={#VOID},\
cabecera={#VOID}, TOTCOMB=0, LENTABLA=0,\
preparacion de datos
 
/* EOF */
</syntaxhighlight>
{{out}}
<pre>
A B C | [A=>B & B=>C] => A=>C
----- ----- ----- ----- ----- ----- ----- ----- -----
F F F | T T T T T
F F T | T T T T T
F T F | T F F T T
F T T | T T T T T
T F F | F F T T F
T F T | F F T T T
T T F | T F F T F
T T T | T T T T T
 
A B | value: A=>B <=> ~AvB
----- ----- ----- -----
F F | T
F T | T
T F | T
T T | T
 
A B C D | [~AvB & A=>C & (B => (C=>D))] => A=>C
----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
F F F F | T T T T F T T T T
F F F T | T T T T F T T T T
F F T F | T T T T F T F T T
F F T T | T T T T F T T T T
F T F F | T T T T T T T T T
F T F T | T T T T T T T T T
F T T F | T T T F T F F T T
F T T T | T T T T T T T T T
T F F F | F F F F F T T T F
T F F T | F F F F F T T T F
T F T F | F F T F F T F T T
T F T T | F F T F F T T T T
T T F F | T F F F T T T T F
T T F T | T F F F T T T T F
T T T F | T T T F T F F T T
T T T T | T T T T T T T T T
 
A B ~A ~B A&B AvB A^B A=>B A<=>B A~&B A~vB
----- ----- ----- ----- ----- ----- ----- ----- ----- ----- -----
F F T T F F F T T T T
F T T F F T T T F T F
T F F T F T T F F T F
T T F F T T F T T F F
 
A ~A
----- -----
F T
T F
 
</pre>
 
=={{header|APL}}==
{{works with|Dyalog APL}}
 
This is an APL function that returns a formatted truth table.
Variables are single letters, and the operators are:
 
* <code>∧</code>: and
* <code>∨</code>: or
* <code>~</code>: not
* <code>≠</code>: xor
* <code>→</code>: implies
 
Except for <code>→</code>, these are the operators normally used
in APL. The notation is infix, with the normal boolean precedence
rules (unlike normal APL, which evaluates right-to-left).
 
<syntaxhighlight lang="apl">truth←{
op←⍉↑'~∧∨≠→('(4 3 2 2 1 0)
order←⍬⍬{
out stk←⍺
0=≢⍵:out,⌽stk
c rst←(⊃⍵) (1↓⍵)
c∊⎕A:((out,c)stk)∇rst
c∊'01':((out,⍎c)stk)∇rst
(c≠'(')∧(≢op)≥n←op[;1]⍳c:rst∇⍨out{
cnd←⌽∧\⌽(⍵≠'(')∧op[op[;1]⍳⍵;2]≥op[n;2]
(⍺,⌽cnd/⍵)(((~cnd)/⍵),c)
}stk
c='(':(out(stk,c))∇rst
c=')':rst∇⍨out{
⍬≡par←⍸'('=⍵:'Missing ('⎕SIGNAL 11
n←⌈/par
(⍺,n↓⍵)((n-1)↑⍵)
}stk
('Invalid character ',c)⎕SIGNAL 11
}1(819⌶)⍵~4↑⎕TC
'('∊order:'Missing )'⎕SIGNAL 11
nvar←≢vars←∪(order∊⎕A)/order
eval←{
⍺←⍬
0=≢⍵:{
1≠≢⍵:'Missing operator'⎕SIGNAL 11 ⋄ ⊃⍵
}⍺
c rst←(⊃⍵) (1↓⍵)
c∊⎕A:(⍺⍺[vars⍳c],⍺)∇rst
c∊0 1:(c,⍺)∇rst
c='~':(⍺≠1 0↑⍨≢⍺)∇rst ⊣ 'Missing operand'⎕SIGNAL(0=≢⍺)/11
c∊op[;1]:({
2>≢⍵:'Missing operand'⎕SIGNAL 11
c='→':(≥/2↑⍵),2↓⍵
((⍎c)/2↑⍵),2↓⍵
}⍺)∇rst
}
_←(nvar/0) eval order
confs←⍉(nvar/2)⊤¯1+⍳2*nvar
tab←'FT│'[1+(confs,2),{⍵ eval order}¨↓confs]
tab←↑,/ ' ',¨tab
hdr←((∊,/(' ',¨vars),' '),[0.5]'─'),⍪'│┼'
hdr←hdr,(' ',⍵,' '),[0.5]'─'
hdr⍪(,∘' '⍣(⊃⊃-/1↓¨⍴¨hdr tab))tab
}</syntaxhighlight>
 
{{out}}
 
<pre style='height: 50ex; line-height: normal;'> truth 'A'
A │ A
───┼───
F │ F
T │ T
 
truth 'A∧B ∨ P∧Q'
A B P Q │ A∧B ∨ P∧Q
─────────┼───────────
F F F F │ F
F F F T │ F
F F T F │ F
F F T T │ T
F T F F │ F
F T F T │ F
F T T F │ F
F T T T │ T
T F F F │ F
T F F T │ F
T F T F │ F
T F T T │ T
T T F F │ T
T T F T │ T
T T T F │ T
T T T T │ T
 
truth '(H→M) ∧ (S→H) → (S→M)'
H M S │ (H→M) ∧ (S→H) → (S→M)
───────┼───────────────────────
F F F │ T
F F T │ T
F T F │ T
F T T │ T
T F F │ T
T F T │ T
T T F │ T
T T T │ T </pre>
 
 
 
=={{header|BASIC}}==
 
<syntaxhighlight lang="gwbasic">10 DEFINT A-Z: DATA "~",4,"&",3,"|",2,"^",2,"=>",1
20 DIM V(26),E(255),S(255),C(5),C$(5)
30 FOR I=1 TO 5: READ C$(I),C(I): NEXT
40 PRINT "Boolean expression evaluator"
50 PRINT "----------------------------"
60 PRINT "Operators are: ~ (not), & (and), | (or), ^ (xor), => (implies)."
70 PRINT "Variables are A-Z. Constant False and True are 0 and 1."
100 FOR I=1 TO 26: V(I)=0: NEXT
110 PRINT: LINE INPUT "Enter an expression: ";A$
120 E$="": E=0: S=0
130 FOR I=1 TO LEN(A$)
140 I$=MID$(A$,I,1)
150 IF I$<>" " THEN E$=E$+I$
160 NEXT
170 IF E$="" THEN END ELSE Y$=E$
180 IF E$="" THEN 330
190 A$=LEFT$(E$,1): A=ASC(A$) OR 32: B$=RIGHT$(E$,LEN(E$)-1)
200 IF A>=97 AND A<=122 THEN E(E)=A-33: E=E+1: E$=B$: GOTO 180
210 IF A$="0" OR A$="1" THEN E(E)=VAL(A$)+32: E=E+1: E$=B$: GOTO 180
220 IF A$="(" THEN S(S)=97: S=S+1: E$=B$: GOTO 180
225 IF A$=")" THEN E$=B$: GOTO 300
227 I=1
230 IF LEFT$(E$,LEN(C$(I)))=C$(I) THEN 250 ELSE I=I+1: IF I<6 THEN 230
240 PRINT "Parse error at: ";E$: PRINT: GOTO 100
250 A$=C$(I): E$=RIGHT$(E$,LEN(E$)-LEN(A$))
260 IF I=1 THEN S(S)=1: S=S+1: GOTO 180
270 IF S=0 THEN 290
275 IF S(S-1)<>97 AND C(S(S-1) AND 31)>=C(I) THEN 280 ELSE 290
280 S=S-1: E(E)=S(S): E=E+1: GOTO 270
290 S(S)=I: S=S+1: GOTO 180
300 IF S=0 THEN PRINT "Error: missing (!": GOTO 100
310 IF S(S-1)<>97 THEN S=S-1: E(E)=S(S): E=E+1: GOTO 300
320 S=S-1: GOTO 180
330 IF S=0 THEN 350 ELSE S=S-1
335 IF S(S)=97 THEN PRINT "Error: missing )!": GOTO 100
340 E(E)=S(S): E=E+1: GOTO 330
350 V$=""
360 FOR I=0 TO E-1
370 IF (E(I) AND 224)<>64 THEN 390
380 A$=CHR$(E(I)+1): IF INSTR(V$,A$)=0 THEN V$=V$+A$
390 NEXT
400 GOSUB 600
410 FOR I=1 TO LEN(V$): PRINT MID$(V$,I,1);" ";: NEXT
420 PRINT "| ";Y$
430 PRINT STRING$(2+2*LEN(V$)+LEN(Y$),"-")
440 FOR J=1 TO 2^LEN(V$)
450 FOR I=1 TO LEN(V$)
460 IF V(I) THEN PRINT "T "; ELSE PRINT "F ";
470 NEXT
480 PRINT "| ";: GOSUB 600: IF S(0) THEN PRINT "T" ELSE PRINT "F"
490 I=1
500 IF V(I) THEN V(I)=0: I=I+1: GOTO 500 ELSE V(I)=1
510 NEXT
520 GOTO 100
600 S=0
610 FOR I=0 TO E-1: T=E(I) AND 224: V=E(I) AND 31
620 IF T=0 THEN ON V GOTO 700,710,720,730,740
630 IF T=32 THEN S(S)=-V: S=S+1: GOTO 650
640 IF T=64 THEN S(S)=V(INSTR(V$,CHR$(V+65))): S=S+1: GOTO 650
650 NEXT
660 IF S<>1 THEN PRINT "Missing operator": GOTO 100
670 RETURN
700 IF S<1 THEN 770 ELSE S(S-1)=1-S(S-1): GOTO 650
710 IF S<2 THEN 770 ELSE S=S-1:S(S-1)=S(S-1) AND S(S): GOTO 650
720 IF S<2 THEN 770 ELSE S=S-1:S(S-1)=S(S-1) OR S(S): GOTO 650
730 IF S<2 THEN 770 ELSE S=S-1:S(S-1)=S(S-1) XOR S(S): GOTO 650
740 IF S<2 THEN 770 ELSE S=S-1
750 IF S(S-1) THEN S(S-1)=S(S) ELSE S(S-1)=-1
760 GOTO 650
770 PRINT "Missing operand": GOTO 100</syntaxhighlight>
 
{{out}}
 
<pre style='height: 50ex;'>Boolean expression evaluator
----------------------------
Operators are: ~ (not), & (and), | (or), ^ (xor), => (implies).
Variables are A-Z. Constant False and True are 0 and 1.
 
Enter an expression: A
A | A
-----
F | F
T | T
 
Enter an expression: X & ~Y
X Y | X&~Y
----------
F F | F
T F | T
F T | F
T T | F
 
Enter an expression: ~(A & B)
A B | ~(A&B)
------------
F F | T
T F | T
F T | T
T T | F
 
Enter an expression: (H => M) & (S => H) => (S => M)
H M S | (H=>M)&(S=>H)=>(S=>M)
-----------------------------
F F F | T
T F F | T
F T F | T
T T F | T
F F T | T
T F T | T
F T T | T
T T T | T
 
Enter an expression: A&B | P&Q
A B P Q | A&B|P&Q
-----------------
F F F F | F
T F F F | F
F T F F | F
T T F F | T
F F T F | F
T F T F | F
F T T F | F
T T T F | T
F F F T | F
T F F T | F
F T F T | F
T T F T | T
F F T T | T
T F T T | T
F T T T | T
T T T T | T
 
Enter an expression:
Ok</pre>
 
=={{header|C}}==
{{trans|D}}
<langsyntaxhighlight lang="c">#include <stdio.h>
#include <string.h>
#include <stdlib.h>
Line 340 ⟶ 1,415:
}
return 0;
}</langsyntaxhighlight>
 
{{output}}
Line 394 ⟶ 1,469:
Boolean expression:
</pre>
 
=={{header|C++}}==
{{trans|C}}
<syntaxhighlight lang="cpp">#include <iostream>
#include <stack>
#include <string>
#include <sstream>
#include <vector>
 
struct var {
char name;
bool value;
};
std::vector<var> vars;
 
template<typename T>
T pop(std::stack<T> &s) {
auto v = s.top();
s.pop();
return v;
}
 
bool is_operator(char c) {
return c == '&' || c == '|' || c == '!' || c == '^';
}
 
bool eval_expr(const std::string &expr) {
std::stack<bool> sob;
for (auto e : expr) {
if (e == 'T') {
sob.push(true);
} else if (e == 'F') {
sob.push(false);
} else {
auto it = std::find_if(vars.cbegin(), vars.cend(), [e](const var &v) { return v.name == e; });
if (it != vars.cend()) {
sob.push(it->value);
} else {
int before = sob.size();
switch (e) {
case '&':
sob.push(pop(sob) & pop(sob));
break;
case '|':
sob.push(pop(sob) | pop(sob));
break;
case '!':
sob.push(!pop(sob));
break;
case '^':
sob.push(pop(sob) ^ pop(sob));
break;
default:
throw std::exception("Non-conformant character in expression.");
}
}
}
}
if (sob.size() != 1) {
throw std::exception("Stack should contain exactly one element.");
}
return sob.top();
}
 
void set_vars(int pos, const std::string &expr) {
if (pos > vars.size()) {
throw std::exception("Argument to set_vars can't be greater than the number of variables.");
}
if (pos == vars.size()) {
for (auto &v : vars) {
std::cout << (v.value ? "T " : "F ");
}
std::cout << (eval_expr(expr) ? 'T' : 'F') << '\n'; //todo implement evaluation
} else {
vars[pos].value = false;
set_vars(pos + 1, expr);
vars[pos].value = true;
set_vars(pos + 1, expr);
}
}
 
/* removes whitespace and converts to upper case */
std::string process_expr(const std::string &src) {
std::stringstream expr;
 
for (auto c : src) {
if (!isspace(c)) {
expr << (char)toupper(c);
}
}
 
return expr.str();
}
 
int main() {
std::cout << "Accepts single-character variables (except for 'T' and 'F',\n";
std::cout << "which specify explicit true or false values), postfix, with\n";
std::cout << "&|!^ for and, or, not, xor, respectively; optionally\n";
std::cout << "seperated by whitespace. Just enter nothing to quit.\n";
 
while (true) {
std::cout << "\nBoolean expression: ";
 
std::string input;
std::getline(std::cin, input);
 
auto expr = process_expr(input);
if (expr.length() == 0) {
break;
}
 
vars.clear();
for (auto e : expr) {
if (!is_operator(e) && e != 'T' && e != 'F') {
vars.push_back({ e, false });
}
}
std::cout << '\n';
if (vars.size() == 0) {
std::cout << "No variables were entered.\n";
} else {
for (auto &v : vars) {
std::cout << v.name << " ";
}
std::cout << expr << '\n';
 
auto h = vars.size() * 3 + expr.length();
for (size_t i = 0; i < h; i++) {
std::cout << '=';
}
std::cout << '\n';
 
set_vars(0, expr);
}
}
 
return 0;
}</syntaxhighlight>
{{out}}
<pre>Accepts single-character variables (except for 'T' and 'F',
which specify explicit true or false values), postfix, with
&|!^ for and, or, not, xor, respectively; optionally
seperated by whitespace. Just enter nothing to quit.
 
Boolean expression: A B ^
 
A B AB^
=========
F F F
F T T
T F T
T T F
 
Boolean expression: A B C ^ |
 
A B C ABC^|
==============
F F F F
F F T T
F T F T
F T T F
T F F T
T F T T
T T F T
T T T T
 
Boolean expression: A B C D ^ ^ ^
 
A B C D ABCD^^^
===================
F F F F F
F F F T T
F F T F T
F F T T F
F T F F T
F T F T F
F T T F F
F T T T T
T F F F T
T F F T F
T F T F F
T F T T T
T T F F F
T T F T T
T T T F T
T T T T F</pre>
 
=={{header|C sharp}}==
Line 400 ⟶ 1,661:
To not make it too complicated, operators are limited to a single character.<br/>
Either postfix or infix expressions are allowed. Infix expressions are converted to postfix.
<langsyntaxhighlight lang="csharp">using System;
using System.Collections;
using System.Collections.Generic;
Line 646 ⟶ 1,907:
}
}
}</langsyntaxhighlight>
{{out}}
<pre>
Line 693 ⟶ 1,954:
 
=={{header|Clojure}}==
<langsyntaxhighlight lang="clojure"> (ns clojure-sandbox.truthtables
(:require [clojure.string :as s]
[clojure.pprint :as pprint]))
Line 792 ⟶ 2,053:
 
(truth-table "! a | b") ;; interpreted as ! (a | b)
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 803 ⟶ 2,064:
 
</pre>
=={{header|Cowgol}}==
 
<syntaxhighlight lang="cowgol"># Truth table generator in Cowgol
# -
# This program will generate a truth table for the Boolean expression
# given on the command line.
#
# The expression is in infix notation, and operator precedence is impemented,
# i.e., the following expression:
# A & B | C & D => E
# is parsed as:
# ((A & B) | (C & D)) => E.
#
# Syntax:
# * Variables are single letters (A-Z). They are case-insensitive.
# * 0 and 1 can be used as constant true or false.
# * Operators are ~ (not), & (and), | (or), ^ (xor), and => (implies).
# * Parentheses may be used to override the normal precedence.
 
include "cowgol.coh";
include "strings.coh";
include "argv.coh";
ArgvInit();
 
# Concatenate all command line arguments together, skipping whitespace
var code: uint8[512];
var codeptr := &code[0];
loop
var argmt := ArgvNext();
if argmt == 0 as [uint8] then break; end if;
loop
var char := [argmt];
argmt := @next argmt;
if char == 0 then break;
elseif char == ' ' then continue;
end if;
[codeptr] := char;
codeptr := @next codeptr;
end loop;
end loop;
[codeptr] := 0;
 
# If no code given, print an error and stop
if StrLen(&code[0]) == 0 then
print("Error: no boolean expression given\n");
ExitWithError();
end if;
 
interface TokenReader(str: [uint8]): (next: [uint8], tok: uint8);
 
# Operators
interface OpFn(l: uint8, r: uint8): (v: uint8);
sub And implements OpFn is v := l & r; end sub;
sub Or implements OpFn is v := l | r; end sub;
sub Xor implements OpFn is v := l ^ r; end sub;
sub Not implements OpFn is v := ~l; end sub;
sub Impl implements OpFn is
if l == 0 then v := 1;
else v := r;
end if;
end sub;
record Operator is
fn: OpFn;
name: [uint8];
val: uint8;
prec: uint8;
end record;
var ops: Operator[] := {
{Not, "~", 1, 5},
{And, "&", 2, 4},
{Or, "|", 2, 3},
{Xor, "^", 2, 3},
{Impl, "=>", 2, 2}
};
 
const TOKEN_MASK := (1<<5)-1;
const TOKEN_OP := 1<<5;
sub ReadOp implements TokenReader is
tok := 0;
next := str;
while tok < @sizeof ops loop
var find := ops[tok].name;
while [find] == [next] loop
next := @next next;
find := @next find;
end loop;
if [find] == 0 then
tok := tok | TOKEN_OP;
return;
end if;
next := str;
tok := tok + 1;
end loop;
tok := 0;
end sub;
 
 
# Values (constants, variables)
const TOKEN_VAR := 2<<5;
const TOKEN_CONST := 3<<5;
const CONST_TRUE := 0;
const CONST_FALSE := 1;
sub ReadValue implements TokenReader is
var cur := [str];
next := str;
tok := 0;
if cur == '0' or cur == '1' then
next := @next str;
tok := TOKEN_CONST | cur - '0';
elseif (cur >= 'A' and cur <= 'Z') or (cur >= 'a' and cur <= 'z') then
next := @next str;
tok := TOKEN_VAR | (cur | 32) - 'a';
end if;
end sub;
 
# Parentheses
const TOKEN_PAR := 4<<5;
const PAR_OPEN := 0;
const PAR_CLOSE := 1;
sub ReadParen implements TokenReader is
case [str] is
when '(': next := @next str; tok := TOKEN_PAR | PAR_OPEN;
when ')': next := @next str; tok := TOKEN_PAR | PAR_CLOSE;
when else: next := str; tok := 0;
end case;
end sub;
 
# Read next token
sub NextToken(str: [uint8]): (next: [uint8], tok: uint8) is
var toks: TokenReader[] := {ReadOp, ReadValue, ReadParen};
var i: uint8 := 0;
while i < @sizeof toks loop
(next, tok) := (toks[i]) (str);
if tok != 0 then return; end if;
i := i + 1;
end loop;
# Invalid token
print("cannot tokenize: ");
print(str);
print_nl();
ExitWithError();
end sub;
 
# Use shunting yard algorithm to parse the input
var expression: uint8[512];
var oprstack: uint8[512];
var expr_ptr := &expression[0];
var ostop := &oprstack[0];
var varmask: uint32 := 0; # mark which variables are in use
var one: uint32 := 1; # cannot shift constant by variable
 
sub GetOp(o: uint8): (r: [Operator]) is
r := &ops[o];
end sub;
 
codeptr := &code[0];
while [codeptr] != 0 loop
var tok: uint8;
(codeptr, tok) := NextToken(codeptr);
var toktype := tok & ~TOKEN_MASK;
var tokval := tok & TOKEN_MASK;
case toktype is
# constants and variables get pushed to output queue
when TOKEN_CONST:
[expr_ptr] := tok; expr_ptr := @next expr_ptr;
when TOKEN_VAR:
[expr_ptr] := tok; expr_ptr := @next expr_ptr;
varmask := varmask | one << tokval;
# operators
when TOKEN_OP:
if ops[tokval].val == 1 then
# unary operator binds immediately
[ostop] := tok; ostop := @next ostop;
else
while ostop > &oprstack[0]
and [@prev ostop] != TOKEN_PAR|PAR_OPEN
and [GetOp([@prev ostop] & TOKEN_MASK)].prec
>= ops[tokval].prec
loop
ostop := @prev ostop;
[expr_ptr] := [ostop];
expr_ptr := @next expr_ptr;
end loop;
[ostop] := tok;
ostop := @next ostop;
end if;
# parenthesis
when TOKEN_PAR:
if tokval == PAR_OPEN then
# push left parenthesis onto operator stack
[ostop] := tok; ostop := @next ostop;
else
# pop whole operator stack until left parenthesis
while ostop > &oprstack[0]
and [@prev ostop] != TOKEN_PAR|PAR_OPEN
loop
ostop := @prev ostop;
[expr_ptr] := [ostop];
expr_ptr := @next expr_ptr;
end loop;
# if we run out of stack, mismatched parenthesis
if ostop == &oprstack[0] then
print("Error: missing (");
print_nl();
ExitWithError();
else
ostop := @prev ostop;
end if;
end if;
end case;
end loop;
 
# push remaining operators onto expression
while ostop != &oprstack[0] loop
ostop := @prev ostop;
[expr_ptr] := [ostop];
if [expr_ptr] & ~TOKEN_MASK == TOKEN_PAR then
print("Error: missing )");
print_nl();
ExitWithError();
end if;
expr_ptr := @next expr_ptr;
end loop;
 
# terminate expression
[expr_ptr] := 0;
 
# Evaluate expression given set of variables
sub Eval(varset: uint32): (r: uint8) is
# We can reuse the operator stack as the evaluation stack
var ptr := &oprstack[0];
var exp := &expression[0];
var one: uint32 := 1;
while [exp] != 0 loop
var toktype := [exp] & ~TOKEN_MASK;
var tokval := [exp] & TOKEN_MASK;
case toktype is
when TOKEN_CONST:
[ptr] := tokval;
ptr := @next ptr;
when TOKEN_VAR:
[ptr] := ((varset & (one << tokval)) >> tokval) as uint8;
ptr := @next ptr;
when TOKEN_OP:
var op := GetOp(tokval);
ptr := ptr - ([op].val as intptr);
if ptr < &oprstack[0] then
# not enough values on the stack
print("Missing operand\n");
ExitWithError();
end if;
[ptr] := ([op].fn)([ptr], [@next ptr]) & 1;
ptr := @next ptr;
when else:
# wrong token left in the expression
print("invalid expression token ");
print_hex_i8([exp]);
print_nl();
ExitWithError();
end case;
exp := @next exp;
end loop;
# There should be exactly one item on the stack
ptr := @prev ptr;
if ptr != &oprstack[0] then
print("Too many operands\n");
ExitWithError();
else
r := [ptr];
end if;
end sub;
var v := Eval(0); # evaluate once to catch errors
 
# Print header and count variables
var ch: uint8 := 'A';
var vcount: uint8 := 0;
var vars := varmask;
 
while vars != 0 loop
if vars & 1 != 0 then
print_char(ch);
print_char(' ');
vcount := vcount + 1;
end if;
ch := ch + 1;
vars := vars >> 1;
end loop;
print("| ");
print(&code[0]);
print_nl();
 
ch := 2 + vcount * 2 + StrLen(&code[0]) as uint8;
while ch != 0 loop
print_char('-');
ch := ch - 1;
end loop;
print_nl();
 
# Given configuration number, generate variable configuration
sub distr(val: uint32): (r: uint32) is
var vars := varmask;
r := 0;
var n: uint8 := 0;
while vars != 0 loop
r := r >> 1;
if vars & 1 != 0 then
r := r | ((val & 1) << 31);
val := val >> 1;
end if;
vars := vars >> 1;
n := n + 1;
end loop;
r := r >> (32-n);
end sub;
 
vars := 0; # start with F F F F F
var bools: uint8[] := {'F', 'T'};
while vars != one << vcount loop
var dist := distr(vars);
var rslt := Eval(dist);
# print configuration
var vmask := varmask;
while vmask != 0 loop
if vmask & 1 != 0 then
print_char(bools[(dist & 1) as uint8]);
print_char(' ');
end if;
vmask := vmask >> 1;
dist := dist >> 1;
end loop;
# print result
print("| ");
print_char(bools[rslt]);
print_nl();
# next configuration
vars := vars + 1;
end loop; </syntaxhighlight>
 
{{out}}
 
<pre style='height: 50ex;'>$ ./truth.386 'X & ~Y'
X Y | X&~Y
----------
F F | F
T F | T
F T | F
T T | F
$ ./truth.386 '~(A | B)'
A B | ~(A|B)
------------
F F | T
T F | F
F T | F
T T | F
$ ./truth.386 '(H => M) & (S => H) => (S => M)'
H M S | (H=>M)&(S=>H)=>(S=>M)
-----------------------------
F F F | T
T F F | T
F T F | T
T T F | T
F F T | T
T F T | T
F T T | T
T T T | T
$ ./truth.386 'A&B | P&Q'
A B P Q | A&B|P&Q
-----------------
F F F F | F
T F F F | F
F T F F | F
T T F F | T
F F T F | F
T F T F | F
F T T F | F
T T T F | T
F F F T | F
T F F T | F
F T F T | F
T T F T | T
F F T T | T
T F T T | T
F T T T | T
T T T T | T</pre>
 
 
 
 
=={{header|D}}==
{{trans|JavaScript}}
<langsyntaxhighlight lang="d">import std.stdio, std.string, std.array, std.algorithm, std.typecons;
 
struct Var {
Line 893 ⟶ 2,548:
writefln("%-(%s %) %s", .vars.map!(v => v.name), .expr);
setVariables(0);
}</langsyntaxhighlight>
{{out}}
<pre>Accepts single-character variables (except for 'T' and 'F',
Line 940 ⟶ 2,595:
=={{header|Déjà Vu}}==
{{incorrect|Déjà Vu|User input is not arbitrary but fixed to the three examples shown}}
<langsyntaxhighlight lang="dejavu">print-line lst end:
for v in reversed copy lst:
print\( v chr 9 )
Line 965 ⟶ 2,620:
print-truth-table [ "A" "B" ] "A ^ B" @/=
print-truth-table [ "S" "T" "U" ] "S | (T ^ U)" @stu
print-truth-table [ "A" "B" "C" "D" ] "A ^ (B ^ (C ^ D))" @abcd</langsyntaxhighlight>
{{out}}
<pre>A B A ^ B
Line 1,004 ⟶ 2,659:
=={{header|Factor}}==
Postfix is a natural choice. That way, we can use <code>(eval)</code> to to evaluate the expressions without much fuss.
<langsyntaxhighlight lang="factor">USING: arrays combinators eval formatting io kernel listener
math.combinatorics prettyprint qw sequences splitting
vocabs.parser ;
Line 1,061 ⟶ 2,716:
add-col print-table drop ;
MAIN: main</langsyntaxhighlight>
{{out}}
<pre>
Line 1,100 ⟶ 2,755:
=={{header|Fōrmulæ}}==
 
In [http{{FormulaeEntry|page=https://wiki.formulae.org/?script=examples/Truth_table this] page you can see the solution of this task.}}
 
'''Solution'''
Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text ([http://wiki.formulae.org/Editing_F%C5%8Drmul%C3%A6_expressions more info]). Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation &mdash;i.e. XML, JSON&mdash; they are intended for transportation effects more than visualization and edition.
 
[[File:Fōrmulæ - Truth table 01.png]]
The option to show Fōrmulæ programs and their results is showing images. Unfortunately images cannot be uploaded in Rosetta Code.
 
'''Test case 1'''
 
The following example produces the logical negation table:
 
[[File:Fōrmulæ - Truth table 02.png]]
 
[[File:Fōrmulæ - Truth table 03.png]]
 
'''Test case 2'''
 
The following example produces the logical conjunction table:
 
[[File:Fōrmulæ - Truth table 04.png]]
 
[[File:Fōrmulæ - Truth table 05.png]]
 
'''Test case 3'''
 
Because there is no restrictions about the mapping expression, it can be an array of expressions involving the arguments.
 
The following example produces the truth table for logical conjunction, disjunction, conditional, equivalence and exclusive disjunction:
 
[[File:Fōrmulæ - Truth table 06.png]]
 
[[File:Fōrmulæ - Truth table 07.png]]
 
'''Test case 4'''
 
In the following example, the truth table is used to show that a boolean formula is a tautology:
 
[[File:Fōrmulæ - Truth table 08.png]]
 
[[File:Fōrmulæ - Truth table 09.png]]
 
=={{header|Go}}==
Expression parsing and evaluation taken from the Arithmetic evaluation task. Operator precedence and association are that of the Go language, and are determined by the library parser. The unary ^ is first, then &, then | and ^ associating left to right. Note also that the symbols &, |, and ^ operate bitwise on integer types in Go, but here since we implement our own evaluator we can apply them to the type of bool.
<langsyntaxhighlight lang="go">package main
 
import (
Line 1,250 ⟶ 2,939:
return false, errors.New(fmt.Sprintf("%v unsupported", i))
}
</syntaxhighlight>
</lang>
Output:
<pre>
Line 1,287 ⟶ 2,976:
Uses operators "&", "|", "!", "^" (xor), "=>" (implication); all other words are interpreted as variable names.
 
<langsyntaxhighlight lang="haskell">import Control.Monad (mapM, foldM, forever)
import Data.List (unwords, unlines, nub)
import Data.Maybe (fromJust)
Line 1,320 ⟶ 3,009:
colWidth = max 6 $ maximum $ map length (head tbl)
main = forever $ getLine >>= putStrLn . truthTable</langsyntaxhighlight>
 
{{Out}}
Line 1,347 ⟶ 3,036:
 
Translation from infix notation to RPN using Parsec:
<langsyntaxhighlight lang="haskell">{-# LANGUAGE FlexibleContexts #-}
import Text.Parsec
 
Line 1,359 ⟶ 3,048:
many1 alphaNum
op1 s = (\x -> unwords [x, s]) <$ string s
op2 s = (\x y -> unwords [x, y, s]) <$ string s</langsyntaxhighlight>
 
{{Out}}
<langsyntaxhighlight lang="haskell">λ> putStr $ truthTable $ toRPN "(Human => Mortal) & (Socratus => Human) => (Socratus => Mortal)"
 
Human Mortal Socratus result
Line 1,372 ⟶ 3,061:
False True False True
False False True True
False False False True </langsyntaxhighlight>
 
=={{header|J}}==
Line 1,378 ⟶ 3,067:
Implementation:
 
<langsyntaxhighlight lang="j">truthTable=:3 :0
assert. -. 1 e. 'data expr names table' e.&;: y
names=. ~. (#~ _1 <: nc) ;:expr=. y
Line 1,384 ⟶ 3,073:
(names)=. |:data
(' ',;:inv names,<expr),(1+#@>names,<expr)":data,.".expr
)</langsyntaxhighlight>
 
The argument is expected to be a valid boolean J sentence which, among other things, does not use any of the words used within this implementation (but any single-character name is valid).
Line 1,390 ⟶ 3,079:
Example use:
 
<langsyntaxhighlight lang="j"> truthTable '-.b'
b -.b
0 1
Line 1,421 ⟶ 3,110:
1 0 1 1
1 1 0 1
1 1 1 1</langsyntaxhighlight>
 
=={{header|Java}}==
{{works with|Java|1.8+}}
This takes an expression from the command line in reverse Polish notation. The supported operators are & | ^ ! and you probably need to escape them so that your shell doesn't interpret them. As an exercise for the reader, you could make it prompt the user for input (which would avoid the escaping issue), or accept infix expressions (see other examples here for how to turn infix into RPN).
<langsyntaxhighlight lang="java">import java.util.ArrayList;
import java.util.HashMap;
import java.util.Iterator;
Line 1,543 ⟶ 3,232:
return stack.pop();
}
}</langsyntaxhighlight>
{{out}}
Note that the escape character is ^ for Windows
Line 1,578 ⟶ 3,267:
=={{header|JavaScript}}==
Actually a HTML document. Save as a .html document and double-click it. You should be fine.
<langsyntaxhighlight lang="javascript"><!DOCTYPE html><html><head><title>Truth table</title><script>
var elem,expr,vars;
function isboolop(chr){return "&|!^".indexOf(chr)!=-1;}
Line 1,637 ⟶ 3,326:
return stack[0];
}
</script></head><body onload="printtruthtable()"></body></html></langsyntaxhighlight>
{{Out|Output in browser window after entering "AB^"}}
<pre>A B AB^
Line 1,654 ⟶ 3,343:
T T F T
T T T T</pre>
 
=={{header|jq}}==
{{works with|jq}}
'''Also works with gojq, the Go implementation of jq'''
 
This entry uses a PEG ([https://en.wikipedia.org/wiki/Parsing_expression_grammar Parsing Expression Grammar]) approach
to the task. In effect, a PEG grammar for logic expressions
is transcribed into a jq program for parsing and
evaluating the truth values of such expressions.
 
The PEG grammar for logic expressions used here is essentially as follows:
<pre>
expr = (primary '=>' primary) / e1
e1 = e2 (('or' / 'xor') e2)*
e2 = e3 ('and' e3)*
e3 = 'not'? primary
primary = Var / boolean / '(' expr ')'
boolean = 'true' / 'false'
</pre>
 
where Var is a string matching the regex ^[A-Z][a-zA-Z0-9]*$
 
Notice that this grammar binds '=>' most tightly, and uses `not` as a
prefix operator.
 
The PEG grammar above is transcribed and elaborated in the jq function
`expr` below. For details about this approach, see for example
[[Compiler/Verifying_syntax#jq]]. That entry also
contains the jq PEG library that is referenced
in the 'include' statement at the beginning of the
jq program shown below.
 
====Parsing====
<syntaxhighlight lang=jq>
include "peg"; # see [[:Category:jq/peg.jq]
 
def expr:
def Var : parse("[A-Z][a-zA-Z0-9]*");
 
def boolean : (literal("true") // literal("false"))
| .result[-1] |= fromjson;
 
def primary : ws
| (Var
// boolean
// box(q("(") | expr | q(")"))
)
| ws;
 
def e3 : ws | (box(literal("not") | primary) // primary);
def e2 : box(e3 | star(literal("and") | e3)) ;
def e1 : box(e2 | star((literal("or") // literal("xor")) | e2)) ;
def e0 : box(primary | literal("=>") | primary) // e1;
 
ws | e0 | ws;
 
def statement:
{remainder: .} | expr | eos;
</syntaxhighlight>
 
====Evaluation====
<syntaxhighlight lang=jq>
# Evaluate $Expr in the context of {A,B,....}
def eval($Expr):
if $Expr|type == "boolean" then $Expr
elif $Expr|type == "string" then getpath([$Expr])
elif $Expr|length == 1 then eval($Expr[0])
elif $Expr|(length == 2 and first == "not") then eval($Expr[-1])|not
elif $Expr|(length == 3 and .[1] == "or") then eval($Expr[0]) or eval($Expr[2])
elif $Expr|(length == 3 and .[1] == "xor")
then eval($Expr[0]) as $x
| eval($Expr[2]) as $y
| ($x and ($y|not)) or ($y and ($x|not))
elif $Expr|(length == 3 and .[1] == "and") then eval($Expr[0]) and eval($Expr[2])
elif $Expr|(length == 3 and .[1] == "=>") then (eval($Expr[0])|not) or eval($Expr[2])
else $Expr | error
end;
</syntaxhighlight>
====Truth Tables====
<syntaxhighlight lang=jq>
# input: a list of strings
# output: a stream of objects representing all possible true/false combinations
# Each object has the keys specified in the input.
def vars2tf:
if length == 0 then {}
else .[0] as $k
| ({} | .[$k] = (true,false)) + (.[1:] | vars2tf)
end;
 
# If the input is a string, then echo it;
# otherwise emit T or F
def TF:
if type == "string" then .
elif . then "T"
else "F"
end;
 
# Extract the distinct variable names from the parse tree.
def vars: [.. | strings | select(test("^[A-Z]"))] | unique;
 
def underscore:
., (length * "_");
 
</syntaxhighlight>
====Examples====
<syntaxhighlight lang=jq>
def tests: [
"A xor B",
"notA",
"A and B",
"A and B or C",
"A=>(notB)",
"A=>(A => (B or A))",
"A xor B and C"
];
 
def tables:
tests[] as $test
| ($test | statement | .result)
| . as $result
| vars as $vars
| ($vars + [" ", $test] | join(" ") | underscore),
(($vars | vars2tf)
| ( [.[], " ", eval($result) | TF] | join(" ")) ),
""
;
 
tables
</syntaxhighlight>
{{output}}
<pre>
A B A xor B
_____________
T T F
F T T
T F T
F F F
 
A notA
________
T F
F T
 
A B A and B
_____________
T T T
F T F
T F F
F F F
 
A B C A and B or C
____________________
T T T T
F T T T
T F T T
F F T T
T T F T
F T F F
T F F F
F F F F
 
A B A=>(notB)
_______________
T T F
F T T
T F T
F F T
 
A B A=>(A => (B or A))
________________________
T T T
F T T
T F T
F F T
 
A B C A xor B and C
_____________________
T T T F
F T T T
T F T T
F F T F
T T F T
F T F F
T F F T
F F F F
</pre>
 
=={{header|Julia}}==
'''Module''':
<langsyntaxhighlight lang="julia">module TruthTable
 
using Printf
Line 1,699 ⟶ 3,575:
end
 
end # module TruthTable</langsyntaxhighlight>
 
'''Main''':
<langsyntaxhighlight lang="julia">TruthTable.@table !a
TruthTable.@table a | b
TruthTable.@table (a ⊻ b) | (c & a)
TruthTable.@table (a & b) | (c ⊻ d)
</syntaxhighlight>
</lang>
 
{{out}}
Line 1,747 ⟶ 3,623:
=={{header|Kotlin}}==
{{trans|D}}
<langsyntaxhighlight lang="scala">// Version 1.2.31
 
import java.util.Stack
Line 1,820 ⟶ 3,696:
setVariables(0)
}
}</langsyntaxhighlight>
 
{{out}}
Line 1,882 ⟶ 3,758:
This at first seems trivial, given our lovely 'eval' function. However it is complicated by LB's use of 'non-zero' for 'true', and by the requirements of accepting different numbers and names of variables.
My program assumes all space-separated words in the expression$ are either a logic-operator, bracket delimiter, or variable name. Since a truth table for 8 or more variables is of silly length, I regard that as a practical limit.
<syntaxhighlight lang="lb">
<lang lb>
print
print " TRUTH TABLES"
Line 1,974 ⟶ 3,850:
end if
end function
</syntaxhighlight>
</lang>
<pre>
Too_High and Fuel_Out
Line 1,997 ⟶ 3,873:
</pre>
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<langsyntaxhighlight Mathematicalang="mathematica">VariableNames[data_] := Module[ {TokenRemoved},
TokenRemoved = StringSplit[data,{"~And~","~Or~","~Xor~","!","(",")"}];
Union[Select[Map[StringTrim,TokenRemoved] , Not[StringMatchQ[#,""]]&]]
Line 2,009 ⟶ 3,885:
Join[List[Flatten[{VariableNames[BooleanEquation],BooleanEquation}]],
Flatten[{#/.Rule[x_,y_] -> y,ReplaceAll[ToExpression[BooleanEquation],#]}]&/@TestDataSet]//Grid
]</langsyntaxhighlight>
 
Example usage:
<pre>TruthTable["V ~Xor~ (B ~Xor~ (K ~Xor~ D ) )"]
Line 2,033 ⟶ 3,908:
 
=={{header|Maxima}}==
<langsyntaxhighlight Maximalang="maxima">/* Maxima already has the following logical operators
=, # (not equal), not, and, or
define some more and set 'binding power' (operator
Line 2,081 ⟶ 3,956:
gen_table('(Jim and (Spock xor Bones) or Scotty));
gen_table('(A => (B and A)));
gen_table('(V xor (B xor (K xor D ) )));</langsyntaxhighlight>
 
OUtput of the last example:
<syntaxhighlight lang="text">
[ V B K D V xor (B xor (K xor D)) ]
[ ]
Line 2,118 ⟶ 3,993:
[ ]
[ false false false false false ]
</syntaxhighlight>
</lang>
 
=={{header|Nim}}==
{{trans|Kotlin}}
This is an adaptation of Kotlin version, using the same rules and the same algorithm, but with a different representation of expressions. The result is identical.
 
<syntaxhighlight lang="nim">import sequtils, strutils, sugar
 
# List of possible variables names.
const VarChars = {'A'..'E', 'G'..'S', 'U'..'Z'}
 
type
 
Expression = object
names: seq[char] # List of variables names.
values: seq[bool] # Associated values.
formula: string # Formula as a string.
 
 
proc initExpression(str: string): Expression =
## Build an expression from a string.
for ch in str:
if ch in VarChars and ch notin result.names:
result.names.add ch
result.values.setLen(result.names.len)
result.formula = str
 
 
template apply(stack: seq[bool]; op: (bool, bool) -> bool): bool =
## Apply an operator on the last two operands of an evaluation stack.
## Needed to make sure that pops are done (avoiding short-circuit optimization).
let op2 = stack.pop()
let op1 = stack.pop()
op(op1, op2)
 
 
proc evaluate(expr: Expression): bool =
## Evaluate the current expression.
 
var stack: seq[bool] # Evaluation stack.
 
for e in expr.formula:
stack.add case e
of 'T': true
of 'F': false
of '!': not stack.pop()
of '&': stack.apply(`and`)
of '|': stack.apply(`or`)
of '^': stack.apply(`xor`)
else:
if e in VarChars: expr.values[expr.names.find(e)]
else:
raise newException(
ValueError, "Non-conformant character in expression: '$#'.".format(e))
 
if stack.len != 1:
raise newException(ValueError, "Ill-formed expression.")
result = stack[0]
 
 
proc setVariables(expr: var Expression; pos: Natural) =
## Recursively set the variables.
## When all the variables are set, launch the evaluation of the expression
## and print the result.
 
assert pos <= expr.values.len
 
if pos == expr.values.len:
# Evaluate and display.
let vs = expr.values.mapIt(if it: 'T' else: 'F').join(" ")
let es = if expr.evaluate(): 'T' else: 'F'
echo vs, " ", es
 
else:
# Set values.
expr.values[pos] = false
expr.setVariables(pos + 1)
expr.values[pos] = true
expr.setVariables(pos + 1)
 
 
echo "Accepts single-character variables (except for 'T' and 'F',"
echo "which specify explicit true or false values), postfix, with"
echo "&|!^ for and, or, not, xor, respectively; optionally"
echo "seperated by spaces or tabs. Just enter nothing to quit."
 
while true:
# Read formula and create expression.
stdout.write "\nBoolean expression: "
let line = stdin.readLine.toUpperAscii.multiReplace((" ", ""), ("\t", ""))
if line.len == 0: break
var expr = initExpression(line)
if expr.names.len == 0: break
 
# Display the result.
let vs = expr.names.join(" ")
echo '\n', vs, " ", expr.formula
let h = vs.len + expr.formula.len + 2
echo repeat('=', h)
expr.setVariables(0)</syntaxhighlight>
 
{{out}}
Sample session:
<pre>Accepts single-character variables (except for 'T' and 'F',
which specify explicit true or false values), postfix, with
&|!^ for and, or, not, xor, respectively; optionally
seperated by spaces or tabs. Just enter nothing to quit.
 
Boolean expression: A B ^
 
A B AB^
=========
F F F
F T T
T F T
T T F
 
Boolean expression: A B C ^ |
 
A B C ABC^|
==============
F F F F
F F T T
F T F T
F T T F
T F F T
T F T T
T T F T
T T T T
 
Boolean expression: A B C D ^ ^ ^
 
A B C D ABCD^^^
===================
F F F F F
F F F T T
F F T F T
F F T T F
F T F F T
F T F T F
F T T F F
F T T T T
T F F F T
T F F T F
T F T F F
T F T T T
T T F F F
T T F T T
T T T F T
T T T T F
 
Boolean expression: </pre>
 
=={{header|PARI/GP}}==
Line 2,124 ⟶ 4,150:
 
It would be easy to modify the program to take <code>+</code> for XOR instead.
<langsyntaxhighlight lang="parigp">vars(P)={
my(v=List(),x);
while(type(P)=="t_POL",
Line 2,146 ⟶ 4,172:
};
truthTable("x+y") \\ OR
truthTable("x*y") \\ AND</langsyntaxhighlight>
{{out}}
<pre>000
Line 2,161 ⟶ 4,187:
{{trans|C}}
{{works with|Free Pascal}}
<syntaxhighlight lang="pascal">
<lang Pascal>
program TruthTables;
const
Line 2,396 ⟶ 4,422:
end;
end.
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 2,452 ⟶ 4,478:
=={{header|Perl}}==
Note: can't process stuff like "X xor Y"; "xor" would be treated as a variable name here.
<langsyntaxhighlight lang="perl">#!/usr/bin/perl
 
sub truth_table {
Line 2,472 ⟶ 4,498:
truth_table 'A ^ A_1';
truth_table 'foo & bar | baz';
truth_table 'Jim & (Spock ^ Bones) | Scotty';</langsyntaxhighlight>{{out}}<pre>
A A_1 A ^ A_1
----------------------------------------
Line 2,500 ⟶ 4,526:
=={{header|Phix}}==
Expression parsing and evaluation similar to that in the Arithmetic evaluation task.
<!--<syntaxhighlight lang="phix">(phixonline)-->
<lang Phix>sequence opstack = {}
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
object token
<span style="color: #008080;">constant</span> <span style="color: #000000;">bFT</span> <span style="color: #0000FF;">=</span> <span style="color: #004600;">false</span> <span style="color: #000080;font-style:italic;">-- true: use F/T, false: use 0/1, as next</span>
object op = 0 -- 0 = none
string s -- the expression being parsed
integer sidx -- idx to ""
integer ch -- s[sidx]
<span style="color: #008080;">function</span> <span style="color: #000000;">fmt</span><span style="color: #0000FF;">(</span><span style="color: #004080;">bool</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">)</span>
procedure err(string msg)
<span style="color: #008080;">return</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">bFT</span><span style="color: #0000FF;">?{</span><span style="color: #008000;">"F"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"T"</span><span style="color: #0000FF;">}:{</span><span style="color: #008000;">"0"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"1"</span><span style="color: #0000FF;">})[</span><span style="color: #000000;">b</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
printf(1,"%s\n%s^ %s\n\nPressEnter...",{s,repeat(' ',sidx-1),msg})
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
{} = wait_key()
abort(0)
end procedure
<span style="color: #004080;">sequence</span> <span style="color: #000000;">opstack</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
procedure nxtch()
<span style="color: #004080;">object</span> <span style="color: #000000;">token</span><span style="color: #0000FF;">,</span>
sidx += 1
<span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span> <span style="color: #000080;font-style:italic;">-- 0 = none</span>
ch = iff(sidx>length(s)?-1:s[sidx])
<span style="color: #004080;">string</span> <span style="color: #000000;">s</span> <span style="color: #000080;font-style:italic;">-- the expression being parsed</span>
end procedure
<span style="color: #004080;">integer</span> <span style="color: #000000;">sidx</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- idx to ""</span>
<span style="color: #000000;">ch</span> <span style="color: #000080;font-style:italic;">-- s[sidx]</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">err</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">msg</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s\n%s^ %s\n\nPressEnter..."</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">s</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">,</span><span style="color: #000000;">sidx</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">),</span><span style="color: #000000;">msg</span><span style="color: #0000FF;">})</span>
<span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">wait_key</span><span style="color: #0000FF;">()</span>
<span style="color: #7060A8;">abort</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">nxtch</span><span style="color: #0000FF;">()</span>
<span style="color: #000000;">sidx</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #000000;">ch</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">sidx</span><span style="color: #0000FF;">></span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)?-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">:</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">sidx</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">skipspaces</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">while</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ch</span><span style="color: #0000FF;">,</span><span style="color: #008000;">" \t\r\n"</span><span style="color: #0000FF;">)!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">do</span> <span style="color: #000000;">nxtch</span><span style="color: #0000FF;">()</span> <span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">get_token</span><span style="color: #0000FF;">()</span>
<span style="color: #000000;">skipspaces</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">ch</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"()!"</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">token</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">sidx</span><span style="color: #0000FF;">..</span><span style="color: #000000;">sidx</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">nxtch</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">else</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">tokstart</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">sidx</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">=-</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #000000;">token</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"eof"</span> <span style="color: #008080;">return</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">nxtch</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;"><</span><span style="color: #008000;">'A'</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #000000;">token</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">tokstart</span><span style="color: #0000FF;">..</span><span style="color: #000000;">sidx</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">Match</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">token</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">t</span> <span style="color: #008080;">then</span> <span style="color: #000000;">err</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">&</span><span style="color: #008000;">" expected"</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">get_token</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">PopFactor</span><span style="color: #0000FF;">()</span>
<span style="color: #004080;">object</span> <span style="color: #000000;">p2</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">opstack</span><span style="color: #0000FF;">[$]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"not"</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">opstack</span><span style="color: #0000FF;">[$]</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">op</span><span style="color: #0000FF;">,</span><span style="color: #000000;">p2</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">opstack</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">opstack</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..$-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">opstack</span><span style="color: #0000FF;">[$]</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">opstack</span><span style="color: #0000FF;">[$],</span><span style="color: #000000;">op</span><span style="color: #0000FF;">,</span><span style="color: #000000;">p2</span><span style="color: #0000FF;">}</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">names</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- {"false","true",...}</span>
<span style="color: #000000;">flags</span> <span style="color: #000080;font-style:italic;">-- { 0, 1, ,...}</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">PushFactor</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #000000;">PopFactor</span><span style="color: #0000FF;">()</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">,</span><span style="color: #000000;">names</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">names</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">names</span><span style="color: #0000FF;">,</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">names</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">opstack</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">opstack</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">PushOp</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #000000;">PopFactor</span><span style="color: #0000FF;">()</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">t</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #008080;">forward</span> <span style="color: #008080;">procedure</span> <span style="color: #000000;">Expr</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">Factor</span><span style="color: #0000FF;">()</span>
procedure skipspaces()
<span style="color: #008080;">if</span> <span style="color: #000000;">token</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"not"</span>
while find(ch," \t\r\n")!=0 do nxtch() end while
<span style="color: #008080;">or</span> <span style="color: #000000;">token</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"!"</span> <span style="color: #008080;">then</span>
end procedure
<span style="color: #000000;">get_token</span><span style="color: #0000FF;">()</span>
<span style="color: #000000;">Factor</span><span style="color: #0000FF;">()</span>
procedure get_token()
<span style="color: #008080;">if</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #000000;">PopFactor</span><span style="color: #0000FF;">()</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
skipspaces()
<span style="color: #000000;">PushOp</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"not"</span><span style="color: #0000FF;">)</span>
if find(ch,"()!") then
<span style="color: #008080;">elsif</span> <span style="color: #000000;">token</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"("</span> <span style="color: #008080;">then</span>
token = s[sidx..sidx]
<span style="color: #000000;">get_token</span><span style="color: #0000FF;">()</span>
nxtch()
<span style="color: #000000;">Expr</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
else
<span style="color: #000000;">Match</span><span style="color: #0000FF;">(</span><span style="color: #008000;">")"</span><span style="color: #0000FF;">)</span>
integer tokstart = sidx
<span style="color: #008080;">elsif</span> <span style="color: #008080;">not</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">token</span><span style="color: #0000FF;">,{</span><span style="color: #008000;">"and"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"or"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"xor"</span><span style="color: #0000FF;">})</span> <span style="color: #008080;">then</span>
if ch=-1 then token = "eof" return end if
<span style="color: #000000;">PushFactor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">token</span><span style="color: #0000FF;">)</span>
while 1 do
<span style="color: #008080;">if</span> <span style="color: #000000;">ch</span><span style="color: #0000FF;">!=-</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
nxtch()
<span style="color: #000000;">get_token</span><span style="color: #0000FF;">()</span>
if ch<'A' then exit end if
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end while
<span style="color: #008080;">else</span>
token = s[tokstart..sidx-1]
<span style="color: #000000;">err</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"syntax error"</span><span style="color: #0000FF;">)</span>
end if
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end procedure
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
procedure Match(string t)
<span style="color: #008080;">constant</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">operators</span><span style="color: #0000FF;">,</span>
if token!=t then err(t&" expected") end if
<span style="color: #000000;">precedence</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">columnize</span><span style="color: #0000FF;">({{</span><span style="color: #008000;">"not"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">6</span><span style="color: #0000FF;">},</span>
get_token()
<span style="color: #0000FF;">{</span><span style="color: #008000;">"and"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">5</span><span style="color: #0000FF;">},</span>
end procedure
<span style="color: #0000FF;">{</span><span style="color: #008000;">"xor"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"or"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">3</span><span style="color: #0000FF;">}})</span>
procedure PopFactor()
<span style="color: #008080;">procedure</span> <span style="color: #000000;">Expr</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">)</span>
object p2 = opstack[$]
<span style="color: #000000;">Factor</span><span style="color: #0000FF;">()</span>
if op="not" then
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
opstack[$] = {0,op,p2}
<span style="color: #004080;">integer</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">token</span><span style="color: #0000FF;">,</span><span style="color: #000000;">operators</span><span style="color: #0000FF;">)</span>
else
<span style="color: #008080;">if</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
opstack = opstack[1..$-1]
<span style="color: #004080;">integer</span> <span style="color: #000000;">thisp</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">precedence</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span>
opstack[$] = {opstack[$],op,p2}
<span style="color: #008080;">if</span> <span style="color: #000000;">thisp</span><span style="color: #0000FF;"><</span><span style="color: #000000;">p</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
end if
<span style="color: #000000;">get_token</span><span style="color: #0000FF;">()</span>
op = 0
<span style="color: #000000;">Expr</span><span style="color: #0000FF;">(</span><span style="color: #000000;">thisp</span><span style="color: #0000FF;">)</span>
end procedure
<span style="color: #000000;">PushOp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">operators</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">])</span>
 
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
sequence names -- {"false","true",...}
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
sequence flags -- { 0, 1, ,...}
<span style="color: #008080;">function</span> <span style="color: #000000;">evaluate</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
procedure PushFactor(string t)
<span style="color: #008080;">if</span> <span style="color: #004080;">atom</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
if op!=0 then PopFactor() end if
<span style="color: #008080;">if</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">>=</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">flags</span><span style="color: #0000FF;">[</span><span style="color: #000000;">s</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
integer k = find(t,names)
<span style="color: #008080;">return</span> <span style="color: #000000;">s</span>
if k=0 then
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
names = append(names,t)
<span style="color: #004080;">object</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">lhs</span><span style="color: #0000FF;">,</span><span style="color: #000000;">op</span><span style="color: #0000FF;">,</span><span style="color: #000000;">rhs</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span>
k = length(names)
<span style="color: #000000;">lhs</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">evaluate</span><span style="color: #0000FF;">(</span><span style="color: #000000;">lhs</span><span style="color: #0000FF;">)</span>
end if
<span style="color: #000000;">rhs</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">evaluate</span><span style="color: #0000FF;">(</span><span style="color: #000000;">rhs</span><span style="color: #0000FF;">)</span>
opstack = append(opstack,k)
<span style="color: #008080;">if</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"and"</span> <span style="color: #008080;">then</span>
end procedure
<span style="color: #008080;">return</span> <span style="color: #000000;">lhs</span> <span style="color: #008080;">and</span> <span style="color: #000000;">rhs</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"or"</span> <span style="color: #008080;">then</span>
procedure PushOp(string t)
<span style="color: #008080;">return</span> <span style="color: #000000;">lhs</span> <span style="color: #008080;">or</span> <span style="color: #000000;">rhs</span>
if op!=0 then PopFactor() end if
<span style="color: #008080;">elsif</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"xor"</span> <span style="color: #008080;">then</span>
op = t
<span style="color: #008080;">return</span> <span style="color: #000000;">lhs</span> <span style="color: #008080;">xor</span> <span style="color: #000000;">rhs</span>
end procedure
<span style="color: #008080;">elsif</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">=</span><span style="color: #008000;">"not"</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #008080;">not</span> <span style="color: #000000;">rhs</span>
procedure Factor()
<span style="color: #008080;">else</span>
if token="not"
<span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span>
or token="!" then
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
get_token()
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
Factor()
if op!=0 then PopFactor() end if
<span style="color: #008080;">function</span> <span style="color: #000000;">next_comb</span><span style="color: #0000FF;">()</span>
PushOp("not")
<span style="color: #004080;">integer</span> <span style="color: #000000;">fdx</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">flags</span><span style="color: #0000FF;">)</span>
elsif token="(" then
<span style="color: #008080;">while</span> <span style="color: #000000;">flags</span><span style="color: #0000FF;">[</span><span style="color: #000000;">fdx</span><span style="color: #0000FF;">]=</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
get_token()
<span style="color: #000000;">flags</span><span style="color: #0000FF;">[</span><span style="color: #000000;">fdx</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
Expr(0)
<span style="color: #000000;">fdx</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">1</span>
Match(")")
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
elsif not find(token,{"and","or","xor"}) then
<span style="color: #008080;">if</span> <span style="color: #000000;">fdx</span><span style="color: #0000FF;"><=</span><span style="color: #000000;">2</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #004600;">false</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span> <span style="color: #000080;font-style:italic;">-- all done</span>
PushFactor(token)
<span style="color: #000000;">flags</span><span style="color: #0000FF;">[</span><span style="color: #000000;">fdx</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
if ch!=-1 then
<span style="color: #008080;">return</span> <span style="color: #004600;">true</span>
get_token()
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
end if
else
<span style="color: #008080;">procedure</span> <span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">expr</span><span style="color: #0000FF;">)</span>
err("syntax error")
<span style="color: #000000;">opstack</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
end if
<span style="color: #000000;">op</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
end procedure
<span style="color: #000000;">names</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"false"</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"true"</span><span style="color: #0000FF;">}</span>
<span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">expr</span>
constant {operators,
<span style="color: #000000;">sidx</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
precedence} = columnize({{"not",6},
<span style="color: #000000;">nxtch</span><span style="color: #0000FF;">()</span>
{"and",5},
<span style="color: #000000;">get_token</span><span style="color: #0000FF;">()</span>
{"xor",4},
<span style="color: #000000;">Expr</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
{"or",3}})
<span style="color: #008080;">if</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #000000;">PopFactor</span><span style="color: #0000FF;">()</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">opstack</span><span style="color: #0000FF;">)!=</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #000000;">err</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"some error"</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
procedure Expr(integer p)
<span style="color: #000000;">flags</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">names</span><span style="color: #0000FF;">))</span>
Factor()
<span style="color: #000000;">flags</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span> <span style="color: #000080;font-style:italic;">-- set "true" true</span>
while 1 do
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s %s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #7060A8;">join</span><span style="color: #0000FF;">(</span><span style="color: #000000;">names</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">..$]),</span><span style="color: #000000;">s</span><span style="color: #0000FF;">})</span>
integer k = find(token,operators)
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
if k=0 then exit end if
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">3</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">flags</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span> <span style="color: #000080;font-style:italic;">-- (skipping true&false)</span>
integer thisp = precedence[k]
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s%s"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">fmt</span><span style="color: #0000FF;">(</span><span style="color: #000000;">flags</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]),</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">names</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]))})</span>
if thisp<p then exit end if
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
get_token()
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">" %s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">fmt</span><span style="color: #0000FF;">(</span><span style="color: #000000;">evaluate</span><span style="color: #0000FF;">(</span><span style="color: #000000;">opstack</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]))})</span>
Expr(thisp)
<span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #000000;">next_comb</span><span style="color: #0000FF;">()</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
PushOp(operators[k])
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
end while
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
end procedure
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
 
function eval(object s)
<span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"young and not (ugly or poor)"</span><span style="color: #0000FF;">)</span>
if atom(s) then
<span style="color: #008080;">if</span> <span style="color: #7060A8;">platform</span><span style="color: #0000FF;">()!=</span><span style="color: #004600;">JS</span> <span style="color: #008080;">then</span> <span style="color: #000080;font-style:italic;">-- (no gets(0) in a browser)</span>
if s>=1 then s = flags[s] end if
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
return s
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"input expression:"</span><span style="color: #0000FF;">)</span>
end if
<span style="color: #004080;">string</span> <span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">trim</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">gets</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">))</span>
object {lhs,op,rhs} = s
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
lhs = eval(lhs)
<span style="color: #008080;">if</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">=</span><span style="color: #008000;">""</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
rhs = eval(rhs)
<span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
if op="and" then
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
return lhs and rhs
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
elsif op="or" then
<!--</syntaxhighlight>-->
return lhs or rhs
elsif op="xor" then
return lhs xor rhs
elsif op="not" then
return not rhs
else
?9/0
end if
end function
 
function next_comb()
integer fdx = length(flags)
while flags[fdx]=1 do
flags[fdx] = 0
fdx -= 1
end while
if fdx<=2 then return false end if -- all done
flags[fdx] = 1
return true
end function
 
function fmt(bool b)
return {"0","1"}[b+1] -- for 0/1
-- return {"F","T"}[b+1] -- for F/T
end function
 
procedure test(string expr)
opstack = {}
op = 0
names = {"false","true"}
s = expr
sidx = 0
nxtch()
get_token()
Expr(0)
if op!=0 then PopFactor() end if
if length(opstack)!=1 then err("some error") end if
flags = repeat(0,length(names))
flags[2] = 1 -- set "true" true
printf(1,"%s %s\n",{join(names[3..$]),s})
while 1 do
for i=3 to length(flags) do -- (skipping true&false)
printf(1,"%s%s",{fmt(flags[i]),repeat(' ',length(names[i]))})
end for
printf(1," %s\n",{fmt(eval(opstack[1]))})
if not next_comb() then exit end if
end while
puts(1,"\n")
end procedure
 
test("young and not (ugly or poor)")
while 1 do
puts(1,"input expression:")
string t = trim(gets(0))
puts(1,"\n")
if t="" then exit end if
test(t)
end while</lang>
{{out}}
<pre>
Line 2,697 ⟶ 4,730:
 
=={{header|PicoLisp}}==
<langsyntaxhighlight PicoLisplang="picolisp">(de truthTable (Expr)
(let Vars
(uniq
Line 2,720 ⟶ 4,753:
(space (if (print (val "V")) 6 4)) )
(println (eval Expr))
(find '(("V") (set "V" (not (val "V")))) Vars) ) ) ) )</langsyntaxhighlight>
Test:
 
 
<langsyntaxhighlight PicoLisplang="picolisp">: (truthTable (str "A and (B or C)"))
A B C
NIL NIL NIL NIL
Line 2,766 ⟶ 4,799:
T NIL T T
NIL T T T
T T T NIL</langsyntaxhighlight>
 
=={{header|Prolog}}==
{{works with|SWI-Prolog|Any - tested with release 7.6.4}}
<langsyntaxhighlight lang="prolog">/*
To evaluate the truth table a line of text is inputted and then there are three steps
Let's say the expression is:
Line 2,868 ⟶ 4,901:
e(xor,0,0,0). e(xor,0,1,1). e(xor,1,0,1). e(xor,1,1,0).
e(nand,0,0,1). e(nand,0,1,1). e(nand,1,0,1). e(nand,1,1,0).
e(not, 1, 0). e(not, 0, 1).</langsyntaxhighlight>
{{out}}
<pre>
Line 2,889 ⟶ 4,922:
=={{header|Python}}==
This accepts correctly formatted Python boolean expressions.
<langsyntaxhighlight lang="python">from itertools import product
 
while True:
Line 2,903 ⟶ 4,936:
env = dict(zip(names, values))
print(' '.join(str(v) for v in values), ':', eval(code, env))
</syntaxhighlight>
</lang>
 
;Sample output:
Line 2,949 ⟶ 4,982:
 
Thank you</pre>
 
=={{header|Quackery}}==
 
<syntaxhighlight lang="quackery"> [ stack ] is args ( --> s )
[ stack ] is results ( --> s )
[ stack ] is function ( --> s )
[ args share times
[ sp
2 /mod iff
[ char t ]
else
[ char f ]
emit ]
drop
say " | " ] is echoargs ( n --> )
[ args share times
[ 2 /mod swap ]
drop ] is preparestack ( n --> b*n )
 
[ results share times
[ sp
iff
[ char t ]
else
[ char f ]
emit ] ] is echoresults ( b*? --> )
[ say "Please input your function, preceded" cr
$ "by the number of arguments and results: " input
trim nextword quackery args put
trim nextword quackery results put
trim build function put
args share bit times
[ cr
i^ echoargs
i^ preparestack
function share do
echoresults ]
cr
args release
results release
function release ] is truthtable ( --> )
</syntaxhighlight>
 
{{out}}
 
Testing in the Quackery shell.
 
<pre>/O> truthtable
...
Please input your function, preceded
by the number of arguments and results: 2 1 or not
 
f f | t
t f | f
f t | f
t t | f
 
Stack empty.
 
/O> truthtable
...
Please input your function, preceded
by the number of arguments and results: 3 1 and or
 
f f f | f
t f f | t
f t f | f
t t f | t
f f t | f
t f t | t
f t t | t
t t t | t
 
Stack empty.
 
/O> truthtable
...
Please input your function, preceded
by the number of arguments and results: 2 2 2dup and unrot xor ( this is a half-adder )
 
f f | f f
t f | t f
f t | t f
t t | f t
 
Stack empty.</pre>
 
=={{header|R}}==
 
<syntaxhighlight lang="r">
<lang r>
truth_table <- function(x) {
vars <- unique(unlist(strsplit(x, "[^a-zA-Z]+")))
Line 3,019 ⟶ 5,141:
## 15 FALSE TRUE TRUE TRUE TRUE
## 16 TRUE TRUE TRUE TRUE FALSE
</syntaxhighlight>
</lang>
 
=={{header|Racket}}==
Line 3,025 ⟶ 5,147:
Since the requirement is to read an expression dynamically, <tt>eval</tt> is a natural choice. The following isn't trying to protect against bad inputs when doing that.
 
<syntaxhighlight lang="racket">
<lang Racket>
#lang racket
 
Line 3,054 ⟶ 5,176:
(printf "Enter an expression: ")
(truth-table (read))
</syntaxhighlight>
</lang>
 
Sample run:
Line 3,073 ⟶ 5,195:
(formerly Perl 6)
{{works with|Rakudo|2016.01}}
<syntaxhighlight lang="raku" perl6line>use MONKEY-SEE-NO-EVAL;
 
sub MAIN ($x) {
Line 3,082 ⟶ 5,204:
.join("\t").say for map &fun, flat map { .fmt("\%0{+@n}b").comb».Int».so }, 0 ..^ 2**@n;
say '';
}</langsyntaxhighlight>
{{out}}
<pre>
Line 3,137 ⟶ 5,259:
::* &nbsp; '''^''' &nbsp; &nbsp; (caret, &nbsp; circumflex, &nbsp; hat)
Also included is support for two boolean values: '''TRUE''' and '''FALSE''' which are part of boolean expressions.
<langsyntaxhighlight lang="rexx">/*REXX program displays a truth table of variables and an expression. Infix notation */
/*─────────────── is supported with one character propositional constants; variables */
/*─────────────── (propositional constants) that are allowed: A──►Z, a──►z except u.*/
Line 3,372 ⟶ 5,494:
/*f*/ when ? == 'TRUE' then return 1
otherwise return -13
end /*select*/ /* [↑] error, unknown function.*/</langsyntaxhighlight>
Some older REXXes don't have a &nbsp; '''changestr''' &nbsp; BIF, so one is included here &nbsp; ──► &nbsp; [[CHANGESTR.REX]].
 
Line 3,473 ⟶ 5,595:
=={{header|Ruby}}==
Uses <code>eval</code>, so blindly trusts the user's input. The core <code>true</code> and <code>false</code> objects understand the methods <code>&</code> (and), <code>|</code> (or), <code>!</code> (not) and <code>^</code> (xor) -- [http://www.ruby-doc.org/core-1.9.2/TrueClass.html]
<langsyntaxhighlight lang="ruby">loop do
print "\ninput a boolean expression (e.g. 'a & b'): "
expr = gets.strip.downcase
Line 3,498 ⟶ 5,620:
 
eval (prefix + [body] + suffix).join("\n")
end</langsyntaxhighlight>
 
Example
Line 3,542 ⟶ 5,664:
Extending the set of implemented operators should be almost trivial without any change of the logically more complex parts.
 
<langsyntaxhighlight Rustlang="rust">use std::{
collections::HashMap,
fmt::{Display, Formatter},
Line 3,975 ⟶ 6,097:
}
}
}</langsyntaxhighlight>
 
{{out}}
Line 4,004 ⟶ 6,126:
 
</pre>
 
=={{header|SETL}}==
<syntaxhighlight lang="setl">program truth_table;
exprstr := "" +/ command_line;
if exprstr = "" then
print("Enter a Boolean expression on the command line.");
else
showtable(exprstr);
end if;
 
proc showtable(exprstr);
if (toks := tokenize(exprstr)) = om then return; end if;
if (bexp := parse(toks)) = om then return; end if;
vars := [v : v in getvars(bexp)]; $ fix the variable order
 
$ show table header
tabh := "";
loop for v in vars do
tabh +:= v + " ";
end loop;
print(tabh +:= "| " + exprstr);
print('-' * #tabh);
 
$ show table rows
loop for inst in instantiations(vars) do
loop for v in vars do
putchar(rpad(showbool(inst(v)), #v) + " ");
end loop;
print("| " + showbool(booleval(bexp, inst)));
end loop;
end proc;
 
proc showbool(b); return if b then "1" else "0" end if; end proc;
 
proc instantiations(vars);
insts := [];
loop for i in [0..2**#vars-1] do
inst := {};
loop for v in vars do
inst(v) := i mod 2 /= 0;
i div:= 2;
end loop;
insts with:= inst;
end loop;
return insts;
end proc;
 
proc booleval(tokens, inst);
stack := [];
loop for token in tokens do
case token of
("~"): x frome stack; stack with:= not x;
("&"): y frome stack; x frome stack; stack with:= x and y;
("|"): y frome stack; x frome stack; stack with:= x or y;
("^"): y frome stack; x frome stack; stack with:= x /= y;
("=>"): y frome stack; x frome stack; stack with:= x impl y;
("0"): stack with:= false;
("1"): stack with:= true;
else stack with:= inst(token);
end case;
end loop;
answer frome stack;
return answer;
end proc;
 
proc getvars(tokens);
return {tok : tok in tokens | to_upper(tok(1)) in "ABCDEFGHIJKLMNOPQRSTUVWXYZ_"};
end proc;
 
proc parse(tokens);
ops := {["~", 4], ["&", 3], ["|", 2], ["^", 2], ["=>", 1]};
stack := [];
queue := [];
loop for token in tokens do
if token in domain ops then
loop while stack /= []
and (top := stack(#stack)) /= "("
and ops(top) > ops(token) do
oper frome stack;
queue with:= oper;
end loop;
stack with:= token;
elseif token = "(" then
stack with:= token;
elseif token = ")" then
loop doing
if stack = [] then
print("Missing (.");
return om;
end if;
oper frome stack;
while oper /= "(" do
queue with:= oper;
end loop;
elseif token(1) in "23456789" then
print("Invalid boolean ", token);
return om;
else
queue with:= token;
end if;
end loop;
 
loop while stack /= [] do
oper frome stack;
if oper = "(" then
print("Missing ).");
return om;
end if;
queue with:= oper;
end loop;
return queue;
end proc;
 
proc tokenize(s);
varchars := "abcdefghijklmnopqrstuvwxyz";
varchars +:= to_upper(varchars);
varchars +:= "0123456789_";
 
tokens := [];
 
loop doing span(s, " \t\n"); while s /= "" do
if (tok := any(s, "()&|~^")) /= "" $ brackets/single char operators
or (tok := match(s, "=>")) /= "" $ implies (=>)
or (tok := span(s, "0123456789")) /= "" $ numbers
or (tok := span(s, varchars)) /= "" $ variables
then
tokens with:= tok;
else
print("Parse error at", s);
return om;
end if;
end loop;
return tokens;
end proc;
end program;</syntaxhighlight>
{{out}}
<pre>$ setl truth.setl '(human=>mortal) & (socrates=>human) => (socrates=>mortal)'
human mortal socrates | (human=>mortal) & (socrates=>human) => (socrates=>mortal)
---------------------------------------------------------------------------------
0 0 0 | 1
1 0 0 | 1
0 1 0 | 1
1 1 0 | 1
0 0 1 | 1
1 0 1 | 1
0 1 1 | 1
1 1 1 | 1</pre>
 
=={{header|Sidef}}==
{{trans|Ruby}}
A simple solution which accepts arbitrary user-input:
<langsyntaxhighlight lang="ruby">loop {
var expr = Sys.readln("\nBoolean expression (e.g. 'a & b'): ").strip.lc
break if expr.is_empty;
Line 4,030 ⟶ 6,299:
var body = ("say (" + vars.map{|v| v+",'\t'," }.join + " '| ', #{expr})")
eval(prefix + [body] + suffix -> join("\n"))
}</langsyntaxhighlight>
{{out}}
<pre>
Line 4,047 ⟶ 6,316:
=={{header|Smalltalk}}==
{{works with|Smalltalk/X}}
<langsyntaxhighlight lang="smalltalk">[:repeat |
expr := Stdin
request:'Enter boolean expression (name variables a,b,c...):'
defaultAnswer:'a|b'.
ast := Parser parseExpression:expr inNameSpace:nil onError:repeat.
"
"/ ensure that only boolean logic operations are inside (sandbox)
ensure that only boolean logic operations are inside (sandbox)
(ast messageSelectors asSet conform:[:each | #( '|' '&' 'not' ) includes:each]) ifFalse:repeat.
"
(ast messageSelectors asSet
conform:[:each | #( '|' '&' 'not' 'xor:' '==>' ) includes:each])
ifFalse:repeat.
] valueWithRestart.
 
"
"/ extract variables from the AST as a collection
extract variables from the AST as a collection
"/ (i.e. if user entered 'a & (b | x)', we get #('a' 'b' 'x')
(i.e. if user entered 'a & (b | x)', we get #('a' 'b' 'x')
"
varNames := StringCollection streamContents:[:s | ast variableNodesDo:[:each | s nextPut:each name]].
 
"/ generate a code for a block (aka lambda) to evaluate it; this makes a string like:
"
"/ [:a :b :x | a & (b | x) ]
generate code for a block (aka lambda) to evaluate it; this makes a string like:
[:a :b :x | a & (b | x) ]
"
code := '[' , ((varNames collect:[:nm | ':',nm]) asString), ' | ' , expr , ']'.
 
"/ eval the code, to get the block
"
eval the code, to get the block
"
func := Parser evaluate:code.
 
Line 4,072 ⟶ 6,353:
Stdout cr.
 
"
"/ now print with all combinations
now print with all combinations
"
allCombinationsDo :=
[:remainingVars :valuesIn :func |
Line 4,087 ⟶ 6,370:
].
 
allCombinationsDo value:varNames value:#() value:func</syntaxhighlight>
</lang>
{{out}}
<pre>Enter boolean expression (name variables a,b,c...): [[a|b]]:
Line 4,103 ⟶ 6,385:
| true| false| true| true
| true| true| false| true
| true| true| true| true</pre>
 
Enter boolean expression (name variables a,b,c...): [a|b]: (a|b) ==> (c xor: d)
Truth table for (a|b) ==> (c xor: d) :
===================
| a| b| c| d| result
-----------------------------------
| false| false| false| false| true
| false| false| false| true| true
| false| false| true| false| true
| false| false| true| true| true
| false| true| false| false| false
| false| true| false| true| true
| false| true| true| false| true
| false| true| true| true| false
| true| false| false| false| false
| true| false| false| true| true
| true| false| true| false| true
| true| false| true| true| false
| true| true| false| false| false
| true| true| false| true| true
| true| true| true| false| true
| true| true| true| true| false</pre>
 
=={{header|Tcl}}==
<langsyntaxhighlight lang="tcl">package require Tcl 8.5
 
puts -nonewline "Enter a boolean expression: "
Line 4,122 ⟶ 6,426:
 
puts [join $vars \t]\tResult
apply [list {} $cmd]</langsyntaxhighlight>
Sample run:
<pre>
Line 4,139 ⟶ 6,443:
{{omit from|GUISS}}
 
== {{header|XBasicVisual Basic .NET}} ==
{{trans|C#}}
<syntaxhighlight lang="vbnet">Imports System.Text
 
Module Module1
Structure Operator_
Public ReadOnly Symbol As Char
Public ReadOnly Precedence As Integer
Public ReadOnly Arity As Integer
Public ReadOnly Fun As Func(Of Boolean, Boolean, Boolean)
 
Public Sub New(symbol As Char, precedence As Integer, f As Func(Of Boolean, Boolean))
Me.New(symbol, precedence, 1, Function(l, r) f(r))
End Sub
 
Public Sub New(symbol As Char, precedence As Integer, f As Func(Of Boolean, Boolean, Boolean))
Me.New(symbol, precedence, 2, f)
End Sub
 
Public Sub New(symbol As Char, precedence As Integer, arity As Integer, fun As Func(Of Boolean, Boolean, Boolean))
Me.Symbol = symbol
Me.Precedence = precedence
Me.Arity = arity
Me.Fun = fun
End Sub
End Structure
 
Public Class OperatorCollection
Implements IEnumerable(Of Operator_)
 
ReadOnly operators As IDictionary(Of Char, Operator_)
 
Public Sub New(operators As IDictionary(Of Char, Operator_))
Me.operators = operators
End Sub
 
Public Sub Add(symbol As Char, precedence As Integer, fun As Func(Of Boolean, Boolean))
operators.Add(symbol, New Operator_(symbol, precedence, fun))
End Sub
Public Sub Add(symbol As Char, precedence As Integer, fun As Func(Of Boolean, Boolean, Boolean))
operators.Add(symbol, New Operator_(symbol, precedence, fun))
End Sub
 
Public Sub Remove(symbol As Char)
operators.Remove(symbol)
End Sub
 
Public Function GetEnumerator() As IEnumerator(Of Operator_) Implements IEnumerable(Of Operator_).GetEnumerator
Return operators.Values.GetEnumerator
End Function
 
Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
Return GetEnumerator()
End Function
End Class
 
Structure BitSet
Private ReadOnly bits As Integer
 
Public Sub New(bits As Integer)
Me.bits = bits
End Sub
 
Public Shared Operator +(bs As BitSet, v As Integer) As BitSet
Return New BitSet(bs.bits + v)
End Operator
 
Default Public ReadOnly Property Test(index As Integer) As Boolean
Get
Return (bits And (1 << index)) <> 0
End Get
End Property
End Structure
 
Public Class TruthTable
Enum TokenType
Unknown
WhiteSpace
Constant
Operand
Operator_
LeftParenthesis
RightParenthesis
End Enum
 
ReadOnly falseConstant As Char
ReadOnly trueConstant As Char
ReadOnly operatorDict As New Dictionary(Of Char, Operator_)
 
Public ReadOnly Operators As OperatorCollection
 
Sub New(falseConstant As Char, trueConstant As Char)
Me.falseConstant = falseConstant
Me.trueConstant = trueConstant
Operators = New OperatorCollection(operatorDict)
End Sub
 
Private Function TypeOfToken(c As Char) As TokenType
If Char.IsWhiteSpace(c) Then
Return TokenType.WhiteSpace
End If
If c = "("c Then
Return TokenType.LeftParenthesis
End If
If c = ")"c Then
Return TokenType.RightParenthesis
End If
If c = trueConstant OrElse c = falseConstant Then
Return TokenType.Constant
End If
If operatorDict.ContainsKey(c) Then
Return TokenType.Operator_
End If
If Char.IsLetter(c) Then
Return TokenType.Operand
End If
 
Return TokenType.Unknown
End Function
 
Private Function Precedence(op As Char) As Integer
Dim o As New Operator_
If operatorDict.TryGetValue(op, o) Then
Return o.Precedence
Else
Return Integer.MinValue
End If
End Function
 
Public Function ConvertToPostfix(infix As String) As String
Dim stack As New Stack(Of Char)
Dim postfix As New StringBuilder()
For Each c In infix
Dim type = TypeOfToken(c)
Select Case type
Case TokenType.WhiteSpace
Continue For
Case TokenType.Constant, TokenType.Operand
postfix.Append(c)
Case TokenType.Operator_
Dim precedence_ = Precedence(c)
While stack.Count > 0 AndAlso Precedence(stack.Peek()) > precedence_
postfix.Append(stack.Pop())
End While
stack.Push(c)
Case TokenType.LeftParenthesis
stack.Push(c)
Case TokenType.RightParenthesis
Dim top As Char
While stack.Count > 0
top = stack.Pop()
If top = "("c Then
Exit While
Else
postfix.Append(top)
End If
End While
If top <> "("c Then
Throw New ArgumentException("No matching left parenthesis.")
End If
Case Else
Throw New ArgumentException("Invalid character: " + c)
End Select
Next
While stack.Count > 0
Dim top = stack.Pop()
If top = "("c Then
Throw New ArgumentException("No matching right parenthesis.")
End If
postfix.Append(top)
End While
Return postfix.ToString
End Function
 
Private Function Evaluate(expression As Stack(Of Char), values As BitSet, parameters As IDictionary(Of Char, Integer)) As Boolean
If expression.Count = 0 Then
Throw New ArgumentException("Invalid expression.")
End If
Dim c = expression.Pop()
Dim type = TypeOfToken(c)
While type = TokenType.WhiteSpace
c = expression.Pop()
type = TypeOfToken(c)
End While
Select Case type
Case TokenType.Constant
Return c = trueConstant
Case TokenType.Operand
Return values(parameters(c))
Case TokenType.Operator_
Dim right = Evaluate(expression, values, parameters)
Dim op = operatorDict(c)
If op.Arity = 1 Then
Return op.Fun(right, right)
End If
 
Dim left = Evaluate(expression, values, parameters)
Return op.Fun(left, right)
Case Else
Throw New ArgumentException("Invalid character: " + c)
End Select
 
Return False
End Function
 
Public Iterator Function GetTruthTable(expression As String, Optional isPostfix As Boolean = False) As IEnumerable(Of String)
If String.IsNullOrWhiteSpace(expression) Then
Throw New ArgumentException("Invalid expression.")
End If
REM Maps parameters to an index in BitSet
REM Makes sure they appear in the truth table in the order they first appear in the expression
Dim parameters = expression _
.Where(Function(c) TypeOfToken(c) = TokenType.Operand) _
.Distinct() _
.Reverse() _
.Select(Function(c, i) Tuple.Create(c, i)) _
.ToDictionary(Function(p) p.Item1, Function(p) p.Item2)
 
Dim count = parameters.Count
If count > 32 Then
Throw New ArgumentException("Cannot have more than 32 parameters.")
End If
Dim header = If(count = 0, expression, String.Join(" ", parameters.OrderByDescending(Function(p) p.Value).Select(Function(p) p.Key)) & " " & expression)
If Not isPostfix Then
expression = ConvertToPostfix(expression)
End If
 
Dim values As BitSet
Dim stack As New Stack(Of Char)(expression.Length)
 
Dim loopy = 1 << count
While loopy > 0
For Each token In expression
stack.Push(token)
Next
Dim result = Evaluate(stack, values, parameters)
If Not IsNothing(header) Then
If stack.Count > 0 Then
Throw New ArgumentException("Invalid expression.")
End If
Yield header
header = Nothing
End If
 
Dim line = If(count = 0, "", " ") + If(result, trueConstant, falseConstant)
line = String.Join(" ", Enumerable.Range(0, count).Select(Function(i) If(values(count - i - 1), trueConstant, falseConstant))) + line
Yield line
values += 1
''''''''''''''''''''''''''''
loopy -= 1
End While
End Function
 
Public Sub PrintTruthTable(expression As String, Optional isPostfix As Boolean = False)
Try
For Each line In GetTruthTable(expression, isPostfix)
Console.WriteLine(line)
Next
Catch ex As ArgumentException
Console.WriteLine(expression + " " + ex.Message)
End Try
End Sub
End Class
 
Sub Main()
Dim tt As New TruthTable("F"c, "T"c)
tt.Operators.Add("!"c, 6, Function(r) Not r)
tt.Operators.Add("&"c, 5, Function(l, r) l And r)
tt.Operators.Add("^"c, 4, Function(l, r) l Xor r)
tt.Operators.Add("|"c, 3, Function(l, r) l Or r)
REM add a crazy operator
Dim rng As New Random
tt.Operators.Add("?"c, 6, Function(r) rng.NextDouble() < 0.5)
Dim expressions() = {
"!!!T",
"?T",
"F & x | T",
"F & (x | T",
"F & x | T)",
"a ! (a & a)",
"a | (a * a)",
"a ^ T & (b & !c)"
}
For Each expression In expressions
tt.PrintTruthTable(expression)
Console.WriteLine()
Next
 
REM Define a different language
tt = New TruthTable("0"c, "1"c)
tt.Operators.Add("-"c, 6, Function(r) Not r)
tt.Operators.Add("^"c, 5, Function(l, r) l And r)
tt.Operators.Add("v"c, 3, Function(l, r) l Or r)
tt.Operators.Add(">"c, 2, Function(l, r) Not l Or r)
tt.Operators.Add("="c, 1, Function(l, r) l = r)
expressions = {
"-X v 0 = X ^ 1",
"(H > M) ^ (S > H) > (S > M)"
}
For Each expression In expressions
tt.PrintTruthTable(expression)
Console.WriteLine()
Next
End Sub
 
End Module</syntaxhighlight>
{{out}}
<pre>!!!T
F
 
?T
T
 
x F & x | T
F T
T T
 
F & (x | T No matching right parenthesis.
 
F & x | T) No matching left parenthesis.
 
a ! (a & a) Invalid expression.
 
a | (a * a) Invalid character: *
 
a b c a ^ T & (b & !c)
F F F F
F F T F
F T F T
F T T F
T F F T
T F T T
T T F F
T T T T
 
X -X v 0 = X ^ 1
0 0
1 0
 
H M S (H > M) ^ (S > H) > (S > M)
0 0 0 1
0 0 1 1
0 1 0 1
0 1 1 1
1 0 0 1
1 0 1 1
1 1 0 1
1 1 1 1</pre>
 
=={{header|Wren}}==
{{trans|Kotlin}}
{{libheader|Wren-dynamic}}
{{libheader|Wren-ioutil}}
{{libheader|Wren-seq}}
{{libheader|Wren-str}}
<syntaxhighlight lang="wren">import "./dynamic" for Struct
import "./ioutil" for Input
import "./seq" for Stack
import "./str" for Str
 
var Variable = Struct.create("Variable", ["name", "value"])
 
// use integer constants as bools don't support bitwise operators
var FALSE = 0
var TRUE = 1
 
var expr = ""
var variables = []
 
var isOperator = Fn.new { |op| "&|!^".contains(op) }
 
var isVariable = Fn.new { |s| variables.map { |v| v.name }.contains(s) }
 
var evalExpression = Fn.new {
var stack = Stack.new()
for (e in expr) {
var v
if (e == "T") {
v = TRUE
} else if (e == "F") {
v = FALSE
} else if (isVariable.call(e)) {
var vs = variables.where { |v| v.name == e }.toList
if (vs.count != 1) Fiber.abort("Can only be one variable with name %(e).")
v = vs[0].value
} else if (e == "&") {
v = stack.pop() & stack.pop()
} else if (e == "|") {
v = stack.pop() | stack.pop()
} else if (e == "!") {
v = (stack.pop() == TRUE) ? FALSE : TRUE
} else if (e == "^") {
v = stack.pop() ^ stack.pop()
} else {
Fiber.abort("Non-conformant character %(e) in expression")
}
stack.push(v)
}
if (stack.count != 1) Fiber.abort("Something went wrong!")
return stack.peek()
}
 
var setVariables // recursive
setVariables = Fn.new { |pos|
var vc = variables.count
if (pos > vc) Fiber.abort("Argument cannot exceed %(vc).")
if (pos == vc) {
var vs = variables.map { |v| (v.value == TRUE) ? "T" : "F" }.toList
var es = (evalExpression.call() == TRUE) ? "T" : "F"
System.print("%(vs.join(" ")) %(es)")
return
}
variables[pos].value = FALSE
setVariables.call(pos + 1)
variables[pos].value = TRUE
setVariables.call(pos + 1)
}
 
System.print("Accepts single-character variables (except for 'T' and 'F',")
System.print("which specify explicit true or false values), postfix, with")
System.print("&|!^ for and, or, not, xor, respectively; optionally")
System.print("seperated by spaces or tabs. Just enter nothing to quit.")
 
while (true) {
expr = Input.text("\nBoolean expression: ")
if (expr == "") return
expr = Str.upper(expr).replace(" ", "").replace("\t", "")
variables.clear()
for (e in expr) {
if (!isOperator.call(e) && !"TF".contains(e) && !isVariable.call(e)) {
variables.add(Variable.new(e, FALSE))
}
}
if (variables.isEmpty) return
var vs = variables.map { |v| v.name }.join(" ")
System.print("\n%(vs) %(expr)")
var h = vs.count + expr.count + 2
System.print("=" * h)
setVariables.call(0)
}</syntaxhighlight>
 
{{out}}
Sample session:
<pre>
Accepts single-character variables (except for 'T' and 'F',
which specify explicit true or false values), postfix, with
&|!^ for and, or, not, xor, respectively; optionally
seperated by spaces or tabs. Just enter nothing to quit.
 
Boolean expression: A B ^
 
A B AB^
=========
F F F
F T T
T F T
T T F
 
Boolean expression: A B C ^ |
 
A B C ABC^|
==============
F F F F
F F T T
F T F T
F T T F
T F F T
T F T T
T T F T
T T T T
 
Boolean expression: A B C D ^ ^ ^
 
A B C D ABCD^^^
===================
F F F F F
F F F T T
F F T F T
F F T T F
F T F F T
F T F T F
F T T F F
F T T T T
T F F F T
T F F T F
T F T F F
T F T T T
T T F F F
T T F T T
T T T F T
T T T T F
 
Boolean expression:
</pre>
 
=={{header|XBasic}}==
{{trans|C}}
{{works with|Windows XBasic}}
<langsyntaxhighlight lang="xbasic">
PROGRAM "truthtables"
VERSION "0.001"
Line 4,361 ⟶ 7,160:
END FUNCTION
END PROGRAM
</syntaxhighlight>
</lang>
{{out}}
<pre>
9,476

edits