You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

81 lines
5.1 KiB

  1. (show do-list)
  2. (define (nil? x) "Checks if the argument is nil." (= x nil))
  3. (define (number? x) "Checks if the argument is a number." (= (type x) :number))
  4. (define (symbol? x) "Checks if the argument is a symbol." (= (type x) :symbol))
  5. (define (keyword? x) "Checks if the argument is a keyword." (= (type x) :keyword))
  6. (define (pair? x) "Checks if the argument is a pair." (= (type x) :pair))
  7. (define (string? x) "Checks if the argument is a string." (= (type x) :string))
  8. (define (lambda? x) "Checks if the argument is a function." (= (type x) :dynamic-function))
  9. (define (special-lambda? x) "Checks if the argument is a macro." (= (type x) :dynamic-macro))
  10. (define (built-n-function? x) "Checks if the argument is a built-in function." (= (type x) :built-in-function))
  11. (define (apply fun seq) "Applies the funciton to the sequence, as in calls the function with
  12. ithe sequence as arguemens." (eval (pair fun seq)))
  13. (define (end seq) "Returns the last pair in the sqeuence." (if (or (nil? seq) (not (pair? (rest seq)))) seq (end (rest seq))))
  14. (define (last seq) "Returns the (first) of the last (pair) of the given sequence." (first (end seq)))
  15. (define (extend seq elem) "Extends a list with the given element, by putting it in
  16. the (rest) of the last element of the sequence." (if (pair? seq) (begin (define e (end seq)) (mutate e (pair (first e) elem)) seq) elem))
  17. (define (extend2 seq elem) "Extends a list with the given element, by putting it in
  18. the (rest) of the last element of the sequence." (printf "addr of (end seq)" (addr-of (end seq))) (if (pair? seq) ((lambda (e) (begin (printf "addr if e inner" (addr-of e)) (mutate e (pair (first e) elem)) seq)) (end seq))) elem)
  19. (define (append seq elem) "Appends an element to a sequence, by extendeing the list
  20. with (pair elem nil)." (extend seq (pair elem ())))
  21. (define (length seq) "Returns the length of the given sequence." (if (nil? seq) 0 (+ 1 (length (rest seq)))))
  22. (define (increment val) "Adds one to the argument." (+ val 1))
  23. (define (decrement val) "Subtracts one from the argument." (- val 1))
  24. (define (range :keys from :defaults-to 0 to) "Returns a sequence of numbers starting with the number defined
  25. by the key 'from' and ends with the number defined in 'to'." (if (< from to) ([C-function] (pair from (range :from (+ 1 from) :to to))) nil))
  26. (define (range-while :keys from :defaults-to 0 to) "Returns a sequence of numbers starting with the number defined
  27. by the key 'from' and ends with the number defined in 'to'." (define result (list (copy from))) (define head result) (mutate from (increment from)) (while (< from to) (begin (mutate head (pair (first head) (pair (copy from) nil))) (define head (rest head)) (mutate from (increment from)))) result)
  28. (define (map fun seq) "Takes a function and a sequence as arguments and returns a new
  29. sequence which contains the results of using the first sequences
  30. elemens as argument to that function." (if (nil? seq) seq (pair (fun (first seq)) (map fun (rest seq)))))
  31. (define (reduce fun seq) "Takes a function and a sequence as arguments and applies the
  32. function to the argument sequence. This only works correctly if
  33. the given function accepts a variable amount of parameters. If
  34. your funciton is limited to two arguments, use `reduce-binary'
  35. instead." (apply fun seq))
  36. (define (reduce-binary fun seq) "Takes a function and a sequence as arguments and applies the
  37. function to the argument sequence. reduce-binary applies the
  38. arguments `pair-wise' which means it works with binary functions
  39. as compared to `reduce'." (if (nil? (rest seq)) (first seq) (fun (first seq) (reduce-binary fun (rest seq)))))
  40. (define (filter fun seq) "Takes a function and a sequence as arguments and applies the
  41. function to every value in the sequence. If the result of that
  42. funciton application returns a truthy value, the original value is
  43. added to a list, which in the end is returned." (if seq ([C-function] (if (fun (first seq)) (pair (first seq) (filter fun (rest seq))) (filter fun (rest seq)))) nil))
  44. (define (zip l1 l2) (if (and (nil? l1) (nil? l2)) nil ([C-function] (pair (list (first l1) (first l2)) (zip (rest l1) (rest l2))))))
  45. (define (unzip lists) (if lists ([C-function] (define (iter lists l1 l2) (define elem (first lists)) (if elem (iter (rest lists) (pair (first elem) l1) (pair (first (rest elem)) l2)) (list l1 l2)))) nil) (iter lists () ()))
  46. (define (enumerate seq) (define (enumerate-inner seq next-num) (if seq ([C-function] (pair (list (first seq) next-num) (enumerate-inner (rest seq) (+ 1 next-num)))) nil)) (enumerate-inner seq 0))
  47. (define (printf :keys sep :defaults-to " " end :defaults-to "
  48. " :rest args) "A wrapper for the built-in (print) that accepts a variable number
  49. of arguments and also provides keywords for specifying the printed
  50. separators between the arguments and what should be printed after the
  51. las argument." (define printf-quoted (special-lambda (:keys @sep @end :rest @args) (if (nil? @args) (begin (print (eval @end)) nil) (begin (print (first @args)) (if (nil? (rest @args)) nil ([C-function] (print (eval @sep)))) (eval (pair printf-quoted (extend (list :@sep (eval @sep) :@end (eval @end)) (rest @args)))))))) (eval (pair printf-quoted (extend (list :@sep (eval sep) :@end (eval end)) args))))