I've got this function:
(defn handler [request]
(case (request :uri)
"/" (home request)
"/good" (good request)
"/evil" (evil request)
"/neutral" (neutral request)
(status-response 404 (str "<h1>404 Not Found: " (:uri request) "</h1>" ))))
but I keep changing the list of pages-which-resolve-to-functions-with-the-same-name and I'd like to be able to write:
(def-handler good evil neutral)
instead:
But I am stuck. My best shot so far looks like:
(defmacro def-handler [& addresses]
`(defn handler [request#]
(case (request# :uri)
~#(mapcat (fn[x] [(str "/" x) (list x 'request)]) addresses)
"/" (home request#)
(status-response 404 (str "<h1>404 Not Found: " (:uri request#) "</h1>" )))))
But it does not quite work because the request in the generated calls is not the gensym, and I am at a loss how to get the gensym in there.
This looked promising until I noticed it made a new gensym:
(defmacro def-handler [& addresses]
`(defn handler [request#]
(case (request# :uri)
~#(mapcat (fn[x] [(str "/" x) `( ~x request#)]) addresses)
"/" (home request#)
(status-response 404 (str "<h1>404 Not Found: " (:uri request#) "</h1>" )))))
I think you can avoid gensym here at all. I don't see how you can "pollute" environment by not using gensym. Example without gensym:
(defmacro def-handler [& addresses]
`(defn handler [~'request]
(case (~'request :uri)
~#(mapcat (fn[x] [(str "/" x) (list x 'request)]) addresses)
"/" (home ~'request)
(status-response 404 (str "<h1>404 Not Found: " (:uri ~'request) "</h1>" )))))
The problem with your macro code is that the dynamic symbol which is part of quasiquoting can't be use outside quoted part i.e in the unquote/unquote-splicing code. However the other way is possible, that is you do gensym in the macro execution part and use that inside quasiquoting part as shown below:
(defmacro def-handler [& addresses]
(let [request (gensym)]
`(defn handler [~request]
(case (~request :uri)
~#(mapcat (ƒ [x] [(str "/" x) (list x request)]) addresses)
"/" (home ~request)
(status-response 404 (str "<h1>404 Not Found: " (:uri ~request) "</h1>"))))))
Related
I was writing the following pieces of code:
(require [hy.contrib.walk [let]])
(defn maybe? [command-text]
(let [splitted (.split command-text " ")]
(= (get splitted 0) "maybe")))
(defn if? [command-text]
(let [splitted (.split command-text " ")]
(+ (get splitted 0) "if")))
... until I realized I was doing something repetitive, so I wanted to factor out the pattern:
(import [hy [HySymbol]])
(defmacro command-dispatcher [command-type]
`(defn ~(HySymbol (+ command-type "?")) [command-text]
(let [splitted (.split command-text " ")]
(= (get splitted 0) ~command-type))))
However, if I evaluate (command-dispatcher "maybe") in HyREPL, I get a None.
=> (command-dispatcher "maybe")
def is_maybe(command_text):
_hyx_letXUffffX3 = {}
_hyx_letXUffffX3['splitted'] = command_text.split(' ')
return _hyx_letXUffffX3['splitted'][0] == 'maybe'
None
This is weird, because a macro should return a HyExpression, not None. What am I missing?
Your macro will not return anything but will define a function, as you can see here
(assert (not (in "is_maybe" (dir))))
(command-dispatcher "maybe")
(assert (in "is_maybe" (dir)))
An issue in your code is that you are using let, which is not available anymore according to documentation, here is a possible way to rewrite it using setv instead:
(defmacro command-dispatcher [command-type]
`(defn ~(HySymbol (+ command-type "?")) [command-text]
(setv splitted (.split command-text " "))
(= (get splitted 0) ~command-type)))
You can then call this function using is_maybe (or maybe?, that's syntactic sugar), eg.
(command-dispatcher "maybe")
(print (maybe? "foo"))
(print (maybe? "maybe foo"))
Will print
False
True
We have installed the latest Autodesk 2021 and one of our scripts (a modified #Lee Mac) which strips and formats some input text now fails. This script runs perfectly on 2019 and below. I can't seem to work out why there is a difference.
I have substituted the original "vl-catch-all-apply" to "apply" so I could catch the error. The error is:
Too few arguments
This occurs as it hits the '(lambda function call. The code is below with the call:
(defun GDD:removeinfo (rgx str)
(if
(null
(vl-catch-all-error-p
(setq str
(apply
'(lambda nil
(vlax-put-property rgx 'global actrue)
(vlax-put-property rgx 'multiline actrue)
(vlax-put-property rgx 'ignorecase acfalse)
(foreach pair
'(
("\032" . "\\\\\\\\")
("\n" . "\\\\P")
("$1" . "\\\\(\\\\[ACcFfHKkLlOopQTW])|\\\\[ACcFfHKkLlOopQTW][^\\\\;]*;|\\\\[ACcFfKkHLlOopQTW]")
("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")
("$1" . "[\\\\]({)|{")
("\\$1$2$3" . "(\\\\[ACcFfHKkLlOoPpQSTW])|({)|(})")
("\\\\" . "\032")
("" . "(?:.*\\n)*Const\\s+.*\\n")
("" . "\\w\\w\\d?\\s+\\d+\\s\\d+-\\d+-\\d+")
("" . "^\\s+\\n")
)
(vlax-put-property rgx 'pattern (cdr pair))
(setq str (vlax-invoke rgx 'replace str (car pair)))
)
)
)
)
)
)
str
)
)
The call to this function is below. I've checked the "input" and it is identical to the 2019 version that works and the str is populated properly using the vlisp (vscode) debugger. I've run the same code and input through both and only the 2021 version fails?
(setq input (GDD:removeinfo (vlax-get-or-create-object "VBScript.RegExp") input))
I'm not that familiar with LISP and I'm stuck. Thanks for your help.
Assuming <FUN> stands for:
'(lambda nil
(vlax-put-property rgx 'global actrue)
(vlax-put-property rgx 'multiline actrue)
(vlax-put-property rgx 'ignorecase acfalse)
(foreach pair
'(("\032" . "\\\\\\\\")
("\n" . "\\\\P")
("$1" . "\\\\(\\\\[ACcFfHKkLlOopQTW])|\\\\[ACcFfHKkLlOopQTW][^\\\\;]*;|\\\\[ACcFfKkHLlOopQTW]")
("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")
("$1" . "[\\\\]({)|{")
("\\$1$2$3" . "(\\\\[ACcFfHKkLlOoPpQSTW])|({)|(})")
("\\\\" . "\032")
("" . "(?:.*\\n)*Const\\s+.*\\n")
("" . "\\w\\w\\d?\\s+\\d+\\s\\d+-\\d+-\\d+")
("" . "^\\s+\\n"))
(vlax-put-property rgx 'pattern (cdr pair))
(setq str (vlax-invoke rgx 'replace str (car pair)))))
The code you posted, rewritten more compactly, looks as follows:
(defun GDD:removeinfo (rgx str)
(if (null (vl-catch-all-error-p
(setq str (apply <FUN>))))
str))
In particular, the call to APPLY has only one argument:
(apply <FUN>)
APPLY in Autolisp is a function of 2 parameters: a function, and a list of arguments.
The intent is that:
(apply f '(0 1))
... is evaluated as-if you called (f 0 1), but with possibility of building the list of arguments at runtime.
You only gave one argument to apply in your code, so you need to also pass a list of arguments.
In your case, that would be the empty list:
(apply <FUN> nil)
Instead of changing vl-catch-all-apply to apply in order to see the error, simply output the error as part of the else branch of the if statement, for example:
(if
(null
(vl-catch-all-error-p
(setq str
(vl-catch-all-apply
...
)
)
)
)
str
(prompt (strcat "\nError: " (vl-catch-all-error-message str))) ;; Output error and return nil
)
Aside, whilst this code is relatively trivial, I'm not sure whether I agree with you appropriating 95% of the code for my function and stripping off my heading and author prefix.
Whoever wrote that code seemed not to be aware of the progn operator.
So that is to say, if we want to evaluate multiple expressions e1, e2, ... for the sake of a side effect that they produce, we do not have to do this:
;; wrap expressions in a dummy lambda and apply empty arg list to it
(apply (lambda () e1 e2 ...) nil)
We can just write this:
(progn e1 e2 ...)
That still leaves us with a strange code smell which looks like this:
(setq str (progn .... (setq str value)))
The code is assigning the variable str twice with the same value. The deeply nested (setq str value) puts value into str and then yields that value as a result. It's the last expression of the progn (originall, of the lambda) and so that value is also returned. Then the outer setq wastefully stores it in str again. We just need one or the other:
;; set str as the side effect of the last form in the
;; progn; also yield that value.
(progn e1 e2 ...(setq str value))
;; assign value yielded from progn to str, then also
;; yield that value.
(setq str (progn e1 e2 ... value))
I have LISP written in JavaScript (https://jcubic.github.io/lips/ with online demo where you can try it) and I have macro like this:
(define-macro (globalize symbol)
(let ((obj (--> (. lips 'env) (get symbol))))
`(begin
,#(map (lambda (key)
(print (concat key " " (function? (. obj key))))
(if (function? (. obj key))
(let* ((fname (gensym))
(args (gensym))
(code `(define (,(string->symbol key) . ,args)
(apply (. ,obj ,key) ,args))))
(print code)
code)))
;; native Object.key function call on input object
(array->list (--> Object (keys obj)))))))
In this code I use this:
(let ((obj (--> (. lips 'env) (get symbol))))
and I call this macro using:
(globalize pfs)
to create function for each static method of pfs (which is LightingFS from isomorphic-git where each function return a promise, it's like fs from node).
But it will not work for something like this:
(let ((x pfs))
(globalize x))
because lips.env is global enviroment.
So my question is this how macro should work? Should they only process input data as symbols so they never have access to object before evaluation of lisp code?
How the LISP macro that generate bunch of functions based on variable should look like. For instance in scheme if I have alist in variable and want to generate function for each key that will return a value:
input:
(define input `((foo . 10) (bar . 20)))
output:
(begin
(define (foo) 10)
(define (bar) 20))
Can I write macro that will give such output if I use (macro input)? Or the only option is (macro ((foo . 10) (bar . 20)))?
I can accept generic Scheme or Common LISP answer but please don't post define-syntax and hygienic macros from scheme, My lisp don't have them and will never have.
The problem seems to be that I want to access value at macro expansion time and it need to have the value that in runtime. And second question Is eval in this case the only option?
This works in biwascheme:
(define-macro (macro obj)
(let ((obj (eval obj)))
`(begin
,#(map (lambda (pair)
(let ((name (car pair))
(value (cdr pair)))
`(define (,name) ,value)))
obj))))
(define input `((foo . 10) (bar . 20)))
(macro input)
(foo)
;; ==> 10
(bar)
;; ==> 20
(in my lisp eval don't work like in biwascheme but that's other issue).
but this don't work, because x is not global:
(let ((x '((g . 10)))) (macro x))
Is macro with eval something you would normally do, or should them be avoided? Is there other way to generate bunch of functions based on runtime object.
In Common Lisp: creating and compiling functions at runtime.
CL-USER 20 > (defparameter *input* '((foo . 10) (bar . 20)))
*INPUT*
CL-USER 21 > (defun make-my-functions (input)
(loop for (symbol . number) in input
do (compile symbol `(lambda () ,number))))
MAKE-MY-FUNCTIONS
CL-USER 22 > (make-my-functions *input*)
NIL
CL-USER 23 > (foo)
10
CL-USER 24 > (bar)
20
From a local variable:
CL-USER 25 > (let ((input '((foo2 . 102) (bar3 . 303))))
(make-my-functions input))
NIL
CL-USER 26 > (bar3)
303
With a macro, more clumsy and limited:
CL-USER 37 > (defparameter *input* '((foo1 . 101) (bar2 . 202)))
*INPUT*
CL-USER 38 > (defmacro def-my-functions (input &optional getter)
`(progn
,#(loop for (symbol . number) in (if getter
(funcall getter input)
input)
collect `(defun ,symbol () ,number))))
DEF-MY-FUNCTIONS
CL-USER 39 > (def-my-functions *input* symbol-value)
BAR2
CL-USER 40 > (foo1)
101
I need a way to suppress any error messages raised when parsing code using read-from-string so that I can read from Clojure code using something like this:
(let* ((string-with-code " '(func UpperCase \"string\")")
(brace-pos (position #\( string-with-code))
(end-of-token (+ brace-pos
(position #\Space (subseq string-with-code brace-pos))))
(first-token (subseq string-with-code (incf brace-pos) end-of-token)))
(format t "Found function: '~a'"
(read-from-string first-token)))
;; ==> Found function: 'func'
It basically prints the function name from the lisp code in the string. It works Ok until you try to use the dot operator(.) as the first item in the list. Clojure uses the . both to cons and to access classes in a Java package and hence valid code like:
(defmacro chain
([x form] `(. ~x ~form))
([x form & more] `(chain (. ~x ~form) ~#more)))
would cause an error:
*** - READ from #<INPUT STRING-INPUT-STREAM>: token "." not allowed here
if I were to walk it printing every function in the code. I want a way to ignore/suppress the error messages from read-from-string for this code to work preferably without modifying the way the lisp reader works.
EDIT :
A complete program:
(defvar string-with-code "(defmacro chain
([x form] `(d ~x ~form))
([x form & more] `(chain (. ~x ~form) ~#more)))
")
(defvar end-of-token 0)
(defvar first-token 0)
(defun functions-in-string (code)
(let ((bpos (position #\( code)))
(unless (null bpos)
(setq end-of-token (+ bpos (position #\Space (subseq code bpos))))
(setq first-token (subseq code (incf bpos) end-of-token))
(ignore-errors
(format t "Found function: '~(~A~)'~%" (read-from-string first-token)))
(functions-in-string (subseq code end-of-token)))))
;; (ignore-errors
;; (functions-in-string 0 code))
(functions-in-string string-with-code)
OUTPUT :
Found function: 'defmacro'
Found function: '[x'
Found function: 'd'
Found function: '[x'
Found function: 'chain'
;; You'll get the error below if ignore-errors wraps around the function call
;; *** - READ from #<INPUT STRING-INPUT-STREAM>: token "." not allowed here
Not clear what you are asking, but ignoring errors simply is:
CL-USER 37 > (ignore-errors (read-from-string "(. foo bar)"))
NIL
#<CONDITIONS:SIMPLE-READER-ERROR 402000243B>
In case of an error, IGNORE-ERRORS returns NIL and as the second return value the condition.
If you want more control, you would need to write an error handler.
Here's a start for Clojure yacc parsers. This needs more attention from you to deal with special Clojure reader macros and possibly ensure some other grammar aspects, but this is already a functioning start:
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun print-args (&rest args) (format nil "~{~a~^ ~}" args) ))
(defun clojure-lexer (stream)
(let ((digits '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
(translations (make-hash-table)))
(loop :for (key . value) :in
'((#\( . oparen)
(#\) . cparen)
(#\[ . obracket)
(#\] . cbracket)
(#\' . squote)
(#\` . accent)
(#\: . colon)
(#\, . comma)
(#\# . at)) :do
(setf (gethash key translations) value))
(labels ((%reverse-coerce (collected)
(coerce (nreverse collected) 'string))
(%read-token ()
(loop
:with collected := nil
:and stringp := nil
:and commentp := nil
:for token := (read-char stream nil nil) :do
(cond
((null token)
(return (and collected (%reverse-coerce collected))))
((char= token #\;)
(push token collected)
(setf commentp t))
((char= token #\")
(if commentp
(push token collected)
(if stringp
(progn
(push token collected)
(return (%reverse-coerce collected)))
(if collected
(progn
(unread-char token)
(return (%reverse-coerce collected)))
(progn
(push token collected)
(setf stringp t))))))
((gethash token translations)
(if (or stringp commentp)
(push token collected)
(if collected
(progn
(unread-char token stream)
(return (%reverse-coerce collected)))
(return (gethash token translations)))))
((member token '(#\Newline #\Rubout))
(if commentp
(return (and collected (%reverse-coerce collected)))
(if stringp
(push token collected)
(and collected (return (%reverse-coerce collected))))))
((member token '(#\Space #\Tab))
(if (or stringp commentp)
(push token collected)
(and collected (return (%reverse-coerce collected)))))
(t (push token collected))))))
(lambda ()
(let* ((key (%read-token))
(value (or (gethash key translations) key)))
(if (null key)
(values nil nil)
(let ((terminal
(cond
((member key '(oparen cparen squote colon accent
comma at obracket cbracket))
key)
((or (member (char key 0) digits)
(and (char= (char key 0) #\-)
(> (length key) 1)
(member (char key 1) digits)))
'number)
((char= (char key 0) #\") 'string)
((char= (char key 0) #\;) 'comment)
(t 'id))))
(values terminal value))))))))
(yacc:define-parser *clojure-parser*
(:start-symbol exp)
(:terminals (id oparen cparen squote colon accent
comma at obracket cbracket string number))
(exp
(oparen id exp-list cparen #'print-args)
(oparen id cparen #'print-args)
(obracket exp-list cbracket #'print-args)
(obracket cbracket #'print-args)
(comment #'print-args)
(accented-exp #'print-args)
(quoted-exp #'print-args)
(term #'print-args))
(term id string number)
(quoted-exp (quote exp))
(accented-exp (accent exp) (accent at exp))
(exp-list (exp exp-list) exp))
(defun parse-clojure (string)
(yacc:parse-with-lexer
(clojure-lexer (make-string-input-stream string)) *clojure-parser*))
(parse-clojure
"(defn str-invoke [instance method-str & args]
(clojure.lang.Reflector/invokeInstanceMethod
\"instance\" 123
method-str
(to-array args)))")
Results in:
;; "OPAREN defn (str-invoke
;; (OBRACKET (instance (method-str (& args))) CBRACKET
;; OPAREN clojure.lang.Reflector/invokeInstanceMethod (\"instance\"
;; (123
;; (method-str
;; OPAREN to-array args CPAREN))) CPAREN)) CPAREN"
Here's the BNF for the above grammar (not claiming it is the Clojure grammar, it only reflects the Lisp code above):
exp ::= '(' id exp-list ')'
| '(' id ')'
| '[' exp-list ']'
| '[' ']'
| ';' /[^\n]*/
| accented-exp
| quoted-exp
| term
term ::= id | '"' /[^"]*/ '"' | /-?[0-9][^\s]+/
quoted-exp ::= '\'' exp
accented-exp ::= '`' exp | '`' '#' exp
exp-list ::= exp exp-list | exp
id ::= /[^()[\]:,`#']+/
For simplicity, some parts are given as regular expressions, those are delimited by //.
i´m a newbie in lisp ,
i try to programm a programm in lisp, that calculate binomial coefficient iterative (factorial) but NOT recursive.
i´ve try everthing, global function, local function (factorial)),
but my programm doesn´t work, for example when i command: (binom (7 4)), just got an error
SELECT ALL
(defun binom-coef(a b)
(if (or (< a b) (< b 0))
nil )
(flet fakul(n) ; factorial
(cond ((= n 0) 1)
(t (* n (fakul (- n 1))))))
(/ (fakul a) (* (fakul b) (fakul(- a b)))))
i´ve one more question, how to compile in emacs?
(i tried in buffer -> scatch -> (load "binom-coeff.el"
but there´s only a error message...)
Many thanks, :)
You must make up your mind whether you're learning/programming in Common Lisp or in emacs-lisp. They're similar but different, and when learning, confusion may be an impediment.
To learn Emacs Lisp read:
An Introduction to Programming in Emacs Lisp http://www.gnu.org/software/emacs/emacs-lisp-intro/ or type in emacs M-: (info "(eintr)Top") RET
To learn about Common Lisp, have a look at http://cliki.net/Getting+Started
Your best bet is to install SLIME with EMACS. It uses SBCL which is a version of common lisp. Try C-C C-C or C-C C-K to compile. Then C-C C-Z to open a new buffer and run the program. I'm trying to teach myself also. Learning EMACS while learning a new language is not the easiest thing to do. At least for me.
I like this tutorial http://steve-yegge.blogspot.com/2008/01/emergency-elisp.html it's really short and informative.
If it's elisp what you want, just use C-x C-e after closing parenthesis. You had quite a number of errors there.
(defun binom-coef(a b)
;; (if (or (< a b) (< b 0)) nil)
;; Wery strange expression. (if CONDITION IF-TRUE IF-FALSE). You
;; didn't set IF-FALSE, so it's nil by default,
;; and you set IF-TRUE to nil. It allways returns nil.
;; If you want to leave from function when wrong args given
(block nil
(if (or (< a b) (< b 0)) (return))
;; can be throw/catch also
;; (flet fakul(n)
;; ;; wrong usage of flet. It's used like let, (flet ((name1 args1
;; ;; body1) (name2 args2 body2) ... )
;; ;; BODY-WHERE-FUNCTIONS-ARE-VISIBLE)
;; (cond
;; ((= n 0) 1)
;; (t (* n (fakul (- n 1))))
;; ))
(flet ((fakul (n)
(cond
((= n 0) 1)
(t ; shound be like (< 0 n)
(* n (fakul (- n 1))))
)))
(fakul 5)
;; => 120
(/ (fakul a) (* (fakul b) (fakul(- a b))))
;; ^ Inside flet ^
))
)
(binom-coef 8 3) ; <= look, it's not (8 3), because (8 3) means
; execute function `8' with argument 3. If you
; wanted to pass list with 8 and 3, it should be
; (quote (8 3)), or simply '(8 3)
;; => 56