Before implementing import name resolution, then after fic macro imports
This commit is contained in:
@@ -0,0 +1 @@
|
|||||||
|
(define-syntax (e x) x)
|
||||||
@@ -0,0 +1,3 @@
|
|||||||
|
(import "a.slime")
|
||||||
|
|
||||||
|
(printf (e 2))
|
||||||
@@ -0,0 +1,57 @@
|
|||||||
|
(import "oo.slime")
|
||||||
|
|
||||||
|
(define-package math
|
||||||
|
|
||||||
|
(define pi 3.14159265)
|
||||||
|
|
||||||
|
(define (abs x)
|
||||||
|
(if (> x 0) x (- x)))
|
||||||
|
|
||||||
|
(define (sqrt x)
|
||||||
|
(** x 0.5))
|
||||||
|
|
||||||
|
(define-class vector3 (x y z)
|
||||||
|
(define (get-x) x)
|
||||||
|
(define (get-y) y)
|
||||||
|
(define (get-z) z)
|
||||||
|
|
||||||
|
(define (set-x new-x) (mutate x new-x))
|
||||||
|
(define (set-y new-y) (mutate y new-y))
|
||||||
|
(define (set-z new-z) (mutate z new-z))
|
||||||
|
|
||||||
|
(define (length)
|
||||||
|
(** (+ (* x x) (* y y) (* z z)) 0.5))
|
||||||
|
|
||||||
|
(define (scale fac)
|
||||||
|
(mutate x (* fac x))
|
||||||
|
(mutate y (* fac y))
|
||||||
|
(mutate z (* fac z))
|
||||||
|
fac)
|
||||||
|
|
||||||
|
(define (add other)
|
||||||
|
(make-vector3
|
||||||
|
(+ x (other get-x))
|
||||||
|
(+ y (other get-y))
|
||||||
|
(+ z (other get-z))))
|
||||||
|
|
||||||
|
(define (subtract other)
|
||||||
|
(make-vector3
|
||||||
|
(- x (other get-x))
|
||||||
|
(- y (other get-y))
|
||||||
|
(- z (other get-z))))
|
||||||
|
|
||||||
|
(define (scalar-product other)
|
||||||
|
(+ (* x (other get-x))
|
||||||
|
(* y (other get-y))
|
||||||
|
(* z (other get-z))))
|
||||||
|
|
||||||
|
(define (cross-product other)
|
||||||
|
(make-vector3
|
||||||
|
(- (* y (other get-z)) (* z (other get-y)))
|
||||||
|
(- (* z (other get-x)) (* x (other get-z)))
|
||||||
|
(- (* x (other get-y)) (* y (other get-x)))))
|
||||||
|
|
||||||
|
(define (print)
|
||||||
|
(printf :sep "" "[vector3] (" x y z ")"))
|
||||||
|
)
|
||||||
|
)
|
||||||
@@ -0,0 +1,29 @@
|
|||||||
|
(define-syntax (define-class name members :rest body)
|
||||||
|
"Macro for creating classes."
|
||||||
|
(define (underscore sym)
|
||||||
|
(string->symbol (concat-strings "_" (symbol->string sym))))
|
||||||
|
|
||||||
|
(define underscored-members (map underscore members))
|
||||||
|
|
||||||
|
;; the wrapping let environment
|
||||||
|
(define let-body `(let ,(zip members underscored-members)))
|
||||||
|
|
||||||
|
;; the body
|
||||||
|
(extend let-body body)
|
||||||
|
;; (map (lambda (fun) (append let-body fun)) body)
|
||||||
|
|
||||||
|
;; the dispatch function
|
||||||
|
(append let-body `(set-type
|
||||||
|
(special-lambda
|
||||||
|
(message :rest args)
|
||||||
|
"This is the docs for the handle"
|
||||||
|
(eval (extend (list message) args))) ,(symbol->keyword name)))
|
||||||
|
|
||||||
|
;; stuff it all in the constructor function
|
||||||
|
`(define
|
||||||
|
;; The function definition
|
||||||
|
,(pair (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members)
|
||||||
|
;; The docstring
|
||||||
|
,(concat-strings "This is the handle to an object of the class " (symbol->string name))
|
||||||
|
;; the body
|
||||||
|
,let-body))
|
||||||
+36
-28
@@ -53,7 +53,23 @@
|
|||||||
(define-syntax (define-special name-and-args :rest body)
|
(define-syntax (define-special name-and-args :rest body)
|
||||||
`(define ,(first name-and-args) (special-lambda ,(rest name-and-args) @body)))
|
`(define ,(first name-and-args) (special-lambda ,(rest name-and-args) @body)))
|
||||||
|
|
||||||
(define-syntax (do-list :rest body)
|
(define-syntax (construct-list :rest body)
|
||||||
|
"
|
||||||
|
(construct-list
|
||||||
|
i <- '(1 2 3 4 5)
|
||||||
|
yield (* i i))
|
||||||
|
|
||||||
|
(construct-list
|
||||||
|
i <- '(1 2 3 4)
|
||||||
|
j <- '(A B)
|
||||||
|
yield (pair i j))
|
||||||
|
|
||||||
|
(construct-list
|
||||||
|
i <- '(1 2 3 4 5 6 7 8)
|
||||||
|
when (evenp i)
|
||||||
|
yield i)
|
||||||
|
|
||||||
|
"
|
||||||
(define (append-map f ll)
|
(define (append-map f ll)
|
||||||
(unless (= ll ())
|
(unless (= ll ())
|
||||||
(define val (f (first ll)))
|
(define val (f (first ll)))
|
||||||
@@ -73,32 +89,29 @@
|
|||||||
`(if ,(first (rest body)) ,(rec (rest (rest body)))))
|
`(if ,(first (rest body)) ,(rec (rest (rest body)))))
|
||||||
((= (first body) 'yield)
|
((= (first body) 'yield)
|
||||||
(first (rest body)))
|
(first (rest body)))
|
||||||
(t (error "Not a do-able expression: ~S" `(quote ,body))))
|
(else (error "Not a do-able expression"))))
|
||||||
)
|
|
||||||
(rec body))
|
(rec body))
|
||||||
|
|
||||||
|
(define-syntax (apply fun seq)
|
||||||
|
"Applies the funciton to the sequence, as in calls the function with
|
||||||
|
ithe sequence as arguemens."
|
||||||
|
`(eval (pair ,fun ,seq)))
|
||||||
|
|
||||||
;; (define (append-map f ll)
|
|
||||||
;; (unless (= ll ())
|
|
||||||
;; (define val (f (first ll)))
|
|
||||||
;; (if (= (first val) ())
|
|
||||||
;; (append-map f (rest ll))
|
|
||||||
;; (extend
|
|
||||||
;; val
|
|
||||||
;; (append-map f (rest ll))))))
|
|
||||||
|
|
||||||
;; (define-special (do-list :rest body)
|
(define-syntax (define-package name :rest body)
|
||||||
;; (cond
|
`(define ,(string->symbol (concat-strings (symbol->string name) "->"))
|
||||||
;; ((= () body) ())
|
((lambda ()
|
||||||
;; ((= () (rest body)) (first body))
|
@body
|
||||||
;; ((= (first (rest body)) '<-)
|
(set-type
|
||||||
;; `(,append-map (lambda (,(first body)) (list ,(eval `(do-list @(rest (rest (rest body))))))) ,(first (rest (rest body)))))
|
(special-lambda (:rest args)
|
||||||
;; ((= (first body) 'when)
|
(let ((op (first args))
|
||||||
;; `(if ,(first (rest body)) ,(eval `(do-list @(rest (rest body))))))
|
(args (rest args)))
|
||||||
;; ((= (first body) 'yield)
|
(cond ((= op 'pi) 3.14159265)
|
||||||
;; (first (rest body)))
|
(else (try (apply op args)
|
||||||
;; (t (error "Not a do-able expression: ~S" `(quote ,body))))
|
(error "The package does not contain this operation"))))))
|
||||||
;; )
|
:package)))))
|
||||||
|
|
||||||
|
|
||||||
(define (nil? x)
|
(define (nil? x)
|
||||||
"Checks if the argument is nil."
|
"Checks if the argument is nil."
|
||||||
@@ -136,11 +149,6 @@
|
|||||||
"Checks if the argument is a built-in function."
|
"Checks if the argument is a built-in function."
|
||||||
(= (type x) :built-in-function))
|
(= (type x) :built-in-function))
|
||||||
|
|
||||||
(define (apply fun seq)
|
|
||||||
"Applies the funciton to the sequence, as in calls the function with
|
|
||||||
ithe sequence as arguemens."
|
|
||||||
(eval (pair fun seq)))
|
|
||||||
|
|
||||||
(define (end seq)
|
(define (end seq)
|
||||||
"Returns the last pair in the sqeuence."
|
"Returns the last pair in the sqeuence."
|
||||||
(if (or (nil? seq) (not (pair? (rest seq))))
|
(if (or (nil? seq) (not (pair? (rest seq))))
|
||||||
|
|||||||
@@ -16,9 +16,6 @@
|
|||||||
|
|
||||||
(define (built-n-function? x) "Checks if the argument is a built-in function." (= (type x) :built-in-function))
|
(define (built-n-function? x) "Checks if the argument is a built-in function." (= (type x) :built-in-function))
|
||||||
|
|
||||||
(define (apply fun seq) "Applies the funciton to the sequence, as in calls the function with
|
|
||||||
ithe sequence as arguemens." (eval (pair fun seq)))
|
|
||||||
|
|
||||||
(define (end seq) "Returns the last pair in the sqeuence." (if (or (nil? seq) (not (pair? (rest seq)))) seq (end (rest seq))))
|
(define (end seq) "Returns the last pair in the sqeuence." (if (or (nil? seq) (not (pair? (rest seq)))) seq (end (rest seq))))
|
||||||
|
|
||||||
(define (last seq) "Returns the (first) of the last (pair) of the given sequence." (first (end seq)))
|
(define (last seq) "Returns the (first) of the last (pair) of the given sequence." (first (end seq)))
|
||||||
@@ -52,7 +49,7 @@ elemens as argument to that function." (if (nil? seq) seq (pair (fun (first seq)
|
|||||||
function to the argument sequence. This only works correctly if
|
function to the argument sequence. This only works correctly if
|
||||||
the given function accepts a variable amount of parameters. If
|
the given function accepts a variable amount of parameters. If
|
||||||
your funciton is limited to two arguments, use `reduce-binary'
|
your funciton is limited to two arguments, use `reduce-binary'
|
||||||
instead." (apply fun seq))
|
instead." (eval (pair fun seq)))
|
||||||
|
|
||||||
(define (reduce-binary fun seq) "Takes a function and a sequence as arguments and applies the
|
(define (reduce-binary fun seq) "Takes a function and a sequence as arguments and applies the
|
||||||
function to the argument sequence. reduce-binary applies the
|
function to the argument sequence. reduce-binary applies the
|
||||||
|
|||||||
@@ -1,35 +1,6 @@
|
|||||||
(define (type-wrap obj type)
|
(import "oo.slime")
|
||||||
(set-type obj type)
|
|
||||||
obj)
|
|
||||||
|
|
||||||
(define-syntax (defclass name members :rest body)
|
(define-class vector3 (x y z)
|
||||||
"Macro for creating classes."
|
|
||||||
(define (underscore sym)
|
|
||||||
(string->symbol (concat-strings "_" (symbol->string sym))))
|
|
||||||
|
|
||||||
(define underscored-members (map underscore members))
|
|
||||||
|
|
||||||
;; the wrapping let environment
|
|
||||||
(define let-body `(let ,(zip members underscored-members)))
|
|
||||||
|
|
||||||
;; the body
|
|
||||||
(map (lambda (fun) (append let-body fun)) body)
|
|
||||||
|
|
||||||
;; the dispatch function
|
|
||||||
(append let-body `(type-wrap
|
|
||||||
(special-lambda
|
|
||||||
(message :rest args)
|
|
||||||
"This is the docs for the handle"
|
|
||||||
(eval (extend (list message) args))) ,(symbol->keyword name)))
|
|
||||||
|
|
||||||
;; stuff it all in the constructor function
|
|
||||||
`(define
|
|
||||||
,(pair (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members)
|
|
||||||
,(concat-strings "This is the handle to an object of the class " (symbol->string name))
|
|
||||||
,let-body))
|
|
||||||
|
|
||||||
|
|
||||||
(defclass vector3 (x y z)
|
|
||||||
(define (get-x) x)
|
(define (get-x) x)
|
||||||
(define (get-y) y)
|
(define (get-y) y)
|
||||||
(define (get-z) z)
|
(define (get-z) z)
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
(define (type-wrap obj type) (set-type obj type) obj)
|
(import "oo.slime")
|
||||||
|
|
||||||
(define (make-vector3 _x _y _z) "This is the handle to an object of the class vector3" (let ((x _x) (y _y) (z _z)) (define (get-x) x) (define (get-y) y) (define (get-z) z) (define (set-x new-x) (mutate x new-x)) (define (set-y new-y) (mutate y new-y)) (define (set-z new-z) (mutate z new-z)) (define (length) (** (+ (* x x) (* y y) (* z z)) 0.500000)) (define (scale fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac) (define (add other) (make-vector3 (+ x (other get-x)) (+ y (other get-y)) (+ z (other get-z)))) (define (subtract other) (make-vector3 (- x (other get-x)) (- y (other get-y)) (- z (other get-z)))) (define (scalar-product other) (+ (* x (other get-x)) (* y (other get-y)) (* z (other get-z)))) (define (cross-product other) (make-vector3 (- (* y (other get-z)) (* z (other get-y))) (- (* z (other get-x)) (* x (other get-z))) (- (* x (other get-y)) (* y (other get-x))))) (define (print) (printf :sep "" "[vector3] (" x y z ")")) (type-wrap (special-lambda (message :rest args) "This is the docs for the handle" (eval (extend (list message) args))) :vector3)))
|
(define-class vector3 (x y z) (define (get-x) x) (define (get-y) y) (define (get-z) z) (define (set-x new-x) (mutate x new-x)) (define (set-y new-y) (mutate y new-y)) (define (set-z new-z) (mutate z new-z)) (define (length) (** (+ (* x x) (* y y) (* z z)) 0.500000)) (define (scale fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac) (define (add other) (make-vector3 (+ x (other get-x)) (+ y (other get-y)) (+ z (other get-z)))) (define (subtract other) (make-vector3 (- x (other get-x)) (- y (other get-y)) (- z (other get-z)))) (define (scalar-product other) (+ (* x (other get-x)) (* y (other get-y)) (* z (other get-z)))) (define (cross-product other) (make-vector3 (- (* y (other get-z)) (* z (other get-y))) (- (* z (other get-x)) (* x (other get-z))) (- (* x (other get-y)) (* y (other get-x))))) (define (print) (printf :sep "" "[vector3] (" x y z ")")))
|
||||||
|
|
||||||
(define v1 (make-vector3 1 2 3))
|
(define v1 (make-vector3 1 2 3))
|
||||||
|
|
||||||
|
|||||||
@@ -1,3 +1,5 @@
|
|||||||
|
;; regular arguments
|
||||||
|
|
||||||
(define (make-counter)
|
(define (make-counter)
|
||||||
(let ((var 0))
|
(let ((var 0))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
@@ -5,12 +7,47 @@
|
|||||||
var)))
|
var)))
|
||||||
|
|
||||||
(define counter1 (make-counter))
|
(define counter1 (make-counter))
|
||||||
|
|
||||||
(assert (= (counter1) 1))
|
(assert (= (counter1) 1))
|
||||||
|
|
||||||
(define counter2 (make-counter))
|
(define counter2 (make-counter))
|
||||||
|
|
||||||
(assert (= (counter2) 1))
|
(assert (= (counter2) 1))
|
||||||
|
|
||||||
(assert (= (counter2) 2))
|
(assert (= (counter2) 2))
|
||||||
(assert (= (counter1) 2))
|
(assert (= (counter1) 2))
|
||||||
(assert (= (counter1) 3))
|
(assert (= (counter1) 3))
|
||||||
(assert (= (counter2) 3))
|
(assert (= (counter2) 3))
|
||||||
|
(assert (= (counter2) 4))
|
||||||
|
(assert (= (counter2) 5))
|
||||||
|
(assert (= (counter1) 4))
|
||||||
|
(assert (= (counter1) 5))
|
||||||
|
|
||||||
|
;; key arguments
|
||||||
|
|
||||||
|
(define (make-key-counter)
|
||||||
|
((lambda (:keys var)
|
||||||
|
(lambda ()
|
||||||
|
(mutate var (+ 1 var))
|
||||||
|
var))
|
||||||
|
:var 0))
|
||||||
|
|
||||||
|
|
||||||
|
(define key-counter1 (make-key-counter))
|
||||||
|
|
||||||
|
(assert (= (key-counter1) 1))
|
||||||
|
|
||||||
|
(define key-counter2 (make-key-counter))
|
||||||
|
|
||||||
|
(assert (= (key-counter2) 1))
|
||||||
|
|
||||||
|
(assert (= (key-counter2) 2))
|
||||||
|
(assert (= (key-counter1) 2))
|
||||||
|
(assert (= (key-counter1) 3))
|
||||||
|
(assert (= (key-counter2) 3))
|
||||||
|
(assert (= (key-counter2) 4))
|
||||||
|
(assert (= (key-counter2) 5))
|
||||||
|
(assert (= (key-counter1) 4))
|
||||||
|
(assert (= (key-counter1) 5))
|
||||||
|
|
||||||
|
;; rest arguments will no be copied so we don't need to test them here
|
||||||
|
|||||||
@@ -16,3 +16,37 @@
|
|||||||
|
|
||||||
(assert (= (counter2) 3))
|
(assert (= (counter2) 3))
|
||||||
|
|
||||||
|
(assert (= (counter2) 4))
|
||||||
|
|
||||||
|
(assert (= (counter2) 5))
|
||||||
|
|
||||||
|
(assert (= (counter1) 4))
|
||||||
|
|
||||||
|
(assert (= (counter1) 5))
|
||||||
|
|
||||||
|
(define (make-key-counter) ((lambda (:keys var) (lambda () (mutate var (+ 1 var)) var)) :var 0))
|
||||||
|
|
||||||
|
(define key-counter1 (make-key-counter))
|
||||||
|
|
||||||
|
(assert (= (key-counter1) 1))
|
||||||
|
|
||||||
|
(define key-counter2 (make-key-counter))
|
||||||
|
|
||||||
|
(assert (= (key-counter2) 1))
|
||||||
|
|
||||||
|
(assert (= (key-counter2) 2))
|
||||||
|
|
||||||
|
(assert (= (key-counter1) 2))
|
||||||
|
|
||||||
|
(assert (= (key-counter1) 3))
|
||||||
|
|
||||||
|
(assert (= (key-counter2) 3))
|
||||||
|
|
||||||
|
(assert (= (key-counter2) 4))
|
||||||
|
|
||||||
|
(assert (= (key-counter2) 5))
|
||||||
|
|
||||||
|
(assert (= (key-counter1) 4))
|
||||||
|
|
||||||
|
(assert (= (key-counter1) 5))
|
||||||
|
|
||||||
|
|||||||
@@ -0,0 +1,13 @@
|
|||||||
|
(define-syntax (error)
|
||||||
|
(assert t))
|
||||||
|
|
||||||
|
|
||||||
|
(define-syntax (test)
|
||||||
|
`(begin
|
||||||
|
(+ 1 1)
|
||||||
|
(error)
|
||||||
|
(+ 1 1)))
|
||||||
|
|
||||||
|
(test)
|
||||||
|
|
||||||
|
(assert t)
|
||||||
File diff suppressed because it is too large
Load Diff
|
Before Width: | Height: | Size: 139 KiB |
+8
-22
@@ -30,7 +30,8 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
|
|||||||
}
|
}
|
||||||
|
|
||||||
proc built_in_load(String* file_name, Environment* env) -> Lisp_Object* {
|
proc built_in_load(String* file_name, Environment* env) -> Lisp_Object* {
|
||||||
char* file_content = read_entire_file(Memory::get_c_str(file_name));
|
char* full_file_name = find_slime_file(file_name);
|
||||||
|
char* file_content = read_entire_file(full_file_name );
|
||||||
if (file_content) {
|
if (file_content) {
|
||||||
Lisp_Object* result = Memory::nil;
|
Lisp_Object* result = Memory::nil;
|
||||||
Lisp_Object_Array_List* program;
|
Lisp_Object_Array_List* program;
|
||||||
@@ -50,6 +51,7 @@ proc built_in_import(String* file_name, Environment* env) -> Lisp_Object* {
|
|||||||
// create new empty environment
|
// create new empty environment
|
||||||
Environment* new_env;
|
Environment* new_env;
|
||||||
try new_env = Memory::create_child_environment(Globals::root_environment);
|
try new_env = Memory::create_child_environment(Globals::root_environment);
|
||||||
|
append_to_array_list(env->parents, new_env);
|
||||||
|
|
||||||
Environment* old_macro_env = Parser::environment_for_macros;
|
Environment* old_macro_env = Parser::environment_for_macros;
|
||||||
Parser::environment_for_macros = new_env;
|
Parser::environment_for_macros = new_env;
|
||||||
@@ -58,8 +60,6 @@ proc built_in_import(String* file_name, Environment* env) -> Lisp_Object* {
|
|||||||
|
|
||||||
Parser::environment_for_macros = old_macro_env;
|
Parser::environment_for_macros = old_macro_env;
|
||||||
|
|
||||||
append_to_array_list(env->parents, new_env);
|
|
||||||
|
|
||||||
return res;
|
return res;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -391,10 +391,9 @@ proc load_built_ins_into_environment(Environment* env) -> void {
|
|||||||
defun("mutate", cLambda {
|
defun("mutate", cLambda {
|
||||||
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
|
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
|
||||||
try assert_arguments_length(2, arguments_length);
|
try assert_arguments_length(2, arguments_length);
|
||||||
|
|
||||||
Lisp_Object* target = evaluated_arguments->value.pair.first;
|
Lisp_Object* target = evaluated_arguments->value.pair.first;
|
||||||
Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first;
|
Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first;
|
||||||
|
#
|
||||||
if (target == Memory::nil ||
|
if (target == Memory::nil ||
|
||||||
target == Memory::t ||
|
target == Memory::t ||
|
||||||
Memory::get_type(target) == Lisp_Object_Type::Keyword ||
|
Memory::get_type(target) == Lisp_Object_Type::Keyword ||
|
||||||
@@ -724,8 +723,8 @@ proc load_built_ins_into_environment(Environment* env) -> void {
|
|||||||
|
|
||||||
try assert_type(type, Lisp_Object_Type::Keyword);
|
try assert_type(type, Lisp_Object_Type::Keyword);
|
||||||
|
|
||||||
evaluated_arguments->value.pair.first->userType = type;
|
object->userType = type;
|
||||||
return type;
|
return object;
|
||||||
});
|
});
|
||||||
defun("delete-type", cLambda {
|
defun("delete-type", cLambda {
|
||||||
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
|
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
|
||||||
@@ -850,6 +849,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
|
|||||||
puts("body:\n");
|
puts("body:\n");
|
||||||
print(evaluated_arguments->value.pair.first->value.function.body);
|
print(evaluated_arguments->value.pair.first->value.function.body);
|
||||||
puts("\n");
|
puts("\n");
|
||||||
|
printf("parent_env: %lld\n", (long long)evaluated_arguments->value.pair.first->value.function.parent_environment);
|
||||||
|
|
||||||
return Memory::nil;
|
return Memory::nil;
|
||||||
});
|
});
|
||||||
@@ -947,21 +947,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
|
|||||||
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
|
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
|
||||||
try assert_arguments_length(1, arguments_length);
|
try assert_arguments_length(1, arguments_length);
|
||||||
|
|
||||||
|
return Memory::copy_lisp_object(evaluated_arguments->value.pair.first);
|
||||||
if (evaluated_arguments->value.pair.first == Memory::nil ||
|
|
||||||
evaluated_arguments->value.pair.first == Memory::t ||
|
|
||||||
Memory::get_type(evaluated_arguments->value.pair.first) == Lisp_Object_Type::Symbol ||
|
|
||||||
Memory::get_type(evaluated_arguments->value.pair.first) == Lisp_Object_Type::Keyword)
|
|
||||||
{
|
|
||||||
// we don't copy singleton objects
|
|
||||||
return evaluated_arguments->value.pair.first;
|
|
||||||
}
|
|
||||||
|
|
||||||
Lisp_Object* target = Memory::create_lisp_object();
|
|
||||||
Lisp_Object* source = evaluated_arguments->value.pair.first;
|
|
||||||
|
|
||||||
*target = *source;
|
|
||||||
return target;
|
|
||||||
});
|
});
|
||||||
defun("error", cLambda {
|
defun("error", cLambda {
|
||||||
// TODO(Felix): make the error function useful
|
// TODO(Felix): make the error function useful
|
||||||
|
|||||||
+2
-1
@@ -71,6 +71,7 @@ proc print_environment_indent(Environment* env, int indent) -> void {
|
|||||||
print_indent(indent);
|
print_indent(indent);
|
||||||
print(env->values[i]);
|
print(env->values[i]);
|
||||||
printf(" %s", env->keys[i]);
|
printf(" %s", env->keys[i]);
|
||||||
|
printf(" (%lld)", (long long)env->values[i]);
|
||||||
puts("");
|
puts("");
|
||||||
}
|
}
|
||||||
for (int i = 0; i < env->parents->next_index; ++i) {
|
for (int i = 0; i < env->parents->next_index; ++i) {
|
||||||
@@ -82,6 +83,6 @@ proc print_environment_indent(Environment* env, int indent) -> void {
|
|||||||
}
|
}
|
||||||
|
|
||||||
proc print_environment(Environment* env) -> void {
|
proc print_environment(Environment* env) -> void {
|
||||||
printf("\n=== Environment ===\n");
|
printf("\n=== Environment === (%lld)\n", (long long)env);
|
||||||
print_environment_indent(env, 0);
|
print_environment_indent(env, 0);
|
||||||
}
|
}
|
||||||
|
|||||||
+21
-54
@@ -14,8 +14,13 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
|
|||||||
// their identifiers but before we converted them to
|
// their identifiers but before we converted them to
|
||||||
// strings from symbols... Wo maybe just use the symbols?
|
// strings from symbols... Wo maybe just use the symbols?
|
||||||
|
|
||||||
|
// NOTE(Felix): We have to copy all the arguments, otherwise
|
||||||
|
// we change the program code.
|
||||||
try sym = Memory::get_or_create_lisp_object_symbol(function->positional_arguments->identifiers[i]);
|
try sym = Memory::get_or_create_lisp_object_symbol(function->positional_arguments->identifiers[i]);
|
||||||
define_symbol(sym, arguments->value.pair.first, new_env);
|
define_symbol(
|
||||||
|
sym,
|
||||||
|
Memory::copy_lisp_object_except_pairs(arguments->value.pair.first),
|
||||||
|
new_env);
|
||||||
|
|
||||||
arguments = arguments->value.pair.rest;
|
arguments = arguments->value.pair.rest;
|
||||||
}
|
}
|
||||||
@@ -82,7 +87,10 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
|
|||||||
// if not set it and then add it to the array list
|
// if not set it and then add it to the array list
|
||||||
try sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.symbol.identifier);
|
try sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.symbol.identifier);
|
||||||
// NOTE(Felix): It seems we do not need to evaluate the argument here...
|
// NOTE(Felix): It seems we do not need to evaluate the argument here...
|
||||||
try define_symbol(sym, arguments->value.pair.rest->value.pair.first, new_env);
|
try define_symbol(
|
||||||
|
sym,
|
||||||
|
Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first),
|
||||||
|
new_env);
|
||||||
|
|
||||||
append_to_array_list(read_in_keywords, arguments->value.pair.first->value.symbol.identifier);
|
append_to_array_list(read_in_keywords, arguments->value.pair.first->value.symbol.identifier);
|
||||||
|
|
||||||
@@ -122,7 +130,7 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
|
|||||||
// to use it or if the user supplied his own
|
// to use it or if the user supplied his own
|
||||||
if (!was_set) {
|
if (!was_set) {
|
||||||
try sym = Memory::get_or_create_lisp_object_symbol(defined_keyword);
|
try sym = Memory::get_or_create_lisp_object_symbol(defined_keyword);
|
||||||
try val = Memory::copy_lisp_object(function->keyword_arguments->values->data[i]);
|
try val = Memory::copy_lisp_object_except_pairs(function->keyword_arguments->values->data[i]);
|
||||||
define_symbol(sym, val, new_env);
|
define_symbol(sym, val, new_env);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -137,7 +145,12 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
|
|||||||
} else {
|
} else {
|
||||||
if (function->rest_argument) {
|
if (function->rest_argument) {
|
||||||
try sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument);
|
try sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument);
|
||||||
define_symbol(sym, arguments, new_env);
|
define_symbol(
|
||||||
|
sym,
|
||||||
|
// NOTE(Felix): arguments will be a list, and I THINK
|
||||||
|
// we do not need to copy it...
|
||||||
|
arguments,
|
||||||
|
new_env);
|
||||||
} else {
|
} else {
|
||||||
// rest was not declared but additional arguments were found
|
// rest was not declared but additional arguments were found
|
||||||
create_generic_error(
|
create_generic_error(
|
||||||
@@ -152,20 +165,9 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
|
|||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
/*
|
|
||||||
(begin
|
|
||||||
(define type--before type)
|
|
||||||
(define type
|
|
||||||
(lambda (e)
|
|
||||||
(if (and (= (type--before e) :pair) (= (first e) :my-type))
|
|
||||||
:my-type
|
|
||||||
(type--before e))))
|
|
||||||
)
|
|
||||||
*/
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
This parses the argument specification of funcitons into their
|
This parses the argument specification of funcitons into their
|
||||||
Function struct. It dois this by allocating new
|
Function struct. It does this by allocating new
|
||||||
positional_arguments, keyword_arguments and rest_argument and
|
positional_arguments, keyword_arguments and rest_argument and
|
||||||
filling it in
|
filling it in
|
||||||
*/
|
*/
|
||||||
@@ -382,7 +384,6 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
|
|||||||
case Lisp_Object_Type::Symbol: {
|
case Lisp_Object_Type::Symbol: {
|
||||||
Lisp_Object* symbol;
|
Lisp_Object* symbol;
|
||||||
try symbol = lookup_symbol(node, env);
|
try symbol = lookup_symbol(node, env);
|
||||||
|
|
||||||
return symbol;
|
return symbol;
|
||||||
}
|
}
|
||||||
case Lisp_Object_Type::Pair: {
|
case Lisp_Object_Type::Pair: {
|
||||||
@@ -409,7 +410,8 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
|
|||||||
// check for lisp function
|
// check for lisp function
|
||||||
if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) {
|
if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) {
|
||||||
// only for lambdas we evaluate the arguments before
|
// only for lambdas we evaluate the arguments before
|
||||||
// apllying
|
// apllying, for the other types, special-lambda and macro
|
||||||
|
// we do not need.
|
||||||
if (lispOperator->value.function.type == Function_Type::Lambda) {
|
if (lispOperator->value.function.type == Function_Type::Lambda) {
|
||||||
try arguments = eval_arguments(arguments, env, &arguments_length);
|
try arguments = eval_arguments(arguments, env, &arguments_length);
|
||||||
}
|
}
|
||||||
@@ -440,25 +442,7 @@ proc interprete_file (char* file_name) -> Lisp_Object* {
|
|||||||
try user_env = Memory::create_child_environment(root_env);
|
try user_env = Memory::create_child_environment(root_env);
|
||||||
Parser::environment_for_macros = user_env;
|
Parser::environment_for_macros = user_env;
|
||||||
|
|
||||||
// save the current working directory
|
Lisp_Object* result = built_in_load(Memory::create_string(file_name), user_env);
|
||||||
char cwd[1024];
|
|
||||||
getcwd(cwd, 1024);
|
|
||||||
|
|
||||||
// get the direction of the exe
|
|
||||||
char* exe_path = exe_dir();
|
|
||||||
|
|
||||||
// switch to the exe directory for loading pre.slime
|
|
||||||
chdir(exe_path);
|
|
||||||
free(exe_path);
|
|
||||||
|
|
||||||
built_in_import(Memory::create_string("pre.slime"), user_env);
|
|
||||||
|
|
||||||
|
|
||||||
// switch back to the users directory
|
|
||||||
chdir(cwd);
|
|
||||||
|
|
||||||
Lisp_Object* result;
|
|
||||||
result = built_in_load(Memory::create_string(file_name), user_env);
|
|
||||||
|
|
||||||
if (Globals::error) {
|
if (Globals::error) {
|
||||||
log_error();
|
log_error();
|
||||||
@@ -480,23 +464,6 @@ proc interprete_stdin(bool is_emacs_repl = false) -> void {
|
|||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
// save the current working directory
|
|
||||||
char cwd[1024];
|
|
||||||
getcwd(cwd, 1024);
|
|
||||||
|
|
||||||
// get the direction of the exe
|
|
||||||
char* exe_path = exe_dir();
|
|
||||||
|
|
||||||
// switch to the exe directory for loading pre.slime
|
|
||||||
chdir(exe_path);
|
|
||||||
free(exe_path);
|
|
||||||
|
|
||||||
built_in_import(Memory::create_string("pre.slime"), user_env);
|
|
||||||
|
|
||||||
|
|
||||||
// switch back to the users directory
|
|
||||||
chdir(cwd);
|
|
||||||
|
|
||||||
Parser::environment_for_macros = user_env;
|
Parser::environment_for_macros = user_env;
|
||||||
|
|
||||||
printf("Welcome to the lispy interpreter.\n");
|
printf("Welcome to the lispy interpreter.\n");
|
||||||
|
|||||||
@@ -12,6 +12,8 @@ proc load_built_ins_into_environment(Environment*) -> void;
|
|||||||
proc parse_argument_list(Lisp_Object*, Function*) -> void;
|
proc parse_argument_list(Lisp_Object*, Function*) -> void;
|
||||||
proc print_environment(Environment*) -> void;
|
proc print_environment(Environment*) -> void;
|
||||||
|
|
||||||
|
proc exe_dir() -> char*;
|
||||||
|
|
||||||
proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char*;
|
proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char*;
|
||||||
|
|
||||||
proc visualize_lisp_machine() -> void;
|
proc visualize_lisp_machine() -> void;
|
||||||
@@ -24,6 +26,8 @@ namespace Memory {
|
|||||||
|
|
||||||
|
|
||||||
namespace Parser {
|
namespace Parser {
|
||||||
|
extern Environment* environment_for_macros;
|
||||||
|
|
||||||
extern String* standard_in;
|
extern String* standard_in;
|
||||||
extern String* parser_file;
|
extern String* parser_file;
|
||||||
extern int parser_line;
|
extern int parser_line;
|
||||||
|
|||||||
+5
-1
@@ -90,6 +90,10 @@ proc unescape_string(char* in) -> bool {
|
|||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
proc find_slime_file(String* filename) -> char* {
|
||||||
|
return Memory::get_c_str(filename);
|
||||||
|
}
|
||||||
|
|
||||||
proc read_entire_file(char* filename) -> char* {
|
proc read_entire_file(char* filename) -> char* {
|
||||||
char *fileContent = nullptr;
|
char *fileContent = nullptr;
|
||||||
FILE *fp = fopen(filename, "r");
|
FILE *fp = fopen(filename, "r");
|
||||||
@@ -351,7 +355,7 @@ proc log_error() -> void {
|
|||||||
puts(console_normal);
|
puts(console_normal);
|
||||||
}
|
}
|
||||||
|
|
||||||
char* exe_dir() {
|
proc exe_dir() -> char* {
|
||||||
size_t size = 512, i, n;
|
size_t size = 512, i, n;
|
||||||
char *path, *temp;
|
char *path, *temp;
|
||||||
|
|
||||||
|
|||||||
+32
-3
@@ -182,7 +182,7 @@ namespace Memory {
|
|||||||
set_type(t, Lisp_Object_Type::T);
|
set_type(t, Lisp_Object_Type::T);
|
||||||
|
|
||||||
try_void Globals::root_environment = create_built_ins_environment();
|
try_void Globals::root_environment = create_built_ins_environment();
|
||||||
try_void Parser::standard_in = create_string("stdin");
|
try_void Parser::standard_in = create_string("stdin");
|
||||||
}
|
}
|
||||||
|
|
||||||
proc reset() -> void {
|
proc reset() -> void {
|
||||||
@@ -283,7 +283,14 @@ namespace Memory {
|
|||||||
}
|
}
|
||||||
|
|
||||||
proc copy_lisp_object(Lisp_Object* n) -> Lisp_Object* {
|
proc copy_lisp_object(Lisp_Object* n) -> Lisp_Object* {
|
||||||
if (n == nil || n == t)
|
// TODO(Felix): If argument is a list (pair), do a FULL copy,
|
||||||
|
|
||||||
|
// we don't copy singleton objects
|
||||||
|
if (
|
||||||
|
n == Memory::nil || n == Memory::t ||
|
||||||
|
Memory::get_type(n) == Lisp_Object_Type::Symbol ||
|
||||||
|
Memory::get_type(n) == Lisp_Object_Type::Keyword
|
||||||
|
)
|
||||||
return n;
|
return n;
|
||||||
|
|
||||||
Lisp_Object* target;
|
Lisp_Object* target;
|
||||||
@@ -292,6 +299,12 @@ namespace Memory {
|
|||||||
return target;
|
return target;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
proc copy_lisp_object_except_pairs(Lisp_Object* n) -> Lisp_Object* {
|
||||||
|
if (get_type(n) == Lisp_Object_Type::Pair)
|
||||||
|
return n;
|
||||||
|
return copy_lisp_object(n);
|
||||||
|
}
|
||||||
|
|
||||||
proc create_child_environment(Environment* parent) -> Environment* {
|
proc create_child_environment(Environment* parent) -> Environment* {
|
||||||
|
|
||||||
int index;
|
int index;
|
||||||
@@ -337,8 +350,24 @@ namespace Memory {
|
|||||||
|
|
||||||
proc create_built_ins_environment() -> Environment* {
|
proc create_built_ins_environment() -> Environment* {
|
||||||
Environment* ret;
|
Environment* ret;
|
||||||
try ret = create_child_environment(nullptr);
|
try ret = create_empty_environment();
|
||||||
load_built_ins_into_environment(ret);
|
load_built_ins_into_environment(ret);
|
||||||
|
|
||||||
|
Parser::environment_for_macros = ret;
|
||||||
|
|
||||||
|
// save the current working directory
|
||||||
|
char cwd[1024];
|
||||||
|
getcwd(cwd, 1024);
|
||||||
|
|
||||||
|
// get the direction of the exe
|
||||||
|
char* exe_path = exe_dir();
|
||||||
|
chdir(exe_path);
|
||||||
|
free(exe_path);
|
||||||
|
|
||||||
|
built_in_load(Memory::create_string("pre.slime"), ret);
|
||||||
|
|
||||||
|
chdir(cwd);
|
||||||
|
|
||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -455,6 +455,9 @@ namespace Parser {
|
|||||||
Memory::get_type(macro) == Lisp_Object_Type::Function &&
|
Memory::get_type(macro) == Lisp_Object_Type::Function &&
|
||||||
macro->value.function.type == Function_Type::Macro)
|
macro->value.function.type == Function_Type::Macro)
|
||||||
{
|
{
|
||||||
|
// printf("Found macro: ") ;
|
||||||
|
// print(parsed_symbol);
|
||||||
|
// printf("\n");
|
||||||
try expression = eval_expr(expression, environment_for_macros);
|
try expression = eval_expr(expression, environment_for_macros);
|
||||||
} else break;
|
} else break;
|
||||||
}
|
}
|
||||||
|
|||||||
+5
-11
@@ -572,21 +572,15 @@ proc test_singular_t_and_nil() -> testresult {
|
|||||||
}
|
}
|
||||||
|
|
||||||
proc test_file(const char* file) -> testresult {
|
proc test_file(const char* file) -> testresult {
|
||||||
Environment* root_env;
|
|
||||||
Environment* user_env;
|
|
||||||
|
|
||||||
Memory::reset();
|
Memory::reset();
|
||||||
assert_no_error();
|
assert_no_error();
|
||||||
|
|
||||||
root_env = Memory::create_built_ins_environment();
|
Environment* root_env = Globals::root_environment;
|
||||||
assert_no_error();
|
Environment* user_env = Memory::create_child_environment(root_env);
|
||||||
user_env = Memory::create_child_environment(root_env);
|
|
||||||
assert_no_error();
|
assert_no_error();
|
||||||
|
|
||||||
Parser::environment_for_macros = user_env;
|
Parser::environment_for_macros = user_env;
|
||||||
|
|
||||||
built_in_import(Memory::create_string("pre.slime"), user_env);
|
|
||||||
assert_no_error();
|
|
||||||
|
|
||||||
Lisp_Object* result = built_in_load(Memory::create_string(file), user_env);
|
Lisp_Object* result = built_in_load(Memory::create_string(file), user_env);
|
||||||
assert_no_error();
|
assert_no_error();
|
||||||
@@ -595,8 +589,7 @@ proc test_file(const char* file) -> testresult {
|
|||||||
}
|
}
|
||||||
|
|
||||||
proc run_all_tests() -> bool {
|
proc run_all_tests() -> bool {
|
||||||
Memory::init(4096 * 2000, 1024, 4096 * 16);
|
Memory::init(4096 * 2000, 1024 * 32, 4096 * 16);
|
||||||
Parser::environment_for_macros = Globals::root_environment;
|
|
||||||
|
|
||||||
// get the direction of the exe
|
// get the direction of the exe
|
||||||
char* exe_path = exe_dir();
|
char* exe_path = exe_dir();
|
||||||
@@ -638,8 +631,9 @@ proc run_all_tests() -> bool {
|
|||||||
invoke_test_script("evaluation_of_default_args");
|
invoke_test_script("evaluation_of_default_args");
|
||||||
invoke_test_script("lexical_scope");
|
invoke_test_script("lexical_scope");
|
||||||
invoke_test_script("class_macro");
|
invoke_test_script("class_macro");
|
||||||
invoke_test_script("sicp");
|
|
||||||
invoke_test_script("import_and_load");
|
invoke_test_script("import_and_load");
|
||||||
|
invoke_test_script("sicp");
|
||||||
|
invoke_test_script("macro_expand");
|
||||||
|
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|||||||
Reference in New Issue
Block a user