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
Related
This Common Lisp macro and test function
(defmacro test (body)
`(let ,(mapcar #'(lambda (s)
`(,s ,(char-code (char-downcase (char (symbol-name s) 0)))))
'(a b))
,body))
(test (+ a b))
expands into
(let ((a 97) (b 98))
(+ a b))
and gives 195 when evaluated
Trying to do that in Racket
(define-syntax (test stx)
(syntax-case stx ()
[(_ body)
#`(let #,(map (lambda (x)
(list x
(char->integer (car (string->list (symbol->string x))))))
'(a b))
body)]))
(test (+ a b))
When I run the macroexpander, the macro form expands to:
(let ((a 97) (b 98)) (+ a b))))
which is what I thought I wanted.
But it fails with:
a: unbound identifier in context..
Disabling macro hiding gives a form that ends with:
(#%app:35
call-with-values:35
(lambda:35 ()
(let-values:36 (((a:37) (quote 97)) ((b:37) (quote 98)))
(#%app:38 + (#%top . a) b)))
(print-values:35)))
I don't understand why my nice expansion (let ((a 97) (b 98)) (+ a b)) doesn't work, and I'm puzzled by (#%top .a)... I wonder if it's trying to find a function called "a"?
When I copy the expanded form into the REPL, it works...
I'm grateful for any help!
Racket has hygienic macro. Consider:
(define-syntax-rule (or a b)
(let ([a-val a])
(if a-val a-val b)))
Then:
(let ([a-val 1])
(or #f a-val))
will roughly expand to:
(let ([a-val 1])
(let ([a-val2 #f])
(if a-val2 a-val2 a-val)))
which evaluates to 1. If macro is not hygienic, then it would result in #f, which is considered incorrect.
Notice that a-val is renamed to a-val2 automatically to avoid the collision. That's what happens to your case too.
One way to fix the problem in your case is to give a correct context to the generated identifiers so that the macroexpander understands that they should refer to the same variable.
(define-syntax (test stx)
(syntax-case stx ()
[(_ body)
#`(let #,(map (lambda (x)
(list (datum->syntax stx x) ; <-- change here
(char->integer (car (string->list (symbol->string x))))))
'(a b))
body)]))
(test (+ a b))
As a counterpart Sorawee Porncharoenwase's answer (which is the right answer) I think it's worth while thinking a bit about why your test macro is problematic in CL and why macros which do similar things are outright buggy.
Given your test macro, imagine some user looking at this code:
(let ((a 1) (b 2))
(test (+ a b)))
Well, I don't know about you, but what I would expect to happen is that the a and b inside test are the a and b I've just bound. But that's not the case at all, of course.
Well, perhaps the documentation for test describes in great detail that it binds two variables, and that this is what I should expect. And, of course, there are macros which do just that, and where it's fine:
(defmacro awhen (test &body forms)
`(let ((it ,test))
(when ,it ,#forms)))
And now:
(awhen (find-exploder thing)
(explode it))
And this is all fine, because the documentation for awhen will say that it binds it to the result of the test in its body.
But now consider this or macro stolen from the other answer:
(defmacro vel (a b)
`(let ((a-val ,a))
(if a-val a-val ,b)))
This is a disaster. It 'works', except it doesn't work at all:
> (let ((a-val 3))
(vel nil a-val))
nil
Now that's not just surprising in the way your test macro is: it's wrong.
Instead, you have to write vel like this in CL:
(defmacro vel (a b)
(let ((a-val-name (make-symbol "A-VAL")))
`(let ((,a-val-name ,a))
(if ,a-val-name ,a-val-name ,b))))
(You can of course use gensym instead of make-symbol, and most people do I think.)
And now
> (let ((a-val 3))
(vel nil a-val))
3
as you would expect.
This is all because the CL macro system is unhygenic – it relies on you to ensure that things like names do not clash. In CL you have to go slightly out of your way to write macros which are correct in many cases. The Racket macro system, on the other hand, is hygenic: it will by default ensure that names (and other things) don't clash. In Racket (and Scheme) you have to go out of your way to write macros which are either incorrect or do something slightly unexpected like introducing bindings visible from code which makes use of the macros.
Note that I'm not expressing a preference for either approach to macros: I've spent most of my life writing CL, and I'm very happy with its macro system. More recently I've written more Racket and I'm happy with its macro system as well, although I find it harder to understand.
Finally here is a variant of your macro which is less surprising in use (almost all of the noise in this code is sanity checking which syntax-parse supports in the form of the two #:fail-when clauses):
(define-syntax (with-char-codes stx)
(syntax-parse stx
[(_ (v:id ...) form ...)
#:fail-when (check-duplicate-identifier (syntax->list #'(v ...)))
"duplicate name"
#:fail-when (for/or ([name (syntax->list #'(v ...))])
(and (> (string-length (symbol->string
(syntax->datum name)))
1)
name))
"name too long"
#'(let ([v (char->integer (string-ref (symbol->string 'v) 0))] ...)
form ...)]))
And now
> (with-char-codes (a b)
(+ a b))
195
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 #'+
Is there anyway to check if a function return nothing in Scheme?
For example:
(define (f1)
(if #f #f)
)
or
(define (f2) (values) )
or
(define (f3) (define var 10))
How can I check if f return nothing?
Thanks in advance.
Yes. You can wrap the call in something that makes a list of the values. eg.
(define-syntax values->list
(syntax-rules ()
((_ expression)
(call-with-values (lambda () expression)
(lambda g (apply list g))))))
(apply + 5 4 (values->list (values))) ; ==> 9
(null? (values->list (values))) ; ==> #t
Your procedure f2 does return exactly one value and it's undefined in the report (Scheme standard). That means it can change from call to call and the result of (eq? (display "test1") (display "test2")) is unknown.
Implementations usually choose a singleton value to represent the undefined value, but you can not depend on it. Implementations are free to do anything. eg. I know that in at least one Scheme implementations this happens:
(define test 10)
(+ (display 5) (set! test 15))
; ==> 20 (side effects prints 5, and test bound to 15)
It would be crazy to actually use this, but it's probably useful in the REPL.
In GNU Guile the function for checking this is unspecified?:
(unspecified? (if #f #f)); returns #t
(unspecified? '()); returns #f
What is the smartest way to create a switch statement in Scheme?
I want to check one value up against several others, if one results true the entire function should result true, otherwise false. I am not very good with the syntax in scheme.
In Scheme you have case:
(case (car '(c d))
((a e i o u) 'vowel)
((w y) 'semivowel)
(else 'consonant)) ; ==> consonant
As you see it compares against literal data. Thus you cannot compare the value with other variables. Then you need cond
An alternative to an explicit comparison agains each value, is to use member:
> (define (vowel? x) (member x '(a e i o u))
> (vowel? 'b)
#f
Base Case
Often if you want to return a boolean value a simple boolean expression will be enough. In the simple case several checks within an or will be enough:
(define (switch val)
(or (equal? val 'some-value)
(equal? val 'some-other-value)
(equal? val 'yet-another-value)))
Higher Order Function
Is we're doing this often it's a lot of work, so we can make a function called make-switch that takes a list of values and returns a function that serves as a switch statement for those values:
(define (make-switch list-of-vals)
(define (custom-switch val)
(define (inner vals)
(cond ((null? vals) #f)
((equal? val (first vals)) #t)
(else
(inner (rest vals)))))
(inner list-of-vals))
Then we can use make-switch like this:
> (define k (make-switch '(1 2 a "b")))
> (k 1)
#t
> (k 5)
#f
> (k "a")
#f
> (k "b")
#t
Faster Lookups
If we're mostly checking against a static set of values, then a hash-table is another alternative. This code in #lang racket shows the general approach, an R5RS Scheme could use SRFI-69:
#lang racket
(define (make-switch alist)
(define (list->hash alist)
(make-hash (map (lambda (x) (cons x x))
alist)))
(lambda (val)
(if (hash-ref (list->hash alist) val #f)
#t
#f)))
Note
There may be cases where you want to use eq? or some other test for equality, but I've left make-custom-make-switch as an exercise for further exploration.
So I'm playing around with a simple doc-string system as a warmup in scheme, the idea being you could do something like:
(def-with-doc (foo a b)
(desc "Takes two parameters and sums them")
(param 'a "First parameter")
(param 'b "Second parameter")
(return "Sum of arguments")
(+ a b)
Which would be turned into:
(begin
(begin
(desc 'foo "Takes two parameters and sums them")
(param 'foo 'a "First parameter")
(param 'foo 'b "Second parameter")
(return 'foo "Sum of arguments"))
(begin
(define (foo a b)
(+ a b))))
The macro I've written:
(define doc-symbol-list '(param desc return))
(define-macro (def-with-doc arg-list #!rest body)
;; Loop over body, splitting into doc calls and everything else
(let loop ((remaining body) (docs '()) (main '()))
(if (null? remaining)
; Reverse accumulation order of docs and main
; And build re-ordered begin tree
(let ((docs (cons 'begin (reverse docs)))
(main (cons 'begin (reverse main))))
(cons 'begin `(,docs ,`(define ,arg-list ,main))))
; Accumulate into docs list if expression is reserved
; Otherwise into the body list
(let ((sexp (car remaining)) (rest (cdr remaining)))
(if (member (car sexp) doc-symbol-list)
(loop rest (cons sexp docs) main)
(loop rest docs (cons sexp main)))))))
Takes the definition, moves the param/desc/return calls into the top level wrapped in begin statements and reconstructs the body of the function, that way the doc string calls are only executed once when the file is loaded rather than each time the function is called. I know I could manually put the doc-string stuff at the top level but I'm trying to emulate Python doc-strings.
Anyhow, the last think that I need to do is bind the function name (foo in above) into the doc-string calls, so that (param 'a "First parameter") becomes (param 'foo 'a "First parameter") so that the function each call is associated with is known. This is where I'm having trouble, every attempt I've made has failed to do what I want.
I would suggest using define-syntax as it is hygienic and its syntax-rules are pretty easy to understand. syntax-rules are in a pattern-to-result format; if you can understand cond, you can understand syntax-rules.
I think this does what you want, judging by the before and after snippets.
(define-syntax def-with-doc
(syntax-rules ()
;; this pattern
[(_ (func params ...)
(tag attributes ...)
...
code)
;; is converted into
(begin
(tag (quote func) attributes ...)
...
(define (func params ...)
code))]))
Forgive my terminology because I've never used doc-strings.
Basically, this matches against anything that follows that pattern of a function + params def, 0 or more tags with attributes, and a code statement.
Then, it just rearranges everything.