Lisp, Error: Comma not inside a backquote. [file position = 762] - lisp

I've been following the instructions to install coding examples for Lisp but have been getting the error "Comma not inside a backquote" when trying to load the file "aima.Lisp" using Allegro CL.
This is the code for the file (unedited code here):
;;; -*- Mode: Lisp; Syntax: Common-Lisp -*- File:
aima.lisp
;;;; Vendor-Specific Customizations
#+Lucid (setq *warn-if-no-in-package* nil)
;;;; A minimal facility for defining systems of files
(defparameter "C:\Users\Aaron\Lisp\"
(truename "~/public_html/code/") ; <<<<<<<< Edit this
<<<<<<
"The root directory where the code is stored.")
(defparameter *aima-binary-type*
(first (list ; <<<<<<<<<<<<<<<<<<<< Edit this
<<<<<<<<<
#+Lispworks system::*binary-file-type*
#+Lucid (first lucid::*load-binary-pathname-
types*)
#+Allegro excl:*fasl-default-type*
#+(or AKCL KCL) "o"
#+CMU "sparcf"
#+CLISP "fas"))
"If calling aima-load loads your source files and not
your compiled
binary files, insert the file type for your binaries
before the <<<<
and load systems with (aima-load-binary NAME).")
(defconstant *aima-version*
"0.99 AIMA Code, Appomattox Version, 09-Apr-2002")
(defparameter *aima-system-names* nil
"A list of names of the systems that have been
defined.")
(defstruct aima-system
name (requires nil) (doc "") (parts nil) (examples nil)
(loaded? nil))
;;;; The Top-Level Functions:
(defmacro def-aima-system (name requires doc &body parts)
"Define a system as a list of parts. A part can be a
string, which denotes
a file name; or a symbol, which denotes a (sub)system
name; or a list of the
form (subdirectory / part...), which means the parts
are in a subdirectory.
The REQUIRES argument is a list of systems that must be
loaded before this
one. Note that a documentation string is mandatory."
`(add-aima-system :name ',name
:requires ',requires :doc ',doc
:parts ',parts))
(defun aima-load (&optional (name 'all))
"Load file(s), trying the system-dependent method
first."
(operate-on-aima-system name 'load-something))
(defun aima-load-binary (&optional (name 'all))
"Load file(s), prefering binaries to source."
(operate-on-aima-system name 'load-binary))
(defun aima-compile (&optional (name 'everything))
"Compile (and load) the file or files that make up an
AIMA system."
(operate-on-aima-system name 'compile-load))
(defun aima-load-if-unloaded (name)
(let ((system (get-aima-system name)))
(unless (and system (aima-system-loaded? system))
(aima-load system))
system))
;;;; Support Functions
(defun add-aima-system (&key name requires doc parts
examples)
(pushnew name *aima-system-names*)
(setf (get 'aima-system name)
(make-aima-system :name name :examples examples
:requires requires :doc doc
:parts parts)))
(defun get-aima-system (name)
"Return the system with this name. (If argument is a
system, return it.)"
(cond ((aima-system-p name) name)
((symbolp name) (get 'aima-system name))
(t nil)))
(defun operate-on-aima-system (part operation &key (path
nil) (load t)
(directory-operation
#'identity))
"Perform the operation on the part (or system) and its
subparts (if any).
Reasonable operations are load, load-binary, compile-
load, and echo.
If LOAD is true, then load any required systems that
are unloaded."
(let (system)
(cond
((stringp part) (funcall operation (aima-file part
:path path)))
((and (consp part) (eq (second part) '/))
(let* ((subdirectory (mklist (first part)))
(new-path (append path subdirectory)))
(funcall directory-operation new-path)
(dolist (subpart (nthcdr 2 part))
(operate-on-aima-system subpart operation :load
load
:path new-path
:directory-operation
directory-operation))))
((consp part)
(dolist (subpart part)
(operate-on-aima-system subpart operation :load
load :path path
:directory-operation
directory-operation)))
((setf system (get-aima-system part))
;; Load the required systems, then operate on the
parts
(when load (mapc #'aima-load-if-unloaded (aima-
system-requires system)))
(operate-on-aima-system (aima-system-parts system)
operation
:load load :path path
:directory-operation
directory-operation)
(setf (aima-system-loaded? system) t))
(t (warn "Unrecognized part: ~S in path ~A" part
path)))))
(defun aima-file (name &key (type nil) (path nil))
"Given a file name and maybe a file type and a relative
path from the
AIMA directory, return the right complete pathname."
(make-pathname :name name :type type :defaults *aima-
root*
:directory (append (pathname-directory
*aima-root*)
(mklist path))))
#-MCL ;; Macintosh Common Lisp already defines this
function
(defun compile-load (file)
"Compile file and then load it."
;; This could be made more sophisticated, to compile
only when out of date.
(compile-file (file-with-type file "lisp"))
(load-binary file))
(defun load-binary (file)
"Load file, trying the binary first, but loading the
source if necessary."
(load-something file '(binary nil "lisp")))
(defun load-something (file &optional (types '(nil binary
"lisp")))
"Try each of the types in turn until we get a file that
loads.
Complain if we can't find anything. By default, try
the system-dependent
method first, then the binary, and finally the source
(lisp) file."
(dolist (type types (warn "Can't find file: ~A" file))
(when (load (file-with-type file type) :if-does-not-
exist nil)
(return t))))
(defun file-with-type (file type)
"Return a pathname with the given type."
(if (null type)
file
(merge-pathnames
(make-pathname :type (if (eq type 'binary) *aima-
binary-type* type))
file)))
(defun mklist (x)
"If x is a list, return it; otherwise return a
singleton list, (x)."
(if (listp x) x (list x)))
;;;
---------------------------------------------------------
-------------
;;;; Definitions of Systems
;;;
---------------------------------------------------------
-------------
(def-aima-system utilities ()
"Basic functions that are loaded every time, and used
by many other systems."
("utilities" / "utilities" "binary-tree" "queue"
"cltl2" "test-utilities"))
(def-aima-system agents (utilities)
"Code from Part I: Agents and Environments"
("agents" / "test-agents"
("environments" / "basic-env" "grid-env" "vacuum"
"wumpus")
("agents" / "agent" "vacuum" "wumpus")
("algorithms" / "grid")))
(def-aima-system search (agents)
"Code from Part II: Problem Solving and Search"
("search" / "test-search"
("algorithms" / "problems" "simple" "repeated"
"csp" "ida" "iterative" "sma" "minimax")
("environments" / "games" "prob-solve")
("domains" / "cannibals" "ttt" "cognac" "nqueens"
"path-planning"
"puzzle8" "route-finding" "tsp" "vacuum")
("agents" / "ps-agents" "ttt-agent")))
(def-aima-system logic (agents)
"Code from Part III: Logic, Inference, and Knowledge
Representation"
("logic" / "test-logic"
("algorithms" / "tell-ask" "unify" "normal" "prop"
"horn" "fol" "infix")
("environments" / "shopping")))
(def-aima-system planning ()
"Code from Part IV: Planning and Acting"
("planning" / ))
(def-aima-system uncertainty (agents)
"Code from Part V: Uncertain Knowledge and Reasoning"
("uncertainty" / "test-uncertainty"
("agents" / "mdp-agent")
("domains" / "mdp" "4x3-mdp")
("environments" / "mdp")
("algorithms" / "dp" "stats")))
(def-aima-system learning (uncertainty)
"Code from Part VI: Learning"
("learning" / "test-learning"
("algorithms" / "inductive-learning" "learning-
curves" "dtl" "dll"
"nn" "perceptron" "multilayer" "q-iteration")
("domains" / "restaurant-multivalued" "restaurant-
real"
"restaurant-boolean" "majority-boolean" "ex-19-4-
boolean"
"and-boolean" "xor-boolean" "4x3-passive-mdp")
("agents" / "passive-lms-learner" "passive-adp-
learner"
"passive-td-learner" "active-adp-learner" "active-
qi-learner"
"exploring-adp-learner" "exploring-tdq-learner")))
(def-aima-system language (logic)
"Code from Part VII, Chapters 22-23: Natural Language
and Communication"
("language" / "test-language"
("algorithms" / "chart-parse")
("domains" / "grammars" )))
(def-aima-system all ()
"All systems except the utilities system, which is
always already loaded"
agents search logic planning uncertainty learning
language)
(def-aima-system everything ()
"All the code, including the utilities"
utilities all)
(setf *aima-system-names* (nreverse *aima-system-names*))
;;;; Always load the utilities
(aima-load 'utilities)
This is the first time I've tried using lisp and I am having trouble finding the error.

Your problem is not "Comma not inside a backquote", but the fact that you have edited line 9 wrong. Backslash escapes closing double quote, so your string does not end on line 9 and all the code becomes mess.
Only edit line 9 of the original file, try to do it this way:
(defparameter *aima-root* (truename "C:\\Users\\Aaron\\Lisp\\aima\\")
"The root directory where the code is stored.")

Related

Simple vs complex user entry functions in Lisp

At this site: http://www.gigamonkeys.com/book/practical-a-simple-database.html there is user entry function listed as follows:
(defun prompt-read (prompt)
(format *query-io* "~%~a: " prompt)
(force-output *query-io*)
(read-line *query-io*))
Are there any major advantages of above function as compared to following simpler form:
(defun prompt-read2 (prompt)
(format t "~%~a: " prompt)
(setf answer (read-line)))
Is it recommended to always use force-output and *query-io* all the time?
Setting the answer to a global variable like that is bad. You should just return the answer and let the caller do what it wants with it. If you do use special (~global) variables, you should put asterisks around the name (*ANSWER* instead of ANSWER).
FORCE-OUTPUT is needed to ensure that the user actually sees the prompt before having to answer. If I run the second version using SBCL in a terminal, the program just freezes to wait for input without saying anything.
*QUERY-IO* should be used for querying things from the user, because some environment might want to handle that differently from other output. For example, someone might write a GUI wrapper for your program that turns the queries into graphical dialogs. Or maybe they want to run it as a part of a script, providing the input from a string.
(defun prompt-read (prompt)
(format *query-io* "~%~a: " prompt)
(force-output *query-io*)
(read-line *query-io*))
(defun hello ()
(format t "~&Hello ~a!~%" (prompt-read "What's your name")))
(defmacro with-input ((input) &body body)
`(let ((*query-io* (make-two-way-stream (make-string-input-stream ,input)
(make-string-output-stream))))
,#body))
(defun test ()
(with-input ("jkiiski")
(hello))
(with-input ("rnso")
(hello)))
(test)
; Hello jkiiski!
; Hello rnso!
Edit
A more complex example using SBCLs gray streams.
(defclass foo-stream (sb-gray:fundamental-character-input-stream)
((output-input-script :initarg :script :accessor foo-stream-script)
(output-stream :initarg :out :accessor foo-stream-out)
(current-input :initform nil :accessor foo-stream-current-input)))
(defmethod sb-gray:stream-read-char ((stream foo-stream))
(with-accessors ((input foo-stream-current-input)
(out foo-stream-out)
(script foo-stream-script)) stream
(when (or (null input)
(not (listen input)))
(let ((output (string-trim '(#\space #\newline)
(get-output-stream-string out))))
(setf input (make-string-input-stream
(format nil "~a~%"
(cdr (assoc output script :test #'string=)))))))
(read-char input)))
(defun prompt-read (prompt)
(format *query-io* "~%~a: " prompt)
(force-output *query-io*)
(read-line *query-io*))
(defun hello ()
(format t "~&Hello ~a!~%" (prompt-read "What's your name"))
(format t "~&I'm ~a too!" (prompt-read "How are you"))
(format t "~&~a~%" (if (string-equal (prompt-read
"Do you want to delete all your files")
"yes")
"Deleting all files... (not really)"
"Not deleting anything.")))
(defmacro with-input-script ((script) &body body)
(let ((out-sym (gensym "out")))
`(let* ((,out-sym (make-string-output-stream))
(*query-io* (make-two-way-stream
(make-instance 'foo-stream
:out ,out-sym
:script ,script)
,out-sym)))
,#body)))
(defun test ()
(with-input-script ('(("What's your name:" . "jkiiski")
("How are you:" . "great")
("Do you want to delete all your files:" . "No")))
(hello))
(with-input-script ('(("What's your name:" . "Foo Bar")
("How are you:" . "fine")
("Do you want to delete all your files:" . "Yes")))
(hello)))
(test)
; Hello jkiiski!
; I'm great too!
; Not deleting anything.
; Hello Foo Bar!
; I'm fine too!
; Deleting all files... (not really)
Yes you code is easy but the first is more clarifying what are you doing:
*query-io* is a global variable (which you can tell because of the * naming convention for global variables) that contains the input stream
connected to the terminal. The return value of prompt-read will be the
value of the last form, the call to READ-LINE, which returns the
string it read (without the trailing newline.)
This is what they said about *query-io*
And about the streams that you can put there works as follow:
most other I/O functions also accept T and NIL as stream designators
but with a different meaning: as a stream designator, T designates the
bidirectional stream *TERMINAL-IO*, while NIL designates
*STANDARD-OUTPUT* as an output stream and *STANDARD-INPUT* as an input stream
in this case it seems that this is only pointing to *standard-input* and not to the bidirectional stream t

Emacs metaprogramming, dynamically define methods

I am trying to define some helper functions to quickly jump to different projects from within emacs. I started by defining a macro as follows
(defmacro project-alias (name path)
`(defun ,name ()
(interactive)
(cd ,path)))
And this works great I can (project-alias foo "~/bar") no problem. The problem comes when I try and apply this macro over a list of tuples.
(setq projects '((foo . "~/foo")
(bar . "~/bar")))
(dolist (p projects)
(project-alias (car p) (cdr p)))
The above code errors with
Debugger entered--Lisp error: (wrong-type-argument symbolp (car p))
defalias((car p) (lambda nil (interactive) (cd (cdr p))))
I have tried passing the first argument in as a string and calling intern to get the symbol representation out with no joy, and I've also tried defining my macro to accept the string form and that doesn't work either
What am I doing wrong?
If your use of the macro involves evaluating sexps to produce the name and path, then it needs to evaluate the sexps:
(defmacro project-alias (name path)
`(defun ,(eval name) () (interactive) (cd ,(eval path))))
Alternatively, use a function:
(defun project-alias (name path)
(eval `(defun ,name () (interactive) (cd ,path))))
You could do either
(defun project-alias-f (name path)
(eval `(defun ,name ()
(interactive)
(cd ,path))))
(dolist (p projects)
(project-alias-f (car p) (cdr p)))
or
(dolist (p projects)
(eval `(project-alias ,(car p) ,(cdr p))))
Macro arguments are passed un-evaluated. (Macros could not otherwise do what they can do.)
So your arguments are literally the forms (car p) and (cdr p) (as opposed to, for instance, foo and "~/foo").
Here's another take on it, with no macros nor eval:
;; -*- lexical-binding:t -*-
(defun project-alias-f (name filename)
(defalias name (lambda () (interactive) (cd filename)))
(dolist (p projects)
(project-alias-f (car p) (cdr p)))
This is not an answer to your macro problem, but an alternative solution to your desire to jump between projects.
In my init.el file, I have (amongst other things)
(set-register ?A '(file . "~/.aliases"))
(set-register ?E '(file . "~/.emacs.d/init.el"))
(set-register ?H '(file . "~/.hgrc"))
(set-register ?T '(file . "~/.TODO.org"))
Then I can use jump-to-register (C-x r j) to jump to one of these files when I wish to edit the file (or do something with one of the unlisted projects). Because a file/folder is stored in the register (rather than a window config say), emacs will open the file or folder it finds in the register.

Asking emacs for default directory path "once"

I want to have a variable that keeps the default directory a user enters and keep using it throughout the run of emacs.
Basically, when the user executes a custom command, the prompt will ask for a default directory path to execute the command (only once) and whenever the user calls the same command emacs uses the same path onward.
How can I program that snippet of code in lisp?
I basically want this code in the igrep library to accept the input from user once and not ask again:
(defvar default-files-string-new "*.[sch]")
(defun igrep-read-files (&optional prompt-prefix)
"Read and return a file name pattern from the minibuffer.
If `current-prefix-arg' is '(16) or '(64), read multiple file name
patterns and return them in a list. Optional PROMPT-PREFIX is
prepended to the \"File(s): \" prompt."
(let* ((default-files (igrep-default-files))
(default-files-string (mapconcat 'identity default-files " "))
(insert-default-directory igrep-insert-default-directory)
(file (igrep-read-file-name
(igrep-prefix prompt-prefix
(if default-files
(format "File(s) [default: %s]: "
default-files-string)
"File(s): "))
nil (if default-files default-files-string "") nil nil
'igrep-files-history))
(files (list file)))
(if (or igrep-read-multiple-files
(and (consp current-prefix-arg)
(memq (prefix-numeric-value current-prefix-arg)
'(16 64))))
(let* ((key (igrep-default-key 'exit-minibuffer
minibuffer-local-completion-map
"\r"))
(prompt
(igrep-prefix prompt-prefix
(if igrep-verbose-prompts
(format "File(s): [Type `%s' when done] "
(key-description key))
"File(s): "))))
(while (and (setq file
(igrep-read-file-name prompt
nil "" nil nil
'igrep-files-history))
(not (equal file "")))
(setq files (cons file files)))))
(mapcar (lambda (file)
(if (file-directory-p file)
;; really should map expand-file-name over default-files:
(expand-file-name (if default-files default-files-string-new "*")
file)
file))
(nreverse files))))
You could use advices to do that:
(defvar wd-alist nil)
(mapc
(lambda (function)
(eval
`(defadvice ,function (around ,(intern (format "%s-wd" function)) activate)
(let ((wd (cdr (assoc ',function wd-alist))))
(unless wd
(setq wd (read-file-name "Default directory: "))
(push (cons ',function wd) wd-alist))
(let ((default-directory wd))
ad-do-it)))))
'(grep-find))
The variable wd-list stores the association (FUNCTION . PATH). The list mapc iterate over are the advised functions. Now, when calling find-grep, it asks for the working directory (after interactive arguments, so you first have to type the pattern and enter...) and stores it in wd-list for further use. Now your find-grep are always done in that directory.
You could have a custom variable for the sane default, and then have the user enter the path or accept the default on the first call.
(defcustom default-path "/tmp/foo" "Path")
(setq current-path nil)
(defun foo ()
(interactive)
(unless current-path
(setq current-path
(read-from-minibuffer
(format "Path [%s]" default-path) nil nil t nil default-path)))
(message "Path is: %s" current-path))
The first time you do M-x foo, it prompts for the path. A common idiom is to allow the user to specify a prefix argument when they want to change the value (after the first time.) This code will have the desired effect:
(defun foo (choose)
(interactive "P")
(when (or choose (not current-path))
(setq current-path
(read-from-minibuffer
(format "Path [%s]" default-path) nil nil t nil default-path)))
(message "Path is: %s" current-path))
Now doing M-x foo is the same as before, but C-0 M-x foo will prompt for a new value.
In your example, something like this will work.
(defun igrep-read-files (&optional prompt-prefix)
(interactive "P")
(when (or prompt-prefix (not current-path ))
(setq current-path
(read-file-name "Dir: " default-path nil t)))
(message (expand-file-name default-files-string-new current-path)))
Have a look at the code of sendmail-query-once.
Although it's not very fashionable to do this sort of thing.
Usually package writers pick a sane default and let the user
customize it as they want.

define your own tag in org-mode

There are Tags as in #+AUTHOR or #+LATEX in org-mode - are they called tags? I'd like to define my own tag which calls a function to preprocess the data and then outputs it - if the export target is LaTeX.
My solution was defining an own language, qtree, for SRC blocks.
#+BEGIN_SRC qtree
[.CP [.TP [.NP [] [.N' [.N Syntax] []]] [.VP [] [.V' [.V sucks] []]]]]
#+END_SRC
And process it accordingly. I even added a qtree-mode with paredit.
And a landscape parameter if the trees grow big. https://github.com/Tass/emacs-starter-kit/blob/master/vendor/assorted/org-babel-qtree.el
(require 'org)
(defun org-babel-execute:qtree (body params)
"Reformat a block of lisp-edited tree to one tikz-qtree likes."
(let (( tree
(concat "\\begin{tikzpicture}
\\tikzset{every tree node/.style={align=center, anchor=north}}
\\Tree "
(replace-regexp-in-string
" \\_<\\w+\\_>" (lambda (x) (concat "\\\\\\\\" (substring x 1)))
(replace-regexp-in-string
(regexp-quote "]") " ]" ; qtree needs a space
; before every closing
; bracket.
(replace-regexp-in-string
(regexp-quote "[]") "[.{}]" body)) ; empty leaf
; nodes, see
; http://tex.stackexchange.com/questions/75915
) ; For
; http://tex.stackexchange.com/questions/75217
"\n\\end{tikzpicture}"
)))
(if (assoc :landscape params)
(concat "\\begin{landscape}\n" tree "\n\\end{landscape}")
tree)))
(setq org-babel-default-header-args:qtree '((:results . "latex") (:exports . "results")))
(add-to-list 'org-src-lang-modes '("qtree" . qtree))
(define-generic-mode
'qtree-mode ;; name of the mode to create
'("%") ;; comments start with '%'
'() ;; no keywords
'(("[." . 'font-lock-operator) ;; some operators
("]" . 'font-lock-operator))
'() ;; files for which to activate this mode
'(paredit-mode) ;; other functions to call
"A mode for qtree edits" ;; doc string for this mode
)
They seem to be called keywords for in-buffer settings no more. Whatever they're called, they don't seem to be user-definable.
What you want to do is extremely related to a common way of handling whereas to export with xelatex or pdflatex as described on Worg.
The relevant part would be :
;; Originally taken from Bruno Tavernier: http://thread.gmane.org/gmane.emacs.orgmode/31150/focus=31432
(defun my-auto-tex-cmd ()
(if (string-match "YOUR_TAG: value1" (buffer-string))
(do something))
(if (string-match "YOUR_TAG: value2" (buffer-string))
(do something else))
(add-hook 'org-export-latex-after-initial-vars-hook 'my-auto-tex-cmd)

set! global from Scheme macro?

I am trying to write a wrapper for define, that stores the values passed to it. I've been approaching it in baby steps (being new to Lisp in general, and even newer to Scheme) but have run into a wall.
In Racket, I'm starting with:
> (require (lib "defmacro.ss"))
> (define-macro (mydefine thing definition)
`(define ,thing ,definition))
> (mydefine a 9)
> a
9
Okay, that works. Time to do something in the macro, prior to returning the s-exprs:
> (define-macro (mydefine thing definition)
(display "This works")
`(define ,thing ,definition))
> (mydefine a "bob")
This works
> a
"bob"
Nice. But I can't for the life of me get it to set a global variable instead of displaying something:
> (define *myglobal* null)
> (define-macro (mydefine thing definition)
(set! *myglobal* "This does not")
`(define ,thing ,definition))
> (mydefine a ":-(")
set!: cannot set identifier before its definition: *myglobal*
Any suggestions on how to accomplish this would be greatly appreciated.
I suspect that I'm trying to swim against the current here, either by fiddling with globals from a macro in Scheme, or by using define-macro instead of learning the Scheme-specific syntax for macro creation.
You're running against Racket's phase separation -- which means that each phase (the runtime and the compile-time) operate in different worlds. As Vijay notes, one way to solve this is to do what you want at runtime, but that will probably not be what you need in the long run. The thing is that trying these things usually means that you will want to store some syntactic information at the compile-time level. For example, say that you want to store the names of all of your defined names, to be used in a second macro that will print them all out. You would do this as follows (I'm using sane macros here, define-macro is a legacy hack that shouldn't be used for real work, you can look these things up in the guide, and then in the reference):
#lang racket
(define-for-syntax defined-names '())
(define-syntax (mydefine stx)
(syntax-case stx ()
[(_ name value)
(identifier? #'name)
(begin (set! defined-names (cons #'name defined-names))
#'(define name value))]
;; provide the same syntactic sugar that `define' does
[(_ (name . args) . body)
#'(mydefine name (lambda args . body))]))
Note that defined-names is defined at the syntax level, which means that normal runtime code cannot refer to it. In fact, you can have it bound to a different value at the runtime level, since the two bindings are distinct. Now that that's done, you can write the macro that uses it -- even though defined-names is inaccessible at the runtime, it is a plain binding at the syntax level, so:
(define-syntax (show-definitions stx)
(syntax-case stx ()
[(_) (with-syntax ([(name ...) (reverse defined-names)])
#'(begin (printf "The global values are:\n")
(for ([sym (in-list '(name ...))]
[val (in-list (list name ...))])
(printf " ~s = ~s\n" sym val))))]))
The statement (set! *myglobal* "This does not") is executed in the transformer environment, not the normal environment. So it's not able to find *myglobal. We need to get both the expressions executed in the environment where *myglobal* is defined.
Here is one solution:
(define *defined-values* null)
(define-macro (mydefine thing definition)
`(begin
(set! *defined-values* (cons ,definition *defined-values*))
(define ,thing ,`(car *defined-values*))))
> (mydefine a 10)
> (mydefine b (+ 20 30))
> a
10
> b
50
> *defined-values*
(50 10)
> (define i 10)
> (mydefine a (begin (set! i (add1 i)) i)) ;; makes sure that `definition`
;; is not evaluated twice.
> a
11
If the Scheme implementation does not provide define-macro but has define-syntax, mydefine could be defined as:
(define-syntax mydefine
(syntax-rules ()
((_ thing definition)
(begin
(set! *defined-values* (cons definition *defined-values*))
(define thing (car *defined-values*))))))