Is it possible in Common Lisp to define a method with a "list type"?
(defgeneric show (obj))
(defmethod show ((obj coordinate)) ;; Works
...)
(defmethod show ((obj [LIST OF coordinate])) ;; How to?
...)
You can write a method on list type but not on arbitrary type specifiers. From hyperspec:
If parameter-specializer-name is a symbol it names a class;
if it is a list, it is of the form (eql eql-specializer-form).
Related question: Defmethod on Arbitrary Type Specifiers?
Something like this might work for you:
(defmethod show ((obj coordinate))
...)
(defmethod show ((obj null)))
(defmethod show ((obj cons)) ;; Or just loop it.
(show (car obj))
(show (cdr obj)))
Related
I'm working on SICP's metacircular-evaluator with Typed Racket and stuck when preparing primitive procedures beforehand with a list of cons of symbol and the procedure object. In the book the authors prepare primitive-procedures as below, however, when I mimic it in Typed Racket and define accessors on it, I simply can't extract procedures nor symbols because I need to explicitly instantiate car or cdr with a type which I cannot write down, that is, all the union of procedure types in the list.
So I thought that if I can declare a type representing all the callable procedures(without keyword args but with rest args), I can finally annotate the list below. I seriously googled and tried many ways myself but I have come up with no good idea. Can anyone think of a good way to define such a type? Or even better, can anyone come up with a better idea to prepare all the primitive procedures?
(define primitive-procedures
(list (cons 'car car)
(cons 'cdr cdr)
(cons 'list list)
...))
The problem is with trying to fit a heterogeneous set of function types into a homogeneous list type / homogeneous lookup-result type.
In the comments you noted that you cannot give the type primitive-procedures : (All (a b) (Listof (Pairof Symbol (-> a * b))) because the type declared differs from every procedure in the actual list. You probably tried adding All because you were trying to accommodate all the heterogeneous types in there. But the Listof type, and more importantly the lookup function you use to get primitives out of the list, have fundamentally homogeneous types. You'll have to make the type homogeneous and work around the types within the list.
If the values in your target language are the same as your host for a meta-circular interpreter, the simplest choice for this homogeneous function type is (-> Any * Any).
(: primitive-procedures : (Listof (Pairof Symbol (-> Any * Any))))
(: lookup-primitive : (-> (Listof (Pairof Symbol (-> Any * Any))) Symbol (-> Any * Any)))
Then the use of lookup-primitive should be fine using apply. However the most complicated part is the definition of primitive-procedures with this homogeneous type.
Just using
(define primitive-procedures
(list (cons 'car car)
(cons 'cdr cdr)
(cons 'list list)
...))
isn't enough and gives a type mismatch.
car cannot be used as (-> Any * Any). It can be used as (-> (Pairof Any Any) Any).
cdr cannot be used as (-> Any * Any). It can be used as (-> (Pairof Any Any) Any).
list can be used as (-> Any * Any). That's good.
So we must wrap car and cdr somehow, with functions that check the number of arguments and check that the argument is a pair, before passing the arguments to car and cdr.
(lambda [args : Any *]
(match args
[(list arg)
(unless (pair? arg) (error 'car "wrong argument type"))
(car arg)]
[_
(error 'car "wrong number of arguments")]))
Now this lambda expression can be used as (-> Any * Any), but it's clunky. It's even worse when you consider we would have to do this for every primitive that doesn't already fit:
(define primitive-procedures
(list (cons 'car (lambda [args : Any *]
(match args
[(list arg)
(unless (pair? arg) (error 'car "wrong argument type"))
(car arg)]
[_
(error 'car "wrong number of arguments")])))
(cons 'cdr (lambda [args : Any *]
(match args
[(list arg)
(unless (pair? arg) (error 'cdr "wrong argument type"))
(cdr arg)]
[_
(error 'cdr "wrong number of arguments")])))
(cons 'list list)
...))
This code is ugly and repeats itself a lot. I would define a macro called prim to do this pattern for me:
(require syntax/parse/define)
(define-simple-macro (prim (arg-pred ...) proc)
#:with (arg-id ...) (generate-temporaries #'(arg-pred ...))
(lambda [args : Any *]
(match args
[(list arg-id ...)
(unless (arg-pred arg-id) (error 'proc "wrong argument type")) ...
(proc arg-id ...)]
[_
(error 'proc "wrong number of arguments")])))
Then we can use it in primitive-procedures like
(define primitive-procedures
(list (cons 'car (prim (pair?) car))
(cons 'cdr (prim (pair?) cdr))
(cons 'list list)
...))
And now it is finally defined with the homogeneous type (Listof (Pairof Symbol (-> Any * Any))).
Currently, I have the following alist:
(define globals '((objects test)))
The name of its variable is stored in another alist:
(define test '((loc globals) (other properties)))
I would like to easily retrieve the objects list in globals. I first tried this code.
(assoc 'objects
(cadr (assoc 'loc
test)))
However, that spit out an error:
ERROR: In procedure assoc: Wrong type argument in position 2 (expecting association list): globals
I searched and found this question, so I tried using eval.
(assoc 'objects
(eval '(cadr (assoc 'loc
test))
(interaction-environment)))
However, that spit out the same error as above! Does anyone know how to call assoc with the right argument?
EDIT (2014-10-27 21:27 EST): Thank you for all of the solutions. Unfortunately, the submitted examples will likely not work on the full code:
(define-syntax object
(syntax-rules ()
((_ name prop prop* ...)
(begin
(define name '(prop prop* ...))
(let* ((parent (cadr (assoc 'loc name)))
(objref (cdr (assoc 'objects parent))))
(set! parent
(assoc-set! parent
'objects
(append objref '(name)))))))))
(object my-object
(loc globals)
(name "Harry")
(desc "My Object"))
Try this:
(define globals '((objects test)))
(define test (list (list 'loc globals) '(other properties)))
; alternatively: (define test (list `(loc ,globals) '(other properties)))
(assoc 'objects
(cadr (assoc 'loc test)))
=> '(objects test)
In this case, we don't want to create a list of symbols such as this:
'(loc globals)
What we want, is a list whose second element is another list called globals:
(list 'loc globals)
Alternatively (as pointed by Chris in the comments) we can use quasiquoting to make explicit that we do want an actual value in the list, not that we forgot to quote an item:
`(loc ,globals)
UPDATE
This is a different problem, you should mention the whole context from the beginning. The assoc-set! procedure is still missing from the question, but you can try this to see if it's what you need:
(define-syntax object
(syntax-rules ()
((_ name prop prop* ...)
(begin
(define name '(prop prop* ...))
(let* ((parent (eval (cadr (assoc 'loc name)))) ; use Guile's eval
(objref (cdr (assoc 'objects parent))))
(set! parent
(assoc-set! parent
'objects
(append objref '(name)))))))))
More specifically, can you overload the built-in Scheme procedure display?
More generally, how can you overload any procedure in Scheme?
Scheme doesn't have overloading based on types a`la Java/C++, it's dynamically typed so it wouldn't make sense.
You can do a few things though:
You can overload based on the structure of the arguments:
(define overload1
(case-lambda
((x y) (+ x y))
((x y z) (+ (- x y) z))))
This doesn't really help you though since display is only going to take one argument no matter what.
(define (overload-kinda x)
(cond
((list? x) (do-list x))
((symbol? x) (do-sym x))
;etc
))
Which is hacky but sometimes necessary.
My usual approach is higher order functions and the case lambda
(define my-display
(case-lambda
((x) (display x))
((x f) (display (f x)))))
Now if we need special treatment for displaying anything we pass in a function to render it.
The accepted answer don't overload the function, only define different function with same behavior.
Scheme usually allow to overwrite bultin function, so to overload the function (e.g. display) you can use something called Monkey Patch:
(define display (let ((orig display))
(lambda (x . rest)
(let ((port (if (null? rest)
(current-output-port)
(car rest))))
(if (number? x)
(orig (string-append "#<" (number->string x 16) ">") port)
(orig x port))))))
and now the display work differently with numbers. you can also use custom types like display different type of records in specific way. This is general example how to overwrite bultin function in any language that allow to modify the original binding. You save original function in variable, redefine the function and if you what to call original function you use the variable where you saved original.
The code can be abstracted away into general macro that will redefine the function and run your code on specific types of arguments, so it would be proper overloading like in Java and not only based on number of arguments like in case-lambda.
Here is example such macro (using lisp type macro):
(define-macro (overload name-spec . body)
(let ((name (car name-spec))
(args (cdr name-spec)))
`(define ,name (let ((,name ,name))
(lambda ,args
,#body)))))
(overload (display x . rest)
(let ((port (if (null? rest)
(current-output-port)
(car rest))))
(if (number? x)
(display (string-append "#<" (number->string x 16) ">") port)
(display x port))))
(display 10)
;; ==> #<a>
(display "20")
;; ==> 20
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.
I have this data structure (basically):
(setq ssm-list '(tasklist
((id . "10525295")
(name . "Inbox")
(sort_order . "0"))))
This works for getting the name:
(defun ssm-list-get-prop (list prop)
(cdr (assoc prop (car (cdr list)))))
(ssm-list-get-prop slack-one-list 'name)
What'd I like is to create a macro that will create a defun with the name ssm-list-name (or ssm-list-id) as there are actually a lot more properties in the list.
So I tried this:
(defmacro ssm-list-prop-defun (field)
`(defun ,(intern (concat "ssm-list-" field))
(one-list)
(cdr (assoc ,field (car (cdr one-list))))))
(ssm-list-prop-defun 'name)
(ssm-list-prop-defun 'id)
But the last two calls failed miserably with (wrong-type-argument characterp quote) I tried putting symbol-name in the macro but that didn't help.
Is there a way to accomplish this?
You're very close, minor edits gets you a working solution. The problem is that you're mixing symbols and strings. This will work:
(defmacro ssm-list-prop-defun (field)
;; note that concat operates on strings
`(defun ,(intern (concat "ssm-list-" field))
(one-list)
;; note that you need a symbol here, so quote the
;; result of the call to intern
;; and, if you're always using symbols,
;; might as well use assq
(cdr (assq ',(intern field) (car (cdr one-list))))))
;; pass in a string
(ssm-list-prop-defun "name")
And here's the variant that uses a symbol:
;; variant that works off a symbol
(defmacro ssm-list-prop-defun (field)
`(defun ,(intern (concat "ssm-list-" (symbol-name field)))
(one-list)
(cdr (assq ',field (car (cdr one-list))))))
(ssm-list-prop-defun name)
I think you want to read about defstruct in the cl package: (info "(cl) Structures") (or http://www.gnu.org/software/emacs/manual/html_node/cl/Structures.html#Structures)