I try to implement interface representing arithmetic expressions. The interface will be used by java-side but the whole logic is on clojure.
Having:
(defprotocol ExtendsExpression
(toTree [this]))
(extend-type String
ExtendsExpression
(toTree [this] (symbol this)))
(extend-type Number
ExtendsExpression
(toTree [this] this))
(definterface Expression
(toTree []))
(defrecord Expression1 [^String oper arg]
Expression
(toTree [this]
(list (symbol oper) (toTree arg))))
(defrecord Expression2 [^String oper arg1 arg2]
Expression
(toTree [this]
(list (symbol oper) (toTree arg1) (toTree arg2))))
(defrecord Expression3 [^String oper arg1 arg2 arg3]
Expression
(toTree [this]
(list (symbol oper) (toTree arg1) (toTree arg2) (toTree arg3))))
I try to use it as:
(toTree (Expression3. "+" "a" "b" (Expression2. "*" "c" "d")))
but I'm getting:
IllegalArgumentException No implementation of method: :toTree of protocol: #'user/ExtendsExpression found for class: user.Expression3 clojure.core/-cache-protocol-fn (core_deftype.clj:541)
Why clojure tries to call toTree of ExtendsExpression for Expression3? I expect that for Expression3 it will call the toTree method of Expression interface.
Ok, Got it ;)
(defprotocol ExtendsExpression
(to-tree [this]))
(extend-type String
ExtendsExpression
(to-tree [this] (symbol this)))
(extend-type Number
ExtendsExpression
(to-tree [this] this))
(definterface Expression
(toTree []))
(defrecord Expression1 [^String oper arg]
ExtendsExpression
(to-tree [this]
(list (symbol oper) (to-tree arg)))
Expression
(toTree [this] (to-tree this)))
(defrecord Expression2 [^String oper arg1 arg2]
ExtendsExpression
(to-tree [this]
(list (symbol oper) (to-tree arg1) (to-tree arg2)))
Expression
(toTree [this] (to-tree this)))
(defrecord Expression3 [^String oper arg1 arg2 arg3]
ExtendsExpression
(to-tree [this]
(list (symbol oper) (to-tree arg1) (to-tree arg2) (to-tree arg3)))
Expression
(toTree [this] (to-tree this)))
(to-tree (Expression3. "+" "a" "b" (Expression2. "*" "c" "d"))) ;=> (+ a b (* c d))
and the records implements Expression interface, so I can call them from java easily:
(.toTree (Expression3. "+" "a" "b" (Expression2. "*" "c" "d"))) ;=> (+ a b (* c d))
just to check what interfaces Expression3 implements:
(-> Expression3 clojure.reflect/reflect :bases pprint)
#{clojure.lang.IHashEq java.io.Serializable clojure.lang.IKeywordLookup
clojure.lang.IPersistentMap clojure.lang.IRecord java.lang.Object
user.ExtendsExpression clojure.lang.IObj clojure.lang.ILookup
user.Expression java.util.Map}
Related
I have implemented the language “ROL”, now I'm trying to extend the language to also support fun and call I'm trying to implement it in the substitution model.
here is my code for the eval function (Note that this code worked just fine without the fun and call. so the problem must be with these two implementations
(: eval : RegE -> RES)
;; evaluates RegE expressions by reducing them to bit-lists
(define (eval expr)
(cases expr
[(Reg right) (RegV right)]
[(Bool b) (RES_Bool b)]
[(Id name) (error 'eval "free identifier: ~s" name)]
[(And left right) (reg-arith-op bit-and (eval left ) (eval right) )]
[(Or left right) (reg-arith-op bit-or (eval left ) (eval right) )]
[(Shl E1) (RegV (shift-left (RegV->bit-list (eval E1))))]
[(Maj E1) (RES_Bool (majority? (RegV->bit-list (eval E1))))]
[(Geq E1 E2) (RES_Bool (geq-bitlists? (RegV->bit-list (eval E1)) (RegV->bit-list (eval E2))))]
[(With bound-id named-expr bound-body)
(eval (subst bound-body
bound-id
(Reg (RegV->bit-list(eval named-expr)))))]
[(Fun bound-id bound-body) expr]
[(Call fun-expr arg-expr)
(let ([fval (eval fun-expr)])
(cases fval
[(Fun bound-id bound-body)
(eval (subst bound-body
bound-id
(eval arg-expr)))]
[else (error 'eval "`call' expects a function, got: ~s"
fval)]))]
[(If E1 E2 E3) (if (RegV->boolean (eval E1)) (eval E2) (eval E3))]
))
and here is my sunst function:
(define (subst expr from to)
(cases expr
[(Reg g) expr]
[(Bool g) expr]
[(And left right)(And (subst left from to)(subst right from to))]
[(Or left right)(Or (subst left from to)(subst right from to))]
[(If bool ifBody elseBody) (If (subst bool from to) (subst ifBody from to) (subst elseBody from to))]
[(Maj left)(Maj (subst left from to))]
[(Geq left right)(Geq (subst left from to)(subst right from to))]
[(Shl left)(Shl (subst left from to))]
[(Id name) (if (eq? name from) to expr)]
[(With bound-id named-expr bound-body)
(if (eq? bound-id from)
expr
(With bound-id
named-expr
(subst bound-body from to)))]
[(Call left right) (Call (subst left from to) (subst right from to))]
[(Fun bound-id bound-body)
(if (eq? bound-id from)
expr
(Fun bound-id (subst bound-body from to)))]))
I'm getting the errors:
Type Checker: type mismatch
expected: RegE
given: RES in: fval
. Type Checker: type mismatch
expected: RegE
given: RES in: (eval arg-expr)
. Type Checker: type mismatch
expected: RES
given: Fun in: (cases expr ((Reg right) (RegV right)) ((Bool b) (RES_Bool b)) ((Id name) (error (quote eval) "free identifier: ~s" name)) ((And left right) (reg-arith-op bit-and (eval left) (eval right))) ((Or left right) (reg-arith-op bit-or (eval left) (eval right))) ((Shl E1) (RegV (shift-left (RegV->bit-list (eval E1))))) ((Maj E1) (RES_Bool (majority? (RegV->bit-list (eval E1))))) ((Geq E1 E2) (RES_Bool (geq-bitlists? (RegV->bit-list (eval E1)) (RegV->bit-list (eval E2))))) ((With bound-id named-expr bound-body) (eval (subst bound-body bound-id (Reg (RegV->bit-list (eval named-expr)))))) ((Fun bound-id bound-body) expr) ((Call fun-expr arg-expr) (let ((fval (eval fun-expr))) (cases fval ((Fun bound-id bound-body) (eval (subst bound-body bound-id (eval arg-expr)))) (else (error (quote eval) "`call' expects a function, got: ~s" fval))))) ((If E1 E2 E3) (if (RegV->boolean (eval E1)) (eval E2) (eval E3))))
. Type Checker: Summary: 3 errors encountered in:
fval
(eval arg-expr)
(cases expr ((Reg right) (RegV right)) ((Bool b) (RES_Bool b)) ((Id name) (error (quote eval) "free identifier: ~s" name)) ((And left right) (reg-arith-op bit-and (eval left) (eval right))) ((Or left right) (reg-arith-op bit-or (eval left) (eval right))) ((Shl E1) (RegV (shift-left (RegV->bit-list (eval E1))))) ((Maj E1) (RES_Bool (majority? (RegV->bit-list (eval E1))))) ((Geq E1 E2) (RES_Bool (geq-bitlists? (RegV->bit-list (eval E1)) (RegV->bit-list (eval E2))))) ((With bound-id named-expr bound-body) (eval (subst bound-body bound-id (Reg (RegV->bit-list (eval named-expr)))))) ((Fun bound-id bound-body) expr) ((Call fun-expr arg-expr) (let ((fval (eval fun-expr))) (cases fval ((Fun bound-id bound-body) (eval (subst bound-body bound-id (eval arg-expr)))) (else (error (quote eval) "`call' expects a function, got: ~s" fval))))) ((If E1 E2 E3) (if (RegV->boolean (eval E1)) (eval E2) (eval E3))))
>
My datatypes are:
(define-type RegE
[Reg Bit-List]
[Xor RegE RegE]
[And RegE RegE]
[Or RegE RegE]
[Shl RegE]
[Id Symbol]
[With Symbol RegE RegE]
[Bool Boolean]
[Geq RegE RegE]
[Maj RegE]
[If RegE RegE RegE]
[Fun Symbol RegE]
[Call RegE RegE])
and:
(define-type RES
[RES_Bool Boolean]
[RegV Bit-List])
I can see that for (let ([fval (eval fun-expr) doing the (eval fun-expr) will return RES, and I;m guessing this is probably the problem, is there any other way to wite it down? any help would be appreciated..
The key question is how you want to represent functions at runtime.
The definition of eval is:
(: eval : RegE -> RES)
;; evaluates RegE expressions by reducing them to bit-lists
(define (eval expr)
(cases expr
...
[(Fun bound-id bound-body) expr]
...
The result of evaluating (Fun bound-id bound-body) needs to be a RES.
Maybe extend RES as:
(define-type RES
[RES_Bool Boolean]
[RegV Bit-List]
[FunV Symbol RegE])
Then let eval return a (FunV bound-id bound-body).
In the evaluation of Call, you will then need to switch to
(cases fval
[(FunV bound-id bound-body)
since fval is a RES.
I wish to overload the + operator to work on common lisp vectors -- just as it would for vectors in linear algebra. Is it possible to overload with the + operator?
Here is my intended definition:
(defmethod + ((v1 vector) (v2 vector))
Thanks in advance for all the help!
If I were to do this, I would start by doing it in a separate package. I would then write a general function that uses binary operators:
(defun + (&rest addends)
(reduce #'binary+ (cdr addends) :initial-value (car addends)))
(defgeneric binary+ (addend1 addend2))
Then you can define methods on the generic function binary+ that would allow you to add two vectors, a vector and a scalar, ...
Something that would be a suitable wrapper-generating macro:
(defmacro define-operator (op &key (binary-signifier :binary) (package *package*)
"Defines a generic operator OP, being essentially a reduce operation using
a generic function whose name is a concatenation of BINARY-SIGNIFIER and OP."
(let ((op op)
(binary (intern (concatenate 'string
(string binary-signifier)
(string op))
package)))
`(progn
(defun ,op (&rest args)
(reduce (function ,binary) (cdr args) :initial-value (car args)))
(defgeneric ,binary (arg1 arg2)))))
Then you can define methods, as per Joshua Taylor's answer:
(defmethod binary+ ((x number) (y number))
(cl:+ x y))
(defmethod binary+ ((x vector) (y vector))
(map 'vector 'cl:+ x y))
(defmethod binary+ ((x list) (y list))
(map 'list 'cl:+ x y))
This is an extension of Vatine's answer, but with some more detail to make the implementaiton clearer:
(defpackage #:generic-arithmetic
(:use "COMMON-LISP")
(:shadow "+"))
(in-package #:generic-arithmetic)
(defun + (&rest addends)
(reduce 'binary+ (cdr addends) :initial-value (car addends)))
(defgeneric binary+ (addend1 addend2))
(defmethod binary+ ((x number) (y number))
(cl:+ x y))
(defmethod binary+ ((x vector) (y vector))
(map 'vector 'cl:+ x y))
(defmethod binary+ ((x list) (y list))
(map 'list 'cl:+ x y))
(+ 1 1)
;=> 2
(+ #(1 2) #(0 -1))
;=> #(1 1)
(+ '(1 3) '(3 1))
;=> (4 4)
It's probably not a good idea to define generic function +, because, well, this symbol is locked. CLOS is different from object systems in other languages, such as C++, so term `overload' is probably not quite correct.
Actually, you do not need a special function to sum vectors, use map:
CL-USER> (let ((v0 #(1 2 3))
(v1 #(4 5 6)))
(map 'vector #'+ v0 v1))
#(5 7 9)
It's possible to redefine + if you shadow it first:
? (shadow '+)
? (defgeneric + (a &rest b))
? (defmethod + ((a number) &rest b) (apply 'cl:+ a b))
? (+ 1 2)
3
? (+ 2 3 4)
9
? (defmethod + ((a string) &rest b) (apply #'cl:concatenate 'string a b))
? (+ "Hello" "World")
"HelloWorld"
? (+ "Hello" " cruel " "World")
"Hello cruel World"
? (defmethod + ((a vector) &rest b) (apply #'map 'vector 'cl:+ a b))
? (let ((v0 #(1 2 3)) (v1 #(4 5 6))) (+ v0 v1))
#(5 7 9)
I can't figure out how to do something like (instance? MyRecordType x) when MyRecordType was declared using defrecord. The type and class of the records are always clojure.lang.PersistentArrayMap.
For instance:
(defrecord MyRecord1 [data-field1 data-field2])
(defrecord MyRecord2 [data-field1])
(def x (->MyRecord1 1 2))
(def y (->MyRecord2 3))
(instance? MyRecord1 x)
=> false
(instance? MyRecord2 y)
=> false
(type x)
=> clojure.lang.IPersistentMap
(class y)
=> clojure.lang.IPersistentMap
(= (type x) (type y))
=> true
It should work that way. This is what your example looks like on Clojure 1.5.1
user=> (defrecord MyRecord1 [data-field1 data-field2])
user=> (defrecord MyRecord2 [data-field1])
user=> (def x (->MyRecord1 1 2))
user=> (def y (->MyRecord2 3))
user=> (instance? MyRecord1 x)
true
user=> (instance? MyRecord2 y)
true
user=> (type x)
user.MyRecord1
user=> (class y)
user.MyRecord2
user=> (= (type x) (type y))
false
This code works as I want, except for the warning message. In GNU Common Lisp, how do I suppress that message without suppressing other possible warning messages?
1 (defgeneric zang (x y)
2 (:documentation "they want you to put documentation here"))
3 (defmethod zang ((a number) (b string))
4 (format t "got to zang ((~s number) (~s string))~%" a b))
5 (defmethod zang ((a integer) (b string))
6 (format t "got to zang ((~s integer) (~s string))~%" a b)
7 (when (evenp a)
8 (format t "passing control to the other guy~%")
9 (call-next-method (1+ a) "hoo boy")
10 (format t "returned control from the other guy~%")))
11 (defmethod no-applicable-method (zang &rest args)
12 (format t "no applicable method for (zang ~{~s~^ ~})~%" args))
13 (zang 3.5 "hi")
14 (zang 3 "hi")
15 (zang 4 "hi")
16 (zang "hello" "world")
WARNING: Replacing method #<STANDARD-METHOD (#<BUILT-IN-CLASS T>)> in
#<STANDARD-GENERIC-FUNCTION NO-APPLICABLE-METHOD>
got to zang ((3.5 number) ("hi" string))
got to zang ((3 integer) ("hi" string))
got to zang ((4 integer) ("hi" string))
passing control to the other guy
got to zang ((5 number) ("hoo boy" string))
returned control from the other guy
no applicable method for (zang "hello" "world")
EDIT in response to Vatine's kind reply:
I tried that, and the situation escalated from a warning to a fatal error:
(defgeneric zang (x y)
(:documentation "they want you to put documentation here"))
(defmethod zang ((a number) (b string))
(format t "got to zang ((~s number) (~s string))~%" a b))
(defmethod zang ((a integer) (b string))
(format t "got to zang ((~s integer) (~s string))~%" a b)
(when (evenp a)
(format t "passing control to the next guy~%")
(call-next-method (1+ a) "hoo boy")
(format t "returned control from the next guy~%")))
;(defmethod no-applicable-method (zang &rest args)
; (format t "no applicable method for (zang ~{~s~^ ~})~%" args))
(defmethod no-applicable-method ((zang eql #'zang) &rest args)
(format t "no applicable method for (zang ~{~s~^ ~})~%" args))
(zang 3.5 "hi")
(zang 3 "hi")
(zang 4 "hi")
(zang "hello" "world")
*** - DEFMETHOD NO-APPLICABLE-METHOD: Invalid specialized parameter in method
lambda list ((ZANG EQL #'ZANG) &REST ARGS): (ZANG EQL #'ZANG)
You need to provide a correct argument list for NO-APPLICABLE-METHOD.
If you use a compiler (even the CLISP implementation can compile via COMPILE-FILE), you also should get an error message at compile time about the incorrect argument list.
The LispWorks compiler for example says:
**++++ Error between functions:
An argument is not an atom or list of two elements : (ZANG EQL (FUNCTION ZANG))
Fixed version:
(defgeneric zang (x y)
(:documentation "they want you to put documentation here"))
(defmethod zang ((a number) (b string))
(format t "got to zang ((~s number) (~s string))~%" a b))
(defmethod zang ((a integer) (b string))
(format t "got to zang ((~s integer) (~s string))~%" a b)
(when (evenp a)
(format t "passing control to the next guy~%")
(call-next-method (1+ a) "hoo boy")
(format t "returned control from the next guy~%")))
;(defmethod no-applicable-method (zang &rest args)
; (format t "no applicable method for (zang ~{~s~^ ~})~%" args))
(defmethod no-applicable-method ((zang (eql #'zang)) &rest args)
(format t "no applicable method for (zang ~{~s~^ ~})~%" args))
Example:
(defun test ()
(zang 3.5 "hi")
(zang 3 "hi")
(zang 4 "hi")
(zang "hello" "world"))
CL-USER 1 > (test)
got to zang ((3.5 number) ("hi" string))
got to zang ((3 integer) ("hi" string))
got to zang ((4 integer) ("hi" string))
passing control to the next guy
got to zang ((5 number) ("hoo boy" string))
returned control from the next guy
no applicable method for (zang "hello" "world")
NIL
I think you want to define a method on no-applicable-method as:
(defmethod no-applicable-method ((zang (eql #'zang)) &rest args)
...)
As-is, you're declaring a method that applies to all generic functions and that's why clisp is telling you that you're replacing an already-defined method.
The code below doesn't behave as I would expect.
; given a function name, its args and body, create 2 versions:
; i.e., (double-it foo []) should create 2 functions: foo and foo*
(defmacro double-it
[fname args & body]
`(defn ~fname ~args ~#body)
`(defn ~(symbol (str fname "*")) ~args ~#body))
The code above doesn't create two functions as I would expect. It only creates the last one.
user=> (double-it deez [a b] (str b a))
#'user/deez*
How can I get a single macro to define two functions?
; given a function name, its args and body, create 2 versions:
; ie (double-it foo [] ) should create 2 functions: foo and foo*
(defmacro double-it
[fname args & body]
`(do (defn ~fname ~args ~#body)
(defn ~(symbol (str fname "*")) ~args ~#body)))
(double-it afunc [str] (println str))
(afunc* "asd")
(afunc "asd")
No need to quote them separately.