Shortly I have a function foo:
(defun foo (a b &key test)
(format t "~S is the result of my test ~A" (funcall test a b) test))
then the result of the evaluation is:
(foo 12 34 :test #'(lambda (a b) (+ a b)))
46 is the result of my test #<Anonymous Function #x30200171D91F>
and I want
(foo 12 34 :test #'(lambda (a b) (+ a b)))
46 is the result of my test #'(lambda (a b) (+ a b))
Unfortunately, function-lambda-expression does not display any information in CCL.
The point is this is implementation-dependent.
For instance in CCL:
(describe #'(lambda (a b) (+ a b)))
#<Anonymous Function #x302000C49E1F>
Name: NIL
Arglist (analysis): (A B)
Bits: -528481792
Plist: (CCL::FUNCTION-SYMBOL-MAP (#(B A) . #(575 18 49 63 18 49)))
Maybe, I can formulate the question differently. How to save a lambda function as a slot instance in a file in order to retrieve it from any lisp implementation.
Or to be more specific, I would like to set a slot as a non-interpreted function in order to call it to be interpreted as such and have a trace of the 'source'.
My temporary 'solution' is to use explicitly a macro function such as:
(defmacro src (func) `(read-from-string (format nil "~A" ',func)))
(setf (my-slot my-class-object) (src #'(lambda (a b) (* a b))))
;; this stores the un-interpreted function such as
(my-slot my-class-object)
;; return
#'(lambda (a b) (* a b))
;; then I can do
(funcall (my-slot my-class-object) 2 3)
6
The ability to restore the source from a function depends on the implementation and the debug level of your environment. In Common Lisp implementations that compiles code, you need to optimize for debugging to keep track of the source code. Sometimes the source is simply the filename where the function was defined, and an offset.
Named functions
If you want to keep track of functions, it is easier to do portably if you restrict yourself to named functions. Just attach the source code to the property list of the symbol, using a macro:
;; body should be a single form that returns a name, like "defun"
(defmacro with-source-code (&body body)
(destructuring-bind (form) body
(let ((name$ (gensym)))
`(let ((,name$ ,form))
(check-type ,name$ symbol)
(setf (get ,name$ 'source-code) ',form)
,name$))))
;; get the code associated with the name
(defun source-code (name)
(check-type name symbol)
(get name 'source-code))
For example:
(with-source-code
(defun my-test-fn (x y)
(+ x y)))
(source-code 'my-test-fn)
=> (DEFUN MY-TEST-FN (X Y) (+ X Y))
Weak hash tables
Weak references are also implementation dependent, but you can use the trivial-garbage system to use them portably, or be notified when the feature is unavailable.
Here you attach the actual function object to its source code (or, any object, but this is not great for numbers or characters since they are usually not identifiable):
;; defines package "tg"
(ql:quickload :trivial-garbage)
(defparameter *source-map*
(tg:make-weak-hash-table :test #'eq :weakness :key)
"Map objects to their defining forms.")
The weakness is :key so that the garbage collector may remove the entry if the key (the object whose code we want to retrieve) is garbage collected. This should be enough to avoid keeping entries indefinitely.
(defmacro remember (form)
(let ((value$ (gensym)))
`(let ((,value$ ,form))
(setf (gethash ,value$ *source-map*) ',form)
,value$)))
(defun source (object)
(gethash object *source-map*))
For example, you can define a lambda* macro that remembers the anonymous function being defined:
(defmacro lambda* ((&rest args) &body body)
`(remember (lambda ,args ,#body)))
For example:
(let ((fn (lambda* (x y) (+ x y))))
(prog1 (funcall fn 3 4)
(format t "~&Calling ~a" (source fn))))
The above returns 7 and prints Calling (LAMBDA (X Y) (+ X Y))
Metaclass
If you want to avoid weak hash tables, you can also wrap your function in another object, which can act like a function (a funcallable object), using the meta-object protocol.
In that case, you can use closer-mop to have a unified API to work with the Meta-Object Protocol:
(ql:quickload :closer-mop)
You define a subclass of funcallable-standard-object that keep track of the source code, and the function (or closure) being called:
(defclass fn-with-code (c2mop:funcallable-standard-object)
((source :reader source-of :initarg :source))
(:metaclass c2mop:funcallable-standard-class))
The object can be called like any other function, but for that you need to call set-funcallable-instance-function. We can do that after initializing the object, by definining the following method:
(defmethod initialize-instance :after ((f fn-with-code)
&key function &allow-other-keys)
(c2mop:set-funcallable-instance-function f function))
I also define a help function to build such an instance, given a function object and its source code:
(defun make-fn-with-code (function source)
(make-instance 'fn-with-code :source source :function function))
Then, we can rewrite lambda* as follows:
(defmacro lambda* ((&rest args) &body body)
(let ((code `(lambda ,args ,#body)))
`(make-fn-with-code ,code ',code)))
Finally, what is useful with this approach is that the code can be printed automatically when the function is printed, by defining a method for print-object:
(defmethod print-object ((o fn-with-code) stream)
(print-unreadable-object (o stream :type nil :identity nil)
(format stream "FUN ~a" (source-of o))))
> (lambda* (x y) (* x y))
#<FUN (LAMBDA (X Y) (* X Y))> ;; << printed as follow
You are nearly there with a macro. If you merge "foo" and "format-function" into one macro:
(defmacro format-result (a b &key test)
`(format t "~S is the result of my test ~A"
(funcall ,test ,a ,b) ',test))
so:
(FORMAT-RESULT 1 2 :test (lambda (a b) (+ a b)))
3 is the result of my test (LAMBDA (A B) (+ A B))
(FORMAT-RESULT 1 2 :test #'+)
3 is the result of my test #'+
Related
I am trying to define a function func->symbol that takes a function and returns its name as a symbol. For example:
(define (pythagoras a b)
(sqrt (+ (* a a) (* b b))))
;; #1
(func->symbol pythagoras) ; Returns: 'pythagoras
;; #2
(func->symbol (if #t pythagoras sqrt)) ; Returns: 'pythagoras
;; #3
(let ((f (if #t pythagoras sqrt)))
(func->symbol f)) ; Returns: 'pythagoras
;; #4
(let ((f (if #t pythagoras sqrt)))
(let ((g f))
(func->symbol g))) ; Returns: 'pythagoras
This is a follow-up question on How do I get a definition's name as a symbol? which only deals with case #1. For case #1, a simple macro def->symbol is sufficient:
(define-syntax def->symbol
(syntax-rules ()
((_ def) 'def)))
However, this macro definition does not pass cases #2, #3, #4. Is it possible to define func->symbol, or is Scheme not expressive enough for this?
In Racket, in many cases, you can get a function's name using object-name. But it is probably a bad idea to rely on this result for anything other than debugging.
Perhaps it's worth an answer which shows why this is not possible in any language with first-class functions.
I'll define what I mean by a language having first-class functions (there are varying definitions).
Functions can be passed as arguments to other functions, and returned as values from them.
Functions can be stored in variables and other data structures.
There are anonymous functions, or function literals.
Scheme clearly has first-class functions in this sense. Now consider this code:
(define a #f)
(define b #f)
(let ((f (lambda (x)
(+ x 1))))
(set! a f)
(set! b f))
Let's imagine there is a function-name function, which, given a function, returns its name. What should (function-name a) return?
Well, the answer is that there's simply no useful value it can return (in Racket, (object-name a) returns f, but that's clearly exposing implementation details which might be useful for debugging but would be very misleading as a return value for a function-name procedure.
This is why such a procedure can't exist in general in a language with first-class functions: the function which maps from names to values is many-to-one and thus has no inverse.
Here is an example of the sort of disgusting hack you could do to make this 'work' and also why it's horrible. The following is Racket-specific code:
(define-syntax define/naming
;; Define something in such a way that, if it's a procedure,
;; it gets the right name. This is a horrid hack.
(syntax-rules ()
[(_ (p arg ...) form ...)
(define (p arg ...) form ...)]
[(_ name val)
(define name (let ([p val])
(if (procedure? p)
(procedure-rename p 'name)
p)))]))
And now, given
(define/naming a
(let ([c 0])
(thunk
(begin0
c
(set! c (+ c 1))))))
(define/naming b a)
Then:
> (object-name a)
'a
> (object-name b)
'b
> (eqv? a b)
#f
> (a)
0
> (b)
1
> (a)
2
So a and b have the 'right' names, but because of that they are necessarily not the same object, which I think is semantically wrong: if I see (define a b) then I want (eqv? a b) to be true, I think. But a and b do capture the same lexical state, so that works, at least.
In Practical Common Lisp Ch. 9, Peter Seibel provides a basic unit test bench for comparing expected with actual results of evaluating S-expressions. For example, defining a test as (deftest plus-test () (check (= (+ 1 2) 3))) and evaluating (plus-test) will print the result pass ... (PLUS-TEST): (= (+ 1 2) 3). However, a slightly more complex example like (deftest cdr-test () (check (equal (cdr '(a |a| "a" #\a)) '(|a| "a" #\a) produces the result pass ... (CDR-TEST): (equal (cdr '(A a a a)) '(a a a)) rather than pass ... (CDR-TEST): (equal (cdr '(a |a| "a" #\a)) '(|a| "a" #\a)). I have not been able to successfully modify his code to print the desired result, and would appreciate some assistance. Here is his code from Ch. 9:
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (make-symbol ,(string n))))
,#body))
(defvar *test-name* nil)
(defmacro deftest (name parameters &body body)
"Define a test function. Within a test function we can call other
test functions or use `check' to run individual test cases."
`(defun ,name ,parameters
(let ((*test-name* (append *test-name* (list ',name))))
,#body)))
(defmacro check (&body forms)
"Run each expression in `forms' as a test case."
`(combine-results
,#(loop for f in forms collect `(report-result ,f ',f))))
(defmacro combine-results (&body forms)
"Combine the results (as booleans) of evaluating `forms' in order."
(with-gensyms (result)
`(let ((,result t))
,#(loop for f in forms collect `(unless ,f (setf ,result nil)))
,result)))
(defun report-result (result form)
"Report the results of a single test case. Called by `check'."
(format t "~:[FAIL~;pass~] ... ~a: ~a~%" result *test-name* form)
result)
This is just a question about format control, since the function format does the output in the code you are using.
The corresponding Common Lisp Hyperspec documentation is in FORMAT Printer Operations.
* (format t "~a" ''(a #\a))
'(A a)
NIL
* (format t "~s" ''(a #\a))
'(A #\a)
NIL
In scheme you can define functions which return a lambda expression and use them to define new functions. For example, you can write this code
(define (pow-iter base exp r)
(if (= exp 1)
r
(pow-iter base (- exp 1) (* base r))))
(define (pow exp)
(lambda (base)
(pow-iter base exp base)))
(define cubic (pow 3))
(cubic 2)
We have here a function pow which takes the exponent as argument and evaluates to a lambda function which evaluates to the nth power of the given base.
However, if we put that within a scope like this:
(define (do-cubic x)
(define (pow-iter base exp r)
(if (= exp 1)
r
(pow-iter base (- exp 1) (* base r))))
(define (pow exp)
(lambda (base)
(pow-iter base exp base)))
(define cubic (pow 3))
(cubic x))
(do-cubic 2)
I get an error
pow: undefined; cannot use before initialization
Why does this error occur and is there any way to fix it without changing the logic of the program?
This program provokes the same error:
#lang r5rs
(let ()
(define (foo x) (lambda (y) (+ 42 x)))
(define bar (foo 1))
(bar 2))
Output:
foo: undefined;
cannot use before initialization
The reason you get an error is that "internal definitions" are rewritten into a letrec expression all the bindings are in effect while their initial values are being computed, thus allowing mutually recursive definitions.
(letrec ((foo (lambda (x) (lambda (y) (+ 42 x))))
(bar (foo 1)))
(bar 2))
In R5RS the initialization expressions are evaluated in an unspecified order. This means that in the first snippet above it is possible for (define bar (foo 1)) to be evaluated before (define (foo x) ...). In other words the value of foo is needed before foo have been initialized.
In Racket (#lang racket) internal definitions use letrec*-semantics (i.e. the initialization expressions are evaluated in the order they appear in the code. Thus the program runs without errors.
Note also that the letrec in #lang racket corresponds to what letrec* does in "R5RS"-implementations.
For more information on letrec vs letrec* see the introduction of http://www.cs.indiana.edu/~dyb/pubs/letrec-reloaded.pdf
In an attempt to emulate simple OOP in scheme (just for fun), I have caught myself repeating the following pattern over and over:
(define my-class ; constructor
(let ((let-for-name-encapsulation 'anything))
; object created from data is message passing interface
(define (this data)
(lambda (m)
(cond ((eq? m 'method1) (method1 data))
((eq? m 'method2) (method2 data))
(else (error "my-class: unknown operation error" m)))))
;
(define (method1 data)
(lambda (arg1 ...)
... )) ; code using internal 'data' of object
;
(define (method2 data)
(lambda (arg2 ...)
... ))
;
; returning three arguments constructor (say)
;
(lambda (x y z) (this (list 'data x y z)))))
I decided to wrap everything inside a let ((let-for-name-encapsulation ... so as to avoid leaking names within the global environment while still
being able to use the define construct for each internal function name, which enhances readability. I prefer this solution to the unsightly construct (let ((method1 (lambda (... but I am still not very happy because of the somewhat artificial let-for-name-encapsulation. Can anyone suggests something simple which would make the code look even nicer?. Do I need to learn macros to go beyond this?
I use that pattern often, but you don't actually need to define any variables:
(define binding
(let ()
(define local-binding1 expression)
...
procedure-expression)))
I've seen it in reference implementations of SRFIs so it's a common pattern. Basically it's a way to make letrec without the extra identation and lambdas. It can easily be made a macro to make it even flatter:
(define-syntax define/lexical
(syntax-rules ()
((_ binding body ...)
(define binding
(let ()
body ...)))))
;; test
(define/lexical my-class
(define (this data)
(lambda (m)
(cond ((eq? m 'method1) (method1 data))
((eq? m 'method2) (method2 data))
(else (error "my-class: unknown operation error" m)))))
(define (method1 data)
(lambda (arg1 ...)
... )) ; code using internal 'data' of object
(define (method2 data)
(lambda (arg2 ...)
... ))
;; returning three arguments constructor (say)
(lambda (x y z) (this (list 'data x y z))))
;; it works for procedures that return procedures as well
(define/lexical (count start end step)
(define ...)
(lambda ...))
Of course you could use macros to simplify your object system as well.
Suppose I have something like this:
(define pair (cons 1 (lambda (x) (* x x))
If I want to return the front object of the pair I do this:
(car pair)
And it returns 1. However when the object is a procedure I don't get the exact description of it.
In other words:
(cdr pair)
returns #<procedure> and not (lambda (x) (*x x)).
How do I fix this?
Although there's no way to do this generally, you can rig up something to do it for procedures that you define.
Racket structs can define a prop:procedure that allows the struct to be applied (called) as a procedure. The same struct can hold a copy of your original syntax for the function definition. That's what the sourced struct is doing, below.
The write-sourced stuff is simply to make the output cleaner (show only the original sexpr, not the other struct fields).
The define-proc macro makes it simpler to initialize the struct -- you don't need to type the code twice and hope it matches. It does this for you.
#lang racket
(require (for-syntax racket/syntax))
;; Optional: Just for nicer output
(define (write-sourced x port mode)
(define f (case mode
[(#t) write]
[(#f) display]
[else pretty-print])) ;nicer than `print` for big sexprs
(f (sourced-sexpr x) port))
(struct sourced (proc sexpr)
#:property prop:procedure (struct-field-index proc)
;; Optional: Just to make cleaner output
#:methods gen:custom-write
[(define write-proc write-sourced)])
;; A macro to make it easier to use the `sourced` struct
(define-syntax (define-proc stx)
(syntax-case stx ()
[(_ (id arg ...) expr ...)
#'(define id (sourced (lambda (arg ...) expr ...)
'(lambda (arg ...) expr ...)))]))
;; Example
(define-proc (foo x)
(add1 x))
(foo 1) ; => 2
foo ; => '(lambda (x) (add1 x))
The procedure cons evaluates its arguments: 1 is self-evaluating to 1; (lambda ...) evaluates to an anonymous procedure. If you want to 'prevent' evaluation, you need to quote the argument, as such:
> (define pair (cons 1 '(lambda (x) (* x x))
> (cdr pair)
(lambda (x) (* x x))