From 27b865c0df4655ebb4f9d696b1ae75ca7353ea77 Mon Sep 17 00:00:00 2001 From: water111 <48171810+water111@users.noreply.github.com> Date: Sat, 19 Sep 2020 16:50:42 -0400 Subject: [PATCH] Add methods and pointers (#53) * method calls and sorting * add more tests and fix some alias stuff --- common/type_system/TypeSystem.cpp | 22 +- common/type_system/TypeSystem.h | 3 + game/kernel/kscheme.cpp | 2 +- goal_src/goal-lib.gc | 50 +++- goal_src/kernel/gcommon.gc | 270 +++++++++++++++++++ goal_src/test/test-append.gc | 4 + goal_src/test/test-assoc-1.gc | 3 + goal_src/test/test-assoc-2.gc | 3 + goal_src/test/test-assoce-1.gc | 3 + goal_src/test/test-assoce-2.gc | 3 + goal_src/test/test-delete-car.gc | 10 + goal_src/test/test-delete-list.gc | 3 + goal_src/test/test-insert-cons.gc | 7 + goal_src/test/test-last.gc | 4 + goal_src/test/test-member-1.gc | 3 + goal_src/test/test-member-2.gc | 3 + goal_src/test/test-memcpy.gc | 11 + goal_src/test/test-methods.gc | 4 + goal_src/test/test-new-inline-array-class.gc | 14 + goal_src/test/test-pair-asize.gc | 3 + goal_src/test/test-pair-length.gc | 3 + goal_src/test/test-pointers-1.gc | 9 + goal_src/test/test-sort-2.gc | 14 + goal_src/test/test-sort-3.gc | 12 + goal_src/test/test-sort.gc | 14 + goalc/compiler/Compiler.h | 6 +- goalc/compiler/Env.cpp | 10 +- goalc/compiler/Env.h | 4 +- goalc/compiler/Util.cpp | 4 + goalc/compiler/Val.cpp | 33 +-- goalc/compiler/Val.h | 2 +- goalc/compiler/compilation/Atoms.cpp | 3 +- goalc/compiler/compilation/Block.cpp | 2 +- goalc/compiler/compilation/ControlFlow.cpp | 2 +- goalc/compiler/compilation/Define.cpp | 4 + goalc/compiler/compilation/Function.cpp | 35 ++- goalc/compiler/compilation/Type.cpp | 70 ++++- test/test_compiler_and_runtime.cpp | 23 ++ 38 files changed, 628 insertions(+), 47 deletions(-) create mode 100644 goal_src/test/test-append.gc create mode 100644 goal_src/test/test-assoc-1.gc create mode 100644 goal_src/test/test-assoc-2.gc create mode 100644 goal_src/test/test-assoce-1.gc create mode 100644 goal_src/test/test-assoce-2.gc create mode 100644 goal_src/test/test-delete-car.gc create mode 100644 goal_src/test/test-delete-list.gc create mode 100644 goal_src/test/test-insert-cons.gc create mode 100644 goal_src/test/test-last.gc create mode 100644 goal_src/test/test-member-1.gc create mode 100644 goal_src/test/test-member-2.gc create mode 100644 goal_src/test/test-memcpy.gc create mode 100644 goal_src/test/test-methods.gc create mode 100644 goal_src/test/test-new-inline-array-class.gc create mode 100644 goal_src/test/test-pair-asize.gc create mode 100644 goal_src/test/test-pair-length.gc create mode 100644 goal_src/test/test-pointers-1.gc create mode 100644 goal_src/test/test-sort-2.gc create mode 100644 goal_src/test/test-sort-3.gc create mode 100644 goal_src/test/test-sort.gc diff --git a/common/type_system/TypeSystem.cpp b/common/type_system/TypeSystem.cpp index 03c5876ad..fd1675ca3 100644 --- a/common/type_system/TypeSystem.cpp +++ b/common/type_system/TypeSystem.cpp @@ -155,6 +155,10 @@ TypeSpec TypeSystem::make_typespec(const std::string& name) const { } } +bool TypeSystem::fully_defined_type_exists(const std::string& name) const { + return m_types.find(name) != m_types.end(); +} + /*! * Create a typespec for a function. If the function doesn't return anything, use "none" as the * return type. @@ -568,7 +572,7 @@ void TypeSystem::add_builtin_types() { add_method(obj_type, "print", make_function_typespec({"_type_"}, "_type_")); add_method(obj_type, "inspect", make_function_typespec({"_type_"}, "_type_")); add_method(obj_type, "length", - make_function_typespec({"_type_"}, "int32")); // todo - this integer type? + make_function_typespec({"_type_"}, "int")); // todo - this integer type? add_method(obj_type, "asize-of", make_function_typespec({"_type_"}, "int")); add_method(obj_type, "copy", make_function_typespec({"_type_", "symbol"}, "_type_")); add_method(obj_type, "relocate", make_function_typespec({"_type_", "int32"}, "_type_")); @@ -972,4 +976,20 @@ TypeSpec TypeSystem::lowest_common_ancestor(const std::vector& types) result = lowest_common_ancestor(result, types.at(i)); } return result; +} + +TypeSpec coerce_to_reg_type(const TypeSpec& in) { + if (in.arg_count() == 0) { + if (in.base_type() == "int8" || in.base_type() == "int16" || in.base_type() == "int32" || + in.base_type() == "int16") { + return TypeSpec("int"); + } + + if (in.base_type() == "uint8" || in.base_type() == "uint16" || in.base_type() == "uint32" || + in.base_type() == "uint16") { + return TypeSpec("uint"); + } + } + + return in; } \ No newline at end of file diff --git a/common/type_system/TypeSystem.h b/common/type_system/TypeSystem.h index 0e156de78..2f154a540 100644 --- a/common/type_system/TypeSystem.h +++ b/common/type_system/TypeSystem.h @@ -39,6 +39,7 @@ class TypeSystem { DerefInfo get_deref_info(const TypeSpec& ts); + bool fully_defined_type_exists(const std::string& name) const; TypeSpec make_typespec(const std::string& name) const; TypeSpec make_function_typespec(const std::vector& arg_types, const std::string& return_type); @@ -122,4 +123,6 @@ class TypeSystem { bool m_allow_redefinition = false; }; +TypeSpec coerce_to_reg_type(const TypeSpec& in); + #endif // JAK_TYPESYSTEM_H diff --git a/game/kernel/kscheme.cpp b/game/kernel/kscheme.cpp index 41bcc4aa5..09cc2ea00 100644 --- a/game/kernel/kscheme.cpp +++ b/game/kernel/kscheme.cpp @@ -1093,7 +1093,7 @@ u64 sprint(u32 obj) { */ u64 print_object(u32 obj) { if ((obj & OFFSET_MASK) == BINTEGER_OFFSET) { - return print_binteger(obj); + return print_binteger(s64(s32(obj))); } else { if ((obj < SymbolTable2.offset || 0x7ffffff < obj) && // not in normal memory (obj < 0x84000 || 0x100000 <= obj)) { // not in kernel memory diff --git a/goal_src/goal-lib.gc b/goal_src/goal-lib.gc index 7156be2f9..ed89c1c71 100644 --- a/goal_src/goal-lib.gc +++ b/goal_src/goal-lib.gc @@ -195,6 +195,18 @@ ) ) +(defmacro when (condition &rest body) + `(if ,condition + (begin ,@body) + ) + ) + +(defmacro unless (condition &rest body) + `(if (not ,condition) + (begin ,@body) + ) + ) + ;; TODO - these work but aren't very efficient. (defmacro and (&rest args) @@ -278,6 +290,22 @@ `(logand #xfffffff0 (+ (the-as integer ,value) 15)) ) +(defmacro &+ (v1 &rest args) + (if (null? args) + `(the pointer ,v1) + `(&+ (+ (the-as int ,v1) (the-as int ,(first args))) ,@(cdr args)) + ) + ) + +(defmacro &- (v1 v2) + `(the pointer (- (the-as int ,v1) (the-as int ,v2))) + ) + +(defmacro &+! (v1 v2) + `(set! ,v1 (&+ ,v1 ,v2)) + ) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TYPE STUFF ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -317,4 +345,24 @@ (quote '()) `(cons ,(car args) (list ,@(cdr args))) ) - ) \ No newline at end of file + ) + +(defmacro null? (arg) + ;; todo, make this better + `(eq? ,arg '()) + ) +(defmacro caar (arg) + `(car (car ,arg)) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; METHOD STUFF +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(defmacro object-new (&rest sz) + (if (null? sz) + `(the ,(current-method-type) ((-> object method-table 0) allocation type-to-make (-> type-to-make asize))) + `(the ,(current-method-type) ((-> object method-table 0) allocation type-to-make ,@sz)) + ) + ) diff --git a/goal_src/kernel/gcommon.gc b/goal_src/kernel/gcommon.gc index 45dd09409..b1dbdc9cb 100644 --- a/goal_src/kernel/gcommon.gc +++ b/goal_src/kernel/gcommon.gc @@ -357,4 +357,274 @@ (dotimes (i idx (car obj)) (set! obj (cdr obj)) ) + ) + +(defmethod length pair ((obj pair)) + "Get the number of elements in a proper list" + (if (eq? obj '()) + (return-from #f 0) + ) + + (let ((lst (cdr obj)) + (len 1)) + (while (and (not (eq? lst '())) + (pair? lst) + ) + (+1! len) + (set! lst (cdr lst)) + ) + len) + ) + + + +(defmethod asize-of pair ((obj pair)) + "Get the asize of a pair" + (the-as int (-> pair size)) + ) + +(defun last ((obj object)) + "Get the last pair in a list." + (while (not (eq? (cdr obj) '())) + (set! obj (cdr obj)) + ) + obj + ) + +(defun member ((obj object) (lst object)) + "if obj is a member of the list, return the pair containing obj as its car. + if not, return #f." + (while (and (not (eq? lst '())) + (not (eq? (car lst) obj))) + (set! lst (cdr lst)) + ) + + (if (eq? lst '()) + #f + lst + ) + ) + +(define-extern name= (function basic basic symbol)) + +(defun nmember ((obj basic) (lst object)) + "If obj is a member of the list, return the pair containing obj as its car. + If not, return #f. Use name= (see gstring.gc) to check equality." + (while (and (not (eq? lst '())) + (not (name= (the basic (car lst)) obj)) + ) + (set! lst (cdr lst)) + ) + + (if (eq? lst '()) + #f + lst + ) + ) + +(defun assoc ((item object) (alst object)) + "Get a pair with car of item from the association list (list of pairs) alst." + (while (and (not (null? alst)) + (not (eq? (caar alst) item))) + (set! alst (cdr alst)) + ) + (if (not (null? alst)) + (car alst) + #f + ) + ) + +(defun assoce ((item object) (alst object)) + "Like assoc, but a pair with car of 'else will match anything" + (while (and (not (null? alst)) + (not (eq? (caar alst) item)) + (not (eq? (caar alst) 'else)) + ) + (set! alst (cdr alst)) + ) + (if (not (null? alst)) + (car alst) + #f + ) + ) + +;; todo +;; nassoc +;; nassce + +(defun append! ((front object) (back object)) + "Append back to front." + (if (null? front) + (return-from #f back) + ) + + (let ((lst front)) + ;; seek to the end of front + (while (not (null? (cdr lst))) + (set! lst (cdr lst)) + ) + + ;; this check seems not needed + (if (not (null? lst)) + (set! (cdr lst) back) + ) + + front + ) + ) + +(defun delete! ((item object) (lst object)) + "Delete the first occurance of item from a list and return the list. + Does nothing if the item isn't in the list." + (if (eq? (car lst) item) + (return-from #f (cdr lst)) + ) + + (let ((iter (cdr lst)) + (rep lst)) + + (while (and (not (null? iter)) + (not (eq? (car iter) item))) + (set! rep iter) + (set! iter (cdr iter)) + ) + + (if (not (null? iter)) + (set! (cdr rep) (cdr iter)) + ) + ) + (the pair lst) + ) + +(defun delete-car! ((item object) (lst object)) + "Like delete, but will delete if (car item-from-list) is equal to item. Useful for deleting from association list by key." + ;(format #t "call to delete car: ~A ~A~%" item lst) + (if (eq? (caar lst) item) + (return-from #f (cdr lst)) + ) + + (let ((rep lst) + (iter (cdr lst))) + (while (and (not (null? iter)) + (not (eq? (caar iter) item))) + (set! rep iter) + (set! iter (cdr iter)) + ) + + (if (not (null? iter)) + (set! (cdr rep) (cdr iter)) + ) + ) + lst + ) + +(defun insert-cons! ((kv object) (alst object)) + "Insert key-value pair into an association list. Also removes the old one if it was there." + (cons kv (delete-car! (car kv) alst)) + ) + +(defun sort ((lst object) (compare function)) + "Sort the given list in place. Uses the given comparison function. The comparison function can + either return #t/#f or an integer, in which case the sign of the integer determines lt/gt." + ;; in each iteration, we count how many changes we make. Once we make no changes, the list is sorted. + (let ((changes -1)) + + (while (not (zero? changes)) ;; outer loop + (set! changes 0) ;; reset changes for this iteration + (let ((iter lst)) ;; iterate through list + (while (and (not (null? (cdr iter))) + (pair? (cdr iter))) + ;; L221 + (let* ((val1 (car iter)) ;; value at iterator + (val2 (car (cdr iter))) ;; value after iterator + (c-result (compare val1 val2))) ;; run comparison function + ;; check if val1 and val2 are in order. The compare function may either return #t + ;; or it may return val1 - val2. There is an issue if val1 - val2 happens to equal #t or #f. + (unless (or + (and c-result (<= (the integer c-result) 0)) ;; not #f, and negative, we're sorted! + (eq? c-result #t) ;; explictly return #t, we're sorted! + ) + ;; these two aren't sorted! so we swap them and increment changes. + (+1! changes) + (set! (car iter) val2) + (set! (car (cdr iter)) val1) + ) + ;; move on to the next thing in the list. + (set! iter (cdr iter)) + ) + ) + ) + ) + ) + lst + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; inline array +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; a parent class for boxed "inline arrays" classes, +;; An inline-array is an array with a bunch of objects back-to-back, as opposed to a bunch of +;; references back to back. +;; Most inline-arrays are unboxed and are just data - this is a somewhat rarely used container parent +;; class for a class that wraps an unboxed inline-array. +;; the "heap-base" field of the type is used to store the indexing scale. + +(deftype inline-array-class (basic) + ((length int32 :offset-assert 4) + (allocated-length int32 :offset-assert 8) + (data uint8 :dynamic) + ;; ?? + ) + ) + +(defmethod new inline-array-class ((allocation symbol) (type-to-make type) (cnt integer)) + "Create a new inline-array. Sets the length, allocated-length to cnt. Uses the mysterious heap-base field + of the type-to-make to determine the element size" + (let* ((sz (+ (-> type-to-make size) (* (-> type-to-make heap-base) cnt))) + (new-object (object-new sz))) + ;;(format 0 "create sz ~d at #x~X~%" sz new-object) + (unless (zero? new-object) + (set! (-> new-object length) cnt) + (set! (-> new-object allocated-length) cnt) + ) + new-object + ) + ) + +(defmethod length inline-array-class ((obj inline-array-class)) + ;"Get the length of an inline-array" + (-> obj length) + ) + +(defmethod asize-of inline-array-class ((obj inline-array-class)) + ;"Get the size in memory of an inline-array-class" + (+ (the-as int (-> obj type size)) + (* (-> obj allocated-length) (-> obj type heap-base)) + ) + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; array (todo) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; memcpy and similar +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun mem-copy! ((dst pointer) (src pointer) (size integer)) + "Copy memory from src to dst. Size is in bytes. This is not an efficient implementation, + however, there are _no restrictions_ on size, alignment etc. Increasing address copy." + (let ((i 0) + (d (the pointer dst)) + (s (the pointer src)) + ) + + (while (< i size) + (set! (-> (the (pointer uint8) d) 0) (-> (the (pointer uint8) s) 0)) + (&+! d 1) + (&+! s 1) + (+1! i) + ) + ) + dst ) \ No newline at end of file diff --git a/goal_src/test/test-append.gc b/goal_src/test/test-append.gc new file mode 100644 index 000000000..01fa784f2 --- /dev/null +++ b/goal_src/test/test-append.gc @@ -0,0 +1,4 @@ +(format #t "~A~%" + (append! (list 'a 'b) (list 'c 'd 'e))) + + 0 \ No newline at end of file diff --git a/goal_src/test/test-assoc-1.gc b/goal_src/test/test-assoc-1.gc new file mode 100644 index 000000000..a0ae271b3 --- /dev/null +++ b/goal_src/test/test-assoc-1.gc @@ -0,0 +1,3 @@ +(format #t "~A~%" + (cdr (assoc 'e (list (cons 'a 'b) (cons 'e 'w) (cons 'x 'x))))) + 0 \ No newline at end of file diff --git a/goal_src/test/test-assoc-2.gc b/goal_src/test/test-assoc-2.gc new file mode 100644 index 000000000..831ceb4d6 --- /dev/null +++ b/goal_src/test/test-assoc-2.gc @@ -0,0 +1,3 @@ +(format #t "~A~%" + (assoc 'r (list (cons 'a 'b) (cons 'e 'w) (cons 'x 'x)))) + 0 \ No newline at end of file diff --git a/goal_src/test/test-assoce-1.gc b/goal_src/test/test-assoce-1.gc new file mode 100644 index 000000000..f47671ed5 --- /dev/null +++ b/goal_src/test/test-assoce-1.gc @@ -0,0 +1,3 @@ +(format #t "~A~%" + (cdr (assoce 'r (list (cons 'a 'b) (cons 'e 'w) (cons 'else 'x))))) + 0 \ No newline at end of file diff --git a/goal_src/test/test-assoce-2.gc b/goal_src/test/test-assoce-2.gc new file mode 100644 index 000000000..7697008bc --- /dev/null +++ b/goal_src/test/test-assoce-2.gc @@ -0,0 +1,3 @@ +(format #t "~A~%" + (cdr (assoce 'r (list (cons 'a 'b) (cons 'r 'x) (cons 'else 'w))))) + 0 \ No newline at end of file diff --git a/goal_src/test/test-delete-car.gc b/goal_src/test/test-delete-car.gc new file mode 100644 index 000000000..450c453b4 --- /dev/null +++ b/goal_src/test/test-delete-car.gc @@ -0,0 +1,10 @@ +(let ((my-list (list (cons 'a 'b) + (cons 'c 'd) + (cons 'e 'f) + ) + )) + (delete-car! 'c my-list) + (format #t "~A~%" my-list) + (format #t "~A~%" (assoc 'c my-list)) + ) +0 \ No newline at end of file diff --git a/goal_src/test/test-delete-list.gc b/goal_src/test/test-delete-list.gc new file mode 100644 index 000000000..75d49e2d5 --- /dev/null +++ b/goal_src/test/test-delete-list.gc @@ -0,0 +1,3 @@ +(format #t "~A~%" + (delete! 'c (list 'a 'b 'c 'd 'e))) + 0 \ No newline at end of file diff --git a/goal_src/test/test-insert-cons.gc b/goal_src/test/test-insert-cons.gc new file mode 100644 index 000000000..f7ce9e828 --- /dev/null +++ b/goal_src/test/test-insert-cons.gc @@ -0,0 +1,7 @@ +(let ((alist (list (cons 'a 'b) + (cons 'c 'd) + (cons 'e 'f)))) + (set! alist (insert-cons! (cons 'c 'w) alist)) + (format #t "~A~%" alist) + ) + 0 \ No newline at end of file diff --git a/goal_src/test/test-last.gc b/goal_src/test/test-last.gc new file mode 100644 index 000000000..8e7ab40e2 --- /dev/null +++ b/goal_src/test/test-last.gc @@ -0,0 +1,4 @@ +(format #t "~A~%" + (car (last (list 'a 'b 'c 'd))) + ) + 0 \ No newline at end of file diff --git a/goal_src/test/test-member-1.gc b/goal_src/test/test-member-1.gc new file mode 100644 index 000000000..51746fd55 --- /dev/null +++ b/goal_src/test/test-member-1.gc @@ -0,0 +1,3 @@ +(format #t "~A~%" + (member 'c (list 'a 'b 'c 'd))) + 0 \ No newline at end of file diff --git a/goal_src/test/test-member-2.gc b/goal_src/test/test-member-2.gc new file mode 100644 index 000000000..03447777d --- /dev/null +++ b/goal_src/test/test-member-2.gc @@ -0,0 +1,3 @@ +(format #t "~A~%" + (member 1234 (list 'a 'b 'c 'd)) + ) \ No newline at end of file diff --git a/goal_src/test/test-memcpy.gc b/goal_src/test/test-memcpy.gc new file mode 100644 index 000000000..b4b94e343 --- /dev/null +++ b/goal_src/test/test-memcpy.gc @@ -0,0 +1,11 @@ +(let* ((base-addr #x6000000) + (offset #x123) + (ptr-int32 (the (pointer int32) base-addr)) + (ptr-int16 (the (pointer int16) #x6000123)) + ) + (set! (-> ptr-int32 1) #x00070006) + (mem-copy! ptr-int16 ptr-int32 8) + (+ (-> ptr-int16 2) + (-> ptr-int16 3) + ) + ) diff --git a/goal_src/test/test-methods.gc b/goal_src/test/test-methods.gc new file mode 100644 index 000000000..c6934c3bb --- /dev/null +++ b/goal_src/test/test-methods.gc @@ -0,0 +1,4 @@ +(format #t "~A~A~%" (eq? (-> process method-table 2) (method process print)) + (eq? (-> string method-table 3) (method "test" inspect)) + ) +0 \ No newline at end of file diff --git a/goal_src/test/test-new-inline-array-class.gc b/goal_src/test/test-new-inline-array-class.gc new file mode 100644 index 000000000..e3b953ad5 --- /dev/null +++ b/goal_src/test/test-new-inline-array-class.gc @@ -0,0 +1,14 @@ +(deftype my-inline-array-type (inline-array-class) + () + ) + +(set! (-> my-inline-array-type heap-base) 12) + +(let ((my-inline-array-obj + (the my-inline-array-type + (new + 'debug + 'my-inline-array-type + 234)))) + (asize-of my-inline-array-obj) + ) \ No newline at end of file diff --git a/goal_src/test/test-pair-asize.gc b/goal_src/test/test-pair-asize.gc new file mode 100644 index 000000000..9966daeab --- /dev/null +++ b/goal_src/test/test-pair-asize.gc @@ -0,0 +1,3 @@ +(let ((lst (list 5 4))) + (asize-of (the pair lst)) + ) \ No newline at end of file diff --git a/goal_src/test/test-pair-length.gc b/goal_src/test/test-pair-length.gc new file mode 100644 index 000000000..b79080644 --- /dev/null +++ b/goal_src/test/test-pair-length.gc @@ -0,0 +1,3 @@ +(let ((lst (list 5 4 3 2 1 0))) + (length (the pair lst)) + ) \ No newline at end of file diff --git a/goal_src/test/test-pointers-1.gc b/goal_src/test/test-pointers-1.gc new file mode 100644 index 000000000..c3481c135 --- /dev/null +++ b/goal_src/test/test-pointers-1.gc @@ -0,0 +1,9 @@ +(let* ((base-addr #x6000000) + (ptr-int32 (the (pointer int32) base-addr)) + (ptr-int16 (the (pointer int16) base-addr)) + ) + (set! (-> ptr-int32 1) #x00070006) + (+ (-> ptr-int16 2) + (-> ptr-int16 3) + ) + ) \ No newline at end of file diff --git a/goal_src/test/test-sort-2.gc b/goal_src/test/test-sort-2.gc new file mode 100644 index 000000000..abe02e3c5 --- /dev/null +++ b/goal_src/test/test-sort-2.gc @@ -0,0 +1,14 @@ +(defmacro blist (&rest args) + (if (null? args) + (quote '()) + `(cons (ash ,(car args) 3) (blist ,@(cdr args))) + ) + ) + +(let ((my-list + (blist 24 16 32 56 72 1234 -34 25 654) + )) + (format #t "~A~%" my-list) + (sort my-list -) + (format #t "~A~%" my-list) + ) \ No newline at end of file diff --git a/goal_src/test/test-sort-3.gc b/goal_src/test/test-sort-3.gc new file mode 100644 index 000000000..a95c61ad2 --- /dev/null +++ b/goal_src/test/test-sort-3.gc @@ -0,0 +1,12 @@ +(defmacro blist (&rest args) + (if (null? args) + (quote '()) + `(cons (ash ,(car args) 3) (blist ,@(cdr args))) + ) + ) + +(let ((my-list (blist 24 16 32 56 72 1234 -34 25 654))) + (format #t "~A~%" my-list) + (sort my-list (lambda ((x int) (y int)) (< x y))) + (format #t "~A~%" my-list) + ) \ No newline at end of file diff --git a/goal_src/test/test-sort.gc b/goal_src/test/test-sort.gc new file mode 100644 index 000000000..49ad2dac8 --- /dev/null +++ b/goal_src/test/test-sort.gc @@ -0,0 +1,14 @@ +(defmacro blist (&rest args) + (if (null? args) + (quote '()) + `(cons (ash ,(car args) 3) (blist ,@(cdr args))) + ) + ) + +(let ((my-list + (blist 24 16 32 56 72 1234 -34 25 654) + )) + (format #t "~A~%" my-list) + (sort my-list (lambda ((x int) (y int)) (- y x))) + (format #t "~A~%" my-list) + ) \ No newline at end of file diff --git a/goalc/compiler/Compiler.h b/goalc/compiler/Compiler.h index f7190168f..33bfd08b6 100644 --- a/goalc/compiler/Compiler.h +++ b/goalc/compiler/Compiler.h @@ -66,6 +66,7 @@ class Compiler { std::string as_string(const goos::Object& o); std::string symbol_string(const goos::Object& o); std::string quoted_sym_as_string(const goos::Object& o); + bool is_basic(const TypeSpec& ts); const goos::Object& pair_car(const goos::Object& o); const goos::Object& pair_cdr(const goos::Object& o); void expect_empty_list(const goos::Object& o); @@ -80,7 +81,8 @@ class Compiler { Val* compile_real_function_call(const goos::Object& form, RegVal* function, const std::vector& args, - Env* env); + Env* env, + std::string method_type_name = ""); TypeSystem m_ts; std::unique_ptr m_global_env = nullptr; @@ -109,6 +111,7 @@ class Compiler { RegVal* compile_get_method_of_type(const TypeSpec& type, const std::string& method_name, Env* env); + RegVal* compile_get_method_of_object(RegVal* object, const std::string& method_name, Env* env); public: // Atoms @@ -179,6 +182,7 @@ class Compiler { Val* compile_new(const goos::Object& form, const goos::Object& rest, Env* env); Val* compile_car(const goos::Object& form, const goos::Object& rest, Env* env); Val* compile_cdr(const goos::Object& form, const goos::Object& rest, Env* env); + Val* compile_method(const goos::Object& form, const goos::Object& rest, Env* env); }; #endif // JAK_COMPILER_H diff --git a/goalc/compiler/Env.cpp b/goalc/compiler/Env.cpp index 1e2b5ebd0..d6974dcfe 100644 --- a/goalc/compiler/Env.cpp +++ b/goalc/compiler/Env.cpp @@ -39,12 +39,12 @@ BlockEnv* Env::find_block(const std::string& name) { return m_parent->find_block(name); } -RegVal* Env::make_gpr(TypeSpec ts) { - return make_ireg(std::move(ts), emitter::RegKind::GPR); +RegVal* Env::make_gpr(const TypeSpec& ts) { + return make_ireg(coerce_to_reg_type(ts), emitter::RegKind::GPR); } -RegVal* Env::make_xmm(TypeSpec ts) { - return make_ireg(std::move(ts), emitter::RegKind::XMM); +RegVal* Env::make_xmm(const TypeSpec& ts) { + return make_ireg(coerce_to_reg_type(ts), emitter::RegKind::XMM); } std::unordered_map& Env::get_label_map() { @@ -233,7 +233,7 @@ RegVal* FunctionEnv::make_ireg(TypeSpec ts, emitter::RegKind kind) { IRegister ireg; ireg.kind = kind; ireg.id = m_iregs.size(); - auto rv = std::make_unique(ireg, ts); + auto rv = std::make_unique(ireg, coerce_to_reg_type(ts)); m_iregs.push_back(std::move(rv)); assert(kind != emitter::RegKind::INVALID); return m_iregs.back().get(); diff --git a/goalc/compiler/Env.h b/goalc/compiler/Env.h index a1f5a822e..4e920357e 100644 --- a/goalc/compiler/Env.h +++ b/goalc/compiler/Env.h @@ -36,8 +36,8 @@ class Env { virtual RegVal* lexical_lookup(goos::Object sym); virtual BlockEnv* find_block(const std::string& name); virtual std::unordered_map& get_label_map(); - RegVal* make_gpr(TypeSpec ts); - RegVal* make_xmm(TypeSpec ts); + RegVal* make_gpr(const TypeSpec& ts); + RegVal* make_xmm(const TypeSpec& ts); virtual ~Env() = default; Env* parent() { return m_parent; } diff --git a/goalc/compiler/Util.cpp b/goalc/compiler/Util.cpp index 6340e4878..0c37525b4 100644 --- a/goalc/compiler/Util.cpp +++ b/goalc/compiler/Util.cpp @@ -180,4 +180,8 @@ emitter::RegKind Compiler::get_preferred_reg_kind(const TypeSpec& ts) { bool Compiler::is_none(Val* in) { return dynamic_cast(in); +} + +bool Compiler::is_basic(const TypeSpec& ts) { + return m_ts.typecheck(m_ts.make_typespec("basic"), ts, "", false, false); } \ No newline at end of file diff --git a/goalc/compiler/Val.cpp b/goalc/compiler/Val.cpp index 13781e744..201703dc3 100644 --- a/goalc/compiler/Val.cpp +++ b/goalc/compiler/Val.cpp @@ -11,7 +11,7 @@ RegVal* Val::to_gpr(Env* fe) { if (rv->ireg().kind == emitter::RegKind::GPR) { return rv; } else { - auto re = fe->make_gpr(m_ts); + auto re = fe->make_gpr(coerce_to_reg_type(m_ts)); fe->emit(std::make_unique(re, rv)); return re; } @@ -39,7 +39,7 @@ RegVal* RegVal::to_gpr(Env* fe) { if (m_ireg.kind == emitter::RegKind::GPR) { return this; } else { - auto re = fe->make_gpr(m_ts); + auto re = fe->make_gpr(coerce_to_reg_type(m_ts)); fe->emit(std::make_unique(re, this)); return re; } @@ -50,58 +50,58 @@ RegVal* RegVal::to_xmm(Env* fe) { if (m_ireg.kind == emitter::RegKind::XMM) { return this; } else { - auto re = fe->make_xmm(m_ts); + auto re = fe->make_xmm(coerce_to_reg_type(m_ts)); fe->emit(std::make_unique(re, this)); return re; } } RegVal* IntegerConstantVal::to_reg(Env* fe) { - auto rv = fe->make_gpr(m_ts); + auto rv = fe->make_gpr(coerce_to_reg_type(m_ts)); fe->emit(std::make_unique(rv, m_value)); return rv; } RegVal* SymbolVal::to_reg(Env* fe) { - auto re = fe->make_gpr(m_ts); + auto re = fe->make_gpr(coerce_to_reg_type(m_ts)); fe->emit(std::make_unique(re, m_name)); return re; } RegVal* SymbolValueVal::to_reg(Env* fe) { - auto re = fe->make_gpr(m_ts); + auto re = fe->make_gpr(coerce_to_reg_type(m_ts)); fe->emit(std::make_unique(re, m_sym, m_sext)); return re; } RegVal* StaticVal::to_reg(Env* fe) { - auto re = fe->make_gpr(m_ts); + auto re = fe->make_gpr(coerce_to_reg_type(m_ts)); fe->emit(std::make_unique(re, obj)); return re; } RegVal* LambdaVal::to_reg(Env* fe) { - auto re = fe->make_gpr(m_ts); + auto re = fe->make_gpr(coerce_to_reg_type(m_ts)); assert(func); fe->emit(std::make_unique(re, func)); return re; } RegVal* FloatConstantVal::to_reg(Env* fe) { - auto re = fe->make_xmm(m_ts); + auto re = fe->make_xmm(coerce_to_reg_type(m_ts)); fe->emit(std::make_unique(re, m_value)); return re; } RegVal* MemoryOffsetConstantVal::to_reg(Env* fe) { - auto re = fe->make_gpr(m_ts); + auto re = fe->make_gpr(coerce_to_reg_type(m_ts)); fe->emit(std::make_unique(re, int64_t(offset))); fe->emit(std::make_unique(IntegerMathKind::ADD_64, re, base->to_gpr(fe))); return re; } RegVal* MemoryOffsetVal::to_reg(Env* fe) { - auto re = fe->make_gpr(m_ts); + auto re = fe->make_gpr(coerce_to_reg_type(m_ts)); fe->emit(std::make_unique(re, offset->to_gpr(fe))); fe->emit(std::make_unique(IntegerMathKind::ADD_64, re, base->to_gpr(fe))); return re; @@ -110,12 +110,12 @@ RegVal* MemoryOffsetVal::to_reg(Env* fe) { RegVal* MemoryDerefVal::to_reg(Env* fe) { auto base_as_co = dynamic_cast(base); if (base_as_co) { - auto re = fe->make_gpr(m_ts); + auto re = fe->make_gpr(coerce_to_reg_type(m_ts)); fe->emit(std::make_unique(re, base_as_co->offset, base_as_co->base->to_gpr(fe), info)); return re; } else { - auto re = fe->make_gpr(m_ts); + auto re = fe->make_gpr(coerce_to_reg_type(m_ts)); auto addr = base->to_gpr(fe); fe->emit(std::make_unique(re, 0, addr, info)); return re; @@ -123,8 +123,9 @@ RegVal* MemoryDerefVal::to_reg(Env* fe) { } RegVal* AliasVal::to_reg(Env* fe) { - auto result = base->to_reg(fe); - result->set_type(m_ts); + auto as_old_type = base->to_reg(fe); + auto result = fe->make_ireg(m_ts, as_old_type->ireg().kind); + fe->emit(std::make_unique(result, as_old_type)); return result; } @@ -138,7 +139,7 @@ std::string PairEntryVal::print() const { RegVal* PairEntryVal::to_reg(Env* fe) { int offset = is_car ? -2 : 2; - auto re = fe->make_gpr(m_ts); + auto re = fe->make_gpr(coerce_to_reg_type(m_ts)); MemLoadInfo info; info.reg = RegKind::GPR_64; info.sign_extend = true; diff --git a/goalc/compiler/Val.h b/goalc/compiler/Val.h index 20e13e06d..f4e76086d 100644 --- a/goalc/compiler/Val.h +++ b/goalc/compiler/Val.h @@ -64,7 +64,7 @@ class None : public Val { */ class RegVal : public Val { public: - RegVal(IRegister ireg, TypeSpec ts) : Val(std::move(ts)), m_ireg(ireg) {} + RegVal(IRegister ireg, const TypeSpec& ts) : Val(coerce_to_reg_type(ts)), m_ireg(ireg) {} bool is_register() const override { return true; } IRegister ireg() const override { return m_ireg; } std::string print() const override { return m_ireg.to_string(); }; diff --git a/goalc/compiler/compilation/Atoms.cpp b/goalc/compiler/compilation/Atoms.cpp index 09298e91d..8d164a4f4 100644 --- a/goalc/compiler/compilation/Atoms.cpp +++ b/goalc/compiler/compilation/Atoms.cpp @@ -67,6 +67,7 @@ static const std::unordered_map< {"new", &Compiler::compile_new}, {"car", &Compiler::compile_car}, {"cdr", &Compiler::compile_cdr}, + {"method", &Compiler::compile_method}, // // // // LAMBDA @@ -88,7 +89,7 @@ static const std::unordered_map< // // OBJECT // {"current-method-type", &Compiler::compile_current_method_type}, // - // {"method", &Compiler::compile_method}, + // // // IT IS MATH {"+", &Compiler::compile_add}, diff --git a/goalc/compiler/compilation/Block.cpp b/goalc/compiler/compilation/Block.cpp index 1db698041..2828114e3 100644 --- a/goalc/compiler/compilation/Block.cpp +++ b/goalc/compiler/compilation/Block.cpp @@ -53,7 +53,7 @@ Val* Compiler::compile_block(const goos::Object& form, const goos::Object& _rest auto& return_types = block_env->return_types; return_types.push_back(result->type()); auto return_type = m_ts.lowest_common_ancestor(return_types); - block_env->return_value->set_type(return_type); + block_env->return_value->set_type(coerce_to_reg_type(return_type)); // an IR to move the result of the block into the block's return register (if no return-from's are // taken) diff --git a/goalc/compiler/compilation/ControlFlow.cpp b/goalc/compiler/compilation/ControlFlow.cpp index cdbdf9435..2cb2e47a8 100644 --- a/goalc/compiler/compilation/ControlFlow.cpp +++ b/goalc/compiler/compilation/ControlFlow.cpp @@ -216,7 +216,7 @@ Val* Compiler::compile_cond(const goos::Object& form, const goos::Object& rest, env->emit(std::move(get_false)); } - result->set_type(m_ts.lowest_common_ancestor(case_result_types)); + result->set_type(coerce_to_reg_type(m_ts.lowest_common_ancestor(case_result_types))); // PATCH END end_label->idx = fenv->code().size(); diff --git a/goalc/compiler/compilation/Define.cpp b/goalc/compiler/compilation/Define.cpp index 812c44fbd..7c2916e0a 100644 --- a/goalc/compiler/compilation/Define.cpp +++ b/goalc/compiler/compilation/Define.cpp @@ -109,6 +109,10 @@ Val* Compiler::compile_set(const goos::Object& form, const goos::Object& rest, E source, base_as_mco->offset, base_as_mco->base->to_gpr(env), ti->get_load_size())); return source; } else { + auto ti = m_ts.lookup_type(base->type()); + env->emit(std::make_unique(source, 0, base->to_gpr(env), + ti->get_load_size())); + return source; throw_compile_error(form, "Set not implemented for this (non-mco) yet"); } } else if (as_pair) { diff --git a/goalc/compiler/compilation/Function.cpp b/goalc/compiler/compilation/Function.cpp index 22e49143e..44d944fec 100644 --- a/goalc/compiler/compilation/Function.cpp +++ b/goalc/compiler/compilation/Function.cpp @@ -284,21 +284,23 @@ Val* Compiler::compile_function_or_method_call(const goos::Object& form, Env* en } else { // not an inline call if (is_method_call) { - throw_compile_error(form, "Unrecognized symbol " + uneval_head.print() + " as head of form"); - // // determine the method to call by looking at the type of first argument - // if (eval_args.empty()) { - // - // } - // printf("BAD %s\n", uneval_head.print().c_str()); - // assert(false); // nyi - // head = compile_get_method_of_object(eval_args.front(), symbol_string(uneval_head), env); + if (eval_args.empty()) { + throw_compile_error(form, + "Unrecognized symbol " + uneval_head.print() + " as head of form"); + } + head = compile_get_method_of_object(eval_args.front(), symbol_string(uneval_head), env); } // convert the head to a GPR - auto head_as_gpr = - head->to_gpr(env); // std::dynamic_pointer_cast(resolve_to_gpr(head, env)); + auto head_as_gpr = head->to_gpr(env); if (head_as_gpr) { - return compile_real_function_call(form, head_as_gpr, eval_args, env); + if (is_method_call) { + return compile_real_function_call(form, head_as_gpr, eval_args, env, + eval_args.front()->type().base_type()); + } else { + return compile_real_function_call(form, head_as_gpr, eval_args, env); + } + } else { throw_compile_error(form, "can't figure out this function call!"); } @@ -311,7 +313,8 @@ Val* Compiler::compile_function_or_method_call(const goos::Object& form, Env* en Val* Compiler::compile_real_function_call(const goos::Object& form, RegVal* function, const std::vector& args, - Env* env) { + Env* env, + std::string method_type_name) { auto fe = get_parent_env_of_type(env); fe->require_aligned_stack(); TypeSpec return_ts; @@ -341,14 +344,18 @@ Val* Compiler::compile_real_function_call(const goos::Object& form, // check arg count: if (function->type().arg_count()) { if (function->type().arg_count() - 1 != args.size()) { - printf("got type %s\n", function->type().print().c_str()); throw_compile_error(form, "invalid number of arguments to function call: got " + std::to_string(args.size()) + " and expected " + std::to_string(function->type().arg_count() - 1) + " for " + function->type().print()); } for (uint32_t i = 0; i < args.size(); i++) { - typecheck(form, function->type().get_arg(i), args.at(i)->type(), "function argument"); + if (method_type_name.empty()) { + typecheck(form, function->type().get_arg(i), args.at(i)->type(), "function argument"); + } else { + typecheck(form, function->type().get_arg(i).substitute_for_method_call(method_type_name), + args.at(i)->type(), "function argument"); + } } } diff --git a/goalc/compiler/compilation/Type.cpp b/goalc/compiler/compilation/Type.cpp index ea2744c40..681cb8363 100644 --- a/goalc/compiler/compilation/Type.cpp +++ b/goalc/compiler/compilation/Type.cpp @@ -1,11 +1,19 @@ #include "goalc/compiler/Compiler.h" #include "common/type_system/deftype.h" +namespace { +int get_offset_of_method(int id) { + // todo - something that looks at the type system? + // this will need changing if the layout of type ever changes. + return 16 + 4 * id; +} +} // namespace + RegVal* Compiler::compile_get_method_of_type(const TypeSpec& type, const std::string& method_name, Env* env) { auto info = m_ts.lookup_method(type.base_type(), method_name); - auto offset_of_method = 16 + 4 * info.id; // todo, something more flexible? + auto offset_of_method = get_offset_of_method(info.id); auto fe = get_parent_env_of_type(env); auto typ = compile_get_symbol_value(type.base_type(), env)->to_gpr(env); @@ -25,6 +33,43 @@ RegVal* Compiler::compile_get_method_of_type(const TypeSpec& type, return deref->to_reg(env); } +RegVal* Compiler::compile_get_method_of_object(RegVal* object, + const std::string& method_name, + Env* env) { + auto& compile_time_type = object->type(); + auto method_info = m_ts.lookup_method(compile_time_type.base_type(), method_name); + auto fe = get_parent_env_of_type(env); + + RegVal* runtime_type = nullptr; + if (is_basic(compile_time_type)) { + runtime_type = fe->make_gpr(m_ts.make_typespec("type")); + MemLoadInfo info; + info.size = 4; + info.sign_extend = false; + info.reg = RegKind::GPR_64; + env->emit(std::make_unique(runtime_type, -4, object, info)); + } else { + // can't look up at runtime + runtime_type = compile_get_symbol_value(compile_time_type.base_type(), env)->to_gpr(env); + } + + auto offset_of_method = get_offset_of_method(method_info.id); + MemLoadInfo load_info; + load_info.sign_extend = false; + load_info.size = POINTER_SIZE; + + auto loc_type = m_ts.make_pointer_typespec(method_info.type); + auto loc = fe->alloc_val(loc_type, runtime_type, offset_of_method); + auto di = m_ts.get_deref_info(loc_type); + assert(di.can_deref); + assert(di.mem_deref); + assert(di.sign_extend == false); + assert(di.load_size == 4); + + auto deref = fe->alloc_val(di.result_type, loc, MemLoadInfo(di)); + return deref->to_reg(env); +} + Val* Compiler::compile_deftype(const goos::Object& form, const goos::Object& rest, Env* env) { (void)form; (void)env; @@ -100,6 +145,7 @@ Val* Compiler::compile_defmethod(const goos::Object& form, const goos::Object& _ auto new_func_env = std::make_unique(env, lambda.debug_name); new_func_env->set_segment(MAIN_SEGMENT); // todo, how do we set debug? + new_func_env->method_of_type_name = symbol_string(type_name); // set up arguments assert(lambda.params.size() < 8); // todo graceful error @@ -138,6 +184,8 @@ Val* Compiler::compile_defmethod(const goos::Object& form, const goos::Object& _ if (result) { auto final_result = result->to_gpr(new_func_env.get()); new_func_env->emit(std::make_unique(return_reg, final_result)); + printf("return type is %s from %s from %s\n", final_result->type().print().c_str(), + final_result->print().c_str(), result->print().c_str()); lambda_ts.add_arg(final_result->type()); } else { lambda_ts.add_arg(m_ts.make_typespec("none")); @@ -336,4 +384,22 @@ Val* Compiler::compile_cdr(const goos::Object& form, const goos::Object& rest, E auto fe = get_parent_env_of_type(env); return fe->alloc_val(m_ts.make_typespec("object"), compile_error_guard(args.unnamed.at(0), env), false); -} \ No newline at end of file +} + +// todo, consider splitting into method-of-object and method-of-type? +Val* Compiler::compile_method(const goos::Object& form, const goos::Object& rest, Env* env) { + auto args = get_va(form, rest); + va_check(form, args, {{}, {goos::ObjectType::SYMBOL}}, {}); + + auto arg = args.unnamed.at(0); + auto method_name = symbol_string(args.unnamed.at(1)); + + if (arg.is_symbol()) { + if (m_ts.fully_defined_type_exists(symbol_string(arg))) { + return compile_get_method_of_type(m_ts.make_typespec(symbol_string(arg)), method_name, env); + } + } + + auto obj = compile_error_guard(arg, env)->to_gpr(env); + return compile_get_method_of_object(obj, method_name, env); +} diff --git a/test/test_compiler_and_runtime.cpp b/test/test_compiler_and_runtime.cpp index 300dd1195..33673c812 100644 --- a/test/test_compiler_and_runtime.cpp +++ b/test/test_compiler_and_runtime.cpp @@ -136,6 +136,27 @@ TEST(CompilerAndRuntime, BuildGameAndTest) { runner.run_test("test-access-inline-array.gc", {"1.2345\n0\n"}); runner.run_test("test-find-parent-method.gc", {"\"test pass!\"\n0\n"}); runner.run_test("test-ref.gc", {"83\n"}); + runner.run_test("test-pair-asize.gc", {"8\n"}); + runner.run_test("test-last.gc", {"d\n0\n"}); + runner.run_test("test-sort.gc", + {"(24 16 32 56 72 1234 -34 25 654)\n(1234 654 72 56 32 25 24 16 -34)\n0\n"}); + runner.run_test("test-sort-2.gc", + {"(24 16 32 56 72 1234 -34 25 654)\n(-34 16 24 25 32 56 72 654 1234)\n0\n"}); + runner.run_test("test-sort-3.gc", + {"(24 16 32 56 72 1234 -34 25 654)\n(-34 16 24 25 32 56 72 654 1234)\n0\n"}); + runner.run_test("test-pair-length.gc", {"6\n"}); + runner.run_test("test-member-1.gc", {"(c d)\n0\n"}); + runner.run_test("test-member-2.gc", {"#f\n0\n"}); + runner.run_test("test-assoc-1.gc", {"w\n0\n"}); + runner.run_test("test-assoc-2.gc", {"#f\n0\n"}); + runner.run_test("test-assoce-1.gc", {"x\n0\n"}); + runner.run_test("test-assoce-2.gc", {"x\n0\n"}); + runner.run_test("test-append.gc", {"(a b c d e)\n0\n"}); + runner.run_test("test-delete-list.gc", {"(a b d e)\n0\n"}); + runner.run_test("test-delete-car.gc", {"((a . b) (e . f))\n#f\n0\n"}); + runner.run_test("test-insert-cons.gc", {"((c . w) (a . b) (e . f))\n0\n"}); + runner.run_test("test-new-inline-array-class.gc", {"2820\n"}); + runner.run_test("test-memcpy.gc", {"13\n"}); runner.print_summary(); @@ -307,6 +328,8 @@ TEST(CompilerAndRuntime, CompilerTests) { runner.run_test("test-car-cdr-set.gc", {"(c . d)\n0\n"}); runner.run_test("test-nested-car-cdr-set.gc", {"efgh\n((e . g) f . h)\n0\n"}); runner.run_test("test-dotimes.gc", {"4950\n"}); + runner.run_test("test-methods.gc", {"#t#t\n0\n"}); + runner.run_test("test-pointers-1.gc", {"13\n"}); compiler.shutdown_target(); runtime_thread.join();