From 3507b9bad7164012b1d49f95ce014ca589fa1d36 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 3 May 2012 19:17:41 -0700 Subject: [PATCH] classes: - Allow methods to dispatch off union{ } and intersection{ } classes. - Add not{ } anonymous-complement syntax. - Define class-name for anonymous-union/intersection/complement and maybes, and clean up pprint. - Change maybe: foo to maybe{ foo } - Call sort-classes when making anonymous-union/anonymous-intersection classes so that they are canonicalized. --- basis/compiler/tests/redefine26.factor | 2 +- .../tree/propagation/propagation-tests.factor | 6 +-- basis/dlists/dlists.factor | 6 +-- basis/io/sockets/sockets.factor | 6 +-- basis/prettyprint/backend/backend.factor | 22 +++++--- basis/prettyprint/prettyprint-tests.factor | 18 +++---- basis/typed/typed-tests.factor | 2 +- core/bootstrap/syntax.factor | 3 +- core/classes/algebra/algebra.factor | 12 ++++- core/classes/intersection/intersection.factor | 3 ++ core/classes/maybe/maybe-tests.factor | 28 +++++----- core/classes/maybe/maybe.factor | 9 ++-- core/classes/union/union.factor | 3 ++ core/compiler/units/units.factor | 3 +- core/generic/generic.factor | 9 +--- core/syntax/syntax.factor | 8 ++- extra/cuda/ptx/ptx.factor | 54 +++++++++---------- extra/gpu/framebuffers/framebuffers.factor | 8 +-- extra/gpu/render/render.factor | 8 +-- extra/gpu/shaders/shaders.factor | 12 ++--- extra/gpu/state/state.factor | 18 +++---- extra/gpu/textures/textures.factor | 2 +- 22 files changed, 133 insertions(+), 109 deletions(-) diff --git a/basis/compiler/tests/redefine26.factor b/basis/compiler/tests/redefine26.factor index 10be39d675..81dbabf1d9 100644 --- a/basis/compiler/tests/redefine26.factor +++ b/basis/compiler/tests/redefine26.factor @@ -7,7 +7,7 @@ TUPLE: hoo ; UNION: foo integer yoo ; -TUPLE: redefine-test-26 { a maybe: foo } ; +TUPLE: redefine-test-26 { a maybe{ foo } } ; : store-26 ( -- obj ) redefine-test-26 new 26 >>a ; : store-26. ( -- obj ) redefine-test-26 new 26. >>a ; diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index c22071c319..d56faf150e 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -1008,12 +1008,12 @@ M: tuple-with-read-only-slot clone ] unit-test [ t ] [ - [ maybe: integer instance? ] { instance? } inlined? + [ maybe{ integer } instance? ] { instance? } inlined? ] unit-test TUPLE: inline-please a ; [ t ] [ - [ maybe: inline-please instance? ] { instance? } inlined? + [ maybe{ inline-please } instance? ] { instance? } inlined? ] unit-test GENERIC: derp ( obj -- obj' ) @@ -1023,5 +1023,5 @@ M: f derp drop t ; [ t ] [ - [ dup maybe: integer instance? [ derp ] when ] { instance? } inlined? + [ dup maybe{ integer } instance? [ derp ] when ] { instance? } inlined? ] unit-test diff --git a/basis/dlists/dlists.factor b/basis/dlists/dlists.factor index 758b704708..be968b0dab 100644 --- a/basis/dlists/dlists.factor +++ b/basis/dlists/dlists.factor @@ -6,7 +6,7 @@ deques fry hashtables kernel parser search-deques sequences summary vocabs.loader ; IN: dlists -TUPLE: dlist-link { prev maybe: dlist-link } { next maybe: dlist-link } ; +TUPLE: dlist-link { prev maybe{ dlist-link } } { next maybe{ dlist-link } } ; TUPLE: dlist-node < dlist-link obj ; @@ -22,8 +22,8 @@ M: dlist-link obj>> ; \ dlist-node new-dlist-link ; inline TUPLE: dlist -{ front maybe: dlist-link } -{ back maybe: dlist-link } ; +{ front maybe{ dlist-link } } +{ back maybe{ dlist-link } } ; : ( -- list ) dlist new ; inline diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index b4855c09b6..093989e390 100644 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -65,7 +65,7 @@ M: local protocol drop 0 ; SLOT: port -TUPLE: ipv4 { host maybe: string read-only } ; +TUPLE: ipv4 { host maybe{ string } read-only } ; members ; +! QUALIFIED-WITH: classes.not cn IN: prettyprint.backend M: effect pprint* effect>string text ; @@ -26,13 +28,16 @@ M: effect pprint* effect>string text ; GENERIC: word-name* ( obj -- str ) M: maybe word-name* - class>> word-name* "maybe: " prepend ; + class-name "maybe{ " " }" surround ; + +M: anonymous-complement word-name* + class-name "not{ " " }" surround ; M: anonymous-union word-name* - members>> [ word-name* ] map " " join "union{ " " }" surround ; + class-name "union{ " " }" surround ; M: anonymous-intersection word-name* - participants>> [ word-name* ] map " " join "intersection{ " " }" surround ; + class-name "intersection{ " " }" surround ; M: word word-name* ( word -- str ) [ name>> "( no name )" or ] [ record-vocab ] bi ; @@ -213,6 +218,8 @@ M: callstack pprint-delims drop \ CS{ \ } ; M: hash-set pprint-delims drop \ HS{ \ } ; M: anonymous-union pprint-delims drop \ union{ \ } ; M: anonymous-intersection pprint-delims drop \ intersection{ \ } ; +M: anonymous-complement pprint-delims drop \ not{ \ } ; +M: maybe pprint-delims drop \ maybe{ \ } ; M: object >pprint-sequence ; M: vector >pprint-sequence ; @@ -224,6 +231,8 @@ M: callstack >pprint-sequence callstack>array ; M: hash-set >pprint-sequence members ; M: anonymous-union >pprint-sequence members>> ; M: anonymous-intersection >pprint-sequence participants>> ; +M: anonymous-complement >pprint-sequence class>> 1array ; +M: maybe >pprint-sequence class>> 1array ; : class-slot-sequence ( class slots -- sequence ) [ 1array ] [ [ f 2array ] dip append ] if-empty ; @@ -264,6 +273,8 @@ M: compose pprint* pprint-object ; M: hash-set pprint* pprint-object ; M: anonymous-union pprint* pprint-object ; M: anonymous-intersection pprint* pprint-object ; +M: anonymous-complement pprint* pprint-object ; +M: maybe pprint* pprint-object ; M: wrapper pprint* { @@ -271,6 +282,3 @@ M: wrapper pprint* { [ dup wrapped>> word? ] [ > pprint-word block> ] } [ pprint-object ] } cond ; - -M: maybe pprint* - > pprint-class block> ; diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor index 2eed7b47d2..23d10930e6 100644 --- a/basis/prettyprint/prettyprint-tests.factor +++ b/basis/prettyprint/prettyprint-tests.factor @@ -388,18 +388,18 @@ TUPLE: final-tuple ; final ] with-variable ] unit-test -[ "maybe: integer\n" ] [ [ maybe: integer . ] with-string-writer ] unit-test +[ "maybe{ integer }\n" ] [ [ maybe{ integer } . ] with-string-writer ] unit-test TUPLE: bob a b ; -[ "maybe: bob\n" ] [ [ maybe: bob . ] with-string-writer ] unit-test -[ "maybe: word\n" ] [ [ maybe: word . ] with-string-writer ] unit-test +[ "maybe{ bob }\n" ] [ [ maybe{ bob } . ] with-string-writer ] unit-test +[ "maybe{ word }\n" ] [ [ maybe{ word } . ] with-string-writer ] unit-test TUPLE: har a ; GENERIC: harhar ( obj -- obj ) -M: maybe: har harhar ; +M: maybe{ har } harhar ; M: integer harhar M\ integer harhar drop ; [ """USING: prettyprint.tests ; -M: maybe: har harhar ; +M: maybe{ har } harhar ; USING: kernel math prettyprint.tests ; M: integer harhar M\\ integer harhar drop ;\n""" @@ -445,13 +445,13 @@ TUPLE: fo { a intersection{ fixnum integer } initial: 0 } ; ] [ [ intersection{ union{ float integer } intersection{ string hashtable } } . ] with-string-writer ] unit-test [ -"""maybe: union{ float integer }\n""" +"""maybe{ union{ float integer } }\n""" ] [ - [ maybe: union{ float integer } . ] with-string-writer + [ maybe{ union{ float integer } } . ] with-string-writer ] unit-test [ -"""maybe: maybe: integer\n""" +"""maybe{ maybe{ integer } }\n""" ] [ - [ maybe: maybe: integer . ] with-string-writer + [ maybe{ maybe{ integer } } . ] with-string-writer ] unit-test diff --git a/basis/typed/typed-tests.factor b/basis/typed/typed-tests.factor index 5209038473..0471490189 100644 --- a/basis/typed/typed-tests.factor +++ b/basis/typed/typed-tests.factor @@ -163,7 +163,7 @@ TYPED: forget-fail ( a: forget-class -- ) drop ; [ ] [ [ \ forget-fail forget ] with-compilation-unit ] unit-test -TYPED: typed-maybe ( x: maybe: integer -- ? ) >boolean ; +TYPED: typed-maybe ( x: maybe{ integer } -- ? ) >boolean ; [ f ] [ f typed-maybe ] unit-test [ t ] [ 30 typed-maybe ] unit-test diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor index 8bd950f3dd..3da99fa49b 100644 --- a/core/bootstrap/syntax.factor +++ b/core/bootstrap/syntax.factor @@ -82,7 +82,8 @@ IN: bootstrap.syntax "<<" ">>" "call-next-method" - "maybe:" + "not{" + "maybe{" "union{" "intersection{" "initial:" diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index 078cace06b..3610360b6f 100644 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -7,6 +7,8 @@ FROM: classes => members ; RENAME: members sets => set-members IN: classes.algebra +DEFER: sort-classes + ( members -- class ) [ null eq? not ] filter set-members - dup length 1 = [ first ] [ anonymous-union boa ] if ; + dup length 1 = [ first ] [ sort-classes f like anonymous-union boa ] if ; M: anonymous-union rank-class drop 6 ; @@ -25,7 +27,7 @@ INSTANCE: anonymous-intersection classoid : ( participants -- class ) set-members dup length 1 = - [ first ] [ anonymous-intersection boa ] if ; + [ first ] [ sort-classes f like anonymous-intersection boa ] if ; M: anonymous-intersection rank-class drop 4 ; @@ -37,6 +39,12 @@ C: anonymous-complement M: anonymous-complement rank-class drop 3 ; +M: anonymous-complement instance? + over [ class>> instance? not ] [ 2drop t ] if ; + +M: anonymous-complement class-name + class>> class-name ; + DEFER: (class<=) DEFER: (class-not) diff --git a/core/classes/intersection/intersection.factor b/core/classes/intersection/intersection.factor index 20b456648f..92f384ded1 100644 --- a/core/classes/intersection/intersection.factor +++ b/core/classes/intersection/intersection.factor @@ -51,6 +51,9 @@ M: anonymous-intersection (flatten-class) [ dup set ] each ] if-empty ; +M: anonymous-intersection class-name + participants>> [ class-name ] map " " join ; + PRIVATE> : define-intersection-class ( class participants -- ) diff --git a/core/classes/maybe/maybe-tests.factor b/core/classes/maybe/maybe-tests.factor index 5f536e906c..b8c7374ccb 100644 --- a/core/classes/maybe/maybe-tests.factor +++ b/core/classes/maybe/maybe-tests.factor @@ -4,41 +4,41 @@ USING: classes.maybe eval generic.single kernel tools.test math classes accessors slots classes.algebra ; IN: classes.maybe.tests -[ t ] [ 3 maybe: integer instance? ] unit-test -[ t ] [ f maybe: integer instance? ] unit-test -[ f ] [ 3.0 maybe: integer instance? ] unit-test +[ t ] [ 3 maybe{ integer } instance? ] unit-test +[ t ] [ f maybe{ integer } instance? ] unit-test +[ f ] [ 3.0 maybe{ integer } instance? ] unit-test -TUPLE: maybe-integer-container { something maybe: integer } ; +TUPLE: maybe-integer-container { something maybe{ integer } } ; [ f ] [ maybe-integer-container new something>> ] unit-test [ 3 ] [ maybe-integer-container new 3 >>something something>> ] unit-test [ maybe-integer-container new 3.0 >>something ] [ bad-slot-value? ] must-fail-with -TUPLE: self-pointer { next maybe: self-pointer } ; +TUPLE: self-pointer { next maybe{ self-pointer } } ; [ T{ self-pointer { next T{ self-pointer } } } ] [ self-pointer new self-pointer new >>next ] unit-test -[ t ] [ f maybe: f instance? ] unit-test +[ t ] [ f maybe{ POSTPONE: f } instance? ] unit-test -PREDICATE: natural < maybe: integer +PREDICATE: natural < maybe{ integer } 0 > ; [ f ] [ -1 natural? ] unit-test [ f ] [ 0 natural? ] unit-test [ t ] [ 1 natural? ] unit-test -[ t ] [ f maybe: maybe: integer instance? ] unit-test -[ t ] [ 3 maybe: maybe: integer instance? ] unit-test -[ f ] [ 3.03 maybe: maybe: integer instance? ] unit-test +[ t ] [ f maybe{ maybe{ integer } } instance? ] unit-test +[ t ] [ 3 maybe{ maybe{ integer } } instance? ] unit-test +[ f ] [ 3.03 maybe{ maybe{ integer } } instance? ] unit-test -INTERSECTION: only-f maybe: integer POSTPONE: f ; +INTERSECTION: only-f maybe{ integer } POSTPONE: f ; [ t ] [ f only-f instance? ] unit-test [ f ] [ t only-f instance? ] unit-test [ f ] [ 30 only-f instance? ] unit-test -UNION: ?integer-float maybe: integer maybe: float ; +UNION: ?integer-float maybe{ integer } maybe{ float } ; [ t ] [ 30 ?integer-float instance? ] unit-test [ t ] [ 30.0 ?integer-float instance? ] unit-test @@ -47,7 +47,7 @@ UNION: ?integer-float maybe: integer maybe: float ; TUPLE: foo ; GENERIC: lol ( obj -- string ) -M: maybe: foo lol drop "lol" ; +M: maybe{ foo } lol drop "lol" ; [ "lol" ] [ foo new lol ] unit-test [ "lol" ] [ f lol ] unit-test @@ -55,7 +55,7 @@ M: maybe: foo lol drop "lol" ; TUPLE: foo2 a ; GENERIC: lol2 ( obj -- string ) -M: maybe: foo lol2 drop "lol2" ; +M: maybe{ foo } lol2 drop "lol2" ; M: f lol2 drop "lol22" ; [ "lol2" ] [ foo new lol2 ] unit-test diff --git a/core/classes/maybe/maybe.factor b/core/classes/maybe/maybe.factor index 56c57343e1..8678c1991c 100644 --- a/core/classes/maybe/maybe.factor +++ b/core/classes/maybe/maybe.factor @@ -2,12 +2,13 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors classes classes.algebra classes.algebra.private classes.private classes.union.private -effects kernel words ; +effects kernel words sequences arrays ; IN: classes.maybe ! The class slot has to be a union of a word and a classoid -! for TUPLE: foo { a maybe: foo } ; and maybe: union{ integer float } to work. -! In the first case, foo is not yet a tuple-class when maybe: is reached, +! for TUPLE: foo { a maybe{ foo } } ; and maybe{ union{ integer float } } +! to work. +! In the first case, foo is not yet a tuple-class when maybe{ is reached, ! thus it's not a classoid yet. union{ is a classoid, so the second case works. ! words are not generally classoids, so classoid alone is insufficient. TUPLE: maybe { class union{ word classoid } initial: object read-only } ; @@ -36,7 +37,7 @@ M: maybe union-of-builtins? class>> union-of-builtins? ; M: maybe class-name - class>> name>> ; + class>> class-name ; M: maybe predicate-def class>> predicate-def [ [ t ] if* ] curry ; diff --git a/core/classes/union/union.factor b/core/classes/union/union.factor index 385719b552..b4e59a4a7e 100644 --- a/core/classes/union/union.factor +++ b/core/classes/union/union.factor @@ -69,6 +69,9 @@ M: union-class instance? M: anonymous-union instance? members>> [ instance? ] with any? ; +M: anonymous-union class-name + members>> [ class-name ] map " " join ; + M: union-class normalize-class members normalize-class ; diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index 004c725470..8c6f1601ec 100644 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -3,7 +3,7 @@ USING: accessors arrays assocs classes classes.private classes.tuple classes.tuple.private continuations definitions generic init kernel kernel.private math namespaces sequences -sets source-files.errors vocabs words ; +sets source-files.errors vocabs words classes.algebra ; FROM: namespaces => set ; IN: compiler.units @@ -18,6 +18,7 @@ TUPLE: redefine-error def ; > ] bi@ "=>" glue ; - -M: maybe method-word-name - [ class>> name>> ] [ name>> ] bi* "=>" glue ; +: method-word-name ( class generic -- string ) + [ class-name ] [ name>> ] bi* "=>" glue ; M: method parent-word "method-generic" word-prop ; diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 361fc0769c..e356f8d88e 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -246,8 +246,12 @@ IN: bootstrap.syntax ] if* ] define-core-syntax - "maybe:" [ - scan-class suffix! + "maybe{" [ + \ } [ ] parse-literal + ] define-core-syntax + + "not{" [ + \ } [ ] parse-literal ] define-core-syntax "intersection{" [ diff --git a/extra/cuda/ptx/ptx.factor b/extra/cuda/ptx/ptx.factor index 6b6d27a793..79cd232007 100644 --- a/extra/cuda/ptx/ptx.factor +++ b/extra/cuda/ptx/ptx.factor @@ -26,7 +26,7 @@ VARIANT: ptx-texmode VARIANT: ptx-storage-space .reg .sreg - .const: { { bank maybe: integer } } + .const: { { bank maybe{ integer } } } .global .local .param @@ -34,9 +34,9 @@ VARIANT: ptx-storage-space .tex ; TUPLE: ptx-target - { arch maybe: ptx-arch } + { arch maybe{ ptx-arch } } { map_f64_to_f32? boolean } - { texmode maybe: ptx-texmode } ; + { texmode maybe{ ptx-texmode } } ; TUPLE: ptx { version string } @@ -50,13 +50,13 @@ TUPLE: ptx-struct-definition TUPLE: ptx-variable { extern? boolean } { visible? boolean } - { align maybe: integer } + { align maybe{ integer } } { storage-space ptx-storage-space } { type ptx-type } { name string } - { parameter maybe: integer } + { parameter maybe{ integer } } { dim dim } - { initializer maybe: string } ; + { initializer maybe{ string } } ; TUPLE: ptx-negation { var string } ; @@ -79,8 +79,8 @@ UNION: ptx-operand integer float ptx-var ptx-negation ptx-vector ptx-indirect ; TUPLE: ptx-instruction - { label maybe: string } - { predicate maybe: ptx-operand } ; + { label maybe{ string } } + { predicate maybe{ ptx-operand } } ; TUPLE: ptx-entry { name string } @@ -89,7 +89,7 @@ TUPLE: ptx-entry body ; TUPLE: ptx-func < ptx-entry - { return maybe: ptx-variable } ; + { return maybe{ ptx-variable } } ; TUPLE: ptx-directive ; @@ -146,10 +146,10 @@ VARIANT: ptx-mul-mode .wide ; TUPLE: ptx-mul-instruction < ptx-3op-instruction - { mode maybe: ptx-mul-mode } ; + { mode maybe{ ptx-mul-mode } } ; TUPLE: ptx-mad-instruction < ptx-4op-instruction - { mode maybe: ptx-mul-mode } + { mode maybe{ ptx-mul-mode } } { sat? boolean } ; VARIANT: ptx-prmt-mode @@ -158,7 +158,7 @@ VARIANT: ptx-prmt-mode ROLE: ptx-float-ftz { ftz? boolean } ; ROLE: ptx-float-env < ptx-float-ftz - { round maybe: ptx-float-rounding-mode } ; + { round maybe{ ptx-float-rounding-mode } } ; VARIANT: ptx-testp-op .finite .infinite .number .notanumber .normal .subnormal ; @@ -183,8 +183,8 @@ INSTANCE: .hi ptx-cmp-op TUPLE: ptx-set-instruction < ptx-3op-instruction { cmp-op ptx-cmp-op } - { bool-op maybe: ptx-op } - { c maybe: ptx-operand } + { bool-op maybe{ ptx-op } } + { c maybe{ ptx-operand } } { ftz? boolean } ; VARIANT: ptx-cache-op @@ -193,8 +193,8 @@ VARIANT: ptx-cache-op TUPLE: ptx-ldst-instruction < ptx-2op-instruction { volatile? boolean } - { storage-space maybe: ptx-storage-space } - { cache-op maybe: ptx-cache-op } ; + { storage-space maybe{ ptx-storage-space } } + { cache-op maybe{ ptx-cache-op } } ; VARIANT: ptx-cache-level .L1 .L2 ; @@ -216,19 +216,19 @@ TUPLE: add <{ ptx-addsub-instruction ptx-float-env } ; TUPLE: addc < ptx-addsub-instruction ; TUPLE: and < ptx-3op-instruction ; TUPLE: atom < ptx-3op-instruction - { storage-space maybe: ptx-storage-space } + { storage-space maybe{ ptx-storage-space } } { op ptx-op } - { c maybe: ptx-operand } ; + { c maybe{ ptx-operand } } ; TUPLE: bar.arrive < ptx-instruction { a ptx-operand } { b ptx-operand } ; TUPLE: bar.red < ptx-2op-instruction { op ptx-op } - { b maybe: ptx-operand } + { b maybe{ ptx-operand } } { c ptx-operand } ; TUPLE: bar.sync < ptx-instruction { a ptx-operand } - { b maybe: ptx-operand } ; + { b maybe{ ptx-operand } } ; TUPLE: bfe < ptx-4op-instruction ; TUPLE: bfi < ptx-5op-instruction ; TUPLE: bfind < ptx-2op-instruction @@ -237,20 +237,20 @@ TUPLE: bra < ptx-branch-instruction ; TUPLE: brev < ptx-2op-instruction ; TUPLE: brkpt < ptx-instruction ; TUPLE: call < ptx-branch-instruction - { return maybe: ptx-operand } + { return maybe{ ptx-operand } } params ; TUPLE: clz < ptx-2op-instruction ; TUPLE: cnot < ptx-2op-instruction ; TUPLE: copysign < ptx-3op-instruction ; TUPLE: cos <{ ptx-2op-instruction ptx-float-env } ; TUPLE: cvt < ptx-2op-instruction - { round maybe: ptx-rounding-mode } + { round maybe{ ptx-rounding-mode } } { ftz? boolean } { sat? boolean } { dest-type ptx-type } ; TUPLE: cvta < ptx-2op-instruction { to? boolean } - { storage-space maybe: ptx-storage-space } ; + { storage-space maybe{ ptx-storage-space } } ; TUPLE: div <{ ptx-3op-instruction ptx-float-env } ; TUPLE: ex2 <{ ptx-2op-instruction ptx-float-env } ; TUPLE: exit < ptx-instruction ; @@ -279,16 +279,16 @@ TUPLE: pmevent < ptx-instruction TUPLE: popc < ptx-2op-instruction ; TUPLE: prefetch < ptx-instruction { a ptx-operand } - { storage-space maybe: ptx-storage-space } + { storage-space maybe{ ptx-storage-space } } { level ptx-cache-level } ; TUPLE: prefetchu < ptx-instruction { a ptx-operand } { level ptx-cache-level } ; TUPLE: prmt < ptx-4op-instruction - { mode maybe: ptx-prmt-mode } ; + { mode maybe{ ptx-prmt-mode } } ; TUPLE: rcp <{ ptx-2op-instruction ptx-float-env } ; TUPLE: red < ptx-2op-instruction - { storage-space maybe: ptx-storage-space } + { storage-space maybe{ ptx-storage-space } } { op ptx-op } ; TUPLE: rem < ptx-3op-instruction ; TUPLE: ret < ptx-instruction ; @@ -298,7 +298,7 @@ TUPLE: selp < ptx-4op-instruction ; TUPLE: set < ptx-set-instruction { dest-type ptx-type } ; TUPLE: setp < ptx-set-instruction - { |dest maybe: ptx-operand } ; + { |dest maybe{ ptx-operand } } ; TUPLE: shl < ptx-3op-instruction ; TUPLE: shr < ptx-3op-instruction ; TUPLE: sin <{ ptx-2op-instruction ptx-float-env } ; diff --git a/extra/gpu/framebuffers/framebuffers.factor b/extra/gpu/framebuffers/framebuffers.factor index b49db8c8b2..166d385b1f 100644 --- a/extra/gpu/framebuffers/framebuffers.factor +++ b/extra/gpu/framebuffers/framebuffers.factor @@ -88,8 +88,8 @@ M: texture-attachment attachment-object texture>> texture-object ; TUPLE: framebuffer < gpu-object { color-attachments array read-only } - { depth-attachment maybe: framebuffer-attachment read-only initial: f } - { stencil-attachment maybe: framebuffer-attachment read-only initial: f } ; + { depth-attachment maybe{ framebuffer-attachment } read-only initial: f } + { stencil-attachment maybe{ framebuffer-attachment } read-only initial: f } ; UNION: any-framebuffer system-framebuffer framebuffer ; @@ -102,8 +102,8 @@ VARIANT: framebuffer-attachment-face VARIANT: color-attachment-ref default-attachment system-attachment: { - { side maybe: framebuffer-attachment-side initial: f } - { face maybe: framebuffer-attachment-face initial: back-face } + { side maybe{ framebuffer-attachment-side } initial: f } + { face maybe{ framebuffer-attachment-face } initial: back-face } } color-attachment: { { index integer } } ; diff --git a/extra/gpu/render/render.factor b/extra/gpu/render/render.factor index 116ef10274..e9a1d90692 100755 --- a/extra/gpu/render/render.factor +++ b/extra/gpu/render/render.factor @@ -53,7 +53,7 @@ ALIAS: mat4x4-uniform mat4-uniform TUPLE: uniform { name string read-only initial: "" } { uniform-type class read-only initial: float-uniform } - { dim maybe: integer read-only initial: f } ; + { dim maybe{ integer } read-only initial: f } ; VARIANT: index-type ubyte-indexes @@ -80,7 +80,7 @@ TUPLE: index-elements C: index-elements TUPLE: multi-index-elements - { buffer maybe: buffer read-only } + { buffer maybe{ buffer } read-only } { ptrs read-only } { counts uint-array read-only } { index-type index-type read-only } ; @@ -587,8 +587,8 @@ TUPLE: render-set { vertex-array vertex-array initial: T{ vertex-array-collection } read-only } { uniforms uniform-tuple read-only } { indexes vertex-indexes initial: T{ index-range } read-only } - { instances maybe: integer initial: f read-only } - { framebuffer maybe: any-framebuffer initial: system-framebuffer read-only } + { instances maybe{ integer } initial: f read-only } + { framebuffer maybe{ any-framebuffer } initial: system-framebuffer read-only } { output-attachments sequence initial: { default-attachment } read-only } { transform-feedback-output transform-feedback-output initial: f read-only } ; diff --git a/extra/gpu/shaders/shaders.factor b/extra/gpu/shaders/shaders.factor index b68866145b..602e1f3977 100755 --- a/extra/gpu/shaders/shaders.factor +++ b/extra/gpu/shaders/shaders.factor @@ -33,10 +33,10 @@ ERROR: invalid-link-feedback-format-error format ; ERROR: inaccurate-feedback-attribute-error attribute ; TUPLE: vertex-attribute - { name maybe: string read-only initial: f } - { component-type component-type read-only initial: float-components } - { dim integer read-only initial: 4 } - { normalize? boolean read-only initial: f } ; + { name maybe{ string } read-only initial: f } + { component-type component-type read-only initial: float-components } + { dim integer read-only initial: 4 } + { normalize? boolean read-only initial: f } ; MIXIN: vertex-format @@ -54,7 +54,7 @@ TUPLE: program { line integer read-only } { shaders array read-only } { vertex-formats array read-only } - { feedback-format maybe: vertex-format read-only } + { feedback-format maybe{ vertex-format } read-only } { geometry-shader-parameters array read-only } { instances hashtable read-only } ; @@ -524,7 +524,7 @@ DEFER: [ nip ] [ drop link-program ] if ; TUPLE: feedback-format - { vertex-format maybe: vertex-format read-only } ; + { vertex-format maybe{ vertex-format } read-only } ; : validate-feedback-format ( sequence -- vertex-format/f ) dup length 1 <= diff --git a/extra/gpu/state/state.factor b/extra/gpu/state/state.factor index 0f2ce7cb46..c1ff32e3f9 100755 --- a/extra/gpu/state/state.factor +++ b/extra/gpu/state/state.factor @@ -13,14 +13,14 @@ TUPLE: viewport-state C: viewport-state TUPLE: scissor-state - { rect maybe: rect read-only } ; + { rect maybe{ rect } read-only } ; C: scissor-state TUPLE: multisample-state { multisample? boolean read-only } { sample-alpha-to-coverage? boolean read-only } { sample-alpha-to-one? boolean read-only } - { sample-coverage maybe: float read-only } + { sample-coverage maybe{ float } read-only } { invert-sample-coverage? boolean read-only } ; C: multisample-state @@ -44,8 +44,8 @@ TUPLE: stencil-mode C: stencil-mode TUPLE: stencil-state - { front-mode maybe: stencil-mode initial: f read-only } - { back-mode maybe: stencil-mode initial: f read-only } ; + { front-mode maybe{ stencil-mode } initial: f read-only } + { back-mode maybe{ stencil-mode } initial: f read-only } ; C: stencil-state TUPLE: depth-range-state @@ -54,7 +54,7 @@ TUPLE: depth-range-state C: depth-range-state TUPLE: depth-state - { comparison maybe: comparison initial: f read-only } ; + { comparison maybe{ comparison } initial: f read-only } ; C: depth-state VARIANT: blend-equation @@ -81,8 +81,8 @@ C: blend-mode TUPLE: blend-state { constant-color sequence initial: f read-only } - { rgb-mode maybe: blend-mode read-only } - { alpha-mode maybe: blend-mode read-only } ; + { rgb-mode maybe{ blend-mode } read-only } + { alpha-mode maybe{ blend-mode } read-only } ; C: blend-state TUPLE: mask-state @@ -101,7 +101,7 @@ VARIANT: triangle-mode TUPLE: triangle-cull-state { front-face triangle-face initial: face-ccw read-only } - { cull maybe: triangle-cull initial: f read-only } ; + { cull maybe{ triangle-cull } initial: f read-only } ; C: triangle-cull-state TUPLE: triangle-state @@ -114,7 +114,7 @@ VARIANT: point-sprite-origin origin-upper-left origin-lower-left ; TUPLE: point-state - { size maybe: float initial: 1.0 read-only } + { size maybe{ float } initial: 1.0 read-only } { sprite-origin point-sprite-origin initial: origin-upper-left read-only } { fade-threshold float initial: 1.0 read-only } ; C: point-state diff --git a/extra/gpu/textures/textures.factor b/extra/gpu/textures/textures.factor index 5752e4bcf5..53670da424 100644 --- a/extra/gpu/textures/textures.factor +++ b/extra/gpu/textures/textures.factor @@ -69,7 +69,7 @@ UNION: wrap-set texture-wrap sequence ; TUPLE: texture-parameters { wrap wrap-set initial: { repeat-texcoord repeat-texcoord repeat-texcoord } } { min-filter texture-filter initial: filter-nearest } - { min-mipmap-filter maybe: texture-filter initial: filter-linear } + { min-mipmap-filter maybe{ texture-filter } initial: filter-linear } { mag-filter texture-filter initial: filter-linear } { min-lod integer initial: -1000 } { max-lod integer initial: 1000 }