extra/rosetta-code/ternary-logic/ternary-logic.factor

   1 ! Copyright (c) 2012 Anonymous
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: combinators kernel ;
   4 IN: rosetta-code.ternary-logic
   5
   6 ! http://rosettacode.org/wiki/Ternary_logic
   7
   8 ! In logic, a three-valued logic (also trivalent, ternary, or
   9 ! trinary logic, sometimes abbreviated 3VL) is any of several
  10 ! many-valued logic systems in which there are three truth values
  11 ! indicating true, false and some indeterminate third value. This
  12 ! is contrasted with the more commonly known bivalent logics (such
  13 ! as classical sentential or boolean logic) which provide only for
  14 ! true and false. Conceptual form and basic ideas were initially
  15 ! created by Łukasiewicz, Lewis and Sulski. These were then
  16 ! re-formulated by Grigore Moisil in an axiomatic algebraic form,
  17 ! and also extended to n-valued logics in 1945.
  18
  19 ! Task:
  20
  21 ! * Define a new type that emulates ternary logic by storing data trits.
  22
  23 ! * Given all the binary logic operators of the original
  24 !   programming language, reimplement these operators for the new
  25 !   Ternary logic type trit.
  26
  27 ! * Generate a sampling of results using trit variables.
  28
  29 ! * Kudos for actually thinking up a test case algorithm where
  30 !   ternary logic is intrinsically useful, optimises the test case
  31 !   algorithm and is preferable to binary logic.
  32
  33 SINGLETON: m
  34 UNION: trit t m POSTPONE: f ;
  35
  36 GENERIC: >trit ( object -- trit )
  37 M: trit >trit ;
  38
  39 : tnot ( trit1 -- trit )
  40     >trit { { t [ f ] } { m [ m ] } { f [ t ] } } case ;
  41
  42 : tand ( trit1 trit2 -- trit )
  43     >trit {
  44         { t [ >trit ] }
  45         { m [ >trit { { t [ m ] } { m [ m ] } { f [ f ] } } case ] }
  46         { f [ >trit drop f ] }
  47     } case ;
  48
  49 : tor ( trit1 trit2 -- trit )
  50     >trit {
  51         { t [ >trit drop t ] }
  52         { m [ >trit { { t [ t ] } { m [ m ] } { f [ m ] } } case ] }
  53         { f [ >trit ] }
  54     } case ;
  55
  56 : txor ( trit1 trit2 -- trit )
  57     >trit {
  58         { t [ tnot ] }
  59         { m [ >trit drop m ] }
  60         { f [ >trit ] }
  61     } case ;
  62
  63 : t= ( trit1 trit2 -- trit )
  64     {
  65         { t [ >trit ] }
  66         { m [ >trit drop m ] }
  67         { f [ tnot ] }
  68     } case ;