I was trying to figure out the way to empty a list (seen as a stack) in Common Lisp.
I came up with this:
(defun emptystack ()
(dolist (var *stack*) (pop *stack*)))
But it generates a warning at compile time (VAR is defined but never used).
Then I thought that it would have been simpler just to do:
(setq *stack* nil)
But still, I was wondering if there was any way to do it manually like in the first function, but without any unused variable.
One can declare to ignore the unused variable:
(defun emptystack ()
(dolist (var *stack*)
(declare (ignore var))
(pop *stack*)))
With the DO macro:
(defun emptystack ()
(do () ; no bindings
((null *stack*)) ; end test, no further results
(pop *stack*))) ; body
In LOOP one can also ignore the variable by naming it nil:
(defun emptystack ()
(loop for nil in *stack* do (pop *stack*)))
You could use
(defun emptystack ()
(loop while *stack* do (pop *stack*)))
which indeed does not use a variable under the hood:
? (macroexpand-1 '(loop while *stack* do (pop *stack*)))
(BLOCK NIL (ANSI-LOOP::LOOP-BODY NIL ((UNLESS *STACK* (GO ANSI-LOOP::END-LOOP))) ((POP *STACK*)) ((UNLESS *STACK* (GO ANSI-LOOP::END-LOOP))) NIL))
Related
I'm writing a transformation from Scheme subset to CPS language. It is implemented in F#. On big input programs conversion fails by stack overflow.
I'm using some sort of algorithm described in the paper Compiling with Continuations.
I've tried to increase maximum stack size of the working thread up to 50 MB, then it works.
Maybe there some way to modify the algorithm, so that I won't need to tune stack size?
For example, the algorithm transforms
(foo (bar 1) (bar 2))
to
(let ((c1 (cont (r1)
(let ((c2 (cont (r2)
(foo halt r1 r2))))
(bar c2 2)))))
(bar c1 1))
where halt is a final continuation which finishes the program.
Maybe your actual problems has simple solutions to avoid heavy stack consumption, so please don't mind adding details. However, without more knowledge about your particular code, here is a general approach to reduce the stack consumption in a recursive programs, based on trampolines and continuations.
Walker
Here is a typical recursive function that is not trivially tail-recursive, written in Common Lisp because I don't know F#:
(defun walk (form transform join)
(typecase form
(cons (funcall join
(walk (car form) transform join)
(walk (cdr form) transform join)))
(t (funcall transform form))))
The code is however quite simple, hopefully, and walks a tree made of cons cells:
if the form is a cons-cell, recursively walk on the car (resp. cdr) and join the results
Otherwise, apply a transform on the value
For example:
(walk '(a (b c d) 3 2 (a 2 1) 0)
(lambda (u) (and (numberp u) u))
(lambda (a b) (if a (cons a b) (or a b))))
=> (3 2 (2 1) 0)
The code walks the form, and retain only numbers, but preserves (non-empty) nesting.
Calling trace on walk with the above example shows a maximal depth of 8 nested calls.
Continuations and trampoline
Here is an adapted version, called
walk/then, that walks a form as previously, and when a result is
available, calls then on it. Here then is a continuation.
The function also returns a thunk, i.e. a parameterless closure.
What happens is that when we return the closure, the stack is unwound,
and when we apply the thunk it will
start from a fresh stack, but having advanced in the computation
(I usually picture someone walking up an escalator that goes down).
The fact that we return a thunk to reduce the number of stack frames is part of the trampoline.
The then function takes a value, namely
the result that the current walk eventually will return.
The result is thus passed down the stack, and what is
returned at each step is a thunk function.
Nesting continuations allows to capture the complex behaviour of transform/join, by pushing the remaining parts of the computation in nested continuations.
(defun walk/then (form transform join then)
(typecase form
(cons (lambda ()
(walk/then (car form) transform join
(lambda (v)
(walk/then (cdr form) transform join
(lambda (w)
(funcall then (funcall join v w))))))))
(t (funcall then (funcall transform form)))))
For example, (walk/then (car form) transform join (lambda (v) ...)) reads as follows: walk the car of form with
arguments transform and join, and eventually call (lambda (v) ...) on the result; namely, walk down the cdr, and then join both results; eventually, call the input then on the joined result.
What is missing is a way to continually call the returned thunk until exhaustion; here is it
with a loop, but this could easily be a tail-recursive function:
(loop for res =
(walk/then '(a (b c d) 3 2 (a 2 1) 0)
(lambda (u) (and (numberp u) u))
(lambda (a b) (if a (cons a b) (or a b)))
#'identity)
then (typecase res (function (funcall res)) (t res))
while (functionp res)
finally (return res))
The above returns (3 2 (2 1) 0), and the depth of the trace never goes over 2 when tracing walk/then.
See Eli Bendersky's article for another take at this, in Python.
I've converted algorithm to trampoline form. It looks like FSM.
There is a loop, which looks at the current state, makes some manipulations, and goes to another state. Also it uses two stacks for different kind of continuations.
Here is input language (it is a subset of the language I used originally) :
// Input language consists of only variables and function applications
type Expr =
| Var of string
| App of Expr * Expr list
Here is target language:
// CPS form - each function gets a continuation,
// added continuation definitions and continuation applications
type Norm =
| LetCont of name : string * args : string list * body : Norm * inner : Norm
| FuncCall of func : string * cont : string * args : string list
| ContCall of cont : string * args : string list
Here is original algorithm:
// Usual way to make CPS conversion.
let rec transform expr cont =
match expr with
| App(func, args) ->
transformMany (func :: args) (fun vars ->
let func' = List.head vars
let args' = List.tail vars
let c = fresh()
let r = fresh()
LetCont(c, [r], cont r, FuncCall(func', c, args')))
| Var(v) -> cont v
and transformMany exprs cont =
match exprs with
| e :: rest ->
transform e (fun e' ->
transformMany rest (fun rest' ->
cont (e' :: rest')))
| _ -> cont []
let transformTop expr =
transform expr (fun var -> ContCall("halt", [var]))
Here is modified version:
type Action =
| ContinuationVar of Expr * (string -> Action)
| ContinuationExpr of string * (Norm -> Action)
| TransformMany of string list * Expr list * (string list -> Action)
| Result of Norm
| Variable of string
// Make one action at time and return to top loop
let rec transform2 expr =
match expr with
| App(func, args) ->
TransformMany([], func :: args, (fun vars ->
let func' = List.head vars
let args' = List.tail vars
let c = fresh()
let r = fresh()
ContinuationExpr(r, fun expr ->
Result(LetCont(c, [r], expr, FuncCall(func', c, args'))))))
| Var(v) -> Variable(v)
// We have two stacks here:
// contsVar for continuations accepting variables
// contsExpr for continuations accepting expressions
let transformTop2 expr =
let rec loop contsVar contsExpr action =
match action with
| ContinuationVar(expr, cont) ->
loop (cont :: contsVar) contsExpr (transform2 expr)
| ContinuationExpr(var, contExpr) ->
let contVar = List.head contsVar
let contsVar' = List.tail contsVar
loop contsVar' (contExpr :: contsExpr) (contVar var)
| TransformMany(vars, e :: exprs, cont) ->
loop contsVar contsExpr (ContinuationVar(e, fun var ->
TransformMany(var :: vars, exprs, cont)))
| TransformMany(vars, [], cont) ->
loop contsVar contsExpr (cont (List.rev vars))
| Result(r) ->
match contsExpr with
| cont :: rest -> loop contsVar rest (cont r)
| _ -> r
| Variable(v) ->
match contsVar with
| cont :: rest -> loop rest contsExpr (cont v)
| _ -> failwith "must not be empty"
let initial = ContinuationVar(expr, fun var -> Result(ContCall("halt", [var])))
loop [] [] initial
I was trying out some erlang code and I am not sure why we have to wrap code in parentheses in some place to work whereas in some other place it work without parentheses as well. Is it due to operator precedence (very unlikely), or due to being statement instead of expression? Erlang newbie here. Please see the examples below.
%% Example from the Programming Erlang book.
-module(lib_misc).
-export([for/3]).
for(Max, Max, F) -> [F(Max)];
for(I, Max, F) -> [F(I)|for(I+1, Max, F)].
I use the above function to generate a list of functions
lib_misc:for(1, 10, fun (X) -> (fun () -> 2*X end) end).
giving something like
[#Fun<erl_eval.20.82930912>,#Fun<erl_eval.20.82930912>,
#Fun<erl_eval.20.82930912>,#Fun<erl_eval.20.82930912>,
#Fun<erl_eval.20.82930912>,#Fun<erl_eval.20.82930912>,
#Fun<erl_eval.20.82930912>,#Fun<erl_eval.20.82930912>,
#Fun<erl_eval.20.82930912>,#Fun<erl_eval.20.82930912>]
Next I tried will calling the function immediately to get the computed result, with three different variation producing the same result and assign it to a variable L.
L = lib_misc:for(1, 10, fun (X) -> (fun () -> 2*X end) end).
lib_misc:for(1, 10, fun (X) -> (fun () -> 2*X end ()) end). %% [2,4,6,8,10,12,14,16,18,20]
lib_misc:for(1, 10, fun (X) -> (fun () -> 2*X end)() end). %% [2,4,6,8,10,12,14,16,18,20]
lib_misc:for(1, 10, fun (X) -> fun () -> 2*X end() end). %% [2,4,6,8,10,12,14,16,18,20]
The problem is when I call
lists:nth(3, L)().
which gives the error * 1: syntax error before: '('. Why is this not giving 6? lists:nth() is a function which in this case returns another function. So what is causing this problem?
Wrapping the statement in parenthesis gives the expected result, but why so?
(lists:nth(3, L))(). %% 6
Similarly, assigning the return value to a variable and calling it works, but that's obvious.
-module(test).
-export([l/0, t/0]).
l() -> lib_misc:for(1, 10, fun (X) -> (fun () -> 2*X end) end).
%% t() -> lists:nth(3, l())(). %% test.erl:5: syntax error before: '('
t() -> lists:nth(3, l()). %% works.
If the problem is with statement expression thing, in this code fun (X) -> fun () -> 2*X end() end is the inner anonymous function a statement or an expression?
Thanks.
It's simply an effect of the precedence rules in the Erlang grammar. (And there are no statements in Erlang, only expressions.)
I'm trying to parse org-mode text in this way:
* head
** sub-head
- word :: description
** sub-head
- word :: description
- some notes
* head2
** sub-head2
- some more notes
I am trying to capture the data (such as "word :: description" and "some notes") in such a way that each piece of data preserves what its parent headers are and what the parent's parents are, etc. I envision the data coming out in such a form in elisp:
(
("head"
("sub-head" ("word :: definition"))
("sub-head" ("word :: description" "some notes"))
)
("head2"
("sub-head2" ("some more notes"))
)
)
I am guessing there is an elegant solution using recursion. I'm open to structuring the data in elisp a different way, if there's a better way to do it.
The function org-element-parse-buffer should help. It parses the whole org-mode buffer into a lisp list. You will get more properties than you need.
http://orgmode.org/worg/exporters/org-element-docstrings.html#sec-10
Here's a recursive solution:
(defun org-splitter (str lvl)
(let* ((lst (split-string
str
(concat lvl " ")))
(out (unless (= (length (car lst))
(length str))
(mapcar
(lambda (s)
(and
(string-match "\\([^\n]+\\)\n\\(.*\\)" s)
(list (match-string 1 s)
(org-splitter
(substring-no-properties
s (match-beginning 2))
(concat lvl "\\*")))))
(cdr lst)))))
(if (string= (car lst) "")
out
(cons (car lst) out))))
(defun org-recurse-all ()
(let ((str (buffer-substring-no-properties
(point-min) (point-max))))
(org-splitter str "^\\*")))
I am trying to write a simple parser which creates a sxml-expression from a string, e. g.
"This is a [Test]" ===> (item "This is a" (subitem "Test"))
Anybody who is wondering about the square brackets within the given example may have a look at the so called Leiden conventions.
This is the code I have written so far:
(define my-sequence '("this" "[" "is" "a" "]" "test"))
(define (left-square-bracket? item)
(or (equal? item "[")
(eq? item #\x005b)))
(define (right-square-bracket? item)
(or (equal? item "]")
(eq? item #\x005d)))
(define (parse-sequence sequence)
(cond ((null? sequence) '())
((left-square-bracket? (car sequence))
(let ((subsequence (get-subsequence (cdr sequence))))
(list subsequence)))
(else
(cons (car sequence)
(parse-sequence (cdr sequence))))))
(define (get-subsequence sequence)
(if (right-square-bracket? (car sequence))
'()
(cons (car sequence)
(get-subsequence (cdr sequence)))))
Evaluating (parse-sequence my-sequence) yields ("this" ("is" "a")). A nested expression has been created, but the program finished without having evaluated the last item "test". The question is, how do I return from get-subsequence to parse-sequence?
Any help is appreciated, many thanks in advance! :)
To address your initial questions, how to return multiple values: use the "values" form. Here is an example implementation where the inner procedure returns both the remaining list to be processed and the result so far. It recurses on opening brackets.
(define (parse-sequence lst)
(define (parse-seq lst)
(let loop ((lst lst) (res null))
(cond
((null? lst) (values null res))
((string=? (car lst) "[")
(let-values ([(lst2 res2) (parse-seq (cdr lst))])
(loop lst2 (append res (list res2)))))
((string=? (car lst) "]")
(values (cdr lst) res))
(else
(loop (cdr lst) (append res (list (car lst))))))))
(let-values ([(lst res) (parse-seq lst)])
res))
then
(parse-sequence '("this" "is" "a" "test"))
(parse-sequence '("this" "[" "is" "a" "]" "test"))
(parse-sequence '("this" "[" "is" "[" "a" "]" "]" "test"))
will yield
'("this" "is" "a" "test")
'("this" ("is" "a") "test")
'("this" ("is" ("a")) "test")
I made some progress by using open-input-string in combination with read-char:
(define my-sequence (open-input-string "this [is a] test"))
(define (parse-sequence sequence)
`(item
,#(let loop ((next-char (read-char sequence)))
(cond ((eof-object? next-char) '())
((left-square-bracket? next-char)
(let ((subsequence (get-subsequence sequence)))
(cons subsequence
(loop (read-char sequence)))))
(else
(cons next-char
(loop (read-char sequence))))))))
(define (get-subsequence sequence)
`(subitem
,#(let loop ((next-char (read-char sequence)))
(if (right-square-bracket? next-char)
'()
(cons next-char
(loop (read-char sequence)))))))
(parse-sequence my-sequence)
===> (item #\t #\h #\i #\s #\space (subitem #\i #\s #\space #\a) #\space #\t #\e #\s #\t)
Now work goes on, step by step. :)
Any comments and suggestions are still appreciated. :)
On page 76 we define a function item as parser -- a function that takes a String and returns [(Char, String)] or [] if failed.
On page 78 we define a function sat that takes a predicate p and "wraps" a parser construction around that
p :: (Char -> Bool) -> Parser Char
sat p = do x <- item
if p x then return x else failure
What I don't understand is the magic of <-? If the result of item is not empty then this operator should unwrap the list and fetch the first item from the tuple, otherwise it should produce something that won't choke the predicate. What am I missing?
do x <- item
if p x then return x else failure
This is syntactic sugar for
item >>= (\x -> if p x then return x else failure)
>>= is the monadic bind operator.
What you're missing is: what is the definition of >>= for the Parser type? (Where in the book is the Monad instance for Parser defined? It will start instance Monad Parser where.)
The do notation is desugared to applications of the monad operator (>>=). More precisely, the definition of sat is desugared to the following definition.
sat p :: (Char -> Bool) -> Parser Char
sat p =
item >>= \x -> if p x then return x else failure
The operator (>>=) first applies the item parser to the input. As you correctly observed this parser yields the first character. Then, (>>=) passes the result of the first parser to its second argument, that is, to the function \x -> if p x then return x else failure. This function checks whether the predicate is satisfied for the first character of the input stream. If it is satisfied, the function yields a parser (return x) that does not consume any input and simply yields x as result. If it does not satisfied the predicate, the function yields a parser that fails for any input (failure).