we have macros. OOOOOOFFF
This commit is contained in:
FelixBrendel
+160
-145
@@ -1,102 +1,117 @@
|
||||
(define defmacro
|
||||
(macro (@name @params :rest @body)
|
||||
"Macro for creating macros with a more concise syntax."
|
||||
(eval (pair 'define-upwards (pair @name (pair (pair 'macro (pair @params @body)) nil))))))
|
||||
(define-syntax when (condition :rest body)
|
||||
(list 'if condition (pair 'prog body) nil))
|
||||
|
||||
(define defun
|
||||
(macro (@name @params :rest @body)
|
||||
"Macro for creating functions with a more concise syntax."
|
||||
(eval (pair 'define-upwards (pair @name (pair (pair 'lambda (pair @params @body)) nil))))))
|
||||
(define-syntax unless (condition :rest body)
|
||||
(list 'if condition nil (pair 'prog body)))
|
||||
|
||||
;; (defun nil? (x)
|
||||
;; "Checks if the argument is nil."
|
||||
;; (= x nil))
|
||||
(define-syntax defun (name arguments :rest body)
|
||||
;; (type-assert arguments :pair)
|
||||
;; `(define ,name (lambda ,arguments ,body))
|
||||
|
||||
;; (defun number? (x)
|
||||
;; "Checks if the argument is a number."
|
||||
;; (= (type x) :number))
|
||||
;; see if we have a docstring
|
||||
(if (and (= (type (first body)) :string) (not (= (type (rest body)) :nil)))
|
||||
(list 'define name (list 'lambda arguments (first body) (pair 'prog (rest body))))
|
||||
(list 'define name (list 'lambda arguments (pair 'prog body)))))
|
||||
|
||||
;; (defun symbol? (x)
|
||||
;; "Checks if the argument is a symbol."
|
||||
;; (= (type x) :symbol))
|
||||
(define-syntax defspecial (name arguments :rest body)
|
||||
;; (type-assert arguments :pair)
|
||||
;; `(define ,name (lambda ,arguments ,body))
|
||||
|
||||
;; (defun keyword? (x)
|
||||
;; "Checks if the argument is a keyword."
|
||||
;; (= (type x) :keyword))
|
||||
;; see if we have a docstring
|
||||
(if (and (= (type (first body)) :string) (not (= (type (rest body)) :nil)))
|
||||
(list 'define name (list 'special-lambda arguments (first body) (pair 'prog (rest body))))
|
||||
(list 'define name (list 'special-lambda arguments (pair 'prog body)))))
|
||||
|
||||
;; (defun pair? (x)
|
||||
;; "Checks if the argument is a pair."
|
||||
;; (= (type x) :pair))
|
||||
;; (cond
|
||||
;; (p1 v1)
|
||||
;; (p2 v2))
|
||||
(define-syntax cond (:rest clauses)
|
||||
(defun rec (clauses)
|
||||
(if (= nil clauses)
|
||||
nil
|
||||
(list 'if (first (first clauses))
|
||||
(pair 'prog (rest (first clauses)))
|
||||
(rec (rest clauses)))))
|
||||
(rec clauses))
|
||||
|
||||
;; (defun string? (x)
|
||||
;; "Checks if the argument is a string."
|
||||
;; (= (type x) :string))
|
||||
(defun nil? (x)
|
||||
"Checks if the argument is nil."
|
||||
(= x nil))
|
||||
|
||||
;; (defun dynamic-function? (x)
|
||||
;; "Checks if the argument is a function."
|
||||
;; (= (type x) :dynamic-function))
|
||||
(defun number? (x)
|
||||
"Checks if the argument is a number."
|
||||
(= (type x) :number))
|
||||
|
||||
;; (defun dynamic-macro? (x)
|
||||
;; "Checks if the argument is a macro."
|
||||
;; (= (type x) :dynamic-macro))
|
||||
(defun symbol? (x)
|
||||
"Checks if the argument is a symbol."
|
||||
(= (type x) :symbol))
|
||||
|
||||
;; (defun built-in-function? (x)
|
||||
;; "Checks if the argument is a built-in function."
|
||||
;; (= (type x) :built-in-function))
|
||||
(defun keyword? (x)
|
||||
"Checks if the argument is a keyword."
|
||||
(= (type x) :keyword))
|
||||
|
||||
;; (defun apply (fun seq)
|
||||
;; "Applies the funciton to the sequence, as in calls the function
|
||||
;; with ithe sequence as arguemens."
|
||||
;; (eval (pair fun seq)))
|
||||
(defun pair? (x)
|
||||
"Checks if the argument is a pair."
|
||||
(or (= (type x) :pair) (= (type x) :nil)))
|
||||
|
||||
;; (defmacro when (@test :rest @body)
|
||||
;; "Executes the code in :rest if test is true."
|
||||
;; (if (eval @test)
|
||||
;; (eval (pair prog @body))
|
||||
;; nil))
|
||||
(defun string? (x)
|
||||
"Checks if the argument is a string."
|
||||
(= (type x) :string))
|
||||
|
||||
;; (defmacro unless (@test :rest @body)
|
||||
;; "Executes the code in :rest if test is false."
|
||||
;; (if (eval @test)
|
||||
;; nil
|
||||
;; (eval (pair prog @body))))
|
||||
(defun lambda? (x)
|
||||
"Checks if the argument is a function."
|
||||
(= (type x) :dynamic-function))
|
||||
|
||||
;; (defun end (seq)
|
||||
;; "Returns the last pair in the sqeuence."
|
||||
;; (if (or (nil? seq) (not (pair? (rest seq))))
|
||||
;; seq
|
||||
;; (end (rest seq))))
|
||||
(defun special-lambda? (x)
|
||||
"Checks if the argument is a macro."
|
||||
(= (type x) :dynamic-macro))
|
||||
|
||||
;; (defun last (seq)
|
||||
;; "Returns the (first) of the last (pair) of the given sequence."
|
||||
;; (first (end seq)))
|
||||
(defun built-in-function? (x)
|
||||
"Checks if the argument is a built-in function."
|
||||
(= (type x) :built-in-function))
|
||||
|
||||
;; (defun extend (seq elem)
|
||||
;; "Extends a list with the given element, by putting it in
|
||||
;; the (rest) of the last element of the sequence."
|
||||
;; (when (pair? seq)
|
||||
;; (define e (end seq))
|
||||
;; (mutate e (pair (first e) elem)))
|
||||
;; seq)
|
||||
(defun apply (fun seq)
|
||||
"Applies the funciton to the sequence, as in calls the function
|
||||
with ithe sequence as arguemens."
|
||||
(eval (pair fun seq)))
|
||||
|
||||
;; (defun incr (val)
|
||||
;; "Adds one to the argument."
|
||||
;; (+ val 1))
|
||||
(defun end (seq)
|
||||
"Returns the last pair in the sqeuence."
|
||||
(if (or (nil? seq) (not (pair? (rest seq))))
|
||||
seq
|
||||
(end (rest seq))))
|
||||
|
||||
;; (defun decr (val)
|
||||
;; "Subtracts one from the argument."
|
||||
;; (- val 1))
|
||||
(defun last (seq)
|
||||
"Returns the (first) of the last (pair) of the given sequence."
|
||||
(first (end seq)))
|
||||
|
||||
;; (defun append (seq elem)
|
||||
;; "Appends an element to a sequence, by extendeing the list
|
||||
;; with (pair elem nil)."
|
||||
;; (extend seq (pair elem nil)))
|
||||
(defun extend (seq elem)
|
||||
"Extends a list with the given element, by putting it in
|
||||
the (rest) of the last element of the sequence."
|
||||
(when (pair? seq)
|
||||
(define e (end seq))
|
||||
(mutate e (pair (first e) elem)))
|
||||
seq)
|
||||
|
||||
(defun append (seq elem)
|
||||
"Appends an element to a sequence, by extendeing the list
|
||||
with (pair elem nil)."
|
||||
(extend seq (pair elem nil)))
|
||||
|
||||
(defun length (seq)
|
||||
"Returns the length of the given sequence."
|
||||
(if (nil? seq)
|
||||
0
|
||||
(incr (length (rest seq)))))
|
||||
|
||||
(defun increment (val)
|
||||
"Adds one to the argument."
|
||||
(+ val 1))
|
||||
|
||||
(defun decrement (val)
|
||||
"Subtracts one from the argument."
|
||||
(- val 1))
|
||||
|
||||
;; (defun length (seq)
|
||||
;; "Returns the length of the given sequence."
|
||||
;; (if (nil? seq)
|
||||
;; 0
|
||||
;; (incr (length (rest seq)))))
|
||||
|
||||
;; (defmacro n-times (@times @action)
|
||||
;; "Executes @action @times times."
|
||||
@@ -119,79 +134,79 @@
|
||||
;; (eval (pair prog @for-body))
|
||||
;; (eval (extend (list for @symbol (@op @from) @to) @for-body))))
|
||||
|
||||
;; (defun range (:keys from :defaults-to 0 to)
|
||||
;; "Returns a sequence of numbers starting with the number defined
|
||||
;; by the key 'from' and ends with the number defined in 'to'."
|
||||
;; (when (< from to)
|
||||
;; (pair from (range :from (+ 1 from) :to to))))
|
||||
(defun range (:keys from :defaults-to 0 to)
|
||||
"Returns a sequence of numbers starting with the number defined
|
||||
by the key 'from' and ends with the number defined in 'to'."
|
||||
(when (< from to)
|
||||
(pair from (range :from (+ 1 from) :to to))))
|
||||
|
||||
;; (defun range-while (:keys from :defaults-to 0 to)
|
||||
;; "Returns a sequence of numbers starting with the number defined
|
||||
;; by the key 'from' and ends with the number defined in 'to'."
|
||||
;; (define result (list (copy from)))
|
||||
;; (define head result)
|
||||
;; (mutate from (incr from))
|
||||
;; (while (< from to)
|
||||
;; (prog
|
||||
;; (mutate head (pair (first head) (pair (copy from) nil)))
|
||||
;; (define head (rest head))
|
||||
;; (mutate from (incr from))))
|
||||
;; result)
|
||||
(defun range-while (:keys from :defaults-to 0 to)
|
||||
"Returns a sequence of numbers starting with the number defined
|
||||
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)
|
||||
(prog
|
||||
(mutate head (pair (first head) (pair (copy from) nil)))
|
||||
(define head (rest head))
|
||||
(mutate from (increment from))))
|
||||
result)
|
||||
|
||||
;; (defun map (fun seq)
|
||||
;; "Takes a function and a sequence as arguments and returns a new
|
||||
;; sequence which contains the results of using the first sequences
|
||||
;; elemens as argument to that function."
|
||||
;; (if (nil? seq)
|
||||
;; seq
|
||||
;; (pair (fun (first seq))
|
||||
;; (map fun (rest seq)))))
|
||||
(defun map (fun seq)
|
||||
"Takes a function and a sequence as arguments and returns a new
|
||||
sequence which contains the results of using the first sequences
|
||||
elemens as argument to that function."
|
||||
(if (nil? seq)
|
||||
seq
|
||||
(pair (fun (first seq))
|
||||
(map fun (rest seq)))))
|
||||
|
||||
;; (defun reduce (fun seq)
|
||||
;; "Takes a function and a sequence as arguments and applies the
|
||||
;; function to the argument sequence. This only works correctly if
|
||||
;; the given function accepts a variable amount of parameters. If
|
||||
;; your funciton is limited to two arguments, use `reduce-binary'
|
||||
;; instead."
|
||||
;; (apply fun seq))
|
||||
(defun reduce (fun seq)
|
||||
"Takes a function and a sequence as arguments and applies the
|
||||
function to the argument sequence. This only works correctly if
|
||||
the given function accepts a variable amount of parameters. If
|
||||
your funciton is limited to two arguments, use `reduce-binary'
|
||||
instead."
|
||||
(apply fun seq))
|
||||
|
||||
;; (defun reduce-binary (fun seq)
|
||||
;; "Takes a function and a sequence as arguments and applies the
|
||||
;; function to the argument sequence. reduce-binary applies the
|
||||
;; arguments `pair-wise' which means it works with binary functions
|
||||
;; as compared to `reduce'."
|
||||
;; (if (nil? (rest seq))
|
||||
;; (first seq)
|
||||
;; (fun (first seq)
|
||||
;; (reduce-binary fun (rest seq)))))
|
||||
(defun reduce-binary (fun seq)
|
||||
"Takes a function and a sequence as arguments and applies the
|
||||
function to the argument sequence. reduce-binary applies the
|
||||
arguments `pair-wise' which means it works with binary functions
|
||||
as compared to `reduce'."
|
||||
(if (nil? (rest seq))
|
||||
(first seq)
|
||||
(fun (first seq)
|
||||
(reduce-binary fun (rest seq)))))
|
||||
|
||||
;; (defun filter (fun seq)
|
||||
;; "Takes a function and a sequence as arguments and applies the
|
||||
;; function to every value in the sequence. If the result of that
|
||||
;; funciton application returns a truthy value, the original value is
|
||||
;; added to a list, which in the end is returned."
|
||||
;; (when seq
|
||||
;; (if (fun (first seq))
|
||||
;; (pair (first seq)
|
||||
;; (filter fun (rest seq)))
|
||||
;; (filter fun (rest seq)))))
|
||||
(defun filter (fun seq)
|
||||
"Takes a function and a sequence as arguments and applies the
|
||||
function to every value in the sequence. If the result of that
|
||||
funciton application returns a truthy value, the original value is
|
||||
added to a list, which in the end is returned."
|
||||
(when seq
|
||||
(if (fun (first seq))
|
||||
(pair (first seq)
|
||||
(filter fun (rest seq)))
|
||||
(filter fun (rest seq)))))
|
||||
|
||||
;; (defun printf (:keys sep :defaults-to " " end :defaults-to "\n" :rest args)
|
||||
;; "A wrapper for the built-in (print) that accepts a variable number
|
||||
;; of arguments and also provides keywords for specifying the printed
|
||||
;; separators between the arguments and what should be printed after the
|
||||
;; las argument."
|
||||
;; (defmacro printf-quoted (:keys @sep @end :rest @args)
|
||||
;; (if (nil? @args)
|
||||
;; (prog (print (eval @end)) nil)
|
||||
;; (prog
|
||||
;; (print (first @args))
|
||||
;; (unless (nil? (rest @args))
|
||||
;; (print (eval @sep)))
|
||||
;; (eval (pair printf-quoted
|
||||
;; (extend (list :@sep (eval @sep) :@end (eval @end)) (rest @args)))))))
|
||||
(defun printf (:keys sep :defaults-to " " end :defaults-to "\n" :rest args)
|
||||
"A wrapper for the built-in (print) that accepts a variable number
|
||||
of arguments and also provides keywords for specifying the printed
|
||||
separators between the arguments and what should be printed after the
|
||||
las argument."
|
||||
(defspecial printf-quoted (:keys @sep @end :rest @args)
|
||||
(if (nil? @args)
|
||||
(prog (print (eval @end)) nil)
|
||||
(prog
|
||||
(print (first @args))
|
||||
(unless (nil? (rest @args))
|
||||
(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))))
|
||||
(eval (pair printf-quoted (extend (list :@sep (eval sep) :@end (eval end)) args))))
|
||||
|
||||
;; (defmacro pe (@expr)
|
||||
;; (printf @expr "evaluates to" (eval @expr)))
|
||||
|
||||
+72
-21
@@ -1,29 +1,80 @@
|
||||
;; (define-syntax defclass (name members :rest functions)
|
||||
;; (list 'defun (string->symbol (concat-strings "make-" (symbol->string name)))
|
||||
|
||||
(defun make-vector (x y z)
|
||||
(let ((local-x x)
|
||||
(local-y y)
|
||||
(local-z z)
|
||||
(defun (macro (@name @params :rest @body)
|
||||
(eval (pair 'define-upwards (pair @name (pair (pair 'lambda (pair @params @body)) nil)))))))
|
||||
|
||||
(defun set-x (new-x) (mutate local-x new-x))
|
||||
(defun set-y (new-y) (mutate local-y new-y))
|
||||
(defun set-z (new-z) (mutate local-z new-z))
|
||||
;; ))
|
||||
|
||||
(defun dispatch (message)
|
||||
(if (= message ::get-x)
|
||||
local-x
|
||||
(if (= message ::set-x)
|
||||
set-x
|
||||
nil)))
|
||||
;; (defclass vector3 (x y z)
|
||||
;; ;; getters and setters will be auto generated
|
||||
|
||||
(break)
|
||||
dispatch))
|
||||
;; (defun ->length ()
|
||||
;; (** (+ (* x x) (* y y) (* z z)) 0.5))
|
||||
|
||||
(define v (make-vector 1 2 3))
|
||||
;; (defun ->scale (fac)
|
||||
;; (mutate x (* fac x))
|
||||
;; (mutate y (* fac y))
|
||||
;; (mutate z (* fac z)))
|
||||
|
||||
(print (v ::get-x))
|
||||
((v ::set-x) 19)
|
||||
(print (v ::get-x))
|
||||
;; )
|
||||
|
||||
(defun make-vector3 (x-coord y-coord z-coord)
|
||||
(let ((x x-coord)
|
||||
(y y-coord)
|
||||
(z z-coord))
|
||||
|
||||
(defun ->get-x () x)
|
||||
(defun ->get-y () y)
|
||||
(defun ->get-z () z)
|
||||
(defun ->set-x (new-x) (mutate x new-x))
|
||||
(defun ->set-y (new-y) (mutate y new-y))
|
||||
(defun ->set-z (new-z) (mutate z new-z))
|
||||
|
||||
(defun ->length ()
|
||||
(** (+ (* x x) (* y y) (* z z)) 0.5))
|
||||
|
||||
(defun ->scale (fac)
|
||||
(mutate x (* fac x))
|
||||
(mutate y (* fac y))
|
||||
(mutate z (* fac z)))
|
||||
|
||||
(defun ->print ()
|
||||
(print "[vector3] (")
|
||||
(print x)
|
||||
(print " ")
|
||||
(print y)
|
||||
(print " ")
|
||||
(print z)
|
||||
(print ")\n"))
|
||||
|
||||
(defun ->+ (other)
|
||||
(make-vector
|
||||
(+ x ((other ->get-x)))
|
||||
(+ y ((other ->get-y)))
|
||||
(+ z ((other ->get-z)))))
|
||||
|
||||
(defun ->- (other)
|
||||
(make-vector
|
||||
(- x ((other ->get-x)))
|
||||
(- y ((other ->get-y)))
|
||||
(- z ((other ->get-z)))))
|
||||
|
||||
(defun ->scalar-product (other)
|
||||
(+ (* x ((other ->get-x)))
|
||||
(* y ((other ->get-y)))
|
||||
(* z ((other ->get-z)))))
|
||||
|
||||
(defun ->cross-product (other)
|
||||
(make-vector
|
||||
(- (* y ((other ->get-z))) (* z ((other ->get-y))))
|
||||
(- (* z ((other ->get-x))) (* x ((other ->get-z))))
|
||||
(- (* x ((other ->get-y))) (* y ((other ->get-x))))))
|
||||
|
||||
(special-lambda (message) (eval message))))
|
||||
|
||||
(define v1 (make-vector3 1 2 3))
|
||||
(define v2 (make-vector3 3 2 1))
|
||||
|
||||
(print ((v1 ->length)))
|
||||
(print ((v2 ->length)))
|
||||
|
||||
(read " ")
|
||||
|
||||
Reference in New Issue
Block a user