Permalink
Browse files

add some stdlib and stdlib todo

  • Loading branch information...
1 parent d97bf7c commit 619d61cd9b00178ce055d3307ae1669643ab0dc9 @tianyicui committed Oct 3, 2012
Showing with 81 additions and 11 deletions.
  1. +0 −4 lib/prim_func.ml
  2. +1 −1 lib/repl.ml
  3. +74 −3 lib/stdlib.scm
  4. +0 −3 tests/prim_func_test.ml
  5. +6 −0 tests/stdlib_test.ml
View
@@ -125,9 +125,6 @@ let cons hd tl =
| _, Sexp (DottedList (xs, x)) -> dotted_list (hd :: xs) x
| _ -> dotted_list [hd] tl
;;
-let list_func param =
- list_ param
-;;
let force value =
Promise.force (unpack_promise value)
@@ -307,7 +304,6 @@ let prim_functions =
"car", unary_op car;
"cdr", unary_op cdr;
"cons", binary_op cons;
- "list", list_func;
"force", unary_op force;
View
@@ -56,6 +56,6 @@ let repl conf =
in
if final_exn <> Normal_exit then
(if conf.print_exn then
- prerr_endline(Print.print_exn final_exn);
+ prerr_endline (Print.print_exn final_exn);
raise final_exn)
;;
View
@@ -1,15 +1,82 @@
+(define (caar x) (car (car x)))
+(define (cadr x) (car (cdr x)))
+(define (cdar x) (cdr (car x)))
+(define (cddr x) (cdr (cdr x)))
+(define (caaar x) (car (car (car x))))
+(define (caadr x) (car (car (cdr x))))
+(define (cadar x) (car (cdr (car x))))
+(define (caddr x) (car (cdr (cdr x))))
+(define (cdaar x) (cdr (car (car x))))
+(define (cdadr x) (cdr (car (cdr x))))
+(define (cddar x) (cdr (cdr (car x))))
+(define (cdddr x) (cdr (cdr (cdr x))))
+(define (caaaar x) (car (car (car (car x)))))
+(define (caaadr x) (car (car (car (cdr x)))))
+(define (caadar x) (car (car (cdr (car x)))))
+(define (caaddr x) (car (car (cdr (cdr x)))))
+(define (cadaar x) (car (cdr (car (car x)))))
+(define (cadadr x) (car (cdr (car (cdr x)))))
+(define (caddar x) (car (cdr (cdr (car x)))))
+(define (cadddr x) (car (cdr (cdr (cdr x)))))
+(define (cdaaar x) (cdr (car (car (car x)))))
+(define (cdaadr x) (cdr (car (car (cdr x)))))
+(define (cdadar x) (cdr (car (cdr (car x)))))
+(define (cdaddr x) (cdr (car (cdr (cdr x)))))
+(define (cddaar x) (cdr (cdr (car (car x)))))
+(define (cddadr x) (cdr (cdr (car (cdr x)))))
+(define (cdddar x) (cdr (cdr (cdr (car x)))))
+(define (cddddr x) (cdr (cdr (cdr (cdr x)))))
+
(define (not x) (if x #f #t))
(define (null? obj) (if (eqv? obj '()) #t #f))
(define (list . objs) objs)
+
(define (id obj) obj)
(define (flip func) (lambda (arg1 arg2) (func arg2 arg1)))
(define (curry func arg1) (lambda (arg) (apply func (cons arg1 (list arg)))))
(define (compose f g) (lambda (arg) (f (apply g arg))))
+
+; TODO: quatient, remainder, modulo
+(define remainder %)
+(define quotient /)
(define zero? (curry = 0))
(define positive? (curry < 0))
(define negative? (curry > 0))
(define (even? num) (= (% num 2) 0))
-(define (odd? num) (not (odd? num)))
+(define (odd? num) (not (even? num)))
+(define (abs num) (if (negative? num) (- num) num))
+; from tinyscheme
+(define gcd
+ (lambda a
+ (if (null? a)
+ 0
+ (let ((aa (abs (car a)))
+ (bb (abs (cadr a))))
+ (if (= bb 0)
+ aa
+ (gcd bb (% aa bb)))))))
+; from tinyscheme
+(define lcm
+ (lambda a
+ (if (null? a)
+ 1
+ (let ((aa (abs (car a)))
+ (bb (abs (cadr a))))
+ (if (or (= aa 0) (= bb 0))
+ 0
+ (abs (* (quotient aa (gcd aa bb)) bb)))))))
+; TODO: number->string, string->number
+
+; TODO: set-car!, set-cdr!
+; TODO: append
+; from tinyscheme
+(define (list-tail x k)
+ (if (zero? k)
+ x
+ (list-tail (cdr x) (- k 1))))
+; from tinyscheme
+(define (list-ref x k)
+ (car (list-tail x k)))
(define (foldr func end lst)
(if (null? lst)
end
@@ -27,8 +94,8 @@
(define (sum . lst) (fold + 0 lst))
(define (product . lst) (fold * 1 lst))
; should be implemented as macro for short-circuit
-; (define (and . lst) (fold && #t lst))
-; (define (or . lst) (fold || #f lst))
+(define (and . lst) (fold && #t lst))
+(define (or . lst) (fold || #f lst))
(define (max first . rest) (fold (lambda (old new) (if (> old new) old new)) first rest))
(define (min first . rest) (fold (lambda (old new) (if (< old new) old new)) first rest))
(define (length lst) (fold (lambda (x y) (+ x 1)) 0 lst))
@@ -40,5 +107,9 @@
(define (assq obj alist) (fold (mem-helper (curry eq? obj) car) #f alist))
(define (assv obj alist) (fold (mem-helper (curry eqv? obj) car) #f alist))
(define (assoc obj alist) (fold (mem-helper (curry equal? obj) car) #f alist))
+; TODO map can have multiple args
(define (map func lst) (foldr (lambda (x y) (cons (func x) y)) '() lst))
+; TODO for-each
(define (filter pred lst) (foldr (lambda (x y) (if (pred x) (cons x y) y)) '() lst))
+
+; TODO string-length, string-ref, string-set!, string-ci=? and co, substring, string-append, string-copy, string-fill!
@@ -50,9 +50,6 @@ let _ =
test "(cons 'a '(b . c))" "(a b . c)";
test "(cons 'a 'b)" "(a . b)";
test "(cons '() '())" "(())";
- test "(list)" "()";
- test "(list 1 2 3)" "(1 2 3)";
- test "(list (+ 1 2) 3)" "(3 3)";
test "(eqv? 'a 'a)" "#t";
test "(eqv? 'a 'b)" "#f";
@@ -1,7 +1,13 @@
open Test
let _ =
+ test "(abs -4) (abs 0) (abs 3)" "4\n0\n3";
+ test "(list)" "()";
+ test "(list 1 2 3)" "(1 2 3)";
+ test "(list (+ 1 2) 3)" "(3 3)";
test "(map (curry + 2) '(1 2 3 4))" "(3 4 5 6)";
test "(filter even? '(1 2 3 4))" "(2 4)";
+ test "(gcd 32 -36) (gcd)" "4\n0";
+ test "(lcm 32 -36) (lcm)" "288\n1";
prerr_string "All passed!\n"

0 comments on commit 619d61c

Please sign in to comment.