The following three examples fail with the following errors:
(setv dct {1 2 3 4})
(setv dcts "dct")
;; (print (get (. (globals) [dcts]) 1))
(print (-> (globals) (. [dcts]) (get 1)))
;; (print (get (get (globals) "dct") 1))
(print (-> (globals) (get "dct") (get 1)))
;; (print (get (get (globals) dcts) 1))
(print (-> (globals) (get dcts) (get 1)))
Traceback (most recent call last):
File "/usr/lib/python3.9/runpy.py", line 267, in run_path
code, fname = _get_code_from_file(run_name, path_name)
File "/home/shadowrylander/test.hy", line 5
(print (-> (globals) (. [dcts]) (get 1)))
^
hy.errors.HySyntaxError: parse error for pattern macro 'get': got unexpected end of file, expected: some(...)
Traceback (most recent call last):
File "/usr/lib/python3.9/runpy.py", line 267, in run_path
code, fname = _get_code_from_file(run_name, path_name)
File "/home/shadowrylander/test.hy", line 8
(print (-> (globals) (get "dct") (get 1)))
^
hy.errors.HySyntaxError: parse error for pattern macro 'get': got unexpected end of file, expected: some(...)
Traceback (most recent call last):
File "/usr/lib/python3.9/runpy.py", line 267, in run_path
code, fname = _get_code_from_file(run_name, path_name)
File "/home/shadowrylander/test.hy", line 11
(print (-> (globals) (get dcts) (get 1)))
^
hy.errors.HySyntaxError: parse error for pattern macro 'get': got unexpected end of file, expected: some(...)
Is it not possible to use get, or macros in general, with the threading macro (->)? I've rewritten the print statements multiple times to ensure consistent brackets, and they're all there.
=> (require hyrule [->])
(setv dct {1 2 3 4})
(setv dcts "dct")
;; (print (get (. (globals) [dcts]) 1))
(print (-> (globals) (. [dcts]) (get 1)))
;; (print (get (get (globals) "dct") 1))
(print (-> (globals) (get "dct") (get 1)))
;; (print (get (get (globals) dcts) 1))
(print (-> (globals) (get dcts) (get 1)))
The following works for me on Hy master. Did you forget the require?
=> (require hyrule [->])
=> (setv dct {1 2 3 4})
=> (setv dcts "dct")
=> (print (-> (globals) (get dcts) (get 1)))
2
Related
I have the following code:
(require [hyrule [-> ->>]])
(defn static/freezer [value freezer]
(cond [(not value) (setv freezer [])]
[(isinstance value list)
(do (if (not (isinstance freezer list)) (setv freezer []))
(.extend freezer value)
(setv freezer (->> (lfor i
(lfor j freezer :if j j)
(if (isinstance i list) i [i]))
(list)
(chain #*))))]
[True (raise (TypeError f"Sorry! The 'm/freezer' can only accept lists or non-truthy values!"))])
(return freezer))
(print (static/freezer [[1 2] [3 4] 5))
... but am getting the following error:
Traceback (most recent call last):
File "/usr/lib/python3.9/runpy.py", line 267, in run_path
code, fname = _get_code_from_file(run_name, path_name)
File "/home/shadowrylander/bakery/test.hy", line 12
(chain #*))))]
^
hy.lex.exceptions.LexException: Ran into a RPAREN where it wasn't expected.
I am assuming the ->> macro isn't taking effect, as every bracket checks out, but neither eval-when-compile nor eval-after-compile helps.
As suggested by the error message, (chain #*) is not lexically legal. #*, as well as #**, must be followed by a form. The underlying idea is that #* and #**, like ( and ", are not forms themselves, but characters that can be used along with some other characters to construct forms, namely (unpack-iterable …) and (unpack-mapping …). #1730 discusses some related issues. At any rate, lexing happens before any macros are expanded, so ->> can't get around this.
I'm learning (common) Lisp, and as exercise, I want to implement 'xond', a cond macro, that transform this silly example:
(xond (= n 1) (setq x 2) (= n 2) (setq x 1))
into a if-else chain:
(if (= n 1) (setq x 2) (if (= n 2) (setq x 1)))
Currently, I have this macro:
(defmacro xond (&rest x) (if x (list 'progn (list 'if (pop x) (pop x)))))
that just expand the first two items in x:
(macroexpand '(xond (= x 1) (setq y 2)))
produce
(PROGN (IF (= X 1) (SETQ Y 2))) ;
Now I want to process all items in x, so I add a loop to produce a if-serie (a step toward if-else-version):
(defmacro xond (&rest x)
(loop (if x
(list 'progn (list 'if (pop x) (pop x)))
(return t))))
but then macro seems to stop working:
(macroexpand '(xond (= x 1) (setq y 2)))
T ;
What I'm missing here?
Edition
verdammelt's answer put me in the right track, and coredump's made me change my approach to an iterative one.
Now I'll implement (xond test1 exp1 test2 exp2) as:
(block nil
test1 (return exp1)
test2 (return exp2)
)
which can be done by iteration.
I'm writing this for my minimal Lisp interpreter; I have only implemented the most basic functions.
This is what I wrote. I'm using la to accumulate the parts of the output.
(defmacro xond (&rest x)
(let ((la '()))
(loop
(if x (push (list 'if (pop x) (list 'return (pop x))) la)
(progn (push 'nil la)
(push 'block la)
(return la)
)))))
with
(macroexpand '(xond (= x 1) (setq y 2) (= X 2) (setq y 1)))
result:
(BLOCK NIL
(IF (= X 2) (RETURN (SETQ Y 1)))
(IF (= X 1) (RETURN (SETQ Y 2)))
) ;
Second edition
Add a label to block and change return to return-from, to avoid conflict with other return inside arguments. Also changed push for append to generate code in the same orden as the parameters.
(defmacro xond (&rest x)
(let ((label (gensym)) (la '()) (condition nil) (expresion nil))
(setq la (append la (list 'block label)))
(loop
(if x
(setq la (append la (list
(list 'if (pop x) (list 'return-from label (pop x))))))
(return la)))))
So
(macroexpand '(xond (= x 1) (setq y 2) (= X 2) (setq y 1)))
now gives
(BLOCK #:G3187 (IF (= X 1) (RETURN-FROM #:G3187 (SETQ Y 2))) (IF (= X 2) (RETURN-FROM #:G3187 (SETQ Y 1))))
Some remarks
You do not need a progn when you only expand into a single if
The use of pop might be confusing for the reader (and the programmer too) since it mutates a place, maybe you want to start with a less imperative approach
Also, in that case I don't think a loop approach is helpful, because you need to nest the expressions that come after in the body inside a previously built form, and even though it can be done, it is a bit more complex to do that simply a recursive function or a "recursive" macro.
Here I explain both approach, starting with "recursive" macro (the quote here is because the macro does not call itself, but expands as call to itself).
Macro expansion fixpoint
If I had to implement xond, I would write a macro that expands into other calls to xond, until macroexpansion reaches a base case where there are no more xond:
(defmacro xond (&rest body)
(if (rest body)
(destructuring-bind (test if-action . rest) body
`(if ,test ,if-action (xond ,#rest)))
(first body)))
For example, this expression:
(xond (= n 1) (setq x 2) (= n 2) (setq x 1))
First macroexpands into:
(if (= n 1)
(setq x 2)
(xond (= n 2) (setq x 1)))
And eventually reaches a fixpoint with:
(if (= n 1)
(setq x 2)
(if (= n 2)
(setq x 1)
nil))
Be careful, you cannot directly use xond inside the definition of xond, what happens is that the macro expands as a call to xond, which Lisp then expands again. If you are not careful, you may end up with an infinite macroexpansion, that's why you need a base case where the macro does not expand into xond.
Macro calling a recursive function
Alternatively, you can call a recursive function inside your macro, and expand all the inner forms at once.
With LABELS, you bind xond-expand to a recursive function. Here this is an actual recursive approach:
(labels ((xond-expand (body)
(if body
(list 'if
(pop body)
(pop body)
(xond-expand body))
nil)))
(xond-expand '((= n 1) (setq x 2) (= n 2) (setq x 1))))
; => (IF (= N 1)
; (SETQ X 2)
; (IF (= N 2)
; (SETQ X 1)
; NIL))
Your xond macro ends with (return t) so it evaluates to t rather than your accumulated if expressions.
You could use loop's collect clause to accumulate the code you wish to return. For example: (loop for x in '(1 2 3) collect (* 2 x)) would evaluate to (2 4 6).
How about
(ql:quickload :alexandria)
(defun as-last (l1 l2)
`(,#l1 ,l2))
(defmacro xond (&rest args)
(reduce #'as-last
(loop for (condition . branch) in (alexandria:plist-alist args)
collect `(if ,condition ,branch))
:from-end t))
(macroexpand-1 '(xond c1 b1 c2 b2 c3 b3))
;; (IF C1 B1 (IF C2 B2 (IF C3 B3))) ;
;; T
alexandria's plist-alist was used to pair the arguments,
the intrinsic destructuring in loop used to extract conditions and branches.
The helper function as-last stacks lists together in the kind of
(a b c) (d e f) => (a b c (d e f)).
(reduce ... :from-end t) right-folds the sequence of the collected (if condition branch) clauses stacking them into each other using #'as-last.
Without any dependencies
('though, does alexandria even count as a dependency? ;) )
(defun pairs (l &key (acc '()) (fill-with-nil-p nil))
(cond ((null l) (nreverse acc))
((null (cdr l)) (pairs (cdr l)
:acc (cons (if fill-with-nil-p
(list (car l) nil)
l)
acc)
:fill-with-nil-p fill-with-nil-p))
(t (pairs (cdr (cdr l))
:acc (cons (list (car l) (cadr l)) acc)
:fill-with-nil-p fill-with-nil-p))))
(defun as-last (l1 l2)
`(,#l1 ,l2))
(defmacro xond (&rest args)
(reduce #'as-last
(loop for (condition branch) in (pairs args)
collect `(if ,condition ,branch))
:from-end t))
(macroexpand-1 '(xond c1 b1 c2 b2 c3 b3))
;; (IF C1 B1 (IF C2 B2 (IF C3 B3))) ;
;; T
The helper function pairs makes out of (a b c d e f) => ((a b) (c d) (e f)).
(:fill-with-nil-p determines in case of odd number of list elements, whether the last element would be listed (last-el) or (last-el nil) - in the latter case filled with nil).
The following macro tries to assign a member variable from init argument.
But
name 'self' is not defined
(defmacro optional_assign [x &optional [base self]]
`(lif ~x (setv (. ~base ~x) ~x) (setv (. ~base ~x ) None) ))
(defclass clsa []
(defn __init__ [self &optional y]
(optional_assign y)
))
(setv insa1 (clsa 123))
(print insa1.y) ;;=>123
(setv insa2 (clsa))
(print insa2.y) ;;=>None
The default argument is evaluated like an ordinary expression, so you want [base 'self], not [base self].
Also, you're missing a ~ for the first mention of x in the body.
This is the first time I have ever seen this compiler error does anyone know what it is? and why my function can't print my nested vectors.
(defvar *col-lookup* #.(let ((ht (make-hash-table)))
(loop for (key . value) in
'(
(A . 0) (B . 1) (C . 2)
(D . 3) (E . 4) (F . 5) (G . 6))
do (setf (gethash key ht) value))
ht))
;; vector of vectors
(defparameter *game-board*
(make-array 7 :initial-element (make-array 0 :initial-element 0)))
;;make move lookup character in table then push X onto vector of value of key
(defun move (c)
(let ((place (gethash c *col-lookup*)))
(cond ((oddp *turn-count*)
(push "X" (aref *game-board* place))
(incf *turn-count*))
((push "O" (aref *game-board* place))
(incf *turn-count*)))))
You are creating a very peculiar vector of vectors with the code:
(make-array 7 :initial-element (make-array 0 :initial-element 0)))
This code will create a vector of 7 elements, each of them a vector with 0 elements (i.e. an empty vector) (and note that giving the initial-element to 0 is useless because there are no elements to assign). If you print it you should see:
#(#() #() #() #() #() #() #())
which means exactly this, a vector with seven empty vectors. So if you try to access the internal vector with something like (aref (aref *game-board*) 1) 2) you get an error.
Finally note that in the code of the function move you use:
(push "X" (aref *game-board* place))
whose effect is not of modifying the internal vector at place place, but of replace the old value of (aref *game-board* place) with a cons of the string "X" and the old value of (aref *game-board* place), the empty vector.
I was able to print my vector of vectors by simply looping over it once. I still do not know what that error was but I haven't ran into it since.
(defun print-game ()
(loop for i from 0 to 6 do
(print (aref *game-board* i))))
I expanded the macro below to see how it worked and found myself a little confused.
(loop for i below 4 collect i)
expands to (I have cleaned it up a little for readability)
(block nil
(let ((i 0))
(declare (type (and number real) i))
(let* ((list-head (list nil))
(list-tail list-head))
(tagbody
sb-loop::next-loop
(when (>= i 4) (go sb-loop::end-loop))
(rplacd list-tail (setq list-tail (list i)))
(setq i (1+ i))
(print "-------") ;; added so I could see the lists grow
(print list-head)
(print list-tail)
(print "-------")
(go sb-loop::next-loop)
sb-loop::end-loop
(return-from nil (cdr list-head))))))
..and here is the output from running the above..
;; "-------"
;; (NIL 0)
;; (0)
;; "-------"
;; "-------"
;; (NIL 0 1)
;; (1)
;; "-------"
;; "-------"
;; (NIL 0 1 2)
;; (2)
;; "-------"
;; "-------"
;; (NIL 0 1 2 3)
;; (3)
;; "-------"
I just can't see where list-head is modified, I have to assume head and tail are eq and thus modifying one is modifying the other but could someone please break down what is happening on the rplacd line?
list-head and list-tail are initially the same (in the eq sense). list-head is a cons which cdr is the list being collected. list-tail points to the last cons in the list (except initially, see below).
To add an element to the end of the list, replacd modifies the cdr of list-tail to add a new cons, and list-tail is updated to point to the new cons.
When the loop terminates, the result is the cdr of list-head.
Why this complicated business with an extra cons? Because the list appending algorithm becomes easier when list-tail is always a pointer to the last cons of the list. But in the beginning, the empty list has no cons. So the trick is to make the list one cons longer.