From 76dd4d6482aeda12e9fb30d42b155766bd502a0e Mon Sep 17 00:00:00 2001 From: FelixBrendel Date: Tue, 31 Mar 2020 11:38:53 +0200 Subject: [PATCH] using stdint types --- .dir-locals.el | 2 +- .gitignore | 2 +- .rgignore | 1 + 3rd/ftb | 2 +- bin/alist.slime | 44 +- bin/cxr.slime | 4 - bin/emoji.slime | 2 +- ...te-docs.slime => generate-docs-file.slime} | 16 +- bin/interpolation.slime | 2 +- bin/math.slime | 12 +- bin/oo.slime | 12 +- bin/pre.slime | 232 +++++----- bin/pre.slime.expanded | 106 ----- bin/sets.slime | 2 +- bin/tests/alists.slime | 20 +- bin/tests/automata.slime | 24 +- bin/tests/class_macro.slime | 12 +- bin/tests/evaluation_of_default_args.slime | 2 +- bin/tests/lexical_scope.slime | 4 +- bin/tests/macro_expand.slime | 4 +- build.bat | 3 +- build.sh | 2 +- build_clang.bat | 25 -- compile_flags.txt | 5 - debug.bat | 4 - include/assert.hpp | 54 --- include/define_macros.hpp | 154 ------- include/libslime.h | 237 ----------- include/parse.cpp | 398 ------------------ integration/emacs/slime-mode.el | 14 +- src/built_ins.cpp | 124 +++--- src/define_macros.hpp | 8 +- src/docgeneration.cpp | 6 +- src/env.cpp | 32 +- src/error.cpp | 27 +- src/eval.cpp | 44 +- src/forward_decls.cpp | 18 +- src/globals.cpp | 4 +- src/io.cpp | 52 ++- src/libslime.cpp | 25 +- src/lisp_object.cpp | 2 +- src/main.cpp | 8 +- src/memory.cpp | 18 +- src/parse.cpp | 50 +-- src/platform.cpp | 18 +- src/structs.cpp | 14 +- src/testing.cpp | 53 ++- tests/fullslime/build.sh | 11 - tests/fullslime/main.cpp | 6 - tests/libslime/build.sh | 21 - tests/libslime/main.cpp | 6 - todo.org | 36 +- 52 files changed, 482 insertions(+), 1502 deletions(-) rename bin/{generate-docs.slime => generate-docs-file.slime} (72%) delete mode 100644 bin/pre.slime.expanded delete mode 100644 build_clang.bat delete mode 100644 compile_flags.txt delete mode 100644 debug.bat delete mode 100644 include/assert.hpp delete mode 100644 include/define_macros.hpp delete mode 100644 include/libslime.h delete mode 100644 include/parse.cpp delete mode 100644 tests/fullslime/build.sh delete mode 100644 tests/fullslime/main.cpp delete mode 100644 tests/libslime/build.sh delete mode 100644 tests/libslime/main.cpp diff --git a/.dir-locals.el b/.dir-locals.el index 0453cfa..cf53c5f 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -29,7 +29,7 @@ (font-lock-add-keywords '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))))))) (c++-mode . ((eval . (company-clang-set-prefix "slime.h")) diff --git a/.gitignore b/.gitignore index c8a9737..b4dd02a 100644 --- a/.gitignore +++ b/.gitignore @@ -17,12 +17,12 @@ todo.html /manual/manual.pdf /manual/manual.tex *.out -/bin/slime *.report *.svg /tests/libslime/main /tests/fullslime/main *.o +/bin/slime /bin/slime_d /bin/slime_p *.json diff --git a/.rgignore b/.rgignore index 66f3395..37c2036 100644 --- a/.rgignore +++ b/.rgignore @@ -1,4 +1,5 @@ /vs /build /manual +/profiler_vis/speedscope todo.org \ No newline at end of file diff --git a/3rd/ftb b/3rd/ftb index e5cb9ce..f35d5c6 160000 --- a/3rd/ftb +++ b/3rd/ftb @@ -1 +1 @@ -Subproject commit e5cb9ce81d822fee56bdef1f44b3f8d1a29618de +Subproject commit f35d5c6d900447fc8d29e68abe4838b788f067b9 diff --git a/bin/alist.slime b/bin/alist.slime index f9cccc0..043d621 100644 --- a/bin/alist.slime +++ b/bin/alist.slime @@ -15,13 +15,13 @@ :alist)) (define (print alist) - (let ((associations (first alist))) + (let ((associations (car alist))) (define (pprint-intern associations) (when associations (print " " (caar associations) "->" (cdar associations)) - (pprint-intern (rest associations)))) + (pprint-intern (cdr associations)))) (print "(") (when associations (print "\n") @@ -30,22 +30,22 @@ (define (get alist key) - (let ((associations (first alist))) + (let ((associations (car alist))) (define (alist-get-intern associations key) (cond ((null? associations) (error :key-not-found "key was not found in alist")) ((= (caar associations) key) (cdar associations)) - (else (alist-get-intern (rest associations) key)))) + (else (alist-get-intern (cdr associations) key)))) (alist-get-intern associations key))) (define (find alist key) - (let ((associations (first alist))) + (let ((associations (car alist))) (define (alist-find-intern associations key current-index) (cond ((null? associations) key-not-found-index) ((= (caar associations) key) current-index) - (else (alist-find-intern (rest associations) + (else (alist-find-intern (cdr associations) key (+ 1 current-index))))) (alist-find-intern associations key 0))) @@ -65,31 +65,31 @@ (if (= index 1) ;; we want to remove the next one, so we set our ;; 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 - (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")) - ((= index 0) (mutate alist (pair (cdar alist) ()))) + ((= index 0) (mutate! alist (cons (cdar alist) ()))) (else (alist-remove!-internal alist index)))) alist) (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)) ()) :alist))) (define (set-overwrite! alist key value) - (let ((associations (first alist))) + (let ((associations (car alist))) (define (alist-set-overwrite-intern associations key value) (cond ((= (caar associations) key) - (mutate (car associations) (pair key value))) + (mutate! (car associations) (cons key value))) ((null? associations) (set! alist key value)) (else (alist-set-overwrite-intern - (rest associations) key value)))) + (cdr associations) key value)))) (alist-set-overwrite-intern associations key value)) alist) ) @@ -116,7 +116,7 @@ :plist)) (define (print plist) - (let ((props (first plist))) + (let ((props (car plist))) (define (pprint-intern props) (when props (print " " @@ -130,7 +130,7 @@ (print ")\n"))) (define (get plist prop) - (let ((props (first plist))) + (let ((props (car plist))) (define (plist-get-intern props prop) (cond ((null? props) (error :key-not-found "property was not found in plist")) @@ -140,14 +140,14 @@ (plist-get-intern props prop))) (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))) (define (set-overwrite! plist prop value) - (let ((props (first plist))) + (let ((props (car plist))) (define (plist-set-overwrite-intern props prop value) (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)) (else (plist-set-overwrite-intern (cddr props) prop value)))) @@ -155,7 +155,7 @@ plist) (define (find plist prop) - (let ((props (first plist))) + (let ((props (car plist))) (define (plist-find-intern props prop current-index) (cond ((null? props) key-not-found-index) ((= (car props) prop) current-index) @@ -176,13 +176,13 @@ (if (= index 1) ;; we want to remove the next one, so we set our ;; 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)))))) ;; else cdr-recurse (plist-remove!-internal (cddr props) (- index 1)))) (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)))) plist) diff --git a/bin/cxr.slime b/bin/cxr.slime index 630ebfa..03fc7d2 100644 --- a/bin/cxr.slime +++ b/bin/cxr.slime @@ -1,7 +1,3 @@ -(define cons pair) -(define car first) -(define cdr rest) - (define (caar seq) (car (car seq))) diff --git a/bin/emoji.slime b/bin/emoji.slime index 778ae7d..f01e34e 100644 --- a/bin/emoji.slime +++ b/bin/emoji.slime @@ -3826,6 +3826,6 @@ (hm/set! emoji-map :flag:-Wales '🏴󠁧󠁢󠁷󠁬󠁳󠁿) (define (get emoji-name) - (mytry + (attempt (hm/get emoji-map emoji-name) (error :not-found "emoji was not found")))) diff --git a/bin/generate-docs.slime b/bin/generate-docs-file.slime similarity index 72% rename from bin/generate-docs.slime rename to bin/generate-docs-file.slime index df15edd..ff4ab8e 100644 --- a/bin/generate-docs.slime +++ b/bin/generate-docs-file.slime @@ -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") diff --git a/bin/interpolation.slime b/bin/interpolation.slime index 92bca45..eab7de3 100644 --- a/bin/interpolation.slime +++ b/bin/interpolation.slime @@ -17,7 +17,7 @@ (dt (/ 1 #steps))) (lambda () (let ((res (lerp a b t))) - (mutate t (+ t dt)) + (mutate! t (+ t dt)) res)))) (define make-point pair) diff --git a/bin/math.slime b/bin/math.slime index 286959e..7196041 100644 --- a/bin/math.slime +++ b/bin/math.slime @@ -15,17 +15,17 @@ (** x 0.5)) (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) (** (+ (* x x) (* y y) (* z z)) 0.5)) (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) (define (add other) diff --git a/bin/oo.slime b/bin/oo.slime index b59f2a4..1c551f4 100644 --- a/bin/oo.slime +++ b/bin/oo.slime @@ -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." - (let ((name (first name-and-members)) - (members (rest name-and-members))) + (let ((name (car name-and-members)) + (members (cdr name-and-members))) `(set-type! (define ;; The function definition @@ -14,12 +14,12 @@ (set-type! (lambda args "This is the docs for the handle" - (let ((op (eval (first args)))) + (let ((op (eval (car args)))) (if (procedure? op) (eval args) - (eval (first args))))) + (eval (car args))))) ,(symbol->keyword name)))) :constructor))) -(define-syntax (-> obj meth . args) +(define-macro (-> obj meth . args) `(,obj ',meth ,@args)) diff --git a/bin/pre.slime b/bin/pre.slime index 8cca1fd..01aa06a 100644 --- a/bin/pre.slime +++ b/bin/pre.slime @@ -5,13 +5,17 @@ ;; (kk) +(define pair cons) +(define first car) +(define rest cdr) + (define hm/set! hash-map-set!) (define hm/get hash-map-get) (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 (print :end " " ',expr "evaluates to") ((lambda (e) @@ -23,16 +27,16 @@ (define (stream-null? s) (when s t)) -(define-syntax (delay expr) +(define-macro (delay expr) `(,lambda () ,expr)) (define (force 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)) ;; -> ;; (if cond1 @@ -44,12 +48,12 @@ ;; ()) ;; ()) (if args - `(,if ,(first args) - ,(apply and (rest args)) + `(,if ,(car args) + ,(apply and (cdr args)) ()) t)) -(define-syntax (or . args) +(define-macro (or . args) ;; (or cond1 cond2 (cond3 args)) ;; -> ;; (if cond1 @@ -60,12 +64,12 @@ ;; t ;; ()))) (if args - `(,if ,(first args) + `(,if ,(car args) 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 condition is true. @@ -80,68 +84,68 @@ condition is true. (print \"World!\")) {{{example_end}}} " - (if (= (rest body) ()) + (if (= (cdr body) ()) `(if ,condition ,@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 condition is false." - (if (= (rest body) ()) + (if (= (cdr body) ()) `(if ,condition nil ,@body) `(if ,condition nil (begin ,@body)))) -(define-syntax (n-times times action) +(define-macro (n-times times action) "Executes action times times." (define (repeat times elem) (unless (> 1 times) - (pair elem (repeat (- times 1) elem)))) + (cons elem (repeat (- times 1) elem)))) `(begin ,@(repeat times action))) -(define-syntax (let bindings . body) +(define-macro (let bindings . body) (define (unzip lists) (when lists (define (iter lists l1 l2) - (define elem (first lists)) + (define elem (car lists)) (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))) (iter lists () ()))) (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) (if (= () clauses) () - (if (= (first (first clauses)) 'else) + (if (= (car (car clauses)) 'else) (begin - (if (not (= (rest clauses) ())) + (if (not (= (cdr 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)))))) + (cons 'begin (cdr (car clauses))))) + `(if ,(car (car clauses)) + (begin ,@(cdr (car clauses))) + ,(rec (cdr clauses)))))) (rec clauses)) -(define-syntax (case var . clauses) +(define-macro (case var . clauses) (define (rec clauses) (if (= nil clauses) nil - (if (= (first (first clauses)) 'else) + (if (= (car (car clauses)) 'else) (begin - (if (not (= (rest clauses) ())) + (if (not (= (cdr 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)))))) + (cons 'begin (cdr (car clauses))))) + `(if (member? ,var ',(car (car clauses))) + (begin ,@(cdr (car clauses))) + ,(rec (cdr clauses)))))) (rec clauses)) -(define-syntax (construct-list . body) +(define-macro (construct-list . body) " {{{example_start}}} (construct-list @@ -152,7 +156,7 @@ condition is false." (construct-list i <- '(1 2 3 4) j <- '(A B) - yield (pair i j)) + yield (cons i j)) (construct-list i <- '(1 2 3 4 5 6 7 8) @@ -161,44 +165,44 @@ condition is false." " (define (append-map f 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 val - (append-map f (rest ll)))))) + (append-map f (cdr 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))) + ((= () (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")))) (rec body)) -(define-syntax (define-typed args . body) +(define-macro (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)))) + (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) (assert-types= ,@lambda-list) ,@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) "::"))) (eval `(,begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body)) - (pair 'begin + (cons 'begin (map (lambda (orig-export-name) ((lambda (export-name) `(define ,export-name @@ -213,7 +217,7 @@ condition is false." (exec `(begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body))) (eval exec) (enable-debug-log) - (pair begin + (cons begin (map (lambda (orig-export-name) ((lambda (export-name) `(define ,export-name @@ -224,24 +228,24 @@ condition is false." exports)) (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 ()) (names ())) (define (process-params params) (when params - (let ((_name (first params)) - (_type (first (rest params)))) + (let ((_name (car params)) + (_type (car (cdr params)))) (assert (symbol? _name)) (assert (keyword? _type)) (set! types (append types _type)) (set! names (append names _name)) - (process-params (rest (rest params)))))) + (process-params (cdr (cdr params)))))) (process-params params) ;; we have the fun-name, the param names and the types, lets go: ;; - ;; first check if there is already a generic--map + ;; car check if there is already a generic--map (let ((generic-map-name (string->symbol (concat-strings "generic-" (symbol->string fun-name) "-map")))) (unless (bound? generic-map-name) @@ -279,10 +283,10 @@ condition is false." (define (types=? . objs) (define (inner 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) - (inner (rest (rest objs))) + (inner (cdr (cdr objs))) ())) t)) (inner objs)) @@ -290,10 +294,10 @@ condition is false." (define (assert-types= . objs) (define (inner 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) - (inner (rest (rest objs))) + (inner (cdr (cdr objs))) (error :type-missmatch "type missmatch" actual-type desired-type))))) (inner objs)) @@ -309,7 +313,7 @@ condition is false." "Checks if the argument is a keyword." (type=? x :keyword)) -(define (pair? x) +(define (cons? x) "Checks if the argument is a pair." (type=? x :pair)) @@ -352,70 +356,70 @@ condition is false." (print (end a)) {{{example_end}}} " - (if (or (null? seq) (not (pair? (rest seq)))) + (if (or (null? seq) (not (cons? (cdr seq)))) seq - (end (rest seq)))) + (end (cdr 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}}} (define a (list 1 2 3 4)) (print (last a)) {{{example_end}}} " - (first (end seq))) + (car (end seq))) (define (extend seq elem) "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 (define e (end seq)) - (mutate e (pair (first e) elem)) + (mutate! e (cons (car e) elem)) seq) elem)) (define (extend2 seq elem) "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))) - (if (pair? seq) + (if (cons? seq) (let ((e (end seq))) (print "addr if e inner" (addr-of e)) - (mutate e (pair (first e) elem)) + (mutate! e (cons (car e) elem)) seq)) elem) (define (append seq elem) "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) "Returns the length of the given sequence." (if (null? seq) 0 - (+ 1 (length (rest seq))))) + (+ 1 (length (cdr seq))))) (define (member? elem seq) - (when (pair? seq) - (if (= elem (first seq)) + (when (cons? seq) + (if (= elem (car seq)) t - (member? elem (rest seq))))) + (member? elem (cdr 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))))) + (else (sublist-starting-at (cdr 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)))))) + ((= 0 index) (cdr seq)) + (else (cons (car seq) (list-without-index (cdr seq) (- index 1)))))) (define (increment val) "Adds one to the argument." @@ -429,7 +433,7 @@ with (pair elem nil)." "Returns a sequence of numbers starting with the number defined by the key =from= and ends with the number defined in =to=." (when (< from to) - (pair from (range :from (+ 1 from) :to to)))) + (cons from (range :from (+ 1 from) :to to)))) (define (range-while (:from 0) :to) "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)) (while (< from to) (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)))) result) (define (map fun seq) "Takes a function and a sequence as arguments and returns a new -sequence which contains the results of using the first sequences +sequence which contains the results of using the car sequences elemens as argument to that function." (if (null? seq) seq - (pair (fun (first seq)) - (map fun (rest seq))))) + (cons (fun (car seq)) + (map fun (cdr seq))))) (define (reduce fun seq) "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 *pair-wise* which means it works with binary functions as compared to [[=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) "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 added to a list, which in the end is returned." (when seq - (if (fun (first seq)) - (pair (first seq) - (filter fun (rest seq))) - (filter fun (rest seq))))) + (if (fun (car seq)) + (cons (car seq) + (filter fun (cdr seq))) + (filter fun (cdr seq))))) (define (zip l1 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) (when lists (define (iter lists l1 l2) - (define elem (first lists)) + (define elem (car lists)) (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))) (iter lists () ()))) @@ -503,8 +507,8 @@ added to a list, which in the end is returned." (define (enumerate seq) (define (enumerate-inner seq next-num) (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)) diff --git a/bin/pre.slime.expanded b/bin/pre.slime.expanded deleted file mode 100644 index 434b363..0000000 --- a/bin/pre.slime.expanded +++ /dev/null @@ -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)) - diff --git a/bin/sets.slime b/bin/sets.slime index 3be85fc..fe3485c 100644 --- a/bin/sets.slime +++ b/bin/sets.slime @@ -25,7 +25,7 @@ (define (insert! 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) ) diff --git a/bin/tests/alists.slime b/bin/tests/alists.slime index 6f61c77..680961a 100644 --- a/bin/tests/alists.slime +++ b/bin/tests/alists.slime @@ -3,7 +3,7 @@ (define a (ds::alist::make)) ;; a == (()) -(assert (= (first a) ())) +(assert (= (car a) ())) (ds::alist::set! a 'key1 'value1) ;; a == (key1: value1) @@ -20,7 +20,7 @@ (assert (ds::alist::key-exists? a 'key2)) (assert (= (ds::alist::find a 'key2) 0)) (assert (= (ds::alist::find a 'key1) 1)) -(assert (= (length (first a)) 2)) +(assert (= (length (car a)) 2)) (ds::alist::set! a 'key1 'value3) @@ -28,7 +28,7 @@ ;; key2: value2, ;; key1: value1) -(assert (= (length (first a)) 3)) +(assert (= (length (car a)) 3)) (assert (= (ds::alist::get a 'key1) 'value3)) (ds::alist::set-overwrite! a 'key1 'value4) @@ -36,14 +36,14 @@ ;; key2: value2, ;; key1: value1) -(assert (= (length (first a)) 3)) +(assert (= (length (car a)) 3)) (assert (= (ds::alist::get a 'key1) 'value4)) (ds::alist::remove! a 'key1) ;; a == (key2: value2, ;; key1: value1) -(assert (= (length (first a)) 2)) +(assert (= (length (car a)) 2)) (assert (= (ds::alist::get a 'key1) 'value1)) (assert (= (ds::alist::get a 'key2) 'value2)) @@ -57,7 +57,7 @@ (define p (ds::plist::make)) ;; p == (()) -(assert (= (first p) ())) +(assert (= (car p) ())) (ds::plist::set! p :key1 'value1) ;; p == ((:key1 value1)) @@ -74,14 +74,14 @@ (assert (ds::plist::prop-exists? p :key2)) (assert (= (ds::plist::find p :key2) 0)) (assert (= (ds::plist::find p :key1) 1)) -(assert (= (length (first p)) 4)) +(assert (= (length (car p)) 4)) (ds::plist::set! p :key1 'value3) ;; p == ((:key1 value3, ;; :key2 value2, ;; :key1 value1)) -(assert (= (length (first p)) 6)) +(assert (= (length (car p)) 6)) (assert (= (ds::plist::get p :key1) 'value3)) (ds::plist::set-overwrite! p :key1 'value4) @@ -89,13 +89,13 @@ ;; :key2 value2, ;; :key1 value1)) -;; (assert (= (length (first p)) 6)) +;; (assert (= (length (car p)) 6)) ;; (assert (= (ds::plist::get p :key1) 'value4)) ;; (ds::plist::remove! p :key1) ;; ;; p == ((:key2 value2, ;; ;; :key1 value1)) -;; (assert (= (length (first p)) 4)) +;; (assert (= (length (car p)) 4)) ;; (assert (= (ds::plist::get p :key1) 'value1)) ;; (assert (= (ds::plist::get p :key2) 'value2)) diff --git a/bin/tests/automata.slime b/bin/tests/automata.slime index 377234f..0dd0e57 100644 --- a/bin/tests/automata.slime +++ b/bin/tests/automata.slime @@ -22,25 +22,25 @@ (set::make "q0"))) (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"))) - (assert (= (first state) :fail)) - (assert (= (first (rest state)) "q1"))) + (assert (= (car state) :fail)) + (assert (= (car (cdr state)) "q1"))) (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"))) - (assert (= (first state) :fail)) - (assert (= (first (rest state)) "q1"))) + (assert (= (car state) :fail)) + (assert (= (car (cdr state)) "q1"))) (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"))) - (assert (= (first state) :accept)) - (assert (= (first (rest state)) "q0"))) + (assert (= (car state) :accept)) + (assert (= (car (cdr state)) "q0"))) diff --git a/bin/tests/class_macro.slime b/bin/tests/class_macro.slime index 15852d5..193bda0 100644 --- a/bin/tests/class_macro.slime +++ b/bin/tests/class_macro.slime @@ -1,17 +1,17 @@ (import "oo.slime") (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) (** (+ (* x x) (* y y) (* z z)) 0.5)) (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) (define (add other) diff --git a/bin/tests/evaluation_of_default_args.slime b/bin/tests/evaluation_of_default_args.slime index 0167258..164c6e1 100644 --- a/bin/tests/evaluation_of_default_args.slime +++ b/bin/tests/evaluation_of_default_args.slime @@ -10,6 +10,6 @@ ((lambda () (define (a) :ok) - (define (b (:k (begin (break) (a)))) + (define (b (:k (begin (show-environment) (a)))) k) (b)))) diff --git a/bin/tests/lexical_scope.slime b/bin/tests/lexical_scope.slime index 06e6150..6aba474 100644 --- a/bin/tests/lexical_scope.slime +++ b/bin/tests/lexical_scope.slime @@ -26,7 +26,7 @@ (define x 0) (lambda () (define temp x) - (mutate x (+ x 1)) + (mutate! x (+ x 1)) temp)) ;; key arguments @@ -34,7 +34,7 @@ (define (make-key-counter) ((lambda (:var) (lambda () - (mutate var (+ 1 var)) + (mutate! var (+ 1 var)) var)) :var 0)) diff --git a/bin/tests/macro_expand.slime b/bin/tests/macro_expand.slime index d704402..2fe3ce4 100644 --- a/bin/tests/macro_expand.slime +++ b/bin/tests/macro_expand.slime @@ -1,8 +1,8 @@ -(define-syntax (error) +(define-macro (error) (assert t)) -(define-syntax (test) +(define-macro (test) `(begin (+ 1 1) (error) diff --git a/build.bat b/build.bat index 8490a22..6a1f7eb 100644 --- a/build.bat +++ b/build.bat @@ -8,9 +8,8 @@ taskkill /F /IM %exeName% > NUL 2> NUL echo ---------- Compiling ---------- call cl ^ - /DEBUG:FULL^ ../src/main.cpp^ - /I../3rd/ ^ + /I../3rd/ /DEBUG:FULL ^ /D_PROFILING /D_DEBUG /D_DONT_BREAK_ON_ERRORS ^ /Zi /std:c++latest /Fe%exeName% /W3 /wd4003 /wd4996 /nologo /EHsc diff --git a/build.sh b/build.sh index 2e8158f..c6f149c 100755 --- a/build.sh +++ b/build.sh @@ -40,7 +40,7 @@ pushd ./bin > /dev/null # echo "----------------------" # echo " generating docs " # echo "----------------------" -# time valgrind -q ./slime_d --generate-docs || exit 1 +# time valgrind -q ./slime_d --generate-docs-file || exit 1 echo "" echo "----------------------" diff --git a/build_clang.bat b/build_clang.bat deleted file mode 100644 index 4d6fd41..0000000 --- a/build_clang.bat +++ /dev/null @@ -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 diff --git a/compile_flags.txt b/compile_flags.txt deleted file mode 100644 index c9b5a98..0000000 --- a/compile_flags.txt +++ /dev/null @@ -1,5 +0,0 @@ --std=c++17 --D_DEBUG --D_DONT_BREAK_ON_ERRORS --I3rd/ --include=libslime.cpp diff --git a/debug.bat b/debug.bat deleted file mode 100644 index c1bf6ab..0000000 --- a/debug.bat +++ /dev/null @@ -1,4 +0,0 @@ -@echo off -pushd %~dp0 -start "" "cdbg64.exe" build\slime.exe -popd diff --git a/include/assert.hpp b/include/assert.hpp deleted file mode 100644 index 168ef96..0000000 --- a/include/assert.hpp +++ /dev/null @@ -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 diff --git a/include/define_macros.hpp b/include/define_macros.hpp deleted file mode 100644 index 9974310..0000000 --- a/include/define_macros.hpp +++ /dev/null @@ -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) diff --git a/include/libslime.h b/include/libslime.h deleted file mode 100644 index 4f85ff5..0000000 --- a/include/libslime.h +++ /dev/null @@ -1,237 +0,0 @@ -#pragma once - -// #include -#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 call_stack; - Array_List 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 symbols; - }; - - struct Keyword_Arguments { - // Array of Pointers to Lisp_Object - Array_List keywords; - // NOTE(Felix): values[i] will be nullptr if no defalut value was - // declared for key identifiers[i] - Array_List 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 parents; - Hash_Map 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* 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 load_path; - namespace Current_Execution { - extern Array_List call_stack; - extern Array_List envi_stack; - } - - extern Error* error; - extern bool breaking_on_errors; - } -} diff --git a/include/parse.cpp b/include/parse.cpp deleted file mode 100644 index d26bab5..0000000 --- a/include/parse.cpp +++ /dev/null @@ -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* { - profile_this(); - parser_file = file_name; - parser_line = 1; - parser_col = 0; - - Array_List* program = new Array_List; - - 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; - } - -} diff --git a/integration/emacs/slime-mode.el b/integration/emacs/slime-mode.el index 9a5ed2c..c6d0dc0 100644 --- a/integration/emacs/slime-mode.el +++ b/integration/emacs/slime-mode.el @@ -14,7 +14,7 @@ ;; "% a b" ;; "get-random-between a b" ;; "assert test" -;; "define-syntax form (:doc \"\") . body" +;; "define-macro form (:doc \"\") . body" ;; "define definee (:doc \"\") . body" ;; "mutate target source" ;; "vector-length v" @@ -44,7 +44,7 @@ ;; "info n" ;; "show n" ;; "addr-of var" -;; "generate-docs file_name" +;; "generate-docs-file file_name" ;; "print (:sep \" \") (:end \"\\n\") . things" ;; "read (:prompt \">\"" ;; "exit (:code 0)" @@ -62,13 +62,13 @@ (defconst slime-built-ins '("=" ">" ">=" "<" "<=" "+" "-" "*" "/" "**" "%" "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!" "quote" "quasiquote" "unquote" "unquote-splicing" "and" "or" "not" "let" "lambda" "apply" "eval" "begin" "list" "pair" "create-hash-map" "hash-map-get" "hash-map-set!" "hash-map-delete!" "vector" "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" "symbol->string" "concat-strings")) @@ -88,8 +88,8 @@ ((string= s "get-random-between") "a b") ((string= s "assert") "test") ((string= s "define") "definee (:doc \"\") . body") - ((string= s "define-syntax") "form (:doc \"\") . body") - ((string= s "mutate") "(mutate )") + ((string= s "define-macro") "form (:doc \"\") . body") + ((string= s "mutate!") "(mutate! )") ((string= s "if") "(if )") (t '()))) @@ -122,7 +122,7 @@ (put 'lambda 'doc-string-elt 2) (put 'special-lambda '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)" "Major mode for editing slime code." diff --git a/src/built_ins.cpp b/src/built_ins.cpp index 05e085f..dfd928c 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -12,7 +12,7 @@ namespace Slime { case Lisp_Object_Type::Symbol: case Lisp_Object_Type::Keyword: case Lisp_Object_Type::Function: - // TODO(Felix): should a pointer + // QUESTION(Felix): should a pointer // object compare the pointer? case Lisp_Object_Type::Pointer: case Lisp_Object_Type::Continuation: return false; @@ -36,7 +36,7 @@ namespace Slime { n1_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])) return false; if (!lisp_object_equal(n1->value.hashMap->get_object(n1_keys[i]), @@ -49,7 +49,7 @@ namespace Slime { case Lisp_Object_Type::Vector: { if (n1->value.vector.length != n2->value.vector.length ) 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)) return false; } @@ -149,12 +149,6 @@ namespace Slime { String file_name_built_ins = Memory::create_string(__FILE__); 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") { // NOTE(Felix): is has to be a macro because apply by // itself cannot return the result, we have to invoke eval @@ -207,7 +201,7 @@ namespace Slime { { define_symbol( 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__); define((lambda), "") { fetch(c); @@ -236,7 +230,7 @@ namespace Slime { profile_with_name("(begin)"); using namespace Globals::Current_Execution; Lisp_Object* args = pcs[--pcs.next_index]; - int length = list_length(args); + u32 length = list_length(args); cs.reserve(length); for_lisp_list(args) { cs.data[cs.next_index - 1 + (length - it_index)] = it; @@ -402,7 +396,7 @@ namespace Slime { define((> . args), "TODO") { profile_with_name("(>)"); fetch(args); - double last_number = strtod("Inf", NULL); + f64 last_number = strtod("Inf", 0); for_lisp_list (args) { try assert_type(it, Lisp_Object_Type::Number); @@ -417,7 +411,7 @@ namespace Slime { { profile_with_name("(>=)"); fetch(args); - double last_number = strtod("Inf", NULL); + f64 last_number = strtod("Inf", 0); for_lisp_list (args) { try assert_type(it, Lisp_Object_Type::Number); @@ -432,7 +426,7 @@ namespace Slime { { profile_with_name("(<)"); fetch(args); - double last_number = strtod("-Inf", NULL); + f64 last_number = strtod("-Inf", 0); for_lisp_list (args) { try assert_type(it, Lisp_Object_Type::Number); @@ -447,7 +441,7 @@ namespace Slime { { profile_with_name("(<=)"); fetch(args); - double last_number = strtod("-Inf", NULL); + f64 last_number = strtod("-Inf", 0); for_lisp_list (args) { try assert_type(it, Lisp_Object_Type::Number); @@ -463,7 +457,7 @@ namespace Slime { profile_with_name("(+)"); fetch(args); - double sum = 0; + f64 sum = 0; for_lisp_list (args) { 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); - double difference = args->value.pair.first->value.number; + f64 difference = args->value.pair.first->value.number; if (args->value.pair.rest == Memory::nil) { return Memory::create_lisp_object(-difference); @@ -502,7 +496,7 @@ namespace Slime { return Memory::create_lisp_object(1); } - double product = 1; + f64 product = 1; for_lisp_list (args) { 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); - double quotient = args->value.pair.first->value.number; + f64 quotient = args->value.pair.first->value.number; for_lisp_list (args->value.pair.rest) { try assert_type(it, Lisp_Object_Type::Number); @@ -544,8 +538,8 @@ namespace Slime { fetch(a, b); try assert_type(a, 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") { profile_with_name("(get-random-between)"); @@ -553,9 +547,9 @@ namespace Slime { try assert_type(a, 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 += fa; @@ -585,7 +579,10 @@ namespace Slime { define_special((assert test), "TODO") { profile_with_name("(assert)"); 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 { Lisp_Object* res; try res = eval_expr(test); @@ -598,8 +595,8 @@ namespace Slime { free(string); 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); // TODO(Felix): Macros cannot have docs now @@ -623,8 +620,8 @@ namespace Slime { } return Memory::nil; }; - define((mutate target source), "TODO") { - profile_with_name("(mutate)"); + define((mutate! target source), "TODO") { + profile_with_name("(mutate!)"); fetch(target, source); if (target == Memory::nil || @@ -650,7 +647,7 @@ namespace Slime { profile_with_name("(vector-length)"); fetch(v); 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") { profile_with_name("(vector-ref)"); @@ -659,10 +656,10 @@ namespace Slime { try assert_type(vec, Lisp_Object_Type::Vector); 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 < 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; }; @@ -673,10 +670,10 @@ namespace Slime { try assert_type(vec, Lisp_Object_Type::Vector); 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 < 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; @@ -920,28 +917,28 @@ namespace Slime { profile_with_name("(vector)"); fetch(args); Lisp_Object* ret; - int length = list_length(args); + u32 length = list_length(args); try ret = Memory::create_lisp_object_vector(length, args); return ret; }; - define((pair car cdr), "TODO") { - profile_with_name("(pair)"); + define((cons car cdr), "TODO") { + profile_with_name("(cons)"); fetch(car, cdr); Lisp_Object* ret; try ret = Memory::create_lisp_object_pair(car, cdr); return ret; }; - define((first seq), "TODO") { - profile_with_name("(first)"); + define((car seq), "TODO") { + profile_with_name("(car)"); fetch(seq); if (seq == Memory::nil) return Memory::nil; try assert_type(seq, Lisp_Object_Type::Pair); return seq->value.pair.first; }; - define((rest seq), "TODO") { - profile_with_name("(rest)"); + define((cdr seq), "TODO") { + profile_with_name("(cdr)"); fetch(seq); if (seq == Memory::nil) return Memory::nil; @@ -1006,11 +1003,6 @@ namespace Slime { } return Memory::get_keyword("unknown"); }; - // define((mem-reset), "TODO") { - // profile_with_name("(mem-reset)"); - // Memory::reset(); - // return Memory::nil; - // }; define_special((info n), "TODO") { // NOTE(Felix): we need to define_special because the docstring is @@ -1049,7 +1041,7 @@ namespace Slime { if (args->positional.symbols.next_index != 0) { printf("%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) { printf(", %s", Memory::get_c_str(args->positional.symbols.data[i]->value.symbol)); } @@ -1064,7 +1056,7 @@ namespace Slime { print(args->keyword.values.data[0], true); 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", Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol)); if (args->keyword.values.data[i]) { @@ -1102,8 +1094,8 @@ namespace Slime { fetch(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); try assert_type(file_name, Lisp_Object_Type::String); in_caller_env { @@ -1145,10 +1137,10 @@ namespace Slime { profile_with_name("(exit)"); fetch(code); 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 { print_environment(get_current_environment()); } @@ -1159,8 +1151,8 @@ namespace Slime { Memory::print_status(); 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); Lisp_Object* result; @@ -1204,8 +1196,6 @@ namespace Slime { define((copy obj), "TODO") { profile_with_name("(copy)"); 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); }; define((error type message), "TODO") { @@ -1229,6 +1219,14 @@ namespace Slime { try assert_type(sym, Lisp_Object_Type::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") { profile_with_name("(string->symbol)"); fetch(str); @@ -1238,26 +1236,18 @@ namespace Slime { try assert_type(str, Lisp_Object_Type::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") { profile_with_name("(concat-strings)"); fetch(strings); - int resulting_string_len = 0; + u32 resulting_string_len = 0; for_lisp_list (strings) { try assert_type(it, Lisp_Object_Type::String); resulting_string_len += it->value.string.length; } String resulting_string = Memory::create_string("", resulting_string_len); - int index_in_string = 0; + u32 index_in_string = 0; for_lisp_list (strings) { strcpy(resulting_string.data+index_in_string, diff --git a/src/define_macros.hpp b/src/define_macros.hpp index 91295c2..bcfe95d 100644 --- a/src/define_macros.hpp +++ b/src/define_macros.hpp @@ -5,9 +5,9 @@ do { \ if (Globals::log_level == Log_Level::Debug) { \ 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; \ - for (int i = 0; i < spacing;++i) \ + for (s32 i = 0; i < spacing;++i) \ printf(" "); \ printf("%s (%d) ", __FILE__, __LINE__); \ printf("-> %s\n",__FUNCTION__); \ @@ -139,7 +139,7 @@ */ #define for_lisp_vector(v) \ if (!v); else \ - if (int it_index = 0); else \ + if (u32 it_index = 0); else \ for (auto it = v->value.vector.data; \ it_index < v->value.vector.length; \ it=v->value.vector.data+(++it_index)) @@ -149,7 +149,7 @@ */ #define for_lisp_list(l) \ if (!l); else \ - if (int it_index = 0); else \ + if (u32 it_index = 0); else \ for (Lisp_Object* head = l, *it; \ head->type == Lisp_Object_Type::Pair && (it = head->value.pair.first); \ head = head->value.pair.rest, ++it_index) diff --git a/src/docgeneration.cpp b/src/docgeneration.cpp index 5100737..70d04f0 100644 --- a/src/docgeneration.cpp +++ b/src/docgeneration.cpp @@ -99,7 +99,7 @@ namespace Slime { if (args->positional.symbols.next_index != 0) { fprintf(f, "\n - postitional :: "); 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)); } } @@ -111,7 +111,7 @@ namespace Slime { print(args->keyword.values.data[0], true, 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)); if (args->keyword.values.data[i]) { 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); } }; diff --git a/src/env.cpp b/src/env.cpp index 36777c8..1a36669 100644 --- a/src/env.cpp +++ b/src/env.cpp @@ -29,26 +29,24 @@ namespace Slime { proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { // 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; result = lookup_symbol_in_this_envt(node, env); if (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]); if (result) return result; } - auto nil_sym = Memory::get_symbol("nil"); - auto t_sym = Memory::get_symbol("t"); - if (node == nil_sym) { return Memory::nil; - } - if (node == t_sym) { + } else if (node == t_sym) { 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(" "); } }; 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; } for_hash_map (env->hm) { - print_indent(indent); + print_indent(); printf("-> %s :: ", (((Lisp_Object*)key)->value.symbol.data)); print((Lisp_Object*)value); - printf(" (0x%016llx)", (unsigned long long)value); + printf(" (0x%p)", value); 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(":"); print_environment_indent(env->parents.data[i], indent+4); } } proc print_environment(Environment* env) -> void { - printf("\n=== Environment === (%p)\n", env); + printf("\n=== Environment === (0x%p)\n", env); print_environment_indent(env, 0); } diff --git a/src/error.cpp b/src/error.cpp index b1ba966..2230c67 100644 --- a/src/error.cpp +++ b/src/error.cpp @@ -7,7 +7,9 @@ namespace Slime { 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(); if (Globals::breaking_on_errors) { debug_break(); @@ -22,37 +24,32 @@ namespace Slime { if (Globals::log_level > Log_Level::None) { // c error location 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; - for (int i = 0; i < spacing; ++i) + for (s32 i = 0; i < spacing; ++i) 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); } // 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; - - // TODO(Felix): is the length even used?? - int length = 200; - String formatted_string = Memory::create_string("", length); if (error) { error = new(Error); error->type = type; } - int written_length; + // contents will be filled in + String formatted_string = Memory::create_string("", 0); + va_list args; - char* out_msg; va_start(args, format); - written_length = vasprintf(&out_msg, format, args); + formatted_string.length = vasprintf(&formatted_string.data, format, 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); } } diff --git a/src/eval.cpp b/src/eval.cpp index 4a1753a..963e3c4 100644 --- a/src/eval.cpp +++ b/src/eval.cpp @@ -2,13 +2,13 @@ namespace Slime { proc create_extended_environment_for_function_application_nrc( Lisp_Object* function, - int arg_start, - int arg_end) -> Environment* + u32 arg_start, + u32 arg_end) -> Environment* { profile_this(); 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; Environment* env = Memory::create_child_environment(function->value.function->parent_environment); Arguments* arg_spec = &function->value.function->args; @@ -18,14 +18,14 @@ namespace Slime { defer { 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* val; // 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) { create_parsing_error( "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 (index_of_next_arg != arg_end) { // 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) ++obligatory_keywords_count; } @@ -59,7 +59,7 @@ namespace Slime { while (cs.data[index_of_next_arg]->type == Lisp_Object_Type::Keyword) { // check if this one is even an accepted keyword 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]) { accepted = true; break; @@ -80,7 +80,7 @@ namespace Slime { } // This is an accepted kwarg; check if it was already // 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 we already read it in but also finished @@ -130,10 +130,10 @@ namespace Slime { kw_done: // 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]; 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) { was_set = true; 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) return 0; try assert_type(node, Lisp_Object_Type::Pair); - int len = 0; + u32 len = 0; while (node->type == Lisp_Object_Type::Pair) { ++len; @@ -369,9 +369,13 @@ namespace Slime { cs.data[cs.next_index-1] = pc->value.pair.first; 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); mes.append(pc); @@ -400,9 +404,9 @@ namespace Slime { try pc->value.function->body.c_macro_body(); } 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(); nas->append(NasAction::Step); } else { @@ -438,7 +442,7 @@ namespace Slime { case NasAction::Step: { if (pcs.data[pcs.next_index-1] == Memory::nil) { --pcs.next_index; - int am = ams.data[--ams.next_index]; + u32 am = ams.data[--ams.next_index]; Lisp_Object* function = cs.data[am]; try assert_type(function, Lisp_Object_Type::Function); diff --git a/src/forward_decls.cpp b/src/forward_decls.cpp index b401912..fec239c 100644 --- a/src/forward_decls.cpp +++ b/src/forward_decls.cpp @@ -4,13 +4,13 @@ namespace Slime { 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); + 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_expr(Lisp_Object*); bool is_truthy (Lisp_Object*); - int list_length(Lisp_Object*); + u32 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); @@ -46,12 +46,12 @@ namespace Slime { 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(f64); 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*); + Lisp_Object* create_lisp_object_vector(u32, 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*); @@ -65,10 +65,10 @@ namespace Slime { extern String standard_in; 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(char* text); Lisp_Object* parse_single_expression(wchar_t* text); diff --git a/src/globals.cpp b/src/globals.cpp index bf1d1ff..2884051 100644 --- a/src/globals.cpp +++ b/src/globals.cpp @@ -5,8 +5,8 @@ namespace Slime { #define STRINGIZE(s) STRINGIZE2(s) #define VERSION_STRING "v" STRINGIZE(v_major) "." STRINGIZE(v_minor) " - built on " __DATE__ " " __TIME__ 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_minor #undef STRINGIZE2 diff --git a/src/io.cpp b/src/io.cpp index 4f06874..e01ef4c 100644 --- a/src/io.cpp +++ b/src/io.cpp @@ -2,7 +2,7 @@ namespace Slime { proc string_equal(const char input[], const char check[]) -> bool { 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') return true; } @@ -32,7 +32,7 @@ namespace Slime { proc escape_string(char* in) -> char* { // TODO(Felix): add more escape sequences - int i = 0, count = 0; + u32 i = 0, count = 0; while (in[i] != '\0') { switch (in[i]) { case '\\': @@ -48,7 +48,7 @@ namespace Slime { // copy in i = 0; - int j = 0; + u32 j = 0; while (in[i] != '\0') { switch (in[i]) { case '\\': ret[j++] = '\\'; ret[j++] = '\\'; break; @@ -62,7 +62,7 @@ namespace Slime { return ret; } - proc unescape_string(char* in) -> int { + proc unescape_string(char* in) -> s32 { if (!in) return 0; char *out = in, *p = in; @@ -114,7 +114,7 @@ namespace Slime { /* Set the end of string. */ *out = '\0'; - return (int)(out - in); + return (s32)(out - in); } proc read_entire_file(char* filename) -> char* { @@ -164,9 +164,9 @@ namespace Slime { char* linep = line; size_t lenmax = 100, len = lenmax; - int c; + s32 c; - int nesting = 0; + s32 nesting = 0; while (true) { c = fgetc(stdin); @@ -204,9 +204,9 @@ namespace Slime { proc read_line() -> char* { char* line = (char*)malloc(100), * linep = line; size_t lenmax = 100, len = lenmax; - int c; + s32 c; - int nesting = 0; + s32 nesting = 0; if(line == nullptr) return nullptr; @@ -261,7 +261,7 @@ namespace Slime { char* wchar_to_char(const wchar_t* pwchar) { // get the number of characters in the string. - int currentCharIndex = 0; + s32 currentCharIndex = 0; char currentChar = (char)pwchar[currentCharIndex]; while (currentChar != '\0') @@ -270,12 +270,12 @@ namespace Slime { 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) 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) char character = (char)pwchar[i]; @@ -302,7 +302,6 @@ namespace Slime { proc string_buider_to_string(Array_List string_builder) -> char* { size_t len = 1; - int idx = 0; for (auto str : string_builder) { len += strlen(str); } @@ -331,8 +330,8 @@ namespace Slime { case (Lisp_Object_Type::Continuation): return _strdup("[continuation]"); case (Lisp_Object_Type::Pointer): return _strdup("[pointer]"); 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 asprintf(&temp, "%f", node->value.number); return temp; @@ -376,7 +375,7 @@ namespace Slime { string_builder.append(_strdup("[")); if (node->value.vector.length > 0) 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(lisp_object_to_string(node->value.vector.data+i, print_repr)); } @@ -388,11 +387,13 @@ namespace Slime { return temp; } break; 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) { // NOTE(Felix): try to find the symbol it is bound to // in global env @@ -422,7 +423,6 @@ namespace Slime { } } break; case (Lisp_Object_Type::Pair): { - // TODO Lisp_Object* head = node; defer { @@ -489,7 +489,7 @@ namespace Slime { } default: create_generic_error("A Lisp_Object of type-id %d cannot be converted to a string", - (int)(node->type)); + (u8)(node->type)); return nullptr; } } @@ -528,12 +528,10 @@ namespace Slime { using Globals::Current_Execution::nass; using Globals::Current_Execution::ams; 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); + defer_free(t); printf(" %d: %s\n ", i, t); - defer { - free(t); - }; } printf("\npcs:\n "); for (auto lo : pcs) { diff --git a/src/libslime.cpp b/src/libslime.cpp index ed1f30f..5b6c024 100644 --- a/src/libslime.cpp +++ b/src/libslime.cpp @@ -20,19 +20,18 @@ # include #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;} bool hm_objects_match(char* a, char* b); bool hm_objects_match(void* a, void* 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/types.hpp" #include "ftb/arraylist.hpp" #include "ftb/bucket_allocator.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); } -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]) { value = (10000003 * value) ^ str[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; switch (obj->type) { // hash from adress: if two objects of these types have diff --git a/src/lisp_object.cpp b/src/lisp_object.cpp index 7932bdc..9ea0353 100644 --- a/src/lisp_object.cpp +++ b/src/lisp_object.cpp @@ -1,5 +1,5 @@ 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) return nullptr; diff --git a/src/main.cpp b/src/main.cpp index e70b2dc..5647454 100644 --- a/src/main.cpp +++ b/src/main.cpp @@ -1,6 +1,6 @@ #include "libslime.cpp" -int main(int argc, char* argv[]) { +s32 main(s32 argc, char* argv[]) { #ifdef _MSC_VER // enable colored terminal output for windows HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE); @@ -12,12 +12,12 @@ int main(int argc, char* argv[]) { if (argc > 1) { if (Slime::string_equal(argv[1], "--run-tests")) { - int res = Slime::run_all_tests(); + s32 res = Slime::run_all_tests(); 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(); 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 { Slime::interprete_file(argv[1]); } diff --git a/src/memory.cpp b/src/memory.cpp index 8694b57..c872a19 100644 --- a/src/memory.cpp +++ b/src/memory.cpp @@ -64,7 +64,7 @@ namespace Slime::Memory { // TODO(Felix): When parsing symbols or keywords, compute the // hash while reading them in. 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]; 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 = { len, (char*)malloc(sizeof(char) * len + 1) @@ -84,7 +84,7 @@ namespace Slime::Memory { } 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 { @@ -247,7 +247,7 @@ namespace Slime::Memory { return node; } - proc create_lisp_object(double number) -> Lisp_Object* { + proc create_lisp_object(f64 number) -> Lisp_Object* { Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::Number; @@ -271,7 +271,7 @@ namespace Slime::Memory { return node; } - proc allocate_vector(int size) -> Lisp_Object* { + proc allocate_vector(u32 size) -> Lisp_Object* { Lisp_Object* ret = object_memory.allocate(size); if (!ret) { 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; } - 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); Lisp_Object* node; @@ -292,7 +292,7 @@ namespace Slime::Memory { Lisp_Object* head = element_list; - int i = 0; + u32 i = 0; while (head != Memory::nil) { node->value.vector.data[i] = *head->value.pair.first; head = head->value.pair.rest; @@ -412,14 +412,14 @@ namespace Slime::Memory { Lisp_Object* node; try node = create_lisp_object(); node->type = Lisp_Object_Type::Pair; - // node->value.pair = new(Pair); node->value.pair.first = first; node->value.pair.rest = rest; return node; } 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 if (n == Memory::nil || n == Memory::t) { diff --git a/src/parse.cpp b/src/parse.cpp index e1826ab..a461235 100644 --- a/src/parse.cpp +++ b/src/parse.cpp @@ -1,10 +1,10 @@ namespace Slime::Parser { String standard_in; 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 if (text[*index_in_text] != ';') return; @@ -18,8 +18,8 @@ namespace Slime::Parser { 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') { ++parser_line; 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 while (text[(*index_in_text)] == ' ' || 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(); - int position_before; + u32 position_before; do { position_before = *index_in_text; eat_comment_line(text, index_in_text); @@ -50,12 +50,12 @@ namespace Slime::Parser { } 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); 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(); if (text[*index_in_text] != l_delimiter) { create_parsing_error("a fancy cannot be parsed here"); @@ -83,8 +83,8 @@ namespace Slime::Parser { 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] != ' ' && text[*index_in_text+atom_length] != ')' && text[*index_in_text+atom_length] != '(' && @@ -102,26 +102,26 @@ namespace Slime::Parser { 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; 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); + u32 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* { + proc parse_symbol_or_keyword(char* text, u32* 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); + u32 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'; @@ -144,7 +144,7 @@ namespace Slime::Parser { 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 '"' step_char(text, index_in_text); @@ -162,7 +162,7 @@ namespace Slime::Parser { } // okay so the first letter was not actually closing the string... - int string_length = 0; + u32 string_length = 0; bool escaping = false; while (escaping || text[*index_in_text+string_length] != '"') { if (escaping) { @@ -181,7 +181,7 @@ namespace Slime::Parser { // 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; + u32 new_len; try new_len = unescape_string(text+(*index_in_text)); String string = Memory::create_string("", new_len); @@ -201,7 +201,7 @@ namespace Slime::Parser { 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(); Lisp_Object* ret; // 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(); if (text[*index_in_text] != '(') { create_parsing_error("a list cannot be parsed here"); @@ -283,7 +283,7 @@ namespace Slime::Parser { 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(); Lisp_Object* vector_sym = Memory::get_symbol("vector"); Lisp_Object* hash_map_sym = Memory::get_symbol("hash-map"); @@ -340,7 +340,7 @@ namespace Slime::Parser { 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(); Lisp_Object* ret; eat_until_code(text, index_in_text); @@ -378,7 +378,7 @@ namespace Slime::Parser { parser_line = 1; parser_col = 1; - int index_in_text = 0; + u32 index_in_text = 0; Lisp_Object* ret; try ret = parse_expression(text, &index_in_text); return ret; @@ -394,7 +394,7 @@ namespace Slime::Parser { Array_List* program = (Array_List*)malloc(sizeof(Array_List)); program->alloc(); - int index_in_text = 0; + u32 index_in_text = 0; Lisp_Object* parsed; eat_until_code(text, &index_in_text); diff --git a/src/platform.cpp b/src/platform.cpp index e251118..bf17d76 100644 --- a/src/platform.cpp +++ b/src/platform.cpp @@ -1,7 +1,7 @@ namespace Slime { inline proc get_cwd() -> char* { - const int buf_size = 2048; + const u32 buf_size = 2048; char* res = (char*)malloc(buf_size * sizeof(char)); #ifdef _MSC_VER @@ -23,9 +23,9 @@ namespace Slime { #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 - int len = _vscprintf(fmt, ap); + s32 len = _vscprintf(fmt, ap); if (len == -1) { return -1; } @@ -35,7 +35,7 @@ namespace Slime { return -1; } // _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) { free(str); return -1; @@ -44,10 +44,10 @@ namespace Slime { return r; } - int asprintf(char **strp, const char *fmt, ...) { + s32 asprintf(char **strp, const char *fmt, ...) { va_list ap; va_start(ap, fmt); - int r = vasprintf(strp, fmt, ap); + s32 r = vasprintf(strp, fmt, ap); va_end(ap); return r; } @@ -91,8 +91,8 @@ namespace Slime { else { // 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; while ((c = path[++index_in_path]) != '\0') { @@ -121,7 +121,7 @@ namespace Slime { used = readlink("/proc/self/exe", path, size); if (used == -1) { - const int saved_errno = errno; + const s32 saved_errno = errno; free(path); errno = saved_errno; return NULL; diff --git a/src/structs.cpp b/src/structs.cpp index f17da3b..cc2b886 100644 --- a/src/structs.cpp +++ b/src/structs.cpp @@ -66,14 +66,14 @@ namespace Slime { }; struct String { - int length; + u32 length; char* data; }; struct Source_Code_Location { String file; - int line; - int column; + u32 line; + u32 column; }; struct Pair { @@ -82,7 +82,7 @@ namespace Slime { }; struct Vector { - int length; + u32 length; Lisp_Object* data; }; @@ -126,12 +126,12 @@ namespace Slime { } body; }; -#pragma pack(1) +// #pragma pack(1) struct Lisp_Object { Lisp_Object_Type type; union value { String symbol; // used for symbols and keywords - double number; + f64 number; String string; Pair pair; Vector vector; @@ -141,7 +141,7 @@ namespace Slime { Hash_Map* hashMap; } value; }; -#pragma options align=reset +// #pragma options align=reset struct Error { Lisp_Object* position; // type has to be a keyword diff --git a/src/testing.cpp b/src/testing.cpp index 5bf3cd9..b626219 100644 --- a/src/testing.cpp +++ b/src/testing.cpp @@ -1,8 +1,7 @@ namespace Slime { + typedef s32 testresult; #define epsilon 2.2204460492503131E-16 - -#define testresult int #define pass 1 #define fail 0 @@ -46,15 +45,15 @@ namespace Slime { 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; \ } -#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; \ } @@ -87,7 +86,7 @@ namespace Slime { } \ else { \ result = false; \ - for(int i = -1; i < 70; ++i) \ + for(s32 i = -1; i < 70; ++i) \ fputs((i%3==1)? "." : " ", stdout); \ fputs(console_red "failed\n" console_normal, stdout); \ if(Globals::error) { \ @@ -105,7 +104,7 @@ namespace Slime { } \ else { \ result = false; \ - for(int i = -1; i < 70; ++i) \ + for(s32 i = -1; i < 70; ++i) \ fputs((i%3==1)? "." : " ", stdout); \ fputs(console_red "failed\n" console_normal, stdout); \ if(Globals::error) { \ @@ -116,7 +115,7 @@ namespace Slime { proc test_array_lists_adding_and_removing() -> testresult { // test adding and removing - Array_List list; + Array_List list; list.alloc(); defer { list.dealloc(); @@ -146,7 +145,7 @@ namespace Slime { proc test_array_lists_sorting() -> testresult { // test adding and removing - Array_List list; + Array_List list; list.alloc(); defer { list.dealloc(); @@ -184,7 +183,7 @@ namespace Slime { } proc test_array_lists_searching() -> testresult { - Array_List list; + Array_List list; list.alloc(); defer { list.dealloc(); @@ -195,7 +194,7 @@ namespace Slime { list.append(3); list.append(4); - int index = list.sorted_find(3); + s32 index = list.sorted_find(3); assert_equal_int(index, 2); index = list.sorted_find(1); @@ -208,7 +207,7 @@ namespace Slime { } proc test_parse_atom() -> testresult { - int index_in_text = 0; + u32 index_in_text = 0; char string[] = "123 -1.23e-2 " // numbers "\"asd\" " // strings @@ -219,13 +218,13 @@ namespace Slime { Lisp_Object* result = Parser::parse_atom(string, &index_in_text); 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; result = Parser::parse_atom(string, &index_in_text); 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 ++index_in_text; @@ -264,7 +263,7 @@ namespace Slime { } proc test_parse_expression() -> testresult { - int index_in_text = 0; + u32 index_in_text = 0; char string[] = "(fun + 12)"; 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->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; @@ -327,7 +326,7 @@ namespace Slime { assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Number); - assert_equal_double(result->value.number, 14); + assert_equal_f64(result->value.number, 14); return pass; } @@ -342,7 +341,7 @@ namespace Slime { assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Number); - assert_equal_double(result->value.number, 6); + assert_equal_f64(result->value.number, 6); return pass; } @@ -357,7 +356,7 @@ namespace Slime { assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Number); - assert_equal_double(result->value.number, 40); + assert_equal_f64(result->value.number, 40); return pass; } @@ -372,7 +371,7 @@ namespace Slime { assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Number); - assert_equal_double(result->value.number, 5); + assert_equal_f64(result->value.number, 5); return pass; } @@ -387,7 +386,7 @@ namespace Slime { assert_no_error(); assert_not_null(result); 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)"; expression = Parser::parse_single_expression(exp_string2); @@ -396,7 +395,7 @@ namespace Slime { assert_no_error(); assert_not_null(result); assert_equal_type(result, Lisp_Object_Type::Number); - assert_equal_double(result->value.number, 5); + assert_equal_f64(result->value.number, 5); return pass; } @@ -650,8 +649,8 @@ namespace Slime { #undef assert_no_error #undef assert_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_type #undef assert_null diff --git a/tests/fullslime/build.sh b/tests/fullslime/build.sh deleted file mode 100644 index 26763fc..0000000 --- a/tests/fullslime/build.sh +++ /dev/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/ \ diff --git a/tests/fullslime/main.cpp b/tests/fullslime/main.cpp deleted file mode 100644 index 1a55e9f..0000000 --- a/tests/fullslime/main.cpp +++ /dev/null @@ -1,6 +0,0 @@ -#include - -int main() { - int res = Slime::run_all_tests(); - return res ? 0 : 1; -} diff --git a/tests/libslime/build.sh b/tests/libslime/build.sh deleted file mode 100644 index ce05cdf..0000000 --- a/tests/libslime/build.sh +++ /dev/null @@ -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/ diff --git a/tests/libslime/main.cpp b/tests/libslime/main.cpp deleted file mode 100644 index 5daed6a..0000000 --- a/tests/libslime/main.cpp +++ /dev/null @@ -1,6 +0,0 @@ -#include - -int main() { - int res = Slime::run_all_tests(); - return res ? 0 : 1; -} diff --git a/todo.org b/todo.org index 4c5970d..56bc597 100644 --- a/todo.org +++ b/todo.org @@ -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, 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 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 (let fac ([n 10]) (if (zero? n) 1 (* n (fac (sub1 n))))) 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 BUG 1: eval dot notation #+BEGIN_SRC lisp