62 lines
1.6 KiB
Text
62 lines
1.6 KiB
Text
$define TRUE 1
|
|
$define FALSE -1
|
|
$define UNKNOWN 0
|
|
|
|
invocable all
|
|
link printf
|
|
|
|
procedure main() # demonstrate ternary logic
|
|
|
|
ufunc := ["not3"]
|
|
bfunc := ["and3", "or3", "xor3", "eq3", "ifthen3"]
|
|
|
|
every f := !ufunc do { # display unary functions
|
|
printf("\nunary function=%s:\n",f)
|
|
every t1 := (TRUE | FALSE | UNKNOWN) do
|
|
printf(" %s : %s\n",showtrit(t1),showtrit(not3(t1)))
|
|
}
|
|
|
|
|
|
every f := !bfunc do { # display binary functions
|
|
printf("\nbinary function=%s:\n ",f)
|
|
every t1 := (&null | TRUE | FALSE | UNKNOWN) do {
|
|
printf(" %s : ",showtrit(\t1))
|
|
every t2 := (TRUE | FALSE | UNKNOWN | &null) do {
|
|
if /t1 then printf(" %s",showtrit(\t2)|"\n")
|
|
else printf(" %s",showtrit(f(t1,\t2))|"\n")
|
|
}
|
|
}
|
|
}
|
|
end
|
|
|
|
procedure showtrit(a) #: return printable trit of error if invalid
|
|
return case a of {TRUE:"T";FALSE:"F";UNKNOWN:"?";default:runerr(205,a)}
|
|
end
|
|
|
|
procedure istrit(a) #: return value of trit or error if invalid
|
|
return (TRUE|FALSE|UNKNOWN|runerr(205,a)) = a
|
|
end
|
|
|
|
procedure not3(a) #: not of trit or error if invalid
|
|
return FALSE * istrit(a)
|
|
end
|
|
|
|
procedure and3(a,b) #: and of two trits or error if invalid
|
|
return min(istrit(a),istrit(b))
|
|
end
|
|
|
|
procedure or3(a,b) #: or of two trits or error if invalid
|
|
return max(istrit(a),istrit(b))
|
|
end
|
|
|
|
procedure eq3(a,b) #: equals of two trits or error if invalid
|
|
return istrit(a) * istrit(b)
|
|
end
|
|
|
|
procedure ifthen3(a,b) #: if trit then trit or error if invalid
|
|
return case istrit(a) of { TRUE: istrit(b) ; UNKNOWN: or3(a,b); FALSE: TRUE }
|
|
end
|
|
|
|
procedure xor3(a,b) #: xor of two trits or error if invalid
|
|
return not3(eq3(a,b))
|
|
end
|