]> gitweb.factorcode.org Git - factor.git/commitdiff
classes:
authorDoug Coleman <doug.coleman@gmail.com>
Fri, 4 May 2012 02:17:41 +0000 (19:17 -0700)
committerDoug Coleman <doug.coleman@gmail.com>
Fri, 4 May 2012 02:45:30 +0000 (19:45 -0700)
- 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.

22 files changed:
basis/compiler/tests/redefine26.factor
basis/compiler/tree/propagation/propagation-tests.factor
basis/dlists/dlists.factor
basis/io/sockets/sockets.factor
basis/prettyprint/backend/backend.factor
basis/prettyprint/prettyprint-tests.factor
basis/typed/typed-tests.factor
core/bootstrap/syntax.factor
core/classes/algebra/algebra.factor
core/classes/intersection/intersection.factor
core/classes/maybe/maybe-tests.factor
core/classes/maybe/maybe.factor
core/classes/union/union.factor
core/compiler/units/units.factor
core/generic/generic.factor
core/syntax/syntax.factor
extra/cuda/ptx/ptx.factor
extra/gpu/framebuffers/framebuffers.factor
extra/gpu/render/render.factor
extra/gpu/shaders/shaders.factor
extra/gpu/state/state.factor
extra/gpu/textures/textures.factor

index 10be39d67591d922a5d2260f2b158152b268c81a..81dbabf1d948856dac03ad1d91914e3fca92110e 100644 (file)
@@ -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 ;
index c22071c319631a4dc3b4fe791e1e1348c50db246..d56faf150ede4b8d8b6834b78925f4ba281bbe01 100644 (file)
@@ -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
index 758b7047080df160e8f89e169c31c2f2888cff10..be968b0dab1b4ad00f10715a4957d4b9bce041f4 100644 (file)
@@ -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 } } ;
 
 : <dlist> ( -- list )
     dlist new ; inline
index b4855c09b6dbaf604675b01bcfa01561246373ec..093989e390239a4ec24c9be7d8f358b0602646f6 100644 (file)
@@ -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 } ;
 
 <PRIVATE
 
@@ -131,7 +131,7 @@ M: inet4 present
 M: inet4 protocol drop 0 ;
 
 TUPLE: ipv6
-{ host maybe: string read-only }
+{ host maybe{ string } read-only }
 { scope-id integer read-only } ;
 
 <PRIVATE
@@ -393,7 +393,7 @@ GENERIC: resolve-host ( addrspec -- seq )
 
 HOOK: resolve-localhost os ( -- obj )
 
-TUPLE: hostname { host maybe: string read-only } ;
+TUPLE: hostname { host maybe{ string } read-only } ;
 
 TUPLE: inet < hostname port ;
 
index 25fb8e612bcaea17ded2f5716b6f05b0659a0c3e..f893c61e703859b3d6da6458a1f60b5339faf91e 100644 (file)
@@ -7,8 +7,10 @@ colors.constants combinators continuations effects generic
 hash-sets hashtables io io.pathnames io.styles kernel
 make math math.order math.parser namespaces prettyprint.config
 prettyprint.custom prettyprint.sections prettyprint.stylesheet
-quotations sbufs sequences strings vectors words words.symbol ;
+quotations sbufs sequences strings vectors words words.symbol
+classes.private ;
 FROM: sets => 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? ] [ <block \ \ pprint-word wrapped>> pprint-word block> ] }
         [ pprint-object ]
     } cond ;
-
-M: maybe pprint*
-    <block \ maybe: pprint-word class>> pprint-class block> ;
index 2eed7b47d26b0ea0d65331e8dc9f3f5b1afcfd87..23d10930e6aa4cec752fa1df07d3d95cd0bf952f 100644 (file)
@@ -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
index 5209038473f4f81f928eb36f5eb0da2ea3e0688e..04714901896ffab78e955c813f94545172191c02 100644 (file)
@@ -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
index 8bd950f3ddccd7460ef962a00cfb378e1114b418..3da99fa49bea6e8c674439b644d7df3786a56528 100644 (file)
@@ -82,7 +82,8 @@ IN: bootstrap.syntax
         "<<"
         ">>"
         "call-next-method"
-        "maybe:"
+        "not{"
+        "maybe{"
         "union{"
         "intersection{"
         "initial:"
index 078cace06b25197b03df218e22b4fae1dab8e583..3610360b6f5ac95d2463fee709299cc808f5becb 100644 (file)
@@ -7,6 +7,8 @@ FROM: classes => members ;
 RENAME: members sets => set-members
 IN: classes.algebra
 
+DEFER: sort-classes
+
 <PRIVATE
 
 TUPLE: anonymous-union { members read-only } ;
@@ -15,7 +17,7 @@ INSTANCE: anonymous-union classoid
 
 : <anonymous-union> ( 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
 
 : <anonymous-intersection> ( 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> 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)
index 20b456648f61d3fa4c6185762403df50b9c41cdd..92f384ded1819e0fd254fa6653808a86104d1598 100644 (file)
@@ -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 -- )
index 5f536e906c780aebef86ae609a9d833a0cd80a21..b8c7374ccbe9af0ab5753d8dafec6367c793b84d 100644 (file)
@@ -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
index 56c57343e1bb66d67704d7aa5e0a95453db391db..8678c1991c0b2956fd1701afbe68493695177a33 100644 (file)
@@ -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 ;
index 385719b552298fbcc34e8620e89d60094c674bb7..b4e59a4a7e2fe7fe9abe8882cb825105d33dc53b 100644 (file)
@@ -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 <anonymous-union> normalize-class ;
 
index 004c7254703f09c533d2ccfe338c374847d601a7..8c6f1601ecfc740012bd21662129fe0c368f3b8c 100644 (file)
@@ -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 ;
 <PRIVATE
 
 : add-once ( key assoc -- )
+    ! 2dup keys swap [ class= ] curry any? [ over redefine-error ] when conjoin ;
     2dup key? [ over redefine-error ] when conjoin ;
 
 : (remember-definition) ( definition loc assoc -- )
index e9c9c349cfe605c77ab96ebfb17f0cae09e71eeb..3e3a13539258de22fe9bf709ad2c872e2f67014d 100644 (file)
@@ -107,13 +107,8 @@ GENERIC: update-generic ( class generic -- )
 : with-methods ( class generic quot -- )
     [ "methods" word-prop ] prepose [ update-generic ] 2bi ; inline
 
-GENERIC# method-word-name 1 ( class generic -- string )
-
-M: class method-word-name ( class generic -- string )
-    [ name>> ] 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 ;
index 361fc0769c29b0c3d8cceb3675f9a82aa77a3423..e356f8d88e7b7cb3e2bf14c9678322ec0148740c 100644 (file)
@@ -246,8 +246,12 @@ IN: bootstrap.syntax
         ] if*
     ] define-core-syntax
 
-    "maybe:" [
-        scan-class <maybe> suffix!
+    "maybe{" [
+        \ } [ <anonymous-union> <maybe> ] parse-literal
+    ] define-core-syntax
+
+    "not{" [
+        \ } [ <anonymous-union> <anonymous-complement> ] parse-literal
     ] define-core-syntax
 
     "intersection{" [
index 6b6d27a7933a21b3665b8c8f8ba8d2a8826457a4..79cd2320073d2691a3fe726715d02d7ec4ea7a0b 100644 (file)
@@ -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 } ;
index b49db8c8b2b8c135370cd9769920389cedaff078..166d385b1f0345d0a2f2a7c18dabff5e26b31666 100644 (file)
@@ -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 } } ;
 
index 116ef10274023b5a7f1db42812c97ef0b8461ece..e9a1d9069284b3baccaebaf6da28e5f17c169f8d 100755 (executable)
@@ -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> 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 } ;
 
index b68866145bcd759d2937baa6c0d8abefc97ff053..602e1f397788b484b53af0da4f138d0569be3e89 100755 (executable)
@@ -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: <shader-instance>
     [ 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 <=
index 0f2ce7cb46e18c7c70cb8b1c2a54265e9d98c14c..c1ff32e3f9300fa83d8367e92df924102083cc6f 100755 (executable)
@@ -13,14 +13,14 @@ TUPLE: viewport-state
 C: <viewport-state> viewport-state
 
 TUPLE: scissor-state
-    { rect maybe: rect read-only } ;
+    { rect maybe{ rect } read-only } ;
 C: <scissor-state> 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> multisample-state
 
@@ -44,8 +44,8 @@ TUPLE: stencil-mode
 C: <stencil-mode> 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> stencil-state
 
 TUPLE: depth-range-state
@@ -54,7 +54,7 @@ TUPLE: depth-range-state
 C: <depth-range-state> depth-range-state
 
 TUPLE: depth-state
-    { comparison maybe: comparison initial: f read-only } ;
+    { comparison maybe{ comparison } initial: f read-only } ;
 C: <depth-state> depth-state
 
 VARIANT: blend-equation
@@ -81,8 +81,8 @@ C: <blend-mode> 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> 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> 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> point-state
index 5752e4bcf5784915167b1e25f2aedb38c647ef62..53670da424bfa0437192f5f8383e56e9ef7a0d7a 100644 (file)
@@ -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 }