summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2019-10-03 20:06:49 -0700
committerKaz Kylheku <kaz@kylheku.com>2019-10-03 20:06:49 -0700
commita7f158174e41155a119f8762f2bb36def24cb828 (patch)
tree55fd301b41af600d8834b8ba9b58a861c16ede7a
parentb83615f69af7f971d440b0d02db85f24afe9e39c (diff)
downloadtxr-a7f158174e41155a119f8762f2bb36def24cb828.tar.gz
txr-a7f158174e41155a119f8762f2bb36def24cb828.tar.bz2
txr-a7f158174e41155a119f8762f2bb36def24cb828.zip
op: new features for anonymous recursion.
Within the op syntax, the new implicit variable @rec now refers to the function itself. There is also @(rec ...) for calling the function through a function binding. For instance, here is Fibonacci: (do if (> @1 1) (+ @(rec (pred @1)) @(rec (ppred @1))) 1) * share/txr/stdlib/op.tl (sys:op-ctx): New slots rec and recvar. (sys:op-rec-p, sys:op-ensure-rec): New functions. (sys:op-alpha-rename): Check for the new syntaxes and translate to appropriate gensymed expressions, while updating the context structure, so the expander is informed about the @rec or @(rec ...) activity in the expression. (sys:op-expand): Check whether @rec or @(rec ...) has been used in the expression, and generate the necessary variants to support it. We need to bind the lambda to a recursive binding using the same mechanism that labels uses, and possibly to bind the gensym underneat @rec to the value of that function binding. * txr.1: op documentation extended to cover the new feature, plus some wording improvements.
-rw-r--r--share/txr/stdlib/op.tl68
-rw-r--r--txr.160
2 files changed, 88 insertions, 40 deletions
diff --git a/share/txr/stdlib/op.tl b/share/txr/stdlib/op.tl
index 03828d22..e9b19b45 100644
--- a/share/txr/stdlib/op.tl
+++ b/share/txr/stdlib/op.tl
@@ -27,7 +27,7 @@
(defvar sys:*op-ctx*)
(sys:make-struct-type
- 'sys:op-ctx nil nil '(form gens up meta) nil
+ 'sys:op-ctx nil nil '(form gens up meta rec recvar) nil
(lambda (me)
(slotset me 'up sys:*op-ctx*)
(slotset me 'meta (gensym "meta-")))
@@ -54,19 +54,36 @@
((eq x 'sys:var) (or (integerp y)
(eq y 'rest))))))))
+(defun sys:op-rec-p (expr)
+ (tree-case expr
+ ((x (y . r)) (and (eq x 'sys:expr) (eq y 'usr:rec)))))
+
+(defun sys:op-ensure-rec (ctx : recvar)
+ (when recvar
+ (slotset ctx 'recvar t))
+ (or (slot ctx 'rec) (slotset ctx 'rec (gensym "rec-"))))
+
(defun sys:op-alpha-rename (f e op-args do-nested-metas)
(let* ((ctx sys:*op-ctx*)
(code ^(macrolet ((sys:expr (:form f arg)
(let ((ctx ,ctx))
- (if (and (slot ctx 'up) (sys:op-meta-p arg))
- ^(,(slot (slot ctx 'up) 'meta) (quote ,arg))
- f)))
+ (cond
+ ((and (slot ctx 'up)
+ (or (sys:op-meta-p arg)
+ (sys:op-rec-p arg)
+ (equal arg '(sys:var usr:rec))))
+ ^(,(slot (slot ctx 'up) 'meta) (quote ,arg)))
+ ((sys:op-rec-p f)
+ ^(,(sys:op-ensure-rec ctx) ,*(rest arg)))
+ (t f))))
(sys:var (:form f arg . mods)
(cond
- ((and (not mods) (sys:op-meta-p f))
+ ((sys:op-meta-p f)
(unless (integerp arg)
(sys:setq arg 0))
(sys:ensure-op-arg ,ctx arg))
+ ((equal f '(sys:var usr:rec))
+ (sys:op-ensure-rec ,ctx t))
(t f)))
,*(if do-nested-metas
^((,(slot ctx 'meta) ((quote arg)) arg))))
@@ -74,6 +91,8 @@
(expand code e)))
(defun sys:op-expand (f e args)
+ (unless args
+ ['compile-error f "arguments required"])
(let* ((ctx (make-struct 'sys:op-ctx ^(form ,f)))
(sys:*op-ctx* ctx)
(sym (car f))
@@ -81,21 +100,30 @@
(syntax-1 (sys:op-alpha-rename f e syntax-0 nil))
(syntax-2 (sys:op-alpha-rename f e syntax-1 t))
(metas (slot ctx 'gens))
- (rest-sym (sys:ensure-op-arg ctx 0)))
- (unless args
- ['compile-error f "arguments required"])
- ^(lambda (,*(cdr metas) . ,rest-sym)
- ,(let ((fargs (cdr (cdr syntax-2))))
- (cond
- ((and (eq sym 'lop) fargs)
- (let ((fargs-l1 (mapcar (lambda (farg)
- ^(sys:l1-val ,farg))
- fargs)))
- ^[sys:apply ,(car (cdr syntax-2))
- (append ,rest-sym (list ,*fargs-l1))]))
- ((or metas (eq sym 'do))
- syntax-2)
- (t (append syntax-2 rest-sym)))))))
+ (rec (slot ctx 'rec))
+ (recvar (slot ctx 'recvar))
+ (rest-sym (sys:ensure-op-arg ctx 0))
+ (lambda-interior (let ((fargs (cdr (cdr syntax-2))))
+ (cond
+ ((and (eq sym 'lop) fargs)
+ (let ((fargs-l1 (mapcar (lambda (farg)
+ ^(sys:l1-val ,farg))
+ fargs)))
+ ^[sys:apply ,(car (cdr syntax-2))
+ (append ,rest-sym (list ,*fargs-l1))]))
+ ((or metas (eq sym 'do))
+ syntax-2)
+ (t (append syntax-2 rest-sym))))))
+ (cond
+ (recvar ^(sys:lbind ((,rec (lambda (,*(cdr metas) . ,rest-sym)
+ (let ((,rec (fun ,rec)))
+ ,lambda-interior))))
+ (fun ,rec)))
+ (rec ^(sys:lbind ((,rec (lambda (,*(cdr metas) . ,rest-sym)
+ ,lambda-interior)))
+ (fun ,rec)))
+ (t ^(lambda (,*(cdr metas) . ,rest-sym)
+ ,lambda-interior)))))
(defmacro op (:form f :env e . args)
(sys:op-expand f e args))
diff --git a/txr.1 b/txr.1
index 6586d9fe..4c7148f3 100644
--- a/txr.1
+++ b/txr.1
@@ -45099,17 +45099,19 @@ an anonymous function which, if called with one argument, stores that argument
into
.codn x .
-The argument forms are arbitrary expressions, within which a special
-convention is permitted:
+The argument forms are arbitrary expressions, within which special
+conventions is permitted regarding the use of certain implicit variables:
.RS
.meIP >> @ num
A number preceded by a
.code @
-is a metanumber. This is a special syntax
-which denotes an argument. For instance
+is, syntactically, a metanumber. If it appears inside
+.code op
+as an expression, it behaves as a positional argument, whose
+existence it implies. For instance
.code @2
-means that the second argument of
-the anonymous function is to be substituted in place of the
+means that the function shall have at least two arguments,
+the second argument of which is be substituted in place of the
.codn @2 .
.code op
generates a function which has a number of required arguments equal to the
@@ -45127,14 +45129,29 @@ argument to
returning the result, and ignores its first two arguments).
There is no way to use
.code op
-to generate functions which have optional arguments.
+to generate functions which have optional arguments. The positional
+arguments are mutable; they may be assigned.
.meIP < @rest
If the meta-symbol
.meta @rest
appears in the
.code op
-syntax, it explicitly denotes the list of trailing arguments,
-allowing them to be placed anywhere in the expression.
+syntax as an expression, it explicitly denotes and evaluates to the list of
+trailing arguments. Like the metanumber positional arguments, it
+may be assigned.
+.meIP < @rec
+If the meta-symbol
+.meta @rec
+appears in the
+.code op
+syntax as an expression, it denotes a mutable variable which is bound to the
+function itself which is generated by that
+.code op
+expression.
+.meIP >> @( rec ...)
+If this syntax appears inside
+.codn op ,
+it specifies a recursive call the function.
.RE
.IP
@@ -45155,7 +45172,7 @@ syntax, then
is implicitly inserted. What this means is that, for example, since
the form
.code "(op foo)"
-does not contain any numeric positional arguments like
+does not contain any implicit positional arguments like
.codn @1 ,
and does not contain
.codn @rest ,
@@ -45231,10 +45248,11 @@ The
and
.code do
operators can be nested, in any combination. This raises the
-question: if a metanumber like
-.code @1
-or
+question: if an expression like
+.codn @1 ,
.code @rest
+or
+.code @rec
occurs in an
.code op
that is nested
@@ -45242,22 +45260,24 @@ within an
.codn op ,
what is the meaning?
-A metanumber always belongs with the inner-most op or do operator. So for
-instance
+An expression with a single
+.code @
+always belongs with the inner-most op or do
+operator. So for instance
.code "(op (op @1))"
means that an
.code "(op @1)"
expression is nested
-within an
+within an outer
.code op
-expression which itself contains no meta-syntax.
+expression that contains no references to its implicit variables.
The
.code @1
-belongs with the inner op.
+belongs to the inner op.
There is a way for an inner
.code op
-to refer to an outer op metanumber argument. This is
+to refer to the implicit variables of an outer one. This is
expressed by adding an extra
.code @
prefix for every level of escape. For example in
@@ -45296,7 +45316,7 @@ a parameter from the outermost
into the innermost
.codn op .
-Note that meta-numbers and meta-symbols belonging to an
+Note that the implicit variables belonging to an
.code op
can be used in the dot position of a function call, such as: