--
-Jason
Member of the Autodesk Discussion Forum Moderator Program
If it wasn't it should be. There are two ways to implement them now.
1. Pass the flexible part as a list. Let your subroutine interpret the contents as you
wish.
2. Use global variables that are localized in the calling routine.
Doug
;Demo
(defun plus (list)
(apply '+ list)
)
Doug
;Demo2
(defun subfun ( c d)
(if a
(do a part)
)
(if b
(do b part)
)
(do c)
(do d)
)
(defun mainfun ( / a b)
(setq a 2 b 3)
(subfun 4 5)
)
Doug
"Jason Piercey" <Jason@AtrEngDOTcom> wrote in message
news:783E6E1CADA4269E...@in.WebX.maYIadrTaRb...
--
-Jason
Member of the Autodesk Discussion Forum Moderator Program
"Doug Broad" <dbr...@nash.cc.nc.us> wrote in message
news:B340169547EAC504...@in.WebX.maYIadrTaRb...
And you can required and optional arguments as follows:
(defun function (argexpr1 .... argexprn flexarglist)
....
)
;where argexpr1 to argexprn are fixed arguments that each must exist and flexarglist is
the
container for the flexible argument list portion. Flexarglist must be included by the
calling
function but could be nil.
Doug
"Jason Piercey" <Jason@AtrEngDOTcom> wrote in message
news:8569E9F7B44D16B6...@in.WebX.maYIadrTaRb...
Thanks for the help.
--
-Jason
Member of the Autodesk Discussion Forum Moderator Program
Here I recode his universal evaluation function as meval function ,
which uses evcon function for cond-expression evaluating and evlis
for simple list evaluation. Pair is a function that pairs up the formal
arguments of a lisp function with the supplied values. Here for example
we will lift the restrictions and allow for args number mismatch by
automatic list binding for extra arguments -- WHAT WILL MAKE the
OPTIONAL ARGUMENTS in function calls POSSIBLE in this specific
meta-lisp version.
Of course it is a toy, but you may have some fun playing with it. :-)
(defun meval ( e a ) ; meta-lisp eval
(cond
((vl-symbolp e) ; get symbol's value
(envget e a)) ; from environment
((atom e)
e) ; self-evaluating atomic values
((atom (car e))
(cond
((eq 'QUOTE (car e))
(cadr e))
((eq 'ATOM (car e))
(atom (meval (cadr e) a)))
((eq 'EQ (car e))
(eq (meval (cadr e) a)
(meval (caddr e) a)))
((eq 'CAR (car e))
(car (meval (cadr e) a)))
((eq 'CDR (car e))
(cdr (meval (cadr e) a)))
((eq 'CONS (car e))
(cons (meval (cadr e) a)
(meval (caddr e) a)))
((eq 'COND (car e))
(evcon (cdr e) a))
((eq 'LAMBDA (car e)) ; lambda expressions are self-evaluating
e )
((member (type (car e)) ; enable some arithmetics
'(SUBR USUBR EXSUBR EXRXSUBR))
(apply (quote (car e))
(evlis (cdr e) a)))
((envget (car e) a) ; present in environment
(meval ; rewrite expression
(cons (envget (car e) a)
(cdr e))
a))
(T e) ; coudn't evaluate -- autoquote
))
;; ((lambda (xs) body) vs)
((eq (caar e) 'LAMBDA)
(last ; last expr's value
(evlis ; evaluate body exprs
(cddar e)
(pair (cadar e) ; under extended environment
(evlis (cdr e) a)
a))))
(T e) ; coudn't evaluate -- autoquote
))
(defun c:mlisp ( ) ; meta-lisp REP prompt
(while 1
(print (meval (read (getstring 1 "\n> "))
*standard-environment*))))
(defun mlisp ( e)
(meval e *standard-environment*))
(defun envget (sym a)
(cdr (assoc sym a)))
(defun evlis ( e a )
(mapcar ; evaluate each subexpr under same 'a' environment
'(lambda(x)(meval x a))
e))
(defun evcon ( e a )
(cond
((null e) nil)
((meval (caar e) a)
(last (evlis (cdar e) a)))
(T (evcon (cdr e) a))))
(defun pair ( args vals env )
(cond
((null args) env)
((atom args)
(cons (cons args vals)
env))
(T (cons (cons (car args) (car vals))
(pair (cdr args) (cdr vals) env)))))
(setq *standard-environment*
(append
(mapcar '(lambda(s)(cons s (vl-symbol-value s)))
'(T + - * / < > <= >= =
sqrt float ; ....
))
'((list . (lambda x x))
(zero? . (lambda (n) (= n 0)))
(odd? . (lambda (n) (cond ((zero? n) nil) (T (even? (- n 1))))))
(even? . (lambda (n) (cond ((zero? n) T) (T (odd? (- n 1))))))
)))
;|
_$ (pair '(a b . c) '(1 (2) 3 4 5) '((x . 0) (y . -1)))
((A . 1) (B 2) (C 3 4 5) (X . 0) (Y . -1))
_$ (pair '(a b . c) '(1 ) '((x . 0) (y . -1)))
((A . 1) (B) (C) (X . 0) (Y . -1))
_$ (meval '((lambda x x) 1 2 3)
nil)
(1 2 3)
_$ (meval '((lambda(list f)
(f 1 2 3 4 5))
'(lambda x x)
'(lambda(a b . c) (list a b c)))
nil )
(1 2 (3 4 5))
_$ (meval '((lambda( odd? even? zero?)
(even? 2))
(lambda(n) (cond ((zero? n) nil) (T (even? (- n 1)))))
(lambda(n) (cond ((zero? n) T) (T (odd? (- n 1)))))
(lambda(x) (= x 0)))
'((T . T)))
T
_$ |;
(princ)
--
Have fun, :-)
Vlad http://vnestr.tripod.com/
Jason Piercey <Jason@AtrEngDOTcom> wrote in message
news:25FDECC7DED75B7E...@in.WebX.maYIadrTaRb...
The evcon function should be changed to support
single-expression COND clauses, like (cond (1) (2)):
(defun evcon ( e a / x)
(cond
((null e) nil)
((setq x (meval (caar e) a))
(if (cdar e)
(last (evlis (cdar e) a))
x)) ; test expr value
(T (evcon (cdr e) a))))
The classic sqrt example from the article is included
below in this extended standard environment:
(setq *standard-environment*
(append
(mapcar '(lambda(s)(cons s (vl-symbol-value s)))
'(T + - * / < > <= >= =
print prin1 princ float ; ....
))
(list
(cons 'al-sqrt sqrt)
)
'((list . (lambda x x))
(zero? . (lambda (n) (= n 0)))
(odd? . (lambda (n) (cond ((zero? n) nil) (T (even? (- n 1))))))
(even? . (lambda (n) (cond ((zero? n) T) (T (odd? (- n 1))))))
(prins . (lambda (x) (car (list (prin1 x) (princ " ")))))
(abs . (lambda (x) (cond ((< x 0) (- x)) (T x))))
(sqrt . (lambda (a x e)
(cond ((< (abs (- (* x x) a)) e) x)
(T (sqrt a (/ (+ x (/ a (float x))) 2) e)))))
)))
it can be tested with e.g.
_$ (mlisp '(- (al-sqrt 7.7) (prins (sqrt 7.7 2.0 0.0001))))
2.77489 -2.6698e-006
_$
It may be an interesting exercise to add more functions from the
article here, and more so, to add AND, OR etc., implement LET,
SET and DEFINE or to add macros, introduce pseudo-lexical
bindings with FUNCTION or even change the whole evaluation
semantics to lazy (evaluate any value only when it is needed, as
opposed to the usual "eager" evaluation when all arguments are
evaluated at function call time) or maybe add support for some
infix notation; in short, create your own language.
--
Vlad http://vnestr.tripod.com/
Vladimir Nesterovsky <vne...@netvision.net.il> wrote in message
news:238739BFB3E9CC7E...@in.WebX.maYIadrTaRb...
The link looks like something I could share in my classes. I first learned recursion
with PL1 at VA Tech in the late 70's. That class was a real mind bender. Don't
think I'm up to replacing AutoLISP any time soon though. Interesting function.
Maybe when I get time to play....
Doug
"Vladimir Nesterovsky" <vne...@netvision.net.il> wrote in message
news:238739BFB3E9CC7E...@in.WebX.maYIadrTaRb...
> You can easily have full control over the evaluation model if you
> create your own lisp interpreter, as is so clearly and brilliantly
> shown in the classic Lisp paper by John MacCarthy, "Recursive
> Functions of Symbolic Expressions and Their Computation by Machine,
> Part I", http://www-formal.stanford.edu/jmc/recursive.html .
>
> <snip>
(setq *standard-environment*
;......
;......
(sqrt3 . (lambda (a x e)
(cond ((< (abs (- (* x x) a)) e) x)
(T (sqrt3 a (/ (+ x (/ a (float x))) 2)
e)))))
(sqrt . (lambda (a . xe)
(cond ((atom xe) (sqrt3 a (/ a 2.0) 0.00001))
((atom (cdr xe)) (sqrt3 a (car xe) 0.00001))
(T (sqrt3 a (car xe) (cadr xe))))))
;......
)
and then
(mlisp '(sqrt 25.5))
or
(mlisp '(sqrt 25.5 5))
or
(mlisp '(sqrt 25.5 5 0.00000001))
would all work.
The '(a . xe)' arguments list for sqrt's lambda definition
means that inside the function, 'a' is bound to the first
supplied argument, and 'xe' is the list of all the rest, or
an empty list (nil) if none were specified, which is made
possible by the specific version of the function 'pair'.
'Pair' could've checked the number of arguments and refuse
the function call on mismatch, like it's done in AutoLISP,
but it need not be that restrictive. It is actually simpler to write
it in the way that makes optional arguments possible.
--
Have fun, :-)
Vlad http://vnestr.tripod.com/
(define (list . args) args)
Doug Broad <dbr...@earthlink.net> wrote in message
news:848B70F375F68FC0...@in.WebX.maYIadrTaRb...
;;; sample to call a function with optional arguments
;;; and to simplify the intermediate binding.
(defun opttest (req opts)
;; test has one required arg and two optional which default to nil,
;; process the body with bindings for the optional args
(with-optional-args opts '(o1 o2) '(nil nil)
;; this should be eval'd (it really should be a macro!)
'(progn
(print (list req o1 o2))
(prin1)
)
)
)
; (if (not function) (setq function quote))
;;; define the helper
(defun with-optional-args (args names defaults body)
;; be sure that args is long enough for mapcar
(while (< (length args) (length names))
(setq args (append args '(()))))
(while (< (length defaults) (length names))
;; provide enough parens to impress novice hackers
(setq defaults (append defaults '(()))))
;; bind the list name symbols locally (not to pollute namespace
;; with o1 and o2)
;; we create dynamically a lambda with our local symbols.
;; if we had backquoting we could even read the form below :)
(apply (list 'lambda (cons '/ names)
;; set names to values of args
(list 'mapcar (list 'quote
'(lambda (arg name def)
(set name (if arg arg def))))
;; '(1 2) => (list 1 2))
(list 'quote args)
;; '(o1 o2) => (list o1 o2))
(list 'quote names)
(list 'quote defaults)
)
;; eval the body with the new local names (o1 and o2)
body
)
nil)
)
;;; to give you a clue, the lambda which binds the names should
;;; look like:
;|
'(LAMBDA (/ O1 O2)
(MAPCAR (QUOTE (LAMBDA (ARG NAME DEF)
(SET NAME (IF ARG ARG DEF))))
(QUOTE (1 2))
(QUOTE (O1 O2))
(QUOTE (nil nil))
)
(eval BODY)
)
and with backquoting it would look like:
`(LAMBDA (/ ,@names)
(MAPCAR '(LAMBDA (ARG NAME DEF)
(SET NAME (IF ARG ARG DEF))))
,args
,names
,defaults
)
,BODY
)
easier to read, isn't it?
Ralph Gimenez has a backquote in his SageCLOS and I have one also.
|;
(opttest 0 '(1)) ; => (0 1 nil)
o1
o2
(opttest 0 '(1 2)) ; => (0 1 2)
o1
o2
(opttest 0 '()) ; => (0 nil nil)
o1
o2
We don't really need it if we define (as it should've been done
in the first place)
(sqrt . (lambda (a x e)
(cond
(e (sqrt3 a x e))
(x (sqrt3 a x 0.00001))
(T (sqrt3 a (/ a 2.0) 0.00001)))))
which is much simpler and clearer and just lets the language itself
to take care of all the details of establishing the variables bindings.
With-opt-args macro isn't really needed for mlisp dialect, where
the bindings are established as a language feature -- there's no
need to do it explicitly. The whole point is not to be forced to write
> (opttest 0 '(1))
> (opttest 0 '(1 2))
> (opttest 0 '())
but rather to be able to call
(opt 0 1)
(opt 0 1 2)
(opt 0)
But if you have to simulate the opt-args calls under Autolisp, yes,
you'll have to use with-opt-args to assign them automatically
instead of manually "dissecting" the supplied arguments list.
I would write it a bit differently though. The standard way
to provide variable bindings (which also seems to be much
simpler then the embedded SET calls) is just to call
( (lambda (a1 a2 ...) body )
e1 e2 ... )
as a representation e.g. of a LET form (let ((a1 e1) ...) body)
in Scheme or CL. It is usually defined as
let-expression = (let ( arg-bindings ) body )
arg-bindings = {arg | arg-binding}*
arg-binding = (arg) | (arg val)
arg = symbol
val = value
and is represented by the following code transofmation:
`( (lambda ,(let-vars (cadr let-expression)) body )
,@(let-values (cadr let-expression)) )
where the two functions are defined as
(defun let-vars (e)
(mapcar '(lambda(x) (if (listp x) (car x) x)) e))
(defun let-values (e)
(mapcar '(lambda(x) (if (listp x) (cadr x))) e))
Or maybe the better example would be a kind of binding
provided by destructuring-bind in CL. We don't really need
destructuring so badly (or it may be the next exercise maybe),
but it would look better IMHO if called as
(with-opt-args ((o1) o2 (o3 'def-val)) supplied-list
body )
so the code transform is
(with-opt-args vars vals body) ==>
`( apply '(lambda ,(let-vars vars) ,body )
,@(defaults-values (let-values vars) vals) )
where
(defun defaults-values (defaults values)
;; autolisp version -- if value not supplied
;; the default will be used, evaluated
;; (since it's a part of bindings argument
;; that has to be quoted in autolisp).
(mapcar
'(lambda (d / v)
(if values ; supplied-p
(setq v (car values))
(setq v (eval d))) ; default
(setq values (cdr values))
v)
defaults ))
So, the final Autolisp version is simply
(defun with-opt-args ( bindings opts body )
(apply (list 'lambda (let-vars bindings) body)
(defaults-values (let-values bindings) opts)))
It can be called e.g. as
_$ (with-opt-args '(o1 o2) '(1)
'(progn
(print (list o1 o2))
(prin1)))
(1 nil)
_$
which is equivalent to
(apply '(lambda (o1 o2) (progn ... ))
(list 1 nil))
More examples:
_$ (with-opt-args '( a (b 1) (c 2) ) '(10 20) '(progn (+ a b c)))
32
_$
is like calling (apply '(lambda(a b c)(progn(+ a b c))) (list 10 20 2)),
and
_$ (setq x 8)
8
_$ (with-opt-args '( a (b 1) (c x) ) '(10 20) '(+ a b c))
38
_$
is like (apply '(lambda(a b c)(+ a b c)) (list 10 20 x))
_$ (with-opt-args '((a (print "X")) b (c (print (list 1 2 3)))) '((1) )
'(list a b c))
(1 2 3) ((1) nil (1 2 3))
_$
is (apply '(lambda(a b c) (list a b c))
(list '(1) nil (print (list 1 2 3))))
only the default value for 'c' variable is evaluated, since it's needed. The
value for 'a' variable is supplied, hence its default value isn't needed
and thus isn't evaluated (no "X" is printed).
Enjoy, :-)
--
Vlad http://vnestr.tripod.com/
(define (list . args) args)
LEsquivel <arch...@onebox.com> wrote in message
news:1A72C48FF0E49E9E...@in.WebX.maYIadrTaRb...
Luis