| @@ -29,7 +29,7 @@ | |||||
| (font-lock-add-keywords | (font-lock-add-keywords | ||||
| 'c++-mode | 'c++-mode | ||||
| '(("\\<\\(if_debug\\|if_windows\\|if_linux\\|defer\\|proc\\|try\\|try_void\\|for_array_list\\|for_lisp_vector\\|in_caller_env\\|for_lisp_list\\|ignore_logging\\|dont_break_on_errors\\)\\>" . | |||||
| '(("\\<\\(if_debug\\|if_windows\\|if_linux\\|defer\\|proc\\|try\\|try_void\\|for_array_list\\|for_hash_map\\|for_lisp_list\\|for_lisp_vector\\|in_caller_env\\|ignore_logging\\|dont_break_on_errors\\)\\>" . | |||||
| font-lock-keyword-face))))))) | font-lock-keyword-face))))))) | ||||
| (c++-mode . ((eval . (company-clang-set-prefix "slime.h")) | (c++-mode . ((eval . (company-clang-set-prefix "slime.h")) | ||||
| @@ -17,12 +17,12 @@ todo.html | |||||
| /manual/manual.pdf | /manual/manual.pdf | ||||
| /manual/manual.tex | /manual/manual.tex | ||||
| *.out | *.out | ||||
| /bin/slime | |||||
| *.report | *.report | ||||
| *.svg | *.svg | ||||
| /tests/libslime/main | /tests/libslime/main | ||||
| /tests/fullslime/main | /tests/fullslime/main | ||||
| *.o | *.o | ||||
| /bin/slime | |||||
| /bin/slime_d | /bin/slime_d | ||||
| /bin/slime_p | /bin/slime_p | ||||
| *.json | *.json | ||||
| @@ -1,4 +1,5 @@ | |||||
| /vs | /vs | ||||
| /build | /build | ||||
| /manual | /manual | ||||
| /profiler_vis/speedscope | |||||
| todo.org | todo.org | ||||
| @@ -1 +1 @@ | |||||
| Subproject commit e5cb9ce81d822fee56bdef1f44b3f8d1a29618de | |||||
| Subproject commit f35d5c6d900447fc8d29e68abe4838b788f067b9 | |||||
| @@ -15,13 +15,13 @@ | |||||
| :alist)) | :alist)) | ||||
| (define (print alist) | (define (print alist) | ||||
| (let ((associations (first alist))) | |||||
| (let ((associations (car alist))) | |||||
| (define (pprint-intern associations) | (define (pprint-intern associations) | ||||
| (when associations | (when associations | ||||
| (print " " | (print " " | ||||
| (caar associations) "->" | (caar associations) "->" | ||||
| (cdar associations)) | (cdar associations)) | ||||
| (pprint-intern (rest associations)))) | |||||
| (pprint-intern (cdr associations)))) | |||||
| (print "(") | (print "(") | ||||
| (when associations | (when associations | ||||
| (print "\n") | (print "\n") | ||||
| @@ -30,22 +30,22 @@ | |||||
| (define (get alist key) | (define (get alist key) | ||||
| (let ((associations (first alist))) | |||||
| (let ((associations (car alist))) | |||||
| (define (alist-get-intern associations key) | (define (alist-get-intern associations key) | ||||
| (cond ((null? associations) | (cond ((null? associations) | ||||
| (error :key-not-found "key was not found in alist")) | (error :key-not-found "key was not found in alist")) | ||||
| ((= (caar associations) key) | ((= (caar associations) key) | ||||
| (cdar associations)) | (cdar associations)) | ||||
| (else (alist-get-intern (rest associations) key)))) | |||||
| (else (alist-get-intern (cdr associations) key)))) | |||||
| (alist-get-intern associations key))) | (alist-get-intern associations key))) | ||||
| (define (find alist key) | (define (find alist key) | ||||
| (let ((associations (first alist))) | |||||
| (let ((associations (car alist))) | |||||
| (define (alist-find-intern associations key current-index) | (define (alist-find-intern associations key current-index) | ||||
| (cond ((null? associations) key-not-found-index) | (cond ((null? associations) key-not-found-index) | ||||
| ((= (caar associations) key) current-index) | ((= (caar associations) key) current-index) | ||||
| (else (alist-find-intern (rest associations) | |||||
| (else (alist-find-intern (cdr associations) | |||||
| key | key | ||||
| (+ 1 current-index))))) | (+ 1 current-index))))) | ||||
| (alist-find-intern associations key 0))) | (alist-find-intern associations key 0))) | ||||
| @@ -65,31 +65,31 @@ | |||||
| (if (= index 1) | (if (= index 1) | ||||
| ;; we want to remove the next one, so we set our | ;; we want to remove the next one, so we set our | ||||
| ;; cdr to the next next one | ;; cdr to the next next one | ||||
| (mutate associations (pair (first associations) | |||||
| (rest (rest associations)))) | |||||
| (mutate! associations (cons (car associations) | |||||
| (cdr (cdr associations)))) | |||||
| ;; else cdr-recurse | ;; else cdr-recurse | ||||
| (alist-remove!-internal (rest asociations) (- index 1)))) | |||||
| (alist-remove!-internal (cdr asociations) (- index 1)))) | |||||
| (cond ((= index key-not-found-index) (error :key-not-found "key to remove was not found")) | (cond ((= index key-not-found-index) (error :key-not-found "key to remove was not found")) | ||||
| ((= index 0) (mutate alist (pair (cdar alist) ()))) | |||||
| ((= index 0) (mutate! alist (cons (cdar alist) ()))) | |||||
| (else (alist-remove!-internal alist index)))) | (else (alist-remove!-internal alist index)))) | ||||
| alist) | alist) | ||||
| (define (set! alist key value) | (define (set! alist key value) | ||||
| (mutate alist (set-type! (pair (pair (pair key value) | |||||
| (mutate! alist (set-type! (cons (cons (cons key value) | |||||
| (car alist)) | (car alist)) | ||||
| ()) | ()) | ||||
| :alist))) | :alist))) | ||||
| (define (set-overwrite! alist key value) | (define (set-overwrite! alist key value) | ||||
| (let ((associations (first alist))) | |||||
| (let ((associations (car alist))) | |||||
| (define (alist-set-overwrite-intern associations key value) | (define (alist-set-overwrite-intern associations key value) | ||||
| (cond ((= (caar associations) key) | (cond ((= (caar associations) key) | ||||
| (mutate (car associations) (pair key value))) | |||||
| (mutate! (car associations) (cons key value))) | |||||
| ((null? associations) (set! alist key value)) | ((null? associations) (set! alist key value)) | ||||
| (else (alist-set-overwrite-intern | (else (alist-set-overwrite-intern | ||||
| (rest associations) key value)))) | |||||
| (cdr associations) key value)))) | |||||
| (alist-set-overwrite-intern associations key value)) | (alist-set-overwrite-intern associations key value)) | ||||
| alist) | alist) | ||||
| ) | ) | ||||
| @@ -116,7 +116,7 @@ | |||||
| :plist)) | :plist)) | ||||
| (define (print plist) | (define (print plist) | ||||
| (let ((props (first plist))) | |||||
| (let ((props (car plist))) | |||||
| (define (pprint-intern props) | (define (pprint-intern props) | ||||
| (when props | (when props | ||||
| (print " " | (print " " | ||||
| @@ -130,7 +130,7 @@ | |||||
| (print ")\n"))) | (print ")\n"))) | ||||
| (define (get plist prop) | (define (get plist prop) | ||||
| (let ((props (first plist))) | |||||
| (let ((props (car plist))) | |||||
| (define (plist-get-intern props prop) | (define (plist-get-intern props prop) | ||||
| (cond ((null? props) | (cond ((null? props) | ||||
| (error :key-not-found "property was not found in plist")) | (error :key-not-found "property was not found in plist")) | ||||
| @@ -140,14 +140,14 @@ | |||||
| (plist-get-intern props prop))) | (plist-get-intern props prop))) | ||||
| (define (set! plist prop value) | (define (set! plist prop value) | ||||
| (mutate plist (set-type! (pair (pair prop (pair value (first plist))) ()) | |||||
| (mutate! plist (set-type! (cons (cons prop (cons value (car plist))) ()) | |||||
| :plist))) | :plist))) | ||||
| (define (set-overwrite! plist prop value) | (define (set-overwrite! plist prop value) | ||||
| (let ((props (first plist))) | |||||
| (let ((props (car plist))) | |||||
| (define (plist-set-overwrite-intern props prop value) | (define (plist-set-overwrite-intern props prop value) | ||||
| (cond ((= (car props) prop) | (cond ((= (car props) prop) | ||||
| (mutate (cdr props) (pair value (cddr props)))) | |||||
| (mutate! (cdr props) (cons value (cddr props)))) | |||||
| ((null? props) (plist-set! plist prop value)) | ((null? props) (plist-set! plist prop value)) | ||||
| (else (plist-set-overwrite-intern | (else (plist-set-overwrite-intern | ||||
| (cddr props) prop value)))) | (cddr props) prop value)))) | ||||
| @@ -155,7 +155,7 @@ | |||||
| plist) | plist) | ||||
| (define (find plist prop) | (define (find plist prop) | ||||
| (let ((props (first plist))) | |||||
| (let ((props (car plist))) | |||||
| (define (plist-find-intern props prop current-index) | (define (plist-find-intern props prop current-index) | ||||
| (cond ((null? props) key-not-found-index) | (cond ((null? props) key-not-found-index) | ||||
| ((= (car props) prop) current-index) | ((= (car props) prop) current-index) | ||||
| @@ -176,13 +176,13 @@ | |||||
| (if (= index 1) | (if (= index 1) | ||||
| ;; we want to remove the next one, so we set our | ;; we want to remove the next one, so we set our | ||||
| ;; cdr to the next next one | ;; cdr to the next next one | ||||
| (mutate (cdar props) (pair (cadar props) ;; xD nice meme dude!!! | |||||
| (mutate! (cdar props) (cons (cadar props) ;; xD nice meme dude!!! | |||||
| (cdr (cdr (cdr (cdar props)))))) | (cdr (cdr (cdr (cdar props)))))) | ||||
| ;; else cdr-recurse | ;; else cdr-recurse | ||||
| (plist-remove!-internal (cddr props) (- index 1)))) | (plist-remove!-internal (cddr props) (- index 1)))) | ||||
| (cond ((= index key-not-found-index) (error :key-not-found "prop to remove was not found")) | (cond ((= index key-not-found-index) (error :key-not-found "prop to remove was not found")) | ||||
| ((= index 0) (mutate plist (pair (cddar plist) ()))) | |||||
| ((= index 0) (mutate! plist (cons (cddar plist) ()))) | |||||
| (else (plist-remove!-internal plist index)))) | (else (plist-remove!-internal plist index)))) | ||||
| plist) | plist) | ||||
| @@ -1,7 +1,3 @@ | |||||
| (define cons pair) | |||||
| (define car first) | |||||
| (define cdr rest) | |||||
| (define (caar seq) | (define (caar seq) | ||||
| (car (car seq))) | (car (car seq))) | ||||
| @@ -3826,6 +3826,6 @@ | |||||
| (hm/set! emoji-map :flag:-Wales '🏴) | (hm/set! emoji-map :flag:-Wales '🏴) | ||||
| (define (get emoji-name) | (define (get emoji-name) | ||||
| (mytry | |||||
| (attempt | |||||
| (hm/get emoji-map emoji-name) | (hm/get emoji-map emoji-name) | ||||
| (error :not-found "emoji was not found")))) | (error :not-found "emoji was not found")))) | ||||
| @@ -1,8 +1,8 @@ | |||||
| (import "alist.slime") | |||||
| (import "automata.slime") | |||||
| (import "interpolation.slime") | |||||
| (import "oo.slime") | |||||
| (import "math.slime") | |||||
| (import "sets.slime") | |||||
| (generate-docs "../manual/built-in-docs.org") | |||||
| (import "alist.slime") | |||||
| (import "automata.slime") | |||||
| (import "interpolation.slime") | |||||
| (import "oo.slime") | |||||
| (import "math.slime") | |||||
| (import "sets.slime") | |||||
| (generate-docs-file "../manual/built-in-docs.org") | |||||
| @@ -17,7 +17,7 @@ | |||||
| (dt (/ 1 #steps))) | (dt (/ 1 #steps))) | ||||
| (lambda () | (lambda () | ||||
| (let ((res (lerp a b t))) | (let ((res (lerp a b t))) | ||||
| (mutate t (+ t dt)) | |||||
| (mutate! t (+ t dt)) | |||||
| res)))) | res)))) | ||||
| (define make-point pair) | (define make-point pair) | ||||
| @@ -15,17 +15,17 @@ | |||||
| (** x 0.5)) | (** x 0.5)) | ||||
| (define-class (vector3 x y z) | (define-class (vector3 x y 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 (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) | (define (length) | ||||
| (** (+ (* x x) (* y y) (* z z)) 0.5)) | (** (+ (* x x) (* y y) (* z z)) 0.5)) | ||||
| (define (scale fac) | (define (scale fac) | ||||
| (mutate x (* fac x)) | |||||
| (mutate y (* fac y)) | |||||
| (mutate z (* fac z)) | |||||
| (mutate! x (* fac x)) | |||||
| (mutate! y (* fac y)) | |||||
| (mutate! z (* fac z)) | |||||
| fac) | fac) | ||||
| (define (add other) | (define (add other) | ||||
| @@ -1,7 +1,7 @@ | |||||
| (define-syntax (define-class name-and-members . body) | |||||
| (define-macro (define-class name-and-members . body) | |||||
| "Macro for creating simple classes." | "Macro for creating simple classes." | ||||
| (let ((name (first name-and-members)) | |||||
| (members (rest name-and-members))) | |||||
| (let ((name (car name-and-members)) | |||||
| (members (cdr name-and-members))) | |||||
| `(set-type! | `(set-type! | ||||
| (define | (define | ||||
| ;; The function definition | ;; The function definition | ||||
| @@ -14,12 +14,12 @@ | |||||
| (set-type! | (set-type! | ||||
| (lambda args | (lambda args | ||||
| "This is the docs for the handle" | "This is the docs for the handle" | ||||
| (let ((op (eval (first args)))) | |||||
| (let ((op (eval (car args)))) | |||||
| (if (procedure? op) | (if (procedure? op) | ||||
| (eval args) | (eval args) | ||||
| (eval (first args))))) | |||||
| (eval (car args))))) | |||||
| ,(symbol->keyword name)))) | ,(symbol->keyword name)))) | ||||
| :constructor))) | :constructor))) | ||||
| (define-syntax (-> obj meth . args) | |||||
| (define-macro (-> obj meth . args) | |||||
| `(,obj ',meth ,@args)) | `(,obj ',meth ,@args)) | ||||
| @@ -5,13 +5,17 @@ | |||||
| ;; (kk) | ;; (kk) | ||||
| (define pair cons) | |||||
| (define first car) | |||||
| (define rest cdr) | |||||
| (define hm/set! hash-map-set!) | (define hm/set! hash-map-set!) | ||||
| (define hm/get hash-map-get) | (define hm/get hash-map-get) | ||||
| (define (hm/get-or-nil hm key) | (define (hm/get-or-nil hm key) | ||||
| (mytry (hm/get hm key) ())) | |||||
| (attempt (hm/get hm key) ())) | |||||
| (define-syntax (pe expr) | |||||
| (define-macro (pe expr) | |||||
| `(begin | `(begin | ||||
| (print :end " " ',expr "evaluates to") | (print :end " " ',expr "evaluates to") | ||||
| ((lambda (e) | ((lambda (e) | ||||
| @@ -23,16 +27,16 @@ | |||||
| (define (stream-null? s) (when s t)) | (define (stream-null? s) (when s t)) | ||||
| (define-syntax (delay expr) | |||||
| (define-macro (delay expr) | |||||
| `(,lambda () ,expr)) | `(,lambda () ,expr)) | ||||
| (define (force promise) | (define (force promise) | ||||
| (promise)) | (promise)) | ||||
| (define-syntax (mac a) (list + 1 1)) | |||||
| (define-syntax (add . args) (pair '+ args)) | |||||
| (define-macro (mac a) (list + 1 1)) | |||||
| (define-macro (add . args) (cons '+ args)) | |||||
| (define-syntax (and . args) | |||||
| (define-macro (and . args) | |||||
| ;; (and cond1 cond2 (cond3 args)) | ;; (and cond1 cond2 (cond3 args)) | ||||
| ;; -> | ;; -> | ||||
| ;; (if cond1 | ;; (if cond1 | ||||
| @@ -44,12 +48,12 @@ | |||||
| ;; ()) | ;; ()) | ||||
| ;; ()) | ;; ()) | ||||
| (if args | (if args | ||||
| `(,if ,(first args) | |||||
| ,(apply and (rest args)) | |||||
| `(,if ,(car args) | |||||
| ,(apply and (cdr args)) | |||||
| ()) | ()) | ||||
| t)) | t)) | ||||
| (define-syntax (or . args) | |||||
| (define-macro (or . args) | |||||
| ;; (or cond1 cond2 (cond3 args)) | ;; (or cond1 cond2 (cond3 args)) | ||||
| ;; -> | ;; -> | ||||
| ;; (if cond1 | ;; (if cond1 | ||||
| @@ -60,12 +64,12 @@ | |||||
| ;; t | ;; t | ||||
| ;; ()))) | ;; ()))) | ||||
| (if args | (if args | ||||
| `(,if ,(first args) | |||||
| `(,if ,(car args) | |||||
| t | t | ||||
| ,(apply or (rest args))) | |||||
| ,(apply or (cdr args))) | |||||
| ())) | ())) | ||||
| (define-syntax (when condition . body) | |||||
| (define-macro (when condition . body) | |||||
| "Special form for when multiple actions should be done if a | "Special form for when multiple actions should be done if a | ||||
| condition is true. | condition is true. | ||||
| @@ -80,68 +84,68 @@ condition is true. | |||||
| (print \"World!\")) | (print \"World!\")) | ||||
| {{{example_end}}} | {{{example_end}}} | ||||
| " | " | ||||
| (if (= (rest body) ()) | |||||
| (if (= (cdr body) ()) | |||||
| `(if ,condition ,@body nil) | `(if ,condition ,@body nil) | ||||
| `(if ,condition (begin ,@body) nil))) | `(if ,condition (begin ,@body) nil))) | ||||
| (define-syntax (unless condition . body) | |||||
| (define-macro (unless condition . body) | |||||
| "Special form for when multiple actions should be done if a | "Special form for when multiple actions should be done if a | ||||
| condition is false." | condition is false." | ||||
| (if (= (rest body) ()) | |||||
| (if (= (cdr body) ()) | |||||
| `(if ,condition nil ,@body) | `(if ,condition nil ,@body) | ||||
| `(if ,condition nil (begin ,@body)))) | `(if ,condition nil (begin ,@body)))) | ||||
| (define-syntax (n-times times action) | |||||
| (define-macro (n-times times action) | |||||
| "Executes action times times." | "Executes action times times." | ||||
| (define (repeat times elem) | (define (repeat times elem) | ||||
| (unless (> 1 times) | (unless (> 1 times) | ||||
| (pair elem (repeat (- times 1) elem)))) | |||||
| (cons elem (repeat (- times 1) elem)))) | |||||
| `(begin ,@(repeat times action))) | `(begin ,@(repeat times action))) | ||||
| (define-syntax (let bindings . body) | |||||
| (define-macro (let bindings . body) | |||||
| (define (unzip lists) | (define (unzip lists) | ||||
| (when lists | (when lists | ||||
| (define (iter lists l1 l2) | (define (iter lists l1 l2) | ||||
| (define elem (first lists)) | |||||
| (define elem (car lists)) | |||||
| (if elem | (if elem | ||||
| (iter (rest lists) | |||||
| (pair (first elem) l1) | |||||
| (pair (first (rest elem)) l2)) | |||||
| (iter (cdr lists) | |||||
| (cons (car elem) l1) | |||||
| (cons (car (cdr elem)) l2)) | |||||
| (list l1 l2))) | (list l1 l2))) | ||||
| (iter lists () ()))) | (iter lists () ()))) | ||||
| (define unzipped (unzip bindings)) | (define unzipped (unzip bindings)) | ||||
| `((,lambda ,(first unzipped) ,@body) ,@(first (rest unzipped)))) | |||||
| `((,lambda ,(car unzipped) ,@body) ,@(car (cdr unzipped)))) | |||||
| (define-syntax (cond . clauses) | |||||
| (define-macro (cond . clauses) | |||||
| (define (rec clauses) | (define (rec clauses) | ||||
| (if (= () clauses) | (if (= () clauses) | ||||
| () | () | ||||
| (if (= (first (first clauses)) 'else) | |||||
| (if (= (car (car clauses)) 'else) | |||||
| (begin | (begin | ||||
| (if (not (= (rest clauses) ())) | |||||
| (if (not (= (cdr clauses) ())) | |||||
| (error :syntax-error "There are additional clauses after the else clause!") | (error :syntax-error "There are additional clauses after the else clause!") | ||||
| (pair 'begin (rest (first clauses))))) | |||||
| `(if ,(first (first clauses)) | |||||
| (begin ,@(rest (first clauses))) | |||||
| ,(rec (rest clauses)))))) | |||||
| (cons 'begin (cdr (car clauses))))) | |||||
| `(if ,(car (car clauses)) | |||||
| (begin ,@(cdr (car clauses))) | |||||
| ,(rec (cdr clauses)))))) | |||||
| (rec clauses)) | (rec clauses)) | ||||
| (define-syntax (case var . clauses) | |||||
| (define-macro (case var . clauses) | |||||
| (define (rec clauses) | (define (rec clauses) | ||||
| (if (= nil clauses) | (if (= nil clauses) | ||||
| nil | nil | ||||
| (if (= (first (first clauses)) 'else) | |||||
| (if (= (car (car clauses)) 'else) | |||||
| (begin | (begin | ||||
| (if (not (= (rest clauses) ())) | |||||
| (if (not (= (cdr clauses) ())) | |||||
| (error :syntax-error "There are additional clauses after the else clause!") | (error :syntax-error "There are additional clauses after the else clause!") | ||||
| (pair 'begin (rest (first clauses))))) | |||||
| `(if (member? ,var ',(first (first clauses))) | |||||
| (begin ,@(rest (first clauses))) | |||||
| ,(rec (rest clauses)))))) | |||||
| (cons 'begin (cdr (car clauses))))) | |||||
| `(if (member? ,var ',(car (car clauses))) | |||||
| (begin ,@(cdr (car clauses))) | |||||
| ,(rec (cdr clauses)))))) | |||||
| (rec clauses)) | (rec clauses)) | ||||
| (define-syntax (construct-list . body) | |||||
| (define-macro (construct-list . body) | |||||
| " | " | ||||
| {{{example_start}}} | {{{example_start}}} | ||||
| (construct-list | (construct-list | ||||
| @@ -152,7 +156,7 @@ condition is false." | |||||
| (construct-list | (construct-list | ||||
| i <- '(1 2 3 4) | i <- '(1 2 3 4) | ||||
| j <- '(A B) | j <- '(A B) | ||||
| yield (pair i j)) | |||||
| yield (cons i j)) | |||||
| (construct-list | (construct-list | ||||
| i <- '(1 2 3 4 5 6 7 8) | i <- '(1 2 3 4 5 6 7 8) | ||||
| @@ -161,44 +165,44 @@ condition is false." | |||||
| " | " | ||||
| (define (append-map f ll) | (define (append-map f ll) | ||||
| (unless (= ll ()) | (unless (= ll ()) | ||||
| (define val (f (first ll))) | |||||
| (if (= (first val) ()) | |||||
| (append-map f (rest ll)) | |||||
| (define val (f (car ll))) | |||||
| (if (= (car val) ()) | |||||
| (append-map f (cdr ll)) | |||||
| (extend | (extend | ||||
| val | val | ||||
| (append-map f (rest ll)))))) | |||||
| (append-map f (cdr ll)))))) | |||||
| (define (rec body) | (define (rec body) | ||||
| (cond | (cond | ||||
| ((= () body) ()) | ((= () body) ()) | ||||
| ((= () (rest body)) (first body)) | |||||
| ((= (first (rest body)) '<-) | |||||
| `(,append-map (lambda (,(first body)) (list ,(rec (rest (rest (rest body)))))) ,(first (rest (rest body))))) | |||||
| ((= (first body) 'if) | |||||
| `(when ,(first (rest body)) ,(rec (rest (rest body))))) | |||||
| ((= (first (rest body)) 'yield) | |||||
| (first (rest body))) | |||||
| ((= () (cdr body)) (car body)) | |||||
| ((= (car (cdr body)) '<-) | |||||
| `(,append-map (lambda (,(car body)) (list ,(rec (cdr (cdr (cdr body)))))) ,(car (cdr (cdr body))))) | |||||
| ((= (car body) 'if) | |||||
| `(when ,(car (cdr body)) ,(rec (cdr (cdr body))))) | |||||
| ((= (car (cdr body)) 'yield) | |||||
| (car (cdr body))) | |||||
| (else (error :syntax-error "Not a do-able expression")))) | (else (error :syntax-error "Not a do-able expression")))) | ||||
| (rec body)) | (rec body)) | ||||
| (define-syntax (define-typed args . body) | |||||
| (define-macro (define-typed args . body) | |||||
| (define (get-arg-names args) | (define (get-arg-names args) | ||||
| (when args | (when args | ||||
| (pair (first args) | |||||
| (get-arg-names (rest (rest args)))))) | |||||
| (let ((name (first args)) | |||||
| (lambda-list (rest args)) | |||||
| (arg-names (get-arg-names (rest args)))) | |||||
| (cons (car args) | |||||
| (get-arg-names (cdr (cdr args)))))) | |||||
| (let ((name (car args)) | |||||
| (lambda-list (cdr args)) | |||||
| (arg-names (get-arg-names (cdr args)))) | |||||
| `(define (,name ,@arg-names) | `(define (,name ,@arg-names) | ||||
| (assert-types= ,@lambda-list) | (assert-types= ,@lambda-list) | ||||
| ,@body))) | ,@body))) | ||||
| (define-syntax (define-module module-name (:imports ()) (:exports ()) . body) | |||||
| (define-macro (define-module module-name (:imports ()) (:exports ()) . body) | |||||
| (let ((module-prefix (concat-strings (symbol->string module-name) "::"))) | (let ((module-prefix (concat-strings (symbol->string module-name) "::"))) | ||||
| (eval `(,begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body)) | (eval `(,begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body)) | ||||
| (pair 'begin | |||||
| (cons 'begin | |||||
| (map (lambda (orig-export-name) | (map (lambda (orig-export-name) | ||||
| ((lambda (export-name) | ((lambda (export-name) | ||||
| `(define ,export-name | `(define ,export-name | ||||
| @@ -213,7 +217,7 @@ condition is false." | |||||
| (exec `(begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body))) | (exec `(begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body))) | ||||
| (eval exec) | (eval exec) | ||||
| (enable-debug-log) | (enable-debug-log) | ||||
| (pair begin | |||||
| (cons begin | |||||
| (map (lambda (orig-export-name) | (map (lambda (orig-export-name) | ||||
| ((lambda (export-name) | ((lambda (export-name) | ||||
| `(define ,export-name | `(define ,export-name | ||||
| @@ -224,24 +228,24 @@ condition is false." | |||||
| exports)) | exports)) | ||||
| (disable-debug-log))) | (disable-debug-log))) | ||||
| (define-syntax (generic-extend args . body) | |||||
| (let ((fun-name (first args)) | |||||
| (params (rest args)) | |||||
| (define-macro (generic-extend args . body) | |||||
| (let ((fun-name (car args)) | |||||
| (params (cdr args)) | |||||
| (types ()) | (types ()) | ||||
| (names ())) | (names ())) | ||||
| (define (process-params params) | (define (process-params params) | ||||
| (when params | (when params | ||||
| (let ((_name (first params)) | |||||
| (_type (first (rest params)))) | |||||
| (let ((_name (car params)) | |||||
| (_type (car (cdr params)))) | |||||
| (assert (symbol? _name)) | (assert (symbol? _name)) | ||||
| (assert (keyword? _type)) | (assert (keyword? _type)) | ||||
| (set! types (append types _type)) | (set! types (append types _type)) | ||||
| (set! names (append names _name)) | (set! names (append names _name)) | ||||
| (process-params (rest (rest params)))))) | |||||
| (process-params (cdr (cdr params)))))) | |||||
| (process-params params) | (process-params params) | ||||
| ;; we have the fun-name, the param names and the types, lets go: | ;; we have the fun-name, the param names and the types, lets go: | ||||
| ;; | ;; | ||||
| ;; first check if there is already a generic-<name>-map | |||||
| ;; car check if there is already a generic-<name>-map | |||||
| (let ((generic-map-name (string->symbol | (let ((generic-map-name (string->symbol | ||||
| (concat-strings "generic-" (symbol->string fun-name) "-map")))) | (concat-strings "generic-" (symbol->string fun-name) "-map")))) | ||||
| (unless (bound? generic-map-name) | (unless (bound? generic-map-name) | ||||
| @@ -279,10 +283,10 @@ condition is false." | |||||
| (define (types=? . objs) | (define (types=? . objs) | ||||
| (define (inner objs) | (define (inner objs) | ||||
| (if objs | (if objs | ||||
| (let ((actual-type (type (first objs))) | |||||
| (desired-type (first (rest objs)))) | |||||
| (let ((actual-type (type (car objs))) | |||||
| (desired-type (car (cdr objs)))) | |||||
| (if (= actual-type desired-type) | (if (= actual-type desired-type) | ||||
| (inner (rest (rest objs))) | |||||
| (inner (cdr (cdr objs))) | |||||
| ())) | ())) | ||||
| t)) | t)) | ||||
| (inner objs)) | (inner objs)) | ||||
| @@ -290,10 +294,10 @@ condition is false." | |||||
| (define (assert-types= . objs) | (define (assert-types= . objs) | ||||
| (define (inner objs) | (define (inner objs) | ||||
| (when objs | (when objs | ||||
| (let ((actual-type (type (first objs))) | |||||
| (desired-type (first (rest objs)))) | |||||
| (let ((actual-type (type (car objs))) | |||||
| (desired-type (car (cdr objs)))) | |||||
| (if (= actual-type desired-type) | (if (= actual-type desired-type) | ||||
| (inner (rest (rest objs))) | |||||
| (inner (cdr (cdr objs))) | |||||
| (error :type-missmatch "type missmatch" actual-type desired-type))))) | (error :type-missmatch "type missmatch" actual-type desired-type))))) | ||||
| (inner objs)) | (inner objs)) | ||||
| @@ -309,7 +313,7 @@ condition is false." | |||||
| "Checks if the argument is a keyword." | "Checks if the argument is a keyword." | ||||
| (type=? x :keyword)) | (type=? x :keyword)) | ||||
| (define (pair? x) | |||||
| (define (cons? x) | |||||
| "Checks if the argument is a pair." | "Checks if the argument is a pair." | ||||
| (type=? x :pair)) | (type=? x :pair)) | ||||
| @@ -352,70 +356,70 @@ condition is false." | |||||
| (print (end a)) | (print (end a)) | ||||
| {{{example_end}}} | {{{example_end}}} | ||||
| " | " | ||||
| (if (or (null? seq) (not (pair? (rest seq)))) | |||||
| (if (or (null? seq) (not (cons? (cdr seq)))) | |||||
| seq | seq | ||||
| (end (rest seq)))) | |||||
| (end (cdr seq)))) | |||||
| (define (last seq) | (define (last seq) | ||||
| "Returns the (first) of the last (pair) of the given sequence. | |||||
| "Returns the (car) of the last (cons) of the given sequence. | |||||
| {{{example_start}}} | {{{example_start}}} | ||||
| (define a (list 1 2 3 4)) | (define a (list 1 2 3 4)) | ||||
| (print (last a)) | (print (last a)) | ||||
| {{{example_end}}} | {{{example_end}}} | ||||
| " | " | ||||
| (first (end seq))) | |||||
| (car (end seq))) | |||||
| (define (extend seq elem) | (define (extend seq elem) | ||||
| "Extends a list with the given element, by putting it in | "Extends a list with the given element, by putting it in | ||||
| the (rest) of the last element of the sequence." | |||||
| (if (pair? seq) | |||||
| the (cdr ) of the last element of the sequence." | |||||
| (if (cons? seq) | |||||
| (begin | (begin | ||||
| (define e (end seq)) | (define e (end seq)) | ||||
| (mutate e (pair (first e) elem)) | |||||
| (mutate! e (cons (car e) elem)) | |||||
| seq) | seq) | ||||
| elem)) | elem)) | ||||
| (define (extend2 seq elem) | (define (extend2 seq elem) | ||||
| "Extends a list with the given element, by putting it in | "Extends a list with the given element, by putting it in | ||||
| the (rest) of the last element of the sequence." | |||||
| the (cdr ) of the last element of the sequence." | |||||
| (print "addr of (end seq)" (addr-of (end seq))) | (print "addr of (end seq)" (addr-of (end seq))) | ||||
| (if (pair? seq) | |||||
| (if (cons? seq) | |||||
| (let ((e (end seq))) | (let ((e (end seq))) | ||||
| (print "addr if e inner" (addr-of e)) | (print "addr if e inner" (addr-of e)) | ||||
| (mutate e (pair (first e) elem)) | |||||
| (mutate! e (cons (car e) elem)) | |||||
| seq)) | seq)) | ||||
| elem) | elem) | ||||
| (define (append seq elem) | (define (append seq elem) | ||||
| "Appends an element to a sequence, by extendeing the list | "Appends an element to a sequence, by extendeing the list | ||||
| with (pair elem nil)." | |||||
| (extend seq (pair elem ()))) | |||||
| with (cons elem nil)." | |||||
| (extend seq (cons elem ()))) | |||||
| (define (length seq) | (define (length seq) | ||||
| "Returns the length of the given sequence." | "Returns the length of the given sequence." | ||||
| (if (null? seq) | (if (null? seq) | ||||
| 0 | 0 | ||||
| (+ 1 (length (rest seq))))) | |||||
| (+ 1 (length (cdr seq))))) | |||||
| (define (member? elem seq) | (define (member? elem seq) | ||||
| (when (pair? seq) | |||||
| (if (= elem (first seq)) | |||||
| (when (cons? seq) | |||||
| (if (= elem (car seq)) | |||||
| t | t | ||||
| (member? elem (rest seq))))) | |||||
| (member? elem (cdr seq))))) | |||||
| (define (sublist-starting-at-index seq index) | (define (sublist-starting-at-index seq index) | ||||
| (cond ((< index 0) | (cond ((< index 0) | ||||
| (error :index-out-of-range "sublist-starting-at-index: index must be positive")) | (error :index-out-of-range "sublist-starting-at-index: index must be positive")) | ||||
| ((null? seq) ()) | ((null? seq) ()) | ||||
| ((= 0 index) seq) | ((= 0 index) seq) | ||||
| (else (sublist-starting-at (rest seq) (- index 1))))) | |||||
| (else (sublist-starting-at (cdr seq) (- index 1))))) | |||||
| (define (list-without-index seq index) | (define (list-without-index seq index) | ||||
| (cond ((or (< index 0) (null? seq)) | (cond ((or (< index 0) (null? seq)) | ||||
| (error :index-out-of-range "list-remove-index!: index out of range")) | (error :index-out-of-range "list-remove-index!: index out of range")) | ||||
| ((= 0 index) (rest seq)) | |||||
| (else (pair (first seq) (list-without-index (rest seq) (- index 1)))))) | |||||
| ((= 0 index) (cdr seq)) | |||||
| (else (cons (car seq) (list-without-index (cdr seq) (- index 1)))))) | |||||
| (define (increment val) | (define (increment val) | ||||
| "Adds one to the argument." | "Adds one to the argument." | ||||
| @@ -429,7 +433,7 @@ with (pair elem nil)." | |||||
| "Returns a sequence of numbers starting with the number defined | "Returns a sequence of numbers starting with the number defined | ||||
| by the key =from= and ends with the number defined in =to=." | by the key =from= and ends with the number defined in =to=." | ||||
| (when (< from to) | (when (< from to) | ||||
| (pair from (range :from (+ 1 from) :to to)))) | |||||
| (cons from (range :from (+ 1 from) :to to)))) | |||||
| (define (range-while (:from 0) :to) | (define (range-while (:from 0) :to) | ||||
| "Returns a sequence of numbers starting with the number defined | "Returns a sequence of numbers starting with the number defined | ||||
| @@ -439,19 +443,19 @@ by the key 'from' and ends with the number defined in 'to'." | |||||
| (set! from (increment from)) | (set! from (increment from)) | ||||
| (while (< from to) | (while (< from to) | ||||
| (begin | (begin | ||||
| (mutate head (pair (first head) (pair (copy from) nil))) | |||||
| (define head (rest head)) | |||||
| (mutate! head (cons (car head) (cons (copy from) nil))) | |||||
| (define head (cdr head)) | |||||
| (set! from (increment from)))) | (set! from (increment from)))) | ||||
| result) | result) | ||||
| (define (map fun seq) | (define (map fun seq) | ||||
| "Takes a function and a sequence as arguments and returns a new | "Takes a function and a sequence as arguments and returns a new | ||||
| sequence which contains the results of using the first sequences | |||||
| sequence which contains the results of using the car sequences | |||||
| elemens as argument to that function." | elemens as argument to that function." | ||||
| (if (null? seq) | (if (null? seq) | ||||
| seq | seq | ||||
| (pair (fun (first seq)) | |||||
| (map fun (rest seq))))) | |||||
| (cons (fun (car seq)) | |||||
| (map fun (cdr seq))))) | |||||
| (define (reduce fun seq) | (define (reduce fun seq) | ||||
| "Takes a function and a sequence as arguments and applies the | "Takes a function and a sequence as arguments and applies the | ||||
| @@ -466,10 +470,10 @@ instead." | |||||
| function to the argument sequence. reduce-binary applies the arguments | function to the argument sequence. reduce-binary applies the arguments | ||||
| *pair-wise* which means it works with binary functions as compared to | *pair-wise* which means it works with binary functions as compared to | ||||
| [[=reduce=]]." | [[=reduce=]]." | ||||
| (if (null? (rest seq)) | |||||
| (first seq) | |||||
| (fun (first seq) | |||||
| (reduce-binary fun (rest seq))))) | |||||
| (if (null? (cdr seq)) | |||||
| (car seq) | |||||
| (fun (car seq) | |||||
| (reduce-binary fun (cdr seq))))) | |||||
| (define (filter fun seq) | (define (filter fun seq) | ||||
| "Takes a function and a sequence as arguments and applies the | "Takes a function and a sequence as arguments and applies the | ||||
| @@ -477,25 +481,25 @@ function to every value in the sequence. If the result of that | |||||
| funciton application returns a truthy value, the original value is | funciton application returns a truthy value, the original value is | ||||
| added to a list, which in the end is returned." | added to a list, which in the end is returned." | ||||
| (when seq | (when seq | ||||
| (if (fun (first seq)) | |||||
| (pair (first seq) | |||||
| (filter fun (rest seq))) | |||||
| (filter fun (rest seq))))) | |||||
| (if (fun (car seq)) | |||||
| (cons (car seq) | |||||
| (filter fun (cdr seq))) | |||||
| (filter fun (cdr seq))))) | |||||
| (define (zip l1 l2) | (define (zip l1 l2) | ||||
| (unless (and (null? l1) (null? l2)) | (unless (and (null? l1) (null? l2)) | ||||
| (pair (list (first l1) (first l2)) | |||||
| (zip (rest l1) (rest l2))))) | |||||
| (cons (list (car l1) (car l2)) | |||||
| (zip (cdr l1) (cdr l2))))) | |||||
| (define (unzip lists) | (define (unzip lists) | ||||
| (when lists | (when lists | ||||
| (define (iter lists l1 l2) | (define (iter lists l1 l2) | ||||
| (define elem (first lists)) | |||||
| (define elem (car lists)) | |||||
| (if elem | (if elem | ||||
| (iter (rest lists) | |||||
| (pair (first elem) l1) | |||||
| (pair (first (rest elem)) l2)) | |||||
| (iter (cdr lists) | |||||
| (cons (car elem) l1) | |||||
| (cons (car (cdr elem)) l2)) | |||||
| (list l1 l2))) | (list l1 l2))) | ||||
| (iter lists () ()))) | (iter lists () ()))) | ||||
| @@ -503,8 +507,8 @@ added to a list, which in the end is returned." | |||||
| (define (enumerate seq) | (define (enumerate seq) | ||||
| (define (enumerate-inner seq next-num) | (define (enumerate-inner seq next-num) | ||||
| (when seq | (when seq | ||||
| (pair (list (first seq) next-num) | |||||
| (enumerate-inner (rest seq) (+ 1 next-num))))) | |||||
| (cons (list (car seq) next-num) | |||||
| (enumerate-inner (cdr seq) (+ 1 next-num))))) | |||||
| (enumerate-inner seq 0)) | (enumerate-inner seq 0)) | ||||
| @@ -1,106 +0,0 @@ | |||||
| (define hm/set! hash-map-set!) | |||||
| (define hm/get hash-map-get) | |||||
| (define (hm/get-or-nil hm key) (mytry (hm/get hm key) ())) | |||||
| (define-syntax (pe expr) `(print ',expr "evaluates to" ,expr)) | |||||
| (define the-empty-stream ()) | |||||
| (define (stream-null? s) (if s t ())) | |||||
| (define-syntax (delay expr) `(,lambda () ,expr)) | |||||
| (define (force promise) (promise)) | |||||
| (define-syntax (when condition . body) :doc "Special form for when multiple actions should be done if a\ncondition is true.\n\n{{{example_start}}}\n(when (not ())\n (print "Hello ")\n (print "from ")\n (print "when!"))\n\n(when ()\n (print "Goodbye ")\n (print "World!"))\n{{{example_end}}}\n" (if (= (rest body) ()) `(if ,condition ,@body nil) `(if ,condition (begin ,@body) nil))) | |||||
| (define-syntax (unless condition . body) :doc "Special form for when multiple actions should be done if a\ncondition is false." (if (= (rest body) ()) `(if ,condition nil ,@body) `(if ,condition nil (begin ,@body)))) | |||||
| (define-syntax (n-times times action) :doc "Executes action times times." (define (repeat times elem) (unless (> 1 times) (pair elem (repeat (- times 1) elem)))) `(begin ,@(repeat times action))) | |||||
| (define-syntax (let bindings . body) (define (unzip lists) (when lists (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)))) (iter lists () ())) (define unzipped (unzip bindings)) `((,lambda ,(first unzipped) ,@body) ,@(first (rest unzipped)))) | |||||
| (define-syntax (cond . clauses) (define (rec clauses) (if (= nil clauses) nil (if (= (first (first clauses)) 'else) (begin (if (not (= (rest clauses) ())) (error :syntax-error "There are additional clauses after the else clause!") (pair 'begin (rest (first clauses))))) `(if ,(first (first clauses)) (begin ,@(rest (first clauses))) ,(rec (rest clauses)))))) (rec clauses)) | |||||
| (define-syntax (case var . clauses) (define (rec clauses) (if (= nil clauses) nil (if (= (first (first clauses)) 'else) (begin (if (not (= (rest clauses) ())) (error :syntax-error "There are additional clauses after the else clause!") (pair 'begin (rest (first clauses))))) `(if (member? ,var ',(first (first clauses))) (begin ,@(rest (first clauses))) ,(rec (rest clauses)))))) (rec clauses)) | |||||
| (define-syntax (construct-list . body) :doc "\n{{{example_start}}}\n(construct-list\n i <- '(1 2 3 4 5)\n yield (* i i))\n{{{example_end}}}\n\n(construct-list\n i <- '(1 2 3 4)\n j <- '(A B)\n yield (pair i j))\n\n(construct-list\n i <- '(1 2 3 4 5 6 7 8)\n if (= 0 (% i 2))\n yield i)\n" (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 (rec body) (cond ((= () body) ()) ((= () (rest body)) (first body)) ((= (first (rest body)) '<-) `(,append-map (lambda (,(first body)) (list ,(rec (rest (rest (rest body)))))) ,(first (rest (rest body))))) ((= (first body) 'if) `(when ,(first (rest body)) ,(rec (rest (rest body))))) ((= (first (rest body)) 'yield) (first (rest body))) (else (error :syntax-error "Not a do-able expression")))) (rec body)) | |||||
| (define-syntax (define-typed args . body) (define (get-arg-names args) (when args (pair (first args) (get-arg-names (rest (rest args)))))) (let ((name (first args)) (lambda-list (rest args)) (arg-names (get-arg-names (rest args)))) `(define (,name ,@arg-names) (assert-types= ,@lambda-list) ,@body))) | |||||
| (define-syntax (define-module module-name (:imports ()) :exports . body) (let ((module-prefix (concat-strings (symbol->string module-name) "::"))) (eval `(begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body)) (pair 'begin (map (lambda (orig-export-name) (let ((export-name (string->symbol (concat-strings module-prefix (symbol->string orig-export-name))))) `(define ,export-name ,(mytry (eval orig-export-name) (error :module-error "The module does not contain a key it tries to export"))))) exports)))) | |||||
| (define-syntax (generic-extend args . body) (let ((fun-name (first args)) (params (rest args)) (types ()) (names ())) (define (process-params params) (when params (let ((_name (first params)) (_type (first (rest params)))) (assert (symbol? _name)) (assert (keyword? _type)) (set! types (append types _type)) (set! names (append names _name)) (process-params (rest (rest params)))))) (process-params params) (let ((generic-map-name (string->symbol (concat-strings "generic-" (symbol->string fun-name) "-map")))) (unless (bound? generic-map-name) (define generic-map-name (hash-map))) (hm/set! generic-map-name types (eval `(,lambda ,names ,@body))) (if (bound? fun-name) (let ((exisiting-fun (eval fun-name))) (unless (type=? exisiting-fun :generic-procedure) (unless (procedure? exisiting-fun) (error :macro-expand-error "can only generic-extend procedures.")) (define orig-proc exisiting-fun) (define fun-name (eval `(,lambda args (let ((fun (hm/get (map type args)))) (if (procedure? fun) (fun . args) (,orig-proc . args)))))))))))) | |||||
| (define (null? x) :doc "Checks if the argument is =nil=." (= x ())) | |||||
| (define (type=? obj typ) :doc "Checks if the argument =obj= is of type =typ=" (= (type obj) typ)) | |||||
| (define (types=? . objs) (define (inner objs) (if objs (let ((actual-type (type (first objs))) (desired-type (first (rest objs)))) (if (= actual-type desired-type) (inner (rest (rest objs))) ())) t)) (inner objs)) | |||||
| (define (assert-types= . objs) (define (inner objs) (when objs (let ((actual-type (type (first objs))) (desired-type (first (rest objs)))) (if (= actual-type desired-type) (inner (rest (rest objs))) (error :type-missmatch "type missmatch" actual-type desired-type))))) (inner objs)) | |||||
| (define (number? x) :doc "Checks if the argument is a number." (type=? x :number)) | |||||
| (define (symbol? x) :doc "Checks if the argument is a symbol." (type=? x :symbol)) | |||||
| (define (keyword? x) :doc "Checks if the argument is a keyword." (type=? x :keyword)) | |||||
| (define (pair? x) :doc "Checks if the argument is a pair." (type=? x :pair)) | |||||
| (define (string? x) :doc "Checks if the argument is a string." (type=? x :string)) | |||||
| (define (lambda? x) :doc "Checks if the argument is a function." (type=? x :lambda)) | |||||
| (define (macro? x) :doc "Checks if the argument is a macro." (type=? x :macro)) | |||||
| (define (special-lambda? x) :doc "Checks if the argument is a special-lambda." (type=? x :dynamic-macro)) | |||||
| (define (built-in-function? x) :doc "Checks if the argument is a built-in function." (type=? x :cfunction)) | |||||
| (define (continuation? x) :doc "Checks if the argument is a continuation." (type=? x :continuation)) | |||||
| (define (procedure? x) (or (lambda? x) (special-lambda? x) (macro? x) (built-in-function? x) (continuation? x))) | |||||
| (define (end seq) :doc "Returns the last pair in the sqeuence.\n\n{{{example_start}}}\n(define a (list 1 2 3 4))\n(print (end a))\n{{{example_end}}}\n" (if (or (null? seq) (not (pair? (rest seq)))) seq (end (rest seq)))) | |||||
| (define (last seq) :doc "Returns the (first) of the last (pair) of the given sequence.\n\n{{{example_start}}}\n(define a (list 1 2 3 4))\n(print (last a))\n{{{example_end}}}\n" (first (end seq))) | |||||
| (define (extend seq elem) :doc "Extends a list with the given element, by putting it in\nthe (rest) of the last element of the sequence." (if (pair? seq) (begin (define e (end seq)) (mutate e (pair (first e) elem)) seq) elem)) | |||||
| (define (extend2 seq elem) :doc "Extends a list with the given element, by putting it in\nthe (rest) of the last element of the sequence." (print "addr of (end seq)" (addr-of (end seq))) (if (pair? seq) (let ((e (end seq))) (print "addr if e inner" (addr-of e)) (mutate e (pair (first e) elem)) seq)) elem) | |||||
| (define (append seq elem) :doc "Appends an element to a sequence, by extendeing the list\nwith (pair elem nil)." (extend seq (pair elem ()))) | |||||
| (define (length seq) :doc "Returns the length of the given sequence." (if (null? seq) 0 (+ 1 (length (rest seq))))) | |||||
| (define (member? elem seq) (when (pair? seq) (if (= elem (first seq)) t (member? elem (rest seq))))) | |||||
| (define (sublist-starting-at-index seq index) (cond ((< index 0) (error :index-out-of-range "sublist-starting-at-index: index must be positive")) ((null? seq) ()) ((= 0 index) seq) (else (sublist-starting-at (rest seq) (- index 1))))) | |||||
| (define (list-without-index seq index) (cond ((or (< index 0) (null? seq)) (error :index-out-of-range "list-remove-index!: index out of range")) ((= 0 index) (rest seq)) (else (pair (first seq) (list-without-index (rest seq) (- index 1)))))) | |||||
| (define (increment val) :doc "Adds one to the argument." (+ val 1)) | |||||
| (define (decrement val) :doc "Subtracts one from the argument." (- val 1)) | |||||
| (define (range (:from 0) :to) :doc "Returns a sequence of numbers starting with the number defined\nby the key =from= and ends with the number defined in =to=." (when (< from to) (pair from (range :from (+ 1 from) :to to)))) | |||||
| (define (range-while (:from 0) :to) :doc "Returns a sequence of numbers starting with the number defined\nby the key 'from' and ends with the number defined in 'to'." (define result (list (copy from))) (define head result) (set! from (increment from)) (while (< from to) (begin (mutate head (pair (first head) (pair (copy from) nil))) (define head (rest head)) (set! from (increment from)))) result) | |||||
| (define (map fun seq) :doc "Takes a function and a sequence as arguments and returns a new\nsequence which contains the results of using the first sequences\nelemens as argument to that function." (if (null? seq) seq (pair (fun (first seq)) (map fun (rest seq))))) | |||||
| (define (reduce fun seq) :doc "Takes a function and a sequence as arguments and applies the\nfunction to the argument sequence. This only works correctly if the\ngiven function accepts a variable amount of parameters. If your\nfunciton is limited to two arguments, use [[=reduce-binary=]]\ninstead." (apply fun seq)) | |||||
| (define (reduce-binary fun seq) :doc "Takes a function and a sequence as arguments and applies the\nfunction to the argument sequence. reduce-binary applies the arguments\n*pair-wise* which means it works with binary functions as compared to\n[[=reduce=]]." (if (null? (rest seq)) (first seq) (fun (first seq) (reduce-binary fun (rest seq))))) | |||||
| (define (filter fun seq) :doc "Takes a function and a sequence as arguments and applies the\nfunction to every value in the sequence. If the result of that\nfunciton application returns a truthy value, the original value is\nadded 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))))) | |||||
| (define (zip l1 l2) (unless (and (null? l1) (null? l2)) (pair (list (first l1) (first l2)) (zip (rest l1) (rest l2))))) | |||||
| (define (unzip lists) (when lists (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))) (iter lists () ()))) | |||||
| (define (enumerate seq) (define (enumerate-inner seq next-num) (when seq (pair (list (first seq) next-num) (enumerate-inner (rest seq) (+ 1 next-num))))) (enumerate-inner seq 0)) | |||||
| @@ -25,7 +25,7 @@ | |||||
| (define (insert! set value) | (define (insert! set value) | ||||
| (unless (contains? set value) | (unless (contains? set value) | ||||
| (set! set (pair (pair value (first set)) ())) | |||||
| (set! set (cons (cons value (car set)) ())) | |||||
| (set-type! set :set)) | (set-type! set :set)) | ||||
| set) | set) | ||||
| ) | ) | ||||
| @@ -3,7 +3,7 @@ | |||||
| (define a (ds::alist::make)) | (define a (ds::alist::make)) | ||||
| ;; a == (()) | ;; a == (()) | ||||
| (assert (= (first a) ())) | |||||
| (assert (= (car a) ())) | |||||
| (ds::alist::set! a 'key1 'value1) | (ds::alist::set! a 'key1 'value1) | ||||
| ;; a == (key1: value1) | ;; a == (key1: value1) | ||||
| @@ -20,7 +20,7 @@ | |||||
| (assert (ds::alist::key-exists? a 'key2)) | (assert (ds::alist::key-exists? a 'key2)) | ||||
| (assert (= (ds::alist::find a 'key2) 0)) | (assert (= (ds::alist::find a 'key2) 0)) | ||||
| (assert (= (ds::alist::find a 'key1) 1)) | (assert (= (ds::alist::find a 'key1) 1)) | ||||
| (assert (= (length (first a)) 2)) | |||||
| (assert (= (length (car a)) 2)) | |||||
| (ds::alist::set! a 'key1 'value3) | (ds::alist::set! a 'key1 'value3) | ||||
| @@ -28,7 +28,7 @@ | |||||
| ;; key2: value2, | ;; key2: value2, | ||||
| ;; key1: value1) | ;; key1: value1) | ||||
| (assert (= (length (first a)) 3)) | |||||
| (assert (= (length (car a)) 3)) | |||||
| (assert (= (ds::alist::get a 'key1) 'value3)) | (assert (= (ds::alist::get a 'key1) 'value3)) | ||||
| (ds::alist::set-overwrite! a 'key1 'value4) | (ds::alist::set-overwrite! a 'key1 'value4) | ||||
| @@ -36,14 +36,14 @@ | |||||
| ;; key2: value2, | ;; key2: value2, | ||||
| ;; key1: value1) | ;; key1: value1) | ||||
| (assert (= (length (first a)) 3)) | |||||
| (assert (= (length (car a)) 3)) | |||||
| (assert (= (ds::alist::get a 'key1) 'value4)) | (assert (= (ds::alist::get a 'key1) 'value4)) | ||||
| (ds::alist::remove! a 'key1) | (ds::alist::remove! a 'key1) | ||||
| ;; a == (key2: value2, | ;; a == (key2: value2, | ||||
| ;; key1: value1) | ;; key1: value1) | ||||
| (assert (= (length (first a)) 2)) | |||||
| (assert (= (length (car a)) 2)) | |||||
| (assert (= (ds::alist::get a 'key1) 'value1)) | (assert (= (ds::alist::get a 'key1) 'value1)) | ||||
| (assert (= (ds::alist::get a 'key2) 'value2)) | (assert (= (ds::alist::get a 'key2) 'value2)) | ||||
| @@ -57,7 +57,7 @@ | |||||
| (define p (ds::plist::make)) | (define p (ds::plist::make)) | ||||
| ;; p == (()) | ;; p == (()) | ||||
| (assert (= (first p) ())) | |||||
| (assert (= (car p) ())) | |||||
| (ds::plist::set! p :key1 'value1) | (ds::plist::set! p :key1 'value1) | ||||
| ;; p == ((:key1 value1)) | ;; p == ((:key1 value1)) | ||||
| @@ -74,14 +74,14 @@ | |||||
| (assert (ds::plist::prop-exists? p :key2)) | (assert (ds::plist::prop-exists? p :key2)) | ||||
| (assert (= (ds::plist::find p :key2) 0)) | (assert (= (ds::plist::find p :key2) 0)) | ||||
| (assert (= (ds::plist::find p :key1) 1)) | (assert (= (ds::plist::find p :key1) 1)) | ||||
| (assert (= (length (first p)) 4)) | |||||
| (assert (= (length (car p)) 4)) | |||||
| (ds::plist::set! p :key1 'value3) | (ds::plist::set! p :key1 'value3) | ||||
| ;; p == ((:key1 value3, | ;; p == ((:key1 value3, | ||||
| ;; :key2 value2, | ;; :key2 value2, | ||||
| ;; :key1 value1)) | ;; :key1 value1)) | ||||
| (assert (= (length (first p)) 6)) | |||||
| (assert (= (length (car p)) 6)) | |||||
| (assert (= (ds::plist::get p :key1) 'value3)) | (assert (= (ds::plist::get p :key1) 'value3)) | ||||
| (ds::plist::set-overwrite! p :key1 'value4) | (ds::plist::set-overwrite! p :key1 'value4) | ||||
| @@ -89,13 +89,13 @@ | |||||
| ;; :key2 value2, | ;; :key2 value2, | ||||
| ;; :key1 value1)) | ;; :key1 value1)) | ||||
| ;; (assert (= (length (first p)) 6)) | |||||
| ;; (assert (= (length (car p)) 6)) | |||||
| ;; (assert (= (ds::plist::get p :key1) 'value4)) | ;; (assert (= (ds::plist::get p :key1) 'value4)) | ||||
| ;; (ds::plist::remove! p :key1) | ;; (ds::plist::remove! p :key1) | ||||
| ;; ;; p == ((:key2 value2, | ;; ;; p == ((:key2 value2, | ||||
| ;; ;; :key1 value1)) | ;; ;; :key1 value1)) | ||||
| ;; (assert (= (length (first p)) 4)) | |||||
| ;; (assert (= (length (car p)) 4)) | |||||
| ;; (assert (= (ds::plist::get p :key1) 'value1)) | ;; (assert (= (ds::plist::get p :key1) 'value1)) | ||||
| ;; (assert (= (ds::plist::get p :key2) 'value2)) | ;; (assert (= (ds::plist::get p :key2) 'value2)) | ||||
| @@ -22,25 +22,25 @@ | |||||
| (set::make "q0"))) | (set::make "q0"))) | ||||
| (let ((state (aut ()))) | (let ((state (aut ()))) | ||||
| (assert (= (first state) :accept)) | |||||
| (assert (= (first (rest state)) "q0"))) | |||||
| (assert (= (car state) :accept)) | |||||
| (assert (= (car (cdr state)) "q0"))) | |||||
| (let ((state (aut "M"))) | (let ((state (aut "M"))) | ||||
| (assert (= (first state) :fail)) | |||||
| (assert (= (first (rest state)) "q1"))) | |||||
| (assert (= (car state) :fail)) | |||||
| (assert (= (car (cdr state)) "q1"))) | |||||
| (let ((state (aut "A"))) | (let ((state (aut "A"))) | ||||
| (assert (= (first state) :accept)) | |||||
| (assert (= (first (rest state)) "q0"))) | |||||
| (assert (= (car state) :accept)) | |||||
| (assert (= (car (cdr state)) "q0"))) | |||||
| (let ((state (aut "M"))) | (let ((state (aut "M"))) | ||||
| (assert (= (first state) :fail)) | |||||
| (assert (= (first (rest state)) "q1"))) | |||||
| (assert (= (car state) :fail)) | |||||
| (assert (= (car (cdr state)) "q1"))) | |||||
| (let ((state (aut "G"))) | (let ((state (aut "G"))) | ||||
| (assert (= (first state) :fail)) | |||||
| (assert (= (first (rest state)) "q2"))) | |||||
| (assert (= (car state) :fail)) | |||||
| (assert (= (car (cdr state)) "q2"))) | |||||
| (let ((state (aut "E"))) | (let ((state (aut "E"))) | ||||
| (assert (= (first state) :accept)) | |||||
| (assert (= (first (rest state)) "q0"))) | |||||
| (assert (= (car state) :accept)) | |||||
| (assert (= (car (cdr state)) "q0"))) | |||||
| @@ -1,17 +1,17 @@ | |||||
| (import "oo.slime") | (import "oo.slime") | ||||
| (define-class (vector3 x y z) | (define-class (vector3 x y 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 (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) | (define (length) | ||||
| (** (+ (* x x) (* y y) (* z z)) 0.5)) | (** (+ (* x x) (* y y) (* z z)) 0.5)) | ||||
| (define (scale fac) | (define (scale fac) | ||||
| (mutate x (* fac x)) | |||||
| (mutate y (* fac y)) | |||||
| (mutate z (* fac z)) | |||||
| (mutate! x (* fac x)) | |||||
| (mutate! y (* fac y)) | |||||
| (mutate! z (* fac z)) | |||||
| fac) | fac) | ||||
| (define (add other) | (define (add other) | ||||
| @@ -10,6 +10,6 @@ | |||||
| ((lambda () | ((lambda () | ||||
| (define (a) | (define (a) | ||||
| :ok) | :ok) | ||||
| (define (b (:k (begin (break) (a)))) | |||||
| (define (b (:k (begin (show-environment) (a)))) | |||||
| k) | k) | ||||
| (b)))) | (b)))) | ||||
| @@ -26,7 +26,7 @@ | |||||
| (define x 0) | (define x 0) | ||||
| (lambda () | (lambda () | ||||
| (define temp x) | (define temp x) | ||||
| (mutate x (+ x 1)) | |||||
| (mutate! x (+ x 1)) | |||||
| temp)) | temp)) | ||||
| ;; key arguments | ;; key arguments | ||||
| @@ -34,7 +34,7 @@ | |||||
| (define (make-key-counter) | (define (make-key-counter) | ||||
| ((lambda (:var) | ((lambda (:var) | ||||
| (lambda () | (lambda () | ||||
| (mutate var (+ 1 var)) | |||||
| (mutate! var (+ 1 var)) | |||||
| var)) | var)) | ||||
| :var 0)) | :var 0)) | ||||
| @@ -1,8 +1,8 @@ | |||||
| (define-syntax (error) | |||||
| (define-macro (error) | |||||
| (assert t)) | (assert t)) | ||||
| (define-syntax (test) | |||||
| (define-macro (test) | |||||
| `(begin | `(begin | ||||
| (+ 1 1) | (+ 1 1) | ||||
| (error) | (error) | ||||
| @@ -8,9 +8,8 @@ taskkill /F /IM %exeName% > NUL 2> NUL | |||||
| echo ---------- Compiling ---------- | echo ---------- Compiling ---------- | ||||
| call cl ^ | call cl ^ | ||||
| /DEBUG:FULL^ | |||||
| ../src/main.cpp^ | ../src/main.cpp^ | ||||
| /I../3rd/ ^ | |||||
| /I../3rd/ /DEBUG:FULL ^ | |||||
| /D_PROFILING /D_DEBUG /D_DONT_BREAK_ON_ERRORS ^ | /D_PROFILING /D_DEBUG /D_DONT_BREAK_ON_ERRORS ^ | ||||
| /Zi /std:c++latest /Fe%exeName% /W3 /wd4003 /wd4996 /nologo /EHsc | /Zi /std:c++latest /Fe%exeName% /W3 /wd4003 /wd4996 /nologo /EHsc | ||||
| @@ -40,7 +40,7 @@ pushd ./bin > /dev/null | |||||
| # echo "----------------------" | # echo "----------------------" | ||||
| # echo " generating docs " | # echo " generating docs " | ||||
| # echo "----------------------" | # echo "----------------------" | ||||
| # time valgrind -q ./slime_d --generate-docs || exit 1 | |||||
| # time valgrind -q ./slime_d --generate-docs-file || exit 1 | |||||
| echo "" | echo "" | ||||
| echo "----------------------" | echo "----------------------" | ||||
| @@ -1,25 +0,0 @@ | |||||
| @echo off | |||||
| @setlocal | |||||
| pushd %~dp0 | |||||
| set exeName=slime.exe | |||||
| set binDir=bin | |||||
| mkdir build 2>nul | |||||
| pushd build | |||||
| taskkill /F /IM %exeName% > NUL 2> NUL | |||||
| echo ---------- Compiling ---------- | |||||
| call timecmd clang++ -std=c++1z ../src/main.cpp -o %exeName% -D_DEBUG libucrtd.lib | |||||
| if %errorlevel% == 0 ( | |||||
| echo. | |||||
| echo Done | |||||
| ) else ( | |||||
| echo. | |||||
| echo Fuckin' ell | |||||
| ) | |||||
| popd | |||||
| popd | |||||
| @@ -1,5 +0,0 @@ | |||||
| -std=c++17 | |||||
| -D_DEBUG | |||||
| -D_DONT_BREAK_ON_ERRORS | |||||
| -I3rd/ | |||||
| -include=libslime.cpp | |||||
| @@ -1,4 +0,0 @@ | |||||
| @echo off | |||||
| pushd %~dp0 | |||||
| start "" "cdbg64.exe" build\slime.exe | |||||
| popd | |||||
| @@ -1,54 +0,0 @@ | |||||
| /** | |||||
| Usage of the create_error_macros: | |||||
| */ | |||||
| #define __create_error(keyword, ...) \ | |||||
| create_error( \ | |||||
| __FUNCTION__, __FILE__, __LINE__, \ | |||||
| Memory::get_keyword(keyword), \ | |||||
| __VA_ARGS__) | |||||
| #define create_out_of_memory_error(...) \ | |||||
| __create_error("out-of-memory", __VA_ARGS__) | |||||
| #define create_generic_error(...) \ | |||||
| __create_error("generic", __VA_ARGS__) | |||||
| #define create_not_yet_implemented_error() \ | |||||
| __create_error("not-yet-implemented", "This feature has not yet been implemented.") | |||||
| #define create_parsing_error(...) \ | |||||
| __create_error("parsing-error", __VA_ARGS__) | |||||
| #define create_symbol_undefined_error(...) \ | |||||
| __create_error("symbol-undefined", __VA_ARGS__) | |||||
| #define create_type_missmatch_error(expected, actual) \ | |||||
| __create_error("type-missmatch", \ | |||||
| "Type missmatch: expected %s, got %s", \ | |||||
| expected, actual) | |||||
| #ifdef _DEBUG | |||||
| #define assert_type(_node, _type) \ | |||||
| do { \ | |||||
| if (Memory::get_type(_node) != _type) { \ | |||||
| create_type_missmatch_error( \ | |||||
| lisp_object_type_to_string(_type), \ | |||||
| lisp_object_type_to_string(Memory::get_type(_node))); \ | |||||
| } \ | |||||
| } while(0) | |||||
| #define assert(condition) \ | |||||
| do { \ | |||||
| if (!(condition)) { \ | |||||
| create_generic_error("Assertion-error."); \ | |||||
| } \ | |||||
| } while(0) | |||||
| #else | |||||
| # define assert_arguments_length(expected, actual) do {} while (0) | |||||
| # define assert_arguments_length_less_equal(expected, actual) do {} while (0) | |||||
| # define assert_arguments_length_greater_equal(expected, actual) do {} while (0) | |||||
| # define assert_type(_node, _type) do {} while (0) | |||||
| # define assert(condition) do {} while (0) | |||||
| #endif | |||||
| @@ -1,154 +0,0 @@ | |||||
| #define concat_( a, b) a##b | |||||
| #define label(prefix, lnum) concat_(prefix,lnum) | |||||
| #define log_location() \ | |||||
| do { \ | |||||
| if (Globals::log_level == Log_Level::Debug) { \ | |||||
| printf("in"); \ | |||||
| int spacing = 30-(int)strlen(__FILE__); \ | |||||
| if (spacing < 1) spacing = 1; \ | |||||
| for (int i = 0; i < spacing;++i) \ | |||||
| printf(" "); \ | |||||
| printf("%s (%d) ", __FILE__, __LINE__); \ | |||||
| printf("-> %s\n",__FUNCTION__); \ | |||||
| } \ | |||||
| } while(0) | |||||
| #define if_error_log_location_and_return(val) \ | |||||
| do { \ | |||||
| if (Globals::error) { \ | |||||
| log_location(); \ | |||||
| return val; \ | |||||
| } \ | |||||
| } while(0) | |||||
| #ifdef _DEBUG | |||||
| #define try_or_else_return(val) \ | |||||
| if (1) \ | |||||
| goto label(body,__LINE__); \ | |||||
| else \ | |||||
| while (1) \ | |||||
| if (1) { \ | |||||
| if (Globals::error) { \ | |||||
| log_location(); \ | |||||
| return val; \ | |||||
| } \ | |||||
| break; \ | |||||
| } \ | |||||
| else label(body,__LINE__): | |||||
| ; | |||||
| #else | |||||
| #define try_or_else_return(val) | |||||
| #endif | |||||
| #define try_struct try_or_else_return({}) | |||||
| #define try_void try_or_else_return() | |||||
| #define try try_or_else_return(0) | |||||
| #define dont_break_on_errors fluid_let(Globals::breaking_on_errors, false) | |||||
| #define ignore_logging fluid_let(Globals::log_level, Log_Level::None) | |||||
| #define fetch1(var) \ | |||||
| Lisp_Object* var##_symbol = Memory::get_symbol(#var); \ | |||||
| Lisp_Object* var = lookup_symbol(var##_symbol, get_current_environment()); \ | |||||
| if (Globals::error) printf("in %s:%d\n", __FILE__, __LINE__) | |||||
| #define fetch2(var1, var2) fetch1(var1); fetch1(var2) | |||||
| #define fetch3(var1, var2, var3) fetch2(var1, var2); fetch1(var3) | |||||
| #define fetch4(var1, var2, var3, var4) fetch3(var1, var2, var3); fetch1(var4) | |||||
| #define fetch5(var1, var2, var3, var4, var5) fetch4(var1, var2, var3, var4); fetch1(var5) | |||||
| #define fetch6(var1, var2, var3, var4, var5, var6) fetch5(var1, var2, var3, var4, var5); fetch1(var6) | |||||
| #define fetch7(var1, var2, var3, var4, var5, var6, var7) fetch6(var1, var2, var3, var4, var5, var6); fetch1(var7) | |||||
| #define fetch8(var1, var2, var3, var4, var5, var6, var7, var8) fetch7(var1, var2, var3, var4, var5, var6, var7); fetch1(var8) | |||||
| #define fetch9(var1, var2, var3, var4, var5, var6, var7, var8, var9) fetch8(var1, var2, var3, var4, var5, var6, var7, var8); fetch1(var9) | |||||
| #define fetch10(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10) fetch9(var1, var2, var3, var4, var5, var6, var7, var8, var9); fetch1(var10) | |||||
| #define fetch11(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11) fetch10(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10); fetch1(var11) | |||||
| #define fetch12(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12) fetch11(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11); fetch1(var12) | |||||
| #define fetch13(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13) fetch12(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12); fetch1(var13) | |||||
| #define fetch14(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14) fetch13(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13); fetch1(var14) | |||||
| #define fetch15(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15) fetch14(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14); fetch1(var15) | |||||
| #define fetch16(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16) fetch15(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15); fetch1(var16) | |||||
| #define fetch17(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17) fetch16(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16); fetch1(var17) | |||||
| #define fetch18(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18) fetch17(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17); fetch1(var18) | |||||
| #define fetch19(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19) fetch18(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18); fetch1(var19) | |||||
| #define fetch20(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20) fetch19(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19); fetch1(var20) | |||||
| #define fetch21(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21) fetch20(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20); fetch1(var21) | |||||
| #define fetch22(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22) fetch21(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21); fetch1(var22) | |||||
| #define fetch23(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22, var23) fetch22(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22); fetch1(var23) | |||||
| #define fetch24(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22, var23, var24) fetch23(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22, var23); fetch1(var24) | |||||
| #define GET_MACRO( \ | |||||
| _1, _2, _3, _4, _5, _6, \ | |||||
| _7, _8, _9, _10, _11, _12, \ | |||||
| _13, _14, _15, _16, _17, _18, \ | |||||
| _19, _20, _21, _22, _23, _24, \ | |||||
| NAME, ...) NAME | |||||
| #ifdef _MSC_VER | |||||
| #define EXPAND( x ) x | |||||
| #define fetch(...) EXPAND( \ | |||||
| GET_MACRO( \ | |||||
| __VA_ARGS__, \ | |||||
| fetch24, fetch23, fetch22, fetch21, fetch20, fetch19, \ | |||||
| fetch18, fetch17, fetch16, fetch15, fetch14, fetch13, \ | |||||
| fetch12, fetch11, fetch10, fetch9, fetch8, fetch7, \ | |||||
| fetch6, fetch5, fetch4, fetch3, fetch2, fetch1 \ | |||||
| )(__VA_ARGS__)) | |||||
| #else | |||||
| #define fetch(...) \ | |||||
| GET_MACRO( \ | |||||
| __VA_ARGS__, \ | |||||
| fetch24, fetch23, fetch22, fetch21, fetch20, fetch19, \ | |||||
| fetch18, fetch17, fetch16, fetch15, fetch14, fetch13, \ | |||||
| fetch12, fetch11, fetch10, fetch9, fetch8, fetch7, \ | |||||
| fetch6, fetch5, fetch4, fetch3, fetch2, fetch1 \ | |||||
| )(__VA_ARGS__) | |||||
| #endif | |||||
| // NOTE(Felix): we have to copy the string because we need it to be | |||||
| // mutable for the parser to work, because the parser relys on being | |||||
| // able to temporaily put in markers in the code and also it will fill | |||||
| // out the source code location | |||||
| #define _define_helper(def, docs, special) \ | |||||
| Parser::parser_file = file_name_built_ins; \ | |||||
| Parser::parser_line = __LINE__; \ | |||||
| Parser::parser_col = 0; \ | |||||
| auto label(params,__LINE__) = Parser::parse_single_expression( \ | |||||
| Memory::get_c_str(Memory::create_string(#def))); \ | |||||
| if_error_log_location_and_return(nullptr); \ | |||||
| assert_type(label(params,__LINE__), Lisp_Object_Type::Pair); \ | |||||
| assert_type(label(params,__LINE__)->value.pair.first, Lisp_Object_Type::Symbol); \ | |||||
| auto label(sym,__LINE__) = label(params,__LINE__)->value.pair.first; \ | |||||
| auto label(sfun,__LINE__) = Memory::create_lisp_object_cfunction(special); \ | |||||
| create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \ | |||||
| if_error_log_location_and_return(nullptr); \ | |||||
| label(sfun,__LINE__)->docstring = Memory::create_string(docs); \ | |||||
| define_symbol(label(sym,__LINE__), label(sfun,__LINE__)); \ | |||||
| label(sfun,__LINE__)->value.cFunction->body = []() -> Lisp_Object* | |||||
| #define define(def, docs) _define_helper(def, docs, false) | |||||
| #define define_special(def, docs) _define_helper(def, docs, true) | |||||
| #define in_caller_env fluid_let( \ | |||||
| Globals::Current_Execution::envi_stack.next_index, \ | |||||
| Globals::Current_Execution::envi_stack.next_index-1) | |||||
| /* | |||||
| * iterate over lisp vectors | |||||
| */ | |||||
| #define for_lisp_vector(v) \ | |||||
| if (!v); else \ | |||||
| if (int it_index = 0); else \ | |||||
| for (auto it = v->value.vector.data; \ | |||||
| it_index < v->value.vector.length; \ | |||||
| it=v->value.vector.data+(++it_index)) | |||||
| /* | |||||
| * iterate over lisp lists | |||||
| */ | |||||
| #define for_lisp_list(l) \ | |||||
| if (!l); else \ | |||||
| if (int it_index = 0); else \ | |||||
| for (Lisp_Object* head = l, *it; \ | |||||
| Memory::get_type(head) == Lisp_Object_Type::Pair && (it = head->value.pair.first); \ | |||||
| head = head->value.pair.rest, ++it_index) | |||||
| @@ -1,237 +0,0 @@ | |||||
| #pragma once | |||||
| // #include <functional> | |||||
| #include "ftb/arraylist.hpp" | |||||
| #include "ftb/hashmap.hpp" | |||||
| namespace Slime { | |||||
| struct Lisp_Object; | |||||
| struct String; | |||||
| struct Environment; | |||||
| enum struct Thread_Type { | |||||
| Main, | |||||
| GarbageCollection | |||||
| }; | |||||
| enum struct Lisp_Object_Type { | |||||
| Nil, | |||||
| T, | |||||
| Symbol, | |||||
| Keyword, | |||||
| Number, | |||||
| String, | |||||
| Pair, | |||||
| Vector, | |||||
| Continuation, | |||||
| Pointer, | |||||
| HashMap, | |||||
| // OwningPointer, | |||||
| Function, | |||||
| CFunction, | |||||
| }; | |||||
| enum class Lisp_Object_Flags | |||||
| { | |||||
| // bits 1 to 5 (including) will be reserved for the type | |||||
| Already_Garbage_Collected = 1 << 5, | |||||
| Under_Construction = 1 << 6, | |||||
| }; | |||||
| enum struct Function_Type { | |||||
| Lambda, | |||||
| Macro | |||||
| }; | |||||
| enum struct Log_Level { | |||||
| None, | |||||
| Critical, | |||||
| Warning, | |||||
| Info, | |||||
| Debug, | |||||
| }; | |||||
| struct Continuation { | |||||
| Array_List<Lisp_Object*> call_stack; | |||||
| Array_List<Environment*> envi_stack; | |||||
| }; | |||||
| struct String { | |||||
| int length; | |||||
| char data; | |||||
| }; | |||||
| struct Source_Code_Location { | |||||
| String* file; | |||||
| int line; | |||||
| int column; | |||||
| }; | |||||
| struct Pair { | |||||
| Lisp_Object* first; | |||||
| Lisp_Object* rest; | |||||
| }; | |||||
| struct Vector { | |||||
| int length; | |||||
| Lisp_Object* data; | |||||
| }; | |||||
| struct Positional_Arguments { | |||||
| Array_List<Lisp_Object*> symbols; | |||||
| }; | |||||
| struct Keyword_Arguments { | |||||
| // Array of Pointers to Lisp_Object<Keyword> | |||||
| Array_List<Lisp_Object*> keywords; | |||||
| // NOTE(Felix): values[i] will be nullptr if no defalut value was | |||||
| // declared for key identifiers[i] | |||||
| Array_List<Lisp_Object*> values; | |||||
| }; | |||||
| struct Arguments { | |||||
| Positional_Arguments positional; | |||||
| Keyword_Arguments keyword; | |||||
| // NOTE(Felix): rest_argument will be nullptr if no rest argument | |||||
| // is declared otherwise its a symbol | |||||
| Lisp_Object* rest; | |||||
| }; | |||||
| struct Environment { | |||||
| Array_List<Environment*> parents; | |||||
| Hash_Map<void*, Lisp_Object*> hm; | |||||
| ~Environment() { | |||||
| parents.~Array_List(); | |||||
| hm.~Hash_Map(); | |||||
| } | |||||
| }; | |||||
| struct Function { | |||||
| Function_Type type; | |||||
| Arguments args; | |||||
| Lisp_Object* body; // maybe implicit begin | |||||
| Environment* parent_environment; // we are doing closures now!! | |||||
| }; | |||||
| struct cFunction { | |||||
| Lisp_Object* (*body)(); | |||||
| Arguments args; | |||||
| bool is_special_form; | |||||
| }; | |||||
| struct Lisp_Object { | |||||
| Source_Code_Location* sourceCodeLocation; | |||||
| u64 flags; | |||||
| Lisp_Object* userType; // keyword | |||||
| String* docstring; | |||||
| union value { | |||||
| String* symbol; // used for symbols and keywords | |||||
| double number; | |||||
| String* string; | |||||
| Pair pair; | |||||
| Vector vector; | |||||
| Function* function; | |||||
| cFunction* cFunction; | |||||
| void* pointer; | |||||
| Continuation* continuation; | |||||
| Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap; | |||||
| ~value() {} | |||||
| } value; | |||||
| ~Lisp_Object(); | |||||
| }; | |||||
| struct Error { | |||||
| Lisp_Object* position; | |||||
| // type has to be a keyword | |||||
| Lisp_Object* type; | |||||
| String* message; | |||||
| }; | |||||
| const wchar_t* char_to_wchar(const char* c); | |||||
| char* read_entire_file(char* filename); | |||||
| void add_to_load_path(const char*); | |||||
| bool lisp_object_equal(Lisp_Object*,Lisp_Object*); | |||||
| Lisp_Object* built_in_load(String*); | |||||
| Lisp_Object* built_in_import(String*); | |||||
| void delete_error(); | |||||
| void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...); | |||||
| void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, String* message); | |||||
| void create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line); | |||||
| Lisp_Object* eval_arguments(Lisp_Object*); | |||||
| Lisp_Object* eval_expr(Lisp_Object*); | |||||
| bool is_truthy (Lisp_Object*); | |||||
| int list_length(Lisp_Object*); | |||||
| void* load_built_ins_into_environment(); | |||||
| void create_arguments_from_lambda_list_and_inject(Lisp_Object* formal_arguments, Lisp_Object* function); | |||||
| Lisp_Object* lookup_symbol(Lisp_Object* symbol, Environment*); | |||||
| void define_symbol(Lisp_Object* symbol, Lisp_Object* value); | |||||
| void print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout); | |||||
| void print_environment(Environment*); | |||||
| bool run_all_tests(); | |||||
| inline Environment* get_root_environment(); | |||||
| inline Environment* get_current_environment(); | |||||
| inline void push_environment(Environment*); | |||||
| inline void pop_environment(); | |||||
| const char* lisp_object_type_to_string(Lisp_Object_Type type); | |||||
| void visualize_lisp_machine(); | |||||
| void generate_docs(String* path); | |||||
| void log_error(); | |||||
| namespace Memory { | |||||
| Environment* create_built_ins_environment(); | |||||
| Lisp_Object* create_lisp_object_cfunction(bool is_special); | |||||
| inline Lisp_Object_Type get_type(Lisp_Object* node); | |||||
| void init(int); | |||||
| char* get_c_str(String*); | |||||
| void free_everything(); | |||||
| String* create_string(const char*); | |||||
| Lisp_Object* get_symbol(String* identifier); | |||||
| Lisp_Object* get_symbol(const char*); | |||||
| Lisp_Object* get_keyword(String* identifier); | |||||
| Lisp_Object* get_keyword(const char*); | |||||
| Lisp_Object* create_lisp_object(double); | |||||
| Lisp_Object* create_lisp_object(const char*); | |||||
| Lisp_Object* create_lisp_object_vector(Lisp_Object*); | |||||
| Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*); | |||||
| Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*, Lisp_Object*); | |||||
| Lisp_Object* create_lisp_object_vector(int, Lisp_Object*); | |||||
| inline Lisp_Object* create_list(Lisp_Object*); | |||||
| inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*); | |||||
| inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*); | |||||
| inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*); | |||||
| inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*); | |||||
| inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*,Lisp_Object*); | |||||
| } | |||||
| namespace Parser { | |||||
| // extern Environment* environment_for_macros; | |||||
| extern String* standard_in; | |||||
| extern String* parser_file; | |||||
| extern int parser_line; | |||||
| extern int parser_col; | |||||
| Lisp_Object* parse_single_expression(char* text); | |||||
| Lisp_Object* parse_single_expression(wchar_t* text); | |||||
| } | |||||
| namespace Globals { | |||||
| extern char* bin_path; | |||||
| extern Log_Level log_level; | |||||
| extern Array_List<void*> load_path; | |||||
| namespace Current_Execution { | |||||
| extern Array_List<Lisp_Object*> call_stack; | |||||
| extern Array_List<Environment*> envi_stack; | |||||
| } | |||||
| extern Error* error; | |||||
| extern bool breaking_on_errors; | |||||
| } | |||||
| } | |||||
| @@ -1,398 +0,0 @@ | |||||
| namespace Parser { | |||||
| String* standard_in; | |||||
| String* parser_file; | |||||
| int parser_line; | |||||
| int parser_col; | |||||
| proc eat_comment_line(char* text, int* index_in_text) -> void { | |||||
| // safety check if we are actually starting a comment here | |||||
| if (text[*index_in_text] != ';') | |||||
| return; | |||||
| // eat the comment line | |||||
| do { | |||||
| ++(*index_in_text); | |||||
| ++parser_col; | |||||
| } while (text[(*index_in_text)] != '\n' && | |||||
| text[(*index_in_text)] != '\r' && | |||||
| text[(*index_in_text)] != '\0'); | |||||
| } | |||||
| proc step_char(char* text, int* index_in_text, int steps = 1) { | |||||
| for (int i = 0; i < steps; ++i) { | |||||
| if (text[(*index_in_text)] == '\n') { | |||||
| ++parser_line; | |||||
| parser_col = 0; | |||||
| } | |||||
| ++parser_col; | |||||
| ++(*index_in_text); | |||||
| } | |||||
| } | |||||
| proc eat_whitespace(char* text, int* index_in_text) -> void { | |||||
| // skip whitespaces | |||||
| while (text[(*index_in_text)] == ' ' || | |||||
| text[(*index_in_text)] == '\t' || | |||||
| text[(*index_in_text)] == '\n' || | |||||
| text[(*index_in_text)] == '\r') | |||||
| { | |||||
| step_char(text, index_in_text); | |||||
| } | |||||
| } | |||||
| proc eat_until_code(char* text, int* index_in_text) -> void { | |||||
| profile_this(); | |||||
| int position_before; | |||||
| do { | |||||
| position_before = *index_in_text; | |||||
| eat_comment_line(text, index_in_text); | |||||
| eat_whitespace(text, index_in_text); | |||||
| } while (position_before != *index_in_text); | |||||
| } | |||||
| proc step_char_and_eat_until_code(char* text, int* index_in_text) { | |||||
| step_char(text, index_in_text); | |||||
| eat_until_code(text, index_in_text); | |||||
| } | |||||
| proc parse_fancy_delimiter(char* text, int* index_in_text, char l_delimiter, char r_delimiter, Lisp_Object* first_elem) -> Lisp_Object* { | |||||
| profile_this(); | |||||
| if (text[*index_in_text] != l_delimiter) { | |||||
| create_parsing_error("a fancy cannot be parsed here"); | |||||
| return nullptr; | |||||
| } | |||||
| Lisp_Object* ret; | |||||
| Lisp_Object* head; | |||||
| try ret = Memory::create_lisp_object_pair(first_elem, Memory::nil); | |||||
| head = ret; | |||||
| step_char(text, index_in_text); | |||||
| eat_until_code(text, index_in_text); | |||||
| while (text[*index_in_text] != r_delimiter) { | |||||
| Lisp_Object* element; | |||||
| try element = parse_expression(text, index_in_text); | |||||
| try head->value.pair.rest = Memory::create_lisp_object_pair(element, Memory::nil); | |||||
| head = head->value.pair.rest; | |||||
| eat_until_code(text, index_in_text); | |||||
| } | |||||
| step_char(text, index_in_text); | |||||
| return ret; | |||||
| } | |||||
| proc get_atom_text_length(char* text, int* index_in_text) -> int { | |||||
| int atom_length = 0; | |||||
| while (text[*index_in_text+atom_length] != ' ' && | |||||
| text[*index_in_text+atom_length] != ')' && | |||||
| text[*index_in_text+atom_length] != '(' && | |||||
| text[*index_in_text+atom_length] != '[' && | |||||
| text[*index_in_text+atom_length] != ']' && | |||||
| text[*index_in_text+atom_length] != '{' && | |||||
| text[*index_in_text+atom_length] != '}' && | |||||
| text[*index_in_text+atom_length] != '\0' && | |||||
| text[*index_in_text+atom_length] != '\n' && | |||||
| text[*index_in_text+atom_length] != '\r' && | |||||
| text[*index_in_text+atom_length] != '\t') | |||||
| { | |||||
| ++atom_length; | |||||
| } | |||||
| return atom_length; | |||||
| } | |||||
| proc parse_number(char* text, int* index_in_text) -> Lisp_Object* { | |||||
| Lisp_Object* ret; | |||||
| try ret = Memory::create_lisp_object(0.0); | |||||
| sscanf(text+*index_in_text, "%lf", &ret->value.number); | |||||
| int atom_length = get_atom_text_length(text, index_in_text); | |||||
| step_char(text, index_in_text, atom_length); | |||||
| return ret; | |||||
| } | |||||
| proc parse_symbol_or_keyword(char* text, int* index_in_text) -> Lisp_Object* { | |||||
| bool keyword = false; | |||||
| if (text[*index_in_text] == ':') { | |||||
| keyword = true; | |||||
| step_char(text, index_in_text); | |||||
| } | |||||
| int atom_length = get_atom_text_length(text, index_in_text); | |||||
| char orig = text[*index_in_text+atom_length]; | |||||
| text[*index_in_text+atom_length] = '\0'; | |||||
| String* str_keyword; | |||||
| Lisp_Object* ret; | |||||
| try str_keyword = Memory::create_string("", atom_length); | |||||
| strcpy(&str_keyword->data, text+*index_in_text); | |||||
| if (keyword) { | |||||
| try ret = Memory::get_keyword(str_keyword); | |||||
| } else { | |||||
| try ret = Memory::get_symbol(str_keyword); | |||||
| } | |||||
| text[*index_in_text+atom_length] = orig; | |||||
| step_char(text, index_in_text, atom_length); | |||||
| return ret; | |||||
| } | |||||
| proc parse_string(char* text, int* index_in_text) -> Lisp_Object* { | |||||
| // the first character is the '"' | |||||
| step_char(text, index_in_text); | |||||
| // now we are at the first letter, if this is the closing '"' then | |||||
| // it's easy | |||||
| if (text[*index_in_text] == '"') { | |||||
| Lisp_Object* ret; | |||||
| try ret = Memory::create_lisp_object(Memory::create_string("", 0)); | |||||
| // inject_scl(ret); | |||||
| // plus one because we want to go after the quotes | |||||
| step_char(text, index_in_text); | |||||
| return ret; | |||||
| } | |||||
| // okay so the first letter was not actually closing the string... | |||||
| int string_length = 0; | |||||
| bool escaping = false; | |||||
| while (escaping || text[*index_in_text+string_length] != '"') { | |||||
| if (escaping) { | |||||
| escaping = false; | |||||
| } | |||||
| else | |||||
| if (text[*index_in_text+string_length] == '\\') | |||||
| escaping = true; | |||||
| ++string_length; | |||||
| } | |||||
| // we found the end of the string | |||||
| text[*index_in_text+string_length] = '\0'; | |||||
| // NOTE(Felix): Tactic: Through unescaping the string will | |||||
| // only get shorter, so we replace it inplace and later jump | |||||
| // to the original end of the string. | |||||
| int new_len; | |||||
| try new_len = unescape_string(text+(*index_in_text)); | |||||
| String* string = Memory::create_string("", new_len); | |||||
| strcpy(&string->data, text+(*index_in_text)); | |||||
| // printf("------ %s\n", &string->data); | |||||
| text[*index_in_text+string_length] = '"'; | |||||
| // plus one because we want to go after the quotes | |||||
| step_char(text, index_in_text, string_length+1); | |||||
| Lisp_Object* ret; | |||||
| try ret = Memory::create_lisp_object(string); | |||||
| // inject_scl(ret); | |||||
| return ret; | |||||
| } | |||||
| proc parse_atom(char* text, int* index_in_text) -> Lisp_Object* { | |||||
| profile_this(); | |||||
| Lisp_Object* ret; | |||||
| // numbers | |||||
| if ((text[*index_in_text] <= 57 && // if number | |||||
| text[*index_in_text] >= 48) | |||||
| || | |||||
| ((text[*index_in_text] == '+' || // or if sign and then number | |||||
| text[*index_in_text] == '-') | |||||
| && | |||||
| (text[*index_in_text +1] <= 57 && | |||||
| text[*index_in_text +1] >= 48)) | |||||
| || | |||||
| ((text[*index_in_text] == '.') // or if . and then number | |||||
| && | |||||
| (text[*index_in_text +1] <= 57 && | |||||
| text[*index_in_text +1] >= 48))) | |||||
| { | |||||
| try ret = parse_number(text, index_in_text); | |||||
| } | |||||
| else if (text[*index_in_text] == '"') | |||||
| try ret = parse_string(text, index_in_text); | |||||
| else | |||||
| try ret = parse_symbol_or_keyword(text, index_in_text); | |||||
| return ret; | |||||
| } | |||||
| proc parse_list(char* text, int* index_in_text) -> Lisp_Object* { | |||||
| profile_this(); | |||||
| if (text[*index_in_text] != '(') { | |||||
| create_parsing_error("a list cannot be parsed here"); | |||||
| return nullptr; | |||||
| } | |||||
| step_char_and_eat_until_code(text, index_in_text); | |||||
| if (text[*index_in_text] == ')') { | |||||
| step_char(text, index_in_text); | |||||
| return Memory::nil; | |||||
| } | |||||
| Lisp_Object* first_elem; | |||||
| Lisp_Object* ret; | |||||
| Lisp_Object* head; | |||||
| try first_elem = parse_expression(text, index_in_text); | |||||
| try ret = Memory::create_lisp_object_pair(first_elem, Memory::nil); | |||||
| head = ret; | |||||
| eat_until_code(text, index_in_text); | |||||
| while (text[*index_in_text] != ')') { | |||||
| Lisp_Object* element; | |||||
| if (text[*index_in_text+0] == '.' && | |||||
| text[*index_in_text+1] == ' ') | |||||
| { | |||||
| step_char(text, index_in_text, 2); | |||||
| try element = parse_expression(text, index_in_text); | |||||
| head->value.pair.rest = element; | |||||
| eat_until_code(text, index_in_text); | |||||
| if (text[*index_in_text] != ')') { | |||||
| create_parsing_error("expected the list to end after the dotted end."); | |||||
| return nullptr; | |||||
| } | |||||
| step_char(text, index_in_text); | |||||
| return ret; | |||||
| } | |||||
| try element = parse_expression(text, index_in_text); | |||||
| try head->value.pair.rest = Memory::create_lisp_object_pair(element, Memory::nil); | |||||
| head = head->value.pair.rest; | |||||
| eat_until_code(text, index_in_text); | |||||
| } | |||||
| step_char(text, index_in_text); | |||||
| return ret; | |||||
| } | |||||
| proc maybe_expand_short_form(char* text, int* index_in_text) -> Lisp_Object* { | |||||
| profile_this(); | |||||
| Lisp_Object* vector_sym = Memory::get_symbol("vector"); | |||||
| Lisp_Object* hash_map_sym = Memory::get_symbol("hash-map"); | |||||
| Lisp_Object* quote_sym = Memory::get_symbol("quote"); | |||||
| Lisp_Object* quasiquote_sym = Memory::get_symbol("quasiquote"); | |||||
| Lisp_Object* unquote_sym = Memory::get_symbol("unquote"); | |||||
| Lisp_Object* unquote_splicing_sym = Memory::get_symbol("unquote-splicing"); | |||||
| Lisp_Object* ret = nullptr; | |||||
| Lisp_Object* expr; | |||||
| switch (text[*index_in_text]) { | |||||
| case '\'': { | |||||
| // quote | |||||
| step_char_and_eat_until_code(text, index_in_text); | |||||
| try expr = parse_expression(text, index_in_text); | |||||
| try ret = Memory::create_lisp_object_pair(expr, Memory::nil); | |||||
| try ret = Memory::create_lisp_object_pair(quote_sym, ret); | |||||
| } break; | |||||
| case '`': { | |||||
| // quasiquote | |||||
| step_char_and_eat_until_code(text, index_in_text); | |||||
| try expr = parse_expression(text, index_in_text); | |||||
| try ret = Memory::create_lisp_object_pair(expr, Memory::nil); | |||||
| try ret = Memory::create_lisp_object_pair(quasiquote_sym, ret); | |||||
| } break; | |||||
| case ',': { | |||||
| step_char_and_eat_until_code(text, index_in_text); | |||||
| if (text[*index_in_text] == '@') { | |||||
| // unquote-splicing | |||||
| step_char_and_eat_until_code(text, index_in_text); | |||||
| try expr = parse_expression(text, index_in_text); | |||||
| try ret = Memory::create_lisp_object_pair(expr, Memory::nil); | |||||
| try ret = Memory::create_lisp_object_pair(unquote_splicing_sym, ret); | |||||
| } else { | |||||
| // unquote | |||||
| try expr = parse_expression(text, index_in_text); | |||||
| try ret = Memory::create_lisp_object_pair(expr, Memory::nil); | |||||
| try ret = Memory::create_lisp_object_pair(unquote_sym, ret); | |||||
| } | |||||
| } break; | |||||
| case '[': { | |||||
| // vector | |||||
| try ret = parse_fancy_delimiter(text, index_in_text, '[', ']', vector_sym); | |||||
| } break; | |||||
| case '{': { | |||||
| // hashmap | |||||
| try ret = parse_fancy_delimiter(text, index_in_text, '{', '}', hash_map_sym); | |||||
| } break; | |||||
| default: break; | |||||
| } | |||||
| return ret; | |||||
| } | |||||
| proc parse_expression(char* text, int* index_in_text) -> Lisp_Object* { | |||||
| profile_this(); | |||||
| Lisp_Object* ret; | |||||
| eat_until_code(text, index_in_text); | |||||
| try ret = maybe_expand_short_form(text, index_in_text); | |||||
| if (ret) | |||||
| return ret; | |||||
| if (text[*index_in_text] == '(') { | |||||
| try ret = parse_list(text, index_in_text); | |||||
| } else { | |||||
| try ret = parse_atom(text, index_in_text); | |||||
| } | |||||
| return ret; | |||||
| } | |||||
| proc parse_single_expression(wchar_t* text) -> Lisp_Object* { | |||||
| char* res = wchar_to_char(text); | |||||
| defer {free(res);}; | |||||
| return parse_single_expression(res); | |||||
| } | |||||
| proc parse_single_expression(char* text) -> Lisp_Object* { | |||||
| parser_file = standard_in; | |||||
| parser_line = 1; | |||||
| parser_col = 1; | |||||
| int index_in_text = 0; | |||||
| Lisp_Object* ret; | |||||
| try ret = parse_expression(text, &index_in_text); | |||||
| return ret; | |||||
| } | |||||
| proc parse_program(String* file_name, char* text) -> Array_List<Lisp_Object*>* { | |||||
| profile_this(); | |||||
| parser_file = file_name; | |||||
| parser_line = 1; | |||||
| parser_col = 0; | |||||
| Array_List<Lisp_Object*>* program = new Array_List<Lisp_Object*>; | |||||
| int index_in_text = 0; | |||||
| Lisp_Object* parsed; | |||||
| eat_until_code(text, &index_in_text); | |||||
| while (text[index_in_text] != '\0') { | |||||
| try parsed = parse_expression(text, &index_in_text); | |||||
| program->append(parsed); | |||||
| eat_until_code(text, &index_in_text); | |||||
| } | |||||
| return program; | |||||
| } | |||||
| } | |||||
| @@ -14,7 +14,7 @@ | |||||
| ;; "% a b" | ;; "% a b" | ||||
| ;; "get-random-between a b" | ;; "get-random-between a b" | ||||
| ;; "assert test" | ;; "assert test" | ||||
| ;; "define-syntax form (:doc \"\") . body" | |||||
| ;; "define-macro form (:doc \"\") . body" | |||||
| ;; "define definee (:doc \"\") . body" | ;; "define definee (:doc \"\") . body" | ||||
| ;; "mutate target source" | ;; "mutate target source" | ||||
| ;; "vector-length v" | ;; "vector-length v" | ||||
| @@ -44,7 +44,7 @@ | |||||
| ;; "info n" | ;; "info n" | ||||
| ;; "show n" | ;; "show n" | ||||
| ;; "addr-of var" | ;; "addr-of var" | ||||
| ;; "generate-docs file_name" | |||||
| ;; "generate-docs-file file_name" | |||||
| ;; "print (:sep \" \") (:end \"\\n\") . things" | ;; "print (:sep \" \") (:end \"\\n\") . things" | ||||
| ;; "read (:prompt \">\"" | ;; "read (:prompt \">\"" | ||||
| ;; "exit (:code 0)" | ;; "exit (:code 0)" | ||||
| @@ -62,13 +62,13 @@ | |||||
| (defconst slime-built-ins | (defconst slime-built-ins | ||||
| '("=" ">" ">=" "<" "<=" "+" "-" "*" "/" "**" "%" "get-random-between" | '("=" ">" ">=" "<" "<=" "+" "-" "*" "/" "**" "%" "get-random-between" | ||||
| "assert" "define" "define-syntax" "mutate" "if" "vector-length" | |||||
| "assert" "define" "define-macro" "mutate" "if" "vector-length" | |||||
| "vector-ref" "vector-set!" "set!" "set-car!" "set-cdr!" | "vector-ref" "vector-set!" "set!" "set-car!" "set-cdr!" | ||||
| "quote" "quasiquote" "unquote" "unquote-splicing" "and" "or" "not" "let" | "quote" "quasiquote" "unquote" "unquote-splicing" "and" "or" "not" "let" | ||||
| "lambda" "apply" "eval" "begin" "list" "pair" "create-hash-map" | "lambda" "apply" "eval" "begin" "list" "pair" "create-hash-map" | ||||
| "hash-map-get" "hash-map-set!" "hash-map-delete!" "vector" | "hash-map-get" "hash-map-set!" "hash-map-delete!" "vector" | ||||
| "first" "rest" "set-type!" "delete-type!" "type" "info" "mem-reset" | "first" "rest" "set-type!" "delete-type!" "type" "info" "mem-reset" | ||||
| "show" "addr-of" "generate-docs" "print" "read" "exit" "break" "memstat" | |||||
| "show" "addr-of" "generate-docs-file" "print" "read" "exit" "break" "memstat" | |||||
| "mytry" "load" "import" "copy" "error" "symbol->keyword" "string->symbol" | "mytry" "load" "import" "copy" "error" "symbol->keyword" "string->symbol" | ||||
| "symbol->string" "concat-strings")) | "symbol->string" "concat-strings")) | ||||
| @@ -88,8 +88,8 @@ | |||||
| ((string= s "get-random-between") "a b") | ((string= s "get-random-between") "a b") | ||||
| ((string= s "assert") "test") | ((string= s "assert") "test") | ||||
| ((string= s "define") "definee (:doc \"\") . body") | ((string= s "define") "definee (:doc \"\") . body") | ||||
| ((string= s "define-syntax") "form (:doc \"\") . body") | |||||
| ((string= s "mutate") "(mutate <expression> <expression>)") | |||||
| ((string= s "define-macro") "form (:doc \"\") . body") | |||||
| ((string= s "mutate!") "(mutate! <expression> <expression>)") | |||||
| ((string= s "if") "(if <test> <consequence> <alternative>)") | ((string= s "if") "(if <test> <consequence> <alternative>)") | ||||
| (t '()))) | (t '()))) | ||||
| @@ -122,7 +122,7 @@ | |||||
| (put 'lambda 'doc-string-elt 2) | (put 'lambda 'doc-string-elt 2) | ||||
| (put 'special-lambda 'doc-string-elt 2) | (put 'special-lambda 'doc-string-elt 2) | ||||
| (put 'define 'doc-string-elt 2) | (put 'define 'doc-string-elt 2) | ||||
| (put 'define-syntax 'doc-string-elt 2) | |||||
| (put 'define-macro 'doc-string-elt 2) | |||||
| (define-derived-mode slime-mode prog-mode "(slime)" | (define-derived-mode slime-mode prog-mode "(slime)" | ||||
| "Major mode for editing slime code." | "Major mode for editing slime code." | ||||
| @@ -12,7 +12,7 @@ namespace Slime { | |||||
| case Lisp_Object_Type::Symbol: | case Lisp_Object_Type::Symbol: | ||||
| case Lisp_Object_Type::Keyword: | case Lisp_Object_Type::Keyword: | ||||
| case Lisp_Object_Type::Function: | case Lisp_Object_Type::Function: | ||||
| // TODO(Felix): should a pointer | |||||
| // QUESTION(Felix): should a pointer | |||||
| // object compare the pointer? | // object compare the pointer? | ||||
| case Lisp_Object_Type::Pointer: | case Lisp_Object_Type::Pointer: | ||||
| case Lisp_Object_Type::Continuation: return false; | case Lisp_Object_Type::Continuation: return false; | ||||
| @@ -36,7 +36,7 @@ namespace Slime { | |||||
| n1_keys.sort(); | n1_keys.sort(); | ||||
| n2_keys.sort(); | n2_keys.sort(); | ||||
| for (int i = 0; i < n1_keys.next_index; ++i) { | |||||
| for (u32 i = 0; i < n1_keys.next_index; ++i) { | |||||
| if (!lisp_object_equal(n1_keys[i], n2_keys[i])) | if (!lisp_object_equal(n1_keys[i], n2_keys[i])) | ||||
| return false; | return false; | ||||
| if (!lisp_object_equal(n1->value.hashMap->get_object(n1_keys[i]), | if (!lisp_object_equal(n1->value.hashMap->get_object(n1_keys[i]), | ||||
| @@ -49,7 +49,7 @@ namespace Slime { | |||||
| case Lisp_Object_Type::Vector: { | case Lisp_Object_Type::Vector: { | ||||
| if (n1->value.vector.length != n2->value.vector.length ) | if (n1->value.vector.length != n2->value.vector.length ) | ||||
| return false; | return false; | ||||
| for (int i = 0; i < n1->value.vector.length; ++i) { | |||||
| for (u32 i = 0; i < n1->value.vector.length; ++i) { | |||||
| if (!lisp_object_equal(n1->value.vector.data+i, n2->value.vector.data+i)) | if (!lisp_object_equal(n1->value.vector.data+i, n2->value.vector.data+i)) | ||||
| return false; | return false; | ||||
| } | } | ||||
| @@ -149,12 +149,6 @@ namespace Slime { | |||||
| String file_name_built_ins = Memory::create_string(__FILE__); | String file_name_built_ins = Memory::create_string(__FILE__); | ||||
| defer_free(file_name_built_ins.data); | defer_free(file_name_built_ins.data); | ||||
| define((remove_when_double_free_is_fixed (:k1 ()) (:k2 ()) . rest), "") { | |||||
| return Memory::nil; | |||||
| }; | |||||
| define((remove_when_double_free_is_fixed_2 (:k1 ()) (:k2 ()) . rest), "") { | |||||
| return Memory::nil; | |||||
| }; | |||||
| define_macro((apply fun fun_args), "TODO") { | define_macro((apply fun fun_args), "TODO") { | ||||
| // NOTE(Felix): is has to be a macro because apply by | // NOTE(Felix): is has to be a macro because apply by | ||||
| // itself cannot return the result, we have to invoke eval | // itself cannot return the result, we have to invoke eval | ||||
| @@ -207,7 +201,7 @@ namespace Slime { | |||||
| { | { | ||||
| define_symbol( | define_symbol( | ||||
| Memory::get_symbol("c"), | Memory::get_symbol("c"), | ||||
| Memory::create_lisp_object((double)0)); | |||||
| Memory::create_lisp_object((f64)0)); | |||||
| String file_name_built_ins = Memory::create_string(__FILE__); | String file_name_built_ins = Memory::create_string(__FILE__); | ||||
| define((lambda), "") { | define((lambda), "") { | ||||
| fetch(c); | fetch(c); | ||||
| @@ -236,7 +230,7 @@ namespace Slime { | |||||
| profile_with_name("(begin)"); | profile_with_name("(begin)"); | ||||
| using namespace Globals::Current_Execution; | using namespace Globals::Current_Execution; | ||||
| Lisp_Object* args = pcs[--pcs.next_index]; | Lisp_Object* args = pcs[--pcs.next_index]; | ||||
| int length = list_length(args); | |||||
| u32 length = list_length(args); | |||||
| cs.reserve(length); | cs.reserve(length); | ||||
| for_lisp_list(args) { | for_lisp_list(args) { | ||||
| cs.data[cs.next_index - 1 + (length - it_index)] = it; | cs.data[cs.next_index - 1 + (length - it_index)] = it; | ||||
| @@ -402,7 +396,7 @@ namespace Slime { | |||||
| define((> . args), "TODO") { | define((> . args), "TODO") { | ||||
| profile_with_name("(>)"); | profile_with_name("(>)"); | ||||
| fetch(args); | fetch(args); | ||||
| double last_number = strtod("Inf", NULL); | |||||
| f64 last_number = strtod("Inf", 0); | |||||
| for_lisp_list (args) { | for_lisp_list (args) { | ||||
| try assert_type(it, Lisp_Object_Type::Number); | try assert_type(it, Lisp_Object_Type::Number); | ||||
| @@ -417,7 +411,7 @@ namespace Slime { | |||||
| { | { | ||||
| profile_with_name("(>=)"); | profile_with_name("(>=)"); | ||||
| fetch(args); | fetch(args); | ||||
| double last_number = strtod("Inf", NULL); | |||||
| f64 last_number = strtod("Inf", 0); | |||||
| for_lisp_list (args) { | for_lisp_list (args) { | ||||
| try assert_type(it, Lisp_Object_Type::Number); | try assert_type(it, Lisp_Object_Type::Number); | ||||
| @@ -432,7 +426,7 @@ namespace Slime { | |||||
| { | { | ||||
| profile_with_name("(<)"); | profile_with_name("(<)"); | ||||
| fetch(args); | fetch(args); | ||||
| double last_number = strtod("-Inf", NULL); | |||||
| f64 last_number = strtod("-Inf", 0); | |||||
| for_lisp_list (args) { | for_lisp_list (args) { | ||||
| try assert_type(it, Lisp_Object_Type::Number); | try assert_type(it, Lisp_Object_Type::Number); | ||||
| @@ -447,7 +441,7 @@ namespace Slime { | |||||
| { | { | ||||
| profile_with_name("(<=)"); | profile_with_name("(<=)"); | ||||
| fetch(args); | fetch(args); | ||||
| double last_number = strtod("-Inf", NULL); | |||||
| f64 last_number = strtod("-Inf", 0); | |||||
| for_lisp_list (args) { | for_lisp_list (args) { | ||||
| try assert_type(it, Lisp_Object_Type::Number); | try assert_type(it, Lisp_Object_Type::Number); | ||||
| @@ -463,7 +457,7 @@ namespace Slime { | |||||
| profile_with_name("(+)"); | profile_with_name("(+)"); | ||||
| fetch(args); | fetch(args); | ||||
| double sum = 0; | |||||
| f64 sum = 0; | |||||
| for_lisp_list (args) { | for_lisp_list (args) { | ||||
| try assert_type(it, Lisp_Object_Type::Number); | try assert_type(it, Lisp_Object_Type::Number); | ||||
| @@ -481,7 +475,7 @@ namespace Slime { | |||||
| try assert_type(args->value.pair.first, Lisp_Object_Type::Number); | try assert_type(args->value.pair.first, Lisp_Object_Type::Number); | ||||
| double difference = args->value.pair.first->value.number; | |||||
| f64 difference = args->value.pair.first->value.number; | |||||
| if (args->value.pair.rest == Memory::nil) { | if (args->value.pair.rest == Memory::nil) { | ||||
| return Memory::create_lisp_object(-difference); | return Memory::create_lisp_object(-difference); | ||||
| @@ -502,7 +496,7 @@ namespace Slime { | |||||
| return Memory::create_lisp_object(1); | return Memory::create_lisp_object(1); | ||||
| } | } | ||||
| double product = 1; | |||||
| f64 product = 1; | |||||
| for_lisp_list (args) { | for_lisp_list (args) { | ||||
| try assert_type(it, Lisp_Object_Type::Number); | try assert_type(it, Lisp_Object_Type::Number); | ||||
| @@ -522,7 +516,7 @@ namespace Slime { | |||||
| try assert_type(args->value.pair.first, Lisp_Object_Type::Number); | try assert_type(args->value.pair.first, Lisp_Object_Type::Number); | ||||
| double quotient = args->value.pair.first->value.number; | |||||
| f64 quotient = args->value.pair.first->value.number; | |||||
| for_lisp_list (args->value.pair.rest) { | for_lisp_list (args->value.pair.rest) { | ||||
| try assert_type(it, Lisp_Object_Type::Number); | try assert_type(it, Lisp_Object_Type::Number); | ||||
| @@ -544,8 +538,8 @@ namespace Slime { | |||||
| fetch(a, b); | fetch(a, b); | ||||
| try assert_type(a, Lisp_Object_Type::Number); | try assert_type(a, Lisp_Object_Type::Number); | ||||
| try assert_type(b, Lisp_Object_Type::Number); | try assert_type(b, Lisp_Object_Type::Number); | ||||
| return Memory::create_lisp_object((int)a->value.number % | |||||
| (int)b->value.number); | |||||
| return Memory::create_lisp_object((s32)a->value.number % | |||||
| (s32)b->value.number); | |||||
| }; | }; | ||||
| define((get-random-between a b), "TODO") { | define((get-random-between a b), "TODO") { | ||||
| profile_with_name("(get-random-between)"); | profile_with_name("(get-random-between)"); | ||||
| @@ -553,9 +547,9 @@ namespace Slime { | |||||
| try assert_type(a, Lisp_Object_Type::Number); | try assert_type(a, Lisp_Object_Type::Number); | ||||
| try assert_type(b, Lisp_Object_Type::Number); | try assert_type(b, Lisp_Object_Type::Number); | ||||
| double fa = a->value.number; | |||||
| double fb = b->value.number; | |||||
| double x = (double)rand()/(double)(RAND_MAX); | |||||
| f64 fa = a->value.number; | |||||
| f64 fb = b->value.number; | |||||
| f64 x = (f64)rand()/(f64)(RAND_MAX); | |||||
| x *= (fb - fa); | x *= (fb - fa); | ||||
| x += fa; | x += fa; | ||||
| @@ -585,7 +579,10 @@ namespace Slime { | |||||
| define_special((assert test), "TODO") { | define_special((assert test), "TODO") { | ||||
| profile_with_name("(assert)"); | profile_with_name("(assert)"); | ||||
| fetch(test); | fetch(test); | ||||
| // TODO(Felix): it's probably cleaner to have assert be a | |||||
| // macro + and_then_action to check for error. This is | |||||
| // also cool so we don't see an anditoinal recursive call | |||||
| // in the profiler | |||||
| in_caller_env { | in_caller_env { | ||||
| Lisp_Object* res; | Lisp_Object* res; | ||||
| try res = eval_expr(test); | try res = eval_expr(test); | ||||
| @@ -598,8 +595,8 @@ namespace Slime { | |||||
| free(string); | free(string); | ||||
| return nullptr; | return nullptr; | ||||
| }; | }; | ||||
| define_special((define-syntax form . body), "TODO") { | |||||
| profile_with_name("(define-syntax)"); | |||||
| define_special((define-macro form . body), "TODO") { | |||||
| profile_with_name("(define-macro)"); | |||||
| fetch(form, body); | fetch(form, body); | ||||
| // TODO(Felix): Macros cannot have docs now | // TODO(Felix): Macros cannot have docs now | ||||
| @@ -623,8 +620,8 @@ namespace Slime { | |||||
| } | } | ||||
| return Memory::nil; | return Memory::nil; | ||||
| }; | }; | ||||
| define((mutate target source), "TODO") { | |||||
| profile_with_name("(mutate)"); | |||||
| define((mutate! target source), "TODO") { | |||||
| profile_with_name("(mutate!)"); | |||||
| fetch(target, source); | fetch(target, source); | ||||
| if (target == Memory::nil || | if (target == Memory::nil || | ||||
| @@ -650,7 +647,7 @@ namespace Slime { | |||||
| profile_with_name("(vector-length)"); | profile_with_name("(vector-length)"); | ||||
| fetch(v); | fetch(v); | ||||
| try assert_type(v, Lisp_Object_Type::Vector); | try assert_type(v, Lisp_Object_Type::Vector); | ||||
| return Memory::create_lisp_object((double)v->value.vector.length); | |||||
| return Memory::create_lisp_object((f64)v->value.vector.length); | |||||
| }; | }; | ||||
| define((vector-ref vec idx), "TODO") { | define((vector-ref vec idx), "TODO") { | ||||
| profile_with_name("(vector-ref)"); | profile_with_name("(vector-ref)"); | ||||
| @@ -659,10 +656,10 @@ namespace Slime { | |||||
| try assert_type(vec, Lisp_Object_Type::Vector); | try assert_type(vec, Lisp_Object_Type::Vector); | ||||
| try assert_type(idx, Lisp_Object_Type::Number); | try assert_type(idx, Lisp_Object_Type::Number); | ||||
| int int_idx = ((int)idx->value.number); | |||||
| s32 int_idx = ((s32)idx->value.number); | |||||
| try assert("vector access index must be >= 0", int_idx >= 0); | try assert("vector access index must be >= 0", int_idx >= 0); | ||||
| try assert("vector access index must be < length", int_idx < vec->value.vector.length); | |||||
| try assert("vector access index must be < length", (u32)int_idx < vec->value.vector.length); | |||||
| return vec->value.vector.data+int_idx; | return vec->value.vector.data+int_idx; | ||||
| }; | }; | ||||
| @@ -673,10 +670,10 @@ namespace Slime { | |||||
| try assert_type(vec, Lisp_Object_Type::Vector); | try assert_type(vec, Lisp_Object_Type::Vector); | ||||
| try assert_type(idx, Lisp_Object_Type::Number); | try assert_type(idx, Lisp_Object_Type::Number); | ||||
| int int_idx = ((int)idx->value.number); | |||||
| s32 int_idx = ((s32)idx->value.number); | |||||
| try assert("vector access index must be >= 0", int_idx >= 0); | try assert("vector access index must be >= 0", int_idx >= 0); | ||||
| try assert("vector access index must be < length", int_idx < vec->value.vector.length); | |||||
| try assert("vector access index must be < length", (u32)int_idx < vec->value.vector.length); | |||||
| vec->value.vector.data[int_idx] = *val; | vec->value.vector.data[int_idx] = *val; | ||||
| @@ -920,28 +917,28 @@ namespace Slime { | |||||
| profile_with_name("(vector)"); | profile_with_name("(vector)"); | ||||
| fetch(args); | fetch(args); | ||||
| Lisp_Object* ret; | Lisp_Object* ret; | ||||
| int length = list_length(args); | |||||
| u32 length = list_length(args); | |||||
| try ret = Memory::create_lisp_object_vector(length, args); | try ret = Memory::create_lisp_object_vector(length, args); | ||||
| return ret; | return ret; | ||||
| }; | }; | ||||
| define((pair car cdr), "TODO") { | |||||
| profile_with_name("(pair)"); | |||||
| define((cons car cdr), "TODO") { | |||||
| profile_with_name("(cons)"); | |||||
| fetch(car, cdr); | fetch(car, cdr); | ||||
| Lisp_Object* ret; | Lisp_Object* ret; | ||||
| try ret = Memory::create_lisp_object_pair(car, cdr); | try ret = Memory::create_lisp_object_pair(car, cdr); | ||||
| return ret; | return ret; | ||||
| }; | }; | ||||
| define((first seq), "TODO") { | |||||
| profile_with_name("(first)"); | |||||
| define((car seq), "TODO") { | |||||
| profile_with_name("(car)"); | |||||
| fetch(seq); | fetch(seq); | ||||
| if (seq == Memory::nil) | if (seq == Memory::nil) | ||||
| return Memory::nil; | return Memory::nil; | ||||
| try assert_type(seq, Lisp_Object_Type::Pair); | try assert_type(seq, Lisp_Object_Type::Pair); | ||||
| return seq->value.pair.first; | return seq->value.pair.first; | ||||
| }; | }; | ||||
| define((rest seq), "TODO") { | |||||
| profile_with_name("(rest)"); | |||||
| define((cdr seq), "TODO") { | |||||
| profile_with_name("(cdr)"); | |||||
| fetch(seq); | fetch(seq); | ||||
| if (seq == Memory::nil) | if (seq == Memory::nil) | ||||
| return Memory::nil; | return Memory::nil; | ||||
| @@ -1006,11 +1003,6 @@ namespace Slime { | |||||
| } | } | ||||
| return Memory::get_keyword("unknown"); | return Memory::get_keyword("unknown"); | ||||
| }; | }; | ||||
| // define((mem-reset), "TODO") { | |||||
| // profile_with_name("(mem-reset)"); | |||||
| // Memory::reset(); | |||||
| // return Memory::nil; | |||||
| // }; | |||||
| define_special((info n), "TODO") | define_special((info n), "TODO") | ||||
| { | { | ||||
| // NOTE(Felix): we need to define_special because the docstring is | // NOTE(Felix): we need to define_special because the docstring is | ||||
| @@ -1049,7 +1041,7 @@ namespace Slime { | |||||
| if (args->positional.symbols.next_index != 0) { | if (args->positional.symbols.next_index != 0) { | ||||
| printf("%s", | printf("%s", | ||||
| Memory::get_c_str(args->positional.symbols.data[0]->value.symbol)); | Memory::get_c_str(args->positional.symbols.data[0]->value.symbol)); | ||||
| for (int i = 1; i < args->positional.symbols.next_index; ++i) { | |||||
| for (u32 i = 1; i < args->positional.symbols.next_index; ++i) { | |||||
| printf(", %s", | printf(", %s", | ||||
| Memory::get_c_str(args->positional.symbols.data[i]->value.symbol)); | Memory::get_c_str(args->positional.symbols.data[i]->value.symbol)); | ||||
| } | } | ||||
| @@ -1064,7 +1056,7 @@ namespace Slime { | |||||
| print(args->keyword.values.data[0], true); | print(args->keyword.values.data[0], true); | ||||
| printf(")"); | printf(")"); | ||||
| } | } | ||||
| for (int i = 1; i < args->keyword.values.next_index; ++i) { | |||||
| for (u32 i = 1; i < args->keyword.values.next_index; ++i) { | |||||
| printf(", %s", | printf(", %s", | ||||
| Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol)); | Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol)); | ||||
| if (args->keyword.values.data[i]) { | if (args->keyword.values.data[i]) { | ||||
| @@ -1102,8 +1094,8 @@ namespace Slime { | |||||
| fetch(var); | fetch(var); | ||||
| return Memory::create_lisp_object(&var); | return Memory::create_lisp_object(&var); | ||||
| }; | }; | ||||
| define((generate-docs file_name), "TODO") { | |||||
| profile_with_name("(generate-docs)"); | |||||
| define((generate-docs-file file_name), "TODO") { | |||||
| profile_with_name("(generate-docs-file)"); | |||||
| fetch(file_name); | fetch(file_name); | ||||
| try assert_type(file_name, Lisp_Object_Type::String); | try assert_type(file_name, Lisp_Object_Type::String); | ||||
| in_caller_env { | in_caller_env { | ||||
| @@ -1145,10 +1137,10 @@ namespace Slime { | |||||
| profile_with_name("(exit)"); | profile_with_name("(exit)"); | ||||
| fetch(code); | fetch(code); | ||||
| try assert_type(code, Lisp_Object_Type::Number); | try assert_type(code, Lisp_Object_Type::Number); | ||||
| exit((int)code->value.number); | |||||
| exit((s32)code->value.number); | |||||
| }; | }; | ||||
| define((break), "TODO") { | |||||
| profile_with_name("(break)"); | |||||
| define((show-environment), "TODO") { | |||||
| profile_with_name("(show-environment)"); | |||||
| in_caller_env { | in_caller_env { | ||||
| print_environment(get_current_environment()); | print_environment(get_current_environment()); | ||||
| } | } | ||||
| @@ -1159,8 +1151,8 @@ namespace Slime { | |||||
| Memory::print_status(); | Memory::print_status(); | ||||
| return Memory::nil; | return Memory::nil; | ||||
| }; | }; | ||||
| define_special((mytry try_part catch_part), "TODO") { | |||||
| profile_with_name("(mytry)"); | |||||
| define_special((attempt try_part catch_part), "TODO") { | |||||
| profile_with_name("(attempt)"); | |||||
| fetch(try_part, catch_part); | fetch(try_part, catch_part); | ||||
| Lisp_Object* result; | Lisp_Object* result; | ||||
| @@ -1204,8 +1196,6 @@ namespace Slime { | |||||
| define((copy obj), "TODO") { | define((copy obj), "TODO") { | ||||
| profile_with_name("(copy)"); | profile_with_name("(copy)"); | ||||
| fetch(obj); | fetch(obj); | ||||
| // TODO(Felix): if we are copying string nodes, then | |||||
| // shouldn't the string itself also get copied?? | |||||
| return Memory::copy_lisp_object(obj); | return Memory::copy_lisp_object(obj); | ||||
| }; | }; | ||||
| define((error type message), "TODO") { | define((error type message), "TODO") { | ||||
| @@ -1229,6 +1219,14 @@ namespace Slime { | |||||
| try assert_type(sym, Lisp_Object_Type::Symbol); | try assert_type(sym, Lisp_Object_Type::Symbol); | ||||
| return Memory::get_keyword(sym->value.symbol); | return Memory::get_keyword(sym->value.symbol); | ||||
| }; | }; | ||||
| define((symbol->string sym), "TODO") { | |||||
| profile_with_name("(symbol->string)"); | |||||
| fetch(sym); | |||||
| try assert_type(sym, Lisp_Object_Type::Symbol); | |||||
| return Memory::create_lisp_object( | |||||
| Memory::duplicate_string(sym->value.symbol)); | |||||
| }; | |||||
| define((string->symbol str), "TODO") { | define((string->symbol str), "TODO") { | ||||
| profile_with_name("(string->symbol)"); | profile_with_name("(string->symbol)"); | ||||
| fetch(str); | fetch(str); | ||||
| @@ -1238,26 +1236,18 @@ namespace Slime { | |||||
| try assert_type(str, Lisp_Object_Type::String); | try assert_type(str, Lisp_Object_Type::String); | ||||
| return Memory::get_symbol(Memory::duplicate_string(str->value.string)); | return Memory::get_symbol(Memory::duplicate_string(str->value.string)); | ||||
| }; | }; | ||||
| define((symbol->string sym), "TODO") { | |||||
| profile_with_name("(symbol->string)"); | |||||
| fetch(sym); | |||||
| try assert_type(sym, Lisp_Object_Type::Symbol); | |||||
| return Memory::create_lisp_object( | |||||
| Memory::duplicate_string(sym->value.symbol)); | |||||
| }; | |||||
| define((concat-strings . strings), "TODO") { | define((concat-strings . strings), "TODO") { | ||||
| profile_with_name("(concat-strings)"); | profile_with_name("(concat-strings)"); | ||||
| fetch(strings); | fetch(strings); | ||||
| int resulting_string_len = 0; | |||||
| u32 resulting_string_len = 0; | |||||
| for_lisp_list (strings) { | for_lisp_list (strings) { | ||||
| try assert_type(it, Lisp_Object_Type::String); | try assert_type(it, Lisp_Object_Type::String); | ||||
| resulting_string_len += it->value.string.length; | resulting_string_len += it->value.string.length; | ||||
| } | } | ||||
| String resulting_string = Memory::create_string("", resulting_string_len); | String resulting_string = Memory::create_string("", resulting_string_len); | ||||
| int index_in_string = 0; | |||||
| u32 index_in_string = 0; | |||||
| for_lisp_list (strings) { | for_lisp_list (strings) { | ||||
| strcpy(resulting_string.data+index_in_string, | strcpy(resulting_string.data+index_in_string, | ||||
| @@ -5,9 +5,9 @@ | |||||
| do { \ | do { \ | ||||
| if (Globals::log_level == Log_Level::Debug) { \ | if (Globals::log_level == Log_Level::Debug) { \ | ||||
| printf("in"); \ | printf("in"); \ | ||||
| int spacing = 30-((int)strlen(__FILE__) + (int)log10(__LINE__));\ | |||||
| s32 spacing = 30-((s32)strlen(__FILE__) + (s32)log10(__LINE__)); \ | |||||
| if (spacing < 1) spacing = 1; \ | if (spacing < 1) spacing = 1; \ | ||||
| for (int i = 0; i < spacing;++i) \ | |||||
| for (s32 i = 0; i < spacing;++i) \ | |||||
| printf(" "); \ | printf(" "); \ | ||||
| printf("%s (%d) ", __FILE__, __LINE__); \ | printf("%s (%d) ", __FILE__, __LINE__); \ | ||||
| printf("-> %s\n",__FUNCTION__); \ | printf("-> %s\n",__FUNCTION__); \ | ||||
| @@ -139,7 +139,7 @@ | |||||
| */ | */ | ||||
| #define for_lisp_vector(v) \ | #define for_lisp_vector(v) \ | ||||
| if (!v); else \ | if (!v); else \ | ||||
| if (int it_index = 0); else \ | |||||
| if (u32 it_index = 0); else \ | |||||
| for (auto it = v->value.vector.data; \ | for (auto it = v->value.vector.data; \ | ||||
| it_index < v->value.vector.length; \ | it_index < v->value.vector.length; \ | ||||
| it=v->value.vector.data+(++it_index)) | it=v->value.vector.data+(++it_index)) | ||||
| @@ -149,7 +149,7 @@ | |||||
| */ | */ | ||||
| #define for_lisp_list(l) \ | #define for_lisp_list(l) \ | ||||
| if (!l); else \ | if (!l); else \ | ||||
| if (int it_index = 0); else \ | |||||
| if (u32 it_index = 0); else \ | |||||
| for (Lisp_Object* head = l, *it; \ | for (Lisp_Object* head = l, *it; \ | ||||
| head->type == Lisp_Object_Type::Pair && (it = head->value.pair.first); \ | head->type == Lisp_Object_Type::Pair && (it = head->value.pair.first); \ | ||||
| head = head->value.pair.rest, ++it_index) | head = head->value.pair.rest, ++it_index) | ||||
| @@ -99,7 +99,7 @@ namespace Slime { | |||||
| if (args->positional.symbols.next_index != 0) { | if (args->positional.symbols.next_index != 0) { | ||||
| fprintf(f, "\n - postitional :: "); | fprintf(f, "\n - postitional :: "); | ||||
| fprintf(f, "=%s=", Memory::get_c_str(args->positional.symbols.data[0]->value.symbol)); | fprintf(f, "=%s=", Memory::get_c_str(args->positional.symbols.data[0]->value.symbol)); | ||||
| for (int i = 1; i < args->positional.symbols.next_index; ++i) { | |||||
| for (u32 i = 1; i < args->positional.symbols.next_index; ++i) { | |||||
| fprintf(f, ", =%s=", Memory::get_c_str(args->positional.symbols.data[i]->value.symbol)); | fprintf(f, ", =%s=", Memory::get_c_str(args->positional.symbols.data[i]->value.symbol)); | ||||
| } | } | ||||
| } | } | ||||
| @@ -111,7 +111,7 @@ namespace Slime { | |||||
| print(args->keyword.values.data[0], true, f); | print(args->keyword.values.data[0], true, f); | ||||
| fprintf(f, ")="); | fprintf(f, ")="); | ||||
| } | } | ||||
| for (int i = 1; i < args->keyword.values.next_index; ++i) { | |||||
| for (u32 i = 1; i < args->keyword.values.next_index; ++i) { | |||||
| fprintf(f, ", =%s=", Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol)); | fprintf(f, ", =%s=", Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol)); | ||||
| if (args->keyword.values.data[i]) { | if (args->keyword.values.data[i]) { | ||||
| fprintf(f, " =("); | fprintf(f, " =("); | ||||
| @@ -135,7 +135,7 @@ namespace Slime { | |||||
| } | } | ||||
| } | } | ||||
| for (int i = 0; i < env->parents.next_index; ++i) { | |||||
| for (u32 i = 0; i < env->parents.next_index; ++i) { | |||||
| try_void rec(rec, env->parents.data[i], prefix); | try_void rec(rec, env->parents.data[i], prefix); | ||||
| } | } | ||||
| }; | }; | ||||
| @@ -29,26 +29,24 @@ namespace Slime { | |||||
| proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { | proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { | ||||
| // first check current environment | // first check current environment | ||||
| static Lisp_Object* nil_sym = Memory::get_symbol("nil"); | |||||
| static Lisp_Object* t_sym = Memory::get_symbol("t"); | |||||
| Lisp_Object* result; | Lisp_Object* result; | ||||
| result = lookup_symbol_in_this_envt(node, env); | result = lookup_symbol_in_this_envt(node, env); | ||||
| if (result) | if (result) | ||||
| return result; | return result; | ||||
| for (int i = 0; i < env->parents.next_index; ++i) { | |||||
| for (u32 i = 0; i < env->parents.next_index; ++i) { | |||||
| result = try_lookup_symbol(node, env->parents.data[i]); | result = try_lookup_symbol(node, env->parents.data[i]); | ||||
| if (result) | if (result) | ||||
| return result; | return result; | ||||
| } | } | ||||
| auto nil_sym = Memory::get_symbol("nil"); | |||||
| auto t_sym = Memory::get_symbol("t"); | |||||
| if (node == nil_sym) { | if (node == nil_sym) { | ||||
| return Memory::nil; | return Memory::nil; | ||||
| } | |||||
| if (node == t_sym) { | |||||
| } else if (node == t_sym) { | |||||
| return Memory::t; | return Memory::t; | ||||
| } | } | ||||
| @@ -93,36 +91,36 @@ namespace Slime { | |||||
| } | } | ||||
| proc print_environment_indent(Environment* env, int indent) -> void { | |||||
| proc print_indent = [](int indent) { | |||||
| for (int i = 0; i < indent; ++i) { | |||||
| proc print_environment_indent(Environment* env, u32 indent) -> void { | |||||
| proc print_indent = [indent]() { | |||||
| for (u32 i = 0; i < indent; ++i) { | |||||
| printf(" "); | printf(" "); | ||||
| } | } | ||||
| }; | }; | ||||
| if(env == get_root_environment()) { | if(env == get_root_environment()) { | ||||
| print_indent(indent); | |||||
| printf("[built-ins]-Environment (%p)\n", env); | |||||
| print_indent(); | |||||
| printf("[built-ins]-Environment (0x%p)\n", env); | |||||
| return; | return; | ||||
| } | } | ||||
| for_hash_map (env->hm) { | for_hash_map (env->hm) { | ||||
| print_indent(indent); | |||||
| print_indent(); | |||||
| printf("-> %s :: ", (((Lisp_Object*)key)->value.symbol.data)); | printf("-> %s :: ", (((Lisp_Object*)key)->value.symbol.data)); | ||||
| print((Lisp_Object*)value); | print((Lisp_Object*)value); | ||||
| printf(" (0x%016llx)", (unsigned long long)value); | |||||
| printf(" (0x%p)", value); | |||||
| puts(""); | puts(""); | ||||
| } | } | ||||
| for (int i = 0; i < env->parents.next_index; ++i) { | |||||
| print_indent(indent); | |||||
| printf("parent (%p)", env->parents.data[i]); | |||||
| for (u32 i = 0; i < env->parents.next_index; ++i) { | |||||
| print_indent(); | |||||
| printf("parent (0x%p)", env->parents.data[i]); | |||||
| puts(":"); | puts(":"); | ||||
| print_environment_indent(env->parents.data[i], indent+4); | print_environment_indent(env->parents.data[i], indent+4); | ||||
| } | } | ||||
| } | } | ||||
| proc print_environment(Environment* env) -> void { | proc print_environment(Environment* env) -> void { | ||||
| printf("\n=== Environment === (%p)\n", env); | |||||
| printf("\n=== Environment === (0x%p)\n", env); | |||||
| print_environment_indent(env, 0); | print_environment_indent(env, 0); | ||||
| } | } | ||||
| @@ -7,7 +7,9 @@ namespace Slime { | |||||
| error = nullptr; | error = nullptr; | ||||
| } | } | ||||
| proc create_error(const char* c_func_name,const char* c_file_name, int c_file_line, Lisp_Object* type, String message) -> void { | |||||
| proc create_error(const char* c_func_name, const char* c_file_name, | |||||
| u32 c_file_line, Lisp_Object* type, String message) -> void | |||||
| { | |||||
| delete_error(); | delete_error(); | ||||
| if (Globals::breaking_on_errors) { | if (Globals::breaking_on_errors) { | ||||
| debug_break(); | debug_break(); | ||||
| @@ -22,37 +24,32 @@ namespace Slime { | |||||
| if (Globals::log_level > Log_Level::None) { | if (Globals::log_level > Log_Level::None) { | ||||
| // c error location | // c error location | ||||
| printf("in"); | printf("in"); | ||||
| int spacing = 30-((int)strlen(c_file_name) + (int)log10(c_file_line)); | |||||
| s32 spacing = 30-((s32)strlen(c_file_name) + (s32)log10(c_file_line)); | |||||
| if (spacing < 1) spacing = 1; | if (spacing < 1) spacing = 1; | ||||
| for (int i = 0; i < spacing; ++i) | |||||
| for (s32 i = 0; i < spacing; ++i) | |||||
| printf(" "); | printf(" "); | ||||
| printf("%s (%d) ", c_file_name, c_file_line); | |||||
| printf("%s (%u) ", c_file_name, c_file_line); | |||||
| printf("-> %s\n", c_func_name); | printf("-> %s\n", c_func_name); | ||||
| } | } | ||||
| // visualize_lisp_machine(); | // visualize_lisp_machine(); | ||||
| } | } | ||||
| proc create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...) -> void { | |||||
| proc create_error(const char* c_func_name, const char* c_file_name, | |||||
| u32 c_file_line, Lisp_Object* type, const char* format, ...) -> void { | |||||
| using Globals::error; | using Globals::error; | ||||
| // TODO(Felix): is the length even used?? | |||||
| int length = 200; | |||||
| String formatted_string = Memory::create_string("", length); | |||||
| if (error) { | if (error) { | ||||
| error = new(Error); | error = new(Error); | ||||
| error->type = type; | error->type = type; | ||||
| } | } | ||||
| int written_length; | |||||
| // contents will be filled in | |||||
| String formatted_string = Memory::create_string("", 0); | |||||
| va_list args; | va_list args; | ||||
| char* out_msg; | |||||
| va_start(args, format); | va_start(args, format); | ||||
| written_length = vasprintf(&out_msg, format, args); | |||||
| formatted_string.length = vasprintf(&formatted_string.data, format, args); | |||||
| va_end(args); | va_end(args); | ||||
| formatted_string.length = written_length; | |||||
| strcpy(formatted_string.data, out_msg); | |||||
| free(out_msg); | |||||
| create_error(c_func_name, c_file_name, c_file_line, type, formatted_string); | create_error(c_func_name, c_file_name, c_file_line, type, formatted_string); | ||||
| } | } | ||||
| } | } | ||||
| @@ -2,13 +2,13 @@ namespace Slime { | |||||
| proc create_extended_environment_for_function_application_nrc( | proc create_extended_environment_for_function_application_nrc( | ||||
| Lisp_Object* function, | Lisp_Object* function, | ||||
| int arg_start, | |||||
| int arg_end) -> Environment* | |||||
| u32 arg_start, | |||||
| u32 arg_end) -> Environment* | |||||
| { | { | ||||
| profile_this(); | profile_this(); | ||||
| using namespace Globals::Current_Execution; | using namespace Globals::Current_Execution; | ||||
| int index_of_next_arg = arg_start; | |||||
| u32 index_of_next_arg = arg_start; | |||||
| bool is_c_function = function->value.function->is_c; | bool is_c_function = function->value.function->is_c; | ||||
| Environment* env = Memory::create_child_environment(function->value.function->parent_environment); | Environment* env = Memory::create_child_environment(function->value.function->parent_environment); | ||||
| Arguments* arg_spec = &function->value.function->args; | Arguments* arg_spec = &function->value.function->args; | ||||
| @@ -18,14 +18,14 @@ namespace Slime { | |||||
| defer { | defer { | ||||
| read_in_keywords.dealloc(); | read_in_keywords.dealloc(); | ||||
| }; | }; | ||||
| int obligatory_keywords_count = 0; | |||||
| int read_obligatory_keywords_count = 0; | |||||
| u32 obligatory_keywords_count = 0; | |||||
| u32 read_obligatory_keywords_count = 0; | |||||
| Lisp_Object* sym; | Lisp_Object* sym; | ||||
| Lisp_Object* val; | Lisp_Object* val; | ||||
| // read positionals | // read positionals | ||||
| for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) { | |||||
| for (u32 i = 0; i < arg_spec->positional.symbols.next_index; ++i) { | |||||
| if (index_of_next_arg == arg_end) { | if (index_of_next_arg == arg_end) { | ||||
| create_parsing_error( | create_parsing_error( | ||||
| "Not enough positional args supplied. Needed: %d suppied, %d.\n" | "Not enough positional args supplied. Needed: %d suppied, %d.\n" | ||||
| @@ -51,7 +51,7 @@ namespace Slime { | |||||
| // if there are some left read keywords and rest | // if there are some left read keywords and rest | ||||
| if (index_of_next_arg != arg_end) { | if (index_of_next_arg != arg_end) { | ||||
| // find out how many keyword args we /have/ to read | // find out how many keyword args we /have/ to read | ||||
| for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { | |||||
| for (u32 i = 0; i < arg_spec->keyword.values.next_index; ++i) { | |||||
| if (arg_spec->keyword.values.data[i] == nullptr) | if (arg_spec->keyword.values.data[i] == nullptr) | ||||
| ++obligatory_keywords_count; | ++obligatory_keywords_count; | ||||
| } | } | ||||
| @@ -59,7 +59,7 @@ namespace Slime { | |||||
| while (cs.data[index_of_next_arg]->type == Lisp_Object_Type::Keyword) { | while (cs.data[index_of_next_arg]->type == Lisp_Object_Type::Keyword) { | ||||
| // check if this one is even an accepted keyword | // check if this one is even an accepted keyword | ||||
| bool accepted = false; | bool accepted = false; | ||||
| for (int i = 0; i < arg_spec->keyword.keywords.next_index; ++i) { | |||||
| for (u32 i = 0; i < arg_spec->keyword.keywords.next_index; ++i) { | |||||
| if (cs.data[index_of_next_arg] == arg_spec->keyword.keywords.data[i]) { | if (cs.data[index_of_next_arg] == arg_spec->keyword.keywords.data[i]) { | ||||
| accepted = true; | accepted = true; | ||||
| break; | break; | ||||
| @@ -80,7 +80,7 @@ namespace Slime { | |||||
| } | } | ||||
| // This is an accepted kwarg; check if it was already | // This is an accepted kwarg; check if it was already | ||||
| // read in | // read in | ||||
| for (int i = 0; i < read_in_keywords.next_index; ++i) { | |||||
| for (u32 i = 0; i < read_in_keywords.next_index; ++i) { | |||||
| if (cs.data[index_of_next_arg] == read_in_keywords.data[i]) | if (cs.data[index_of_next_arg] == read_in_keywords.data[i]) | ||||
| { | { | ||||
| // if we already read it in but also finished | // if we already read it in but also finished | ||||
| @@ -130,10 +130,10 @@ namespace Slime { | |||||
| kw_done: | kw_done: | ||||
| // check keywords for completeness | // check keywords for completeness | ||||
| for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { | |||||
| for (u32 i = 0; i < arg_spec->keyword.values.next_index; ++i) { | |||||
| auto defined_keyword = arg_spec->keyword.keywords.data[i]; | auto defined_keyword = arg_spec->keyword.keywords.data[i]; | ||||
| bool was_set = false; | bool was_set = false; | ||||
| for (int j = 0; j < read_in_keywords.next_index; ++j) { | |||||
| for (u32 j = 0; j < read_in_keywords.next_index; ++j) { | |||||
| if (read_in_keywords.data[j] == defined_keyword) { | if (read_in_keywords.data[j] == defined_keyword) { | ||||
| was_set = true; | was_set = true; | ||||
| break; | break; | ||||
| @@ -271,13 +271,13 @@ namespace Slime { | |||||
| } | } | ||||
| proc list_length(Lisp_Object* node) -> int { | |||||
| proc list_length(Lisp_Object* node) -> u32 { | |||||
| if (node == Memory::nil) | if (node == Memory::nil) | ||||
| return 0; | return 0; | ||||
| try assert_type(node, Lisp_Object_Type::Pair); | try assert_type(node, Lisp_Object_Type::Pair); | ||||
| int len = 0; | |||||
| u32 len = 0; | |||||
| while (node->type == Lisp_Object_Type::Pair) { | while (node->type == Lisp_Object_Type::Pair) { | ||||
| ++len; | ++len; | ||||
| @@ -369,9 +369,13 @@ namespace Slime { | |||||
| cs.data[cs.next_index-1] = pc->value.pair.first; | cs.data[cs.next_index-1] = pc->value.pair.first; | ||||
| ams.append(cs.next_index-1); | ams.append(cs.next_index-1); | ||||
| assert("invalid ams state", | |||||
| ams.data[ams.next_index-2] <= | |||||
| ams.data[ams.next_index-1]); | |||||
| if_debug { | |||||
| if (ams.next_index >= 2) { | |||||
| assert("invalid ams state", | |||||
| ams.data[ams.next_index-2] <= | |||||
| ams.data[ams.next_index-1]); | |||||
| } | |||||
| } | |||||
| pcs.append(pc->value.pair.rest); | pcs.append(pc->value.pair.rest); | ||||
| mes.append(pc); | mes.append(pc); | ||||
| @@ -400,9 +404,9 @@ namespace Slime { | |||||
| try pc->value.function->body.c_macro_body(); | try pc->value.function->body.c_macro_body(); | ||||
| } else if (pc->value.function->type.c_function_type == C_Function_Type::cSpecial) | } else if (pc->value.function->type.c_function_type == C_Function_Type::cSpecial) | ||||
| { | { | ||||
| // TODO(Felix): Why not call the function | |||||
| // right away, and instead push step, so | |||||
| // that step calls it? | |||||
| // QUESTION(Felix): Why not call the | |||||
| // function right away, and instead push | |||||
| // step, so that step calls it? | |||||
| push_pc_on_cs(); | push_pc_on_cs(); | ||||
| nas->append(NasAction::Step); | nas->append(NasAction::Step); | ||||
| } else { | } else { | ||||
| @@ -438,7 +442,7 @@ namespace Slime { | |||||
| case NasAction::Step: { | case NasAction::Step: { | ||||
| if (pcs.data[pcs.next_index-1] == Memory::nil) { | if (pcs.data[pcs.next_index-1] == Memory::nil) { | ||||
| --pcs.next_index; | --pcs.next_index; | ||||
| int am = ams.data[--ams.next_index]; | |||||
| u32 am = ams.data[--ams.next_index]; | |||||
| Lisp_Object* function = cs.data[am]; | Lisp_Object* function = cs.data[am]; | ||||
| try assert_type(function, Lisp_Object_Type::Function); | try assert_type(function, Lisp_Object_Type::Function); | ||||
| @@ -4,13 +4,13 @@ namespace Slime { | |||||
| Lisp_Object* built_in_load(String); | Lisp_Object* built_in_load(String); | ||||
| Lisp_Object* built_in_import(String); | Lisp_Object* built_in_import(String); | ||||
| void delete_error(); | void delete_error(); | ||||
| void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, const char* format, ...); | |||||
| void create_error(const char* c_func_name, const char* c_file_name, int c_file_line, Lisp_Object* type, String message); | |||||
| void create_error(Lisp_Object* type, const char* message, const char* c_file_name, int c_file_line); | |||||
| void create_error(const char* c_func_name, const char* c_file_name, u32 c_file_line, Lisp_Object* type, const char* format, ...); | |||||
| void create_error(const char* c_func_name, const char* c_file_name, u32 c_file_line, Lisp_Object* type, String message); | |||||
| void create_error(Lisp_Object* type, const char* message, const char* c_file_name, u32 c_file_line); | |||||
| Lisp_Object* eval_arguments(Lisp_Object*); | Lisp_Object* eval_arguments(Lisp_Object*); | ||||
| Lisp_Object* eval_expr(Lisp_Object*); | Lisp_Object* eval_expr(Lisp_Object*); | ||||
| bool is_truthy (Lisp_Object*); | bool is_truthy (Lisp_Object*); | ||||
| int list_length(Lisp_Object*); | |||||
| u32 list_length(Lisp_Object*); | |||||
| void* load_built_ins_into_environment(); | void* load_built_ins_into_environment(); | ||||
| void create_arguments_from_lambda_list_and_inject(Lisp_Object* formal_arguments, Lisp_Object* function); | void create_arguments_from_lambda_list_and_inject(Lisp_Object* formal_arguments, Lisp_Object* function); | ||||
| @@ -46,12 +46,12 @@ namespace Slime { | |||||
| Lisp_Object* get_symbol(const char*); | Lisp_Object* get_symbol(const char*); | ||||
| Lisp_Object* get_keyword(String identifier); | Lisp_Object* get_keyword(String identifier); | ||||
| Lisp_Object* get_keyword(const char*); | Lisp_Object* get_keyword(const char*); | ||||
| Lisp_Object* create_lisp_object(double); | |||||
| Lisp_Object* create_lisp_object(f64); | |||||
| Lisp_Object* create_lisp_object(const char*); | Lisp_Object* create_lisp_object(const char*); | ||||
| Lisp_Object* create_lisp_object_vector(Lisp_Object*); | Lisp_Object* create_lisp_object_vector(Lisp_Object*); | ||||
| Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*); | Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*); | ||||
| Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*, Lisp_Object*); | Lisp_Object* create_lisp_object_vector(Lisp_Object*, Lisp_Object*, Lisp_Object*); | ||||
| Lisp_Object* create_lisp_object_vector(int, Lisp_Object*); | |||||
| Lisp_Object* create_lisp_object_vector(u32, Lisp_Object*); | |||||
| inline Lisp_Object* create_list(Lisp_Object*); | inline Lisp_Object* create_list(Lisp_Object*); | ||||
| inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*); | inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*); | ||||
| inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*); | inline Lisp_Object* create_list(Lisp_Object*,Lisp_Object*,Lisp_Object*); | ||||
| @@ -65,10 +65,10 @@ namespace Slime { | |||||
| extern String standard_in; | extern String standard_in; | ||||
| extern String parser_file; | extern String parser_file; | ||||
| extern int parser_line; | |||||
| extern int parser_col; | |||||
| extern u32 parser_line; | |||||
| extern u32 parser_col; | |||||
| Lisp_Object* parse_expression(char* text, int* index_in_text); | |||||
| Lisp_Object* parse_expression(char* text, u32* index_in_text); | |||||
| Lisp_Object* parse_single_expression(const char* text); | Lisp_Object* parse_single_expression(const char* text); | ||||
| Lisp_Object* parse_single_expression(char* text); | Lisp_Object* parse_single_expression(char* text); | ||||
| Lisp_Object* parse_single_expression(wchar_t* text); | Lisp_Object* parse_single_expression(wchar_t* text); | ||||
| @@ -5,8 +5,8 @@ namespace Slime { | |||||
| #define STRINGIZE(s) STRINGIZE2(s) | #define STRINGIZE(s) STRINGIZE2(s) | ||||
| #define VERSION_STRING "v" STRINGIZE(v_major) "." STRINGIZE(v_minor) " - built on " __DATE__ " " __TIME__ | #define VERSION_STRING "v" STRINGIZE(v_major) "." STRINGIZE(v_minor) " - built on " __DATE__ " " __TIME__ | ||||
| const char* version_string = VERSION_STRING; | const char* version_string = VERSION_STRING; | ||||
| const int major_version = v_major; | |||||
| const int minor_version = v_minor; | |||||
| const u32 major_version = v_major; | |||||
| const u32 minor_version = v_minor; | |||||
| #undef v_major | #undef v_major | ||||
| #undef v_minor | #undef v_minor | ||||
| #undef STRINGIZE2 | #undef STRINGIZE2 | ||||
| @@ -2,7 +2,7 @@ namespace Slime { | |||||
| proc string_equal(const char input[], const char check[]) -> bool { | proc string_equal(const char input[], const char check[]) -> bool { | ||||
| if (input == check) return true; | if (input == check) return true; | ||||
| for(int i = 0; input[i] == check[i]; i++) { | |||||
| for(u32 i = 0; input[i] == check[i]; i++) { | |||||
| if (input[i] == '\0') | if (input[i] == '\0') | ||||
| return true; | return true; | ||||
| } | } | ||||
| @@ -32,7 +32,7 @@ namespace Slime { | |||||
| proc escape_string(char* in) -> char* { | proc escape_string(char* in) -> char* { | ||||
| // TODO(Felix): add more escape sequences | // TODO(Felix): add more escape sequences | ||||
| int i = 0, count = 0; | |||||
| u32 i = 0, count = 0; | |||||
| while (in[i] != '\0') { | while (in[i] != '\0') { | ||||
| switch (in[i]) { | switch (in[i]) { | ||||
| case '\\': | case '\\': | ||||
| @@ -48,7 +48,7 @@ namespace Slime { | |||||
| // copy in | // copy in | ||||
| i = 0; | i = 0; | ||||
| int j = 0; | |||||
| u32 j = 0; | |||||
| while (in[i] != '\0') { | while (in[i] != '\0') { | ||||
| switch (in[i]) { | switch (in[i]) { | ||||
| case '\\': ret[j++] = '\\'; ret[j++] = '\\'; break; | case '\\': ret[j++] = '\\'; ret[j++] = '\\'; break; | ||||
| @@ -62,7 +62,7 @@ namespace Slime { | |||||
| return ret; | return ret; | ||||
| } | } | ||||
| proc unescape_string(char* in) -> int { | |||||
| proc unescape_string(char* in) -> s32 { | |||||
| if (!in) return 0; | if (!in) return 0; | ||||
| char *out = in, *p = in; | char *out = in, *p = in; | ||||
| @@ -114,7 +114,7 @@ namespace Slime { | |||||
| /* Set the end of string. */ | /* Set the end of string. */ | ||||
| *out = '\0'; | *out = '\0'; | ||||
| return (int)(out - in); | |||||
| return (s32)(out - in); | |||||
| } | } | ||||
| proc read_entire_file(char* filename) -> char* { | proc read_entire_file(char* filename) -> char* { | ||||
| @@ -164,9 +164,9 @@ namespace Slime { | |||||
| char* linep = line; | char* linep = line; | ||||
| size_t lenmax = 100, len = lenmax; | size_t lenmax = 100, len = lenmax; | ||||
| int c; | |||||
| s32 c; | |||||
| int nesting = 0; | |||||
| s32 nesting = 0; | |||||
| while (true) { | while (true) { | ||||
| c = fgetc(stdin); | c = fgetc(stdin); | ||||
| @@ -204,9 +204,9 @@ namespace Slime { | |||||
| proc read_line() -> char* { | proc read_line() -> char* { | ||||
| char* line = (char*)malloc(100), * linep = line; | char* line = (char*)malloc(100), * linep = line; | ||||
| size_t lenmax = 100, len = lenmax; | size_t lenmax = 100, len = lenmax; | ||||
| int c; | |||||
| s32 c; | |||||
| int nesting = 0; | |||||
| s32 nesting = 0; | |||||
| if(line == nullptr) | if(line == nullptr) | ||||
| return nullptr; | return nullptr; | ||||
| @@ -261,7 +261,7 @@ namespace Slime { | |||||
| char* wchar_to_char(const wchar_t* pwchar) { | char* wchar_to_char(const wchar_t* pwchar) { | ||||
| // get the number of characters in the string. | // get the number of characters in the string. | ||||
| int currentCharIndex = 0; | |||||
| s32 currentCharIndex = 0; | |||||
| char currentChar = (char)pwchar[currentCharIndex]; | char currentChar = (char)pwchar[currentCharIndex]; | ||||
| while (currentChar != '\0') | while (currentChar != '\0') | ||||
| @@ -270,12 +270,12 @@ namespace Slime { | |||||
| currentChar = (char)pwchar[currentCharIndex]; | currentChar = (char)pwchar[currentCharIndex]; | ||||
| } | } | ||||
| const int charCount = currentCharIndex + 1; | |||||
| const s32 charCount = currentCharIndex + 1; | |||||
| // allocate a new block of memory size char (1 byte) instead of wide char (2 bytes) | // allocate a new block of memory size char (1 byte) instead of wide char (2 bytes) | ||||
| char* filePathC = (char*)malloc(sizeof(char) * charCount); | char* filePathC = (char*)malloc(sizeof(char) * charCount); | ||||
| for (int i = 0; i < charCount; i++) | |||||
| for (s32 i = 0; i < charCount; i++) | |||||
| { | { | ||||
| // convert to char (1 byte) | // convert to char (1 byte) | ||||
| char character = (char)pwchar[i]; | char character = (char)pwchar[i]; | ||||
| @@ -302,7 +302,6 @@ namespace Slime { | |||||
| proc string_buider_to_string(Array_List<char*> string_builder) -> char* { | proc string_buider_to_string(Array_List<char*> string_builder) -> char* { | ||||
| size_t len = 1; | size_t len = 1; | ||||
| int idx = 0; | |||||
| for (auto str : string_builder) { | for (auto str : string_builder) { | ||||
| len += strlen(str); | len += strlen(str); | ||||
| } | } | ||||
| @@ -331,8 +330,8 @@ namespace Slime { | |||||
| case (Lisp_Object_Type::Continuation): return _strdup("[continuation]"); | case (Lisp_Object_Type::Continuation): return _strdup("[continuation]"); | ||||
| case (Lisp_Object_Type::Pointer): return _strdup("[pointer]"); | case (Lisp_Object_Type::Pointer): return _strdup("[pointer]"); | ||||
| case (Lisp_Object_Type::Number): { | case (Lisp_Object_Type::Number): { | ||||
| if (abs(node->value.number - (int)node->value.number) < 0.000001f) | |||||
| asprintf(&temp, "%d", (int)node->value.number); | |||||
| if (abs(node->value.number - (s32)node->value.number) < 0.000001f) | |||||
| asprintf(&temp, "%d", (s32)node->value.number); | |||||
| else | else | ||||
| asprintf(&temp, "%f", node->value.number); | asprintf(&temp, "%f", node->value.number); | ||||
| return temp; | return temp; | ||||
| @@ -376,7 +375,7 @@ namespace Slime { | |||||
| string_builder.append(_strdup("[")); | string_builder.append(_strdup("[")); | ||||
| if (node->value.vector.length > 0) | if (node->value.vector.length > 0) | ||||
| string_builder.append(lisp_object_to_string(node->value.vector.data, print_repr)); | string_builder.append(lisp_object_to_string(node->value.vector.data, print_repr)); | ||||
| for (int i = 1; i < node->value.vector.length; ++i) { | |||||
| for (u32 i = 1; i < node->value.vector.length; ++i) { | |||||
| string_builder.append(_strdup(" ")); | string_builder.append(_strdup(" ")); | ||||
| string_builder.append(lisp_object_to_string(node->value.vector.data+i, print_repr)); | string_builder.append(lisp_object_to_string(node->value.vector.data+i, print_repr)); | ||||
| } | } | ||||
| @@ -388,11 +387,13 @@ namespace Slime { | |||||
| return temp; | return temp; | ||||
| } break; | } break; | ||||
| case (Lisp_Object_Type::Function): { | case (Lisp_Object_Type::Function): { | ||||
| // TODO(Felix): Enable again when we have user types again: | |||||
| // if (node->userType) { | |||||
| // asprintf(&temp, "[%s]", Memory::get_c_str(node->userType->value.symbol)); | |||||
| // return temp; | |||||
| // } | |||||
| if (Globals::user_types.key_exists(node)) { | |||||
| asprintf(&temp, "[%s]", | |||||
| ((Lisp_Object*)Globals::user_types.key_exists(node)) | |||||
| ->value.symbol.data); | |||||
| return temp; | |||||
| } | |||||
| if (node->value.function->is_c) { | if (node->value.function->is_c) { | ||||
| // NOTE(Felix): try to find the symbol it is bound to | // NOTE(Felix): try to find the symbol it is bound to | ||||
| // in global env | // in global env | ||||
| @@ -422,7 +423,6 @@ namespace Slime { | |||||
| } | } | ||||
| } break; | } break; | ||||
| case (Lisp_Object_Type::Pair): { | case (Lisp_Object_Type::Pair): { | ||||
| // TODO | |||||
| Lisp_Object* head = node; | Lisp_Object* head = node; | ||||
| defer { | defer { | ||||
| @@ -489,7 +489,7 @@ namespace Slime { | |||||
| } | } | ||||
| default: | default: | ||||
| create_generic_error("A Lisp_Object of type-id %d cannot be converted to a string", | create_generic_error("A Lisp_Object of type-id %d cannot be converted to a string", | ||||
| (int)(node->type)); | |||||
| (u8)(node->type)); | |||||
| return nullptr; | return nullptr; | ||||
| } | } | ||||
| } | } | ||||
| @@ -528,12 +528,10 @@ namespace Slime { | |||||
| using Globals::Current_Execution::nass; | using Globals::Current_Execution::nass; | ||||
| using Globals::Current_Execution::ams; | using Globals::Current_Execution::ams; | ||||
| printf("cs:\n "); | printf("cs:\n "); | ||||
| for (int i = 0; i < cs.next_index; ++i) { | |||||
| for (u32 i = 0; i < cs.next_index; ++i) { | |||||
| char* t = lisp_object_to_string(cs.data[i], true); | char* t = lisp_object_to_string(cs.data[i], true); | ||||
| defer_free(t); | |||||
| printf(" %d: %s\n ", i, t); | printf(" %d: %s\n ", i, t); | ||||
| defer { | |||||
| free(t); | |||||
| }; | |||||
| } | } | ||||
| printf("\npcs:\n "); | printf("\npcs:\n "); | ||||
| for (auto lo : pcs) { | for (auto lo : pcs) { | ||||
| @@ -20,19 +20,18 @@ | |||||
| # include <signal.h> | # include <signal.h> | ||||
| #endif | #endif | ||||
| /* | |||||
| Forward declare the hash functions for the hashmap (needed at least | |||||
| for clang++) | |||||
| #include "ftb/types.hpp" | |||||
| /* NOTE(Felix): Forward declare the hash functions for the hashmap | |||||
| (needed at least for clang++) | |||||
| */ | */ | ||||
| namespace Slime {struct Lisp_Object;} | namespace Slime {struct Lisp_Object;} | ||||
| bool hm_objects_match(char* a, char* b); | bool hm_objects_match(char* a, char* b); | ||||
| bool hm_objects_match(void* a, void* b); | bool hm_objects_match(void* a, void* b); | ||||
| bool hm_objects_match(Slime::Lisp_Object* a, Slime::Lisp_Object* b); | bool hm_objects_match(Slime::Lisp_Object* a, Slime::Lisp_Object* b); | ||||
| unsigned int hm_hash(char* str); | |||||
| unsigned int hm_hash(void* ptr); | |||||
| unsigned int hm_hash(Slime::Lisp_Object* obj); | |||||
| u32 hm_hash(char* str); | |||||
| u32 hm_hash(void* ptr); | |||||
| u32 hm_hash(Slime::Lisp_Object* obj); | |||||
| #include "ftb/hashmap.hpp" | #include "ftb/hashmap.hpp" | ||||
| #include "ftb/types.hpp" | |||||
| #include "ftb/arraylist.hpp" | #include "ftb/arraylist.hpp" | ||||
| #include "ftb/bucket_allocator.hpp" | #include "ftb/bucket_allocator.hpp" | ||||
| #include "ftb/macros.hpp" | #include "ftb/macros.hpp" | ||||
| @@ -59,20 +58,20 @@ inline bool hm_objects_match(Slime::Lisp_Object* a, Slime::Lisp_Object* b) { | |||||
| return Slime::lisp_object_equal(a, b); | return Slime::lisp_object_equal(a, b); | ||||
| } | } | ||||
| unsigned int hm_hash(char* str) { | |||||
| unsigned int value = str[0] << 7; | |||||
| int i = 0; | |||||
| u32 hm_hash(char* str) { | |||||
| u32 value = str[0] << 7; | |||||
| s32 i = 0; | |||||
| while (str[i]) { | while (str[i]) { | ||||
| value = (10000003 * value) ^ str[i++]; | value = (10000003 * value) ^ str[i++]; | ||||
| } | } | ||||
| return value ^ i; | return value ^ i; | ||||
| } | } | ||||
| unsigned int hm_hash(void* ptr) { | |||||
| return ((unsigned long long)ptr * 2654435761) % 4294967296; | |||||
| u32 hm_hash(void* ptr) { | |||||
| return ((u64)ptr * 2654435761) % 4294967296; | |||||
| } | } | ||||
| unsigned int hm_hash(Slime::Lisp_Object* obj) { | |||||
| u32 hm_hash(Slime::Lisp_Object* obj) { | |||||
| using namespace Slime; | using namespace Slime; | ||||
| switch (obj->type) { | switch (obj->type) { | ||||
| // hash from adress: if two objects of these types have | // hash from adress: if two objects of these types have | ||||
| @@ -1,5 +1,5 @@ | |||||
| namespace Slime { | namespace Slime { | ||||
| proc create_source_code_location(String file, int line, int col) -> Source_Code_Location* { | |||||
| proc create_source_code_location(String file, u32 line, u32 col) -> Source_Code_Location* { | |||||
| if (!file.data) | if (!file.data) | ||||
| return nullptr; | return nullptr; | ||||
| @@ -1,6 +1,6 @@ | |||||
| #include "libslime.cpp" | #include "libslime.cpp" | ||||
| int main(int argc, char* argv[]) { | |||||
| s32 main(s32 argc, char* argv[]) { | |||||
| #ifdef _MSC_VER | #ifdef _MSC_VER | ||||
| // enable colored terminal output for windows | // enable colored terminal output for windows | ||||
| HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE); | HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE); | ||||
| @@ -12,12 +12,12 @@ int main(int argc, char* argv[]) { | |||||
| if (argc > 1) { | if (argc > 1) { | ||||
| if (Slime::string_equal(argv[1], "--run-tests")) { | if (Slime::string_equal(argv[1], "--run-tests")) { | ||||
| int res = Slime::run_all_tests(); | |||||
| s32 res = Slime::run_all_tests(); | |||||
| return res ? 0 : 1; | return res ? 0 : 1; | ||||
| } else if (Slime::string_equal(argv[1], "--generate-docs")) { | |||||
| } else if (Slime::string_equal(argv[1], "--generate-docs-file")) { | |||||
| Slime::Memory::init(); | Slime::Memory::init(); | ||||
| if (Slime::Globals::error) return 1; | if (Slime::Globals::error) return 1; | ||||
| Slime::built_in_load(Slime::Memory::create_string("generate-docs.slime")); | |||||
| Slime::built_in_load(Slime::Memory::create_string("generate-docs-file.slime")); | |||||
| } else { | } else { | ||||
| Slime::interprete_file(argv[1]); | Slime::interprete_file(argv[1]); | ||||
| } | } | ||||
| @@ -64,7 +64,7 @@ namespace Slime::Memory { | |||||
| // TODO(Felix): When parsing symbols or keywords, compute the | // TODO(Felix): When parsing symbols or keywords, compute the | ||||
| // hash while reading them in. | // hash while reading them in. | ||||
| u64 value = str.data[0] << 7; | u64 value = str.data[0] << 7; | ||||
| for (int i = 1; i < str.length; ++i) { | |||||
| for (u32 i = 1; i < str.length; ++i) { | |||||
| char c = str.data[i]; | char c = str.data[i]; | ||||
| value = (1000003 * value) ^ c; | value = (1000003 * value) ^ c; | ||||
| } | } | ||||
| @@ -74,7 +74,7 @@ namespace Slime::Memory { | |||||
| } | } | ||||
| proc create_string(const char* str, int len) -> String { | |||||
| proc create_string(const char* str, u32 len) -> String { | |||||
| String s = { | String s = { | ||||
| len, | len, | ||||
| (char*)malloc(sizeof(char) * len + 1) | (char*)malloc(sizeof(char) * len + 1) | ||||
| @@ -84,7 +84,7 @@ namespace Slime::Memory { | |||||
| } | } | ||||
| proc create_string (const char* str) -> String { | proc create_string (const char* str) -> String { | ||||
| return create_string(str, (int)strlen(str)); | |||||
| return create_string(str, (u32)strlen(str)); | |||||
| } | } | ||||
| proc duplicate_string(String str) -> String { | proc duplicate_string(String str) -> String { | ||||
| @@ -247,7 +247,7 @@ namespace Slime::Memory { | |||||
| return node; | return node; | ||||
| } | } | ||||
| proc create_lisp_object(double number) -> Lisp_Object* { | |||||
| proc create_lisp_object(f64 number) -> Lisp_Object* { | |||||
| Lisp_Object* node; | Lisp_Object* node; | ||||
| try node = create_lisp_object(); | try node = create_lisp_object(); | ||||
| node->type = Lisp_Object_Type::Number; | node->type = Lisp_Object_Type::Number; | ||||
| @@ -271,7 +271,7 @@ namespace Slime::Memory { | |||||
| return node; | return node; | ||||
| } | } | ||||
| proc allocate_vector(int size) -> Lisp_Object* { | |||||
| proc allocate_vector(u32 size) -> Lisp_Object* { | |||||
| Lisp_Object* ret = object_memory.allocate(size); | Lisp_Object* ret = object_memory.allocate(size); | ||||
| if (!ret) { | if (!ret) { | ||||
| create_out_of_memory_error("The vector is too big to fit in a memory bucket."); | create_out_of_memory_error("The vector is too big to fit in a memory bucket."); | ||||
| @@ -280,7 +280,7 @@ namespace Slime::Memory { | |||||
| return ret; | return ret; | ||||
| } | } | ||||
| proc create_lisp_object_vector(int length, Lisp_Object* element_list) -> Lisp_Object* { | |||||
| proc create_lisp_object_vector(u32 length, Lisp_Object* element_list) -> Lisp_Object* { | |||||
| try assert_type(element_list, Lisp_Object_Type::Pair); | try assert_type(element_list, Lisp_Object_Type::Pair); | ||||
| Lisp_Object* node; | Lisp_Object* node; | ||||
| @@ -292,7 +292,7 @@ namespace Slime::Memory { | |||||
| Lisp_Object* head = element_list; | Lisp_Object* head = element_list; | ||||
| int i = 0; | |||||
| u32 i = 0; | |||||
| while (head != Memory::nil) { | while (head != Memory::nil) { | ||||
| node->value.vector.data[i] = *head->value.pair.first; | node->value.vector.data[i] = *head->value.pair.first; | ||||
| head = head->value.pair.rest; | head = head->value.pair.rest; | ||||
| @@ -412,14 +412,14 @@ namespace Slime::Memory { | |||||
| Lisp_Object* node; | Lisp_Object* node; | ||||
| try node = create_lisp_object(); | try node = create_lisp_object(); | ||||
| node->type = Lisp_Object_Type::Pair; | node->type = Lisp_Object_Type::Pair; | ||||
| // node->value.pair = new(Pair); | |||||
| node->value.pair.first = first; | node->value.pair.first = first; | ||||
| node->value.pair.rest = rest; | node->value.pair.rest = rest; | ||||
| return node; | return node; | ||||
| } | } | ||||
| proc copy_lisp_object(Lisp_Object* n) -> Lisp_Object* { | proc copy_lisp_object(Lisp_Object* n) -> Lisp_Object* { | ||||
| // TODO(Felix): If argument is a list (pair), do a FULL copy, | |||||
| // QUESTION(Felix): If argument is a list (cons), should we do | |||||
| // a full copy? | |||||
| // we don't copy singleton objects | // we don't copy singleton objects | ||||
| if (n == Memory::nil || n == Memory::t) { | if (n == Memory::nil || n == Memory::t) { | ||||
| @@ -1,10 +1,10 @@ | |||||
| namespace Slime::Parser { | namespace Slime::Parser { | ||||
| String standard_in; | String standard_in; | ||||
| String parser_file; | String parser_file; | ||||
| int parser_line; | |||||
| int parser_col; | |||||
| u32 parser_line; | |||||
| u32 parser_col; | |||||
| proc eat_comment_line(char* text, int* index_in_text) -> void { | |||||
| proc eat_comment_line(char* text, u32* index_in_text) -> void { | |||||
| // safety check if we are actually starting a comment here | // safety check if we are actually starting a comment here | ||||
| if (text[*index_in_text] != ';') | if (text[*index_in_text] != ';') | ||||
| return; | return; | ||||
| @@ -18,8 +18,8 @@ namespace Slime::Parser { | |||||
| text[(*index_in_text)] != '\0'); | text[(*index_in_text)] != '\0'); | ||||
| } | } | ||||
| proc step_char(char* text, int* index_in_text, int steps = 1) { | |||||
| for (int i = 0; i < steps; ++i) { | |||||
| proc step_char(char* text, u32* index_in_text, u32 steps = 1) { | |||||
| for (u32 i = 0; i < steps; ++i) { | |||||
| if (text[(*index_in_text)] == '\n') { | if (text[(*index_in_text)] == '\n') { | ||||
| ++parser_line; | ++parser_line; | ||||
| parser_col = 0; | parser_col = 0; | ||||
| @@ -29,7 +29,7 @@ namespace Slime::Parser { | |||||
| } | } | ||||
| } | } | ||||
| proc eat_whitespace(char* text, int* index_in_text) -> void { | |||||
| proc eat_whitespace(char* text, u32* index_in_text) -> void { | |||||
| // skip whitespaces | // skip whitespaces | ||||
| while (text[(*index_in_text)] == ' ' || | while (text[(*index_in_text)] == ' ' || | ||||
| text[(*index_in_text)] == '\t' || | text[(*index_in_text)] == '\t' || | ||||
| @@ -40,9 +40,9 @@ namespace Slime::Parser { | |||||
| } | } | ||||
| } | } | ||||
| proc eat_until_code(char* text, int* index_in_text) -> void { | |||||
| proc eat_until_code(char* text, u32* index_in_text) -> void { | |||||
| profile_this(); | profile_this(); | ||||
| int position_before; | |||||
| u32 position_before; | |||||
| do { | do { | ||||
| position_before = *index_in_text; | position_before = *index_in_text; | ||||
| eat_comment_line(text, index_in_text); | eat_comment_line(text, index_in_text); | ||||
| @@ -50,12 +50,12 @@ namespace Slime::Parser { | |||||
| } while (position_before != *index_in_text); | } while (position_before != *index_in_text); | ||||
| } | } | ||||
| proc step_char_and_eat_until_code(char* text, int* index_in_text) { | |||||
| proc step_char_and_eat_until_code(char* text, u32* index_in_text) { | |||||
| step_char(text, index_in_text); | step_char(text, index_in_text); | ||||
| eat_until_code(text, index_in_text); | eat_until_code(text, index_in_text); | ||||
| } | } | ||||
| proc parse_fancy_delimiter(char* text, int* index_in_text, char l_delimiter, char r_delimiter, Lisp_Object* first_elem) -> Lisp_Object* { | |||||
| proc parse_fancy_delimiter(char* text, u32* index_in_text, char l_delimiter, char r_delimiter, Lisp_Object* first_elem) -> Lisp_Object* { | |||||
| profile_this(); | profile_this(); | ||||
| if (text[*index_in_text] != l_delimiter) { | if (text[*index_in_text] != l_delimiter) { | ||||
| create_parsing_error("a fancy cannot be parsed here"); | create_parsing_error("a fancy cannot be parsed here"); | ||||
| @@ -83,8 +83,8 @@ namespace Slime::Parser { | |||||
| return ret; | return ret; | ||||
| } | } | ||||
| proc get_atom_text_length(char* text, int* index_in_text) -> int { | |||||
| int atom_length = 0; | |||||
| proc get_atom_text_length(char* text, u32* index_in_text) -> u32 { | |||||
| u32 atom_length = 0; | |||||
| while (text[*index_in_text+atom_length] != ' ' && | while (text[*index_in_text+atom_length] != ' ' && | ||||
| text[*index_in_text+atom_length] != ')' && | text[*index_in_text+atom_length] != ')' && | ||||
| text[*index_in_text+atom_length] != '(' && | text[*index_in_text+atom_length] != '(' && | ||||
| @@ -102,26 +102,26 @@ namespace Slime::Parser { | |||||
| return atom_length; | return atom_length; | ||||
| } | } | ||||
| proc parse_number(char* text, int* index_in_text) -> Lisp_Object* { | |||||
| proc parse_number(char* text, u32* index_in_text) -> Lisp_Object* { | |||||
| Lisp_Object* ret; | Lisp_Object* ret; | ||||
| try ret = Memory::create_lisp_object(0.0); | try ret = Memory::create_lisp_object(0.0); | ||||
| sscanf(text+*index_in_text, "%lf", &ret->value.number); | sscanf(text+*index_in_text, "%lf", &ret->value.number); | ||||
| int atom_length = get_atom_text_length(text, index_in_text); | |||||
| u32 atom_length = get_atom_text_length(text, index_in_text); | |||||
| step_char(text, index_in_text, atom_length); | step_char(text, index_in_text, atom_length); | ||||
| return ret; | return ret; | ||||
| } | } | ||||
| proc parse_symbol_or_keyword(char* text, int* index_in_text) -> Lisp_Object* { | |||||
| proc parse_symbol_or_keyword(char* text, u32* index_in_text) -> Lisp_Object* { | |||||
| bool keyword = false; | bool keyword = false; | ||||
| if (text[*index_in_text] == ':') { | if (text[*index_in_text] == ':') { | ||||
| keyword = true; | keyword = true; | ||||
| step_char(text, index_in_text); | step_char(text, index_in_text); | ||||
| } | } | ||||
| int atom_length = get_atom_text_length(text, index_in_text); | |||||
| u32 atom_length = get_atom_text_length(text, index_in_text); | |||||
| char orig = text[*index_in_text+atom_length]; | char orig = text[*index_in_text+atom_length]; | ||||
| text[*index_in_text+atom_length] = '\0'; | text[*index_in_text+atom_length] = '\0'; | ||||
| @@ -144,7 +144,7 @@ namespace Slime::Parser { | |||||
| return ret; | return ret; | ||||
| } | } | ||||
| proc parse_string(char* text, int* index_in_text) -> Lisp_Object* { | |||||
| proc parse_string(char* text, u32* index_in_text) -> Lisp_Object* { | |||||
| // the first character is the '"' | // the first character is the '"' | ||||
| step_char(text, index_in_text); | step_char(text, index_in_text); | ||||
| @@ -162,7 +162,7 @@ namespace Slime::Parser { | |||||
| } | } | ||||
| // okay so the first letter was not actually closing the string... | // okay so the first letter was not actually closing the string... | ||||
| int string_length = 0; | |||||
| u32 string_length = 0; | |||||
| bool escaping = false; | bool escaping = false; | ||||
| while (escaping || text[*index_in_text+string_length] != '"') { | while (escaping || text[*index_in_text+string_length] != '"') { | ||||
| if (escaping) { | if (escaping) { | ||||
| @@ -181,7 +181,7 @@ namespace Slime::Parser { | |||||
| // NOTE(Felix): Tactic: Through unescaping the string will | // NOTE(Felix): Tactic: Through unescaping the string will | ||||
| // only get shorter, so we replace it inplace and later jump | // only get shorter, so we replace it inplace and later jump | ||||
| // to the original end of the string. | // to the original end of the string. | ||||
| int new_len; | |||||
| u32 new_len; | |||||
| try new_len = unescape_string(text+(*index_in_text)); | try new_len = unescape_string(text+(*index_in_text)); | ||||
| String string = Memory::create_string("", new_len); | String string = Memory::create_string("", new_len); | ||||
| @@ -201,7 +201,7 @@ namespace Slime::Parser { | |||||
| return ret; | return ret; | ||||
| } | } | ||||
| proc parse_atom(char* text, int* index_in_text) -> Lisp_Object* { | |||||
| proc parse_atom(char* text, u32* index_in_text) -> Lisp_Object* { | |||||
| profile_this(); | profile_this(); | ||||
| Lisp_Object* ret; | Lisp_Object* ret; | ||||
| // numbers | // numbers | ||||
| @@ -232,7 +232,7 @@ namespace Slime::Parser { | |||||
| proc parse_list(char* text, int* index_in_text) -> Lisp_Object* { | |||||
| proc parse_list(char* text, u32* index_in_text) -> Lisp_Object* { | |||||
| profile_this(); | profile_this(); | ||||
| if (text[*index_in_text] != '(') { | if (text[*index_in_text] != '(') { | ||||
| create_parsing_error("a list cannot be parsed here"); | create_parsing_error("a list cannot be parsed here"); | ||||
| @@ -283,7 +283,7 @@ namespace Slime::Parser { | |||||
| return ret; | return ret; | ||||
| } | } | ||||
| proc maybe_expand_short_form(char* text, int* index_in_text) -> Lisp_Object* { | |||||
| proc maybe_expand_short_form(char* text, u32* index_in_text) -> Lisp_Object* { | |||||
| profile_this(); | profile_this(); | ||||
| Lisp_Object* vector_sym = Memory::get_symbol("vector"); | Lisp_Object* vector_sym = Memory::get_symbol("vector"); | ||||
| Lisp_Object* hash_map_sym = Memory::get_symbol("hash-map"); | Lisp_Object* hash_map_sym = Memory::get_symbol("hash-map"); | ||||
| @@ -340,7 +340,7 @@ namespace Slime::Parser { | |||||
| return ret; | return ret; | ||||
| } | } | ||||
| proc parse_expression(char* text, int* index_in_text) -> Lisp_Object* { | |||||
| proc parse_expression(char* text, u32* index_in_text) -> Lisp_Object* { | |||||
| profile_this(); | profile_this(); | ||||
| Lisp_Object* ret; | Lisp_Object* ret; | ||||
| eat_until_code(text, index_in_text); | eat_until_code(text, index_in_text); | ||||
| @@ -378,7 +378,7 @@ namespace Slime::Parser { | |||||
| parser_line = 1; | parser_line = 1; | ||||
| parser_col = 1; | parser_col = 1; | ||||
| int index_in_text = 0; | |||||
| u32 index_in_text = 0; | |||||
| Lisp_Object* ret; | Lisp_Object* ret; | ||||
| try ret = parse_expression(text, &index_in_text); | try ret = parse_expression(text, &index_in_text); | ||||
| return ret; | return ret; | ||||
| @@ -394,7 +394,7 @@ namespace Slime::Parser { | |||||
| Array_List<Lisp_Object*>* program = (Array_List<Lisp_Object*>*)malloc(sizeof(Array_List<Lisp_Object*>)); | Array_List<Lisp_Object*>* program = (Array_List<Lisp_Object*>*)malloc(sizeof(Array_List<Lisp_Object*>)); | ||||
| program->alloc(); | program->alloc(); | ||||
| int index_in_text = 0; | |||||
| u32 index_in_text = 0; | |||||
| Lisp_Object* parsed; | Lisp_Object* parsed; | ||||
| eat_until_code(text, &index_in_text); | eat_until_code(text, &index_in_text); | ||||
| @@ -1,7 +1,7 @@ | |||||
| namespace Slime { | namespace Slime { | ||||
| inline proc get_cwd() -> char* { | inline proc get_cwd() -> char* { | ||||
| const int buf_size = 2048; | |||||
| const u32 buf_size = 2048; | |||||
| char* res = (char*)malloc(buf_size * sizeof(char)); | char* res = (char*)malloc(buf_size * sizeof(char)); | ||||
| #ifdef _MSC_VER | #ifdef _MSC_VER | ||||
| @@ -23,9 +23,9 @@ namespace Slime { | |||||
| #ifdef _MSC_VER | #ifdef _MSC_VER | ||||
| int vasprintf(char **strp, const char *fmt, va_list ap) { | |||||
| s32 vasprintf(char **strp, const char *fmt, va_list ap) { | |||||
| // _vscprintf tells you how big the buffer needs to be | // _vscprintf tells you how big the buffer needs to be | ||||
| int len = _vscprintf(fmt, ap); | |||||
| s32 len = _vscprintf(fmt, ap); | |||||
| if (len == -1) { | if (len == -1) { | ||||
| return -1; | return -1; | ||||
| } | } | ||||
| @@ -35,7 +35,7 @@ namespace Slime { | |||||
| return -1; | return -1; | ||||
| } | } | ||||
| // _vsprintf_s is the "secure" version of vsprintf | // _vsprintf_s is the "secure" version of vsprintf | ||||
| int r = vsprintf_s(str, len + 1, fmt, ap); | |||||
| s32 r = vsprintf_s(str, len + 1, fmt, ap); | |||||
| if (r == -1) { | if (r == -1) { | ||||
| free(str); | free(str); | ||||
| return -1; | return -1; | ||||
| @@ -44,10 +44,10 @@ namespace Slime { | |||||
| return r; | return r; | ||||
| } | } | ||||
| int asprintf(char **strp, const char *fmt, ...) { | |||||
| s32 asprintf(char **strp, const char *fmt, ...) { | |||||
| va_list ap; | va_list ap; | ||||
| va_start(ap, fmt); | va_start(ap, fmt); | ||||
| int r = vasprintf(strp, fmt, ap); | |||||
| s32 r = vasprintf(strp, fmt, ap); | |||||
| va_end(ap); | va_end(ap); | ||||
| return r; | return r; | ||||
| } | } | ||||
| @@ -91,8 +91,8 @@ namespace Slime { | |||||
| else { | else { | ||||
| // remove the exe name, so we are only left with the path | // remove the exe name, so we are only left with the path | ||||
| int index_in_path = -1; | |||||
| int last_backslash = -1; | |||||
| s32 index_in_path = -1; | |||||
| s32 last_backslash = -1; | |||||
| char c; | char c; | ||||
| while ((c = path[++index_in_path]) != '\0') { | while ((c = path[++index_in_path]) != '\0') { | ||||
| @@ -121,7 +121,7 @@ namespace Slime { | |||||
| used = readlink("/proc/self/exe", path, size); | used = readlink("/proc/self/exe", path, size); | ||||
| if (used == -1) { | if (used == -1) { | ||||
| const int saved_errno = errno; | |||||
| const s32 saved_errno = errno; | |||||
| free(path); | free(path); | ||||
| errno = saved_errno; | errno = saved_errno; | ||||
| return NULL; | return NULL; | ||||
| @@ -66,14 +66,14 @@ namespace Slime { | |||||
| }; | }; | ||||
| struct String { | struct String { | ||||
| int length; | |||||
| u32 length; | |||||
| char* data; | char* data; | ||||
| }; | }; | ||||
| struct Source_Code_Location { | struct Source_Code_Location { | ||||
| String file; | String file; | ||||
| int line; | |||||
| int column; | |||||
| u32 line; | |||||
| u32 column; | |||||
| }; | }; | ||||
| struct Pair { | struct Pair { | ||||
| @@ -82,7 +82,7 @@ namespace Slime { | |||||
| }; | }; | ||||
| struct Vector { | struct Vector { | ||||
| int length; | |||||
| u32 length; | |||||
| Lisp_Object* data; | Lisp_Object* data; | ||||
| }; | }; | ||||
| @@ -126,12 +126,12 @@ namespace Slime { | |||||
| } body; | } body; | ||||
| }; | }; | ||||
| #pragma pack(1) | |||||
| // #pragma pack(1) | |||||
| struct Lisp_Object { | struct Lisp_Object { | ||||
| Lisp_Object_Type type; | Lisp_Object_Type type; | ||||
| union value { | union value { | ||||
| String symbol; // used for symbols and keywords | String symbol; // used for symbols and keywords | ||||
| double number; | |||||
| f64 number; | |||||
| String string; | String string; | ||||
| Pair pair; | Pair pair; | ||||
| Vector vector; | Vector vector; | ||||
| @@ -141,7 +141,7 @@ namespace Slime { | |||||
| Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap; | Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap; | ||||
| } value; | } value; | ||||
| }; | }; | ||||
| #pragma options align=reset | |||||
| // #pragma options align=reset | |||||
| struct Error { | struct Error { | ||||
| Lisp_Object* position; | Lisp_Object* position; | ||||
| // type has to be a keyword | // type has to be a keyword | ||||
| @@ -1,8 +1,7 @@ | |||||
| namespace Slime { | namespace Slime { | ||||
| typedef s32 testresult; | |||||
| #define epsilon 2.2204460492503131E-16 | #define epsilon 2.2204460492503131E-16 | ||||
| #define testresult int | |||||
| #define pass 1 | #define pass 1 | ||||
| #define fail 0 | #define fail 0 | ||||
| @@ -46,15 +45,15 @@ namespace Slime { | |||||
| return fail; \ | return fail; \ | ||||
| } \ | } \ | ||||
| #define assert_equal_double(variable, value) \ | |||||
| if (fabs((double)variable - (double)value) > epsilon) { \ | |||||
| print_assert_equal_fail(variable, value, double, "%f"); \ | |||||
| #define assert_equal_f64(variable, value) \ | |||||
| if (fabs((f64)variable - (f64)value) > epsilon) { \ | |||||
| print_assert_equal_fail(variable, value, f64, "%f"); \ | |||||
| return fail; \ | return fail; \ | ||||
| } | } | ||||
| #define assert_not_equal_double(variable, value) \ | |||||
| if (fabs((double)variable - (double)value) <= epsilon) { \ | |||||
| print_assert_not_equal_fail(variable, value, double, "%f"); \ | |||||
| #define assert_not_equal_f64(variable, value) \ | |||||
| if (fabs((f64)variable - (f64)value) <= epsilon) { \ | |||||
| print_assert_not_equal_fail(variable, value, f64, "%f"); \ | |||||
| return fail; \ | return fail; \ | ||||
| } | } | ||||
| @@ -87,7 +86,7 @@ namespace Slime { | |||||
| } \ | } \ | ||||
| else { \ | else { \ | ||||
| result = false; \ | result = false; \ | ||||
| for(int i = -1; i < 70; ++i) \ | |||||
| for(s32 i = -1; i < 70; ++i) \ | |||||
| fputs((i%3==1)? "." : " ", stdout); \ | fputs((i%3==1)? "." : " ", stdout); \ | ||||
| fputs(console_red "failed\n" console_normal, stdout); \ | fputs(console_red "failed\n" console_normal, stdout); \ | ||||
| if(Globals::error) { \ | if(Globals::error) { \ | ||||
| @@ -105,7 +104,7 @@ namespace Slime { | |||||
| } \ | } \ | ||||
| else { \ | else { \ | ||||
| result = false; \ | result = false; \ | ||||
| for(int i = -1; i < 70; ++i) \ | |||||
| for(s32 i = -1; i < 70; ++i) \ | |||||
| fputs((i%3==1)? "." : " ", stdout); \ | fputs((i%3==1)? "." : " ", stdout); \ | ||||
| fputs(console_red "failed\n" console_normal, stdout); \ | fputs(console_red "failed\n" console_normal, stdout); \ | ||||
| if(Globals::error) { \ | if(Globals::error) { \ | ||||
| @@ -116,7 +115,7 @@ namespace Slime { | |||||
| proc test_array_lists_adding_and_removing() -> testresult { | proc test_array_lists_adding_and_removing() -> testresult { | ||||
| // test adding and removing | // test adding and removing | ||||
| Array_List<int> list; | |||||
| Array_List<s32> list; | |||||
| list.alloc(); | list.alloc(); | ||||
| defer { | defer { | ||||
| list.dealloc(); | list.dealloc(); | ||||
| @@ -146,7 +145,7 @@ namespace Slime { | |||||
| proc test_array_lists_sorting() -> testresult { | proc test_array_lists_sorting() -> testresult { | ||||
| // test adding and removing | // test adding and removing | ||||
| Array_List<int> list; | |||||
| Array_List<s32> list; | |||||
| list.alloc(); | list.alloc(); | ||||
| defer { | defer { | ||||
| list.dealloc(); | list.dealloc(); | ||||
| @@ -184,7 +183,7 @@ namespace Slime { | |||||
| } | } | ||||
| proc test_array_lists_searching() -> testresult { | proc test_array_lists_searching() -> testresult { | ||||
| Array_List<int> list; | |||||
| Array_List<s32> list; | |||||
| list.alloc(); | list.alloc(); | ||||
| defer { | defer { | ||||
| list.dealloc(); | list.dealloc(); | ||||
| @@ -195,7 +194,7 @@ namespace Slime { | |||||
| list.append(3); | list.append(3); | ||||
| list.append(4); | list.append(4); | ||||
| int index = list.sorted_find(3); | |||||
| s32 index = list.sorted_find(3); | |||||
| assert_equal_int(index, 2); | assert_equal_int(index, 2); | ||||
| index = list.sorted_find(1); | index = list.sorted_find(1); | ||||
| @@ -208,7 +207,7 @@ namespace Slime { | |||||
| } | } | ||||
| proc test_parse_atom() -> testresult { | proc test_parse_atom() -> testresult { | ||||
| int index_in_text = 0; | |||||
| u32 index_in_text = 0; | |||||
| char string[] = | char string[] = | ||||
| "123 -1.23e-2 " // numbers | "123 -1.23e-2 " // numbers | ||||
| "\"asd\" " // strings | "\"asd\" " // strings | ||||
| @@ -219,13 +218,13 @@ namespace Slime { | |||||
| Lisp_Object* result = Parser::parse_atom(string, &index_in_text); | Lisp_Object* result = Parser::parse_atom(string, &index_in_text); | ||||
| assert_equal_type(result, Lisp_Object_Type::Number); | assert_equal_type(result, Lisp_Object_Type::Number); | ||||
| assert_equal_double(result->value.number, 123); | |||||
| assert_equal_f64(result->value.number, 123); | |||||
| ++index_in_text; | ++index_in_text; | ||||
| result = Parser::parse_atom(string, &index_in_text); | result = Parser::parse_atom(string, &index_in_text); | ||||
| assert_equal_type(result, Lisp_Object_Type::Number); | assert_equal_type(result, Lisp_Object_Type::Number); | ||||
| assert_equal_double(result->value.number, -1.23e-2); | |||||
| assert_equal_f64(result->value.number, -1.23e-2); | |||||
| // test strings | // test strings | ||||
| ++index_in_text; | ++index_in_text; | ||||
| @@ -264,7 +263,7 @@ namespace Slime { | |||||
| } | } | ||||
| proc test_parse_expression() -> testresult { | proc test_parse_expression() -> testresult { | ||||
| int index_in_text = 0; | |||||
| u32 index_in_text = 0; | |||||
| char string[] = "(fun + 12)"; | char string[] = "(fun + 12)"; | ||||
| Lisp_Object* result = Parser::parse_expression(string, &index_in_text); | Lisp_Object* result = Parser::parse_expression(string, &index_in_text); | ||||
| @@ -284,7 +283,7 @@ namespace Slime { | |||||
| assert_equal_type(result, Lisp_Object_Type::Pair); | assert_equal_type(result, Lisp_Object_Type::Pair); | ||||
| assert_equal_type(result->value.pair.first, Lisp_Object_Type::Number); | assert_equal_type(result->value.pair.first, Lisp_Object_Type::Number); | ||||
| assert_equal_double(result->value.pair.first->value.number, 12); | |||||
| assert_equal_f64(result->value.pair.first->value.number, 12); | |||||
| result = result->value.pair.rest; | result = result->value.pair.rest; | ||||
| @@ -327,7 +326,7 @@ namespace Slime { | |||||
| assert_no_error(); | assert_no_error(); | ||||
| assert_not_null(result); | assert_not_null(result); | ||||
| assert_equal_type(result, Lisp_Object_Type::Number); | assert_equal_type(result, Lisp_Object_Type::Number); | ||||
| assert_equal_double(result->value.number, 14); | |||||
| assert_equal_f64(result->value.number, 14); | |||||
| return pass; | return pass; | ||||
| } | } | ||||
| @@ -342,7 +341,7 @@ namespace Slime { | |||||
| assert_no_error(); | assert_no_error(); | ||||
| assert_not_null(result); | assert_not_null(result); | ||||
| assert_equal_type(result, Lisp_Object_Type::Number); | assert_equal_type(result, Lisp_Object_Type::Number); | ||||
| assert_equal_double(result->value.number, 6); | |||||
| assert_equal_f64(result->value.number, 6); | |||||
| return pass; | return pass; | ||||
| } | } | ||||
| @@ -357,7 +356,7 @@ namespace Slime { | |||||
| assert_no_error(); | assert_no_error(); | ||||
| assert_not_null(result); | assert_not_null(result); | ||||
| assert_equal_type(result, Lisp_Object_Type::Number); | assert_equal_type(result, Lisp_Object_Type::Number); | ||||
| assert_equal_double(result->value.number, 40); | |||||
| assert_equal_f64(result->value.number, 40); | |||||
| return pass; | return pass; | ||||
| } | } | ||||
| @@ -372,7 +371,7 @@ namespace Slime { | |||||
| assert_no_error(); | assert_no_error(); | ||||
| assert_not_null(result); | assert_not_null(result); | ||||
| assert_equal_type(result, Lisp_Object_Type::Number); | assert_equal_type(result, Lisp_Object_Type::Number); | ||||
| assert_equal_double(result->value.number, 5); | |||||
| assert_equal_f64(result->value.number, 5); | |||||
| return pass; | return pass; | ||||
| } | } | ||||
| @@ -387,7 +386,7 @@ namespace Slime { | |||||
| assert_no_error(); | assert_no_error(); | ||||
| assert_not_null(result); | assert_not_null(result); | ||||
| assert_equal_type(result, Lisp_Object_Type::Number); | assert_equal_type(result, Lisp_Object_Type::Number); | ||||
| assert_equal_double(result->value.number, 4); | |||||
| assert_equal_f64(result->value.number, 4); | |||||
| char exp_string2[] = "(if () 4 5)"; | char exp_string2[] = "(if () 4 5)"; | ||||
| expression = Parser::parse_single_expression(exp_string2); | expression = Parser::parse_single_expression(exp_string2); | ||||
| @@ -396,7 +395,7 @@ namespace Slime { | |||||
| assert_no_error(); | assert_no_error(); | ||||
| assert_not_null(result); | assert_not_null(result); | ||||
| assert_equal_type(result, Lisp_Object_Type::Number); | assert_equal_type(result, Lisp_Object_Type::Number); | ||||
| assert_equal_double(result->value.number, 5); | |||||
| assert_equal_f64(result->value.number, 5); | |||||
| return pass; | return pass; | ||||
| } | } | ||||
| @@ -650,8 +649,8 @@ namespace Slime { | |||||
| #undef assert_no_error | #undef assert_no_error | ||||
| #undef assert_equal_int | #undef assert_equal_int | ||||
| #undef assert_not_equal_int | #undef assert_not_equal_int | ||||
| #undef assert_equal_double | |||||
| #undef assert_not_equal_double | |||||
| #undef assert_equal_f64 | |||||
| #undef assert_not_equal_f64 | |||||
| #undef assert_equal_string | #undef assert_equal_string | ||||
| #undef assert_equal_type | #undef assert_equal_type | ||||
| #undef assert_null | #undef assert_null | ||||
| @@ -1,11 +0,0 @@ | |||||
| echo "" | |||||
| echo "----------------------" | |||||
| echo " compiling libslime " | |||||
| echo "----------------------" | |||||
| echo "" | |||||
| clang++ --std=c++17 \ | |||||
| main.cpp -o main \ | |||||
| -I../../3rd/ \ | |||||
| -I../../src/ \ | |||||
| -I../../include/ \ | |||||
| @@ -1,6 +0,0 @@ | |||||
| #include <libslime.cpp> | |||||
| int main() { | |||||
| int res = Slime::run_all_tests(); | |||||
| return res ? 0 : 1; | |||||
| } | |||||
| @@ -1,21 +0,0 @@ | |||||
| echo "" | |||||
| echo "----------------------" | |||||
| echo " compiling libslime " | |||||
| echo "----------------------" | |||||
| echo "" | |||||
| clang++ --std=c++17 \ | |||||
| ../../src/libslime.cpp -c -o libslime.o \ | |||||
| -I../../3rd/ \ | |||||
| -I../../src/ | |||||
| echo "" | |||||
| echo "----------------------" | |||||
| echo " compiling main " | |||||
| echo "----------------------" | |||||
| echo "" | |||||
| clang++ --std=c++17 \ | |||||
| main.cpp -o main libslime.o \ | |||||
| -I../../include/ \ | |||||
| -I../../3rd/ | |||||
| @@ -1,6 +0,0 @@ | |||||
| #include <libslime.h> | |||||
| int main() { | |||||
| int res = Slime::run_all_tests(); | |||||
| return res ? 0 : 1; | |||||
| } | |||||
| @@ -1,18 +1,40 @@ | |||||
| * DONE docs as a external dict to make LO smaller | |||||
| CLOSED: [2020-03-29 So 20:00] | |||||
| * DONE and_then_action NAS_Action | |||||
| CLOSED: [2020-03-29 So 20:01] | |||||
| * DONE renames [8/8] | |||||
| CLOSED: [2020-03-29 So 20:49] | |||||
| - [X] define-syntax -> define-macro | |||||
| - [X] mutate -> mutate! | |||||
| - [X] pair -> cons | |||||
| - [X] first -> car | |||||
| - [X] rest -> cdr | |||||
| - [X] generate-docs -> generate-docs-file | |||||
| - [X] break -> show-environment | |||||
| - [X] mytry -> attempt | |||||
| * DONE rename modifying functions to have suffix '!' | |||||
| CLOSED: [2020-03-29 So 21:00] | |||||
| * DONE write and/or as macros | |||||
| CLOSED: [2020-03-29 So 21:27] | |||||
| * DONE consisitent names (Lisp_Object_Type_to_string .. lisp_object_to_string) | |||||
| CLOSED: [2020-03-29 So 21:27] | |||||
| * DONE use better type names: u32, .. | |||||
| CLOSED: [2020-03-31 Di 11:36] | |||||
| * TODO when copying LO<string>, check if string itself is being copied | |||||
| * TODO define-syntax-shorthand | |||||
| (define-syntax-shorthand [ vector ] ) | |||||
| (define-syntax-shorthand { hash-map } ) | |||||
| * TODO doc generation | |||||
| * TODO assert list_length for arguemns of macros | * TODO assert list_length for arguemns of macros | ||||
| ??? | |||||
| * TODO update header files | * TODO update header files | ||||
| * TODO use better type names: u32, .. | |||||
| * TODO write and/or as macros | |||||
| * TODO docs as a external dict to make LO smaller | |||||
| * TODO doc generation | |||||
| * TODO source code locations | |||||
| * TODO function let | * TODO function let | ||||
| (let fac ([n 10]) | (let fac ([n 10]) | ||||
| (if (zero? n) | (if (zero? n) | ||||
| 1 | 1 | ||||
| (* n (fac (sub1 n))))) | (* n (fac (sub1 n))))) | ||||
| 3628800 | 3628800 | ||||
| * TODO runHook NAS_Action | |||||
| * TODO consisitent names (Lisp_Object_Type_to_string .. lisp_object_to_string) | |||||
| * TODO rename modifying functions to have suffix '!' | |||||
| * TODO rename slime to plisk | * TODO rename slime to plisk | ||||
| * TODO BUG 1: eval dot notation | * TODO BUG 1: eval dot notation | ||||
| #+BEGIN_SRC lisp | #+BEGIN_SRC lisp | ||||