X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Flisp%2Fao_lisp_const.lisp;h=37307a6877758938bb1f9258a701940770560c30;hb=2e58b6c380bc6440490c47650fbf11d45b3f2e72;hp=df277fce9b263e6a03b4ba086d1f2fd18d4ea646;hpb=b3b4731fcb89cb404433f37a7704a503567c43bd;p=fw%2Faltos diff --git a/src/lisp/ao_lisp_const.lisp b/src/lisp/ao_lisp_const.lisp index df277fce..37307a68 100644 --- a/src/lisp/ao_lisp_const.lisp +++ b/src/lisp/ao_lisp_const.lisp @@ -23,17 +23,17 @@ ; having lots of output generated ; -(setq def (macro (name val rest) - (list - 'progn - (list - 'set - (list 'quote name) - val) - (list 'quote name) - ) - ) - ) +(set (quote define) (macro (name val rest) + (list + 'progn + (list + 'set + (list 'quote name) + val) + (list 'quote name) + ) + ) + ) ; ; A slightly more convenient form @@ -42,9 +42,9 @@ ; (defun () s-exprs) ; -(def defun (macro (name args exprs) +(define defun (macro (name args exprs) (list - def + define name (cons 'lambda (cons args exprs)) ) @@ -69,6 +69,28 @@ (defun 1+ (x) (+ x 1)) (defun 1- (x) (- x 1)) +(define if (macro (test args) + (cond ((null? (cdr args)) + (list + cond + (list test (car args))) + ) + (else + (list + cond + (list test (car args)) + (list 'else (cadr args)) + ) + ) + ) + ) + ) + +(if (> 3 2) 'yes) +(if (> 3 2) 'yes 'no) +(if (> 2 3) 'no 'yes) +(if (> 2 3) 'no) + ; define a set of local ; variables and then evaluate ; a list of sexprs @@ -85,16 +107,16 @@ ; ; e.g. ; - ; (let ((x 1) (y)) (setq y (+ x 1)) y) + ; (let ((x 1) (y)) (set! y (+ x 1)) y) -(def let (macro (vars exprs) +(define let (macro (vars exprs) ((lambda (make-names make-exprs make-nils) ; ; make the list of names in the let ; - (setq make-names (lambda (vars) + (set! make-names (lambda (vars) (cond ((not (null? vars)) (cons (car (car vars)) (make-names (cdr vars)))) @@ -107,7 +129,7 @@ ; pre-pended to the ; expressions to evaluate - (setq make-exprs (lambda (vars exprs) + (set! make-exprs (lambda (vars exprs) (cond ((not (null? vars)) (cons (list set (list quote @@ -126,7 +148,7 @@ ; the parameters to the lambda is a list ; of nils of the right length - (setq make-nils (lambda (vars) + (set! make-nils (lambda (vars) (cond ((not (null? vars)) (cons () (make-nils (cdr vars)))) ) ) @@ -134,7 +156,7 @@ ; prepend the set operations ; to the expressions - (setq exprs (make-exprs vars exprs)) + (set! exprs (make-exprs vars exprs)) ; build the lambda. @@ -153,11 +175,11 @@ ; boolean operators -(def or (lexpr (l) +(define or (lexpr (l) (let ((ret #f)) (while (not (null? l)) - (cond ((car l) (setq ret #t) (setq l ())) - ((setq l (cdr l))))) + (cond ((car l) (set! ret #t) (set! l ())) + ((set! l (cdr l))))) ret ) ) @@ -167,14 +189,14 @@ (or #f #t) -(def and (lexpr (l) +(define and (lexpr (l) (let ((ret #t)) (while (not (null? l)) (cond ((car l) - (setq l (cdr l))) + (set! l (cdr l))) (#t - (setq ret #f) - (setq l ())) + (set! ret #f) + (set! l ())) ) ) ret @@ -185,3 +207,16 @@ ; execute to resolve macros (and #t #f) + +(defun equal? (a b) + (cond ((eq? a b) #t) + ((and (pair? a) (pair? b)) + (and (equal? (car a) (car b)) + (equal? (cdr a) (cdr b))) + ) + (else #f) + ) + ) + +(equal? '(a b c) '(a b c)) +(equal? '(a b c) '(a b b))