Skip to content
Browse files

Implemented the special form `setf!` and changed semantic of `define`.

  • Loading branch information...
1 parent eff76f3 commit adfa7bf66085213037e12b2a646eae4636497028 @dahlia dahlia committed
Showing with 95 additions and 4 deletions.
  1. +1 −0 Lisphp/Environment.php
  2. +1 −0 Lisphp/Runtime.php
  3. +6 −1 Lisphp/Runtime/Define.php
  4. +19 −0 Lisphp/Runtime/Setf.php
  5. +5 −0 Lisphp/Scope.php
  6. +11 −0 README.markdown
  7. +17 −3 test.php
  8. +28 −0 tests/lexical-scope.lisphp
  9. +7 −0 tests/lexical-scope.out
View
1 Lisphp/Environment.php
@@ -14,6 +14,7 @@ static function sandbox() {
array('Lisphp_Symbol', 'get')
);
$scope['define'] = new Lisphp_Runtime_Define;
+ $scope['setf!'] = new Lisphp_Runtime_Setf;
$scope['let'] = new Lisphp_Runtime_Let;
$scope['macro'] = new Lisphp_Runtime_Macro;
$scope['lambda'] = new Lisphp_Runtime_Lambda;
View
1 Lisphp/Runtime.php
@@ -3,6 +3,7 @@
require_once 'Runtime/UserMacro.php';
require_once 'Runtime/Eval.php';
require_once 'Runtime/Define.php';
+require_once 'Runtime/Setf.php';
require_once 'Runtime/Let.php';
require_once 'Runtime/Quote.php';
require_once 'Runtime/Macro.php';
View
7 Lisphp/Runtime/Define.php
@@ -13,8 +13,13 @@ function apply(Lisphp_Scope $scope, Lisphp_List $arguments) {
$body = $arguments->cdr();
$name = $name->car();
$retval = new Lisphp_Runtime_Function($scope, $params, $body);
+ } else {
+ throw new InvalidArgumentException(
+ 'first operand of define form must be symbol or list'
+ );
}
- return $scope[$name] = $retval;
+ $scope->define($name, $retval);
+ return $retval;
}
}
View
19 Lisphp/Runtime/Setf.php
@@ -0,0 +1,19 @@
+<?php
+require_once 'Lisphp/Applicable.php';
+require_once 'Lisphp/List.php';
+require_once 'Lisphp/Scope.php';
+
+final class Lisphp_Runtime_Setf implements Lisphp_Applicable {
+ function apply(Lisphp_Scope $scope, Lisphp_List $arguments) {
+ $name = $arguments[0];
+ if ($name instanceof Lisphp_Symbol) {
+ $retval = $arguments[1]->evaluate($scope);
+ } else {
+ throw new InvalidArgumentException(
+ 'first operand of setf! form must be symbol'
+ );
+ }
+ return $scope[$name] = $retval;
+ }
+}
+
View
5 Lisphp/Scope.php
@@ -19,6 +19,11 @@ function let($symbol, $value) {
$this->values[self::_symbol($symbol)] = $value;
}
+ function define($symbol, $value) {
+ for ($s = $this; !is_null($s->superscope); $s = $s->superscope);
+ $s->let($symbol, $value);
+ }
+
function offsetGet($symbol) {
$sym = self::_symbol($symbol);
if (array_key_exists($sym, $this->values)) return $this->values[$sym];
View
11 README.markdown
@@ -183,6 +183,17 @@ Following code defines the same function.
Function body can contain one or more forms. All forms are evaluated
sequentially then the evaluated value of the last form is returned.
+Plus, of course, it implements lexical scope (that is also known as closure)
+also.
+
+ (define (adder n)
+ {lambda [x]
+ (setf! n (+ n x))
+ n})
+
+Special form `define` defines global variables (and functions),
+but `setf!` modifies local variables. See also `let` form.
+
Define custom macros
--------------------
View
20 test.php
@@ -1,6 +1,8 @@
<?php
require dirname(__FILE__) . '/Lisphp.php';
+$options = getopt('v', array('verbose'));
+
function displayStrings() {
global $result;
$args = func_get_args();
@@ -17,16 +19,16 @@ function displayStrings() {
$scope['echo'] = new Lisphp_Runtime_PHPFunction('displayStrings');
$program->execute($scope);
$expected = file_get_contents(preg_replace('/\.lisphp$/', '.out', $file));
- if ($result == $expected) {
+ if (trim($result) == trim($expected)) {
echo '.';
} else {
echo 'F';
- $fails[] = $file;
+ $fails[$file] = $result;
}
}
if ($fails) {
- echo "\nFailed ";
+ echo "\nFailed: ";
} else {
echo "\nOK ";
}
@@ -36,3 +38,15 @@ function displayStrings() {
}
echo ")\n";
+if ($fails) {
+ if (isset($options['verbose']) || isset($options['v'])) {
+ $br = str_repeat('-', 80);
+ foreach ($fails as $file => $actual) {
+ echo "$br\n$file\n$br\n$actual\n";
+ }
+ echo "$br\n";
+ } else {
+ $files = array_map('basename', array_keys($fails));
+ echo "Failed tests: ", join(', ', $files), "\n";
+ }
+}
View
28 tests/lexical-scope.lisphp
@@ -0,0 +1,28 @@
+"Lexical closure -- define, setf!, let, lambda test."
+
+(define (adder n)
+ {lambda [x]
+ (setf! n (+ n x))
+ n})
+
+(define a (adder 3))
+
+(echo (a 1) "\n")
+(echo (a 2) "\n")
+
+
+(define z 1)
+
+{let [(z 123)]
+ (echo z "\n")
+ (setf! z 1234)
+ (echo z "\n")}
+
+(echo z "\n")
+
+
+{let [(y 12)]
+ (define y 123)
+ (echo y "\n")}
+
+(echo y "\n")
View
7 tests/lexical-scope.out
@@ -0,0 +1,7 @@
+4
+6
+123
+1234
+1
+12
+123

0 comments on commit adfa7bf

Please sign in to comment.
Something went wrong with that request. Please try again.