add equal?, member, for-each.
This commit is contained in:
parent
59cdf9632f
commit
bba631edcd
16
TODO
16
TODO
|
@ -12,8 +12,6 @@
|
|||
** run PEG
|
||||
** parse C using PEG
|
||||
http://piumarta.com/software/peg/
|
||||
** missing
|
||||
member (using equal?)
|
||||
** implement core primitives: DONE
|
||||
begin
|
||||
define
|
||||
|
@ -29,7 +27,7 @@ v #(v e c t o r)
|
|||
v assq
|
||||
v call-with-values
|
||||
v char?
|
||||
for-each
|
||||
v for-each
|
||||
v length
|
||||
v list
|
||||
v list->vector
|
||||
|
@ -48,12 +46,16 @@ v vector-ref
|
|||
v vector-set!
|
||||
v vector?
|
||||
v procedure?
|
||||
*** any, each?
|
||||
*** hook-up sc-expand, see guile-1.0?: scheme:eval-transformer
|
||||
*** implement extras:
|
||||
v (gensym)
|
||||
** implement minimal needed for define-macro-based define-syntax
|
||||
v char?
|
||||
v assq
|
||||
v define-macro
|
||||
equal?
|
||||
member
|
||||
v equal?
|
||||
v member
|
||||
v let loop
|
||||
v nested define-macro
|
||||
v nested define
|
||||
|
@ -64,7 +66,3 @@ v string->symbol
|
|||
v and
|
||||
v or
|
||||
v ,@ unquote-splicing
|
||||
** any, each?
|
||||
** implement extras:
|
||||
v (gensym)
|
||||
** hook-up sc-expand, see guile-1.0?: scheme:eval-transformer
|
||||
|
|
17
scm.mes
17
scm.mes
|
@ -26,6 +26,13 @@
|
|||
(define-macro (begin . rest)
|
||||
`((lambda () ,@rest)))
|
||||
|
||||
(define (equal? a b) ;; FIXME: only 2 arg
|
||||
(cond ((and (null? a) (null? b)) #t)
|
||||
((and (pair? a) (pair? b))
|
||||
(and (equal? (car a) (car b))
|
||||
(equal? (cdr a) (cdr b))))
|
||||
(#t (eq? a b))))
|
||||
|
||||
(define (vector . rest) (list->vector rest))
|
||||
|
||||
(define (apply f args)
|
||||
|
@ -46,6 +53,11 @@
|
|||
(#t (memq x (cdr lst)))))
|
||||
(define memv memq)
|
||||
|
||||
(define (member x lst)
|
||||
(cond ((null? lst) #f)
|
||||
((equal? x (car lst)) lst)
|
||||
(#t (member x (cdr lst)))))
|
||||
|
||||
(define-macro (or2 x y)
|
||||
`(cond (,x ,x) (#t ,y)))
|
||||
|
||||
|
@ -105,6 +117,11 @@
|
|||
((null? (cdr r))
|
||||
(cons (f (car l) (caar r)) (map f (cdr l) (cdar r))))))
|
||||
|
||||
(define (identity x) x)
|
||||
(define (for-each f l . r)
|
||||
(apply map (cons f (cons l r)))
|
||||
*unspecified*)
|
||||
|
||||
(define (not x)
|
||||
(cond (x #f)
|
||||
(#t #t)))
|
||||
|
|
17
syntax.mes
17
syntax.mes
|
@ -7,23 +7,6 @@
|
|||
;;(display thing)
|
||||
(newline))
|
||||
|
||||
(define (member x lst)
|
||||
(display "MEMBER x=") (display x)
|
||||
(display " lst=") (display lst)
|
||||
(display " => ") (display (memq x lst))
|
||||
(newline)
|
||||
(memq x lst))
|
||||
(display "mes:define-syntax...")
|
||||
|
||||
(define (equal? a b) ;; FIXME: only 2 arg + broken for lists
|
||||
(display "EQUAL? a=") (display a)
|
||||
(display " b=") (display b) (newline)
|
||||
;;(eq? a b)
|
||||
(cond ((and (null? a) (null? b)) #t)
|
||||
((and (pair? a) (pair? b))
|
||||
(and (equal? (car a) (car b))
|
||||
(equal? (cdr a) (cdr b))))
|
||||
(#t (eq? a b))))
|
||||
(display "mes:define-syntax...")
|
||||
|
||||
;;(define (caddr x) (car (cdr (cdr x))))
|
||||
|
|
Loading…
Reference in a new issue