From 4f2793b7eff631bb0a17815405f6811249dd4ae6 Mon Sep 17 00:00:00 2001 From: Felix Brendel Date: Thu, 8 Aug 2019 14:21:30 +0200 Subject: [PATCH] implement vectors --- bin/automata.slime | 46 +- bin/interpolation.slime | 9 +- bin/math.slime | 5 +- bin/pre.slime | 41 +- bin/sets.slime | 49 +- bin/tests/automata.slime | 46 ++ manual/built-in-docs.org | 1087 ++------------------------------------ src/built_ins.cpp | 32 +- src/io.cpp | 8 + src/lisp_object.cpp | 1 + src/memory.cpp | 44 ++ src/structs.cpp | 8 + src/testing.cpp | 2 + 13 files changed, 266 insertions(+), 1112 deletions(-) create mode 100644 bin/tests/automata.slime diff --git a/bin/automata.slime b/bin/automata.slime index 07bb357..c9d55aa 100644 --- a/bin/automata.slime +++ b/bin/automata.slime @@ -1,36 +1,10 @@ -(import "sets.slime") - - -(define (make-dfa Q S delta q0 F) - (let ((q q0)) - (lambda (s) - (mutate q (delta q s)) - `(,(if (set-contains? F q) :accept :fail) ,q)))) - - -(define (delta q s) - (cond (s (case q - (("q0") (case s (("M") "q1"))) - (("q1") (case s (("A") "q0") - (("G") "q2"))) - (("q2") (case s (("E") "q0"))))) - (else q))) - - -;; (make-delta -;; ("q0" :: "M" -> "q1") -;; ("q1" :: "A" -> "q0" -;; "G" -> "q1") -;; ("q2" :: "E" -> "q0")) - -(define aut (make-dfa (make-set "q0" "q1" "q2") - (make-set "M" "A" "G" "E") - delta - "q0" - (make-set "q0"))) - -(printf (aut "M")) -(printf (aut "A")) -(printf (aut "M")) -(printf (aut "G")) -(printf (aut "E")) +(define-module automata + :exports (make-dfa) + (import "sets.slime") + + (define (make-dfa Q S delta q0 F) + (let ((q q0)) + (lambda (s) + (set! q (delta q s)) + (list (if (set::contains? F q) :accept :fail) q)))) + ) diff --git a/bin/interpolation.slime b/bin/interpolation.slime index a4f7f62..00c520a 100644 --- a/bin/interpolation.slime +++ b/bin/interpolation.slime @@ -1,5 +1,8 @@ -(define-package interpolation +(define-module interpolation + :exports (lerp lerper stepped-lerper + point-lerp point-lerper + bezier2 bezierer2) (define-typed (lerp a :number b :number t :number) (+ (* t (- b a)) a)) @@ -43,5 +46,5 @@ ) -(define sl1 (interpolation-> stepped-lerper 0 1 5)) -(define sl2 (interpolation-> stepped-lerper 10 -10 20)) +(define sl1 (interpolation::stepped-lerper 0 1 5)) +(define sl2 (interpolation::stepped-lerper 10 -10 20)) diff --git a/bin/math.slime b/bin/math.slime index e508f59..090b81d 100644 --- a/bin/math.slime +++ b/bin/math.slime @@ -1,6 +1,7 @@ -(import "oo.slime") +(define-module math + :exports (pi abs sqrt make-vector3) -(define-package math + (import "oo.slime") (define pi "Tha famous circle constant." diff --git a/bin/pre.slime b/bin/pre.slime index 70e4414..8e73699 100644 --- a/bin/pre.slime +++ b/bin/pre.slime @@ -1,3 +1,5 @@ + + (define-syntax (pe expr) `(printf ',expr "evaluates to" ,expr)) @@ -141,18 +143,33 @@ ithe sequence as arguemens." (assert-types= @lambda-list) @body))) -(define-syntax (define-package name :rest body) - `(define ,(string->symbol (concat-strings (symbol->string name) "->")) - ((lambda () - @body - (set-type - (special-lambda (:rest args) - (let ((op (first args)) - (args (rest args))) - (if (callable? (eval op)) - (apply op args) - (eval op)))) - :package))))) + +(define-syntax (define-module module-name :keys exports :rest body) + (let ((module-prefix (concat-strings (symbol->string module-name) "::"))) + (eval `(begin @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 + ,(try (eval orig-export-name) + (error "The module does not contain" orig-export-name))))) + exports)))) + + +;; (define-syntax (define-package name :rest body) +;; `(define ,(string->symbol (concat-strings (symbol->string name) "->")) +;; ((lambda () +;; @body +;; (set-type +;; (special-lambda (:rest args) +;; (let ((op (first args)) +;; (args (rest args))) +;; (if (callable? (eval op)) +;; (apply op args) +;; (eval op)))) +;; :package))))) (define (null? x) "Checks if the argument is =nil=." diff --git a/bin/sets.slime b/bin/sets.slime index 575b352..6202036 100644 --- a/bin/sets.slime +++ b/bin/sets.slime @@ -1,28 +1,33 @@ -(import "cxr.slime") +(define-module set + :exports (make find contains? insert!) -(define key-not-found-index -1) + (import "cxr.slime") -(define (make-set :rest vals) - (set-type - (if vals - (list vals) - '(())) - :set)) + (define key-not-found-index -1) -(define (set-find set val) - (let ((values (car set))) - (define (inner values current-index) - (cond ((null? values) key-not-found-index) - ((= (car values) val) current-index) - (else (inner (cdr values) (+ 1 current-index))))) - (inner values 0))) + (define (make :rest vals) + (set-type + (if vals + (list vals) + '(())) + :set)) -(define (set-contains? set val) - (unless (= (set-find set val) key-not-found-index) + (define (find set val) + (let ((values (car set))) + (define (inner values current-index) + (cond ((null? values) key-not-found-index) + ((= (car values) val) current-index) + (else (inner (cdr values) (+ 1 current-index))))) + (inner values 0))) + + (define (contains? set val) + (unless (= (find set val) key-not-found-index) t)) -(define (set-insert! set value) - (unless (set-contains? set value) - (mutate set (pair (pair value (first set)) ())) - (set-type set :set)) - set) + (define (insert! set value) + (unless (contains? set value) + (set! set (pair (pair value (first set)) ())) + (set-type set :set)) + set) + + ) diff --git a/bin/tests/automata.slime b/bin/tests/automata.slime new file mode 100644 index 0000000..377234f --- /dev/null +++ b/bin/tests/automata.slime @@ -0,0 +1,46 @@ +(import "sets.slime") +(import "automata.slime") + +;; (make-delta +;; ("q0" :: "M" -> "q1") +;; ("q1" :: "A" -> "q0" +;; "G" -> "q1") +;; ("q2" :: "E" -> "q0")) + +(define (delta q s) + (cond (s (case q + (("q0") (case s (("M") "q1"))) + (("q1") (case s (("A") "q0") + (("G") "q2"))) + (("q2") (case s (("E") "q0"))))) + (else q))) + +(define aut (automata::make-dfa (set::make "q0" "q1" "q2") + (set::make "M" "A" "G" "E") + delta + "q0" + (set::make "q0"))) + +(let ((state (aut ()))) + (assert (= (first state) :accept)) + (assert (= (first (rest state)) "q0"))) + +(let ((state (aut "M"))) + (assert (= (first state) :fail)) + (assert (= (first (rest state)) "q1"))) + +(let ((state (aut "A"))) + (assert (= (first state) :accept)) + (assert (= (first (rest state)) "q0"))) + +(let ((state (aut "M"))) + (assert (= (first state) :fail)) + (assert (= (first (rest state)) "q1"))) + +(let ((state (aut "G"))) + (assert (= (first state) :fail)) + (assert (= (first (rest state)) "q2"))) + +(let ((state (aut "E"))) + (assert (= (first state) :accept)) + (assert (= (first (rest state)) "q0"))) diff --git a/manual/built-in-docs.org b/manual/built-in-docs.org index 2bcba64..31da465 100644 --- a/manual/built-in-docs.org +++ b/manual/built-in-docs.org @@ -1,7 +1,7 @@ \hrule * === - - defined in :: =../src/./built_ins.cpp:160:0= + - defined in :: =src/./built_ins.cpp:161:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -10,7 +10,7 @@ Takes 0 or more arguments and returns =t= if all arguments are equal and =()= ot \hrule * =>= - - defined in :: =../src/./built_ins.cpp:176:0= + - defined in :: =src/./built_ins.cpp:177:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -19,7 +19,7 @@ TODO \hrule * =>== - - defined in :: =../src/./built_ins.cpp:193:0= + - defined in :: =src/./built_ins.cpp:194:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -28,7 +28,7 @@ TODO \hrule * =<= - - defined in :: =../src/./built_ins.cpp:210:0= + - defined in :: =src/./built_ins.cpp:211:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -37,7 +37,7 @@ TODO \hrule * =<== - - defined in :: =../src/./built_ins.cpp:229:0= + - defined in :: =src/./built_ins.cpp:230:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -46,7 +46,7 @@ TODO \hrule * =+= - - defined in :: =../src/./built_ins.cpp:246:0= + - defined in :: =src/./built_ins.cpp:247:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -55,7 +55,7 @@ TODO \hrule * =-= - - defined in :: =../src/./built_ins.cpp:258:0= + - defined in :: =src/./built_ins.cpp:259:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -64,7 +64,7 @@ TODO \hrule * =*= - - defined in :: =../src/./built_ins.cpp:280:0= + - defined in :: =src/./built_ins.cpp:281:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -73,7 +73,7 @@ TODO \hrule * =/= - - defined in :: =../src/./built_ins.cpp:300:0= + - defined in :: =src/./built_ins.cpp:301:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -82,7 +82,7 @@ TODO \hrule * =**= - - defined in :: =../src/./built_ins.cpp:320:0= + - defined in :: =src/./built_ins.cpp:321:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -91,7 +91,7 @@ TODO \hrule * =%= - - defined in :: =../src/./built_ins.cpp:335:0= + - defined in :: =src/./built_ins.cpp:336:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -100,7 +100,7 @@ TODO \hrule * =assert= - - defined in :: =../src/./built_ins.cpp:350:0= + - defined in :: =src/./built_ins.cpp:351:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -109,7 +109,7 @@ TODO \hrule * =define= - - defined in :: =../src/./built_ins.cpp:361:0= + - defined in :: =src/./built_ins.cpp:362:0= - type :: =:cfunction= - docu :: #+BEGIN: @@ -118,1158 +118,173 @@ TODO \hrule * =mutate= - - defined in :: =../src/./built_ins.cpp:423:0= + - defined in :: =src/./built_ins.cpp:424:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =if= - - - defined in :: =../src/./built_ins.cpp:448:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =quote= - - - defined in :: =../src/./built_ins.cpp:468:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =quasiquote= +* =set!= - - defined in :: =../src/./built_ins.cpp:473:0= + - defined in :: =src/./built_ins.cpp:449:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =and= +* =set-car!= - - defined in :: =../src/./built_ins.cpp:569:0= + - defined in :: =src/./built_ins.cpp:471:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =or= - - - defined in :: =../src/./built_ins.cpp:580:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =not= - - - defined in :: =../src/./built_ins.cpp:591:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =while= - - - defined in :: =../src/./built_ins.cpp:601:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =lambda= - - - defined in :: =../src/./built_ins.cpp:679:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =special-lambda= - - - defined in :: =../src/./built_ins.cpp:691:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =eval= +* =set-cdr!= - - defined in :: =../src/./built_ins.cpp:699:0= + - defined in :: =src/./built_ins.cpp:482:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =begin= - - - defined in :: =../src/./built_ins.cpp:711:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =list= - - - defined in :: =../src/./built_ins.cpp:727:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =pair= - - - defined in :: =../src/./built_ins.cpp:731:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =first= - - - defined in :: =../src/./built_ins.cpp:741:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =rest= - - - defined in :: =../src/./built_ins.cpp:752:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =set-type= - - - defined in :: =../src/./built_ins.cpp:763:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =delete-type= - - - defined in :: =../src/./built_ins.cpp:775:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =type= - - - defined in :: =../src/./built_ins.cpp:782:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =info= - - - defined in :: =../src/./built_ins.cpp:815:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =show= - - - defined in :: =../src/./built_ins.cpp:896:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =addr-of= - - - defined in :: =../src/./built_ins.cpp:908:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =generate-docs= - - - defined in :: =../src/./built_ins.cpp:914:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =print= - - - defined in :: =../src/./built_ins.cpp:923:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =read= - - - defined in :: =../src/./built_ins.cpp:931:0= - - type :: =:cfunction= - - docu :: - #+BEGIN: -TODO - #+END: -\hrule -* =exit= +* =if= - - defined in :: =../src/./built_ins.cpp:948:0= + - defined in :: =src/./built_ins.cpp:493:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =break= +* =quote= - - defined in :: =../src/./built_ins.cpp:959:0= + - defined in :: =src/./built_ins.cpp:513:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =memstat= +* =quasiquote= - - defined in :: =../src/./built_ins.cpp:964:0= + - defined in :: =src/./built_ins.cpp:518:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =try= +* =and= - - defined in :: =../src/./built_ins.cpp:968:0= + - defined in :: =src/./built_ins.cpp:614:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =load= +* =or= - - defined in :: =../src/./built_ins.cpp:983:0= + - defined in :: =src/./built_ins.cpp:625:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =import= +* =not= - - defined in :: =../src/./built_ins.cpp:994:0= + - defined in :: =src/./built_ins.cpp:636:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =copy= +* =while= - - defined in :: =../src/./built_ins.cpp:1005:0= + - defined in :: =src/./built_ins.cpp:646:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =error= +* =lambda= - - defined in :: =../src/./built_ins.cpp:1013:0= + - defined in :: =src/./built_ins.cpp:724:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =symbol->keyword= +* =special-lambda= - - defined in :: =../src/./built_ins.cpp:1020:0= + - defined in :: =src/./built_ins.cpp:736:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =string->symbol= +* =eval= - - defined in :: =../src/./built_ins.cpp:1029:0= + - defined in :: =src/./built_ins.cpp:744:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =symbol->string= +* =begin= - - defined in :: =../src/./built_ins.cpp:1041:0= + - defined in :: =src/./built_ins.cpp:756:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =concat-strings= +* =list= - - defined in :: =../src/./built_ins.cpp:1050:0= + - defined in :: =src/./built_ins.cpp:772:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =pe= - - - defined in :: =pre.slime:2:40= - - type :: =:macro= - - arguments :: : - - postitional :: =expr= - - docu :: none -\hrule -* =when= - - - defined in :: =pre.slime:21:41= - - type :: =:macro= - - arguments :: : - - postitional :: =condition=: - - rest :: =body= - - docu :: - #+BEGIN: -Special form for when multiple actions should be done if a -condition is true. - -{{{example_start}}} -(when (not ()) - (print "Hello ") - (print "from ") - (print "when!")) - -(when () - (print "Goodbye ") - (print "World!")) -{{{example_end}}} - - #+END: -\hrule -* =unless= - - - defined in :: =pre.slime:28:41= - - type :: =:macro= - - arguments :: : - - postitional :: =condition=: - - rest :: =body= - - docu :: - #+BEGIN: -Special form for when multiple actions should be done if a -condition is false. - #+END: -\hrule -* =n-times= - - - defined in :: =pre.slime:35:35= - - type :: =:macro= - - arguments :: : - - postitional :: =times=, =action= - - docu :: - #+BEGIN: -Executes action times times. - #+END: -\hrule -* =let= - - - defined in :: =pre.slime:52:64= - - type :: =:macro= - - arguments :: : - - postitional :: =bindings=: - - rest :: =body= - - docu :: none -\hrule -* =cond= - - - defined in :: =pre.slime:66:17= - - type :: =:macro= - - arguments :: : - - rest :: =clauses= - - docu :: none -\hrule -* =case= - - - defined in :: =pre.slime:81:17= - - type :: =:macro= - - arguments :: : - - postitional :: =var=: - - rest :: =clauses= - - docu :: none -\hrule -* =define-special= - - - defined in :: =pre.slime:84:81= - - type :: =:macro= - - arguments :: : - - postitional :: =name-and-args=: - - rest :: =body= - - docu :: none -\hrule -* =construct-list= - - - defined in :: =pre.slime:125:14= - - type :: =:macro= - - arguments :: : - - rest :: =body= - - docu :: - #+BEGIN: - -{{{example_start}}} -(construct-list - i <- '(1 2 3 4 5) - yield (* i i)) -{{{example_end}}} - -(construct-list - i <- '(1 2 3 4) - j <- '(A B) - yield (pair i j)) - -(construct-list - i <- '(1 2 3 4 5 6 7 8) - when (evenp i) - yield i) - - #+END: -\hrule -* =apply= - - - defined in :: =pre.slime:130:28= - - type :: =:macro= - - arguments :: : - - postitional :: =fun=, =seq= - - docu :: - #+BEGIN: -Applies the function to the sequence, as in calls the function with -ithe sequence as arguemens. - #+END: -\hrule -* =define-typed= - - - defined in :: =pre.slime:142:16= - - type :: =:macro= - - arguments :: : - - postitional :: =args=: - - rest :: =body= - - docu :: none -\hrule -* =define-package= - - - defined in :: =pre.slime:155:24= - - type :: =:macro= - - arguments :: : - - postitional :: =name=: - - rest :: =body= - - docu :: none -\hrule -* =null?= - - - type :: =:lambda= - - arguments :: : - - postitional :: =x= - - docu :: - #+BEGIN: -Checks if the argument is =nil=. - #+END: -\hrule -* =type=?= - - - type :: =:lambda= - - arguments :: : - - postitional :: =obj=, =typ= - - docu :: - #+BEGIN: -Checks if the argument =obj= is of type =typ= - #+END: -\hrule -* =types=?= - - - type :: =:lambda= - - arguments :: : - - rest :: =objs= - - docu :: none -\hrule -* =assert-types== - - - type :: =:lambda= - - arguments :: : - - rest :: =objs= - - docu :: none -\hrule -* =number?= - - - type :: =:lambda= - - arguments :: : - - postitional :: =x= - - docu :: - #+BEGIN: -Checks if the argument is a number. - #+END: -\hrule -* =symbol?= - - - type :: =:lambda= - - arguments :: : - - postitional :: =x= - - docu :: - #+BEGIN: -Checks if the argument is a symbol. - #+END: -\hrule -* =keyword?= - - - type :: =:lambda= - - arguments :: : - - postitional :: =x= - - docu :: - #+BEGIN: -Checks if the argument is a keyword. - #+END: -\hrule -* =pair?= - - - type :: =:lambda= - - arguments :: : - - postitional :: =x= - - docu :: - #+BEGIN: -Checks if the argument is a pair. - #+END: -\hrule -* =string?= - - - type :: =:lambda= - - arguments :: : - - postitional :: =x= - - docu :: - #+BEGIN: -Checks if the argument is a string. - #+END: -\hrule -* =lambda?= - - - type :: =:lambda= - - arguments :: : - - postitional :: =x= - - docu :: - #+BEGIN: -Checks if the argument is a function. - #+END: -\hrule -* =macro?= - - - type :: =:lambda= - - arguments :: : - - postitional :: =x= - - docu :: - #+BEGIN: -Checks if the argument is a macro. - #+END: -\hrule -* =special-lambda?= - - - type :: =:lambda= - - arguments :: : - - postitional :: =x= - - docu :: - #+BEGIN: -Checks if the argument is a special-lambda. - #+END: -\hrule -* =built-in-function?= - - - type :: =:lambda= - - arguments :: : - - postitional :: =x= - - docu :: - #+BEGIN: -Checks if the argument is a built-in function. - #+END: -\hrule -* =callable?= - - - type :: =:lambda= - - arguments :: : - - postitional :: =x= - - docu :: none -\hrule -* =end= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: - #+BEGIN: -Returns the last pair in the sqeuence. - -{{{example_start}}} -(define a (list 1 2 3 4)) -(printf (end a)) -{{{example_end}}} - - #+END: -\hrule -* =last= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: - #+BEGIN: -Returns the (first) of the last (pair) of the given sequence. - -{{{example_start}}} -(define a (list 1 2 3 4)) -(printf (last a)) -{{{example_end}}} - - #+END: -\hrule -* =extend= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq=, =elem= - - docu :: - #+BEGIN: -Extends a list with the given element, by putting it in -the (rest) of the last element of the sequence. - #+END: -\hrule -* =extend2= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq=, =elem= - - docu :: - #+BEGIN: -Extends a list with the given element, by putting it in -the (rest) of the last element of the sequence. - #+END: -\hrule -* =append= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq=, =elem= - - docu :: - #+BEGIN: -Appends an element to a sequence, by extendeing the list -with (pair elem nil). - #+END: -\hrule -* =length= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: - #+BEGIN: -Returns the length of the given sequence. - #+END: -\hrule -* =member?= - - - type :: =:lambda= - - arguments :: : - - postitional :: =elem=, =seq= - - docu :: none -\hrule -* =sublist-starting-at-index= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq=, =index= - - docu :: none -\hrule -* =list-without-index= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq=, =index= - - docu :: none -\hrule -* =increment= - - - type :: =:lambda= - - arguments :: : - - postitional :: =val= - - docu :: - #+BEGIN: -Adds one to the argument. - #+END: -\hrule -* =decrement= - - - type :: =:lambda= - - arguments :: : - - postitional :: =val= - - docu :: - #+BEGIN: -Subtracts one from the argument. - #+END: -\hrule -* =range= - - - type :: =:lambda= - - arguments :: : - - keyword :: =from= =(0)=, =to= - - docu :: - #+BEGIN: -Returns a sequence of numbers starting with the number defined by the -key =from= and ends with the number defined in =to=. - #+END: -\hrule -* =range-while= - - - type :: =:lambda= - - arguments :: : - - keyword :: =from= =(0)=, =to= - - docu :: - #+BEGIN: -Returns a sequence of numbers starting with the number defined -by the key 'from' and ends with the number defined in 'to'. - #+END: -\hrule -* =map= - - - type :: =:lambda= - - arguments :: : - - postitional :: =fun=, =seq= - - docu :: - #+BEGIN: -Takes a function and a sequence as arguments and returns a new -sequence which contains the results of using the first sequences -elemens as argument to that function. - #+END: -\hrule -* =reduce= - - - type :: =:lambda= - - arguments :: : - - postitional :: =fun=, =seq= - - docu :: - #+BEGIN: -Takes a function and a sequence as arguments and applies the -function to the argument sequence. This only works correctly if the -given function accepts a variable amount of parameters. If your -funciton is limited to two arguments, use [[=reduce-binary=]] -instead. - #+END: -\hrule -* =reduce-binary= +* =vector= - - type :: =:lambda= - - arguments :: : - - postitional :: =fun=, =seq= - - docu :: - #+BEGIN: -Takes a function and a sequence as arguments and applies the -function to the argument sequence. reduce-binary applies the arguments -*pair-wise* which means it works with binary functions as compared to -[[=reduce=]]. - #+END: -\hrule -* =filter= - - - type :: =:lambda= - - arguments :: : - - postitional :: =fun=, =seq= - - docu :: - #+BEGIN: -Takes a function and a sequence as arguments and applies the -function to every value in the sequence. If the result of that -funciton application returns a truthy value, the original value is -added to a list, which in the end is returned. - #+END: -\hrule -* =zip= - - - type :: =:lambda= - - arguments :: : - - postitional :: =l1=, =l2= - - docu :: none -\hrule -* =unzip= - - - type :: =:lambda= - - arguments :: : - - postitional :: =lists= - - docu :: none -\hrule -* =enumerate= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: none -\hrule -* =printf= - - - type :: =:lambda= - - arguments :: : - - keyword :: =sep= =(" ")=, =end= =("\n")=: - - rest :: =args= - - docu :: - #+BEGIN: -A wrapper for the built-in function [[=print=]] that accepts a -variable number of arguments and also provides keywords for specifying -the printed separators (=sep=) between the arguments and what should -be printed after the last argument (=end=). - #+END: -\hrule -* =key-not-found-index= - - - defined in :: =d:\Code\Gitlab\slime\bin\alist.slime:28:31= - - type :: =:number= - - value :: =-1= - - docu :: none -\hrule -* =make-alist= - - - type :: =:lambda= - - arguments :: none. - - docu :: none -\hrule -* =make-plist= - - - type :: =:lambda= - - arguments :: none. - - docu :: none -\hrule -* =pprint-alist= - - - type :: =:lambda= - - arguments :: : - - postitional :: =alist= - - docu :: none -\hrule -* =pprint-plist= - - - type :: =:lambda= - - arguments :: : - - postitional :: =plist= - - docu :: none -\hrule -* =alist-get= - - - type :: =:lambda= - - arguments :: : - - postitional :: =alist=, =key= - - docu :: none -\hrule -* =alist-find= - - - type :: =:lambda= - - arguments :: : - - postitional :: =alist=, =key= - - docu :: none -\hrule -* =alist-key-exists?= - - - type :: =:lambda= - - arguments :: : - - postitional :: =alist=, =key= - - docu :: none -\hrule -* =alist-remove!= - - - type :: =:lambda= - - arguments :: : - - postitional :: =alist=, =key= - - docu :: none -\hrule -* =alist-set!= - - - type :: =:lambda= - - arguments :: : - - postitional :: =alist=, =key=, =value= - - docu :: none -\hrule -* =alist-set-overwrite!= - - - type :: =:lambda= - - arguments :: : - - postitional :: =alist=, =key=, =value= - - docu :: none -\hrule -* =plist-get= - - - type :: =:lambda= - - arguments :: : - - postitional :: =plist=, =prop= - - docu :: none -\hrule -* =plist-set!= - - - type :: =:lambda= - - arguments :: : - - postitional :: =plist=, =prop=, =value= - - docu :: none -\hrule -* =plist-set-overwrite!= - - - type :: =:lambda= - - arguments :: : - - postitional :: =plist=, =prop=, =value= - - docu :: none -\hrule -* =plist-find= - - - type :: =:lambda= - - arguments :: : - - postitional :: =plist=, =prop= - - docu :: none -\hrule -* =plist-prop-exists?= - - - type :: =:lambda= - - arguments :: : - - postitional :: =plist=, =prop= - - docu :: none -\hrule -* =plist-remove!= - - - type :: =:lambda= - - arguments :: : - - postitional :: =plist=, =prop= - - docu :: none -\hrule -* =cons= - - - defined in :: =../src/./built_ins.cpp:731:0= + - defined in :: =src/./built_ins.cpp:776:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =car= +* =pair= - - defined in :: =../src/./built_ins.cpp:741:0= + - defined in :: =src/./built_ins.cpp:782:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =cdr= +* =first= - - defined in :: =../src/./built_ins.cpp:752:0= + - defined in :: =src/./built_ins.cpp:792:0= - type :: =:cfunction= - docu :: #+BEGIN: TODO #+END: \hrule -* =caar= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: none -\hrule -* =cddr= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: none -\hrule -* =cadr= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: none -\hrule -* =cdar= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: none -\hrule -* =caaar= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: none -\hrule -* =caadr= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: none -\hrule -* =cadar= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: none -\hrule -* =caddr= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: none -\hrule -* =cdaar= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: none -\hrule -* =cdadr= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: none -\hrule -* =cddar= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: none -\hrule -* =cdddr= - - - type :: =:lambda= - - arguments :: : - - postitional :: =seq= - - docu :: none -\hrule -* =define-class= - - - defined in :: =d:\Code\Gitlab\slime\bin\oo.slime:22:22= - - type :: =:macro= - - arguments :: : - - postitional :: =name-and-members=: - - rest :: =body= - - docu :: - #+BEGIN: -Macro for creating simple classes. - #+END: -\hrule -* =->= - - - defined in :: =d:\Code\Gitlab\slime\bin\oo.slime:25:24= - - type :: =:macro= - - arguments :: : - - postitional :: =obj=, =meth=: - - rest :: =args= - - docu :: none -\hrule -* =math->= - - - type :: =:package= - - arguments :: : - - rest :: =args= - - docu :: none -\hrule -* =math-> pi= - - - defined in :: =d:\Code\Gitlab\slime\bin\math.slime:5:4= - - type :: =:number= - - value :: =3.141593= - - docu :: - #+BEGIN: -Tha famous circle constant. - #+END: -\hrule -* =math-> abs= - - - defined in :: =d:\Code\Gitlab\slime\bin\math.slime:9:4= - - type :: =:lambda= - - arguments :: : - - postitional :: =x= - - docu :: - #+BEGIN: -Accepts one argument and returns the absoulte value of it - #+END: -\hrule -* =math-> sqrt= - - - defined in :: =d:\Code\Gitlab\slime\bin\math.slime:13:4= - - type :: =:lambda= - - arguments :: : - - postitional :: =x= - - docu :: - #+BEGIN: -Accepts one argument and returns the square root of it - #+END: -\hrule -* =math-> make-vector3= - - - defined in :: =pre.slime:52:63= - - type :: =:constructor= - - arguments :: : - - postitional :: =x=, =y=, =z= - - docu :: - #+BEGIN: -This is the handle to an object of the class vector3 - #+END: -\hrule -* =math-> make-vector3 define-class= - - - defined in :: =d:\Code\Gitlab\slime\bin\oo.slime:22:22= - - type :: =:macro= - - arguments :: : - - postitional :: =name-and-members=: - - rest :: =body= - - docu :: - #+BEGIN: -Macro for creating simple classes. - #+END: -\hrule -* =math-> make-vector3 ->= - - - defined in :: =d:\Code\Gitlab\slime\bin\oo.slime:25:24= - - type :: =:macro= - - arguments :: : - - postitional :: =obj=, =meth=: - - rest :: =args= - - docu :: none +* = \ No newline at end of file diff --git a/src/built_ins.cpp b/src/built_ins.cpp index b00829f..769dd7f 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -22,6 +22,7 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool { case Lisp_Object_Type::Number: return n1->value.number == n2->value.number; case Lisp_Object_Type::String: return string_equal(n1->value.string, n2->value.string); case Lisp_Object_Type::Pair: + case Lisp_Object_Type::Vector: create_not_yet_implemented_error(); return false; } @@ -456,7 +457,7 @@ proc load_built_ins_into_environment() -> void { try assert_type(target_symbol, Lisp_Object_Type::Symbol); Environment* target_env = find_binding_environment(target_symbol->value.symbol.identifier, get_current_environment()); - assert(target_env); + try assert(target_env); push_environment(target_env); defer { @@ -465,6 +466,28 @@ proc load_built_ins_into_environment() -> void { define_symbol(target_symbol, source); + return source; + }); + defun("set-car!", "TODO", __LINE__, cLambda { + try evaluated_arguments = eval_arguments(arguments, &arguments_length); + try assert_arguments_length(2, arguments_length); + Lisp_Object* target = evaluated_arguments->value.pair.first; + Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first; + + assert_type(target, Lisp_Object_Type::Pair); + + *target->value.pair.first = *source; + return source; + }); + defun("set-cdr!", "TODO", __LINE__, cLambda { + try evaluated_arguments = eval_arguments(arguments, &arguments_length); + try assert_arguments_length(2, arguments_length); + Lisp_Object* target = evaluated_arguments->value.pair.first; + Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first; + + assert_type(target, Lisp_Object_Type::Pair); + + *target->value.pair.rest = *source; return source; }); defun("if", "TODO", __LINE__, cLambda { @@ -750,6 +773,12 @@ proc load_built_ins_into_environment() -> void { try evaluated_arguments = eval_arguments(arguments, &arguments_length); return evaluated_arguments; }); + defun("vector", "TODO", __LINE__, cLambda { + try evaluated_arguments = eval_arguments(arguments, &arguments_length); + Lisp_Object* ret; + try ret = Memory::create_lisp_object_vector(arguments_length, evaluated_arguments); + return ret; + }); defun("pair", "TODO", __LINE__, cLambda { try evaluated_arguments = eval_arguments(arguments, &arguments_length); try assert_arguments_length(2, arguments_length); @@ -829,6 +858,7 @@ proc load_built_ins_into_environment() -> void { case Lisp_Object_Type::T: return Memory::get_or_create_lisp_object_keyword("t"); case Lisp_Object_Type::Number: return Memory::get_or_create_lisp_object_keyword("number"); case Lisp_Object_Type::Pair: return Memory::get_or_create_lisp_object_keyword("pair"); + case Lisp_Object_Type::Vector: return Memory::get_or_create_lisp_object_keyword("vector"); case Lisp_Object_Type::String: return Memory::get_or_create_lisp_object_keyword("string"); case Lisp_Object_Type::Symbol: return Memory::get_or_create_lisp_object_keyword("symbol"); } diff --git a/src/io.cpp b/src/io.cpp index 508de3b..8096aae 100644 --- a/src/io.cpp +++ b/src/io.cpp @@ -294,6 +294,14 @@ proc print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout) -> v else fputs(Memory::get_c_str(node->value.string), file); } break; + case (Lisp_Object_Type::Vector): { + fputs("[vector", file); + for (int i = 0; i < node->value.vector.length; ++i) { + fputs(" ", file); + print(node->value.vector.data+i); + } + fputs("]", file); + } break; case (Lisp_Object_Type::Function): { if (node->userType) { fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol.identifier)); diff --git a/src/lisp_object.cpp b/src/lisp_object.cpp index 7c4f842..56f7067 100644 --- a/src/lisp_object.cpp +++ b/src/lisp_object.cpp @@ -21,6 +21,7 @@ proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char* { case(Lisp_Object_Type::CFunction): return "C-function"; case(Lisp_Object_Type::Continuation): return "continuation"; case(Lisp_Object_Type::Pair): return "pair"; + case(Lisp_Object_Type::Vector): return "vector"; } return "unknown"; } diff --git a/src/memory.cpp b/src/memory.cpp index 9a5083c..a1661e1 100644 --- a/src/memory.cpp +++ b/src/memory.cpp @@ -226,6 +226,50 @@ namespace Memory { return node; } + proc allocate_vector(int size) -> Lisp_Object* { + /* + int object_memory_size; + Int_Array_List* free_spots_in_object_memory; + Lisp_Object* object_memory; + int next_index_in_object_memory = 0; + + */ + + if (object_memory_size - next_index_in_object_memory < size) { + create_out_of_memory_error( + "There is not enough space in the lisp object " + "memory to allocate additional lisp objects. " + "Maybe try increasing the Memory size when " + "calling Memory::init()"); + return nullptr; + } + int start = next_index_in_object_memory; + next_index_in_object_memory += size; + return object_memory+start; + } + + proc create_lisp_object_vector(int length, Lisp_Object* element_list) -> Lisp_Object* { + try assert_type(element_list, Lisp_Object_Type::Pair); + + Lisp_Object* node; + try node = create_lisp_object(); + set_type(node, Lisp_Object_Type::Vector); + + node->value.vector.length = length; + try node->value.vector.data = allocate_vector(length); + + Lisp_Object* head = element_list; + + int i = 0; + while (head != Memory::nil) { + node->value.vector.data[i] = *head->value.pair.first; + head = head->value.pair.rest; + ++i; + } + + return node; + } + proc get_or_create_lisp_object_symbol(String* identifier) -> Lisp_Object* { // TODO(Felix): if we already have it stored somewhere then // reuse it and dont create new one diff --git a/src/structs.cpp b/src/structs.cpp index 1dc9528..ba2576d 100644 --- a/src/structs.cpp +++ b/src/structs.cpp @@ -16,6 +16,7 @@ enum struct Lisp_Object_Type { Number, String, Pair, + Vector, Continuation, // Pointer, // OwningPointer, @@ -76,6 +77,11 @@ struct Pair { Lisp_Object* rest; }; +struct Vector { + int length; + Lisp_Object* data; +}; + struct Positional_Arguments { Lisp_Object** symbols; // Array of Pointers to Lisp_Object int next_index; @@ -87,6 +93,7 @@ struct Keyword_Arguments { // NOTE(Felix): values[i] will be nullptr if no defalut value was // declared for key identifiers[i] Lisp_Object_Array_List* values; + // TODO(Felix): Why do we use a Array list here?? int next_index; int length; }; @@ -116,6 +123,7 @@ struct Lisp_Object { double number; String* string; Pair pair; + Vector vector; Function function; cFunction* cFunction; Continuation continuation; diff --git a/src/testing.cpp b/src/testing.cpp index 44be238..b11ed0e 100644 --- a/src/testing.cpp +++ b/src/testing.cpp @@ -639,6 +639,8 @@ proc run_all_tests() -> bool { invoke_test_script("import_and_load"); invoke_test_script("sicp"); invoke_test_script("macro_expand"); + invoke_test_script("automata"); + return result; }