Merge branch 'development'

NEWS

@@ -1,24 +1,30 @@
+Changes of tre-0.8 relative to tre-0.7:
+  * WITHOUT-HEAD, WITHOUT-TAIL: New functions.
+  * PHP: AREF returns NIL for undefined indexes instead of breaking with an
+         error message.
+
 Changes of tre-0.7 relative to tre-0.6:
   * (%NEW): Accidentally converted to (%NEW NIL) – fixed.
   * PHP: Debugged property and associative array functions.
+  * JS: Methods are also available as functions whose identifier is
+        ($ class-name "-" method-name).
 
 Changes of tre-0.6 relative to tre-0.5:
   * PHP: PROPERTY-NAMES fixed for associative arrays.
   * PHP: ASSOC-ARRAY? test if first key is a string.
-  * Curly brackets {} denote MAKE-OBJECT if the first element
-    is a string or keyword.
-  * MAKE-OBJECT, NEW, {}: Also takes keywords whose symbol names
-    are converted to downcase as property names.
-  * JS/PHP: COPY-PROPERTIES, MERGE-PROPERTIES, UPDATE-PROPERTIES:
-            New functions.
+  * Curly brackets {} denote MAKE-OBJECT if the first element is a string or
+    keyword.
+  * MAKE-OBJECT, NEW, {}: Also takes keywords whose symbol names are converted
+    to downcase as property names.
+  * JS/PHP: COPY-PROPERTIES, MERGE-PROPERTIES, UPDATE-PROPERTIES: New
+    functions.
 
 Changes of tre-0.5 relative to tre-0.4:
-  * LOG-MESSAGE returns its argument if logging has been
-    switched off.
+  * LOG-MESSAGE returns its argument if logging has been switched off.
   * LML: Attribute names must be keywords.
   * PHP: NEW create a native object when used witout arguments.
-  * PHP: PROPERTY-NAME, PROPERTY-ALIST, ALIST-PROPERTIES,
-         MAKE-OBJECT: New core functions.
+  * PHP: PROPERTY-NAME, PROPERTY-ALIST, ALIST-PROPERTIES, MAKE-OBJECT: New
+         core functions.
   * PHP: ARRAY? returns T for indexed arrays only.
   * JS/PHP: ASSOC-ARRAY?: New predicate.
   * JS/PHP: JSON-ENCODE, JSON-DECODE added.
@@ -32,8 +38,7 @@ Changes of tre-0.4 relative to tre-0.3:
 RELEASES:
 
 Changes of tre-0.3 relative to tre-0.2:
-  * JS: PROPERTY-NAME, PROPERTY-ALIST, ALIST-PROPERTIES: New
-        core functions.
+  * JS: PROPERTY-NAME, PROPERTY-ALIST, ALIST-PROPERTIES: New core functions.
   * JS: PROPERTY-REMOVE: New core codegen macro.
   * JS: NEW returns an empty object when used without arguments.
 

environment/stage4/head-p.lisp → environment/stage4/head.lisp

@@ -1,2 +1,7 @@
 (fn head? (x head &key (test #'equal))
   (funcall test head (subseq x 0 (length head))))
+
+(fn without-head (x head)
+  (? (head? x head)
+     (subseq x (length head))
+     x))

environment/stage4/main.lisp

@@ -7,7 +7,8 @@
 (env-load "stage4/define-tree-filter.lisp")
 (env-load "stage4/destructive-arith.lisp")
 (env-load "stage4/intersect.lisp")
-(env-load "stage4/tail-p.lisp")
+(env-load "stage4/head.lisp")
+(env-load "stage4/tail.lisp")
 (env-load "stage4/repeat-while-changes.lisp")
 (env-load "stage4/expander.lisp")
 (env-load "stage4/macrolet.lisp")
@@ -26,7 +27,6 @@
 (env-load "stage4/sort.lisp")
 (env-load "stage4/split.lisp" :cl)
 (env-load "stage4/split.tests.lisp")
-(env-load "stage4/head-p.lisp")
 (env-load "stage4/trim.lisp")
 (env-load "stage4/trim.tests.lisp")
 (env-load "stage4/define-slot-setter.lisp")

environment/stage4/tail-p.lisp → environment/stage4/tail.lisp

@@ -3,3 +3,8 @@
          tlen  (length tail))
     (unless (< xlen tlen)
       (funcall test tail (subseq x (- xlen tlen))))))
+
+(fn without-tail (x tail)
+  (? (tail? x tail)
+     (subseq x 0 (- (length x) (length tail)))
+     x))

environment/transpiler/targets/javascript/class.lisp

@@ -26,7 +26,7 @@
   (apply #'generic-defmember class-name names))
 
 (fn js-emit-method (class-name x)
-  (!= ($ '~meth- class-name '- x.)
+  (!= ($ class-name '- x.)
     (. `((%%native ,x.) #',!)
 	   `(fn ,! ,.x.
 		  (%thisify ,class-name

environment/transpiler/targets/javascript/core/string.lisp

@@ -1,8 +1,7 @@
 (js-type-predicate %string? "string")
 
 (fn string? (x)
-  (| (%string? x)
-     (instanceof x (%%native "String"))))
+  (%string? x))
 
 (fn string-concat (&rest x)
   (alet (make-array)

environment/transpiler/targets/php/core.lisp

@@ -2,7 +2,8 @@
 
 (defvar *php-core-native*
         ,(apply #'+ (@ [fetch-file (+ "environment/transpiler/targets/php/core/native/" _ ".php")]
-                       '("settings"
+                       '("remove-magic-quotes"
+                         "settings"
                          "error"
                          "character"
                          "cons"

environment/transpiler/targets/php/core/array.lisp

@@ -25,7 +25,8 @@
 
 (fn aref (a k)
   (? (is_array a)
-     (%aref a k)
+     (& (%aref-defined? a k)
+        (%aref a k))
      (href a k)))
 
 (fn (= aref) (v a k)

environment/transpiler/targets/php/core/native/remove-magic-quotes.php

@@ -0,0 +1,16 @@
+# From somewhere in the official PHP documentation comments.
+if (get_magic_quotes_gpc ()) {
+    $vars = array (&$_GET, &$_POST, &$_COOKIE, &$_REQUEST);
+    while (list ($key, $val) = each ($vars)) {
+        foreach ($val as $k => $v) {
+            unset ($vars[$key][$k]);
+            $sk = stripslashes ($k);
+            if (is_array ($v)) {
+                $vars[$key][$sk] = $v;
+                $vars[] = &$vars[$key][$sk];
+            } else
+                $vars[$key][$sk] = stripslashes ($v);
+        }
+    }
+    unset ($vars);
+}

environment/transpiler/targets/php/toplevel.lisp

@@ -1,22 +1,5 @@
 (fn php-prologue ()
-  (with-string-stream out
-    (format out "<?php // tré revision ~A~%" *tre-revision*)
-    (format out (+ "if (get_magic_quotes_gpc ()) {~%"
-                   "    $vars = array (&$_GET, &$_POST, &$_COOKIE, &$_REQUEST);~%"
-                   "    while (list ($key, $val) = each ($vars)) {~%"
-                   "        foreach ($val as $k => $v) {~%"
-                   "            unset ($vars[$key][$k]);~%"
-                   "            $sk = stripslashes ($k);~%"
-                   "            if (is_array ($v)) {~%"
-                   "                $vars[$key][$sk] = $v;~%"
-                   "                $vars[] = &$vars[$key][$sk];~%"
-                   "            } else~%"
-                   "                $vars[$key][$sk] = stripslashes ($v);~%"
-                   "        }~%"
-                   "    }~%"
-                   "    unset ($vars);~%"
-                   "}~%"))
-    (php-print-native-core out)))
+  (format nil "<?php // tré revision ~A~%~A" *tre-revision* *php-core-native*))
 
 (fn php-epilogue ()
   (format nil "?>~%"))

environment/transpiler/targets/shared/macroexpand/class.lisp

@@ -1,6 +1,6 @@
 (defvar *delayed-constructors* nil)
 
-(fn generic-defclass (constructor-maker class-name args &body body)
+(fn generic-defclass (constructor-maker class-name args &body body) ; TODO: Check if base classes are defined.
   (with (cname   (? (cons? class-name)
                     class-name.
                     class-name)

make.sh

@@ -15,9 +15,11 @@ BINDIR="/usr/local/bin/"
 basic_clean ()
 {
 	echo "Cleaning..."
-	rm -vf *.core compiled environment/transpiler/targets/c/native/$COMPILED_ENV image files.lisp
+	rm -rv compiled
+	rm -vf *.core environment/transpiler/targets/c/native/$COMPILED_ENV image files.lisp
     rm -vf environment/_current-version
-	rm -vrf _nodejstests.log _phptests.log
+    rm -vf environment/_release-date
+	rm -vf _nodejstests.log _phptests.log
 	echo "Checking out last working core..."
     git checkout -- boot-common.lisp
 }