Improve bool system

lisp has true in form of t and false in form of nil

lib/Minilisp.pm

@@ -14,6 +14,19 @@ use constant {
   LIST => 7,
 };
 
+use constant {
+  LISP_TRUE => 1,
+  LISP_FALSE => undef,
+};
+
+sub to_lisp_bool {
+  return shift ? LISP_TRUE : LISP_FALSE;
+}
+
+sub from_lisp_bool {
+  return defined(shift);
+}
+
 sub tokenize {
   my $str = shift;
   my @tokens;
@@ -160,26 +173,26 @@ sub lisp_equal {
   my ($a, $b) = @_;
   if ( ref($a) eq "ARRAY" && ref($b) eq "ARRAY" )
     {
-      return 0 unless scalar(@$a) == scalar(@$b);
+      return LISP_FALSE unless scalar(@$a) == scalar(@$b);
 
       for(my $i = 0; $i < @$a; $i++)
         {
-          return 0 unless lisp_equal($a->[$i], $b->[$i]);
+          return LISP_FALSE unless lisp_equal($a->[$i], $b->[$i]);
         }
 
-      return 1;
+      return LISP_TRUE;
     }
   elsif ( ref($a) eq "KEYWORD" && ref($b) eq "KEYWORD" )
     {
-      return $a->{value} eq $b->{value};
+      return to_lisp_bool($a->{value} eq $b->{value});
     }
   elsif ( ref($a) eq "" && ref($b) eq "" )
     {
-      return $a == $b;
+      return to_lisp_bool($a == $b);
     }
   else
     {
-      return 0;
+      return LISP_FALSE;
     }
 }
 
@@ -215,32 +228,22 @@ my %stdctx = (
     return undef;
   },
   'null' => sub { my ($a) = @_; return ! defined $a; },
-  'evenp' => sub { my ($a) = @_; return ($a % 2 == 0); },
+  'evenp' => sub { my ($a) = @_; return to_lisp_bool($a % 2 == 0); },
-  'oddp' => sub { my ($a) = @_; return ($a % 2 != 0); },
+  'oddp' => sub { my ($a) = @_; return to_lisp_bool($a % 2 != 0); },
-  'zerop' => sub { my ($a) = @_; return $a == 0; },
+  'zerop' => sub { my ($a) = @_; return to_lisp_bool($a == 0); },
-  'eq' => sub { my ($a, $b) = @_; return ($a == $b); },
+  'eq' => sub { my ($a, $b) = @_; return to_lisp_bool($a == $b); },
-  'ne' => sub { my ($a, $b) = @_; return ($a != $b); },
+  'ne' => sub { my ($a, $b) = @_; return to_lisp_bool($a != $b); },
 
   # Logical operators
-  'not' => sub { my ($a) = @_; return !$a; },
+  'not' => sub { my ($a) = @_; return to_lisp_bool(!from_lisp_bool($a)); },
-  'and' => sub {
-    my $v = 1;
-    $v &&= $_ foreach (@_);
-    return $v;
-  },
-  'or' => sub {
-    my $v = 0;
-    $v ||= $_ foreach(@_);
-    return $v;
-  },
 
   # Numeric comparison
-  '=' => sub { my ($a, $b) = @_; return ($a == $b); },
+  '=' => sub { my ($a, $b) = @_; return to_lisp_bool($a == $b); },
-  '/=' => sub { my ($a, $b) = @_; return ($a != $b); },
+  '/=' => sub { my ($a, $b) = @_; return to_lisp_bool($a != $b); },
-  '>' => sub { my ($a,$b) = @_; return ($a > $b); },
+  '>' => sub { my ($a,$b) = @_; return to_lisp_bool($a > $b); },
-  '<' => sub { my ($a,$b) = @_; return ($a < $b); },
+  '<' => sub { my ($a,$b) = @_; return to_lisp_bool($a < $b); },
-  '>=' => sub { my ($a,$b) = @_; return ($a >= $b); },
+  '>=' => sub { my ($a,$b) = @_; return to_lisp_bool($a >= $b); },
-  '<=' => sub { my ($a,$b) = @_; return ($a <= $b); },
+  '<=' => sub { my ($a,$b) = @_; return to_lisp_bool($a <= $b); },
   'max' => sub {
     die "max: At least 2 parameters" unless scalar(@_) >= 2;
     my $v = shift;
@@ -261,18 +264,18 @@ my %stdctx = (
   },
 
   # String comparison
-  'string=' => sub { my ($a, $b) = @_; return ($a eq $b); },
+  'string=' => sub { my ($a, $b) = @_; return to_lisp_bool($a eq $b); },
-  'string/=' => sub { my ($a, $b) = @_; return ($a ne $b); },
+  'string/=' => sub { my ($a, $b) = @_; return to_lisp_bool($a ne $b); },
-  'string<' => sub { my ($a, $b) = @_; return ($a lt $b); },
+  'string<' => sub { my ($a, $b) = @_; return to_lisp_bool($a lt $b); },
-  'string>' => sub { my ($a, $b) = @_; return ($a gt $b); },
+  'string>' => sub { my ($a, $b) = @_; return to_lisp_bool($a gt $b); },
-  'string<=' => sub { my ($a, $b) = @_; return !($a gt $b); },
+  'string<=' => sub { my ($a, $b) = @_; return to_lisp_bool(!($a gt $b)); },
-  'string>=' => sub { my ($a, $b) = @_; return !($a lt $b); },
+  'string>=' => sub { my ($a, $b) = @_; return to_lisp_bool(!($a lt $b)); },
-  'string-equal' => sub { my ($a, $b) = @_; return ( lc($a) eq lc($b)); },
+  'string-equal' => sub { my ($a, $b) = @_; return to_lisp_bool( lc($a) eq lc($b)); },
-  'string-not-equal' => sub { my ($a, $b) = @_; return (lc($a) ne lc($b)); },
+  'string-not-equal' => sub { my ($a, $b) = @_; return to_lisp_bool(lc($a) ne lc($b)); },
-  'string-lessp' => sub { my ($a, $b) = @_; return (lc($a) lt lc($b)); },
+  'string-lessp' => sub { my ($a, $b) = @_; return to_lisp_bool(lc($a) lt lc($b)); },
-  'string-greaterp' => sub { my ($a, $b) = @_; return (lc($a) gt lc($b)); },
+  'string-greaterp' => sub { my ($a, $b) = @_; return to_lisp_bool(lc($a) gt lc($b)); },
-  'string-not-greaterp' => sub { my ($a, $b) = @_; return !(lc($a) gt lc($b)); },
+  'string-not-greaterp' => sub { my ($a, $b) = @_; return to_lisp_bool(!(lc($a) gt lc($b))); },
-  'string-not-lessp' => sub { my ($a, $b) = @_; return !(lc($a) lt lc($b)); },
+  'string-not-lessp' => sub { my ($a, $b) = @_; return to_lisp_bool(!(lc($a) lt lc($b))); },
 
   # string operations
   'string-upcase' => sub { return uc(shift); },
@@ -354,9 +357,8 @@ my %stdctx = (
   },
 
   # Constants
-  't' => 1,
+  't' => LISP_TRUE,
-  'f' => 0,
+  'nil' => LISP_FALSE,
-  'nil' => undef,
 
   # Multi-purpose
   'equal' => \&lisp_equal,
@@ -614,7 +616,7 @@ sub macro_if {
     my $ctx = shift;
 
     my $condresult = $cond->($ctx);
-    if ($condresult) {
+    if (defined $condresult) {
       return $tbranch->($ctx);
     } else {
       return $fbranch->($ctx);
@@ -714,7 +716,7 @@ sub macro_when {
   return sub {
     my $ctx = shift;
 
-    if ($condition->($ctx))
+    if (defined($condition->($ctx)))
       {
         return $work->($ctx);
       }
@@ -733,7 +735,7 @@ sub macro_unless {
   return sub {
     my $ctx = shift;
 
-    if (!$condition->($ctx))
+    if (!defined($condition->($ctx)))
       {
         return $work->($ctx);
       }
@@ -762,6 +764,54 @@ sub macro_set {
 }
 $macros{set} = \&macro_set;
 
+sub macro_and {
+  my $ts = shift;
+
+  my @operands_parsed;
+  while ( $ts->[0]->{type} != RPAREN )
+    {
+      push @operands_parsed, parser_expr($ts);
+    }
+
+  return sub {
+    my $ctx = shift;
+
+    my $v = LISP_TRUE;
+    my @operands = @operands_parsed;
+    while (from_lisp_bool($v) && (my $op = shift @operands))
+      {
+        $v = $op->($ctx);
+      }
+
+    return $v;
+  };
+}
+$macros{and} = \&macro_and;
+
+sub macro_or {
+  my $ts = shift;
+
+  my @operands_parsed;
+  while ( $ts->[0]->{type} != RPAREN )
+    {
+      push @operands_parsed, parser_expr($ts);
+    }
+
+  return sub {
+    my $ctx = shift;
+
+    my $v = LISP_FALSE;
+    my @operands = @operands_parsed;
+    while (!from_lisp_bool($v) && (my $op = shift @operands))
+      {
+        $v = $op->($ctx);
+      }
+
+    return $v;
+  };
+}
+$macros{or} = \&macro_or;
+
 sub compile {
   my ($term) = @_;
   my @tokens = tokenize($term);

t/and_or.t

@@ -0,0 +1,13 @@
+(let ((a 'ok))
+  (and nil (set a 'fail))
+  (expect "and - Short circuit" (equal a 'ok)))
+
+;; (let ((a 'ok))
+;;   (or t (set a 'fail))
+;;   (expect "or - short circuit" (equal a 'ok)))
+
+(expect "and - returns last value if all operands evaluate to true"
+        (equal (and t 'ok) 'ok))
+
+(expect "and - returns nil if any operand evaluates to false"
+        (null (and nil t)))

t/bool.t

@@ -1,9 +1,9 @@
 ;; Constants
 
 (expect "True is true" (eq 1 (if t 1 0)))
-(expect "False is false" (eq 1 (if f 0 1)))
+(expect "False is false" (eq 1 (if nil 0 1)))
 
-(expect "not f == t" (not f))
+(expect "not f == t" (not nil))
 (expect "not t == f" (eq 1 (if (not t) 0 1)))
 
 ;; operator and
@@ -12,17 +12,23 @@
         (and t t))
 
 (expect "and operator: t && f == f"
-        (not (and t f)))
+        (not (and t nil)))
+
+(expect "and operator: f && t == f"
+        (not (and nil t)))
 
 (expect "and operator: f && f == f"
-        (not (and f f)))
+        (not (and nil nil)))
 
 ;; operator or
 (expect "or operator: t || t == t"
         (or t t))
 
 (expect "or operator: t || f == t"
-        (or t f))
+        (or t nil))
+
+(expect "or operator: f || t == t"
+        (or nil t))
 
 (expect "or operator: f || f == f"
-        (not (or f f)))
+        (not (or nil nil)))

t/cond.t

@@ -1,5 +1,5 @@
 (expect "cond" 2
         (cond ((> 1 2) 10)
-              (f 20)
+              (nil 20)
               ((zerop 0) 2)
               (t 10)))

t/unless.t

@@ -2,4 +2,4 @@
         (null (unless t 'fail)))
 
 (expect "unless - false condition"
-        (equal 'ok (unless f 'ok)))
+        (equal 'ok (unless nil 'ok)))

t/when.t

@@ -2,4 +2,4 @@
         (equal 'ok (when t 'ok)))
 
 (expect "when - false condition"
-        (null (when f 'fail)))
+        (null (when nil 'fail)))