Pau*_*des 2 common-lisp infix-notation package infix-operator
我defpackage在Lisp中弄湿了脚,开始了一个可耻的开始,即一个我无法理解的错误.
下面的代码是尝试创建子语言以对向量执行中缀操作.我想将它用于涉及一些线性代数的项目.
我的代码的"肉"是parse-infix.此函数查找具有最高优先级的运算符,调用apply-op替换所述运算符及其操作数,operator (operand, operand)从而收缩列表,并迭代直到列表仅包含结果.支持的运算符是四个规则,相等(将结果绑定到Lisp符号)和向量连接.
这是代码,疣和所有:
(defpackage :infix
(:use :common-lisp)
(:export operator-list
operators
parse-infix
infix))
(in-package :infix)
(defun parse-input (a)
"Turns symbols into numbers as necessary while reading an expression"
(if (symbolp a) (symbol-value a) a))
;; Definition of structure containing data for one operator
(defmacro mapf (op type)
""
`(lambda (a b)
(map ,type #'(lambda (x y)
(funcall ,op x y)) (parse-input a) (parse-input b))))
(defstruct (operator
(:conc-name op-)
(:constructor op (sym &key (func (mapf sym 'vector)) priority associativity n-operands)))
sym ; Operator symbol
func ; Function to be applied to operands
priority ; Other operators attributes
(associativity 'left-to-right) ; Evaluation order for operators
; that appear more than once in a row
(n-operands 2)) ; Number of operands (NOT IMPLEMENTED)
(defmacro operator-list (&body ops)
"Produces an operator list from a list of operator structs."
`(mapcar #'(lambda (y) (apply #'op
(mapcar #'(lambda (x) (if (listp x) (eval x) x)) y))) ',ops))
(defparameter operators
(operator-list
(+ :priority 4)
(- :priority 4)
(* :priority 3)
(/ :priority 3)
(^ :priority 2 :func expt :associativity right-to-left)
(& :priority 2 :func (lambda (x y) (concatenate 'vector x y)))
(= :priority 10 :func (lambda (x y) (set (intern (string x)) y))))
"Default set of operators, which perform arithmetic operations on
vectors lengthwise. If one vector is shorter than the other, the result
is truncated.")
(defun apply-op (b)
"Reads a segment of a list of the format operand/operator/operand (in 3 consecutive
cells) and leaves operator (operand, operand) in a single cell."
(setf (car b) (funcall (op-func (caadr b))
(car b)
(caddr b))
(cdr b) (cdddr b)))
(defun parse-infix (b &key (operator-list operators))
"Parses an infix expression by calling apply-op repeatedly until the entire
expression is processed."
(let ((expr (mapcar #'(lambda (x)
(case (type-of x)
(symbol (or (member x operator-list :key #'op-sym) x))
(cons (parse-infix x))
(otherwise x))) b)))
(loop while (cdr expr) do
(apply-op (reduce #'(lambda (x y &aux (op1 (caadr x)) (op2 (caadr y)))
(if (or (< (op-priority op2) (op-priority op1))
(and (= (op-priority op1) (op-priority op2))
(eq (op-associativity op1) 'right-to-left))) y x))
(remove-if #'listp (mapcon #'list expr) :key #'caddr)))
finally (return (car expr)))))
(defmacro infix (&rest b)
"Wrapper to create lists for parse-infix"
`(parse-infix ',b))
Run Code Online (Sandbox Code Playgroud)
这是障碍.功能似乎正在起作用......
? (infix (#(2 3) + #(4 5)) * #(2 2))
#(12 16)
? (infix (#(100) & (#(2 3) + #(4 5)) * #(2 2))) ; '& is concatenation
#(200 12)
? (infix A = #(5 5) + #(10 10))
#(15 15)
? A
#(15 15)
Run Code Online (Sandbox Code Playgroud)
...但是当我离开包时,连接(&)操作符突然'死':
? (in-package :cl-user)
#<Package "COMMON-LISP-USER">
? (infix:infix A = #(5 5) + #(10 10))
#(15 15)
? (infix:infix (#(2 3) + #(4 5)) * #(2 2))
#(12 16)
? (infix:infix (#(100) & (#(2 3) + #(4 5)) * #(2 2)))
> Error: The value & is not of the expected type LIST.
> While executing: (:INTERNAL INFIX:PARSE-INFIX), in process listener(1).
> Type :POP to abort, :R for a list of available restarts.
> Type :? for other options.
1 >
Run Code Online (Sandbox Code Playgroud)
我试图追踪包裹的功能,并注意到,无论出于何种原因,当我离开infix包裹时,'并且不再被认为是操作员.我没有最模糊的想法为什么会这样.任何输入都表示赞赏.
PS.正如许多人可能注意到的,所有这些都在Clozure Common Lisp中.
& 是包中的内部符号.
您需要导出它来解决问题.
同样适用于^:
(defpackage :infix
(:use :common-lisp)
(:export #:operator-list
#:operators
#:parse-infix
#:infix
#:&
#:^))
Run Code Online (Sandbox Code Playgroud)
当你输入
(infix:infix (#(100) & (#(2 3) + #(4 5)) * #(2 2)))
Run Code Online (Sandbox Code Playgroud)
而在cl-user包中,符号&,+和*被读取为cl-user::&,
cl:+
和cl:*.请注意,后两者从common-lisp包中导出
,因此也可以在infix包中使用:
(eq 'infix::+ 'cl-user::+)
==> T
(eq 'infix::+ 'cl-user::+)
==> T
Run Code Online (Sandbox Code Playgroud)
但是,第一个是不同的:
(eq 'infix::& 'cl-user::&)
==> NIL
Run Code Online (Sandbox Code Playgroud)
find-all-symbols 是你的朋友:
(find-all-symbols "+")
==> (+)
(find-all-symbols "*")
==> (*)
(find-all-symbols "&")
==> (INFIX::& CL-USER::&)
Run Code Online (Sandbox Code Playgroud)
请注意,我用uninterned的标号,:export在参数defpackage-所以他们没有拘留到CL-USER的read.