diff --git a/.gitignore b/.gitignore index 0f6424c..33bcd97 100644 --- a/.gitignore +++ b/.gitignore @@ -17,3 +17,4 @@ todo.html /manual/manual.pdf /manual/manual.tex *.out +/bin/slime diff --git a/bin/alist.slime b/bin/alist.slime index b5e67e2..d843cd6 100644 --- a/bin/alist.slime +++ b/bin/alist.slime @@ -113,9 +113,10 @@ (define (alist-set! alist key value) - (mutate alist (pair (pair (pair key value) - (car alist)) - ()))) + (mutate alist (set-type (pair (pair (pair key value) + (car alist)) + ()) + :alist))) (define (alist-set-overwrite! alist key value) @@ -141,7 +142,8 @@ (plist-get-intern props prop))) (define (plist-set! plist prop value) - (mutate plist (pair (pair prop (pair value (first plist))) ()))) + (mutate plist (set-type (pair (pair prop (pair value (first plist))) ()) + :plist))) (define (plist-set-overwrite! plist prop value) (let ((props (first plist))) diff --git a/bin/pre.slime b/bin/pre.slime index 0e700f4..d08d1d0 100644 --- a/bin/pre.slime +++ b/bin/pre.slime @@ -141,9 +141,6 @@ ithe sequence as arguemens." (assert-types= @lambda-list) @body))) -(define-typed (ttt a :number b :alist) - (printf a b)) - (define-syntax (define-package name :rest body) `(define ,(string->symbol (concat-strings (symbol->string name) "->")) ((lambda () @@ -157,7 +154,6 @@ ithe sequence as arguemens." (eval op)))) :package))))) - (define (null? x) "Checks if the argument is =nil=." (= x ())) @@ -167,19 +163,25 @@ ithe sequence as arguemens." (= (type obj) typ)) (define (types=? :rest objs) - ;; TODO make inner rec functoin to avoid evalutating every time - (if objs - (begin - (assert (keyword? (first (rest objs)))) - (if (type=? (first objs) (first (rest objs))) - (apply types=? (rest (rest 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= :rest objs) - (break) - (unless (apply types=? objs) - (error "assert-types=: types do not match"))) + (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" actual-type desired-type))))) + (inner objs)) (define (number? x) "Checks if the argument is a number." diff --git a/bin/pre.slime.expanded b/bin/pre.slime.expanded index 94d279d..d365a54 100644 --- a/bin/pre.slime.expanded +++ b/bin/pre.slime.expanded @@ -1,12 +1,10 @@ -(define-typed (ttt a :number b :alist) (printf a b)) - (define (null? x) "Checks if the argument is =nil=." (= x ())) (define (type=? obj typ) "Checks if the argument =obj= is of type =typ=" (= (type obj) typ)) -(define (types=? :rest objs) (if objs (begin (assert (keyword? (first (rest objs)))) (if (type=? (first objs) (first (rest objs))) (apply types=? (rest (rest objs))) ())) t)) +(define (types=? :rest 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= :rest objs) (break) (unless (apply types=? objs) (error "assert-types=: types do not match"))) +(define (assert-types= :rest 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" actual-type desired-type))))) (inner objs)) (define (number? x) "Checks if the argument is a number." (type=? x :number)) diff --git a/bin/test.slime b/bin/test.slime new file mode 100644 index 0000000..77c6464 --- /dev/null +++ b/bin/test.slime @@ -0,0 +1,16 @@ +(import "alist.slime") + +(define-typed (tf n :number a :alist) + (printf n) + (pprint-alist a)) + + +(define a (make-alist)) +(alist-set! a 'a 1) +(alist-set! a 'b 2) +(tf 1 a) + +(define (test a b) + (printf a b)) + +(test :ij :yes) diff --git a/build.sh b/build.sh index 753803f..692fb00 100755 --- a/build.sh +++ b/build.sh @@ -3,7 +3,7 @@ SCRIPTPATH="$( cd "$(dirname "$0")" ; pwd -P )" pushd $SCRIPTPATH > /dev/null # _DEBUG -time clang++ src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1 +time g++ -fpermissive src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1 echo "" pushd ./bin > /dev/null diff --git a/manual/built-in-docs.org b/manual/built-in-docs.org index ac617b8..e94d92e 100644 --- a/manual/built-in-docs.org +++ b/manual/built-in-docs.org @@ -591,20 +591,13 @@ ithe sequence as arguemens. \hrule * =define-package= - - defined in :: =pre.slime:158:24= + - defined in :: =pre.slime:155:24= - type :: =:macro= - arguments :: : - postitional :: =name=: - rest :: =body= - docu :: none \hrule -* =ttt= - - - type :: =:lambda= - - arguments :: : - - postitional :: =a=, =b= - - docu :: none -\hrule * =null?= - type :: =:lambda= diff --git a/src/visualization.cpp b/src/visualization.cpp index e1a036a..ee893d9 100644 --- a/src/visualization.cpp +++ b/src/visualization.cpp @@ -199,7 +199,7 @@ proc visualize_lisp_machine() -> void { case Lisp_Object_Type::Function: return draw_text("Function", "#aa1100"); case Lisp_Object_Type::CFunction: return draw_text("CFunction", "#11aa00"); default: - fprintf(stderr, "Do not know hot to visualize type %d\n", Memory::get_type(obj)); + fprintf(stderr, "Do not know hot to visualize type %d\n", (int)Memory::get_type(obj)); return {0}; } };