add case special form, improve readme

README.md

@@ -65,7 +65,7 @@ You can use the [LispFactory](src/LispFactory.php) class to create an instance o
 
 ### Safe-mode
 
-The language features a safe-mode that disables functions which allow external I/O. This allows a "sandbox" to be created where the evaluated scripts do not have access to the file system or similar resources. It is intended to be used when MadLisp is used as an embedded scripting language inside another application.
+The language includes a safe-mode that disables functions which allow external I/O. This allows a "sandbox" to be created where the evaluated scripts do not have access to the file system or other resources.
 
 ## Types
 
@@ -144,6 +144,105 @@ You can also retrieve the parent environment:
 {}
 ```
 
+## Control flow
+
+### If
+
+Simple conditional evaluation is accomplished with the `if` expression that is of the form `(if test consequent alternate)`. If *test* evaluates to truthy value, *consequent* is evaluated and returned. If *test* evaluates to falsy value, *alternate* is evaluated and returned.
+
+```text
+> (if (< 1 2) "yes" "no")
+"yes"
+```
+
+If *alternate* is not provided, null is returned in its place:
+
+```text
+> (if (str? 1) "string")
+null
+```
+
+### And, or
+
+The `and` form returns the first expression that evaluates to falsy value:
+
+```text
+> (and 2 true "str" 0 3)
+0
+```
+
+The `or` form returns the first expression that evaluates to truthy value:
+
+```text
+> (or 0 false 3 5)
+3
+```
+
+Without arguments `and` and `or` return true and false respectively:
+
+```text
+> (and)
+true
+> (or)
+false
+```
+
+### Cond, case and case-strict
+
+When you have more than two possible paths of execution, it is convenient to use the `cond` and `case` forms.
+
+For `cond`, the first item of each argument is evaluated. If it evaluates to truthy value, the following expression is evaluated and returned:
+
+```text
+> (def n 4)
+4
+> (cond ((= n 2) "two") ((= n 4) "four") ((= n 6) "six"))
+"four"
+```
+
+For `case`, the first argument is evaluated, and then it is matched against the first item of the remaining arguments. If there is a match, the following expression is evaluated and returned:
+
+```text
+> (case (+ 1 3) (2 "two") (4 "four") (6 "six"))
+"four"
+```
+
+The `case-strict` is similar, but uses strict comparison:
+
+```text
+> (case (+ 1 3) ("4" "string: 4") (4 "integer: 4"))
+"string: 4"
+> (case-strict (+ 1 3) ("4" "string: 4") (4 "integer: 4"))
+"integer: 4"
+```
+
+Both `cond` and `case` can have an `else` form which is matched if nothing else matched up to that point:
+
+```text
+> (cond ((< n 2) "small") (else "big"))
+"big"
+> (case (% 3 2) (0 "even") (else "odd"))
+"odd"
+```
+
+Both `cond` and `case` can have more than one expression which is evaluated after a successful match:
+
+```text
+> (def n 4)
+4
+> (cond ((int? n) (print "Number: ") n))
+Number: 4
+```
+
+Finally, the arguments to `cond` and `case` can be given either as lists or as vectors. It is up to the programmer to decide which syntax to use. The previous example could have been written using square brackets instead:
+
+```text
+> (cond [(int? n) (print "Number: ") n])
+Number: 4
+```
+
+If no match is found, and `else` is not defined, `cond` and `case` return null.
+
 ## Quoting
 
 Use the `quote` special form to skip evaluation:
@@ -278,21 +377,22 @@ This allows for some fun tricks. For example, we can retrieve the body of a func
 
 Name  | Safe-mode | Example | Example result | Description
 ----- | --------- | ------- | -------------- | -----------
-and   | yes | `(and 1 0 2)` | `0` | Return the first value that evaluates to false, or the last value.
+and   | yes | | | See the section Control flow.
-cond  | yes | `(cond [(= 0 1) 0] [(= 1 1) (print "1") 1])` | `11` | Treat first item of each argument as test. If test evaluates to true, evaluate the following expressions and return the value of the last.
+case  | yes | | | See the section Control flow.
-      | yes | `(cond [(= 0 1) 0] [(= 1 2) 1] [else 3])` | `3` | The symbol `else` evaluates to true. It can be used as the last condition in case no previous test evaluates to true.
+case-strict | yes | | | See the section Control flow.
+cond  | yes | | | See the section Control flow.
 def   | yes | `(def addOne (fn (a) (+ a 1)))` | `<function>` | Define a value in the current environment.
 do    | yes | `(do (print 1) 2)` | `12` | Evaluate multiple expressions and return the value of the last.
 env   | yes | `(env +)` | `<function>` | Return a definition from the current environment represented by argument. Without arguments return the current environment as a hash-map.
 eval  | yes | `(eval (quote (+ 1 2)))` | `3` | Evaluate the argument.
 fn    | yes | `(fn (a b) (+ a b))` | `<function>` | Create a function. Arguments can also be given as a vector instead of a list.
-if    | yes | `(if (< 1 2) "yes" "no")` | `"yes"` | If the first argument evaluates to true, evaluate and return the second argument, otherwise the third argument. If the third argument is omitted return `null` in its place.
+if    | yes | | | See the section Control flow.
 let   | yes | `(let (a (+ 1 2)) a)` | `3` | Create a new local environment using the first argument (list) to define values. Odd arguments are treated as keys and even arguments are treated as values. The last argument is the body of the let-expression which is evaluated using this new environment.
 load  | no  | `(load "file.mad")` | | Read and evaluate a file. The contents are implicitly wrapped in a `do` expression.
 macro | yes | | | See the section Macros.
 macroexpand | yes | | | See the section Macros.
 meta  | yes | | | See the sections Environments and Reflection.
-or    | yes | `(or false 0 1)` | `1` | Return the first value that evaluates to true, or the last value.
+or    | yes | | | See the section Control flow.
 quote | yes | | | See the section Quoting.
 quasiquote | yes | | | See the section Quoting.
 quasiquote-expand | yes | | | See the section Quoting.

src/Evaller.php

@@ -93,6 +93,47 @@ class Evaller
 
                     $ast = $astData[$astLength - 1];
                     continue; // tco
+                } elseif ($symbolName == 'case' || $symbolName == 'case-strict') {
+                    if ($astLength < 3) {
+                        throw new MadLispException("$symbolName requires at least 2 arguments");
+                    }
+
+                    $value = $this->eval($astData[1], $env, $depth + 1);
+
+                    for ($i = 2; $i < $astLength; $i++) {
+                        if (!($astData[$i] instanceof Seq)) {
+                            throw new MadLispException("argument to $symbolName is not seq");
+                        }
+
+                        $data = $astData[$i]->getData();
+
+                        if (count($data) < 2) {
+                            throw new MadLispException("clause for $symbolName requires at least 2 arguments");
+                        }
+
+                        if ($data[0] instanceof Symbol && $data[0]->getName() == 'else') {
+                            $test = true;
+                        } elseif ($symbolName == 'case') {
+                            $test = Util::valueForCompare($value) == Util::valueForCompare($data[0]);
+                        } else {
+                            // Strict comparison
+                            $test = Util::valueForCompare($value) === Util::valueForCompare($data[0]);
+                        }
+
+                        if ($test) {
+                            // Evaluate interval expressions
+                            for ($j = 1; $j < count($data) - 1; $j++) {
+                                $this->eval($data[$j], $env, $depth + 1);
+                            }
+
+                            // Evaluate last expression
+                            $ast = $data[count($data) - 1];
+                            continue 2; // tco
+                        }
+                    }
+
+                    // No match
+                    return null;
                 } elseif ($symbolName == 'cond') {
                     if ($astLength < 2) {
                         throw new MadLispException("cond requires at least 1 argument");
@@ -103,31 +144,31 @@ class Evaller
                             throw new MadLispException("argument to cond is not seq");
                         }
 
-                        $condData = $astData[$i]->getData();
+                        $data = $astData[$i]->getData();
 
-                        if (count($condData) < 2) {
+                        if (count($data) < 2) {
                             throw new MadLispException("clause for cond requires at least 2 arguments");
                         }
 
-                        if ($condData[0] instanceof Symbol && $condData[0]->getName() == 'else') {
+                        if ($data[0] instanceof Symbol && $data[0]->getName() == 'else') {
                             $test = true;
                         } else {
-                            $test = $this->eval($condData[0], $env, $depth + 1);
+                            $test = $this->eval($data[0], $env, $depth + 1);
                         }
 
-                        if ($test == true) {
+                        if ($test) {
                             // Evaluate interval expressions
-                            for ($a = 1; $a < count($condData) - 1; $a++) {
+                            for ($j = 1; $j < count($data) - 1; $j++) {
-                                $this->eval($condData[$a], $env, $depth + 1);
+                                $this->eval($data[$j], $env, $depth + 1);
                             }
 
                             // Evaluate last expression
-                            $ast = $condData[count($condData) - 1];
+                            $ast = $data[count($data) - 1];
                             continue 2; // tco
                         }
                     }
 
-                    // No matches
+                    // No match
                     return null;
                 } elseif ($symbolName == 'def') {
                     if ($astLength != 3) {

src/Lib/Compare.php

@@ -5,25 +5,26 @@ use MadLisp\Collection;
 use MadLisp\CoreFunc;
 use MadLisp\Env;
 use MadLisp\Symbol;
+use MadLisp\Util;
 
 class Compare implements ILib
 {
     public function register(Env $env): void
     {
         $env->set('=', new CoreFunc('=', 'Return true if arguments are equal.', 2, 2,
-            fn ($a, $b) => $this->getValue($a) == $this->getValue($b)
+            fn ($a, $b) => Util::valueForCompare($a) == Util::valueForCompare($b)
         ));
 
         $env->set('==', new CoreFunc('==', 'Return true if arguments are equal using strict comparison.', 2, 2,
-            fn ($a, $b) => $this->getValue($a) === $this->getValue($b)
+            fn ($a, $b) => Util::valueForCompare($a) === Util::valueForCompare($b)
         ));
 
         $env->set('!=', new CoreFunc('!=', 'Return true if arguments are not equal.', 2, 2,
-            fn ($a, $b) => $this->getValue($a) != $this->getValue($b)
+            fn ($a, $b) => Util::valueForCompare($a) != Util::valueForCompare($b)
         ));
 
         $env->set('!==', new CoreFunc('!==', 'Return true if arguments are not equal using strict comparison.', 2, 2,
-            fn ($a, $b) => $this->getValue($a) !== $this->getValue($b)
+            fn ($a, $b) => Util::valueForCompare($a) !== Util::valueForCompare($b)
         ));
 
         $env->set('<', new CoreFunc('<', 'Return true if first argument is less than second argument.', 2, 2,
@@ -42,15 +43,4 @@ class Compare implements ILib
             fn ($a, $b) => $a >= $b
         ));
     }
-
-    private function getValue($a)
-    {
-        if ($a instanceof Symbol) {
-            return $a->getName();
-        } elseif ($a instanceof Collection) {
-            return $a->getData();
-        }
-
-        return $a;
-    }
 }

src/Util.php

@@ -24,4 +24,15 @@ class Util
 
         return new Hash($data);
     }
+
+    public static function valueForCompare($a)
+    {
+        if ($a instanceof Symbol) {
+            return $a->getName();
+        } elseif ($a instanceof Collection) {
+            return $a->getData();
+        }
+
+        return $a;
+    }
 }