Skip to content

Commit

Permalink
C4 linearization: C3 with extra struct (linear) inheritance constraint (
Browse files Browse the repository at this point in the history 
#1118)

Extends the C3 algorithm with a 4th constraint, that struct subclasses
can only mix if they form a linear struct inheritance chain (ie no
diamonds).

This allows us to:
- lift the restriction of structs only inheriting structs; they can
inherit classes so as to fix the slot layout.
- lift the single inheritance restriction of structs, which can now mix
in multiple classes, subject to the linear inheritance constraint.

---------

Co-authored-by: vyzo <[email protected]>
  • Loading branch information
@fare @vyzo
fare and vyzo authored Feb 11, 2024
1 parent 13f0524 commit 5381b28
Show file tree
Hide file tree
Showing 95 changed files with 100,104 additions and 100,647 deletions.
13 changes: 8 additions & 5 deletions src/bootstrap/gerbil/builtin.ssxi.ss
View file
Original file line number Diff line number Diff line change
Expand Up @@ -254,10 +254,13 @@ package: gerbil
((_ prim ...)
(declare-primitive* (prim 5) ...)))

(defrules declare-primitive/5/unchecked()
(defrules declare-primitive/5/unchecked ()
((_ prim ...)
(declare-primitive/unchecked* (prim 5) ...)))

(defrules declare-primitive/6/unchecked ()
((_ prim ...)
(declare-primitive/unchecked* (prim 6) ...)))
;; r5rs primitives -- <r5rs-runtime>
(declare-primitive/0/unchecked
interaction-environment)
Expand Down Expand Up @@ -484,6 +487,9 @@ package: gerbil
substring-move!
subu8vector-move!)

(declare-primitive/6/unchecked
make-class-type)

(declare-primitive/unchecked*
(iota 1 2 3)
(assgetq 2 3)
Expand All @@ -504,10 +510,7 @@ package: gerbil
(bytes->string 1 2)
(string-index 2 3)
(string-rindex 2 3)
(make-struct-type 6 7)
(make-class-type 6)
(make-struct-instance (1))
(make-class-instance (1))
(make-instance (1))
(class-instance-init! (1))
(slot-ref 2 3)
(slot-set! 3 4)
Expand Down
133 changes: 66 additions & 67 deletions src/bootstrap/gerbil/compiler/base__0.scm
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
(declare (block) (standard-bindings) (extended-bindings))
(begin
(define gerbil/compiler/base::timestamp 1707573213)
(define gerbil/compiler/base::timestamp 1707674932)
(begin
(define gxc#current-compile-symbol-table (make-parameter '#f))
(define gxc#current-compile-runtime-sections (make-parameter '#f))
Expand All @@ -18,143 +18,142 @@
(define gxc#current-compile-decls (make-parameter '#f))
(define gxc#current-compile-context (make-parameter '#f))
(define gxc#symbol-table::t
(let ((__tmp192585
(let ((__tmp192586
(let ((__tmp194835 (list))
(__tmp194833
(let ((__tmp194834
(let () (declare (not safe)) (cons 'struct: '#t))))
(declare (not safe))
(cons __tmp192586 '()))))
(cons __tmp194834 '()))))
(declare (not safe))
(make-struct-type
(make-class-type
'gxc#symbol-table::t
'symbol-table
'#f
__tmp194835
'(gensyms bindings)
__tmp192585
__tmp194833
':init!)))
(define gxc#symbol-table?
(let ()
(declare (not safe))
(make-struct-predicate gxc#symbol-table::t)))
(let () (declare (not safe)) (make-class-predicate gxc#symbol-table::t)))
(define gxc#make-symbol-table
(lambda _$args188070_
(apply make-struct-instance gxc#symbol-table::t _$args188070_)))
(lambda _$args190218_
(apply make-instance gxc#symbol-table::t _$args190218_)))
(define gxc#symbol-table-gensyms
(let ()
(declare (not safe))
(make-struct-slot-accessor gxc#symbol-table::t 'gensyms)))
(make-class-slot-accessor gxc#symbol-table::t 'gensyms)))
(define gxc#symbol-table-bindings
(let ()
(declare (not safe))
(make-struct-slot-accessor gxc#symbol-table::t 'bindings)))
(make-class-slot-accessor gxc#symbol-table::t 'bindings)))
(define gxc#symbol-table-gensyms-set!
(let ()
(declare (not safe))
(make-struct-slot-mutator gxc#symbol-table::t 'gensyms)))
(make-class-slot-mutator gxc#symbol-table::t 'gensyms)))
(define gxc#symbol-table-bindings-set!
(let ()
(declare (not safe))
(make-struct-slot-mutator gxc#symbol-table::t 'bindings)))
(make-class-slot-mutator gxc#symbol-table::t 'bindings)))
(define gxc#&symbol-table-gensyms
(let ()
(declare (not safe))
(make-struct-slot-unchecked-accessor gxc#symbol-table::t 'gensyms)))
(make-class-slot-unchecked-accessor gxc#symbol-table::t 'gensyms)))
(define gxc#&symbol-table-bindings
(let ()
(declare (not safe))
(make-struct-slot-unchecked-accessor gxc#symbol-table::t 'bindings)))
(make-class-slot-unchecked-accessor gxc#symbol-table::t 'bindings)))
(define gxc#&symbol-table-gensyms-set!
(let ()
(declare (not safe))
(make-struct-slot-unchecked-mutator gxc#symbol-table::t 'gensyms)))
(make-class-slot-unchecked-mutator gxc#symbol-table::t 'gensyms)))
(define gxc#&symbol-table-bindings-set!
(let ()
(declare (not safe))
(make-struct-slot-unchecked-mutator gxc#symbol-table::t 'bindings)))
(make-class-slot-unchecked-mutator gxc#symbol-table::t 'bindings)))
(define gxc#symbol-table:::init!
(lambda (_self188068_)
(if (let ((__tmp192591
(lambda (_self190216_)
(if (let ((__tmp194840
(let ()
(declare (not safe))
(##structure-length _self188068_))))
(##structure-length _self190216_))))
(declare (not safe))
(##fx< '2 __tmp192591))
(##fx< '2 __tmp194840))
(begin
(let ((__tmp192588
(let ((__tmp194837
(let () (declare (not safe)) (make-table 'test: eq?)))
(__tmp192587
(__tmp194836
(let ()
(declare (not safe))
(##structure-type _self188068_))))
(##structure-type _self190216_))))
(declare (not safe))
(##unchecked-structure-set!
_self188068_
__tmp192588
_self190216_
__tmp194837
'1
__tmp192587
__tmp194836
'#f))
(let ((__tmp192590
(let ((__tmp194839
(let () (declare (not safe)) (make-table 'test: eq?)))
(__tmp192589
(__tmp194838
(let ()
(declare (not safe))
(##structure-type _self188068_))))
(##structure-type _self190216_))))
(declare (not safe))
(##unchecked-structure-set!
_self188068_
__tmp192590
_self190216_
__tmp194839
'2
__tmp192589
__tmp194838
'#f)))
(error '"struct-instance-init!: too many arguments for struct"
_self188068_
_self190216_
'2
(let ()
(declare (not safe))
(##vector-length _self188068_))))))
(##vector-length _self190216_))))))
(let ()
(declare (not safe))
(bind-method! gxc#symbol-table::t ':init! gxc#symbol-table:::init! '#f))
(define gxc#raise-compile-error
(lambda (_message187937_ _stx187938_ . _details187939_)
(let ((_ctx187944_
(let ((_$e187941_ (gxc#current-compile-context)))
(if _$e187941_ _$e187941_ 'compile))))
(lambda (_message190085_ _stx190086_ . _details190087_)
(let ((_ctx190092_
(let ((_$e190089_ (gxc#current-compile-context)))
(if _$e190089_ _$e190089_ 'compile))))
(apply gx#raise-syntax-error
_ctx187944_
_message187937_
_stx187938_
_details187939_))))
_ctx190092_
_message190085_
_stx190086_
_details190087_))))
(define gxc#verbose
(lambda _args187934_
(lambda _args190082_
(if (gxc#current-compile-verbose)
(let ((__tmp192592 (lambda () (apply displayln _args187934_))))
(let ((__tmp194841 (lambda () (apply displayln _args190082_))))
(declare (not safe))
(with-lock gxc#+verbose-mutex+ __tmp192592))
(with-lock gxc#+verbose-mutex+ __tmp194841))
'#!void)))
(define gxc#+verbose-mutex+ (make-mutex 'compiler/driver))
(define gxc#module-path-reserved-chars '":#<>&!?*;()[]{}|'`\"\\")
(define gxc#module-id->path-string
(lambda (_id187916_)
(let* ((_str187918_
(if (let () (declare (not safe)) (symbol? _id187916_))
(symbol->string _id187916_)
_id187916_))
(_len187920_ (string-length _str187918_))
(_res187922_ (make-string _len187920_)))
(let _lp187925_ ((_i187927_ '0))
(if (fx< _i187927_ _len187920_)
(let* ((_char187929_ (string-ref _str187918_ _i187927_))
(_xchar187931_
(lambda (_id190064_)
(let* ((_str190066_
(if (let () (declare (not safe)) (symbol? _id190064_))
(symbol->string _id190064_)
_id190064_))
(_len190068_ (string-length _str190066_))
(_res190070_ (make-string _len190068_)))
(let _lp190073_ ((_i190075_ '0))
(if (fx< _i190075_ _len190068_)
(let* ((_char190077_ (string-ref _str190066_ _i190075_))
(_xchar190079_
(if (let ()
(declare (not safe))
(string-index
gxc#module-path-reserved-chars
_char187929_))
_char190077_))
'#\_
_char187929_)))
(string-set! _res187922_ _i187927_ _xchar187931_)
(let ((__tmp192593
(let () (declare (not safe)) (fx+ _i187927_ '1))))
_char190077_)))
(string-set! _res190070_ _i190075_ _xchar190079_)
(let ((__tmp194842
(let () (declare (not safe)) (fx+ _i190075_ '1))))
(declare (not safe))
(_lp187925_ __tmp192593)))
_res187922_)))))))
(_lp190073_ __tmp194842)))
_res190070_)))))))
Loading

0 comments on commit 5381b28

Please sign in to comment.