diff --git a/apps/webbrowser/webbrowser.factor b/apps/webbrowser/webbrowser.factor index 7553989ecd..51165a0aba 100644 --- a/apps/webbrowser/webbrowser.factor +++ b/apps/webbrowser/webbrowser.factor @@ -6,7 +6,7 @@ sequences strings system ui.operations urls vocabs ; IN: webbrowser -HOOK: open-file os ( path -- ) +HOOK: open-file os ( path -- ) ; "webbrowser." os name>> append require diff --git a/benchmarks/benchmark/binary-trees/binary-trees.factor b/benchmarks/benchmark/binary-trees/binary-trees.factor index a96e6da4ae..55b07219f3 100644 --- a/benchmarks/benchmark/binary-trees/binary-trees.factor +++ b/benchmarks/benchmark/binary-trees/binary-trees.factor @@ -18,7 +18,7 @@ C: tree-node drop f f ] if ; inline recursive -GENERIC: item-check ( node -- n ) +GENERIC: item-check ( node -- n ) ; M: tree-node item-check [ item>> ] [ left>> ] [ right>> ] tri [ item-check ] bi@ - + ; diff --git a/benchmarks/benchmark/dispatch1/dispatch1.factor b/benchmarks/benchmark/dispatch1/dispatch1.factor index d87f04d14c..becffc9f2e 100644 --- a/benchmarks/benchmark/dispatch1/dispatch1.factor +++ b/benchmarks/benchmark/dispatch1/dispatch1.factor @@ -1,7 +1,7 @@ USING: classes classes.tuple kernel sequences vocabs math ; IN: benchmark.dispatch1 -GENERIC: g ( obj -- obj ) +GENERIC: g ( obj -- obj ) ; TUPLE: x1 ; M: x1 g ; diff --git a/benchmarks/benchmark/dispatch3/dispatch3.factor b/benchmarks/benchmark/dispatch3/dispatch3.factor index a1d58474b8..2343899bb1 100644 --- a/benchmarks/benchmark/dispatch3/dispatch3.factor +++ b/benchmarks/benchmark/dispatch3/dispatch3.factor @@ -4,7 +4,7 @@ specialized-arrays bit-arrays ; SPECIALIZED-ARRAY: double IN: benchmark.dispatch3 -GENERIC: g ( obj -- str ) +GENERIC: g ( obj -- str ) ; M: assoc g drop "assoc" ; diff --git a/benchmarks/benchmark/raytracer/raytracer.factor b/benchmarks/benchmark/raytracer/raytracer.factor index c246f1538f..e21c387a78 100644 --- a/benchmarks/benchmark/raytracer/raytracer.factor +++ b/benchmarks/benchmark/raytracer/raytracer.factor @@ -34,7 +34,7 @@ TUPLE: hit { normal double-array read-only } { lambda float read-only } ; C: hit -GENERIC: intersect-scene ( hit ray scene -- hit ) +GENERIC: intersect-scene ( hit ray scene -- hit ) ; TUPLE: sphere { center double-array read-only } { radius float read-only } ; diff --git a/collections/arrays/shaped/shaped.factor b/collections/arrays/shaped/shaped.factor index 70f985c78d..7237e67451 100644 --- a/collections/arrays/shaped/shaped.factor +++ b/collections/arrays/shaped/shaped.factor @@ -7,7 +7,7 @@ IN: arrays.shaped : flat? ( array -- ? ) [ sequence? ] any? not ; inline -GENERIC: array-replace ( object -- shape ) +GENERIC: array-replace ( object -- shape ) ; M: f array-replace ; @@ -26,7 +26,7 @@ C: uniform-shape TUPLE: abnormal-shape shape ; C: abnormal-shape -GENERIC: wrap-shape ( object -- shape ) +GENERIC: wrap-shape ( object -- shape ) ; M: integer wrap-shape 1array ; @@ -38,7 +38,7 @@ M: sequence wrap-shape ] if ; -GENERIC: shape ( array -- shape ) +GENERIC: shape ( array -- shape ) ; M: sequence shape array-replace wrap-shape ; @@ -49,7 +49,7 @@ ERROR: no-negative-shape-components shape ; : check-shape-domain ( seq -- seq ) dup [ 0 < ] any? [ no-negative-shape-components ] when ; -GENERIC: shape-capacity ( shape -- n ) +GENERIC: shape-capacity ( shape -- n ) ; M: sequence shape-capacity check-shape-domain product ; @@ -65,7 +65,7 @@ ERROR: underlying-shape-mismatch underlying shape ; ERROR: no-abnormally-shaped-arrays underlying shape ; -GENERIC: check-underlying-shape ( underlying shape -- underlying shape ) +GENERIC: check-underlying-shape ( underlying shape -- underlying shape ) ; M: abnormal-shape check-underlying-shape no-abnormally-shaped-arrays ; @@ -105,9 +105,9 @@ M: shaped-array shape shape>> ; : ( underlying shape -- shaped-array ) col-array make-shaped-array ; inline -GENERIC: >shaped-array ( array -- shaped-array ) -GENERIC: >row-array ( array -- shaped-array ) -GENERIC: >col-array ( array -- shaped-array ) +GENERIC: >shaped-array ( array -- shaped-array ) ; +GENERIC: >row-array ( array -- shaped-array ) ; +GENERIC: >col-array ( array -- shaped-array ) ; M: sequence >shaped-array [ { } flatten-as ] [ shape ] bi ; @@ -171,7 +171,7 @@ TUPLE: transposed shaped-array ; TUPLE: row-traverser shaped-array index ; -GENERIC: next-index ( object -- index ) +GENERIC: next-index ( object -- index ) ; SYNTAX: sa{ \ } [ >shaped-array ] parse-literal ; diff --git a/collections/assocs/extras/extras.factor b/collections/assocs/extras/extras.factor index d3e6d1ab45..7bbcbe8fe3 100644 --- a/collections/assocs/extras/extras.factor +++ b/collections/assocs/extras/extras.factor @@ -40,7 +40,7 @@ IN: assocs.extras [ [ [ assoc-size ] bi@ + ] [ drop ] 2bi new-assoc ] 2keep [ assoc-merge! ] bi@ ; -GENERIC: delete-value-at ( value assoc -- ) +GENERIC: delete-value-at ( value assoc -- ) ; M: assoc delete-value-at [ value-at* ] keep swap [ delete-at ] [ 2drop ] if ; diff --git a/collections/bit-arrays/bit-arrays.factor b/collections/bit-arrays/bit-arrays.factor index 4274d1b783..ae23dcc927 100644 --- a/collections/bit-arrays/bit-arrays.factor +++ b/collections/bit-arrays/bit-arrays.factor @@ -59,11 +59,11 @@ M: bit-array nth-unsafe M: bit-array set-nth-unsafe bit-index [ toggle-bit ] change-nth-unsafe ; inline -GENERIC: clear-bits ( bit-array -- ) +GENERIC: clear-bits ( bit-array -- ) ; M: bit-array clear-bits 0 (set-bits) ; inline -GENERIC: set-bits ( bit-array -- ) +GENERIC: set-bits ( bit-array -- ) ; M: bit-array set-bits -1 (set-bits) ; inline diff --git a/collections/bitstreams/bitstreams.factor b/collections/bitstreams/bitstreams.factor index f7cb370861..945a640d79 100644 --- a/collections/bitstreams/bitstreams.factor +++ b/collections/bitstreams/bitstreams.factor @@ -62,8 +62,8 @@ TUPLE: lsb0-bit-writer < bit-writer ; : ( -- bs ) lsb0-bit-writer new-bit-writer ; -GENERIC: peek ( n bitstream -- value ) -GENERIC: poke ( value n bitstream -- ) +GENERIC: peek ( n bitstream -- value ) ; +GENERIC: poke ( value n bitstream -- ) ; : get-abp ( bitstream -- abp ) [ byte-pos>> 8 * ] [ bit-pos>> + ] bi ; inline diff --git a/collections/cursors/cursors.factor b/collections/cursors/cursors.factor index 3c928cc02e..027ceb2a2c 100644 --- a/collections/cursors/cursors.factor +++ b/collections/cursors/cursors.factor @@ -12,12 +12,12 @@ IN: cursors MIXIN: cursor -GENERIC: cursor-compatible? ( cursor cursor -- ? ) -GENERIC: cursor-valid? ( cursor -- ? ) -GENERIC: cursor= ( cursor cursor -- ? ) -GENERIC: cursor<= ( cursor cursor -- ? ) -GENERIC: cursor>= ( cursor cursor -- ? ) -GENERIC: cursor-distance-hint ( cursor cursor -- n ) +GENERIC: cursor-compatible? ( cursor cursor -- ? ) ; +GENERIC: cursor-valid? ( cursor -- ? ) ; +GENERIC: cursor= ( cursor cursor -- ? ) ; +GENERIC: cursor<= ( cursor cursor -- ? ) ; +GENERIC: cursor>= ( cursor cursor -- ? ) ; +GENERIC: cursor-distance-hint ( cursor cursor -- n ) ; M: cursor cursor<= cursor= ; inline M: cursor cursor>= cursor= ; inline @@ -30,21 +30,21 @@ M: cursor cursor-distance-hint 2drop 0 ; inline MIXIN: forward-cursor INSTANCE: forward-cursor cursor -GENERIC: inc-cursor ( cursor -- cursor' ) +GENERIC: inc-cursor ( cursor -- cursor' ) ; MIXIN: bidirectional-cursor INSTANCE: bidirectional-cursor forward-cursor -GENERIC: dec-cursor ( cursor -- cursor' ) +GENERIC: dec-cursor ( cursor -- cursor' ) ; MIXIN: random-access-cursor INSTANCE: random-access-cursor bidirectional-cursor -GENERIC# cursor+ 1 ( cursor n -- cursor' ) -GENERIC# cursor- 1 ( cursor n -- cursor' ) -GENERIC: cursor-distance ( cursor cursor -- n ) -GENERIC: cursor< ( cursor cursor -- ? ) -GENERIC: cursor> ( cursor cursor -- ? ) +GENERIC# cursor+ 1 ( cursor n -- cursor' ) ; +GENERIC# cursor- 1 ( cursor n -- cursor' ) ; +GENERIC: cursor-distance ( cursor cursor -- n ) ; +GENERIC: cursor< ( cursor cursor -- ? ) ; +GENERIC: cursor> ( cursor cursor -- ? ) ; M: random-access-cursor inc-cursor 1 cursor+ ; inline M: random-access-cursor dec-cursor -1 cursor+ ; inline @@ -61,9 +61,9 @@ ERROR: invalid-cursor cursor ; MIXIN: input-cursor -GENERIC: cursor-key-value ( cursor -- key value ) +GENERIC: cursor-key-value ( cursor -- key value ) ; M: input-cursor cursor-key-value-unsafe cursor-key-value ; inline M: input-cursor cursor-key-value @@ -83,9 +83,9 @@ M: input-cursor cursor-key-value MIXIN: output-cursor -GENERIC: set-cursor-value ( value cursor -- ) +GENERIC: set-cursor-value ( value cursor -- ) ; M: output-cursor set-cursor-value-unsafe set-cursor-value ; inline M: output-cursor set-cursor-value @@ -114,7 +114,7 @@ INSTANCE: finite-stream-cursor stream-cursor SINGLETON: end-of-stream -GENERIC: cursor-stream-ended? ( cursor -- ? ) +GENERIC: cursor-stream-ended? ( cursor -- ? ) ; M: finite-stream-cursor inc-cursor dup cursor-stream-ended? [ drop end-of-stream ] when ; inline @@ -189,7 +189,7 @@ M: linear-cursor cursor+ M: linear-cursor cursor- [ [ value>> ] [ delta>> ] bi ] dip [ * - ] keep ; inline -GENERIC: up/i ( distance delta -- distance' ) +GENERIC: up/i ( distance delta -- distance' ) ; M: integer up/i [ 1 - + ] keep /i ; inline M: real up/i / ceiling >integer ; inline @@ -223,8 +223,8 @@ M: quadratic-cursor dec-cursor MIXIN: collection -GENERIC: begin-cursor ( collection -- cursor ) -GENERIC: end-cursor ( collection -- cursor ) +GENERIC: begin-cursor ( collection -- cursor ) ; +GENERIC: end-cursor ( collection -- cursor ) ; : all ( collection -- begin end ) [ begin-cursor ] [ end-cursor ] bi ; inline @@ -391,7 +391,7 @@ M: pusher-cursor set-cursor-value growable>> push ; inline : new-growable-cursor ( begin end exemplar -- cursor result ) [ swap cursor-distance-hint ] dip new-resizable [ ] keep ; inline -GENERIC# new-sequence-cursor 1 ( begin end exemplar -- cursor result ) +GENERIC# new-sequence-cursor 1 ( begin end exemplar -- cursor result ) ; M: random-access-cursor new-sequence-cursor [ swap cursor-distance ] dip new-sequence [ begin-cursor ] keep ; inline diff --git a/collections/deques/deques.factor b/collections/deques/deques.factor index 8ecde83a14..ea45f191bc 100644 --- a/collections/deques/deques.factor +++ b/collections/deques/deques.factor @@ -3,17 +3,17 @@ USING: fry kernel sequences ; IN: deques -GENERIC: push-front* ( obj deque -- node ) -GENERIC: push-back* ( obj deque -- node ) -GENERIC: peek-front* ( deque -- obj ? ) -GENERIC: peek-back* ( deque -- obj ? ) -GENERIC: pop-front* ( deque -- ) -GENERIC: pop-back* ( deque -- ) -GENERIC: delete-node ( node deque -- ) -GENERIC: deque-member? ( value deque -- ? ) -GENERIC: clear-deque ( deque -- ) -GENERIC: node-value ( node -- value ) -GENERIC: deque-empty? ( deque -- ? ) +GENERIC: push-front* ( obj deque -- node ) ; +GENERIC: push-back* ( obj deque -- node ) ; +GENERIC: peek-front* ( deque -- obj ? ) ; +GENERIC: peek-back* ( deque -- obj ? ) ; +GENERIC: pop-front* ( deque -- ) ; +GENERIC: pop-back* ( deque -- ) ; +GENERIC: delete-node ( node deque -- ) ; +GENERIC: deque-member? ( value deque -- ? ) ; +GENERIC: clear-deque ( deque -- ) ; +GENERIC: node-value ( node -- value ) ; +GENERIC: deque-empty? ( deque -- ? ) ; ERROR: empty-deque ; diff --git a/collections/disjoint-sets/disjoint-sets.factor b/collections/disjoint-sets/disjoint-sets.factor index 19ab933224..4ece6b9afb 100644 --- a/collections/disjoint-sets/disjoint-sets.factor +++ b/collections/disjoint-sets/disjoint-sets.factor @@ -25,7 +25,7 @@ TUPLE: disjoint-set PRIVATE> -GENERIC: representative ( a disjoint-set -- p ) +GENERIC: representative ( a disjoint-set -- p ) ; M:: disjoint-set representative ( a disjoint-set -- p ) a disjoint-set parents>> at :> p @@ -51,7 +51,7 @@ PRIVATE> : ( -- disjoint-set ) H{ } clone H{ } clone H{ } clone disjoint-set boa ; -GENERIC: add-atom ( a disjoint-set -- ) +GENERIC: add-atom ( a disjoint-set -- ) ; M: disjoint-set add-atom [ dupd parents>> set-at ] @@ -61,24 +61,24 @@ M: disjoint-set add-atom : add-atoms ( seq disjoint-set -- ) '[ _ add-atom ] each ; -GENERIC: disjoint-set-member? ( a disjoint-set -- ? ) +GENERIC: disjoint-set-member? ( a disjoint-set -- ? ) ; M: disjoint-set disjoint-set-member? parents>> key? ; -GENERIC: disjoint-set-members ( disjoint-set -- seq ) +GENERIC: disjoint-set-members ( disjoint-set -- seq ) ; M: disjoint-set disjoint-set-members parents>> keys ; -GENERIC: equiv-set-size ( a disjoint-set -- n ) +GENERIC: equiv-set-size ( a disjoint-set -- n ) ; M: disjoint-set equiv-set-size [ representative ] keep counts>> at ; -GENERIC: equiv? ( a b disjoint-set -- ? ) +GENERIC: equiv? ( a b disjoint-set -- ? ) ; M: disjoint-set equiv? representatives = ; -GENERIC: equate ( a b disjoint-set -- ) +GENERIC: equate ( a b disjoint-set -- ) ; M:: disjoint-set equate ( a b disjoint-set -- ) a b disjoint-set representatives diff --git a/collections/documents/elements/elements.factor b/collections/documents/elements/elements.factor index 3d6538aa36..25c773f9ba 100644 --- a/collections/documents/elements/elements.factor +++ b/collections/documents/elements/elements.factor @@ -4,8 +4,8 @@ USING: arrays combinators documents fry kernel math sequences accessors unicode combinators.short-circuit ; IN: documents.elements -GENERIC: prev-elt ( loc document elt -- newloc ) -GENERIC: next-elt ( loc document elt -- newloc ) +GENERIC: prev-elt ( loc document elt -- newloc ) ; +GENERIC: next-elt ( loc document elt -- newloc ) ; : prev/next-elt ( loc document elt -- start end ) [ prev-elt ] [ next-elt ] 3bi ; diff --git a/collections/hash-sets/wrapped/wrapped.factor b/collections/hash-sets/wrapped/wrapped.factor index 76dc893edc..44ff0ce2c1 100644 --- a/collections/hash-sets/wrapped/wrapped.factor +++ b/collections/hash-sets/wrapped/wrapped.factor @@ -12,7 +12,7 @@ TUPLE: wrapped-key TUPLE: wrapped-hash-set { underlying hash-set read-only } ; -GENERIC: wrap-key ( key wrapped-hash -- wrapped-key ) +GENERIC: wrap-key ( key wrapped-hash -- wrapped-key ) ; >index ] keep ] [ data>> [ set-nth ] 2keep drop ] bi ; inline -GENERIC: heap-compare ( entry1 entry2 heap -- ? ) +GENERIC: heap-compare ( entry1 entry2 heap -- ? ) ; M: min-heap heap-compare drop { entry entry } declare [ key>> ] bi@ after? ; inline diff --git a/collections/io/files/trash/trash.factor b/collections/io/files/trash/trash.factor index 95e729106f..0df3555eb2 100644 --- a/collections/io/files/trash/trash.factor +++ b/collections/io/files/trash/trash.factor @@ -5,7 +5,7 @@ USING: combinators system vocabs ; IN: io.files.trash -HOOK: send-to-trash os ( path -- ) +HOOK: send-to-trash os ( path -- ) ; { { [ os windows? ] [ "io.files.trash.windows" ] } diff --git a/collections/io/serial/serial.factor b/collections/io/serial/serial.factor index 41e7ed3eb1..080ddc4fab 100644 --- a/collections/io/serial/serial.factor +++ b/collections/io/serial/serial.factor @@ -12,9 +12,9 @@ M: invalid-baud summary ( invalid-baud -- string ) baud>> number>string "Baud rate " " not supported" surround ; -HOOK: lookup-baud os ( m -- n ) -HOOK: open-serial os ( serial -- serial' ) -HOOK: default-serial-flags os ( m -- n ) +HOOK: lookup-baud os ( m -- n ) ; +HOOK: open-serial os ( serial -- serial' ) ; +HOOK: default-serial-flags os ( m -- n ) ; M: serial-port dispose* ( serial -- ) stream>> dispose ; : ( path baud -- obj ) diff --git a/collections/lists/lists.factor b/collections/lists/lists.factor index 8bb8b73ea6..3142bd693a 100644 --- a/collections/lists/lists.factor +++ b/collections/lists/lists.factor @@ -6,9 +6,9 @@ IN: lists ! List Protocol MIXIN: list -GENERIC: car ( cons -- car ) -GENERIC: cdr ( cons -- cdr ) -GENERIC: nil? ( object -- ? ) +GENERIC: car ( cons -- car ) ; +GENERIC: cdr ( cons -- cdr ) ; +GENERIC: nil? ( object -- ? ) ; TUPLE: cons-state { car read-only } { cdr read-only } ; @@ -99,6 +99,6 @@ PRIVATE> INSTANCE: cons-state list INSTANCE: +nil+ list -GENERIC: >list ( object -- list ) +GENERIC: >list ( object -- list ) ; M: list >list ; diff --git a/collections/persistent/assocs/assocs.factor b/collections/persistent/assocs/assocs.factor index 59fbd3a51e..ef6d1cb950 100644 --- a/collections/persistent/assocs/assocs.factor +++ b/collections/persistent/assocs/assocs.factor @@ -3,11 +3,11 @@ USING: kernel assocs ; IN: persistent.assocs -GENERIC: new-at ( value key assoc -- assoc' ) +GENERIC: new-at ( value key assoc -- assoc' ) ; M: assoc new-at clone [ set-at ] keep ; -GENERIC: pluck-at ( key assoc -- assoc' ) +GENERIC: pluck-at ( key assoc -- assoc' ) ; M: assoc pluck-at clone [ delete-at ] keep ; diff --git a/collections/persistent/hashtables/nodes/nodes.factor b/collections/persistent/hashtables/nodes/nodes.factor index d681cd57fa..0f9e8d021e 100644 --- a/collections/persistent/hashtables/nodes/nodes.factor +++ b/collections/persistent/hashtables/nodes/nodes.factor @@ -38,13 +38,13 @@ TUPLE: bitmap-node [ nip ] [ over first hashcode>> bitmap-node boa ] if ; -GENERIC: (entry-at) ( key hashcode node -- entry ) +GENERIC: (entry-at) ( key hashcode node -- entry ) ; -GENERIC: (new-at) ( shift value key hashcode node -- node' added-leaf ) +GENERIC: (new-at) ( shift value key hashcode node -- node' added-leaf ) ; -GENERIC: (pluck-at) ( key hashcode node -- node' ) +GENERIC: (pluck-at) ( key hashcode node -- node' ) ; -GENERIC: >alist% ( node -- ) +GENERIC: >alist% ( node -- ) ; : >alist-each% ( nodes -- ) [ >alist% ] each ; diff --git a/collections/persistent/heaps/heaps.factor b/collections/persistent/heaps/heaps.factor index 7d39053379..499c915d17 100644 --- a/collections/persistent/heaps/heaps.factor +++ b/collections/persistent/heaps/heaps.factor @@ -34,7 +34,7 @@ PRIVATE> : both-with? ( obj a b quot -- ? ) swap [ with ] dip swap both? ; inline -GENERIC: sift-down ( value prio left right -- heap ) +GENERIC: sift-down ( value prio left right -- heap ) ; : singleton-sift-down ( value prio singleton empty -- heap ) 2over prio>> <= [ ] [ @@ -61,11 +61,11 @@ M: branch sift-down ! both arguments are branches ] if ; PRIVATE> -GENERIC: pheap-peek ( heap -- value prio ) +GENERIC: pheap-peek ( heap -- value prio ) ; M: empty-heap pheap-peek empty-pheap ; M: branch pheap-peek [ value>> ] [ prio>> ] bi ; -GENERIC: pheap-push ( value prio heap -- newheap ) +GENERIC: pheap-push ( value prio heap -- newheap ) ; M: empty-heap pheap-push drop ; diff --git a/collections/persistent/sequences/sequences.factor b/collections/persistent/sequences/sequences.factor index 8f9cbe83c8..b2caaf6088 100644 --- a/collections/persistent/sequences/sequences.factor +++ b/collections/persistent/sequences/sequences.factor @@ -3,15 +3,15 @@ USING: sequences kernel ; IN: persistent.sequences -GENERIC: ppush ( val seq -- seq' ) +GENERIC: ppush ( val seq -- seq' ) ; M: sequence ppush swap suffix ; -GENERIC: ppop ( seq -- seq' ) +GENERIC: ppop ( seq -- seq' ) ; M: sequence ppop but-last ; -GENERIC: new-nth ( val i seq -- seq' ) +GENERIC: new-nth ( val i seq -- seq' ) ; M: sequence new-nth clone [ set-nth ] keep ; diff --git a/collections/sequences/cords/cords.factor b/collections/sequences/cords/cords.factor index 766fbe87c0..e0ddca4168 100644 --- a/collections/sequences/cords/cords.factor +++ b/collections/sequences/cords/cords.factor @@ -22,7 +22,7 @@ M: cord virtual@ INSTANCE: cord virtual-sequence -GENERIC: cord-append ( seq1 seq2 -- cord ) +GENERIC: cord-append ( seq1 seq2 -- cord ) ; M: object cord-append generic-cord boa ; inline diff --git a/collections/sequences/deep/deep.factor b/collections/sequences/deep/deep.factor index 86388a8af0..f25bbc38bc 100644 --- a/collections/sequences/deep/deep.factor +++ b/collections/sequences/deep/deep.factor @@ -5,7 +5,7 @@ IN: sequences.deep ! All traversal goes in postorder -GENERIC: branch? ( object -- ? ) +GENERIC: branch? ( object -- ? ) ; M: sequence branch? drop t ; M: integer branch? drop f ; diff --git a/collections/sequences/modified/modified.factor b/collections/sequences/modified/modified.factor index 8b2132c6d2..05196187ee 100644 --- a/collections/sequences/modified/modified.factor +++ b/collections/sequences/modified/modified.factor @@ -6,11 +6,11 @@ IN: sequences.modified TUPLE: modified ; -GENERIC: modified-nth ( n seq -- elt ) +GENERIC: modified-nth ( n seq -- elt ) ; M: modified nth modified-nth ; M: modified nth-unsafe modified-nth ; -GENERIC: modified-set-nth ( elt n seq -- ) +GENERIC: modified-set-nth ( elt n seq -- ) ; M: modified set-nth modified-set-nth ; M: modified set-nth-unsafe modified-set-nth ; diff --git a/collections/specialized-arrays/specialized-arrays.factor b/collections/specialized-arrays/specialized-arrays.factor index 7976a5c148..24100a7eee 100644 --- a/collections/specialized-arrays/specialized-arrays.factor +++ b/collections/specialized-arrays/specialized-arrays.factor @@ -17,7 +17,7 @@ INSTANCE: specialized-array sequence : ( n type -- array ) heap-size * ; inline -GENERIC: underlying-type ( c-type -- c-type' ) +GENERIC: underlying-type ( c-type -- c-type' ) ; M: c-type-word underlying-type dup "c-type" word-prop { @@ -32,8 +32,8 @@ M: pointer underlying-type ; inline M: byte-array direct-like drop uchar ; inline diff --git a/collections/trees/avl/avl.factor b/collections/trees/avl/avl.factor index 5e670abe1f..20cf8e94af 100644 --- a/collections/trees/avl/avl.factor +++ b/collections/trees/avl/avl.factor @@ -131,7 +131,7 @@ M: avl set-at ( value key node -- ) left [ replace-with-a-child ] with-side ] if ; -GENERIC: avl-delete ( key node -- node shorter? deleted? ) +GENERIC: avl-delete ( key node -- node shorter? deleted? ) ; M: f avl-delete ( key f -- f f f ) nip f f ; diff --git a/core/alien/alien.factor b/core/alien/alien.factor index 725307ffe6..25d94d40eb 100755 --- a/core/alien/alien.factor +++ b/core/alien/alien.factor @@ -21,7 +21,7 @@ PREDICATE: pinned-alien < alien underlying>> not ; UNION: pinned-c-ptr pinned-alien postpone: f ; -GENERIC: element-size ( seq -- n ) flushable +GENERIC: element-size ( seq -- n ) ; flushable M: byte-array element-size drop 1 ; inline @@ -31,11 +31,11 @@ M: slice element-size seq>> element-size ; inline M: f element-size drop 1 ; inline -GENERIC: byte-length ( obj -- n ) flushable +GENERIC: byte-length ( obj -- n ) ; flushable M: object byte-length [ length ] [ element-size ] bi * ; inline -GENERIC: >c-ptr ( obj -- c-ptr ) flushable +GENERIC: >c-ptr ( obj -- c-ptr ) ; flushable M: c-ptr >c-ptr ; inline @@ -50,7 +50,7 @@ M: object >c-ptr underlying>> ; inline : binary-object ( obj -- c-ptr n ) [ >c-ptr ] [ byte-length ] bi ; inline -GENERIC: expired? ( c-ptr -- ? ) flushable +GENERIC: expired? ( c-ptr -- ? ) ; flushable M: alien expired? expired>> ; diff --git a/core/alien/c-types/c-types-tests.factor b/core/alien/c-types/c-types-tests.factor index 50b6abeba2..dd202cc450 100644 --- a/core/alien/c-types/c-types-tests.factor +++ b/core/alien/c-types/c-types-tests.factor @@ -128,7 +128,7 @@ must-fail-with "IN: alien.c-types.tests use: alien.syntax use: alien.c-types -GENERIC: foo-func ( x -- ) +GENERIC: foo-func ( x -- ) ; " eval( -- ) "IN: alien.c-types.tests @@ -141,7 +141,7 @@ CALLBACK: void foo-func ( ) "IN: alien.c-types.tests use: alien.syntax use: alien.c-types -GENERIC: foo-func ( x -- ) +GENERIC: foo-func ( x -- ) ; " eval( -- ) "IN: alien.c-types.tests diff --git a/core/alien/c-types/c-types.factor b/core/alien/c-types/c-types.factor index e63c13aeac..625eb8a0b1 100644 --- a/core/alien/c-types/c-types.factor +++ b/core/alien/c-types/c-types.factor @@ -42,7 +42,7 @@ ERROR: no-c-type word ; M: no-c-type summary drop "Not a C type" ; ! C type protocol -GENERIC: lookup-c-type ( name -- c-type ) foldable +GENERIC: lookup-c-type ( name -- c-type ) ; foldable PREDICATE: c-type-word < word "c-type" word-prop >boolean ; @@ -61,57 +61,57 @@ M: word lookup-c-type dup "c-type" word-prop resolve-typedef [ ] [ no-c-type ] ?if ; -GENERIC: c-type-class ( name -- class ) +GENERIC: c-type-class ( name -- class ) ; M: abstract-c-type c-type-class class>> ; -GENERIC: c-type-boxed-class ( name -- class ) +GENERIC: c-type-boxed-class ( name -- class ) ; M: abstract-c-type c-type-boxed-class boxed-class>> ; -GENERIC: c-type-boxer-quot ( name -- quot ) +GENERIC: c-type-boxer-quot ( name -- quot ) ; M: abstract-c-type c-type-boxer-quot boxer-quot>> ; -GENERIC: c-type-unboxer-quot ( name -- quot ) +GENERIC: c-type-unboxer-quot ( name -- quot ) ; M: abstract-c-type c-type-unboxer-quot unboxer-quot>> ; -GENERIC: c-type-rep ( name -- rep ) +GENERIC: c-type-rep ( name -- rep ) ; M: c-type c-type-rep rep>> ; -GENERIC: c-type-getter ( name -- quot ) +GENERIC: c-type-getter ( name -- quot ) ; M: c-type c-type-getter getter>> ; -GENERIC: c-type-copier ( name -- quot ) +GENERIC: c-type-copier ( name -- quot ) ; M: c-type c-type-copier drop [ ] ; -GENERIC: c-type-setter ( name -- quot ) +GENERIC: c-type-setter ( name -- quot ) ; M: c-type c-type-setter setter>> ; -GENERIC: c-type-signed ( name -- boolean ) foldable +GENERIC: c-type-signed ( name -- boolean ) ; foldable M: abstract-c-type c-type-signed signed>> ; -GENERIC: c-type-align ( name -- n ) foldable +GENERIC: c-type-align ( name -- n ) ; foldable M: abstract-c-type c-type-align align>> ; -GENERIC: c-type-align-first ( name -- n ) +GENERIC: c-type-align-first ( name -- n ) ; M: abstract-c-type c-type-align-first align-first>> ; -GENERIC: base-type ( c-type -- c-type ) +GENERIC: base-type ( c-type -- c-type ) ; M: c-type-name base-type lookup-c-type ; M: c-type base-type ; -GENERIC: heap-size ( name -- size ) +GENERIC: heap-size ( name -- size ) ; M: abstract-c-type heap-size size>> ; diff --git a/core/alien/libraries/libraries.factor b/core/alien/libraries/libraries.factor index e531e153ac..126b51c746 100755 --- a/core/alien/libraries/libraries.factor +++ b/core/alien/libraries/libraries.factor @@ -17,7 +17,7 @@ PRIMITIVE: (dlsym-raw) ( name dll -- alien ) ; : dlsym-raw ( name dll -- alien ) [ string>symbol ] dip (dlsym-raw) ; -HOOK: dlerror os ( -- message/f ) +HOOK: dlerror os ( -- message/f ) ; symbol: libraries @@ -30,7 +30,7 @@ C: library : lookup-library ( name -- library ) libraries get at ; ERROR: no-library-named name ; -GENERIC: dlsym? ( name string/dll -- ? ) +GENERIC: dlsym? ( name string/dll -- ? ) ; M: string dlsym? dup lookup-library [ nip dll>> dlsym? ] [ no-library-named ] if* ; M: dll dlsym? dlsym >boolean ; @@ -98,7 +98,7 @@ deploy-libraries [ V{ } clone ] initialize [ deploy-libraries get 2dup member? [ 2drop ] [ push ] if ] [ "deploy-library failure" no-such-library ] if ; -HOOK: >deployed-library-path os ( path -- path' ) +HOOK: >deployed-library-path os ( path -- path' ) ; ! { ! { [ os windows? ] [ "alien.libraries.windows" ] } diff --git a/core/alien/strings/strings.factor b/core/alien/strings/strings.factor index d0c3704f0c..32d3deb85a 100644 --- a/core/alien/strings/strings.factor +++ b/core/alien/strings/strings.factor @@ -7,7 +7,7 @@ namespaces sequences sequences.private strings strings.private system system.private ; in: alien.strings -GENERIC# alien>string 1 ( c-ptr encoding -- string/f ) +GENERIC# alien>string 1 ( c-ptr encoding -- string/f ) ; M: c-ptr alien>string [ ] [ ] bi* @@ -24,7 +24,7 @@ ERROR: invalid-c-string string ; : check-string ( string -- ) 0 over member-eq? [ invalid-c-string ] [ drop ] if ; -GENERIC# string>alien 1 ( string encoding -- byte-array ) +GENERIC# string>alien 1 ( string encoding -- byte-array ) ; M: c-ptr string>alien drop ; @@ -60,7 +60,7 @@ M: string string>alien M: tuple string>alien drop underlying>> ; -HOOK: native-string-encoding os ( -- encoding ) foldable +HOOK: native-string-encoding os ( -- encoding ) ; foldable M: unix native-string-encoding utf8 ; @@ -75,13 +75,13 @@ M: windows native-string-encoding utf16n ; : dll-path ( dll -- string ) path>> alien>native-string ; -GENERIC: string>symbol ( str/seq -- alien ) +GENERIC: string>symbol ( str/seq -- alien ) ; M: string string>symbol utf8 string>alien ; M: sequence string>symbol [ utf8 string>alien ] map ; -GENERIC: symbol>string ( symbol(s) -- string ) +GENERIC: symbol>string ( symbol(s) -- string ) ; M: byte-array symbol>string utf8 alien>string ; diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 6210cc42b7..f969d08f50 100644 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -6,18 +6,18 @@ in: assocs mixin: assoc -GENERIC: at* ( key assoc -- value/f ? ) -GENERIC: value-at* ( value assoc -- key/f ? ) -GENERIC: set-at ( value key assoc -- ) -GENERIC: new-assoc ( capacity exemplar -- newassoc ) -GENERIC: delete-at ( key assoc -- ) -GENERIC: clear-assoc ( assoc -- ) -GENERIC: assoc-size ( assoc -- n ) -GENERIC: assoc-like ( assoc exemplar -- newassoc ) -GENERIC: assoc-clone-like ( assoc exemplar -- newassoc ) -GENERIC: >alist ( assoc -- newassoc ) -GENERIC: keys ( assoc -- keys ) -GENERIC: values ( assoc -- values ) +GENERIC: at* ( key assoc -- value/f ? ) ; +GENERIC: value-at* ( value assoc -- key/f ? ) ; +GENERIC: set-at ( value key assoc -- ) ; +GENERIC: new-assoc ( capacity exemplar -- newassoc ) ; +GENERIC: delete-at ( key assoc -- ) ; +GENERIC: clear-assoc ( assoc -- ) ; +GENERIC: assoc-size ( assoc -- n ) ; +GENERIC: assoc-like ( assoc exemplar -- newassoc ) ; +GENERIC: assoc-clone-like ( assoc exemplar -- newassoc ) ; +GENERIC: >alist ( assoc -- newassoc ) ; +GENERIC: keys ( assoc -- keys ) ; +GENERIC: values ( assoc -- values ) ; M: assoc assoc-like drop ; inline diff --git a/core/checksums/checksums.factor b/core/checksums/checksums.factor index c3c0ef9a6c..7b7da5c9ac 100644 --- a/core/checksums/checksums.factor +++ b/core/checksums/checksums.factor @@ -19,11 +19,11 @@ M: checksum-state clone call-next-method [ clone ] change-bytes ; -GENERIC: initialize-checksum-state ( checksum -- checksum-state ) +GENERIC: initialize-checksum-state ( checksum -- checksum-state ) ; -GENERIC: checksum-block ( bytes checksum-state -- ) +GENERIC: checksum-block ( bytes checksum-state -- ) ; -GENERIC: get-checksum ( checksum-state -- value ) +GENERIC: get-checksum ( checksum-state -- value ) ; : add-checksum-bytes ( checksum-state data -- checksum-state ) over bytes>> [ push-all ] keep @@ -43,11 +43,11 @@ GENERIC: get-checksum ( checksum-state -- value ) : add-checksum-file ( checksum-state path -- checksum-state ) normalize-path (file-reader) add-checksum-stream ; -GENERIC: checksum-bytes ( bytes checksum -- value ) +GENERIC: checksum-bytes ( bytes checksum -- value ) ; -GENERIC: checksum-stream ( stream checksum -- value ) +GENERIC: checksum-stream ( stream checksum -- value ) ; -GENERIC: checksum-lines ( lines checksum -- value ) +GENERIC: checksum-lines ( lines checksum -- value ) ; M: checksum checksum-stream [ stream-contents ] dip checksum-bytes ; diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index 8c5b5bb8d6..671f2c9f47 100644 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -61,15 +61,15 @@ DEFER: (class<=) DEFER: (class-not) -GENERIC: (classes-intersect?) ( first second -- ? ) +GENERIC: (classes-intersect?) ( first second -- ? ) ; DEFER: (class-and) DEFER: (class-or) -GENERIC: (flatten-class) ( class -- ) +GENERIC: (flatten-class) ( class -- ) ; -GENERIC: normalize-class ( class -- class' ) +GENERIC: normalize-class ( class -- class' ) ; M: object normalize-class ; diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor index 936db22b61..58407caf48 100644 --- a/core/classes/classes-tests.factor +++ b/core/classes/classes-tests.factor @@ -10,7 +10,7 @@ in: classes.tests { f } [ 3 null instance? ] unit-test ! Regression -GENERIC: method-forget-test ( obj -- obj ) +GENERIC: method-forget-test ( obj -- obj ) ; TUPLE: method-forget-class ; M: method-forget-class method-forget-test ; @@ -31,7 +31,7 @@ use: multiline ! So the user has some code... { } [ "IN: classes.test.a - GENERIC: g ( a -- b ) + GENERIC: g ( a -- b ) ; TUPLE: x ; M: x g ; TUPLE: z < x ;" @@ -50,7 +50,7 @@ use: multiline ! Now, the user removes the z class and adds a method, { } [ "IN: classes.test.a - GENERIC: g ( a -- b ) + GENERIC: g ( a -- b ) ; TUPLE: x ; M: x g ; TUPLE: j ; @@ -71,7 +71,7 @@ use: multiline { } [ "IN: classes.test.c USE: kernel - GENERIC: g ( a -- b ) + GENERIC: g ( a -- b ) ; M: object g ; TUPLE: z ;" "class-intersect-no-method-c" parse-stream drop @@ -89,7 +89,7 @@ use: multiline { } [ "IN: classes.test.c USE: kernel - GENERIC: g ( a -- b ) + GENERIC: g ( a -- b ) ; M: object g ; TUPLE: j ; M: j g ;" @@ -107,7 +107,7 @@ TUPLE: forgotten-predicate-test ; { } [ [ \ forgotten-predicate-test forget ] with-compilation-unit ] unit-test { f } [ \ forgotten-predicate-test? predicate? ] unit-test -GENERIC: generic-predicate? ( a -- b ) +GENERIC: generic-predicate? ( a -- b ) ; { } [ "IN: classes.tests TUPLE: generic-predicate ;" eval( -- ) ] unit-test diff --git a/core/classes/classes.factor b/core/classes/classes.factor index c659b2d9a4..7444381879 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -43,13 +43,13 @@ symbol: update-map symbol: implementors-map -GENERIC: class-name ( class -- string ) +GENERIC: class-name ( class -- string ) ; M: class class-name name>> ; -GENERIC: rank-class ( class -- n ) +GENERIC: rank-class ( class -- n ) ; -GENERIC: reset-class ( class -- ) +GENERIC: reset-class ( class -- ) ; M: class reset-class { @@ -74,11 +74,11 @@ PREDICATE: predicate < word "predicating" word-prop >boolean ; [ name>> "?" append ] [ vocabulary>> ] bi create-word dup predicate? [ dup reset-generic ] unless ; -GENERIC: class-of ( object -- class ) +GENERIC: class-of ( object -- class ) ; -GENERIC: instance? ( object class -- ? ) flushable +GENERIC: instance? ( object class -- ? ) ; flushable -GENERIC: predicate-def ( obj -- quot ) +GENERIC: predicate-def ( obj -- quot ) ; M: word predicate-def "predicate" word-prop ; @@ -121,7 +121,7 @@ M: predicate reset-word ! Output f for non-classes to work with algebra code dup class? [ "participants" word-prop ] [ drop f ] if ; -GENERIC: implementors ( class/classes -- seq ) +GENERIC: implementors ( class/classes -- seq ) ; ! update-map : class-uses ( class -- seq ) @@ -166,7 +166,7 @@ M: sequence implementors [ implementors ] gather ; } spread ] H{ } make ; -GENERIC: metaclass-changed ( use class -- ) +GENERIC: metaclass-changed ( use class -- ) ; : ?metaclass-changed ( class usages/f -- ) [ [ metaclass-changed ] with each ] [ drop ] if* ; @@ -201,11 +201,11 @@ GENERIC: metaclass-changed ( use class -- ) [ nip ?metaclass-changed ] } 3cleave ; -GENERIC: update-class ( class -- ) +GENERIC: update-class ( class -- ) ; M: class update-class drop ; -GENERIC: update-methods ( class seq -- ) +GENERIC: update-methods ( class seq -- ) ; : update-classes ( class -- ) dup class-usages @@ -226,7 +226,7 @@ GENERIC: update-methods ( class seq -- ) [ forget ] [ drop ] if ] [ 2drop ] if ; -GENERIC: forget-methods ( class -- ) +GENERIC: forget-methods ( class -- ) ; PRIVATE> diff --git a/core/classes/error/error-tests.factor b/core/classes/error/error-tests.factor index 892b313683..482523ff4a 100644 --- a/core/classes/error/error-tests.factor +++ b/core/classes/error/error-tests.factor @@ -17,7 +17,7 @@ DEFER: error-y { } [ [ \ error-y dup class? [ forget-class ] [ drop ] if ] with-compilation-unit ] unit-test -{ } [ "IN: classes.error.tests GENERIC: error-y ( a -- b )" eval( -- ) ] unit-test +{ } [ "IN: classes.error.tests GENERIC: error-y ( a -- b )" eval( -- ) ; ] unit-test { f } [ \ error-y tuple-class? ] unit-test diff --git a/core/classes/intersection/intersection-tests.factor b/core/classes/intersection/intersection-tests.factor index 43713781d8..817afa3bcb 100644 --- a/core/classes/intersection/intersection-tests.factor +++ b/core/classes/intersection/intersection-tests.factor @@ -8,7 +8,7 @@ INSTANCE: a3 b INSTANCE: a1 b INTERSECTION: c a2 b ; -GENERIC: x ( a -- b ) +GENERIC: x ( a -- b ) ; M: c x drop c ; M: a x drop a ; @@ -29,7 +29,7 @@ TUPLE: t4 < t2 ; TUPLE: t5 < t2 ; UNION: m t4 t5 t3 ; INTERSECTION: i t2 m ; -GENERIC: g ( a -- b ) +GENERIC: g ( a -- b ) ; M: i g drop i ; M: t4 g drop t4 ; diff --git a/core/classes/maybe/maybe-tests.factor b/core/classes/maybe/maybe-tests.factor index e217d80649..6434d2710a 100644 --- a/core/classes/maybe/maybe-tests.factor +++ b/core/classes/maybe/maybe-tests.factor @@ -46,7 +46,7 @@ UNION: ?integer-float maybe{ integer } maybe{ float } ; { f } [ t ?integer-float instance? ] unit-test TUPLE: foo ; -GENERIC: lol ( obj -- string ) +GENERIC: lol ( obj -- string ) ; M: maybe{ foo } lol drop "lol" ; { "lol" } [ foo new lol ] unit-test @@ -54,7 +54,7 @@ M: maybe{ foo } lol drop "lol" ; [ 3 lol ] [ no-method? ] must-fail-with TUPLE: foo2 a ; -GENERIC: lol2 ( obj -- string ) +GENERIC: lol2 ( obj -- string ) ; M: maybe{ foo } lol2 drop "lol2" ; M: f lol2 drop "lol22" ; diff --git a/core/classes/mixin/mixin-tests.factor b/core/classes/mixin/mixin-tests.factor index 2d23fab168..f3537ef6b3 100644 --- a/core/classes/mixin/mixin-tests.factor +++ b/core/classes/mixin/mixin-tests.factor @@ -15,7 +15,7 @@ mixin: assoc-mixin INSTANCE: hashtable assoc-mixin -GENERIC: collection-size ( x -- y ) +GENERIC: collection-size ( x -- y ) ; M: sequence-mixin collection-size length ; @@ -58,7 +58,7 @@ use: io.streams.string "IN: classes.mixin.tests" "MIXIN: mixin-forget-test" "INSTANCE: sequence mixin-forget-test" - "GENERIC: mixin-forget-test-g ( x -- y )" + "GENERIC: mixin-forget-test-g ( x -- y ) ;" "M: mixin-forget-test mixin-forget-test-g ;" } "\n" join "mixin-forget-test" parse-stream drop @@ -73,7 +73,7 @@ use: io.streams.string "IN: classes.mixin.tests" "MIXIN: mixin-forget-test" "INSTANCE: hashtable mixin-forget-test" - "GENERIC: mixin-forget-test-g ( x -- y )" + "GENERIC: mixin-forget-test-g ( x -- y ) ;" "M: mixin-forget-test mixin-forget-test-g ;" } "\n" join "mixin-forget-test" parse-stream drop @@ -133,7 +133,7 @@ mixin: metaclass-change-mixin TUPLE: metaclass-change ; INSTANCE: metaclass-change metaclass-change-mixin -GENERIC: metaclass-change-generic ( a -- b ) +GENERIC: metaclass-change-generic ( a -- b ) ; M: metaclass-change-mixin metaclass-change-generic ; diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index 06541b5edd..a31e93c51a 100644 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -68,7 +68,7 @@ ERROR: check-mixin-class-error class ; PRIVATE> -GENERIC# add-mixin-instance 1 ( class mixin -- ) +GENERIC# add-mixin-instance 1 ( class mixin -- ) ; M: class add-mixin-instance [ 2drop ] [ (add-mixin-instance) ] if-mixin-member? ; diff --git a/core/classes/predicate/predicate-tests.factor b/core/classes/predicate/predicate-tests.factor index 35b4f68f68..984ba28f83 100644 --- a/core/classes/predicate/predicate-tests.factor +++ b/core/classes/predicate/predicate-tests.factor @@ -12,7 +12,7 @@ PREDICATE: positive < integer 0 > ; { f } [ negative negative class< ] unit-test { f } [ positive negative class< ] unit-test -GENERIC: abs ( n -- n ) +GENERIC: abs ( n -- n ) ; M: integer abs ; M: negative abs -1 * ; M: positive abs ; @@ -27,7 +27,7 @@ TUPLE: tuple-b < tuple-a ; PREDICATE: tuple-c < tuple-b slot>> ; -GENERIC: ptest ( tuple -- x ) +GENERIC: ptest ( tuple -- x ) ; M: tuple-a ptest drop tuple-a ; M: tuple-c ptest drop tuple-c ; @@ -36,7 +36,7 @@ M: tuple-c ptest drop tuple-c ; PREDICATE: tuple-d < tuple-a slot>> ; -GENERIC: ptest' ( tuple -- x ) +GENERIC: ptest' ( tuple -- x ) ; M: tuple-a ptest' drop tuple-a ; M: tuple-d ptest' drop tuple-d ; @@ -61,7 +61,7 @@ UNION: u tup ; { } [ "IN: classes.predicate.tests PREDICATE: u < tup ;" eval( -- ) ] unit-test ! Changing the metaclass of the predicate superclass should work -GENERIC: change-meta-test ( a -- b ) +GENERIC: change-meta-test ( a -- b ) ; TUPLE: change-meta-test-class length ; diff --git a/core/classes/predicate/predicate.factor b/core/classes/predicate/predicate.factor index 87b5c45bab..0b60270ab5 100644 --- a/core/classes/predicate/predicate.factor +++ b/core/classes/predicate/predicate.factor @@ -9,7 +9,7 @@ PREDICATE: predicate-class < class object 1 ( class slots -- tuple ) +GENERIC# boa>object 1 ( class slots -- tuple ) ; M: tuple-class boa>object swap slots>tuple ; diff --git a/core/classes/tuple/tuple-docs.factor b/core/classes/tuple/tuple-docs.factor index 4627da0e1c..02a0a1e958 100644 --- a/core/classes/tuple/tuple-docs.factor +++ b/core/classes/tuple/tuple-docs.factor @@ -129,8 +129,8 @@ ARTICLE: "tuple-inheritance-example" "Tuple subclassing example" "Rectangles and parallelograms use the same algorithm for computing the area, whereas they use different algorithms for computing perimeter. Also, rectangles and parallelograms both have " { $snippet "width" } " and " { $snippet "height" } " slots. We can exploit this with subclassing:" { $code "USING: accessors kernel math math.constants math.functions ;" - "GENERIC: area ( shape -- n )" - "GENERIC: perimeter ( shape -- n )" + "GENERIC: area ( shape -- n ) ;" + "GENERIC: perimeter ( shape -- n ) ;" "" "TUPLE: shape ;" "" diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index db400c252f..5cbf6af6ca 100644 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -74,7 +74,7 @@ C: predicate-test PREDICATE: silly-pred < tuple class-of \ rect = ; -GENERIC: area ( obj -- n ) +GENERIC: area ( obj -- n ) ; M: silly-pred area dup w>> swap h>> * ; TUPLE: circle radius ; @@ -102,7 +102,7 @@ TUPLE: size-test a b c d ; size-test tuple-layout second = ] unit-test -GENERIC: ( a -- b ) +GENERIC: ( a -- b ) ; TUPLE: yo-momma ; @@ -126,7 +126,7 @@ TUPLE: loc-recording ; TUPLE: forget-robustness ; -GENERIC: forget-robustness-generic ( a -- b ) +GENERIC: forget-robustness-generic ( a -- b ) ; M: forget-robustness forget-robustness-generic ; @@ -139,8 +139,8 @@ M: integer forget-robustness-generic ; ] with-compilation-unit ! rapido found this one -GENERIC# m1 0 ( s n -- n ) -GENERIC# m2 1 ( s n -- v ) +GENERIC# m1 0 ( s n -- n ) ; +GENERIC# m2 1 ( s n -- v ) ; TUPLE: t1 ; @@ -168,7 +168,7 @@ C: t4 { 1 } [ 1 m2 ] unit-test ! another combination issue -GENERIC: silly ( obj -- obj obj ) +GENERIC: silly ( obj -- obj obj ) ; UNION: my-union slice repetition column array vector reversed ; @@ -488,7 +488,7 @@ must-fail-with { t } [ "z" accessor-exists? ] unit-test { [ ] } [ - "IN: classes.tuple.tests GENERIC: forget-accessors-test ( a -- b )" + "IN: classes.tuple.tests GENERIC: forget-accessors-test ( a -- b ) ;" "forget-accessors-test" parse-stream ] unit-test @@ -503,7 +503,7 @@ TUPLE: another-forget-accessors-test ; { [ ] } [ - "IN: classes.tuple.tests GENERIC: another-forget-accessors-test ( a -- b )" + "IN: classes.tuple.tests GENERIC: another-forget-accessors-test ( a -- b ) ;" "another-forget-accessors-test" parse-stream ] unit-test diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 9870d4cb09..2298e52b31 100644 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -93,7 +93,7 @@ PRIVATE> : tuple-slots ( tuple -- seq ) prepare-tuple-slots copy-tuple-slots ; -GENERIC: slots>tuple ( seq class -- tuple ) +GENERIC: slots>tuple ( seq class -- tuple ) ; M: tuple-class slots>tuple ( seq class -- tuple ) check-slots pad-slots @@ -120,7 +120,7 @@ ERROR: bad-superclass class ; ] [ 2drop f ] if ] [ 2drop f ] if ; inline -GENERIC: final-class? ( object -- ? ) +GENERIC: final-class? ( object -- ? ) ; M: tuple-class final-class? "final" word-prop ; @@ -277,7 +277,7 @@ M: tuple-class update-class dup final-class? [ bad-superclass ] when dup class? [ bad-superclass ] unless drop ; -GENERIC# (define-tuple-class) 2 ( class superclass slots -- ) +GENERIC# (define-tuple-class) 2 ( class superclass slots -- ) ; : thrower-effect ( slots -- effect ) [ name>> ] map { "*" } ; @@ -303,7 +303,7 @@ PRIVATE> over prepare-slots (define-tuple-class) ; -GENERIC: make-final ( class -- ) +GENERIC: make-final ( class -- ) ; M: tuple-class make-final [ dup class-usage ?metaclass-changed ] diff --git a/core/classes/union/union-tests.factor b/core/classes/union/union-tests.factor index c9569cf15a..dde30bb308 100644 --- a/core/classes/union/union-tests.factor +++ b/core/classes/union/union-tests.factor @@ -15,7 +15,7 @@ UNION: bah fixnum alien ; ! Test redefinition of classes UNION: union-1 fixnum float ; -GENERIC: generic-update-test ( x -- y ) +GENERIC: generic-update-test ( x -- y ) ; M: union-1 generic-update-test drop "union-1" ; @@ -37,7 +37,7 @@ M: union-1 generic-update-test drop "union-1" ; [ -7 generic-update-test ] must-fail ! Empty unions were causing problems -GENERIC: empty-union-test ( obj -- obj ) +GENERIC: empty-union-test ( obj -- obj ) ; UNION: empty-union-1 ; @@ -77,7 +77,7 @@ UNION: redefine-bug-2 redefine-bug-1 quotation ; { f } [ "foo?" "classes.union.tests" lookup-word predicate? ] unit-test -GENERIC: test-generic ( x -- y ) +GENERIC: test-generic ( x -- y ) ; TUPLE: a-tuple ; diff --git a/core/classes/union/union.factor b/core/classes/union/union.factor index 6dd091d3eb..bcb9a38598 100644 --- a/core/classes/union/union.factor +++ b/core/classes/union/union.factor @@ -11,7 +11,7 @@ PREDICATE: union-class < class symbol: compiler-impl -HOOK: update-call-sites compiler-impl ( class generic -- words ) +HOOK: update-call-sites compiler-impl ( class generic -- words ) ; : changed-call-sites ( class generic -- ) update-call-sites [ changed-definition ] each ; @@ -58,11 +58,11 @@ M: generic update-generic ( class generic -- ) M: sequence update-methods ( class seq -- ) implementors [ update-generic ] with each ; -HOOK: recompile compiler-impl ( words -- alist ) +HOOK: recompile compiler-impl ( words -- alist ) ; -HOOK: to-recompile compiler-impl ( -- words ) +HOOK: to-recompile compiler-impl ( -- words ) ; -HOOK: process-forgotten-words compiler-impl ( words -- ) +HOOK: process-forgotten-words compiler-impl ( words -- ) ; : compile ( words -- ) recompile t f modify-code-heap ; @@ -86,7 +86,7 @@ M: f process-forgotten-words drop ; symbol: definition-observers -GENERIC: definitions-changed ( set obj -- ) +GENERIC: definitions-changed ( set obj -- ) ; [ V{ } clone definition-observers set-global ] "compiler.units" add-startup-hook @@ -110,7 +110,7 @@ GENERIC: definitions-changed ( set obj -- ) ! inline caching : effect-counter ( -- n ) REDEFINITION-COUNTER special-object ; inline -GENERIC: always-bump-effect-counter? ( defspec -- ? ) +GENERIC: always-bump-effect-counter? ( defspec -- ? ) ; M: object always-bump-effect-counter? drop f ; diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor index e3a21acbdf..757f4f7d9c 100644 --- a/core/continuations/continuations.factor +++ b/core/continuations/continuations.factor @@ -105,7 +105,7 @@ symbol: return-continuation : return ( -- * ) return-continuation get continue ; -GENERIC: compute-restarts ( error -- seq ) +GENERIC: compute-restarts ( error -- seq ) ; -GENERIC: error-in-thread ( error thread -- * ) +GENERIC: error-in-thread ( error thread -- * ) ; symbol: thread-error-hook ! ( error thread -- * ) diff --git a/core/cpu/architecture/architecture.factor b/core/cpu/architecture/architecture.factor index 6336b40149..04a62e6e18 100644 --- a/core/cpu/architecture/architecture.factor +++ b/core/cpu/architecture/architecture.factor @@ -152,9 +152,9 @@ CONSTANT: reg-classes { int-regs float-regs } ! On x86, vectors and floats are stored in the same register bank ! On PowerPC they are distinct -HOOK: vector-regs cpu ( -- reg-class ) +HOOK: vector-regs cpu ( -- reg-class ) ; -GENERIC: reg-class-of ( rep -- reg-class ) +GENERIC: reg-class-of ( rep -- reg-class ) ; M: tagged-rep reg-class-of drop int-regs ; M: int-rep reg-class-of drop int-regs ; @@ -163,7 +163,7 @@ M: double-rep reg-class-of drop float-regs ; M: vector-rep reg-class-of drop vector-regs ; M: scalar-rep reg-class-of drop vector-regs ; -GENERIC: rep-size ( rep -- n ) foldable +GENERIC: rep-size ( rep -- n ) ; foldable M: tagged-rep rep-size drop cell ; M: int-rep rep-size drop cell ; @@ -179,7 +179,7 @@ M: uint-scalar-rep rep-size drop 4 ; M: longlong-scalar-rep rep-size drop 8 ; M: ulonglong-scalar-rep rep-size drop 8 ; -GENERIC: rep-length ( rep -- n ) foldable +GENERIC: rep-length ( rep -- n ) ; foldable M: char-16-rep rep-length drop 16 ; M: uchar-16-rep rep-length drop 16 ; @@ -192,11 +192,11 @@ M: ulonglong-2-rep rep-length drop 2 ; M: float-4-rep rep-length drop 4 ; M: double-2-rep rep-length drop 2 ; -GENERIC: rep-component-type ( rep -- n ) +GENERIC: rep-component-type ( rep -- n ) ; ! Methods defined in alien.c-types -GENERIC: scalar-rep-of ( rep -- rep' ) +GENERIC: scalar-rep-of ( rep -- rep' ) ; M: float-4-rep scalar-rep-of drop float-rep ; M: double-2-rep scalar-rep-of drop double-rep ; @@ -209,207 +209,207 @@ M: uint-4-rep scalar-rep-of drop uint-scalar-rep ; M: longlong-2-rep scalar-rep-of drop longlong-scalar-rep ; M: ulonglong-2-rep scalar-rep-of drop ulonglong-scalar-rep ; -HOOK: machine-registers cpu ( -- assoc ) +HOOK: machine-registers cpu ( -- assoc ) ; ! Callbacks are not allowed to clobber this -HOOK: frame-reg cpu ( -- reg ) +HOOK: frame-reg cpu ( -- reg ) ; -HOOK: vm-stack-space cpu ( -- n ) +HOOK: vm-stack-space cpu ( -- n ) ; M: object vm-stack-space 0 ; -HOOK: complex-addressing? cpu ( -- ? ) +HOOK: complex-addressing? cpu ( -- ? ) ; -HOOK: gc-root-offset cpu ( spill-slot -- n ) +HOOK: gc-root-offset cpu ( spill-slot -- n ) ; -HOOK: %load-immediate cpu ( reg val -- ) -HOOK: %load-reference cpu ( reg obj -- ) -HOOK: %load-float cpu ( reg val -- ) -HOOK: %load-double cpu ( reg val -- ) -HOOK: %load-vector cpu ( reg val rep -- ) +HOOK: %load-immediate cpu ( reg val -- ) ; +HOOK: %load-reference cpu ( reg obj -- ) ; +HOOK: %load-float cpu ( reg val -- ) ; +HOOK: %load-double cpu ( reg val -- ) ; +HOOK: %load-vector cpu ( reg val rep -- ) ; -HOOK: %peek cpu ( vreg loc -- ) -HOOK: %replace cpu ( vreg loc -- ) -HOOK: %replace-imm cpu ( src loc -- ) -HOOK: %clear cpu ( loc -- ) -HOOK: %inc cpu ( loc -- ) +HOOK: %peek cpu ( vreg loc -- ) ; +HOOK: %replace cpu ( vreg loc -- ) ; +HOOK: %replace-imm cpu ( src loc -- ) ; +HOOK: %clear cpu ( loc -- ) ; +HOOK: %inc cpu ( loc -- ) ; -HOOK: stack-frame-size cpu ( stack-frame -- n ) -HOOK: %call cpu ( word -- ) -HOOK: %jump cpu ( word -- ) -HOOK: %jump-label cpu ( label -- ) -HOOK: %return cpu ( -- ) +HOOK: stack-frame-size cpu ( stack-frame -- n ) ; +HOOK: %call cpu ( word -- ) ; +HOOK: %jump cpu ( word -- ) ; +HOOK: %jump-label cpu ( label -- ) ; +HOOK: %return cpu ( -- ) ; -HOOK: %dispatch cpu ( src temp -- ) +HOOK: %dispatch cpu ( src temp -- ) ; -HOOK: %slot cpu ( dst obj slot scale tag -- ) -HOOK: %slot-imm cpu ( dst obj slot tag -- ) -HOOK: %set-slot cpu ( src obj slot scale tag -- ) -HOOK: %set-slot-imm cpu ( src obj slot tag -- ) +HOOK: %slot cpu ( dst obj slot scale tag -- ) ; +HOOK: %slot-imm cpu ( dst obj slot tag -- ) ; +HOOK: %set-slot cpu ( src obj slot scale tag -- ) ; +HOOK: %set-slot-imm cpu ( src obj slot tag -- ) ; -HOOK: %add cpu ( dst src1 src2 -- ) -HOOK: %add-imm cpu ( dst src1 src2 -- ) -HOOK: %sub cpu ( dst src1 src2 -- ) -HOOK: %sub-imm cpu ( dst src1 src2 -- ) -HOOK: %mul cpu ( dst src1 src2 -- ) -HOOK: %mul-imm cpu ( dst src1 src2 -- ) -HOOK: %and cpu ( dst src1 src2 -- ) -HOOK: %and-imm cpu ( dst src1 src2 -- ) -HOOK: %or cpu ( dst src1 src2 -- ) -HOOK: %or-imm cpu ( dst src1 src2 -- ) -HOOK: %xor cpu ( dst src1 src2 -- ) -HOOK: %xor-imm cpu ( dst src1 src2 -- ) -HOOK: %shl cpu ( dst src1 src2 -- ) -HOOK: %shl-imm cpu ( dst src1 src2 -- ) -HOOK: %shr cpu ( dst src1 src2 -- ) -HOOK: %shr-imm cpu ( dst src1 src2 -- ) -HOOK: %sar cpu ( dst src1 src2 -- ) -HOOK: %sar-imm cpu ( dst src1 src2 -- ) -HOOK: %min cpu ( dst src1 src2 -- ) -HOOK: %max cpu ( dst src1 src2 -- ) -HOOK: %not cpu ( dst src -- ) -HOOK: %neg cpu ( dst src -- ) -HOOK: %log2 cpu ( dst src -- ) -HOOK: %bit-count cpu ( dst src -- ) -HOOK: %bit-test cpu ( dst src1 src2 temp -- ) +HOOK: %add cpu ( dst src1 src2 -- ) ; +HOOK: %add-imm cpu ( dst src1 src2 -- ) ; +HOOK: %sub cpu ( dst src1 src2 -- ) ; +HOOK: %sub-imm cpu ( dst src1 src2 -- ) ; +HOOK: %mul cpu ( dst src1 src2 -- ) ; +HOOK: %mul-imm cpu ( dst src1 src2 -- ) ; +HOOK: %and cpu ( dst src1 src2 -- ) ; +HOOK: %and-imm cpu ( dst src1 src2 -- ) ; +HOOK: %or cpu ( dst src1 src2 -- ) ; +HOOK: %or-imm cpu ( dst src1 src2 -- ) ; +HOOK: %xor cpu ( dst src1 src2 -- ) ; +HOOK: %xor-imm cpu ( dst src1 src2 -- ) ; +HOOK: %shl cpu ( dst src1 src2 -- ) ; +HOOK: %shl-imm cpu ( dst src1 src2 -- ) ; +HOOK: %shr cpu ( dst src1 src2 -- ) ; +HOOK: %shr-imm cpu ( dst src1 src2 -- ) ; +HOOK: %sar cpu ( dst src1 src2 -- ) ; +HOOK: %sar-imm cpu ( dst src1 src2 -- ) ; +HOOK: %min cpu ( dst src1 src2 -- ) ; +HOOK: %max cpu ( dst src1 src2 -- ) ; +HOOK: %not cpu ( dst src -- ) ; +HOOK: %neg cpu ( dst src -- ) ; +HOOK: %log2 cpu ( dst src -- ) ; +HOOK: %bit-count cpu ( dst src -- ) ; +HOOK: %bit-test cpu ( dst src1 src2 temp -- ) ; -HOOK: %copy cpu ( dst src rep -- ) +HOOK: %copy cpu ( dst src rep -- ) ; : %tagged>integer ( dst src -- ) int-rep %copy ; -HOOK: %fixnum-add cpu ( label dst src1 src2 cc -- ) -HOOK: %fixnum-sub cpu ( label dst src1 src2 cc -- ) -HOOK: %fixnum-mul cpu ( label dst src1 src2 cc -- ) +HOOK: %fixnum-add cpu ( label dst src1 src2 cc -- ) ; +HOOK: %fixnum-sub cpu ( label dst src1 src2 cc -- ) ; +HOOK: %fixnum-mul cpu ( label dst src1 src2 cc -- ) ; -HOOK: %add-float cpu ( dst src1 src2 -- ) -HOOK: %sub-float cpu ( dst src1 src2 -- ) -HOOK: %mul-float cpu ( dst src1 src2 -- ) -HOOK: %div-float cpu ( dst src1 src2 -- ) -HOOK: %min-float cpu ( dst src1 src2 -- ) -HOOK: %max-float cpu ( dst src1 src2 -- ) -HOOK: %sqrt cpu ( dst src -- ) +HOOK: %add-float cpu ( dst src1 src2 -- ) ; +HOOK: %sub-float cpu ( dst src1 src2 -- ) ; +HOOK: %mul-float cpu ( dst src1 src2 -- ) ; +HOOK: %div-float cpu ( dst src1 src2 -- ) ; +HOOK: %min-float cpu ( dst src1 src2 -- ) ; +HOOK: %max-float cpu ( dst src1 src2 -- ) ; +HOOK: %sqrt cpu ( dst src -- ) ; -HOOK: %single>double-float cpu ( dst src -- ) -HOOK: %double>single-float cpu ( dst src -- ) +HOOK: %single>double-float cpu ( dst src -- ) ; +HOOK: %double>single-float cpu ( dst src -- ) ; -HOOK: integer-float-needs-stack-frame? cpu ( -- ? ) +HOOK: integer-float-needs-stack-frame? cpu ( -- ? ) ; -HOOK: %integer>float cpu ( dst src -- ) -HOOK: %float>integer cpu ( dst src -- ) +HOOK: %integer>float cpu ( dst src -- ) ; +HOOK: %float>integer cpu ( dst src -- ) ; -HOOK: %zero-vector cpu ( dst rep -- ) -HOOK: %fill-vector cpu ( dst rep -- ) -HOOK: %gather-vector-2 cpu ( dst src1 src2 rep -- ) -HOOK: %gather-int-vector-2 cpu ( dst src1 src2 rep -- ) -HOOK: %gather-vector-4 cpu ( dst src1 src2 src3 src4 rep -- ) -HOOK: %gather-int-vector-4 cpu ( dst src1 src2 src3 src4 rep -- ) -HOOK: %select-vector cpu ( dst src n rep -- ) -HOOK: %shuffle-vector cpu ( dst src shuffle rep -- ) -HOOK: %shuffle-vector-imm cpu ( dst src shuffle rep -- ) -HOOK: %shuffle-vector-halves-imm cpu ( dst src1 src2 shuffle rep -- ) -HOOK: %tail>head-vector cpu ( dst src rep -- ) -HOOK: %merge-vector-head cpu ( dst src1 src2 rep -- ) -HOOK: %merge-vector-tail cpu ( dst src1 src2 rep -- ) -HOOK: %float-pack-vector cpu ( dst src rep -- ) -HOOK: %signed-pack-vector cpu ( dst src1 src2 rep -- ) -HOOK: %unsigned-pack-vector cpu ( dst src1 src2 rep -- ) -HOOK: %unpack-vector-head cpu ( dst src rep -- ) -HOOK: %unpack-vector-tail cpu ( dst src rep -- ) -HOOK: %integer>float-vector cpu ( dst src rep -- ) -HOOK: %float>integer-vector cpu ( dst src rep -- ) -HOOK: %compare-vector cpu ( dst src1 src2 rep cc -- ) -HOOK: %move-vector-mask cpu ( dst src rep -- ) -HOOK: %test-vector cpu ( dst src1 temp rep vcc -- ) -HOOK: %test-vector-branch cpu ( label src1 temp rep vcc -- ) -HOOK: %add-vector cpu ( dst src1 src2 rep -- ) -HOOK: %saturated-add-vector cpu ( dst src1 src2 rep -- ) -HOOK: %add-sub-vector cpu ( dst src1 src2 rep -- ) -HOOK: %sub-vector cpu ( dst src1 src2 rep -- ) -HOOK: %saturated-sub-vector cpu ( dst src1 src2 rep -- ) -HOOK: %mul-vector cpu ( dst src1 src2 rep -- ) -HOOK: %mul-high-vector cpu ( dst src1 src2 rep -- ) -HOOK: %mul-horizontal-add-vector cpu ( dst src1 src2 rep -- ) -HOOK: %saturated-mul-vector cpu ( dst src1 src2 rep -- ) -HOOK: %div-vector cpu ( dst src1 src2 rep -- ) -HOOK: %min-vector cpu ( dst src1 src2 rep -- ) -HOOK: %max-vector cpu ( dst src1 src2 rep -- ) -HOOK: %avg-vector cpu ( dst src1 src2 rep -- ) -HOOK: %dot-vector cpu ( dst src1 src2 rep -- ) -HOOK: %sad-vector cpu ( dst src1 src2 rep -- ) -HOOK: %sqrt-vector cpu ( dst src rep -- ) -HOOK: %horizontal-add-vector cpu ( dst src1 src2 rep -- ) -HOOK: %horizontal-sub-vector cpu ( dst src1 src2 rep -- ) -HOOK: %abs-vector cpu ( dst src rep -- ) -HOOK: %and-vector cpu ( dst src1 src2 rep -- ) -HOOK: %andn-vector cpu ( dst src1 src2 rep -- ) -HOOK: %or-vector cpu ( dst src1 src2 rep -- ) -HOOK: %xor-vector cpu ( dst src1 src2 rep -- ) -HOOK: %not-vector cpu ( dst src rep -- ) -HOOK: %shl-vector cpu ( dst src1 src2 rep -- ) -HOOK: %shr-vector cpu ( dst src1 src2 rep -- ) -HOOK: %shl-vector-imm cpu ( dst src1 src2 rep -- ) -HOOK: %shr-vector-imm cpu ( dst src1 src2 rep -- ) -HOOK: %horizontal-shl-vector-imm cpu ( dst src1 src2 rep -- ) -HOOK: %horizontal-shr-vector-imm cpu ( dst src1 src2 rep -- ) +HOOK: %zero-vector cpu ( dst rep -- ) ; +HOOK: %fill-vector cpu ( dst rep -- ) ; +HOOK: %gather-vector-2 cpu ( dst src1 src2 rep -- ) ; +HOOK: %gather-int-vector-2 cpu ( dst src1 src2 rep -- ) ; +HOOK: %gather-vector-4 cpu ( dst src1 src2 src3 src4 rep -- ) ; +HOOK: %gather-int-vector-4 cpu ( dst src1 src2 src3 src4 rep -- ) ; +HOOK: %select-vector cpu ( dst src n rep -- ) ; +HOOK: %shuffle-vector cpu ( dst src shuffle rep -- ) ; +HOOK: %shuffle-vector-imm cpu ( dst src shuffle rep -- ) ; +HOOK: %shuffle-vector-halves-imm cpu ( dst src1 src2 shuffle rep -- ) ; +HOOK: %tail>head-vector cpu ( dst src rep -- ) ; +HOOK: %merge-vector-head cpu ( dst src1 src2 rep -- ) ; +HOOK: %merge-vector-tail cpu ( dst src1 src2 rep -- ) ; +HOOK: %float-pack-vector cpu ( dst src rep -- ) ; +HOOK: %signed-pack-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %unsigned-pack-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %unpack-vector-head cpu ( dst src rep -- ) ; +HOOK: %unpack-vector-tail cpu ( dst src rep -- ) ; +HOOK: %integer>float-vector cpu ( dst src rep -- ) ; +HOOK: %float>integer-vector cpu ( dst src rep -- ) ; +HOOK: %compare-vector cpu ( dst src1 src2 rep cc -- ) ; +HOOK: %move-vector-mask cpu ( dst src rep -- ) ; +HOOK: %test-vector cpu ( dst src1 temp rep vcc -- ) ; +HOOK: %test-vector-branch cpu ( label src1 temp rep vcc -- ) ; +HOOK: %add-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %saturated-add-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %add-sub-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %sub-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %saturated-sub-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %mul-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %mul-high-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %mul-horizontal-add-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %saturated-mul-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %div-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %min-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %max-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %avg-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %dot-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %sad-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %sqrt-vector cpu ( dst src rep -- ) ; +HOOK: %horizontal-add-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %horizontal-sub-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %abs-vector cpu ( dst src rep -- ) ; +HOOK: %and-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %andn-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %or-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %xor-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %not-vector cpu ( dst src rep -- ) ; +HOOK: %shl-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %shr-vector cpu ( dst src1 src2 rep -- ) ; +HOOK: %shl-vector-imm cpu ( dst src1 src2 rep -- ) ; +HOOK: %shr-vector-imm cpu ( dst src1 src2 rep -- ) ; +HOOK: %horizontal-shl-vector-imm cpu ( dst src1 src2 rep -- ) ; +HOOK: %horizontal-shr-vector-imm cpu ( dst src1 src2 rep -- ) ; -HOOK: %integer>scalar cpu ( dst src rep -- ) -HOOK: %scalar>integer cpu ( dst src rep -- ) -HOOK: %vector>scalar cpu ( dst src rep -- ) -HOOK: %scalar>vector cpu ( dst src rep -- ) +HOOK: %integer>scalar cpu ( dst src rep -- ) ; +HOOK: %scalar>integer cpu ( dst src rep -- ) ; +HOOK: %vector>scalar cpu ( dst src rep -- ) ; +HOOK: %scalar>vector cpu ( dst src rep -- ) ; -HOOK: %zero-vector-reps cpu ( -- reps ) -HOOK: %fill-vector-reps cpu ( -- reps ) -HOOK: %gather-vector-2-reps cpu ( -- reps ) -HOOK: %gather-int-vector-2-reps cpu ( -- reps ) -HOOK: %gather-vector-4-reps cpu ( -- reps ) -HOOK: %gather-int-vector-4-reps cpu ( -- reps ) -HOOK: %select-vector-reps cpu ( -- reps ) -HOOK: %alien-vector-reps cpu ( -- reps ) -HOOK: %shuffle-vector-reps cpu ( -- reps ) -HOOK: %shuffle-vector-imm-reps cpu ( -- reps ) -HOOK: %shuffle-vector-halves-imm-reps cpu ( -- reps ) -HOOK: %merge-vector-reps cpu ( -- reps ) -HOOK: %float-pack-vector-reps cpu ( -- reps ) -HOOK: %signed-pack-vector-reps cpu ( -- reps ) -HOOK: %unsigned-pack-vector-reps cpu ( -- reps ) -HOOK: %unpack-vector-head-reps cpu ( -- reps ) -HOOK: %unpack-vector-tail-reps cpu ( -- reps ) -HOOK: %integer>float-vector-reps cpu ( -- reps ) -HOOK: %float>integer-vector-reps cpu ( -- reps ) -HOOK: %compare-vector-reps cpu ( cc -- reps ) -HOOK: %compare-vector-ccs cpu ( rep cc -- {cc,swap?}s not? ) -HOOK: %move-vector-mask-reps cpu ( -- reps ) -HOOK: %test-vector-reps cpu ( -- reps ) -HOOK: %add-vector-reps cpu ( -- reps ) -HOOK: %saturated-add-vector-reps cpu ( -- reps ) -HOOK: %add-sub-vector-reps cpu ( -- reps ) -HOOK: %sub-vector-reps cpu ( -- reps ) -HOOK: %saturated-sub-vector-reps cpu ( -- reps ) -HOOK: %mul-vector-reps cpu ( -- reps ) -HOOK: %mul-high-vector-reps cpu ( -- reps ) -HOOK: %mul-horizontal-add-vector-reps cpu ( -- reps ) -HOOK: %saturated-mul-vector-reps cpu ( -- reps ) -HOOK: %div-vector-reps cpu ( -- reps ) -HOOK: %min-vector-reps cpu ( -- reps ) -HOOK: %max-vector-reps cpu ( -- reps ) -HOOK: %avg-vector-reps cpu ( -- reps ) -HOOK: %dot-vector-reps cpu ( -- reps ) -HOOK: %sad-vector-reps cpu ( -- reps ) -HOOK: %sqrt-vector-reps cpu ( -- reps ) -HOOK: %horizontal-add-vector-reps cpu ( -- reps ) -HOOK: %horizontal-sub-vector-reps cpu ( -- reps ) -HOOK: %abs-vector-reps cpu ( -- reps ) -HOOK: %and-vector-reps cpu ( -- reps ) -HOOK: %andn-vector-reps cpu ( -- reps ) -HOOK: %or-vector-reps cpu ( -- reps ) -HOOK: %xor-vector-reps cpu ( -- reps ) -HOOK: %not-vector-reps cpu ( -- reps ) -HOOK: %shl-vector-reps cpu ( -- reps ) -HOOK: %shr-vector-reps cpu ( -- reps ) -HOOK: %shl-vector-imm-reps cpu ( -- reps ) -HOOK: %shr-vector-imm-reps cpu ( -- reps ) -HOOK: %horizontal-shl-vector-imm-reps cpu ( -- reps ) -HOOK: %horizontal-shr-vector-imm-reps cpu ( -- reps ) +HOOK: %zero-vector-reps cpu ( -- reps ) ; +HOOK: %fill-vector-reps cpu ( -- reps ) ; +HOOK: %gather-vector-2-reps cpu ( -- reps ) ; +HOOK: %gather-int-vector-2-reps cpu ( -- reps ) ; +HOOK: %gather-vector-4-reps cpu ( -- reps ) ; +HOOK: %gather-int-vector-4-reps cpu ( -- reps ) ; +HOOK: %select-vector-reps cpu ( -- reps ) ; +HOOK: %alien-vector-reps cpu ( -- reps ) ; +HOOK: %shuffle-vector-reps cpu ( -- reps ) ; +HOOK: %shuffle-vector-imm-reps cpu ( -- reps ) ; +HOOK: %shuffle-vector-halves-imm-reps cpu ( -- reps ) ; +HOOK: %merge-vector-reps cpu ( -- reps ) ; +HOOK: %float-pack-vector-reps cpu ( -- reps ) ; +HOOK: %signed-pack-vector-reps cpu ( -- reps ) ; +HOOK: %unsigned-pack-vector-reps cpu ( -- reps ) ; +HOOK: %unpack-vector-head-reps cpu ( -- reps ) ; +HOOK: %unpack-vector-tail-reps cpu ( -- reps ) ; +HOOK: %integer>float-vector-reps cpu ( -- reps ) ; +HOOK: %float>integer-vector-reps cpu ( -- reps ) ; +HOOK: %compare-vector-reps cpu ( cc -- reps ) ; +HOOK: %compare-vector-ccs cpu ( rep cc -- {cc,swap?}s not? ) ; +HOOK: %move-vector-mask-reps cpu ( -- reps ) ; +HOOK: %test-vector-reps cpu ( -- reps ) ; +HOOK: %add-vector-reps cpu ( -- reps ) ; +HOOK: %saturated-add-vector-reps cpu ( -- reps ) ; +HOOK: %add-sub-vector-reps cpu ( -- reps ) ; +HOOK: %sub-vector-reps cpu ( -- reps ) ; +HOOK: %saturated-sub-vector-reps cpu ( -- reps ) ; +HOOK: %mul-vector-reps cpu ( -- reps ) ; +HOOK: %mul-high-vector-reps cpu ( -- reps ) ; +HOOK: %mul-horizontal-add-vector-reps cpu ( -- reps ) ; +HOOK: %saturated-mul-vector-reps cpu ( -- reps ) ; +HOOK: %div-vector-reps cpu ( -- reps ) ; +HOOK: %min-vector-reps cpu ( -- reps ) ; +HOOK: %max-vector-reps cpu ( -- reps ) ; +HOOK: %avg-vector-reps cpu ( -- reps ) ; +HOOK: %dot-vector-reps cpu ( -- reps ) ; +HOOK: %sad-vector-reps cpu ( -- reps ) ; +HOOK: %sqrt-vector-reps cpu ( -- reps ) ; +HOOK: %horizontal-add-vector-reps cpu ( -- reps ) ; +HOOK: %horizontal-sub-vector-reps cpu ( -- reps ) ; +HOOK: %abs-vector-reps cpu ( -- reps ) ; +HOOK: %and-vector-reps cpu ( -- reps ) ; +HOOK: %andn-vector-reps cpu ( -- reps ) ; +HOOK: %or-vector-reps cpu ( -- reps ) ; +HOOK: %xor-vector-reps cpu ( -- reps ) ; +HOOK: %not-vector-reps cpu ( -- reps ) ; +HOOK: %shl-vector-reps cpu ( -- reps ) ; +HOOK: %shr-vector-reps cpu ( -- reps ) ; +HOOK: %shl-vector-imm-reps cpu ( -- reps ) ; +HOOK: %shr-vector-imm-reps cpu ( -- reps ) ; +HOOK: %horizontal-shl-vector-imm-reps cpu ( -- reps ) ; +HOOK: %horizontal-shr-vector-imm-reps cpu ( -- reps ) ; M: object %zero-vector-reps { } ; M: object %fill-vector-reps { } ; @@ -464,76 +464,76 @@ ALIAS: %merge-vector-head-reps %merge-vector-reps ALIAS: %merge-vector-tail-reps %merge-vector-reps ALIAS: %tail>head-vector-reps %unpack-vector-head-reps -HOOK: %unbox-alien cpu ( dst src -- ) -HOOK: %unbox-any-c-ptr cpu ( dst src -- ) -HOOK: %box-alien cpu ( dst src temp -- ) -HOOK: %box-displaced-alien cpu ( dst displacement base temp base-class -- ) +HOOK: %unbox-alien cpu ( dst src -- ) ; +HOOK: %unbox-any-c-ptr cpu ( dst src -- ) ; +HOOK: %box-alien cpu ( dst src temp -- ) ; +HOOK: %box-displaced-alien cpu ( dst displacement base temp base-class -- ) ; -HOOK: %convert-integer cpu ( dst src c-type -- ) +HOOK: %convert-integer cpu ( dst src c-type -- ) ; -HOOK: %load-memory cpu ( dst base displacement scale offset rep c-type -- ) -HOOK: %load-memory-imm cpu ( dst base offset rep c-type -- ) -HOOK: %store-memory cpu ( value base displacement scale offset rep c-type -- ) -HOOK: %store-memory-imm cpu ( value base offset rep c-type -- ) +HOOK: %load-memory cpu ( dst base displacement scale offset rep c-type -- ) ; +HOOK: %load-memory-imm cpu ( dst base offset rep c-type -- ) ; +HOOK: %store-memory cpu ( value base displacement scale offset rep c-type -- ) ; +HOOK: %store-memory-imm cpu ( value base offset rep c-type -- ) ; -HOOK: %alien-global cpu ( dst symbol library -- ) -HOOK: %vm-field cpu ( dst offset -- ) -HOOK: %set-vm-field cpu ( src offset -- ) +HOOK: %alien-global cpu ( dst symbol library -- ) ; +HOOK: %vm-field cpu ( dst offset -- ) ; +HOOK: %set-vm-field cpu ( src offset -- ) ; : %context ( dst -- ) 0 %vm-field ; -HOOK: %allot cpu ( dst size class temp -- ) -HOOK: %write-barrier cpu ( src slot scale tag temp1 temp2 -- ) -HOOK: %write-barrier-imm cpu ( src slot tag temp1 temp2 -- ) +HOOK: %allot cpu ( dst size class temp -- ) ; +HOOK: %write-barrier cpu ( src slot scale tag temp1 temp2 -- ) ; +HOOK: %write-barrier-imm cpu ( src slot tag temp1 temp2 -- ) ; ! GC checks -HOOK: %check-nursery-branch cpu ( label size cc temp1 temp2 -- ) -HOOK: %call-gc cpu ( gc-map -- ) +HOOK: %check-nursery-branch cpu ( label size cc temp1 temp2 -- ) ; +HOOK: %call-gc cpu ( gc-map -- ) ; -HOOK: %prologue cpu ( n -- ) -HOOK: %epilogue cpu ( n -- ) +HOOK: %prologue cpu ( n -- ) ; +HOOK: %epilogue cpu ( n -- ) ; -HOOK: %safepoint cpu ( -- ) +HOOK: %safepoint cpu ( -- ) ; -HOOK: test-instruction? cpu ( -- ? ) +HOOK: test-instruction? cpu ( -- ? ) ; M: object test-instruction? f ; -HOOK: %compare cpu ( dst src1 src2 cc temp -- ) -HOOK: %compare-imm cpu ( dst src1 src2 cc temp -- ) -HOOK: %compare-integer-imm cpu ( dst src1 src2 cc temp -- ) -HOOK: %test cpu ( dst src1 src2 cc temp -- ) -HOOK: %test-imm cpu ( dst src1 src2 cc temp -- ) -HOOK: %compare-float-ordered cpu ( dst src1 src2 cc temp -- ) -HOOK: %compare-float-unordered cpu ( dst src1 src2 cc temp -- ) +HOOK: %compare cpu ( dst src1 src2 cc temp -- ) ; +HOOK: %compare-imm cpu ( dst src1 src2 cc temp -- ) ; +HOOK: %compare-integer-imm cpu ( dst src1 src2 cc temp -- ) ; +HOOK: %test cpu ( dst src1 src2 cc temp -- ) ; +HOOK: %test-imm cpu ( dst src1 src2 cc temp -- ) ; +HOOK: %compare-float-ordered cpu ( dst src1 src2 cc temp -- ) ; +HOOK: %compare-float-unordered cpu ( dst src1 src2 cc temp -- ) ; -HOOK: %compare-branch cpu ( label cc src1 src2 -- ) -HOOK: %compare-imm-branch cpu ( label cc src1 src2 -- ) -HOOK: %compare-integer-imm-branch cpu ( label cc src1 src2 -- ) -HOOK: %test-branch cpu ( label cc src1 src2 -- ) -HOOK: %test-imm-branch cpu ( label cc src1 src2 -- ) -HOOK: %compare-float-ordered-branch cpu ( label cc src1 src2 -- ) -HOOK: %compare-float-unordered-branch cpu ( label cc src1 src2 -- ) +HOOK: %compare-branch cpu ( label cc src1 src2 -- ) ; +HOOK: %compare-imm-branch cpu ( label cc src1 src2 -- ) ; +HOOK: %compare-integer-imm-branch cpu ( label cc src1 src2 -- ) ; +HOOK: %test-branch cpu ( label cc src1 src2 -- ) ; +HOOK: %test-imm-branch cpu ( label cc src1 src2 -- ) ; +HOOK: %compare-float-ordered-branch cpu ( label cc src1 src2 -- ) ; +HOOK: %compare-float-unordered-branch cpu ( label cc src1 src2 -- ) ; -HOOK: %spill cpu ( src rep dst -- ) -HOOK: %reload cpu ( dst rep src -- ) +HOOK: %spill cpu ( src rep dst -- ) ; +HOOK: %reload cpu ( dst rep src -- ) ; -HOOK: %loop-entry cpu ( -- ) +HOOK: %loop-entry cpu ( -- ) ; -HOOK: fused-unboxing? cpu ( -- ? ) +HOOK: fused-unboxing? cpu ( -- ? ) ; -HOOK: immediate-arithmetic? cpu ( n -- ? ) +HOOK: immediate-arithmetic? cpu ( n -- ? ) ; ! Can this value be an immediate operand for %and-imm, %or-imm, ! or %xor-imm? -HOOK: immediate-bitwise? cpu ( n -- ? ) +HOOK: immediate-bitwise? cpu ( n -- ? ) ; ! Can this value be an immediate operand for %compare-imm or ! %compare-imm-branch? -HOOK: immediate-comparand? cpu ( n -- ? ) +HOOK: immediate-comparand? cpu ( n -- ? ) ; ! Can this value be an immediate operand for %replace-imm? -HOOK: immediate-store? cpu ( obj -- ? ) +HOOK: immediate-store? cpu ( obj -- ? ) ; M: object immediate-comparand? ( n -- ? ) { @@ -547,66 +547,66 @@ M: object immediate-comparand? ( n -- ? ) ! FFI stuff -HOOK: return-regs cpu ( -- regs ) +HOOK: return-regs cpu ( -- regs ) ; -HOOK: param-regs cpu ( abi -- regs ) +HOOK: param-regs cpu ( abi -- regs ) ; -HOOK: return-struct-in-registers? cpu ( c-type -- ? ) +HOOK: return-struct-in-registers? cpu ( c-type -- ? ) ; ! Do we pass this struct by value or hidden reference? -HOOK: value-struct? cpu ( c-type -- ? ) +HOOK: value-struct? cpu ( c-type -- ? ) ; ! If t, all parameters are shadowed by dummy stack parameters -HOOK: dummy-stack-params? cpu ( -- ? ) +HOOK: dummy-stack-params? cpu ( -- ? ) ; ! If t, all FP parameters are shadowed by dummy int parameters -HOOK: dummy-int-params? cpu ( -- ? ) +HOOK: dummy-int-params? cpu ( -- ? ) ; ! If t, all int parameters are shadowed by dummy FP parameters -HOOK: dummy-fp-params? cpu ( -- ? ) +HOOK: dummy-fp-params? cpu ( -- ? ) ; ! If t, long longs are never passed in param regs -HOOK: long-long-on-stack? cpu ( -- ? ) +HOOK: long-long-on-stack? cpu ( -- ? ) ; ! If t, long longs are aligned on an odd register. On Linux ! 32-bit PPC, long longs are 8-byte aligned but passed in ! registers so they need to be aligned on an odd numbered ! (r3, r5, etc) register. -HOOK: long-long-odd-register? cpu ( -- ? ) +HOOK: long-long-odd-register? cpu ( -- ? ) ; ! If t, floats are never passed in param regs -HOOK: float-on-stack? cpu ( -- ? ) +HOOK: float-on-stack? cpu ( -- ? ) ; ! If t, put floats in the second word of a double word on the stack -HOOK: float-right-align-on-stack? cpu ( -- ? ) +HOOK: float-right-align-on-stack? cpu ( -- ? ) ; ! If t, the struct return pointer is never passed in a param reg -HOOK: struct-return-on-stack? cpu ( -- ? ) +HOOK: struct-return-on-stack? cpu ( -- ? ) ; ! Call a function to convert a tagged pointer into a value that ! can be passed to a C function, or returned from a callback -HOOK: %unbox cpu ( dst src func rep -- ) +HOOK: %unbox cpu ( dst src func rep -- ) ; -HOOK: %unbox-long-long cpu ( dst1 dst2 src func -- ) +HOOK: %unbox-long-long cpu ( dst1 dst2 src func -- ) ; -HOOK: %local-allot cpu ( dst size align offset -- ) +HOOK: %local-allot cpu ( dst size align offset -- ) ; -HOOK: %box cpu ( dst src func rep gc-map -- ) +HOOK: %box cpu ( dst src func rep gc-map -- ) ; -HOOK: %box-long-long cpu ( dst src1 src2 func gc-map -- ) +HOOK: %box-long-long cpu ( dst src1 src2 func gc-map -- ) ; -HOOK: %save-context cpu ( temp1 temp2 -- ) +HOOK: %save-context cpu ( temp1 temp2 -- ) ; -HOOK: %c-invoke cpu ( symbols dll gc-map -- ) +HOOK: %c-invoke cpu ( symbols dll gc-map -- ) ; -HOOK: %alien-invoke cpu ( reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size symbols dll gc-map -- ) +HOOK: %alien-invoke cpu ( reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size symbols dll gc-map -- ) ; -HOOK: %alien-indirect cpu ( src reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size gc-map -- ) +HOOK: %alien-indirect cpu ( src reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size gc-map -- ) ; -HOOK: %alien-assembly cpu ( reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size quot -- ) +HOOK: %alien-assembly cpu ( reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size quot -- ) ; -HOOK: %callback-inputs cpu ( reg-outputs stack-outputs -- ) +HOOK: %callback-inputs cpu ( reg-outputs stack-outputs -- ) ; -HOOK: %callback-outputs cpu ( reg-inputs -- ) +HOOK: %callback-outputs cpu ( reg-inputs -- ) ; -HOOK: stack-cleanup cpu ( stack-size return abi -- n ) +HOOK: stack-cleanup cpu ( stack-size return abi -- n ) ; diff --git a/core/definitions/definitions-tests.factor b/core/definitions/definitions-tests.factor index cd21fd5bc3..77842b059d 100644 --- a/core/definitions/definitions-tests.factor +++ b/core/definitions/definitions-tests.factor @@ -2,7 +2,7 @@ USING: arrays bit-arrays byte-arrays compiler.units definitions tools.test ; in: definitions.tests -GENERIC: some-generic ( a -- b ) +GENERIC: some-generic ( a -- b ) ; use: arrays diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor index b401ffeae6..a32499eed4 100644 --- a/core/definitions/definitions.factor +++ b/core/definitions/definitions.factor @@ -29,13 +29,13 @@ symbol: new-words : new-word ( word -- ) new-words get add-to-unit ; -GENERIC: where ( defspec -- loc ) +GENERIC: where ( defspec -- loc ) ; M: object where drop f ; -GENERIC: set-where ( loc defspec -- ) +GENERIC: set-where ( loc defspec -- ) ; -GENERIC: forget* ( defspec -- ) +GENERIC: forget* ( defspec -- ) ; symbol: forgotten-definitions @@ -51,6 +51,6 @@ M: wrapper forget* wrapped>> forget ; : forget-all ( definitions -- ) [ forget ] each ; -GENERIC: definer ( defspec -- start end ) +GENERIC: definer ( defspec -- start end ) ; -GENERIC: definition ( defspec -- seq ) +GENERIC: definition ( defspec -- seq ) ; diff --git a/core/delegate/delegate-tests.factor b/core/delegate/delegate-tests.factor index 08557d93a9..eecd6e2e1f 100644 --- a/core/delegate/delegate-tests.factor +++ b/core/delegate/delegate-tests.factor @@ -10,9 +10,9 @@ C: hello TUPLE: goodbye these those ; C: goodbye -GENERIC: foo ( x -- y ) -GENERIC: bar ( a -- b ) -GENERIC# whoa 1 ( s t -- w ) +GENERIC: foo ( x -- y ) ; +GENERIC: bar ( a -- b ) ; +GENERIC# whoa 1 ( s t -- w ) ; PROTOCOL: baz foo { bar 0 } { whoa 1 } ; : hello-test ( hello/goodbye -- array ) @@ -23,7 +23,7 @@ M: hello foo this>> ; M: hello bar hello-test ; M: hello whoa [ this>> ] dip + ; -GENERIC: bing ( c -- d ) +GENERIC: bing ( c -- d ) ; PROTOCOL: bee bing ; CONSULT: hello goodbye those>> ; M: hello bing hello-test ; @@ -41,13 +41,13 @@ M: hello bing hello-test ; { "USING: delegate ;\nIN: delegate.tests\nPROTOCOL: baz foo bar { whoa 1 } ; inline\n" } [ [ baz see ] with-string-writer ] unit-test -GENERIC: one ( a -- b ) +GENERIC: one ( a -- b ) ; M: integer one ; -GENERIC: two ( a -- b ) +GENERIC: two ( a -- b ) ; M: integer two ; -GENERIC: three ( a -- b ) +GENERIC: three ( a -- b ) ; M: integer three ; -GENERIC: four ( a -- b ) +GENERIC: four ( a -- b ) ; M: integer four ; PROTOCOL: alpha one two ; @@ -104,7 +104,7 @@ CONSULT: slot-protocol-test-5 slot-protocol-test-4 x>> ; a-read-only-slot>> ] unit-test -GENERIC: do-me ( x -- ) +GENERIC: do-me ( x -- ) ; M: f do-me drop ; @@ -209,8 +209,8 @@ DEFER: seq-delegate key? ] unit-test -GENERIC: broadcastable ( x -- ) -GENERIC: nonbroadcastable ( x -- y ) +GENERIC: broadcastable ( x -- ) ; +GENERIC: nonbroadcastable ( x -- y ) ; TUPLE: broadcaster targets ; diff --git a/core/delegate/delegate.factor b/core/delegate/delegate.factor index deebe3b78e..8b7cd307e3 100644 --- a/core/delegate/delegate.factor +++ b/core/delegate/delegate.factor @@ -17,7 +17,7 @@ ERROR: broadcast-words-must-have-no-outputs group ; : protocol-consult ( protocol -- consulters ) "protocol-consult" word-prop ; -GENERIC: group-words ( group -- words ) +GENERIC: group-words ( group -- words ) ; M: standard-generic group-words dup "combination" word-prop #>> 2array 1array ; @@ -62,7 +62,7 @@ PREDICATE: consult-method < method M: consult-method reset-word [ call-next-method ] [ f "consultation" set-word-prop ] bi ; -GENERIC# (consult-method-quot) 2 ( consultation quot word -- object ) +GENERIC# (consult-method-quot) 2 ( consultation quot word -- object ) ; M: consultation (consult-method-quot) '[ _ call _ execute ] nip ; diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor index b1fc37164b..1d77aacec9 100755 --- a/core/destructors/destructors.factor +++ b/core/destructors/destructors.factor @@ -30,14 +30,14 @@ continuation ; : new-disposable ( class -- disposable ) new dup register-disposable ; inline -GENERIC: dispose* ( disposable -- ) +GENERIC: dispose* ( disposable -- ) ; ERROR: already-disposed disposable ; : check-disposed ( disposable -- disposable ) dup disposed>> [ already-disposed ] when ; inline -GENERIC: dispose ( disposable -- ) +GENERIC: dispose ( disposable -- ) ; : unless-disposed ( disposable quot -- ) [ dup disposed>> [ drop ] ] dip if ; inline diff --git a/core/effects/effects.factor b/core/effects/effects.factor index 931bae430f..2429e8bbb0 100644 --- a/core/effects/effects.factor +++ b/core/effects/effects.factor @@ -49,7 +49,7 @@ TUPLE: effect [ [ terminated?>> ] same? ] 2tri and and ; -GENERIC: effect>string ( obj -- str ) +GENERIC: effect>string ( obj -- str ) ; M: string effect>string ; M: object effect>string drop "object" ; M: word effect>string name>> ; @@ -80,7 +80,7 @@ M: effect effect>string ( effect -- string ) ")" % ] "" make ; -GENERIC: effect>type ( obj -- type ) +GENERIC: effect>type ( obj -- type ) ; M: object effect>type drop object ; M: word effect>type ; M: pair effect>type second-unsafe effect>type ; @@ -92,7 +92,7 @@ M: classoid effect>type ; : effect-out-types ( effect -- input-types ) out>> [ effect>type ] map ; -GENERIC: stack-effect ( word -- effect/f ) +GENERIC: stack-effect ( word -- effect/f ) ; M: word stack-effect dup "declared-effect" word-prop [ nip ] [ diff --git a/core/fry/fry.factor b/core/fry/fry.factor index 387934396a..c9a7fda4aa 100644 --- a/core/fry/fry.factor +++ b/core/fry/fry.factor @@ -10,7 +10,7 @@ in: fry ERROR: >r/r>-in-fry-error ; -GENERIC: fry ( quot -- quot' ) +GENERIC: fry ( quot -- quot' ) ; boolean ; @@ -63,7 +63,7 @@ PRIVATE> [ nip ] [ nearest-class ] 2bi [ swap ?lookup-method ] [ drop f ] if* ; -GENERIC: effective-method ( generic -- method ) +GENERIC: effective-method ( generic -- method ) ; \ effective-method t "no-compile" set-word-prop @@ -73,7 +73,7 @@ GENERIC: effective-method ( generic -- method ) : next-method ( class generic -- method/f ) [ next-method-class ] keep ?lookup-method ; -GENERIC: next-method-quot* ( class generic combination -- quot ) +GENERIC: next-method-quot* ( class generic combination -- quot ) ; : next-method-quot ( method -- quot ) next-method-quot-cache get [ @@ -103,7 +103,7 @@ ERROR: check-method-error class generic ; outdated-generics get members [ generic? ] filter [ make-generic ] each ; -GENERIC: update-generic ( class generic -- ) +GENERIC: update-generic ( class generic -- ) ; : with-methods ( class generic quot -- ) [ "methods" word-prop ] prepose [ update-generic ] 2bi ; inline @@ -128,7 +128,7 @@ M: method crossref? [ method-word-name f ] [ method-word-props ] 2bi >>props ; -GENERIC: implementor-classes ( obj -- class ) +GENERIC: implementor-classes ( obj -- class ) ; M: maybe implementor-classes class>> 1array ; @@ -186,7 +186,7 @@ M: method forget* [ call-next-method ] bi ] if ; -GENERIC# check-combination-effect 1 ( combination effect -- ) +GENERIC# check-combination-effect 1 ( combination effect -- ) ; M: object check-combination-effect 2drop ; diff --git a/core/generic/hook/hook-tests.factor b/core/generic/hook/hook-tests.factor index 10e80df411..12a4f06c4c 100644 --- a/core/generic/hook/hook-tests.factor +++ b/core/generic/hook/hook-tests.factor @@ -3,7 +3,7 @@ namespaces sequences strings tools.test vectors words ; in: generic.hook.tests symbol: my-var -HOOK: my-hook my-var ( -- x ) +HOOK: my-hook my-var ( -- x ) ; M: integer my-hook "an integer" ; M: string my-hook "a string" ; @@ -12,7 +12,7 @@ M: string my-hook "a string" ; { "a string" } [ my-hook my-var set my-hook ] unit-test [ 1.0 my-var set my-hook ] [ T{ no-method f 1.0 my-hook } = ] must-fail-with -HOOK: call-next-hooker my-var ( -- x ) +HOOK: call-next-hooker my-var ( -- x ) ; M: sequence call-next-hooker "sequence" ; diff --git a/core/generic/parser/parser.factor b/core/generic/parser/parser.factor index 7919926a38..da11c2ad21 100644 --- a/core/generic/parser/parser.factor +++ b/core/generic/parser/parser.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays combinators effects.parser generic -kernel namespaces parser quotations sequences words ; +kernel namespaces parser quotations sequences words lexer ; in: generic.parser ERROR: not-in-a-method-error ; @@ -9,7 +9,7 @@ ERROR: not-in-a-method-error ; : scan-new-generic ( -- word ) scan-new dup reset-word ; : (GENERIC:) ( quot -- ) - [ scan-new-generic ] dip call scan-effect define-generic ; inline + [ scan-new-generic ] dip call scan-effect ";" expect define-generic ; inline : create-method-in ( class generic -- method ) create-method dup set-last-word dup save-location ; diff --git a/core/generic/single/single-docs.factor b/core/generic/single/single-docs.factor index b05700ebfa..afaf58b83e 100644 --- a/core/generic/single/single-docs.factor +++ b/core/generic/single/single-docs.factor @@ -12,7 +12,7 @@ HELP: inconsistent-next-method { $examples "The following code throws this error:" { $code - "GENERIC: error-test ( object -- )" + "GENERIC: error-test ( object -- ) ;" "" "M: string error-test print ;" "" diff --git a/core/generic/single/single.factor b/core/generic/single/single.factor index 4324e44843..c441fdbe1f 100644 --- a/core/generic/single/single.factor +++ b/core/generic/single/single.factor @@ -25,7 +25,7 @@ PREDICATE: single-generic < generic M: single-generic make-inline cannot-be-inline ; -GENERIC: dispatch# ( word -- n ) +GENERIC: dispatch# ( word -- n ) ; M: generic dispatch# "combination" word-prop dispatch# ; @@ -37,7 +37,7 @@ symbol: combination : with-combination ( combination quot -- ) [ combination ] dip with-variable ; inline -HOOK: picker combination ( -- quot ) +HOOK: picker combination ( -- quot ) ; M: single-combination next-method-quot* ( class generic combination -- quot ) [ @@ -148,7 +148,7 @@ C: tag-dispatch-engine ; ! ! ! Compile engine ! ! ! -GENERIC: compile-engine ( engine -- obj ) +GENERIC: compile-engine ( engine -- obj ) ; : compile-engines ( assoc -- assoc' ) [ compile-engine ] assoc-map ; @@ -260,7 +260,7 @@ M: f compile-engine ; [ compile-engine ] bi ] tri ; -HOOK: inline-cache-quots combination ( word methods -- pic-quot/f pic-tail-quot/f ) +HOOK: inline-cache-quots combination ( word methods -- pic-quot/f pic-tail-quot/f ) ; M: single-combination inline-cache-quots 2drop f f ; @@ -269,7 +269,7 @@ M: single-combination inline-cache-quots 2drop f f ; [ >>pic-def ] [ >>pic-tail-def ] bi* drop ; -HOOK: mega-cache-quot combination ( methods -- quot/f ) +HOOK: mega-cache-quot combination ( methods -- quot/f ) ; M: single-combination perform-combination [ diff --git a/core/generic/standard/standard-tests.factor b/core/generic/standard/standard-tests.factor index 0620e65a70..52c210f443 100644 --- a/core/generic/standard/standard-tests.factor +++ b/core/generic/standard/standard-tests.factor @@ -8,7 +8,7 @@ QUALIFIED-WITH: alien.c-types c SPECIALIZED-VECTOR: c:double in: generic.standard.tests -GENERIC: class-of ( x -- y ) +GENERIC: class-of ( x -- y ) ; M: fixnum class-of drop "fixnum" ; M: word class-of drop "word" ; @@ -17,14 +17,14 @@ M: word class-of drop "word" ; { "word" } [ \ class-of class-of ] unit-test [ 3.4 class-of ] must-fail -GENERIC: foobar ( x -- y ) +GENERIC: foobar ( x -- y ) ; M: object foobar drop "Hello world" ; M: fixnum foobar drop "Goodbye cruel world" ; { "Hello world" } [ 4 foobar foobar ] unit-test { "Goodbye cruel world" } [ 4 foobar ] unit-test -GENERIC: lo-tag-test ( obj -- obj' ) +GENERIC: lo-tag-test ( obj -- obj' ) ; M: integer lo-tag-test 3 + ; M: float lo-tag-test 4 - ; @@ -36,7 +36,7 @@ M: complex lo-tag-test sq ; { -1/2 } [ 1+1/2 lo-tag-test ] unit-test { -16 } [ C{ 0 4 } lo-tag-test ] unit-test -GENERIC: hi-tag-test ( obj -- obj' ) +GENERIC: hi-tag-test ( obj -- obj' ) ; M: string hi-tag-test ", in bed" append ; M: integer hi-tag-test 3 + ; @@ -51,11 +51,11 @@ M: sequence hi-tag-test reverse ; UNION: funnies quotation float complex ; -GENERIC: funny ( x -- y ) +GENERIC: funny ( x -- y ) ; M: funnies funny drop 2 ; M: object funny drop 0 ; -GENERIC: union-containment ( x -- y ) +GENERIC: union-containment ( x -- y ) ; M: integer union-containment drop 1 ; M: number union-containment drop 2 ; @@ -81,7 +81,7 @@ TUPLE: circle < shape radius ; C: circle -GENERIC: area ( shape -- n ) +GENERIC: area ( shape -- n ) ; M: abstract-rectangle area [ width>> ] [ height>> ] bi * ; @@ -91,7 +91,7 @@ M: circle area radius>> sq pi * ; { 12 } [ 4 3 2 area ] unit-test { t } [ 2 area 4 pi * = ] unit-test -GENERIC: perimeter ( shape -- n ) +GENERIC: perimeter ( shape -- n ) ; : rectangle-perimeter ( l w -- n ) + 2 * ; @@ -113,12 +113,12 @@ M: circle perimeter 2 * pi * ; PREDICATE: very-funny < funnies number? ; -GENERIC: gooey ( x -- y ) +GENERIC: gooey ( x -- y ) ; M: very-funny gooey sq ; { 0.25 } [ 0.5 gooey ] unit-test -GENERIC: empty-method-test ( x -- y ) +GENERIC: empty-method-test ( x -- y ) ; M: object empty-method-test ; TUPLE: for-arguments-sake ; C: for-arguments-sake @@ -131,7 +131,7 @@ C: another-one { "Hi" } [ empty-method-test empty-method-test ] unit-test { T{ another-one f } } [ empty-method-test ] unit-test -GENERIC: big-mix-test ( obj -- obj' ) +GENERIC: big-mix-test ( obj -- obj' ) ; M: object big-mix-test drop "object" ; @@ -171,7 +171,7 @@ M: circle big-mix-test drop "circle" ; { "tuple" } [ H{ } big-mix-test ] unit-test { "object" } [ \ + big-mix-test ] unit-test -GENERIC: small-lo-tag ( obj -- obj ) +GENERIC: small-lo-tag ( obj -- obj ) ; M: fixnum small-lo-tag drop "fixnum" ; @@ -188,13 +188,13 @@ M: byte-array small-lo-tag drop "byte-array" ; { "double-array" } [ double-array{ 1.0 } small-lo-tag ] unit-test ! Testing recovery from bad method definitions -"IN: generic.standard.tests GENERIC: unhappy ( x -- x )" eval( -- ) +"IN: generic.standard.tests GENERIC: unhappy ( x -- x )" eval( -- ) ; [ "IN: generic.standard.tests M: dictionary unhappy ;" eval( -- ) ] must-fail -{ } [ "IN: generic.standard.tests GENERIC: unhappy ( x -- x )" eval( -- ) ] unit-test +{ } [ "IN: generic.standard.tests GENERIC: unhappy ( x -- x )" eval( -- ) ; ] unit-test -GENERIC# complex-combination 1 ( a b -- c ) +GENERIC# complex-combination 1 ( a b -- c ) ; M: string complex-combination drop ; M: object complex-combination nip ; @@ -206,7 +206,7 @@ TUPLE: first-one ; TUPLE: second-one ; UNION: both first-one union-class ; -GENERIC: wii ( x -- y ) +GENERIC: wii ( x -- y ) ; M: both wii drop 3 ; M: second-one wii drop 4 ; M: tuple-class wii drop 5 ; @@ -214,7 +214,7 @@ M: integer wii drop 6 ; { 3 } [ T{ first-one } wii ] unit-test -GENERIC: tag-and-f ( x -- x x ) +GENERIC: tag-and-f ( x -- x x ) ; M: fixnum tag-and-f 1 ; @@ -229,7 +229,7 @@ M: f tag-and-f 4 ; { 3.4 3 } [ 3.4 tag-and-f ] unit-test ! Issues with forget -GENERIC: generic-forget-test ( a -- b ) +GENERIC: generic-forget-test ( a -- b ) ; M: f generic-forget-test ; @@ -247,10 +247,10 @@ M: f generic-forget-test ; { } [ "IN: generic.standard.tests - GENERIC: jeah ( a -- b ) + GENERIC: jeah ( a -- b ) ; TUPLE: boii ; M: boii jeah ; - GENERIC: jeah* ( a -- b ) + GENERIC: jeah* ( a -- b ) ; M: boii jeah* jeah ;" eval( -- ) "IN: generic.standard.tests @@ -282,7 +282,7 @@ TUPLE: executive < senior-manager ; TUPLE: ceo < executive ; -GENERIC: salary ( person -- n ) +GENERIC: salary ( person -- n ) ; M: intern salary ! Intentional mistake. @@ -332,7 +332,7 @@ UNION: y a c ; UNION: z x y ; -GENERIC: funky* ( obj -- ) +GENERIC: funky* ( obj -- ) ; M: z funky* "z" , drop ; @@ -358,14 +358,14 @@ M: c funky* "c" , call-next-method ; ] unit-test ! Changing method combination should not fail -{ } [ "IN: generic.standard.tests GENERIC: xyz ( a -- b )" eval( -- ) ] unit-test +{ } [ "IN: generic.standard.tests GENERIC: xyz ( a -- b )" eval( -- ) ; ] unit-test { } [ "IN: generic.standard.tests MATH: xyz ( a b -- c )" eval( -- ) ] unit-test { f } [ "xyz" "generic.standard.tests" lookup-word pic-def>> ] unit-test { f } [ "xyz" "generic.standard.tests" lookup-word "decision-tree" word-prop ] unit-test ! Corner cases -[ "IN: generic.standard.tests GENERIC: broken-generic ( -- )" eval( -- ) ] +[ "IN: generic.standard.tests GENERIC: broken-generic ( -- )" eval( -- ) ; ] [ error>> bad-dispatch-position? ] must-fail-with [ "IN: generic.standard.tests GENERIC# broken-generic# -1 ( a -- b )" eval( -- ) ] @@ -379,11 +379,11 @@ must-fail-with must-fail-with ! Generic words cannot be inlined -{ } [ "IN: generic.standard.tests GENERIC: foo ( x -- x )" eval( -- ) ] unit-test -[ "IN: generic.standard.tests GENERIC: foo ( x -- x ) inline" eval( -- ) ] must-fail +{ } [ "IN: generic.standard.tests GENERIC: foo ( x -- x )" eval( -- ) ; ] unit-test +[ "IN: generic.standard.tests GENERIC: foo ( x -- x ) inline" eval( -- ) ; ] must-fail ! Moving a method from one vocab to another didn't always work -GENERIC: move-method-generic ( a -- b ) +GENERIC: move-method-generic ( a -- b ) ; { } [ "IN: generic.standard.tests.a USE: strings USE: generic.standard.tests M: string move-method-generic ;" "move-method-test-1" parse-stream drop ] unit-test @@ -394,7 +394,7 @@ GENERIC: move-method-generic ( a -- b ) { { string } } [ \ move-method-generic order ] unit-test ! FORGET: on method wrappers -GENERIC: forget-test ( a -- b ) +GENERIC: forget-test ( a -- b ) ; M: integer forget-test 3 + ; @@ -408,20 +408,20 @@ M: integer forget-test 3 + ; [ 10 forget-test ] [ no-method? ] must-fail-with ! Declarations on methods -GENERIC: flushable-generic ( a -- b ) flushable +GENERIC: flushable-generic ( a -- b ) ; flushable M: integer flushable-generic ; { t } [ \ flushable-generic flushable? ] unit-test { t } [ M\ integer flushable-generic flushable? ] unit-test -GENERIC: non-flushable-generic ( a -- b ) +GENERIC: non-flushable-generic ( a -- b ) ; M: integer non-flushable-generic ; flushable { f } [ \ non-flushable-generic flushable? ] unit-test { t } [ M\ integer non-flushable-generic flushable? ] unit-test ! method-for-object, method-for-class, effective-method -GENERIC: foozul ( a -- b ) +GENERIC: foozul ( a -- b ) ; M: reversed foozul ; M: integer foozul ; M: slice foozul ; @@ -438,7 +438,7 @@ M: slice foozul ; UNION: amb-union-1a integer float ; UNION: amb-union-1b float string ; -GENERIC: amb-generic-1 ( a -- b ) +GENERIC: amb-generic-1 ( a -- b ) ; M: amb-union-1a amb-generic-1 drop "a" ; M: amb-union-1b amb-generic-1 drop "b" ; @@ -456,7 +456,7 @@ M: amb-union-1b amb-generic-1 drop "b" ; UNION: amb-union-2a float string ; UNION: amb-union-2b integer float ; -GENERIC: amb-generic-2 ( a -- b ) +GENERIC: amb-generic-2 ( a -- b ) ; M: amb-union-2a amb-generic-2 drop "a" ; M: amb-union-2b amb-generic-2 drop "b" ; @@ -475,7 +475,7 @@ TUPLE: amb-tuple-a x ; TUPLE: amb-tuple-b < amb-tuple-a ; PREDICATE: amb-tuple-c < amb-tuple-a x>> 3 = ; -GENERIC: amb-generic-3 ( a -- b ) +GENERIC: amb-generic-3 ( a -- b ) ; M: amb-tuple-b amb-generic-3 drop "b" ; M: amb-tuple-c amb-generic-3 drop "c" ; @@ -488,7 +488,7 @@ M: amb-tuple-c amb-generic-3 drop "c" ; TUPLE: amb-tuple-d ; UNION: amb-union-4 amb-tuple-a amb-tuple-d ; -GENERIC: amb-generic-4 ( a -- b ) +GENERIC: amb-generic-4 ( a -- b ) ; M: amb-tuple-b amb-generic-4 drop "b" ; M: amb-union-4 amb-generic-4 drop "4" ; @@ -507,7 +507,7 @@ mixin: amb-mixin-5 INSTANCE: amb-tuple-a amb-mixin-5 INSTANCE: amb-tuple-d amb-mixin-5 -GENERIC: amb-generic-5 ( a -- b ) +GENERIC: amb-generic-5 ( a -- b ) ; M: amb-tuple-b amb-generic-5 drop "b" ; M: amb-mixin-5 amb-generic-5 drop "5" ; @@ -524,7 +524,7 @@ M: amb-mixin-5 amb-generic-5 drop "5" ; UNION: amb-union-6 amb-tuple-b amb-tuple-d ; -GENERIC: amb-generic-6 ( a -- b ) +GENERIC: amb-generic-6 ( a -- b ) ; M: amb-tuple-a amb-generic-6 drop "a" ; M: amb-union-6 amb-generic-6 drop "6" ; @@ -543,7 +543,7 @@ mixin: amb-mixin-7 INSTANCE: amb-tuple-b amb-mixin-7 INSTANCE: amb-tuple-d amb-mixin-7 -GENERIC: amb-generic-7 ( a -- b ) +GENERIC: amb-generic-7 ( a -- b ) ; M: amb-tuple-a amb-generic-7 drop "a" ; M: amb-mixin-7 amb-generic-7 drop "7" ; @@ -564,7 +564,7 @@ PREDICATE: amb-predicate-b < amb-predicate-a 10 mod 4 = ; UNION: amb-union-8 amb-predicate-b string ; -GENERIC: amb-generic-8 ( a -- b ) +GENERIC: amb-generic-8 ( a -- b ) ; M: amb-union-8 amb-generic-8 drop "8" ; M: amb-predicate-a amb-generic-8 drop "a" ; diff --git a/core/grouping/grouping.factor b/core/grouping/grouping.factor index a5cb2a2cb3..b2146bf67d 100644 --- a/core/grouping/grouping.factor +++ b/core/grouping/grouping.factor @@ -8,7 +8,7 @@ ERROR: groups-error seq n ; : expand ( len seq -- ) [ resize ] change-underlying drop ; inline -GENERIC: contract ( len seq -- ) +GENERIC: contract ( len seq -- ) ; M: growable contract ( len seq -- ) [ length ] keep diff --git a/core/hashtables/wrapped/wrapped.factor b/core/hashtables/wrapped/wrapped.factor index 30926c22b7..8e656139b6 100644 --- a/core/hashtables/wrapped/wrapped.factor +++ b/core/hashtables/wrapped/wrapped.factor @@ -11,7 +11,7 @@ TUPLE: wrapped-key TUPLE: wrapped-hashtable { underlying hashtable read-only } ; -GENERIC: wrap-key ( key wrapped-hash -- wrapped-key ) +GENERIC: wrap-key ( key wrapped-hash -- wrapped-key ) ; input-stream set-global ] [ utf8 output-stream set-global ] [ utf8 error-stream set-global ] tri* ; -HOOK: io-multiplex io-backend ( nanos -- ) +HOOK: io-multiplex io-backend ( nanos -- ) ; -HOOK: normalize-directory io-backend ( path -- path' ) +HOOK: normalize-directory io-backend ( path -- path' ) ; -HOOK: normalize-path io-backend ( path -- path' ) +HOOK: normalize-path io-backend ( path -- path' ) ; M: object normalize-directory normalize-path ; diff --git a/core/io/encodings/ascii/ascii.factor b/core/io/encodings/ascii/ascii.factor index 73fe66b852..10116a7a33 100644 --- a/core/io/encodings/ascii/ascii.factor +++ b/core/io/encodings/ascii/ascii.factor @@ -12,7 +12,7 @@ M: ascii encode-char ( string -- byte-array ) +GENERIC: ascii> ( string -- byte-array ) ; M: object ascii> [ dup 127 <= [ encode-error ] unless ] B{ } map-as ; inline diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index d538ada19f..fd44202523 100644 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -7,15 +7,15 @@ in: io.encodings ! The encoding descriptor protocol -GENERIC: guess-encoded-length ( string-length encoding -- byte-length ) -GENERIC: guess-decoded-length ( byte-length encoding -- string-length ) +GENERIC: guess-encoded-length ( string-length encoding -- byte-length ) ; +GENERIC: guess-decoded-length ( byte-length encoding -- string-length ) ; M: object guess-decoded-length drop ; inline M: object guess-encoded-length drop ; inline -GENERIC: decode-char ( stream encoding -- char/f ) +GENERIC: decode-char ( stream encoding -- char/f ) ; -GENERIC: decode-until ( seps stream encoding -- string/f sep/f ) +GENERIC: decode-until ( seps stream encoding -- string/f sep/f ) ; -GENERIC: encode-char ( char stream encoding -- ) +GENERIC: encode-char ( char stream encoding -- ) ; -GENERIC: encode-string ( string stream encoding -- ) +GENERIC: encode-string ( string stream encoding -- ) ; M: object encode-string [ encode-char ] 2curry each ; inline -GENERIC: ( stream encoding -- newstream ) +GENERIC: ( stream encoding -- newstream ) ; TUPLE: decoder { stream read-only } { code read-only } { cr boolean } ; INSTANCE: decoder input-stream ERROR: decode-error ; -GENERIC: ( stream encoding -- newstream ) +GENERIC: ( stream encoding -- newstream ) ; TUPLE: encoder { stream read-only } { code read-only } ; INSTANCE: encoder output-stream @@ -205,7 +205,7 @@ INSTANCE: encoder plain-writer PRIVATE> -GENERIC# re-encode 1 ( stream encoding -- newstream ) +GENERIC# re-encode 1 ( stream encoding -- newstream ) ; M: object re-encode ; @@ -218,7 +218,7 @@ M: encoder re-encode [ stream>> ] dip re-encode ; [ [ output-stream get ] dip re-encode ] dip with-output-stream* ; inline -GENERIC# re-decode 1 ( stream encoding -- newstream ) +GENERIC# re-decode 1 ( stream encoding -- newstream ) ; M: object re-decode ; diff --git a/core/io/encodings/utf16/utf16.factor b/core/io/encodings/utf16/utf16.factor index 0e1feea76f..1c5fb10555 100644 --- a/core/io/encodings/utf16/utf16.factor +++ b/core/io/encodings/utf16/utf16.factor @@ -114,7 +114,7 @@ M: utf16le encode-char ( char stream encoding -- ) : ascii-string>utf16be ( string stream -- ) [ 1 swap ascii-string>utf16-byte-array ] dip stream-write ; inline -GENERIC# encode-string-utf16le 1 ( string stream -- ) +GENERIC# encode-string-utf16le 1 ( string stream -- ) ; M: object encode-string-utf16le [ char>utf16le ] curry each ; inline @@ -126,7 +126,7 @@ M: string encode-string-utf16le M: utf16le encode-string drop encode-string-utf16le ; -GENERIC# encode-string-utf16be 1 ( string stream -- ) +GENERIC# encode-string-utf16be 1 ( string stream -- ) ; M: object encode-string-utf16be [ char>utf16be ] curry each ; inline diff --git a/core/io/encodings/utf8/utf8.factor b/core/io/encodings/utf8/utf8.factor index 5c068a47fd..aca2593faf 100644 --- a/core/io/encodings/utf8/utf8.factor +++ b/core/io/encodings/utf8/utf8.factor @@ -84,7 +84,7 @@ M: utf8 decode-until (decode-until) ; M: utf8 encode-char drop char>utf8 ; -GENERIC# encode-string-utf8 1 ( string stream -- ) +GENERIC# encode-string-utf8 1 ( string stream -- ) ; M: object encode-string-utf8 [ char>utf8 ] curry each ; inline diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 53893229ce..5fa07c0156 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -15,10 +15,10 @@ symbol: +output+ ! Returns an event to wait for which will ensure completion of ! this request -GENERIC: drain ( port handle -- event/f ) -GENERIC: refill ( port handle -- event/f ) +GENERIC: drain ( port handle -- event/f ) ; +GENERIC: refill ( port handle -- event/f ) ; -HOOK: wait-for-fd io-backend ( handle event -- ) +HOOK: wait-for-fd io-backend ( handle event -- ) ; mixin: file-reader mixin: file-writer @@ -26,11 +26,11 @@ mixin: file-writer M: file-reader stream-element-type drop +byte+ ; inline M: file-writer stream-element-type drop +byte+ ; inline -HOOK: (file-reader) io-backend ( path -- stream ) +HOOK: (file-reader) io-backend ( path -- stream ) ; -HOOK: (file-writer) io-backend ( path -- stream ) +HOOK: (file-writer) io-backend ( path -- stream ) ; -HOOK: (file-appender) io-backend ( path -- stream ) +HOOK: (file-appender) io-backend ( path -- stream ) ; : ( path encoding -- stream ) [ normalize-path (file-reader) { file-reader } declare ] dip ; inline @@ -76,9 +76,9 @@ HOOK: (file-appender) io-backend ( path -- stream ) ! Current directory : path-components ( path -- seq ) normalize-path path-separator split harvest ; -HOOK: resolve-symlinks os ( path -- path' ) +HOOK: resolve-symlinks os ( path -- path' ) ; M: object resolve-symlinks normalize-path ; : resource-path ( path -- newpath ) "resource-path" get prepend-path ; -HOOK: home io-backend ( -- dir ) +HOOK: home io-backend ( -- dir ) ; M: object home "" resource-path ; -GENERIC: vocab-path ( path -- newpath ) +GENERIC: vocab-path ( path -- newpath ) ; -GENERIC: absolute-path ( path -- path' ) +GENERIC: absolute-path ( path -- path' ) ; M: string absolute-path "resource:" ?head [ diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index c5b38a1ab3..1449089f45 100644 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -744,7 +744,7 @@ HELP: set-special-object HELP: object { $class-description "The class of all objects. If a generic word defines a method specializing on this class, the method is used as a fallback, if no other applicable method is found. For instance:" - { $code "GENERIC: enclose ( number -- array )" "M: number enclose 1array ;" "M: object enclose ;" } + { $code "GENERIC: enclose ( number -- array ) ;" "M: number enclose 1array ;" "M: object enclose ;" } } ; HELP: null diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index ea0bf59b32..8613743309 100644 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -71,9 +71,9 @@ DEFER: 3dip : clear ( -- ) { } set-datastack ; ! Combinators -GENERIC: call ( callable -- ) +GENERIC: call ( callable -- ) ; -GENERIC: execute ( word -- ) +GENERIC: execute ( word -- ) ; DEFER: if @@ -247,7 +247,7 @@ UNION: boolean postpone: t postpone: f ; [ [ not ] compose ] dip while ; inline ! Object protocol -GENERIC: hashcode* ( depth obj -- code ) +GENERIC: hashcode* ( depth obj -- code ) ; M: object hashcode* 2drop 0 ; inline @@ -265,7 +265,7 @@ M: f hashcode* 2drop 31337 ; inline ] if ] unless ; inline -GENERIC: equal? ( obj1 obj2 -- ? ) +GENERIC: equal? ( obj1 obj2 -- ? ) ; M: object equal? 2drop f ; inline @@ -282,20 +282,20 @@ M: identity-tuple hashcode* nip identity-hashcode ; inline : same? ( x y quot -- ? ) bi@ = ; inline -GENERIC: clone ( obj -- cloned ) +GENERIC: clone ( obj -- cloned ) ; M: object clone ; inline M: callstack clone (clone) ; inline ! Tuple construction -GENERIC: new ( class -- tuple ) +GENERIC: new ( class -- tuple ) ; -GENERIC: boa ( slots... class -- tuple ) +GENERIC: boa ( slots... class -- tuple ) ; ! Error handling -- defined early so that other files can ! throw errors before continuations are loaded -GENERIC: throw ( error -- * ) +GENERIC: throw ( error -- * ) ; ERROR: assert got expect ; diff --git a/core/lexer/lexer.factor b/core/lexer/lexer.factor index 169db3a2ad..c44e193662 100644 --- a/core/lexer/lexer.factor +++ b/core/lexer/lexer.factor @@ -61,7 +61,7 @@ ERROR: unexpected want got ; [ check-lexer [ column>> ] [ line-text>> ] bi ] prepose keep column<< ; inline -GENERIC: skip-blank ( lexer -- ) +GENERIC: skip-blank ( lexer -- ) ; boolean ; ! Lambdas/locals need to expose their uninterned subwords in order ! to make a boot image. -GENERIC: lambda-subwords ( obj -- ) +GENERIC: lambda-subwords ( obj -- ) ; M: object lambda-subwords drop ; diff --git a/core/locals/locals-tests.factor b/core/locals/locals-tests.factor index 2563259d36..196f67d2c5 100644 --- a/core/locals/locals-tests.factor +++ b/core/locals/locals-tests.factor @@ -101,9 +101,9 @@ write-test-2 "q" set { 13 } [ 10 let-let-test ] unit-test -GENERIC: lambda-generic ( a b -- c ) +GENERIC: lambda-generic ( a b -- c ) ; -GENERIC# lambda-generic-1 1 ( a b -- c ) +GENERIC# lambda-generic-1 1 ( a b -- c ) ; M:: integer lambda-generic-1 ( a b -- c ) a b * ; @@ -112,7 +112,7 @@ M:: string lambda-generic-1 ( a b -- c ) M:: integer lambda-generic ( a b -- c ) a b lambda-generic-1 ; -GENERIC# lambda-generic-2 1 ( a b -- c ) +GENERIC# lambda-generic-2 1 ( a b -- c ) ; M:: integer lambda-generic-2 ( a b -- c ) a CHAR: x b lambda-generic ; @@ -150,20 +150,20 @@ M:: string lambda-generic ( a b -- c ) a b lambda-generic-2 ; DEFER: xyzzy { } [ - "IN: locals.tests USE: math GENERIC: xyzzy ( a -- b ) M: integer xyzzy ;" + "IN: locals.tests USE: math GENERIC: xyzzy ( a -- b ) ; M: integer xyzzy ;" "lambda-generic-test" parse-stream drop ] unit-test { 10 } [ 10 xyzzy ] unit-test { } [ - "IN: locals.tests USE: math USE: locals GENERIC: xyzzy ( a -- b ) M:: integer xyzzy ( n -- x ) 5 ;" + "IN: locals.tests USE: math USE: locals GENERIC: xyzzy ( a -- b ) M:: integer xyzzy ( n -- x ) ; 5 ;" "lambda-generic-test" parse-stream drop ] unit-test { 5 } [ 10 xyzzy ] unit-test -GENERIC: next-method-test ( a -- b ) +GENERIC: next-method-test ( a -- b ) ; M: integer next-method-test 3 + ; @@ -196,7 +196,7 @@ CONSTANT: new-definition "USING: math ;\nIN: locals.tests\n: a-word-with-locals CONSTANT: method-definition "USING: locals.tests sequences ;\nM:: sequence method-with-locals ( a -- y ) a reverse ;\n" -GENERIC: method-with-locals ( x -- y ) +GENERIC: method-with-locals ( x -- y ) ; M:: sequence method-with-locals ( a -- y ) a reverse ; @@ -379,7 +379,7 @@ ERROR: punned-class x ; \ littledan-case-problem-4 def>> must-infer */ -GENERIC: lambda-method-forget-test ( a -- b ) +GENERIC: lambda-method-forget-test ( a -- b ) ; M:: integer lambda-method-forget-test ( a -- b ) a ; @@ -482,7 +482,7 @@ M:: integer lambda-method-forget-test ( a -- b ) a ; { 3 } [ 3 t erg's-:>-bug-2 ] unit-test ! dharmatech found this problem -GENERIC: ed's-bug ( a -- b ) +GENERIC: ed's-bug ( a -- b ) ; M: string ed's-bug reverse ; M: integer ed's-bug neg ; diff --git a/core/locals/rewrite/closures/closures.factor b/core/locals/rewrite/closures/closures.factor index ce8f89f3fe..3f51a35dd1 100644 --- a/core/locals/rewrite/closures/closures.factor +++ b/core/locals/rewrite/closures/closures.factor @@ -8,7 +8,7 @@ in: locals.rewrite.closures ! Step 2: identify free variables and make them into explicit ! parameters of lambdas which are curried on -GENERIC: rewrite-closures* ( obj -- ) +GENERIC: rewrite-closures* ( obj -- ) ; : (rewrite-closures) ( form -- form' ) [ [ rewrite-closures* ] each ] [ ] make ; @@ -16,7 +16,7 @@ GENERIC: rewrite-closures* ( obj -- ) : rewrite-closures ( form -- form' ) expand-macros (rewrite-sugar) (rewrite-closures) point-free ; -GENERIC: defs-vars* ( seq form -- seq' ) +GENERIC: defs-vars* ( seq form -- seq' ) ; : defs-vars ( form -- vars ) { } [ defs-vars* ] reduce members ; @@ -26,7 +26,7 @@ M: quotation defs-vars* [ defs-vars* ] each ; M: object defs-vars* drop ; -GENERIC: uses-vars* ( seq form -- seq' ) +GENERIC: uses-vars* ( seq form -- seq' ) ; : uses-vars ( form -- vars ) { } [ uses-vars* ] reduce members ; diff --git a/core/locals/rewrite/point-free/point-free.factor b/core/locals/rewrite/point-free/point-free.factor index c8c84b32bc..ef4dedb41c 100644 --- a/core/locals/rewrite/point-free/point-free.factor +++ b/core/locals/rewrite/point-free/point-free.factor @@ -15,7 +15,7 @@ in: locals.rewrite.point-free : read-local-quot ( args obj -- quot ) local-index neg [ get-local ] curry ; -GENERIC: localize ( args obj -- args quot ) +GENERIC: localize ( args obj -- args quot ) ; M: local localize dupd read-local-quot ; diff --git a/core/locals/rewrite/sugar/sugar.factor b/core/locals/rewrite/sugar/sugar.factor index 75bb5458ae..0713f50614 100644 --- a/core/locals/rewrite/sugar/sugar.factor +++ b/core/locals/rewrite/sugar/sugar.factor @@ -10,12 +10,12 @@ in: locals.rewrite.sugar ! literals with locals in them into code which constructs ! the literal after pushing locals on the stack -GENERIC: rewrite-sugar* ( obj -- ) +GENERIC: rewrite-sugar* ( obj -- ) ; : (rewrite-sugar) ( form -- form' ) [ rewrite-sugar* ] [ ] make ; -GENERIC: quotation-rewrite ( form -- form' ) +GENERIC: quotation-rewrite ( form -- form' ) ; M: callable quotation-rewrite [ [ rewrite-sugar* ] each ] [ ] make ; @@ -29,7 +29,7 @@ M: callable rewrite-sugar* quotation-rewrite , ; M: lambda rewrite-sugar* quotation-rewrite , ; -GENERIC: rewrite-literal? ( obj -- ? ) +GENERIC: rewrite-literal? ( obj -- ? ) ; M: special rewrite-literal? drop t ; @@ -47,7 +47,7 @@ M: tuple rewrite-literal? tuple>array rewrite-literal? ; M: object rewrite-literal? drop f ; -GENERIC: rewrite-element ( obj -- ) +GENERIC: rewrite-element ( obj -- ) ; : rewrite-elements ( seq -- ) [ rewrite-element ] each ; diff --git a/core/macros/expander/expander.factor b/core/macros/expander/expander.factor index 42eca5761f..7bc9167df7 100644 --- a/core/macros/expander/expander.factor +++ b/core/macros/expander/expander.factor @@ -6,7 +6,7 @@ namespaces quotations sequences sequences.private vectors words ; in: macros.expander -GENERIC: expand-macros ( quot -- quot' ) +GENERIC: expand-macros ( quot -- quot' ) ; symbol: stack @@ -16,13 +16,13 @@ symbol: stack : end ( -- ) stack get [ [ literalize , ] each ] [ delete-all ] bi ; -GENERIC: condomize? ( obj -- ? ) +GENERIC: condomize? ( obj -- ? ) ; M: array condomize? [ condomize? ] any? ; M: callable condomize? [ condomize? ] any? ; M: object condomize? drop f ; -GENERIC: condomize ( obj -- obj' ) +GENERIC: condomize ( obj -- obj' ) ; M: array condomize [ condomize ] map ; M: callable condomize [ condomize ] map ; @@ -31,7 +31,7 @@ M: object condomize ; : literal ( obj -- ) dup condomize? [ condomize ] when stack get push ; -GENERIC: expand-macros* ( obj -- ) +GENERIC: expand-macros* ( obj -- ) ; M: wrapper expand-macros* wrapped>> literal ; diff --git a/core/math/math.factor b/core/math/math.factor index a95cb7c518..2fe944d4fa 100644 --- a/core/math/math.factor +++ b/core/math/math.factor @@ -75,59 +75,59 @@ PRIMITIVE: float>bignum ( x -- y ) ; PRIMITIVE: float>fixnum ( x -- y ) ; PRIVATE> -GENERIC: >fixnum ( x -- n ) foldable -GENERIC: >bignum ( x -- n ) foldable -GENERIC: >integer ( x -- n ) foldable -GENERIC: >float ( x -- y ) foldable -GENERIC: integer>fixnum ( x -- y ) foldable -GENERIC: integer>fixnum-strict ( x -- y ) foldable +GENERIC: >fixnum ( x -- n ) ; foldable +GENERIC: >bignum ( x -- n ) ; foldable +GENERIC: >integer ( x -- n ) ; foldable +GENERIC: >float ( x -- y ) ; foldable +GENERIC: integer>fixnum ( x -- y ) ; foldable +GENERIC: integer>fixnum-strict ( x -- y ) ; foldable -GENERIC: numerator ( a/b -- a ) -GENERIC: denominator ( a/b -- b ) -GENERIC: >fraction ( a/b -- a b ) +GENERIC: numerator ( a/b -- a ) ; +GENERIC: denominator ( a/b -- b ) ; +GENERIC: >fraction ( a/b -- a b ) ; -GENERIC: real-part ( z -- x ) -GENERIC: imaginary-part ( z -- y ) +GENERIC: real-part ( z -- x ) ; +GENERIC: imaginary-part ( z -- y ) ; -MATH: number= ( x y -- ? ) foldable +MATH: number= ( x y -- ? ) ; foldable M: object number= 2drop f ; -MATH: < ( x y -- ? ) foldable -MATH: <= ( x y -- ? ) foldable -MATH: > ( x y -- ? ) foldable -MATH: >= ( x y -- ? ) foldable +MATH: < ( x y -- ? ) ; foldable +MATH: <= ( x y -- ? ) ; foldable +MATH: > ( x y -- ? ) ; foldable +MATH: >= ( x y -- ? ) ; foldable -MATH: unordered? ( x y -- ? ) foldable -MATH: u< ( x y -- ? ) foldable -MATH: u<= ( x y -- ? ) foldable -MATH: u> ( x y -- ? ) foldable -MATH: u>= ( x y -- ? ) foldable +MATH: unordered? ( x y -- ? ) ; foldable +MATH: u< ( x y -- ? ) ; foldable +MATH: u<= ( x y -- ? ) ; foldable +MATH: u> ( x y -- ? ) ; foldable +MATH: u>= ( x y -- ? ) ; foldable M: object unordered? 2drop f ; -MATH: + ( x y -- z ) foldable -MATH: - ( x y -- z ) foldable -MATH: * ( x y -- z ) foldable -MATH: / ( x y -- z ) foldable -MATH: /f ( x y -- z ) foldable -MATH: /i ( x y -- z ) foldable -MATH: mod ( x y -- z ) foldable +MATH: + ( x y -- z ) ; foldable +MATH: - ( x y -- z ) ; foldable +MATH: * ( x y -- z ) ; foldable +MATH: / ( x y -- z ) ; foldable +MATH: /f ( x y -- z ) ; foldable +MATH: /i ( x y -- z ) ; foldable +MATH: mod ( x y -- z ) ; foldable -MATH: /mod ( x y -- z w ) foldable +MATH: /mod ( x y -- z w ) ; foldable -MATH: bitand ( x y -- z ) foldable -MATH: bitor ( x y -- z ) foldable -MATH: bitxor ( x y -- z ) foldable -GENERIC# shift 1 ( x n -- y ) foldable -GENERIC: bitnot ( x -- y ) foldable -GENERIC# bit? 1 ( x n -- ? ) foldable +MATH: bitand ( x y -- z ) ; foldable +MATH: bitor ( x y -- z ) ; foldable +MATH: bitxor ( x y -- z ) ; foldable +GENERIC# shift 1 ( x n -- y ) ; foldable +GENERIC: bitnot ( x -- y ) ; foldable +GENERIC# bit? 1 ( x n -- ? ) ; foldable -GENERIC: abs ( x -- y ) foldable +GENERIC: abs ( x -- y ) ; foldable @@ -147,7 +147,7 @@ ERROR: log2-expects-positive x ; : even? ( n -- ? ) 1 bitand zero? ; inline : odd? ( n -- ? ) 1 bitand 1 number= ; inline -GENERIC: neg? ( x -- -x ) +GENERIC: neg? ( x -- -x ) ; : if-zero ( ..a n quot1: ( ..a -- ..b ) quot2: ( ..a n -- ..b ) -- ..b ) [ dup zero? ] [ [ drop ] prepose ] [ ] tri* if ; inline @@ -174,7 +174,7 @@ TUPLE: complex UNION: number real complex ; -GENERIC: recip ( x -- y ) +GENERIC: recip ( x -- y ) ; M: number recip 1 swap / ; inline @@ -182,7 +182,7 @@ M: number recip 1 swap / ; inline ! Note: an imaginary 0.0 should still create a complex dup 0 = [ drop ] [ complex boa ] if ; inline -GENERIC: >rect ( z -- x y ) +GENERIC: >rect ( z -- x y ) ; M: real >rect 0 ; inline @@ -202,7 +202,7 @@ PRIVATE> : gcd ( x y -- a d ) [ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; inline -MATH: simple-gcd ( x y -- d ) foldable +MATH: simple-gcd ( x y -- d ) ; foldable bits ] same? ; inline -GENERIC: fp-special? ( x -- ? ) -GENERIC: fp-nan? ( x -- ? ) -GENERIC: fp-qnan? ( x -- ? ) -GENERIC: fp-snan? ( x -- ? ) -GENERIC: fp-infinity? ( x -- ? ) -GENERIC: fp-nan-payload ( x -- bits ) -GENERIC: fp-sign ( x -- ? ) +GENERIC: fp-special? ( x -- ? ) ; +GENERIC: fp-nan? ( x -- ? ) ; +GENERIC: fp-qnan? ( x -- ? ) ; +GENERIC: fp-snan? ( x -- ? ) ; +GENERIC: fp-infinity? ( x -- ? ) ; +GENERIC: fp-nan-payload ( x -- bits ) ; +GENERIC: fp-sign ( x -- ? ) ; M: object fp-special? drop f ; inline M: object fp-nan? drop f ; inline @@ -233,8 +233,8 @@ M: object fp-infinity? drop f ; inline : ( payload -- nan ) 0x7ff0000000000000 bitor bits>double ; inline -GENERIC: next-float ( m -- n ) -GENERIC: prev-float ( m -- n ) +GENERIC: next-float ( m -- n ) ; +GENERIC: prev-float ( m -- n ) ; : next-power-of-2 ( m -- n ) dup 2 <= [ drop 2 ] [ 1 - log2 1 + 2^ ] if ; inline diff --git a/core/math/order/order.factor b/core/math/order/order.factor index 12c3422793..2681f588dc 100644 --- a/core/math/order/order.factor +++ b/core/math/order/order.factor @@ -11,7 +11,7 @@ symbol: +gt+ ! Can't use case, index or nth here dup +lt+ eq? [ drop +gt+ ] [ +eq+ eq? +eq+ +lt+ ? ] if ; -GENERIC: <=> ( obj1 obj2 -- <=> ) +GENERIC: <=> ( obj1 obj2 -- <=> ) ; : >=< ( obj1 obj2 -- >=< ) <=> invert-comparison ; inline @@ -22,7 +22,7 @@ GENERIC: <=> ( obj1 obj2 -- <=> ) : (real<=>) ( x y -- <=> ) 2dup < [ 2drop +lt+ ] [ number= +eq+ +gt+ ? ] if ; inline -MATH: real<=> ( x y -- <=> ) +MATH: real<=> ( x y -- <=> ) ; M: fixnum real<=> { fixnum fixnum } declare (real<=>) ; inline M: bignum real<=> { bignum bignum } declare (real<=>) ; inline M: float real<=> { float float } declare (real<=>) ; inline @@ -32,10 +32,10 @@ PRIVATE> M: real <=> real<=> ; inline -GENERIC: before? ( obj1 obj2 -- ? ) -GENERIC: after? ( obj1 obj2 -- ? ) -GENERIC: before=? ( obj1 obj2 -- ? ) -GENERIC: after=? ( obj1 obj2 -- ? ) +GENERIC: before? ( obj1 obj2 -- ? ) ; +GENERIC: after? ( obj1 obj2 -- ? ) ; +GENERIC: before=? ( obj1 obj2 -- ? ) ; +GENERIC: after=? ( obj1 obj2 -- ? ) ; M: object before? ( obj1 obj2 -- ? ) <=> +lt+ eq? ; inline M: object after? ( obj1 obj2 -- ? ) <=> +gt+ eq? ; inline @@ -47,8 +47,8 @@ M: real after? ( obj1 obj2 -- ? ) > ; inline M: real before=? ( obj1 obj2 -- ? ) <= ; inline M: real after=? ( obj1 obj2 -- ? ) >= ; inline -GENERIC: min ( obj1 obj2 -- obj ) -GENERIC: max ( obj1 obj2 -- obj ) +GENERIC: min ( obj1 obj2 -- obj ) ; +GENERIC: max ( obj1 obj2 -- obj ) ; M: object min [ before? ] most ; inline M: object max [ after? ] most ; inline diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor index f37773bc13..a06eb496c8 100644 --- a/core/math/parser/parser.factor +++ b/core/math/parser/parser.factor @@ -415,7 +415,7 @@ CONSTANT: ONES B{ [ over 10 >= ] [ (two-digit) ] while [ over zero? ] [ (one-digit) ] until ; inline -GENERIC: (positive>dec) ( num -- str ) +GENERIC: (positive>dec) ( num -- str ) ; M: bignum (positive>dec) 12 (bignum>dec) (fixnum>dec) "" like reverse! nip ; inline @@ -464,7 +464,7 @@ M: fixnum (positive>dec) PRIVATE> -GENERIC# >base 1 ( n radix -- str ) +GENERIC# >base 1 ( n radix -- str ) ; : number>string ( n -- str ) 10 >base ; inline diff --git a/core/modern/compiler/compiler.factor b/core/modern/compiler/compiler.factor index 950ffa50e7..eb4f0b0dd2 100644 --- a/core/modern/compiler/compiler.factor +++ b/core/modern/compiler/compiler.factor @@ -77,7 +77,7 @@ TUPLE: generate-predicate' < define' ; new swap >>literal ; inline -GENERIC: split-decorators ( seq -- base left right ) +GENERIC: split-decorators ( seq -- base left right ) ; M: compound-literal split-decorators sequence>> [ decorator-literal? not ] partition @@ -85,16 +85,16 @@ M: compound-literal split-decorators [ left-decorator-literal? ] partition ; M: object split-decorators f f ; -! GENERIC: apply-decorator ( base decorator -- ) +! GENERIC: apply-decorator ( base decorator -- ) ; ! : apply-decorators ( obj seq -- obj ) ; -GENERIC: base-literal ( obj -- obj ) +GENERIC: base-literal ( obj -- obj ) ; M: compound-literal base-literal sequence>> [ decorator-literal? not ] find nip ; M: object base-literal ; -GENERIC: literal>tag ( class -- string/f ) +GENERIC: literal>tag ( class -- string/f ) ; M: line-comment-literal literal>tag drop f ; M: uppercase-colon-literal literal>tag tag>> [ "word" ] [ >lower ] if-empty ; @@ -112,7 +112,7 @@ M: compound-literal literal>tag : literals>holders ( literals -- holders ) [ literal>holder ] map ; -GENERIC: holder>definitions' ( literal -- assoc ) +GENERIC: holder>definitions' ( literal -- assoc ) ; M: comment' holder>definitions' drop f ; M: using' holder>definitions' drop f ; M: use' holder>definitions' drop f ; @@ -160,7 +160,7 @@ M: slot' holder>definitions' ! these also make class predicate? words -GENERIC: slot-accessor-name ( obj -- string ) +GENERIC: slot-accessor-name ( obj -- string ) ; M: single-matched-literal slot-accessor-name payload>> first tag>> ">>" append ; M: tag-literal slot-accessor-name tag>> ">>" append ; @@ -219,12 +219,12 @@ M: singleton' holder>definitions' [ in'? ] filter [ literal>> payload>> [ tag>> ] map ] map concat ; -GENERIC: handle-colon-tag ( seq tag -- obj ) -GENERIC: handle-paren-tag ( seq tag -- obj ) +GENERIC: handle-colon-tag ( seq tag -- obj ) ; +GENERIC: handle-paren-tag ( seq tag -- obj ) ; ! M: f handle-paren-tag drop ; -GENERIC: handle-brace-tag ( seq tag -- obj ) -GENERIC: handle-bracket-tag ( seq tag -- obj ) -GENERIC: handle-string-tag ( seq tag -- obj ) +GENERIC: handle-brace-tag ( seq tag -- obj ) ; +GENERIC: handle-bracket-tag ( seq tag -- obj ) ; +GENERIC: handle-string-tag ( seq tag -- obj ) ; ERROR: word-not-found word ; : lookup-in-namespace ( key namespace -- obj/f ) @@ -233,7 +233,7 @@ ERROR: word-not-found word ; word-not-found ] if ; -GENERIC# lookup-literal 1 ( literal namespace -- obj ) +GENERIC# lookup-literal 1 ( literal namespace -- obj ) ; M: tag-literal lookup-literal [ tag>> ] dip lookup-in-namespace ; @@ -258,7 +258,7 @@ M: single-matched-literal lookup-literal } case ; -GENERIC: definition>quotation ( namespace name definition -- quot ) +GENERIC: definition>quotation ( namespace name definition -- quot ) ; M: define' definition>quotation holder>> definition>quotation ; @@ -268,7 +268,7 @@ M: define' definition>quotation M: generate-predicate' definition>quotation 3drop f ; -GENERIC: stack-effect? ( obj -- ? ) +GENERIC: stack-effect? ( obj -- ? ) ; M: single-matched-literal stack-effect? { [ tag>> ] [ delimiter>> "(" = ] } 1&& ; M: object stack-effect? drop f ; @@ -330,7 +330,7 @@ DEFER: load-modern [ manifest>combined-namespace ] [ definitions>> ] bi [ [ name>> ] [ ] bi definition>quotation ] with { } map-as concat ; -GENERIC: add-predicates ( obj -- seq ) +GENERIC: add-predicates ( obj -- seq ) ; M: string add-predicates dup "?" append 2array ; M: sequence add-predicates [ add-predicates ] map concat ; diff --git a/core/modern/modern.factor b/core/modern/modern.factor index f029ffa649..401b87b0cb 100644 --- a/core/modern/modern.factor +++ b/core/modern/modern.factor @@ -52,7 +52,7 @@ TUPLE: compound-sequence-literal sequence ; CONSTRUCTOR: compound-sequence-literal ( sequence -- obj ) ; >> -GENERIC: lexed-underlying ( obj -- slice ) +GENERIC: lexed-underlying ( obj -- slice ) ; M: f lexed-underlying ; M: object lexed-underlying underlying>> ; M: slice lexed-underlying ; @@ -64,7 +64,7 @@ CONSTRUCTOR: compound-literal ( sequence -- obj ) ; ERROR: bad-compound-literal seq decorators words ; : check-compound-literal ( seq -- seq ) ; -GENERIC: make-compound-literals ( seq -- seq' ) +GENERIC: make-compound-literals ( seq -- seq' ) ; M: object make-compound-literals ; M: array make-compound-literals [ @@ -78,7 +78,7 @@ M: array make-compound-literals ! We have empty decorators, just the @ right here ! wrap the decorated object in the payload slot -GENERIC: collapse-decorators ( seq -- seq' ) +GENERIC: collapse-decorators ( seq -- seq' ) ; M: object collapse-decorators ; M: array collapse-decorators [ diff --git a/core/modern/out/out.factor b/core/modern/out/out.factor index b14a968f6d..90e8a43f8d 100644 --- a/core/modern/out/out.factor +++ b/core/modern/out/out.factor @@ -14,7 +14,7 @@ symbol: last-slice [ last-slice namespaces:set ] bi ; DEFER: write-literal -GENERIC: write-literal ( obj -- ) +GENERIC: write-literal ( obj -- ) ; ! M: object write-literal lexed-underlying write ; M: string write-literal write ; M: slice write-literal [ write-whitespace ] [ write ] bi ; diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index 07b5296c4f..1168a6eb17 100644 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -129,7 +129,7 @@ DEFER: foo { f } [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test { 3 } [ - "IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ; M: string smudge-me ;" "foo" + "IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) ; M: integer smudge-me ; M: string smudge-me ;" "foo" parse-stream drop "foo" path>source-file definitions>> first cardinality @@ -143,7 +143,7 @@ DEFER: foo ] unit-test { 2 } [ - "IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ;" "foo" + "IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) ; M: integer smudge-me ;" "foo" parse-stream drop "foo" path>source-file definitions>> first cardinality @@ -234,7 +234,7 @@ DEFER: foo ! Turning a generic into a non-generic could cause all ! kinds of funnyness { } [ - "IN: ayy USE: kernel GENERIC: ayy ( a -- b ) M: object ayy ;" + "IN: ayy USE: kernel GENERIC: ayy ( a -- b ) ; M: object ayy ;" "ayy" parse-stream drop ] unit-test @@ -244,7 +244,7 @@ DEFER: foo ] unit-test { } [ - "IN: azz TUPLE: my-class ; GENERIC: a-generic ( a -- b )" + "IN: azz TUPLE: my-class ; GENERIC: a-generic ( a -- b ) ;" "azz" parse-stream drop ] unit-test @@ -254,7 +254,7 @@ DEFER: foo ] unit-test { } [ - "IN: azz GENERIC: a-generic ( a -- b )" + "IN: azz GENERIC: a-generic ( a -- b ) ;" "azz" parse-stream drop ] unit-test @@ -280,7 +280,7 @@ DEFER: foo ] unit-test { } [ - "IN: parser.tests GENERIC: killer? ( a -- b )" + "IN: parser.tests GENERIC: killer? ( a -- b ) ;" "removing-the-predicate" parse-stream drop ] unit-test @@ -289,7 +289,7 @@ DEFER: foo ] unit-test [ - "IN: parser.tests TUPLE: another-pred-test ; GENERIC: another-pred-test? ( a -- b )" + "IN: parser.tests TUPLE: another-pred-test ; GENERIC: another-pred-test? ( a -- b ) ;" "removing-the-predicate" parse-stream ] [ error>> error>> error>> redefine-error? ] must-fail-with @@ -359,7 +359,7 @@ DEFER: foo 2 [ [ ] [ - "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )" + "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b ) ;" "redefining-a-class-5" parse-stream drop ] unit-test @@ -371,14 +371,14 @@ DEFER: foo [ f ] [ f "foo" "parser.tests" lookup-word execute ] unit-test [ ] [ - "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )" + "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b ) ;" "redefining-a-class-5" parse-stream drop ] unit-test [ f ] [ f "foo" "parser.tests" lookup-word execute ] unit-test [ ] [ - "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )" + "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b ) ;" "redefining-a-class-7" parse-stream drop ] unit-test @@ -428,7 +428,7 @@ DEFER: foo { "IN: parser.tests" "USING: math arrays kernel ;" - "GENERIC: change-combination ( obj a -- b )" + "GENERIC: change-combination ( obj a -- b ) ;" "M: integer change-combination 2drop 1 ;" "M: array change-combination 2drop 2 ;" } "\n" join "change-combination-test" parse-stream drop @@ -498,7 +498,7 @@ SYMBOLS: a b c ; DEFER: blah -{ } [ "IN: parser.tests GENERIC: blah ( x -- x )" eval( -- ) ] unit-test +{ } [ "IN: parser.tests GENERIC: blah ( x -- x )" eval( -- ) ; ] unit-test { } [ "IN: parser.tests SYMBOLS: blah ;" eval( -- ) ] unit-test { f } [ \ blah generic? ] unit-test @@ -637,7 +637,7 @@ EXCLUDE: qualified.tests.bar => x ; [ ": 44 ( -- ) ;" "word identifier test" parse-stream ] [ error>> lexer-error? ] must-fail-with -[ "GENERIC: 33 ( -- )" "generic identifier test" parse-stream ] +[ "GENERIC: 33 ( -- ) ;" "generic identifier test" parse-stream ] [ error>> lexer-error? ] must-fail-with { t } [ diff --git a/core/parser/parser.factor b/core/parser/parser.factor index d2c5a6d596..acf04b6fcf 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -131,7 +131,7 @@ ERROR: classoid-expected object ; symbol: quotation-parser -HOOK: parse-quotation quotation-parser ( -- quot ) +HOOK: parse-quotation quotation-parser ( -- quot ) ; M: f parse-quotation \ ] parse-until >quotation ; diff --git a/core/quotations/quotations.factor b/core/quotations/quotations.factor index d7b9f1d8d6..109d4eb3b1 100644 --- a/core/quotations/quotations.factor +++ b/core/quotations/quotations.factor @@ -51,7 +51,7 @@ INSTANCE: quotation immutable-sequence : 1quotation ( obj -- quot ) 1array array>quotation ; -GENERIC: literalize ( obj -- wrapped ) +GENERIC: literalize ( obj -- wrapped ) ; M: object literalize ; diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 4fd72d6cdd..da40e751d6 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -6,22 +6,22 @@ in: sequences mixin: sequence -GENERIC: length ( seq -- n ) flushable -GENERIC: set-length ( n seq -- ) -GENERIC: nth ( n seq -- elt ) flushable -GENERIC: set-nth ( elt n seq -- ) -GENERIC: new-sequence ( len seq -- newseq ) flushable -GENERIC: new-resizable ( len seq -- newseq ) flushable -GENERIC: like ( seq exemplar -- newseq ) flushable -GENERIC: clone-like ( seq exemplar -- newseq ) flushable +GENERIC: length ( seq -- n ) ; flushable +GENERIC: set-length ( n seq -- ) ; +GENERIC: nth ( n seq -- elt ) ; flushable +GENERIC: set-nth ( elt n seq -- ) ; +GENERIC: new-sequence ( len seq -- newseq ) ; flushable +GENERIC: new-resizable ( len seq -- newseq ) ; flushable +GENERIC: like ( seq exemplar -- newseq ) ; flushable +GENERIC: clone-like ( seq exemplar -- newseq ) ; flushable : new-like ( len exemplar quot -- seq ) over [ [ new-sequence ] dip call ] dip like ; inline M: sequence like drop ; inline -GENERIC: lengthen ( n seq -- ) -GENERIC: shorten ( n seq -- ) +GENERIC: lengthen ( n seq -- ) ; +GENERIC: shorten ( n seq -- ) ; M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ; inline M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ; inline @@ -51,7 +51,7 @@ M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ; inline ERROR: bounds-error index seq ; -GENERIC# bounds-check? 1 ( n seq -- ? ) +GENERIC# bounds-check? 1 ( n seq -- ? ) ; M: integer bounds-check? ( n seq -- ? ) dupd length < [ 0 >= ] [ drop f ] if ; inline @@ -77,11 +77,11 @@ INSTANCE: immutable-sequence sequence : dispatch ( n array -- ) array-nth call ; -GENERIC: resize ( n seq -- newseq ) flushable +GENERIC: resize ( n seq -- newseq ) ; flushable ! Unsafe sequence protocol for inner loops -GENERIC: nth-unsafe ( n seq -- elt ) flushable -GENERIC: set-nth-unsafe ( elt n seq -- ) +GENERIC: nth-unsafe ( n seq -- elt ) ; flushable +GENERIC: set-nth-unsafe ( elt n seq -- ) ; M: sequence nth bounds-check nth-unsafe ; inline M: sequence set-nth bounds-check set-nth-unsafe ; inline @@ -189,8 +189,8 @@ PRIVATE> [ 2drop f ] [ nth-unsafe ] if ; inline mixin: virtual-sequence -GENERIC: virtual-exemplar ( seq -- seq' ) -GENERIC: virtual@ ( n seq -- n' seq' ) +GENERIC: virtual-exemplar ( seq -- seq' ) ; +GENERIC: virtual@ ( n seq -- n' seq' ) ; M: virtual-sequence nth virtual@ nth ; inline M: virtual-sequence set-nth virtual@ set-nth ; inline @@ -861,7 +861,7 @@ PRIVATE> [ 0 swap copy-unsafe ] keep reverse! ] keep like ; -GENERIC: sum-lengths ( seq -- n ) +GENERIC: sum-lengths ( seq -- n ) ; M: object sum-lengths 0 [ length + ] reduce ; @@ -1061,7 +1061,7 @@ PRIVATE> : trim ( ... seq quot: ( ... elt -- ... ? ) -- ... newseq ) [ trim-slice ] [ drop ] 2bi like ; inline -GENERIC: sum ( seq -- n ) +GENERIC: sum ( seq -- n ) ; M: object sum 0 [ + ] binary-reduce ; inline M: iota-tuple sum length dup 1 - * 2/ ; inline M: repetition sum [ elt>> ] [ length>> ] bi * ; inline diff --git a/core/sets/sets.factor b/core/sets/sets.factor index 240a667c36..08fae639f0 100644 --- a/core/sets/sets.factor +++ b/core/sets/sets.factor @@ -6,24 +6,24 @@ in: sets ! Set protocol mixin: set -GENERIC: adjoin ( elt set -- ) -GENERIC: ?adjoin ( elt set -- ? ) -GENERIC: in? ( elt set -- ? ) -GENERIC: delete ( elt set -- ) -GENERIC: set-like ( set exemplar -- set' ) -GENERIC: fast-set ( set -- set' ) -GENERIC: members ( set -- seq ) -GENERIC: union ( set1 set2 -- set ) -GENERIC: intersect ( set1 set2 -- set ) -GENERIC: intersects? ( set1 set2 -- ? ) -GENERIC: diff ( set1 set2 -- set ) -GENERIC: subset? ( set1 set2 -- ? ) -GENERIC: set= ( set1 set2 -- ? ) -GENERIC: duplicates ( set -- seq ) -GENERIC: all-unique? ( set -- ? ) -GENERIC: null? ( set -- ? ) -GENERIC: cardinality ( set -- n ) -GENERIC: clear-set ( set -- ) +GENERIC: adjoin ( elt set -- ) ; +GENERIC: ?adjoin ( elt set -- ? ) ; +GENERIC: in? ( elt set -- ? ) ; +GENERIC: delete ( elt set -- ) ; +GENERIC: set-like ( set exemplar -- set' ) ; +GENERIC: fast-set ( set -- set' ) ; +GENERIC: members ( set -- seq ) ; +GENERIC: union ( set1 set2 -- set ) ; +GENERIC: intersect ( set1 set2 -- set ) ; +GENERIC: intersects? ( set1 set2 -- ? ) ; +GENERIC: diff ( set1 set2 -- set ) ; +GENERIC: subset? ( set1 set2 -- ? ) ; +GENERIC: set= ( set1 set2 -- ? ) ; +GENERIC: duplicates ( set -- seq ) ; +GENERIC: all-unique? ( set -- ? ) ; +GENERIC: null? ( set -- ? ) ; +GENERIC: cardinality ( set -- n ) ; +GENERIC: clear-set ( set -- ) ; M: f members drop f ; diff --git a/core/slots/slots.factor b/core/slots/slots.factor index 51ebea78d2..2b41db09d4 100644 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -33,7 +33,7 @@ PREDICATE: writer-method < method "writing" word-prop >boolean ; [ 2drop make-inline ] 3tri ; -GENERIC# reader-quot 1 ( class slot-spec -- quot ) +GENERIC# reader-quot 1 ( class slot-spec -- quot ) ; M: object reader-quot nip [ @@ -70,7 +70,7 @@ M: object reader-quot ERROR: bad-slot-value value class ; -GENERIC: instance-check-quot ( obj -- quot ) +GENERIC: instance-check-quot ( obj -- quot ) ; M: class instance-check-quot ( class -- quot ) { @@ -87,7 +87,7 @@ M: object instance-check-quot \ unless , ] [ ] make ; -GENERIC# writer-quot 1 ( class slot-spec -- quot ) +GENERIC# writer-quot 1 ( class slot-spec -- quot ) ; M: object writer-quot nip @@ -157,7 +157,7 @@ M: object writer-quot DEFER: initial-value -GENERIC: initial-value* ( class -- object ? ) +GENERIC: initial-value* ( class -- object ? ) ; M: class initial-value* drop f f ; @@ -214,7 +214,7 @@ M: anonymous-intersection initial-value* [ dup initial-value* ] } cond [ drop ] 2dip ; -GENERIC: make-slot ( desc -- slot-spec ) +GENERIC: make-slot ( desc -- slot-spec ) ; M: string make-slot diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor index 61891509a9..8427652a0b 100644 --- a/core/sorting/sorting.factor +++ b/core/sorting/sorting.factor @@ -152,7 +152,7 @@ PRIVATE> PRIVATE> -GENERIC: sort-keys ( obj -- sortedseq ) +GENERIC: sort-keys ( obj -- sortedseq ) ; M: object sort-keys >alist sort-keys ; @@ -162,7 +162,7 @@ M: sequence sort-keys M: hashtable sort-keys >alist [ { array } declare first-unsafe ] sort-with ; -GENERIC: sort-values ( obj -- sortedseq ) +GENERIC: sort-values ( obj -- sortedseq ) ; M: object sort-values >alist sort-values ; diff --git a/core/source-files/errors/errors.factor b/core/source-files/errors/errors.factor index 3e153dda3f..1dd12d2df9 100644 --- a/core/source-files/errors/errors.factor +++ b/core/source-files/errors/errors.factor @@ -4,8 +4,8 @@ USING: accessors assocs continuations definitions init io kernel math math.parser namespaces sequences sorting ; in: source-files.errors -GENERIC: error-file ( error -- file ) -GENERIC: error-line ( error -- line ) +GENERIC: error-file ( error -- file ) ; +GENERIC: error-line ( error -- line ) ; M: object error-file drop f ; M: object error-line drop f ; @@ -27,7 +27,7 @@ M: source-file-error compute-restarts error>> compute-restarts ; TUPLE: error-type-holder type word plural icon quot forget-quot { fatal? initial: t } ; -GENERIC: error-type ( error -- type ) +GENERIC: error-type ( error -- type ) ; : ( error definition class -- source-file-error ) new @@ -64,7 +64,7 @@ error-types [ V{ } clone ] initialize [ quot>> call( -- seq ) ] map concat ; -GENERIC: errors-changed ( observer -- ) +GENERIC: errors-changed ( observer -- ) ; symbol: error-observers diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor index 6599b233cd..3b2b85079f 100644 --- a/core/splitting/splitting.factor +++ b/core/splitting/splitting.factor @@ -109,7 +109,7 @@ PRIVATE> ! string-lines uses string-nth-fast which is 50% faster over ! nth-unsafe. be careful when changing the definition so that ! you don't unoptimize it. -GENERIC: string-lines ( seq -- seq' ) +GENERIC: string-lines ( seq -- seq' ) ; M: string string-lines [ V{ } clone 0 ] dip [ 2dup bounds-check? ] [ diff --git a/core/stack-checker/alien/alien.factor b/core/stack-checker/alien/alien.factor index e5bf38e577..7d800f6a3e 100644 --- a/core/stack-checker/alien/alien.factor +++ b/core/stack-checker/alien/alien.factor @@ -119,7 +119,7 @@ TUPLE: alien-callback-params < alien-node-params xt ; [ [ c-type-boxer-quot ] map deep-spread>quot ] bi append ; -GENERIC: wrap-callback-quot ( params quot -- quot' ) +GENERIC: wrap-callback-quot ( params quot -- quot' ) ; symbol: wait-for-callback-hook diff --git a/core/stack-checker/backend/backend.factor b/core/stack-checker/backend/backend.factor index 65d87f8b08..1502a01272 100644 --- a/core/stack-checker/backend/backend.factor +++ b/core/stack-checker/backend/backend.factor @@ -80,7 +80,7 @@ in: stack-checker.backend 2drop f f ] if ; -GENERIC: apply-object ( obj -- ) +GENERIC: apply-object ( obj -- ) ; M: wrapper apply-object wrapped>> diff --git a/core/stack-checker/branches/branches.factor b/core/stack-checker/branches/branches.factor index 1beb79016b..dfc49353ff 100644 --- a/core/stack-checker/branches/branches.factor +++ b/core/stack-checker/branches/branches.factor @@ -107,7 +107,7 @@ SYMBOLS: combinator quotations ; terminated? } [ dup get ] H{ } map>assoc ; -GENERIC: infer-branch ( literal -- namespace ) +GENERIC: infer-branch ( literal -- namespace ) ; M: literal-tuple infer-branch [ @@ -137,7 +137,7 @@ M: callable infer-branch infer-branches [ first2 #if, ] dip compute-phi-function ; -GENERIC: curried/composed? ( known -- ? ) +GENERIC: curried/composed? ( known -- ? ) ; M: object curried/composed? drop f ; M: curried curried/composed? drop t ; M: composed curried/composed? drop t ; diff --git a/core/stack-checker/dependencies/dependencies.factor b/core/stack-checker/dependencies/dependencies.factor index b67ce625da..fa1f87ad4d 100644 --- a/core/stack-checker/dependencies/dependencies.factor +++ b/core/stack-checker/dependencies/dependencies.factor @@ -40,7 +40,7 @@ SYMBOLS: effect-dependency conditional-dependency definition-dependency ; : add-depends-on-definition ( word -- ) definition-dependency depends-on ; -GENERIC: add-depends-on-c-type ( c-type -- ) +GENERIC: add-depends-on-c-type ( c-type -- ) ; M: void add-depends-on-c-type drop ; @@ -66,7 +66,7 @@ symbol: generic-dependencies ! if any fail, the word is recompiled symbol: conditional-dependencies -GENERIC: satisfied? ( dependency -- ? ) +GENERIC: satisfied? ( dependency -- ? ) ; : add-conditional-dependency ( ... class -- ) boa conditional-dependencies get diff --git a/core/stack-checker/inlining/inlining.factor b/core/stack-checker/inlining/inlining.factor index 522876a250..bc6cb04040 100644 --- a/core/stack-checker/inlining/inlining.factor +++ b/core/stack-checker/inlining/inlining.factor @@ -111,7 +111,7 @@ symbol: enter-out : trimmed-enter-out ( label -- stack ) dup enter-out>> trim-stack ; -GENERIC: (undeclared-known) ( value -- known ) +GENERIC: (undeclared-known) ( value -- known ) ; M: object (undeclared-known) ; M: declared-effect (undeclared-known) known>> (undeclared-known) ; diff --git a/core/stack-checker/known-words/known-words.factor b/core/stack-checker/known-words/known-words.factor index fd97128d9a..ac64b16eae 100644 --- a/core/stack-checker/known-words/known-words.factor +++ b/core/stack-checker/known-words/known-words.factor @@ -92,7 +92,7 @@ in: stack-checker.known-words \ declare [ infer-declare ] "special" set-word-prop ! Call -GENERIC: infer-call* ( value known -- ) +GENERIC: infer-call* ( value known -- ) ; : (infer-call) ( value -- ) dup known infer-call* ; diff --git a/core/stack-checker/recursive-state/tree/tree.factor b/core/stack-checker/recursive-state/tree/tree.factor index 8ddad71cc3..0f221beb35 100644 --- a/core/stack-checker/recursive-state/tree/tree.factor +++ b/core/stack-checker/recursive-state/tree/tree.factor @@ -9,7 +9,7 @@ in: stack-checker.recursive-state.tree TUPLE: node value key hashcode left right ; -GENERIC: lookup ( key node -- value/f ) +GENERIC: lookup ( key node -- value/f ) ; M: f lookup nip ; @@ -21,7 +21,7 @@ M: node lookup [ nip value>> ] [ decide [ left>> ] [ right>> ] if lookup ] if ; -GENERIC: store ( value key node -- node' ) +GENERIC: store ( value key node -- node' ) ; M: f store drop dup hashcode f f node boa ; diff --git a/core/stack-checker/stack-checker-tests.factor b/core/stack-checker/stack-checker-tests.factor index 323eca5a81..db6ef93623 100644 --- a/core/stack-checker/stack-checker-tests.factor +++ b/core/stack-checker/stack-checker-tests.factor @@ -141,13 +141,13 @@ symbol: sym-test { 1 0 } [ recursive-terminator ] must-infer-as -GENERIC: potential-hang ( obj -- obj ) +GENERIC: potential-hang ( obj -- obj ) ; M: fixnum potential-hang dup [ potential-hang ] when ; { } [ [ 5 potential-hang ] infer drop ] unit-test TUPLE: funny-cons car cdr ; -GENERIC: iterate ( obj -- ) +GENERIC: iterate ( obj -- ) ; M: funny-cons iterate cdr>> iterate ; M: f iterate drop ; M: real iterate drop ; @@ -265,7 +265,7 @@ DEFER: inline-recursive-2 ! Hooks symbol: my-var -HOOK: my-hook my-var ( -- x ) +HOOK: my-hook my-var ( -- x ) ; M: integer my-hook "an integer" ; M: string my-hook "a string" ; diff --git a/core/stack-checker/stack-checker.factor b/core/stack-checker/stack-checker.factor index 56981d6191..5b1a7468ce 100644 --- a/core/stack-checker/stack-checker.factor +++ b/core/stack-checker/stack-checker.factor @@ -8,7 +8,7 @@ stack-checker.errors stack-checker.inlining stack-checker.visitor.dummy ; in: stack-checker -GENERIC: infer ( quot -- effect ) +GENERIC: infer ( quot -- effect ) ; M: callable infer ( quot -- effect ) (infer) ; diff --git a/core/stack-checker/values/values.factor b/core/stack-checker/values/values.factor index 9f2057f160..ebf46d5f91 100644 --- a/core/stack-checker/values/values.factor +++ b/core/stack-checker/values/values.factor @@ -26,17 +26,17 @@ symbol: known-values : copy-values ( values -- values' ) [ copy-value ] map ; -GENERIC: (literal-value?) ( value -- ? ) +GENERIC: (literal-value?) ( value -- ? ) ; : literal-value? ( value -- ? ) known (literal-value?) ; -GENERIC: (input-value?) ( value -- ? ) +GENERIC: (input-value?) ( value -- ? ) ; : input-value? ( value -- ? ) known (input-value?) ; -GENERIC: (literal) ( known -- literal ) +GENERIC: (literal) ( known -- literal ) ; TUPLE: literal-tuple < identity-tuple value recursion ; @@ -122,7 +122,7 @@ M: f (literal-value?) drop f ; M: f (literal) current-word get bad-macro-input ; -GENERIC: known>callable ( known -- quot ) +GENERIC: known>callable ( known -- quot ) ; : ?@ ( x -- y ) dup callable? [ drop [ @ ] ] unless ; diff --git a/core/stack-checker/visitor/visitor.factor b/core/stack-checker/visitor/visitor.factor index 6f349712ae..6dc1b1b680 100644 --- a/core/stack-checker/visitor/visitor.factor +++ b/core/stack-checker/visitor/visitor.factor @@ -5,29 +5,29 @@ in: stack-checker.visitor symbol: stack-visitor -HOOK: child-visitor stack-visitor ( -- visitor ) +HOOK: child-visitor stack-visitor ( -- visitor ) ; : nest-visitor ( -- ) child-visitor stack-visitor set ; -HOOK: #introduce, stack-visitor ( values -- ) -HOOK: #call, stack-visitor ( inputs outputs word -- ) -HOOK: #call-recursive, stack-visitor ( inputs outputs word -- ) -HOOK: #push, stack-visitor ( literal value -- ) -HOOK: #shuffle, stack-visitor ( in-d out-d in-r out-r mapping -- ) -HOOK: #drop, stack-visitor ( values -- ) -HOOK: #>r, stack-visitor ( inputs outputs -- ) -HOOK: #r>, stack-visitor ( inputs outputs -- ) -HOOK: #terminate, stack-visitor ( in-d in-r -- ) -HOOK: #if, stack-visitor ( ? true false -- ) -HOOK: #dispatch, stack-visitor ( n branches -- ) -HOOK: #phi, stack-visitor ( d-phi-in d-phi-out terminated -- ) -HOOK: #declare, stack-visitor ( declaration -- ) -HOOK: #return, stack-visitor ( stack -- ) -HOOK: #enter-recursive, stack-visitor ( label inputs outputs -- ) -HOOK: #return-recursive, stack-visitor ( label inputs outputs -- ) -HOOK: #recursive, stack-visitor ( label inputs visitor -- ) -HOOK: #copy, stack-visitor ( inputs outputs -- ) -HOOK: #alien-invoke, stack-visitor ( params -- ) -HOOK: #alien-indirect, stack-visitor ( params -- ) -HOOK: #alien-assembly, stack-visitor ( params -- ) -HOOK: #alien-callback, stack-visitor ( params child -- ) +HOOK: #introduce, stack-visitor ( values -- ) ; +HOOK: #call, stack-visitor ( inputs outputs word -- ) ; +HOOK: #call-recursive, stack-visitor ( inputs outputs word -- ) ; +HOOK: #push, stack-visitor ( literal value -- ) ; +HOOK: #shuffle, stack-visitor ( in-d out-d in-r out-r mapping -- ) ; +HOOK: #drop, stack-visitor ( values -- ) ; +HOOK: #>r, stack-visitor ( inputs outputs -- ) ; +HOOK: #r>, stack-visitor ( inputs outputs -- ) ; +HOOK: #terminate, stack-visitor ( in-d in-r -- ) ; +HOOK: #if, stack-visitor ( ? true false -- ) ; +HOOK: #dispatch, stack-visitor ( n branches -- ) ; +HOOK: #phi, stack-visitor ( d-phi-in d-phi-out terminated -- ) ; +HOOK: #declare, stack-visitor ( declaration -- ) ; +HOOK: #return, stack-visitor ( stack -- ) ; +HOOK: #enter-recursive, stack-visitor ( label inputs outputs -- ) ; +HOOK: #return-recursive, stack-visitor ( label inputs outputs -- ) ; +HOOK: #recursive, stack-visitor ( label inputs visitor -- ) ; +HOOK: #copy, stack-visitor ( inputs outputs -- ) ; +HOOK: #alien-invoke, stack-visitor ( params -- ) ; +HOOK: #alien-indirect, stack-visitor ( params -- ) ; +HOOK: #alien-assembly, stack-visitor ( params -- ) ; +HOOK: #alien-callback, stack-visitor ( params child -- ) ; diff --git a/core/summary/summary.factor b/core/summary/summary.factor index 7991d844d1..31fd109894 100644 --- a/core/summary/summary.factor +++ b/core/summary/summary.factor @@ -4,7 +4,7 @@ USING: accessors assocs classes continuations kernel make math math.parser sequences sets strings ; in: summary -GENERIC: summary ( object -- string ) +GENERIC: summary ( object -- string ) ; : object-summary ( object -- string ) class-of name>> ; inline @@ -13,7 +13,7 @@ GENERIC: summary ( object -- string ) [ % " with " % ] [ # ] [ " " % % ] tri* ] "" make ; -GENERIC: tuple-summary ( object -- string ) +GENERIC: tuple-summary ( object -- string ) ; M: assoc tuple-summary dup assoc-size "entries" container-summary ; diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index cfa2dd87e2..ef3b653d06 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -460,7 +460,7 @@ HELP: SINGLETON: "Defines a new singleton class. The class word itself is the sole instance of the singleton class." } { $examples - { $example "USING: classes.singleton kernel io ;" "IN: singleton-demo" "USE: prettyprint\nSINGLETON: foo\nGENERIC: bar ( obj -- )\nM: foo bar drop \"a foo!\" print ;\nfoo bar" "a foo!" } + { $example "USING: classes.singleton kernel io ;" "IN: singleton-demo" "USE: prettyprint\nSINGLETON: foo\nGENERIC: bar ( obj -- ) ;\nM: foo bar drop \"a foo!\" print ;\nfoo bar" "a foo!" } } ; HELP: SINGLETONS: @@ -665,7 +665,7 @@ HELP: NAN: } ; HELP: GENERIC: -{ $syntax "GENERIC: word ( stack -- effect )" } +{ $syntax "GENERIC: word ( stack -- effect ) ;" } { $values { "word" "a new word to define" } } { $description "Defines a new generic word in the current vocabulary. Initially, it contains no methods, and thus will throw a " { $link no-method } " error when called." } ; @@ -675,7 +675,7 @@ HELP: GENERIC# { $description "Defines a new generic word which dispatches on the " { $snippet "n" } "th most element from the top of the stack in the current vocabulary. Initially, it contains no methods, and thus will throw a " { $link no-method } " error when called." } { $notes "The following two definitions are equivalent:" - { $code "GENERIC: foo ( obj -- )" } + { $code "GENERIC: foo ( obj -- ) ;" } { $code "GENERIC# foo 0 ( obj -- )" } } ; diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index 489e585dfe..7914699dc8 100644 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -150,7 +150,7 @@ symbol: blacklist : add-to-blacklist ( error vocab -- ) vocab-name blacklist get [ set-at ] [ 2drop ] if* ; -GENERIC: (require) ( name -- ) +GENERIC: (require) ( name -- ) ; M: vocab (require) [ diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index 5847b97f15..2b5ca7ee13 100644 --- a/core/vocabs/parser/parser.factor +++ b/core/vocabs/parser/parser.factor @@ -214,7 +214,7 @@ PRIVATE> vocab-link UNION: vocab-spec vocab vocab-link ; -GENERIC: vocab-name ( vocab-spec -- name ) +GENERIC: vocab-name ( vocab-spec -- name ) ; M: vocab vocab-name name>> ; @@ -41,13 +41,13 @@ M: vocab-link vocab-name name>> ; M: object vocab-name check-vocab-name ; -GENERIC: lookup-vocab ( vocab-spec -- vocab ) +GENERIC: lookup-vocab ( vocab-spec -- vocab ) ; M: vocab lookup-vocab ; M: object lookup-vocab ( name -- vocab ) vocab-name dictionary get at ; -GENERIC: vocab-words-assoc ( vocab-spec -- assoc/f ) +GENERIC: vocab-words-assoc ( vocab-spec -- assoc/f ) ; M: vocab vocab-words-assoc words>> ; @@ -55,7 +55,7 @@ M: object vocab-words-assoc lookup-vocab vocab-words-assoc ; M: f vocab-words-assoc ; -GENERIC: vocab-help ( vocab-spec -- help ) +GENERIC: vocab-help ( vocab-spec -- help ) ; M: vocab vocab-help help>> ; @@ -63,7 +63,7 @@ M: object vocab-help lookup-vocab vocab-help ; M: f vocab-help ; -GENERIC: vocab-main ( vocab-spec -- main ) +GENERIC: vocab-main ( vocab-spec -- main ) ; M: vocab vocab-main main>> ; @@ -73,7 +73,7 @@ M: f vocab-main ; symbol: vocab-observers -GENERIC: vocab-changed ( vocab obj -- ) +GENERIC: vocab-changed ( vocab obj -- ) ; : add-vocab-observer ( obj -- ) vocab-observers get push ; @@ -119,7 +119,7 @@ ERROR: no-vocab name ; : loaded-child-vocab-names ( vocab-spec -- seq ) vocab-name loaded-vocab-names [ child-vocab? ] with filter ; -GENERIC: >vocab-link ( name -- vocab ) +GENERIC: >vocab-link ( name -- vocab ) ; M: vocab-spec >vocab-link ; @@ -142,7 +142,7 @@ INSTANCE: vocab-spec definition-mixin : call-require-hook ( name -- ) require-hook get call( name -- ) ; -GENERIC: require ( object -- ) +GENERIC: require ( object -- ) ; M: vocab require name>> require ; diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor index 12866d2000..a462a3c374 100644 --- a/core/words/words-tests.factor +++ b/core/words/words-tests.factor @@ -50,7 +50,7 @@ symbol: a-symbol ! See if redefining a generic as a colon def clears some ! word props. -GENERIC: testing ( a -- b ) +GENERIC: testing ( a -- b ) ; "IN: words.tests : testing ( -- ) ;" eval( -- ) { f } [ \ testing generic? ] unit-test @@ -89,7 +89,7 @@ DEFER: deferred [ error>> undefined-word? ] must-fail-with { } [ - "IN: words.tests GENERIC: symbol-generic ( x -- x )" eval( -- ) + "IN: words.tests GENERIC: symbol-generic ( x -- x )" eval( -- ) ; ] unit-test { } [ @@ -100,7 +100,7 @@ DEFER: deferred { f } [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test { } [ - "IN: words.tests GENERIC: symbol-generic ( a -- b )" + "IN: words.tests GENERIC: symbol-generic ( a -- b ) ;" "symbol-generic-test" parse-stream drop ] unit-test diff --git a/core/words/words.factor b/core/words/words.factor index 94fb80dbb9..d62fa48d4e 100644 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -95,16 +95,16 @@ symbol: bootstrapping? : bootstrap-word ( word -- target ) [ target-word ] [ ] if-bootstrapping ; -GENERIC: crossref? ( word -- ? ) +GENERIC: crossref? ( word -- ? ) ; M: word crossref? dup "forgotten" word-prop [ drop f ] [ vocabulary>> >boolean ] if ; -GENERIC: subwords ( word -- seq ) +GENERIC: subwords ( word -- seq ) ; M: word subwords drop f ; -GENERIC: parent-word ( word -- word/f ) +GENERIC: parent-word ( word -- word/f ) ; M: word parent-word drop f ; @@ -144,7 +144,7 @@ M: word parent-word drop f ; ERROR: cannot-be-inline word ; -GENERIC: make-inline ( word -- ) +GENERIC: make-inline ( word -- ) ; M: word make-inline dup inline? [ drop ] [ @@ -159,7 +159,7 @@ M: word make-inline : make-recursive ( word -- ) t "recursive" set-word-prop ; -GENERIC: flushable? ( word -- ? ) +GENERIC: flushable? ( word -- ? ) ; M: word flushable? [ "flushable" word-prop ] @@ -168,7 +168,7 @@ M: word flushable? : make-flushable ( word -- ) t "flushable" set-word-prop ; -GENERIC: foldable? ( word -- ? ) +GENERIC: foldable? ( word -- ? ) ; M: word foldable? [ "foldable" word-prop ] @@ -178,7 +178,7 @@ M: word foldable? [ make-flushable ] [ t "foldable" set-word-prop ] bi ; -GENERIC: reset-word ( word -- ) +GENERIC: reset-word ( word -- ) ; M: word reset-word dup flushable? [ dup changed-conditionally ] when diff --git a/demos/boids/simulation/simulation.factor b/demos/boids/simulation/simulation.factor index 62fb1d8e98..15badae033 100644 --- a/demos/boids/simulation/simulation.factor +++ b/demos/boids/simulation/simulation.factor @@ -52,7 +52,7 @@ C: boid boid boids [ behaviour within-neighborhood? ] with filter ; -GENERIC: force ( neighbors boid behaviour -- force ) +GENERIC: force ( neighbors boid behaviour -- force ) ; :: (force) ( boid boids behaviour -- force ) boid boids behaviour neighbors diff --git a/demos/bunny/model/model.factor b/demos/bunny/model/model.factor index cf0fafe96a..970fea680a 100644 --- a/demos/bunny/model/model.factor +++ b/demos/bunny/model/model.factor @@ -78,8 +78,8 @@ TUPLE: bunny-buffers array element-array nv ni ; [ third length 3 * ] } cleave bunny-buffers boa ; -GENERIC: bunny-geom ( geom -- ) -GENERIC: draw-bunny ( geom draw -- ) +GENERIC: bunny-geom ( geom -- ) ; +GENERIC: draw-bunny ( geom draw -- ) ; M: bunny-dlist bunny-geom list>> glCallList ; diff --git a/demos/project-euler/215/215.factor b/demos/project-euler/215/215.factor index 1006b7a4cf..56230fb9b9 100644 --- a/demos/project-euler/215/215.factor +++ b/demos/project-euler/215/215.factor @@ -41,9 +41,9 @@ C: end : choice ( t p q -- t t ) [ [ two>> ] [ three>> ] bi ] 2dip bi* ; inline -GENERIC: merge ( t t -- t ) -GENERIC# block-merge 1 ( t t -- t ) -GENERIC# end-merge 1 ( t t -- t ) +GENERIC: merge ( t t -- t ) ; +GENERIC# block-merge 1 ( t t -- t ) ; +GENERIC# end-merge 1 ( t t -- t ) ; M: block merge block-merge ; M: end merge end-merge ; M: block block-merge [ [ two>> ] bi@ merge ] @@ -52,10 +52,10 @@ M: end block-merge nip ; M: block end-merge drop ; M: end end-merge [ ways>> ] bi@ + ; -GENERIC: h-1 ( t -- t ) -GENERIC: h0 ( t -- t ) -GENERIC: h1 ( t -- t ) -GENERIC: h2 ( t -- t ) +GENERIC: h-1 ( t -- t ) ; +GENERIC: h0 ( t -- t ) ; +GENERIC: h1 ( t -- t ) ; +GENERIC: h2 ( t -- t ) ; M: block h-1 [ h1 ] [ h2 ] choice merge ; M: block h0 drop ; @@ -74,7 +74,7 @@ M: end h2 dup failure? [ ] unless ; [ ] dip 1 - [| a b c | b c a b ] times 2drop ; -GENERIC: total ( t -- n ) +GENERIC: total ( t -- n ) ; M: block total [ total ] dup choice + ; M: end total ways>> ; diff --git a/demos/rosetta-code/align-columns/align-columns.factor b/demos/rosetta-code/align-columns/align-columns.factor index 7c9817c2f6..d662b26bcc 100644 --- a/demos/rosetta-code/align-columns/align-columns.factor +++ b/demos/rosetta-code/align-columns/align-columns.factor @@ -53,7 +53,7 @@ justified,$right$justified,$or$center$justified$within$its$column." SINGLETONS: +left+ +middle+ +right+ ; -GENERIC: align-string ( str n alignment -- str' ) +GENERIC: align-string ( str n alignment -- str' ) ; M: +left+ align-string drop CHAR: space pad-tail ; M: +right+ align-string drop CHAR: space pad-head ; diff --git a/demos/rosetta-code/arithmetic-evaluation/arithmetic-evaluation.factor b/demos/rosetta-code/arithmetic-evaluation/arithmetic-evaluation.factor index 7d780f2bb1..fc50e701f2 100644 --- a/demos/rosetta-code/arithmetic-evaluation/arithmetic-evaluation.factor +++ b/demos/rosetta-code/arithmetic-evaluation/arithmetic-evaluation.factor @@ -53,7 +53,7 @@ exp = exp:a spaces "+" fac:b => [[ a b ]] main = exp:e spaces !(.) => [[ e ]] ;EBNF -GENERIC: eval-ast ( ast -- result ) +GENERIC: eval-ast ( ast -- result ) ; M: number eval-ast ; diff --git a/demos/rosetta-code/continued-fraction/continued-fraction.factor b/demos/rosetta-code/continued-fraction/continued-fraction.factor index 80a6b1d528..98352d5d6a 100644 --- a/demos/rosetta-code/continued-fraction/continued-fraction.factor +++ b/demos/rosetta-code/continued-fraction/continued-fraction.factor @@ -19,8 +19,8 @@ IN: rosetta-code.continued-fraction ! For Pi, use a0 = 3 then aN = 6. bN = (2N − 1)2. ! Every continued fraction must implement these two words. -GENERIC: cfrac-a ( n cfrac -- a ) -GENERIC: cfrac-b ( n cfrac -- b ) +GENERIC: cfrac-a ( n cfrac -- a ) ; +GENERIC: cfrac-b ( n cfrac -- b ) ; ! square root of 2 SINGLETON: sqrt2 diff --git a/demos/rosetta-code/ternary-logic/ternary-logic.factor b/demos/rosetta-code/ternary-logic/ternary-logic.factor index c1508bb563..7d2d31f5f6 100644 --- a/demos/rosetta-code/ternary-logic/ternary-logic.factor +++ b/demos/rosetta-code/ternary-logic/ternary-logic.factor @@ -33,7 +33,7 @@ IN: rosetta-code.ternary-logic SINGLETON: m UNION: trit t m POSTPONE: f ; -GENERIC: >trit ( object -- trit ) +GENERIC: >trit ( object -- trit ) ; M: trit >trit ; : tnot ( trit1 -- trit ) diff --git a/demos/smalltalk/compiler/assignment/assignment.factor b/demos/smalltalk/compiler/assignment/assignment.factor index 99d8d6b6b3..9bfed8d85b 100644 --- a/demos/smalltalk/compiler/assignment/assignment.factor +++ b/demos/smalltalk/compiler/assignment/assignment.factor @@ -3,7 +3,7 @@ USING: accessors arrays kernel sequences sets smalltalk.ast ; IN: smalltalk.compiler.assignment -GENERIC: assigned-locals ( ast -- seq ) +GENERIC: assigned-locals ( ast -- seq ) ; M: ast-return assigned-locals value>> assigned-locals ; diff --git a/demos/smalltalk/compiler/compiler.factor b/demos/smalltalk/compiler/compiler.factor index c7f4807faf..86d0b7989e 100644 --- a/demos/smalltalk/compiler/compiler.factor +++ b/demos/smalltalk/compiler/compiler.factor @@ -8,7 +8,7 @@ smalltalk.compiler.return smalltalk.selectors splitting vocabs words ; IN: smalltalk.compiler -GENERIC: compile-ast ( lexenv ast -- quot ) +GENERIC: compile-ast ( lexenv ast -- quot ) ; M: object compile-ast nip 1quotation ; @@ -94,7 +94,7 @@ M: ast-return compile-ast M: ast-sequence compile-ast compile-sequence nip ; -GENERIC: contains-blocks? ( obj -- ? ) +GENERIC: contains-blocks? ( obj -- ? ) ; M: ast-block contains-blocks? drop t ; @@ -108,7 +108,7 @@ M: array compile-ast '[ @ _ narray ] ] [ call-next-method ] if ; -GENERIC: compile-assignment ( lexenv name -- quot ) +GENERIC: compile-assignment ( lexenv name -- quot ) ; M: ast-name compile-assignment name>> swap lookup-writer ; diff --git a/demos/smalltalk/compiler/return/return.factor b/demos/smalltalk/compiler/return/return.factor index f34aba012b..34fea5d4c2 100644 --- a/demos/smalltalk/compiler/return/return.factor +++ b/demos/smalltalk/compiler/return/return.factor @@ -7,7 +7,7 @@ IN: smalltalk.compiler.return SYMBOL: return-continuation -GENERIC: need-return-continuation? ( ast -- ? ) +GENERIC: need-return-continuation? ( ast -- ? ) ; M: ast-return need-return-continuation? drop t ; diff --git a/demos/smalltalk/printer/printer.factor b/demos/smalltalk/printer/printer.factor index cbf4baf74d..be930c6b26 100644 --- a/demos/smalltalk/printer/printer.factor +++ b/demos/smalltalk/printer/printer.factor @@ -4,7 +4,7 @@ USING: accessors arrays byte-arrays kernel make math math.parser prettyprint sequences smalltalk.ast strings ; IN: smalltalk.printer -GENERIC: smalltalk>string ( object -- string ) +GENERIC: smalltalk>string ( object -- string ) ; M: real smalltalk>string number>string ; @@ -15,7 +15,7 @@ M: string smalltalk>string "'" % ] "" make ; -GENERIC: array-element>string ( object -- string ) +GENERIC: array-element>string ( object -- string ) ; M: object array-element>string smalltalk>string ; diff --git a/demos/talks/galois-talk/galois-talk.factor b/demos/talks/galois-talk/galois-talk.factor index ba0e88842c..267ca78648 100644 --- a/demos/talks/galois-talk/galois-talk.factor +++ b/demos/talks/galois-talk/galois-talk.factor @@ -65,7 +65,7 @@ CONSTANT: galois-slides } { $slide "Object system" "Generic words and methods" - { $code "GENERIC: area ( shape -- n )" } + { $code "GENERIC: area ( shape -- n ) ;" } "Two methods:" { $code "USE: math.constants" @@ -110,7 +110,7 @@ CONSTANT: galois-slides "PREDICATE: positive < integer 0 > ;" "PREDICATE: negative < integer 0 < ;" "" - "GENERIC: abs ( n -- )" + "GENERIC: abs ( n -- ) ;" "" "M: positive abs ;" "M: negative abs -1 * ;" diff --git a/demos/talks/google-tech-talk/google-tech-talk.factor b/demos/talks/google-tech-talk/google-tech-talk.factor index 89d19e94fa..1974790cc4 100644 --- a/demos/talks/google-tech-talk/google-tech-talk.factor +++ b/demos/talks/google-tech-talk/google-tech-talk.factor @@ -111,7 +111,7 @@ CONSTANT: google-slides } { $slide "Object system" "Generic words and methods" - { $code "GENERIC: area ( shape -- n )" } + { $code "GENERIC: area ( shape -- n ) ;" } "Two methods:" { $code "USE: math.constants" @@ -130,7 +130,7 @@ CONSTANT: google-slides { $slide "Object system" "New operation, existing types:" { $code - "GENERIC: perimeter ( shape -- n )" + "GENERIC: perimeter ( shape -- n ) ;" "" "M: rectangle perimeter" " [ width>> ] [ height>> ] bi + 2 * ;" @@ -188,7 +188,7 @@ CONSTANT: google-slides { $slide "Object system" "Or put methods on shapes:" { $code - "GENERIC: tell-me ( obj -- )" + "GENERIC: tell-me ( obj -- ) ;" "" "M: shape tell-me" " \"My area is \" write area . ;" diff --git a/demos/talks/minneapolis-talk/minneapolis-talk.factor b/demos/talks/minneapolis-talk/minneapolis-talk.factor index bfdd8e253e..2c2b7f6edd 100644 --- a/demos/talks/minneapolis-talk/minneapolis-talk.factor +++ b/demos/talks/minneapolis-talk/minneapolis-talk.factor @@ -81,7 +81,7 @@ CONSTANT: minneapolis-slides $slide "An example" { $code "USE: math.constants" - "GENERIC: area ( shape -- meters^2 )" + "GENERIC: area ( shape -- meters^2 ) ;" "M: square area square-dimension sq ;" "M: circle area circle-radius sq pi * ;" "M: rectangle area" diff --git a/demos/talks/tc-lisp-talk/tc-lisp-talk.factor b/demos/talks/tc-lisp-talk/tc-lisp-talk.factor index c2a0c14ed8..cb9e885843 100644 --- a/demos/talks/tc-lisp-talk/tc-lisp-talk.factor +++ b/demos/talks/tc-lisp-talk/tc-lisp-talk.factor @@ -84,8 +84,8 @@ CONSTANT: tc-lisp-slides "In ~/factor/work/shapes/shapes.factor" { $code "IN: shapes -GENERIC: area ( shape -- x ) -GENERIC: perimeter ( shape -- x )" +GENERIC: area ( shape -- x ) ; +GENERIC: perimeter ( shape -- x ) ;" } } { $slide "Implementing the shape protocol: circles" diff --git a/demos/talks/vpri-talk/vpri-talk.factor b/demos/talks/vpri-talk/vpri-talk.factor index cba09eb312..9ce4d27ec5 100644 --- a/demos/talks/vpri-talk/vpri-talk.factor +++ b/demos/talks/vpri-talk/vpri-talk.factor @@ -61,7 +61,7 @@ CONSTANT: vpri-slides } { $slide "Object system" "Generic words and methods" - { $code "GENERIC: area ( shape -- n )" } + { $code "GENERIC: area ( shape -- n ) ;" } "Two methods:" { $code "USE: math.constants" @@ -80,7 +80,7 @@ CONSTANT: vpri-slides { $slide "Object system" "New operation, existing types:" { $code - "GENERIC: perimeter ( shape -- n )" + "GENERIC: perimeter ( shape -- n ) ;" "" "M: rectangle perimeter" " [ width>> ] [ height>> ] bi + 2 * ;" @@ -252,7 +252,7 @@ CONSTANT: vpri-slides { { $link call } " is fundamental" } { { $link quotation } ", " { $link curry } " and " { $link compose } " are classes" } { $code - "GENERIC: call ( quot -- )" + "GENERIC: call ( quot -- ) ;" "M: curry call uncurry call ;" "M: compose call uncompose slip call ;" "M: quotation call (call) ;" diff --git a/ffi/cairo-gadgets/cairo-gadgets.factor b/ffi/cairo-gadgets/cairo-gadgets.factor index 4a5d39de4b..5cb679fdff 100644 --- a/ffi/cairo-gadgets/cairo-gadgets.factor +++ b/ffi/cairo-gadgets/cairo-gadgets.factor @@ -32,7 +32,7 @@ SYMBOL: current-cairo PRIVATE> -GENERIC: render-cairo* ( gadget -- ) +GENERIC: render-cairo* ( gadget -- ) ; : render-cairo ( gadget -- alien ) [ diff --git a/ffi/core-foundation/numbers/numbers.factor b/ffi/core-foundation/numbers/numbers.factor index bdeb3bf017..cb40b771e3 100644 --- a/ffi/core-foundation/numbers/numbers.factor +++ b/ffi/core-foundation/numbers/numbers.factor @@ -33,7 +33,7 @@ FUNCTION: CFNumberType CFNumberGetType ( CFNumberRef number ) FUNCTION: Boolean CFNumberGetValue ( CFNumberRef number, CFNumberType theType, void* valuePtr ) -GENERIC: ( number -- alien ) +GENERIC: ( number -- alien ) ; M: integer [ f kCFNumberLongLongType ] dip longlong CFNumberCreate ; diff --git a/ffi/core-foundation/utilities/utilities.factor b/ffi/core-foundation/utilities/utilities.factor index fc74fc4ffc..1dbd98bc19 100644 --- a/ffi/core-foundation/utilities/utilities.factor +++ b/ffi/core-foundation/utilities/utilities.factor @@ -7,7 +7,7 @@ core-foundation.strings destructors hashtables kernel math sequences strings ; IN: core-foundation.utilities -GENERIC: (>cf) ( obj -- cf ) +GENERIC: (>cf) ( obj -- cf ) ; M: number (>cf) ; M: t (>cf) ; diff --git a/ffi/cuda/libraries/libraries.factor b/ffi/cuda/libraries/libraries.factor index 41afac8602..f625c8fab3 100644 --- a/ffi/cuda/libraries/libraries.factor +++ b/ffi/cuda/libraries/libraries.factor @@ -53,7 +53,7 @@ TUPLE: grid grid boa ; inline string write ; @@ -362,7 +362,7 @@ M: ptx-indirect write-ptx-operand } cond "]" write ; -GENERIC: (write-ptx-element) ( elt -- ) +GENERIC: (write-ptx-element) ( elt -- ) ; : write-ptx-element ( elt -- ) dup ptx-element-label [ write ":" write ] when* diff --git a/ffi/forestdb/lib/lib.factor b/ffi/forestdb/lib/lib.factor index 50e7144170..7211314c4e 100644 --- a/ffi/forestdb/lib/lib.factor +++ b/ffi/forestdb/lib/lib.factor @@ -46,7 +46,7 @@ SYMBOL: current-fdb-kvs-handle : get-kvs-handle ( -- handle ) current-fdb-kvs-handle get handle>> ; -GENERIC: encode-kv ( object -- bytes ) +GENERIC: encode-kv ( object -- bytes ) ; M: string encode-kv utf8 encode ; M: byte-array encode-kv ; diff --git a/ffi/gobject-introspection/ffi/ffi.factor b/ffi/gobject-introspection/ffi/ffi.factor index c501958c93..61edb510a7 100644 --- a/ffi/gobject-introspection/ffi/ffi.factor +++ b/ffi/gobject-introspection/ffi/ffi.factor @@ -39,7 +39,7 @@ IN: gobject-introspection.ffi : def-aliases ( aliases -- ) [ def-alias ] each ; -GENERIC: type>c-type ( type -- c-type ) +GENERIC: type>c-type ( type -- c-type ) ; M: atomic-type type>c-type get-type-info c-type>> ; M: enum-type type>c-type get-type-info c-type>> ; @@ -65,7 +65,7 @@ PREDICATE: incorrect-type < simple-type name>> not ; M: incorrect-type type>c-type drop void* ; ! workaround> -GENERIC: parse-const-value ( str data-type -- value ) +GENERIC: parse-const-value ( str data-type -- value ) ; M: atomic-type parse-const-value name>> { @@ -96,7 +96,7 @@ M: utf8-type parse-const-value drop ; : def-bitfield-type ( bitfield -- ) def-enum-type ; -GENERIC: parameter-type>c-type ( data-type -- c-type ) +GENERIC: parameter-type>c-type ( data-type -- c-type ) ; M: data-type parameter-type>c-type type>c-type ; M: varargs-type parameter-type>c-type drop void* ; @@ -105,7 +105,7 @@ M: varargs-type parameter-type>c-type drop void* ; [ type>> parameter-type>c-type ] keep direction>> "in" = [ ] unless ; -GENERIC: return-type>c-type ( data-type -- c-type ) +GENERIC: return-type>c-type ( data-type -- c-type ) ; M: data-type return-type>c-type type>c-type ; M: none-type return-type>c-type drop void ; @@ -142,7 +142,7 @@ M: none-type return-type>c-type drop void ; : def-functions ( functions -- ) [ def-function ] each ; -GENERIC: type>data-type ( type -- data-type ) +GENERIC: type>data-type ( type -- data-type ) ; M: type type>data-type [ simple-type new ] dip name>> >>name ; @@ -186,7 +186,7 @@ M: type type>data-type [ ?suffix-parameters-with-error parameter-names&types ] } cleave make-callback-type define-inline ; -GENERIC: field-type>c-type ( data-type -- c-type ) +GENERIC: field-type>c-type ( data-type -- c-type ) ; M: simple-type field-type>c-type type>c-type ; M: inner-callback-type field-type>c-type drop void* ; diff --git a/ffi/mongodb/driver/driver.factor b/ffi/mongodb/driver/driver.factor index bfad87b739..5ac041728f 100644 --- a/ffi/mongodb/driver/driver.factor +++ b/ffi/mongodb/driver/driver.factor @@ -42,7 +42,7 @@ M: mdb-error pprint* ( obj -- ) ( id mdb-query-msg/mdb-getmore-msg -- mdb-cursor ) +GENERIC: ( id mdb-query-msg/mdb-getmore-msg -- mdb-cursor ) ; M: mdb-query-msg mdb-cursor boa ; @@ -53,7 +53,7 @@ M: mdb-getmore-msg : >mdbregexp ( value -- regexp ) first ; inline -GENERIC: update-query ( mdb-result-msg mdb-query-msg/mdb-getmore-msg -- ) +GENERIC: update-query ( mdb-result-msg mdb-query-msg/mdb-getmore-msg -- ) ; M: mdb-query-msg update-query swap [ start#>> ] [ returned#>> ] bi + >>skip# drop ; @@ -69,7 +69,7 @@ M: mdb-getmore-msg update-query DEFER: send-query -GENERIC: verify-query-result ( mdb-result-msg mdb-query-msg/mdb-getmore-msg -- mdb-result-msg mdb-query-msg/mdb-getmore-msg ) +GENERIC: verify-query-result ( mdb-result-msg mdb-query-msg/mdb-getmore-msg -- mdb-result-msg mdb-query-msg/mdb-getmore-msg ) ; M: mdb-query-msg verify-query-result ; @@ -113,7 +113,7 @@ SYNTAX: r/ H{ } clone [ set-at ] keep [ verify-nodes ] keep ; -GENERIC: create-collection ( name/collection -- ) +GENERIC: create-collection ( name/collection -- ) ; M: string create-collection create-collection ; @@ -214,12 +214,12 @@ PRIVATE> : key-spec ( spec-quot -- spec-assoc ) output>array >hashtable ; inline -GENERIC# hint 1 ( mdb-query-msg index-hint -- mdb-query-msg ) +GENERIC# hint 1 ( mdb-query-msg index-hint -- mdb-query-msg ) ; M: mdb-query-msg hint >>hint ; -GENERIC: find ( selector -- mdb-cursor/f seq ) +GENERIC: find ( selector -- mdb-cursor/f seq ) ; M: mdb-query-msg find fix-query-collection send-query ; @@ -253,7 +253,7 @@ M: mdb-cursor find getlasterror-cmd make-cmd send-cmd [ "err" ] dip at ; -GENERIC: validate. ( collection -- ) +GENERIC: validate. ( collection -- ) ; M: string validate. [ validate-cmd make-cmd ] dip diff --git a/ffi/mongodb/msg/msg.factor b/ffi/mongodb/msg/msg.factor index ed29dd8827..884e76c277 100644 --- a/ffi/mongodb/msg/msg.factor +++ b/ffi/mongodb/msg/msg.factor @@ -75,7 +75,7 @@ CONSTRUCTOR: mdb-delete-msg ( collection selector -- mdb-delete CONSTRUCTOR: mdb-query-msg ( collection query -- mdb-query-msg ) OP_Query >>opcode ; inline -GENERIC: ( object -- mdb-killcursors-msg ) +GENERIC: ( object -- mdb-killcursors-msg ) ; M: sequence ( sequences -- mdb-killcursors-msg ) [ mdb-killcursors-msg new ] dip @@ -85,7 +85,7 @@ M: sequence ( sequences -- mdb-killcursors-msg ) M: integer ( integer -- mdb-killcursors-msg ) V{ } clone [ push ] keep ; -GENERIC: ( collection objects -- mdb-insert-msg ) +GENERIC: ( collection objects -- mdb-insert-msg ) ; M: sequence ( collection sequence -- mdb-insert-msg ) [ mdb-insert-msg new ] 2dip diff --git a/ffi/mongodb/tuple/collection/collection.factor b/ffi/mongodb/tuple/collection/collection.factor index 9cd988d6fc..fb2850a96e 100644 --- a/ffi/mongodb/tuple/collection/collection.factor +++ b/ffi/mongodb/tuple/collection/collection.factor @@ -51,11 +51,11 @@ M: mdb-persistent id<< ( object value -- ) TUPLE: mdb-tuple-collection < mdb-collection { classes } ; -GENERIC: tuple-collection ( object -- mdb-collection ) +GENERIC: tuple-collection ( object -- mdb-collection ) ; -GENERIC: mdb-slot-map ( tuple -- assoc ) +GENERIC: mdb-slot-map ( tuple -- assoc ) ; -GENERIC: mdb-index-map ( tuple -- sequence ) +GENERIC: mdb-index-map ( tuple -- sequence ) ; -GENERIC: ( name -- mdb-tuple-collection ) +GENERIC: ( name -- mdb-tuple-collection ) ; M: string collection-map [ ] [ key? ] 2bi [ at ] [ [ mdb-tuple-collection new dup ] 2dip diff --git a/ffi/mongodb/tuple/persistent/persistent.factor b/ffi/mongodb/tuple/persistent/persistent.factor index 72c7237a77..b637b56ca9 100644 --- a/ffi/mongodb/tuple/persistent/persistent.factor +++ b/ffi/mongodb/tuple/persistent/persistent.factor @@ -6,9 +6,9 @@ IN: mongodb.tuple.persistent SYMBOLS: object-map ; -GENERIC: tuple>assoc ( tuple -- assoc ) +GENERIC: tuple>assoc ( tuple -- assoc ) ; -GENERIC: tuple>selector ( tuple -- selector ) +GENERIC: tuple>selector ( tuple -- selector ) ; DEFER: assoc>tuple @@ -86,7 +86,7 @@ CONSTRUCTOR: cond-value ( value quot -- cond-value ) ; PRIVATE> -GENERIC: tuple>storable ( tuple -- storable ) +GENERIC: tuple>storable ( tuple -- storable ) ; : ensure-oid ( tuple -- tuple ) dup id>> [ >>id ] unless ; inline diff --git a/ffi/mongodb/tuple/tuple.factor b/ffi/mongodb/tuple/tuple.factor index 9522a19dc0..55423838fc 100644 --- a/ffi/mongodb/tuple/tuple.factor +++ b/ffi/mongodb/tuple/tuple.factor @@ -44,7 +44,7 @@ DEFER: tuple>query > ] [ key>> ] bi associate ; inline diff --git a/ffi/openal/alut/backend/backend.factor b/ffi/openal/alut/backend/backend.factor index fc50d3d15e..dba715ef1a 100755 --- a/ffi/openal/alut/backend/backend.factor +++ b/ffi/openal/alut/backend/backend.factor @@ -1,4 +1,4 @@ USING: namespaces system ; IN: openal.alut.backend -HOOK: load-wav-file os ( filename -- format data size frequency ) +HOOK: load-wav-file os ( filename -- format data size frequency ) ; diff --git a/ffi/opencl/opencl.factor b/ffi/opencl/opencl.factor index 8325be9a9c..75d0e65182 100644 --- a/ffi/opencl/opencl.factor +++ b/ffi/opencl/opencl.factor @@ -176,23 +176,23 @@ SYMBOLS: cl-current-context cl-current-queue cl-current-device ; : (current-cl-device) ( -- cl-device ) cl-current-device get ; inline -GENERIC: buffer-access-constant ( buffer-access-mode -- n ) +GENERIC: buffer-access-constant ( buffer-access-mode -- n ) ; M: cl-read-write-access buffer-access-constant drop CL_MEM_READ_WRITE ; M: cl-read-access buffer-access-constant drop CL_MEM_READ_ONLY ; M: cl-write-access buffer-access-constant drop CL_MEM_WRITE_ONLY ; -GENERIC: buffer-map-flags ( buffer-access-mode -- n ) +GENERIC: buffer-map-flags ( buffer-access-mode -- n ) ; M: cl-read-write-access buffer-map-flags drop CL_MAP_READ CL_MAP_WRITE bitor ; M: cl-read-access buffer-map-flags drop CL_MAP_READ ; M: cl-write-access buffer-map-flags drop CL_MAP_WRITE ; -GENERIC: addressing-mode-constant ( addressing-mode -- n ) +GENERIC: addressing-mode-constant ( addressing-mode -- n ) ; M: cl-repeat-addressing addressing-mode-constant drop CL_ADDRESS_REPEAT ; M: cl-clamp-to-edge-addressing addressing-mode-constant drop CL_ADDRESS_CLAMP_TO_EDGE ; M: cl-clamp-addressing addressing-mode-constant drop CL_ADDRESS_CLAMP ; M: cl-no-addressing addressing-mode-constant drop CL_ADDRESS_NONE ; -GENERIC: filter-mode-constant ( filter-mode -- n ) +GENERIC: filter-mode-constant ( filter-mode -- n ) ; M: cl-filter-nearest filter-mode-constant drop CL_FILTER_NEAREST ; M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ; @@ -415,7 +415,7 @@ M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ; [ handle>> ] 2dip [ byte-length ] keep clSetKernelArg cl-success ; inline -GENERIC: bind-kernel-arg ( kernel index data -- ) +GENERIC: bind-kernel-arg ( kernel index data -- ) ; M: cl-buffer bind-kernel-arg bind-kernel-arg-buffer ; M: byte-array bind-kernel-arg bind-kernel-arg-data ; diff --git a/ffi/opengl/demo-support/demo-support.factor b/ffi/opengl/demo-support/demo-support.factor index 4be6bc2781..5da1f0c42e 100644 --- a/ffi/opengl/demo-support/demo-support.factor +++ b/ffi/opengl/demo-support/demo-support.factor @@ -14,9 +14,9 @@ TUPLE: demo-world < world yaw pitch distance ; : set-demo-orientation ( world yaw pitch distance -- world ) [ >>yaw ] [ >>pitch ] [ >>distance ] tri* ; -GENERIC: far-plane ( gadget -- z ) -GENERIC: near-plane ( gadget -- z ) -GENERIC: distance-step ( gadget -- dz ) +GENERIC: far-plane ( gadget -- z ) ; +GENERIC: near-plane ( gadget -- z ) ; +GENERIC: distance-step ( gadget -- dz ) ; M: demo-world far-plane ( gadget -- z ) drop 4.0 ; diff --git a/ffi/opengl/textures/textures.factor b/ffi/opengl/textures/textures.factor index 0accf6f846..c79aa33052 100644 --- a/ffi/opengl/textures/textures.factor +++ b/ffi/opengl/textures/textures.factor @@ -133,7 +133,7 @@ CONSTANT: image-internal-formats H{ { { RGBA u-10-10-10-2-components } $ GL_RGB10_A2 } } -GENERIC: fix-internal-component-order ( order -- order' ) +GENERIC: fix-internal-component-order ( order -- order' ) ; M: object fix-internal-component-order ; M: BGR fix-internal-component-order drop RGB ; @@ -193,7 +193,7 @@ M: XBGR fix-internal-component-order drop RGBA ; } case ] if ; -GENERIC: (component-type>type) ( component-order component-type -- gl-type ) +GENERIC: (component-type>type) ( component-order component-type -- gl-type ) ; M: object (component-type>type) unsupported-component-order ; @@ -262,7 +262,7 @@ SLOT: display-list : draw-texture ( texture -- ) display-list>> [ glCallList ] when* ; -GENERIC: draw-scaled-texture ( dim texture -- ) +GENERIC: draw-scaled-texture ( dim texture -- ) ; DEFER: make-texture diff --git a/ffi/pcre/pcre.factor b/ffi/pcre/pcre.factor index e17eeaa71e..9af6b98d73 100644 --- a/ffi/pcre/pcre.factor +++ b/ffi/pcre/pcre.factor @@ -138,7 +138,7 @@ TUPLE: compiled-pcre pcre extra nametable ; : has-option? ( compiled-pcre option -- ? ) [ pcre>> options ] dip bitand 0 > ; -GENERIC: findall ( subject obj -- matches ) +GENERIC: findall ( subject obj -- matches ) ; M: compiled-pcre findall [ [ findnext dup ] [ ] produce 2nip ] diff --git a/ffi/python/python.factor b/ffi/python/python.factor index 42c2a48b54..6843399e31 100644 --- a/ffi/python/python.factor +++ b/ffi/python/python.factor @@ -61,7 +61,7 @@ SPECIALIZED-ARRAY: void* DEFER: >py -GENERIC: >py ( obj -- py-obj ) +GENERIC: >py ( obj -- py-obj ) ; M: string >py utf8>py-unicode check-new-ref ; M: math:fixnum >py diff --git a/ffi/system-info/system-info.factor b/ffi/system-info/system-info.factor index 156d20ed8e..cedcf8825a 100644 --- a/ffi/system-info/system-info.factor +++ b/ffi/system-info/system-info.factor @@ -4,17 +4,17 @@ USING: accessors io kernel math math.parser sequences system vocabs ; IN: system-info -HOOK: os-version os ( -- version ) -HOOK: cpus os ( -- n ) -HOOK: cpu-mhz os ( -- n ) -HOOK: memory-load os ( -- n ) -HOOK: physical-mem os ( -- n ) -HOOK: available-mem os ( -- n ) -HOOK: total-page-file os ( -- n ) -HOOK: available-page-file os ( -- n ) -HOOK: total-virtual-mem os ( -- n ) -HOOK: available-virtual-mem os ( -- n ) -HOOK: available-virtual-extended-mem os ( -- n ) +HOOK: os-version os ( -- version ) ; +HOOK: cpus os ( -- n ) ; +HOOK: cpu-mhz os ( -- n ) ; +HOOK: memory-load os ( -- n ) ; +HOOK: physical-mem os ( -- n ) ; +HOOK: available-mem os ( -- n ) ; +HOOK: total-page-file os ( -- n ) ; +HOOK: available-page-file os ( -- n ) ; +HOOK: total-virtual-mem os ( -- n ) ; +HOOK: available-virtual-mem os ( -- n ) ; +HOOK: available-virtual-extended-mem os ( -- n ) ; : write-unit ( x n str -- ) [ 2^ /f number>string write bl ] [ write ] bi* ; diff --git a/ffi/terminal/terminal.factor b/ffi/terminal/terminal.factor index 996220b6cc..3f8c43fe5c 100644 --- a/ffi/terminal/terminal.factor +++ b/ffi/terminal/terminal.factor @@ -6,7 +6,7 @@ sequences system vocabs ; IN: terminal -HOOK: (terminal-size) os ( -- columns lines ) +HOOK: (terminal-size) os ( -- columns lines ) ; "terminal." os name>> append require diff --git a/ffi/terminfo/terminfo.factor b/ffi/terminfo/terminfo.factor index 3372a07e82..fd2964c85d 100644 --- a/ffi/terminfo/terminfo.factor +++ b/ffi/terminfo/terminfo.factor @@ -69,7 +69,7 @@ PRIVATE> : file>terminfo ( path -- terminfo ) binary [ read-terminfo ] with-file-reader ; -HOOK: terminfo-path os ( name -- path ) +HOOK: terminfo-path os ( name -- path ) ; M: macosx terminfo-path ( name -- path ) [ first >hex ] keep "/usr/share/terminfo/%s/%s" sprintf ; diff --git a/ffi/text-to-speech/text-to-speech.factor b/ffi/text-to-speech/text-to-speech.factor index 6b6377fbc0..3c5014acc1 100644 --- a/ffi/text-to-speech/text-to-speech.factor +++ b/ffi/text-to-speech/text-to-speech.factor @@ -12,7 +12,7 @@ IN: text-to-speech ! 3. core-audio? ! 4. use google-translate-tts, download and play? -HOOK: speak-text os ( str -- ) +HOOK: speak-text os ( str -- ) ; { { [ os macosx? ] [ "text-to-speech.macosx" ] } @@ -20,7 +20,7 @@ HOOK: speak-text os ( str -- ) { [ os windows? ] [ "text-to-speech.windows" ] } } cond require -GENERIC: speak ( obj -- ) +GENERIC: speak ( obj -- ) ; M: object speak present speak-text ; diff --git a/ffi/unix/groups/groups.factor b/ffi/unix/groups/groups.factor index ad285a665e..0e574d3979 100644 --- a/ffi/unix/groups/groups.factor +++ b/ffi/unix/groups/groups.factor @@ -10,7 +10,7 @@ TUPLE: group id name passwd members ; SYMBOL: group-cache -GENERIC: group-struct ( obj -- group/f ) +GENERIC: group-struct ( obj -- group/f ) ; -GENERIC: user-groups ( string/id -- seq ) +GENERIC: user-groups ( string/id -- seq ) ; M: string user-groups ( string -- seq ) (user-groups) ; @@ -109,9 +109,9 @@ M: integer user-groups ( id -- seq ) : group-exists? ( name/id -- ? ) group-id >boolean ; -GENERIC: set-real-group ( obj -- ) +GENERIC: set-real-group ( obj -- ) ; -GENERIC: set-effective-group ( obj -- ) +GENERIC: set-effective-group ( obj -- ) ; : (with-real-group) ( string/id quot -- ) '[ _ set-real-group @ ] diff --git a/ffi/unix/linux/proc/proc.factor b/ffi/unix/linux/proc/proc.factor index e05eb37744..c0467f6ecc 100644 --- a/ffi/unix/linux/proc/proc.factor +++ b/ffi/unix/linux/proc/proc.factor @@ -278,7 +278,7 @@ TUPLE: proc-uptime up idle ; ! /proc/pid/* -GENERIC# proc-pid-path 1 ( object string -- path ) +GENERIC# proc-pid-path 1 ( object string -- path ) ; M: integer proc-pid-path ( pid string -- path ) [ "/proc/" ] 2dip diff --git a/ffi/unix/unix.factor b/ffi/unix/unix.factor index 7c61cd531f..242268f462 100644 --- a/ffi/unix/unix.factor +++ b/ffi/unix/unix.factor @@ -58,7 +58,7 @@ MACRO:: unix-system-call-allow-eintr ( quot -- quot ) ] if ] ; -HOOK: open-file os ( path flags mode -- fd ) +HOOK: open-file os ( path flags mode -- fd ) ; : close-file ( fd -- ) [ close ] unix-system-call-allow-eintr drop ; diff --git a/ffi/unix/users/users.factor b/ffi/unix/users/users.factor index ee2e592c1f..b7c88788a1 100644 --- a/ffi/unix/users/users.factor +++ b/ffi/unix/users/users.factor @@ -10,8 +10,8 @@ IN: unix.users TUPLE: passwd user-name password uid gid gecos dir shell ; -HOOK: new-passwd os ( -- passwd ) -HOOK: passwd>new-passwd os ( passwd -- new-passwd ) +HOOK: new-passwd os ( -- passwd ) ; +HOOK: passwd>new-passwd os ( passwd -- new-passwd ) ; user-cache ] dip with-variable ; inline -GENERIC: user-passwd ( obj -- passwd/f ) +GENERIC: user-passwd ( obj -- passwd/f ) ; M: integer user-passwd ( id -- passwd/f ) user-cache get @@ -87,9 +87,9 @@ ERROR: no-user string ; : user-exists? ( name/id -- ? ) user-id >boolean ; -GENERIC: set-real-user ( string/id -- ) +GENERIC: set-real-user ( string/id -- ) ; -GENERIC: set-effective-user ( string/id -- ) +GENERIC: set-effective-user ( string/id -- ) ; : (with-real-user) ( string/id quot -- ) '[ _ set-real-user @ ] diff --git a/ffi/unix/utmpx/utmpx.factor b/ffi/unix/utmpx/utmpx.factor index 6e78f12671..a90c868376 100644 --- a/ffi/unix/utmpx/utmpx.factor +++ b/ffi/unix/utmpx/utmpx.factor @@ -27,9 +27,9 @@ FUNCTION: utmpx* pututxline ( utmpx* utx ) TUPLE: utmpx-record user id line pid type timestamp host ; -HOOK: new-utmpx-record os ( -- utmpx-record ) +HOOK: new-utmpx-record os ( -- utmpx-record ) ; -HOOK: utmpx>utmpx-record os ( utmpx -- utmpx-record ) +HOOK: utmpx>utmpx-record os ( utmpx -- utmpx-record ) ; : memory>string ( alien n -- string ) memory>byte-array utf8 decode [ 0 = ] trim-tail ; diff --git a/ffi/windows/directx/dinput/constants/constants.factor b/ffi/windows/directx/dinput/constants/constants.factor index 4c4ddcde7a..042e46cf14 100755 --- a/ffi/windows/directx/dinput/constants/constants.factor +++ b/ffi/windows/directx/dinput/constants/constants.factor @@ -25,7 +25,7 @@ SYMBOLS: << -GENERIC: array-base-type ( c-type -- c-type' ) +GENERIC: array-base-type ( c-type -- c-type' ) ; M: object array-base-type ; M: array array-base-type first ; diff --git a/ffi/windows/winsock/winsock.factor b/ffi/windows/winsock/winsock.factor index 234d4b1c5b..a83938bc0f 100644 --- a/ffi/windows/winsock/winsock.factor +++ b/ffi/windows/winsock/winsock.factor @@ -157,7 +157,7 @@ STRUCT: timeval { sec long } { usec long } ; -GENERIC: sockaddr>ip ( sockaddr -- string ) +GENERIC: sockaddr>ip ( sockaddr -- string ) ; M: sockaddr-in sockaddr>ip ( sockaddr -- string ) addr>> uint [ number>string ] { } map-as "." join ; diff --git a/ffi/x11/events/events.factor b/ffi/x11/events/events.factor index 949c751de5..a1c9dc269c 100644 --- a/ffi/x11/events/events.factor +++ b/ffi/x11/events/events.factor @@ -5,35 +5,35 @@ combinators.short-circuit kernel math.order namespaces x11 x11.xlib ; IN: x11.events -GENERIC: expose-event ( event window -- ) +GENERIC: expose-event ( event window -- ) ; -GENERIC: configure-event ( event window -- ) +GENERIC: configure-event ( event window -- ) ; -GENERIC: button-down-event ( event window -- ) +GENERIC: button-down-event ( event window -- ) ; -GENERIC: button-up-event ( event window -- ) +GENERIC: button-up-event ( event window -- ) ; -GENERIC: enter-event ( event window -- ) +GENERIC: enter-event ( event window -- ) ; -GENERIC: leave-event ( event window -- ) +GENERIC: leave-event ( event window -- ) ; -GENERIC: scroll-event ( event window -- ) +GENERIC: scroll-event ( event window -- ) ; -GENERIC: motion-event ( event window -- ) +GENERIC: motion-event ( event window -- ) ; -GENERIC: key-down-event ( event window -- ) +GENERIC: key-down-event ( event window -- ) ; -GENERIC: key-up-event ( event window -- ) +GENERIC: key-up-event ( event window -- ) ; -GENERIC: focus-in-event ( event window -- ) +GENERIC: focus-in-event ( event window -- ) ; -GENERIC: focus-out-event ( event window -- ) +GENERIC: focus-out-event ( event window -- ) ; -GENERIC: selection-notify-event ( event window -- ) +GENERIC: selection-notify-event ( event window -- ) ; -GENERIC: selection-request-event ( event window -- ) +GENERIC: selection-request-event ( event window -- ) ; -GENERIC: client-event ( event window -- ) +GENERIC: client-event ( event window -- ) ; : next-event ( -- event ) dpy get XEvent [ XNextEvent drop ] keep ; diff --git a/ffi/x11/io/io.factor b/ffi/x11/io/io.factor index 2eaf434072..0a3481884e 100644 --- a/ffi/x11/io/io.factor +++ b/ffi/x11/io/io.factor @@ -3,14 +3,14 @@ USING: io.backend calendar threads kernel ; IN: x11.io -HOOK: init-x-io io-backend ( -- ) +HOOK: init-x-io io-backend ( -- ) ; M: object init-x-io ; -HOOK: wait-for-display io-backend ( -- ) +HOOK: wait-for-display io-backend ( -- ) ; M: object wait-for-display 10 milliseconds sleep ; -HOOK: awaken-event-loop io-backend ( -- ) +HOOK: awaken-event-loop io-backend ( -- ) ; M: object awaken-event-loop ; diff --git a/frameworks/db/db.factor b/frameworks/db/db.factor index a9e7bdca24..3c573032d8 100644 --- a/frameworks/db/db.factor +++ b/frameworks/db/db.factor @@ -21,9 +21,9 @@ TUPLE: db-connection PRIVATE> -GENERIC: db-open ( db -- db-connection ) -HOOK: db-close db-connection ( handle -- ) -HOOK: parse-db-error db-connection ( error -- error' ) +GENERIC: db-open ( db -- db-connection ) ; +HOOK: db-close db-connection ( handle -- ) ; +HOOK: parse-db-error db-connection ( error -- error' ) ; : dispose-statements ( assoc -- ) values dispose-each ; @@ -38,13 +38,13 @@ M: db-connection dispose ( db-connection -- ) TUPLE: result-set sql in-params out-params handle n max ; -GENERIC: query-results ( query -- result-set ) -GENERIC: #rows ( result-set -- n ) -GENERIC: #columns ( result-set -- n ) -GENERIC# row-column 1 ( result-set column -- obj ) -GENERIC# row-column-typed 1 ( result-set column -- sql ) -GENERIC: advance-row ( result-set -- ) -GENERIC: more-rows? ( result-set -- ? ) +GENERIC: query-results ( query -- result-set ) ; +GENERIC: #rows ( result-set -- n ) ; +GENERIC: #columns ( result-set -- n ) ; +GENERIC# row-column 1 ( result-set column -- obj ) ; +GENERIC# row-column-typed 1 ( result-set column -- sql ) ; +GENERIC: advance-row ( result-set -- ) ; +GENERIC: more-rows? ( result-set -- ? ) ; : init-result-set ( result-set -- ) dup #rows >>max @@ -68,14 +68,14 @@ TUPLE: prepared-statement < statement ; swap >>in-params swap >>sql ; -HOOK: db-connection ( string in out -- statement ) -HOOK: db-connection ( string in out -- statement ) -GENERIC: prepare-statement ( statement -- ) -GENERIC: bind-statement* ( statement -- ) -GENERIC: low-level-bind ( statement -- ) -GENERIC: bind-tuple ( tuple statement -- ) +HOOK: db-connection ( string in out -- statement ) ; +HOOK: db-connection ( string in out -- statement ) ; +GENERIC: prepare-statement ( statement -- ) ; +GENERIC: bind-statement* ( statement -- ) ; +GENERIC: low-level-bind ( statement -- ) ; +GENERIC: bind-tuple ( tuple statement -- ) ; -GENERIC: execute-statement* ( statement type -- ) +GENERIC: execute-statement* ( statement type -- ) ; M: object execute-statement* ( statement type -- ) '[ @@ -135,9 +135,9 @@ M: object execute-statement* ( statement type -- ) ! Transactions SYMBOL: in-transaction -HOOK: begin-transaction db-connection ( -- ) -HOOK: commit-transaction db-connection ( -- ) -HOOK: rollback-transaction db-connection ( -- ) +HOOK: begin-transaction db-connection ( -- ) ; +HOOK: commit-transaction db-connection ( -- ) ; +HOOK: rollback-transaction db-connection ( -- ) ; M: db-connection begin-transaction ( -- ) "BEGIN" sql-command ; M: db-connection commit-transaction ( -- ) "COMMIT" sql-command ; diff --git a/frameworks/db/postgresql/postgresql.factor b/frameworks/db/postgresql/postgresql.factor index 12bbd56dcf..308a4b0bf4 100644 --- a/frameworks/db/postgresql/postgresql.factor +++ b/frameworks/db/postgresql/postgresql.factor @@ -40,7 +40,7 @@ M: postgresql-db-connection db-close ( handle -- ) PQfinish ; M: postgresql-statement bind-statement* ( statement -- ) drop ; -GENERIC: postgresql-bind-conversion ( tuple object -- low-level-binding ) +GENERIC: postgresql-bind-conversion ( tuple object -- low-level-binding ) ; M: sql-spec postgresql-bind-conversion ( tuple spec -- object ) slot-name>> swap get-slot-named ; diff --git a/frameworks/db/queries/queries.factor b/frameworks/db/queries/queries.factor index 3fcc32996f..d854f3d1b2 100644 --- a/frameworks/db/queries/queries.factor +++ b/frameworks/db/queries/queries.factor @@ -7,7 +7,7 @@ math.bitwise math.intervals math.parser namespaces nmake prettyprint random sequences shuffle strings words fry ; IN: db.queries -GENERIC: where ( specs obj -- ) +GENERIC: where ( specs obj -- ) ; SINGLETON: retryable : make-retryable ( obj -- obj' ) diff --git a/frameworks/db/sqlite/sqlite.factor b/frameworks/db/sqlite/sqlite.factor index 4542d800ee..7599e9fde8 100644 --- a/frameworks/db/sqlite/sqlite.factor +++ b/frameworks/db/sqlite/sqlite.factor @@ -64,7 +64,7 @@ M: sqlite-statement bind-statement* ( statement -- ) dup bound?>> [ dup reset-bindings ] when low-level-bind ; -GENERIC: sqlite-bind-conversion ( tuple obj -- array ) +GENERIC: sqlite-bind-conversion ( tuple obj -- array ) ; TUPLE: sqlite-low-level-binding < low-level-binding key type ; : ( key value type -- obj ) diff --git a/frameworks/db/tuples/tuples.factor b/frameworks/db/tuples/tuples.factor index 0bdb2978ee..b21b3cd8a1 100644 --- a/frameworks/db/tuples/tuples.factor +++ b/frameworks/db/tuples/tuples.factor @@ -7,17 +7,17 @@ destructors mirrors sets db.types db.private fry combinators.short-circuit db.errors ; IN: db.tuples -HOOK: create-sql-statement db-connection ( class -- object ) -HOOK: drop-sql-statement db-connection ( class -- object ) +HOOK: create-sql-statement db-connection ( class -- object ) ; +HOOK: drop-sql-statement db-connection ( class -- object ) ; -HOOK: db-connection ( class -- object ) -HOOK: db-connection ( class -- object ) -HOOK: db-connection ( class -- object ) -HOOK: db-connection ( tuple class -- object ) -HOOK: db-connection ( tuple class -- statement ) -HOOK: db-connection ( query -- statement ) -HOOK: query>statement db-connection ( query -- statement ) -HOOK: insert-tuple-set-key db-connection ( tuple statement -- ) +HOOK: db-connection ( class -- object ) ; +HOOK: db-connection ( class -- object ) ; +HOOK: db-connection ( class -- object ) ; +HOOK: db-connection ( tuple class -- object ) ; +HOOK: db-connection ( tuple class -- statement ) ; +HOOK: db-connection ( query -- statement ) ; +HOOK: query>statement db-connection ( query -- statement ) ; +HOOK: insert-tuple-set-key db-connection ( tuple statement -- ) ; string ; -GENERIC: eval-generator ( singleton -- object ) +GENERIC: eval-generator ( singleton -- object ) ; : resulting-tuple ( exemplar-tuple row out-params -- tuple ) rot class-of new [ @@ -93,7 +93,7 @@ TUPLE: query tuple group order offset limit ; : ( -- query ) \ query new ; -GENERIC: >query ( object -- query ) +GENERIC: >query ( object -- query ) ; M: query >query clone ; diff --git a/frameworks/db/types/types.factor b/frameworks/db/types/types.factor index 5fb86e5ea9..42b8126a0b 100644 --- a/frameworks/db/types/types.factor +++ b/frameworks/db/types/types.factor @@ -7,8 +7,8 @@ classes.tuple combinators calendar.format classes.singleton accessors quotations random db.private ; IN: db.types -HOOK: persistent-table db-connection ( -- hash ) -HOOK: compound db-connection ( string obj -- hash ) +HOOK: persistent-table db-connection ( -- hash ) ; +HOOK: compound db-connection ( string obj -- hash ) ; TUPLE: sql-spec class slot-name column-name type primary-key modifiers ; @@ -143,8 +143,8 @@ ERROR: no-sql-type type ; modifiers>> [ lookup-modifier ] map " " join [ "" ] [ " " prepend ] if-empty ; -HOOK: bind% db-connection ( spec -- ) -HOOK: bind# db-connection ( spec obj -- ) +HOOK: bind% db-connection ( spec -- ) ; +HOOK: bind# db-connection ( spec obj -- ) ; ERROR: no-column column ; diff --git a/frameworks/furnace/auth/auth.factor b/frameworks/furnace/auth/auth.factor index 173984db32..945f67e346 100644 --- a/frameworks/furnace/auth/auth.factor +++ b/frameworks/furnace/auth/auth.factor @@ -24,7 +24,7 @@ SYMBOL: logged-in-user : username ( -- string/f ) logged-in-user get dup [ username>> ] when ; -GENERIC: init-user-profile ( responder -- ) +GENERIC: init-user-profile ( responder -- ) ; M: object init-user-profile drop ; @@ -58,15 +58,15 @@ V{ } clone capabilities set-global TUPLE: realm < dispatcher name users checksum secure ; -GENERIC: login-required* ( description capabilities realm -- response ) +GENERIC: login-required* ( description capabilities realm -- response ) ; -GENERIC: user-registered ( user realm -- response ) +GENERIC: user-registered ( user realm -- response ) ; M: object user-registered 2drop URL" $realm" ; -GENERIC: init-realm ( realm -- ) +GENERIC: init-realm ( realm -- ) ; -GENERIC: logged-in-username ( realm -- username ) +GENERIC: logged-in-username ( realm -- username ) ; : login-required ( description capabilities -- * ) realm get login-required* exit-with ; diff --git a/frameworks/furnace/auth/providers/providers.factor b/frameworks/furnace/auth/providers/providers.factor index 75363df2b6..eaf16b660a 100644 --- a/frameworks/furnace/auth/providers/providers.factor +++ b/frameworks/furnace/auth/providers/providers.factor @@ -14,11 +14,11 @@ email ticket capabilities profile deleted changed? ; swap >>username 0 >>deleted ; -GENERIC: get-user ( username provider -- user/f ) +GENERIC: get-user ( username provider -- user/f ) ; -GENERIC: update-user ( user provider -- ) +GENERIC: update-user ( user provider -- ) ; -GENERIC: new-user ( user provider -- user/f ) +GENERIC: new-user ( user provider -- user/f ) ; ! Password recovery support diff --git a/frameworks/furnace/sessions/sessions.factor b/frameworks/furnace/sessions/sessions.factor index 13deeff9a0..d13ac1cee8 100644 --- a/frameworks/furnace/sessions/sessions.factor +++ b/frameworks/furnace/sessions/sessions.factor @@ -22,7 +22,7 @@ session "SESSIONS" : get-session ( id -- session ) dup [ session get-state ] when ; -GENERIC: init-session* ( responder -- ) +GENERIC: init-session* ( responder -- ) ; M: object init-session* drop ; diff --git a/frameworks/furnace/syndication/syndication.factor b/frameworks/furnace/syndication/syndication.factor index b71abf6d86..bd5fc49d27 100644 --- a/frameworks/furnace/syndication/syndication.factor +++ b/frameworks/furnace/syndication/syndication.factor @@ -5,17 +5,17 @@ http.server.responses http.server.redirection furnace.actions furnace.utilities io.encodings.utf8 ; IN: furnace.syndication -GENERIC: feed-entry-title ( object -- string ) +GENERIC: feed-entry-title ( object -- string ) ; -GENERIC: feed-entry-date ( object -- timestamp ) +GENERIC: feed-entry-date ( object -- timestamp ) ; -GENERIC: feed-entry-url ( object -- url ) +GENERIC: feed-entry-url ( object -- url ) ; -GENERIC: feed-entry-description ( object -- description ) +GENERIC: feed-entry-description ( object -- description ) ; M: object feed-entry-description drop f ; -GENERIC: >entry ( object -- entry ) +GENERIC: >entry ( object -- entry ) ; M: entry >entry ; diff --git a/frameworks/furnace/utilities/utilities.factor b/frameworks/furnace/utilities/utilities.factor index 7bf2e35ef6..ec1fe34fb6 100644 --- a/frameworks/furnace/utilities/utilities.factor +++ b/frameworks/furnace/utilities/utilities.factor @@ -47,15 +47,15 @@ ERROR: no-such-responder responder ; : resolve-template-path ( pair -- path ) first2 [ resolve-word-path ] dip append-path ; -GENERIC: modify-query ( query responder -- query' ) +GENERIC: modify-query ( query responder -- query' ) ; M: object modify-query drop ; -GENERIC: modify-redirect-query ( query responder -- query' ) +GENERIC: modify-redirect-query ( query responder -- query' ) ; M: object modify-redirect-query drop ; -GENERIC: adjust-url ( url -- url' ) +GENERIC: adjust-url ( url -- url' ) ; M: url adjust-url clone @@ -65,7 +65,7 @@ M: url adjust-url M: string adjust-url ; -GENERIC: adjust-redirect-url ( url -- url' ) +GENERIC: adjust-redirect-url ( url -- url' ) ; M: url adjust-redirect-url adjust-url @@ -73,11 +73,11 @@ M: url adjust-redirect-url M: string adjust-redirect-url ; -GENERIC: link-attr ( tag responder -- ) +GENERIC: link-attr ( tag responder -- ) ; M: object link-attr 2drop ; -GENERIC: modify-form ( responder -- xml/f ) +GENERIC: modify-form ( responder -- xml/f ) ; M: object modify-form drop f ; diff --git a/frameworks/game/input/gtk/gtk.factor b/frameworks/game/input/gtk/gtk.factor index b6fde1c85d..5d1fa319b5 100644 --- a/frameworks/game/input/gtk/gtk.factor +++ b/frameworks/game/input/gtk/gtk.factor @@ -45,7 +45,7 @@ M: gtk-game-input-backend calibrate-controller M: gtk-game-input-backend vibrate-controller 3drop ; -HOOK: x>hid-bit-order os ( -- x ) +HOOK: x>hid-bit-order os ( -- x ) ; M: linux x>hid-bit-order { diff --git a/frameworks/game/input/input.factor b/frameworks/game/input/input.factor index e46587f5ba..55974279af 100644 --- a/frameworks/game/input/input.factor +++ b/frameworks/game/input/input.factor @@ -6,25 +6,25 @@ SYMBOLS: game-input-backend game-input-opened ; game-input-opened [ 0 ] initialize -HOOK: (open-game-input) game-input-backend ( -- ) -HOOK: (close-game-input) game-input-backend ( -- ) -HOOK: (reset-game-input) game-input-backend ( -- ) +HOOK: (open-game-input) game-input-backend ( -- ) ; +HOOK: (close-game-input) game-input-backend ( -- ) ; +HOOK: (reset-game-input) game-input-backend ( -- ) ; -HOOK: get-controllers game-input-backend ( -- sequence ) +HOOK: get-controllers game-input-backend ( -- sequence ) ; -HOOK: product-string game-input-backend ( controller -- string ) -HOOK: product-id game-input-backend ( controller -- id ) -HOOK: instance-id game-input-backend ( controller -- id ) +HOOK: product-string game-input-backend ( controller -- string ) ; +HOOK: product-id game-input-backend ( controller -- id ) ; +HOOK: instance-id game-input-backend ( controller -- id ) ; -HOOK: read-controller game-input-backend ( controller -- controller-state ) -HOOK: calibrate-controller game-input-backend ( controller -- ) -HOOK: vibrate-controller game-input-backend ( controller motor1 motor2 -- ) +HOOK: read-controller game-input-backend ( controller -- controller-state ) ; +HOOK: calibrate-controller game-input-backend ( controller -- ) ; +HOOK: vibrate-controller game-input-backend ( controller motor1 motor2 -- ) ; -HOOK: read-keyboard game-input-backend ( -- keyboard-state ) +HOOK: read-keyboard game-input-backend ( -- keyboard-state ) ; -HOOK: read-mouse game-input-backend ( -- mouse-state ) +HOOK: read-mouse game-input-backend ( -- mouse-state ) ; -HOOK: reset-mouse game-input-backend ( -- ) +HOOK: reset-mouse game-input-backend ( -- ) ; : game-input-opened? ( -- ? ) game-input-opened get zero? not ; diff --git a/frameworks/game/input/x11/x11.factor b/frameworks/game/input/x11/x11.factor index 44e3fda673..48f9f9ae0b 100644 --- a/frameworks/game/input/x11/x11.factor +++ b/frameworks/game/input/x11/x11.factor @@ -39,7 +39,7 @@ M: x11-game-input-backend calibrate-controller M: x11-game-input-backend vibrate-controller 3drop ; -HOOK: x>hid-bit-order os ( -- x ) +HOOK: x>hid-bit-order os ( -- x ) ; M: linux x>hid-bit-order { diff --git a/frameworks/game/loop/loop.factor b/frameworks/game/loop/loop.factor index 29e649f6f3..e82317a527 100755 --- a/frameworks/game/loop/loop.factor +++ b/frameworks/game/loop/loop.factor @@ -16,8 +16,8 @@ TUPLE: game-loop draw-timer benchmark-data ; -GENERIC: tick* ( delegate -- ) -GENERIC: draw* ( tick-slice delegate -- ) +GENERIC: tick* ( delegate -- ) ; +GENERIC: draw* ( tick-slice delegate -- ) ; DEFER: stop-loop @@ -38,7 +38,7 @@ TUPLE: game-loop-error-state error game-loop ; [ draw-timer>> iteration-start-nanos>> nano-count swap - ] [ tick-interval-nanos>> ] bi /f 1.0 min ; -GENERIC# record-benchmarking 1 ( loop quot -- ) +GENERIC# record-benchmarking 1 ( loop quot -- ) ; M: object record-benchmarking call( loop -- ) ; diff --git a/frameworks/game/models/collada/collada.factor b/frameworks/game/models/collada/collada.factor index 18773e79a4..fd01c4dc4a 100644 --- a/frameworks/game/models/collada/collada.factor +++ b/frameworks/game/models/collada/collada.factor @@ -40,7 +40,7 @@ SYMBOLS: up-axis unit-ratio ; SINGLETONS: x-up y-up z-up ; UNION: rh-up x-up y-up z-up ; -GENERIC: >y-up-axis! ( seq from-axis -- seq ) +GENERIC: >y-up-axis! ( seq from-axis -- seq ) ; M: x-up >y-up-axis! drop dup [ diff --git a/frameworks/game/models/loader/loader.factor b/frameworks/game/models/loader/loader.factor index b065bd843d..59aab24d2f 100644 --- a/frameworks/game/models/loader/loader.factor +++ b/frameworks/game/models/loader/loader.factor @@ -26,9 +26,9 @@ types [ H{ } clone ] initialize PRIVATE> -GENERIC# load-models* 2 ( obj encoding class -- models ) +GENERIC# load-models* 2 ( obj encoding class -- models ) ; -GENERIC: stream>models ( stream class -- models ) +GENERIC: stream>models ( stream class -- models ) ; : register-models-class ( extension encoding class -- ) 2array swap types get set-at ; diff --git a/frameworks/game/worlds/worlds.factor b/frameworks/game/worlds/worlds.factor index 46b3f2c5c2..7b2ace1730 100644 --- a/frameworks/game/worlds/worlds.factor +++ b/frameworks/game/worlds/worlds.factor @@ -14,13 +14,13 @@ TUPLE: game-world < world { audio-engine-voice-count initial: 16 } { tick-slice float initial: 0.0 } ; -GENERIC: begin-game-world ( world -- ) +GENERIC: begin-game-world ( world -- ) ; M: object begin-game-world drop ; -GENERIC: end-game-world ( world -- ) +GENERIC: end-game-world ( world -- ) ; M: object end-game-world drop ; -GENERIC: tick-game-world ( world -- ) +GENERIC: tick-game-world ( world -- ) ; M: object tick-game-world drop ; M: game-world tick* diff --git a/frameworks/gpu/framebuffers/framebuffers.factor b/frameworks/gpu/framebuffers/framebuffers.factor index 41f3f44413..255a674008 100644 --- a/frameworks/gpu/framebuffers/framebuffers.factor +++ b/frameworks/gpu/framebuffers/framebuffers.factor @@ -82,7 +82,7 @@ M: texture-attachment dispose texture>> dispose ; UNION: framebuffer-attachment renderbuffer texture-attachment ; -GENERIC: attachment-object ( attachment -- object ) +GENERIC: attachment-object ( attachment -- object ) ; M: renderbuffer attachment-object ; M: texture-attachment attachment-object texture>> texture-object ; @@ -136,19 +136,19 @@ TYPED: framebuffer-attachment-at ( framebuffer: framebuffer > ; -GENERIC# allocate-framebuffer-attachment 1 ( framebuffer-attachment dim -- ) +GENERIC# allocate-framebuffer-attachment 1 ( framebuffer-attachment dim -- ) ; M: texture-attachment allocate-framebuffer-attachment [ [ texture>> ] [ level>> ] bi ] dip f allocate-texture ; M: renderbuffer allocate-framebuffer-attachment allocate-renderbuffer ; -GENERIC: framebuffer-attachment-dim ( framebuffer-attachment -- dim ) +GENERIC: framebuffer-attachment-dim ( framebuffer-attachment -- dim ) ; M: texture-attachment framebuffer-attachment-dim [ texture>> ] [ level>> ] bi texture-dim @@ -170,7 +170,7 @@ M: renderbuffer framebuffer-attachment-dim framebuffer stencil-attachment>> [| attachment | GL_STENCIL_ATTACHMENT attachment quot call ] when* ; inline -GENERIC: bind-framebuffer-attachment ( attachment-target attachment -- ) +GENERIC: bind-framebuffer-attachment ( attachment-target attachment -- ) ; M:: renderbuffer bind-framebuffer-attachment ( attachment-target renderbuffer -- ) GL_DRAW_FRAMEBUFFER attachment-target @@ -201,9 +201,9 @@ M:: texture-layer-attachment bind-framebuffer-attachment ( attachment-target tex [ level>> ] [ layer>> ] tri glFramebufferTextureLayer ; -GENERIC: (default-gl-attachment) ( framebuffer -- gl-attachment ) -GENERIC: (default-attachment-type) ( framebuffer -- type ) -GENERIC: (default-attachment-image-type) ( framebuffer -- order type ) +GENERIC: (default-gl-attachment) ( framebuffer -- gl-attachment ) ; +GENERIC: (default-attachment-type) ( framebuffer -- type ) ; +GENERIC: (default-attachment-image-type) ( framebuffer -- order type ) ; M: system-framebuffer (default-gl-attachment) drop GL_BACK ; @@ -265,7 +265,7 @@ M: framebuffer (default-attachment-image-type) ( framebuffer -- order type ) : framebuffer-rect-image-type ( framebuffer-rect -- order type ) [ framebuffer>> ] [ attachment>> ] bi color-attachment-image-type ; -HOOK: (clear-integer-color-attachment) gpu-api ( type value -- ) +HOOK: (clear-integer-color-attachment) gpu-api ( type value -- ) ; M: opengl-2 (clear-integer-color-attachment) 4 0 pad-tail first4 diff --git a/frameworks/gpu/gpu.factor b/frameworks/gpu/gpu.factor index 1d02b3f07a..a266857234 100755 --- a/frameworks/gpu/gpu.factor +++ b/frameworks/gpu/gpu.factor @@ -17,7 +17,7 @@ SYMBOL: has-vertex-array-objects? has-gl-version-or-extensions? has-vertex-array-objects? set-global "3.0" has-gl-version? opengl-3 opengl-2 ? gpu-api set-global ; -HOOK: init-gpu-api gpu-api ( -- ) +HOOK: init-gpu-api gpu-api ( -- ) ; M: opengl-2 init-gpu-api GL_POINT_SPRITE glEnable ; diff --git a/frameworks/gpu/render/render.factor b/frameworks/gpu/render/render.factor index f157e322a8..bc99a86a4e 100755 --- a/frameworks/gpu/render/render.factor +++ b/frameworks/gpu/render/render.factor @@ -137,11 +137,11 @@ ERROR: invalid-uniform-type uniform ; { triangle-strip-with-adjacency-mode [ GL_TRIANGLE_STRIP_ADJACENCY ] } } case ; inline -GENERIC: render-vertex-indexes ( primitive-mode vertex-indexes -- ) +GENERIC: render-vertex-indexes ( primitive-mode vertex-indexes -- ) ; -GENERIC# render-vertex-indexes-instanced 1 ( primitive-mode vertex-indexes instances -- ) +GENERIC# render-vertex-indexes-instanced 1 ( primitive-mode vertex-indexes instances -- ) ; -GENERIC: gl-array-element-type ( array -- type ) +GENERIC: gl-array-element-type ( array -- type ) ; M: uchar-array gl-array-element-type drop GL_UNSIGNED_BYTE ; inline M: ushort-array gl-array-element-type drop GL_UNSIGNED_SHORT ; inline M: uint-array gl-array-element-type drop GL_UNSIGNED_INT ; inline @@ -189,8 +189,8 @@ M: multi-index-elements render-vertex-indexes : (bind-texture-unit) ( texture texture-unit -- ) swap [ GL_TEXTURE0 + glActiveTexture ] [ bind-texture drop ] bi* ; inline -GENERIC: (bind-uniform-textures) ( program-instance uniform-tuple -- ) -GENERIC: (bind-uniforms) ( program-instance uniform-tuple -- ) +GENERIC: (bind-uniform-textures) ( program-instance uniform-tuple -- ) ; +GENERIC: (bind-uniforms) ( program-instance uniform-tuple -- ) ; M: uniform-tuple (bind-uniform-textures) 2drop ; @@ -259,32 +259,32 @@ DEFER: uniform-texture-accessors UNION: binary-data c-ptr specialized-array struct simd-128 ; -GENERIC: >uniform-bool-array ( sequence -- c-array ) -GENERIC: >uniform-int-array ( sequence -- c-array ) -GENERIC: >uniform-uint-array ( sequence -- c-array ) -GENERIC: >uniform-float-array ( sequence -- c-array ) +GENERIC: >uniform-bool-array ( sequence -- c-array ) ; +GENERIC: >uniform-int-array ( sequence -- c-array ) ; +GENERIC: >uniform-uint-array ( sequence -- c-array ) ; +GENERIC: >uniform-float-array ( sequence -- c-array ) ; -GENERIC# >uniform-bvec-array 1 ( sequence dim -- c-array ) -GENERIC# >uniform-ivec-array 1 ( sequence dim -- c-array ) -GENERIC# >uniform-uvec-array 1 ( sequence dim -- c-array ) -GENERIC# >uniform-vec-array 1 ( sequence dim -- c-array ) +GENERIC# >uniform-bvec-array 1 ( sequence dim -- c-array ) ; +GENERIC# >uniform-ivec-array 1 ( sequence dim -- c-array ) ; +GENERIC# >uniform-uvec-array 1 ( sequence dim -- c-array ) ; +GENERIC# >uniform-vec-array 1 ( sequence dim -- c-array ) ; -GENERIC# >uniform-matrix 2 ( sequence cols rows -- c-array ) +GENERIC# >uniform-matrix 2 ( sequence cols rows -- c-array ) ; -GENERIC# >uniform-matrix-array 2 ( sequence cols rows -- c-array ) +GENERIC# >uniform-matrix-array 2 ( sequence cols rows -- c-array ) ; -GENERIC: bind-uniform-bvec2 ( index sequence -- ) -GENERIC: bind-uniform-bvec3 ( index sequence -- ) -GENERIC: bind-uniform-bvec4 ( index sequence -- ) -GENERIC: bind-uniform-ivec2 ( index sequence -- ) -GENERIC: bind-uniform-ivec3 ( index sequence -- ) -GENERIC: bind-uniform-ivec4 ( index sequence -- ) -GENERIC: bind-uniform-uvec2 ( index sequence -- ) -GENERIC: bind-uniform-uvec3 ( index sequence -- ) -GENERIC: bind-uniform-uvec4 ( index sequence -- ) -GENERIC: bind-uniform-vec2 ( index sequence -- ) -GENERIC: bind-uniform-vec3 ( index sequence -- ) -GENERIC: bind-uniform-vec4 ( index sequence -- ) +GENERIC: bind-uniform-bvec2 ( index sequence -- ) ; +GENERIC: bind-uniform-bvec3 ( index sequence -- ) ; +GENERIC: bind-uniform-bvec4 ( index sequence -- ) ; +GENERIC: bind-uniform-ivec2 ( index sequence -- ) ; +GENERIC: bind-uniform-ivec3 ( index sequence -- ) ; +GENERIC: bind-uniform-ivec4 ( index sequence -- ) ; +GENERIC: bind-uniform-uvec2 ( index sequence -- ) ; +GENERIC: bind-uniform-uvec3 ( index sequence -- ) ; +GENERIC: bind-uniform-uvec4 ( index sequence -- ) ; +GENERIC: bind-uniform-vec2 ( index sequence -- ) ; +GENERIC: bind-uniform-vec3 ( index sequence -- ) ; +GENERIC: bind-uniform-vec4 ( index sequence -- ) ; M: object >uniform-bool-array [ >c-bool ] int-array{ } map-as ; inline M: binary-data >uniform-bool-array ; inline @@ -555,7 +555,7 @@ SYNTAX: UNIFORM-TUPLE: dup first sequence? [ bind-named-output-attachments ] [ [ drop ] 2dip bind-unnamed-output-attachments ] if ; -GENERIC: bind-transform-feedback-output ( output -- ) +GENERIC: bind-transform-feedback-output ( output -- ) ; M: buffer bind-transform-feedback-output [ GL_TRANSFORM_FEEDBACK_BUFFER 0 ] dip handle>> glBindBufferBase ; inline diff --git a/frameworks/gpu/shaders/shaders.factor b/frameworks/gpu/shaders/shaders.factor index 559f46f560..99e66b63c3 100755 --- a/frameworks/gpu/shaders/shaders.factor +++ b/frameworks/gpu/shaders/shaders.factor @@ -66,7 +66,7 @@ TUPLE: program-instance < gpu-object { program program } { world world } ; -GENERIC: vertex-format-size ( format -- size ) +GENERIC: vertex-format-size ( format -- size ) ; MEMO: uniform-index ( program-instance uniform-name -- index ) [ handle>> ] dip glGetUniformLocation ; @@ -231,9 +231,9 @@ UNION: geometry-shader-parameter geometry-shader-vertices-out ; -GENERIC: bind-vertex-format ( program-instance buffer-ptr format -- ) +GENERIC: bind-vertex-format ( program-instance buffer-ptr format -- ) ; -GENERIC: link-feedback-format ( program-handle format -- ) +GENERIC: link-feedback-format ( program-handle format -- ) ; M: f link-feedback-format 2drop ; @@ -242,7 +242,7 @@ M: f link-feedback-format [ vertex-format-attributes [ name>> ] map sift ] map concat swap '[ [ _ ] 2dip swap glBindAttribLocation ] each-index ; -GENERIC: link-geometry-shader-parameter ( program-handle parameter -- ) +GENERIC: link-geometry-shader-parameter ( program-handle parameter -- ) ; M: geometry-shader-input link-geometry-shader-parameter [ GL_GEOMETRY_INPUT_TYPE ] dip gl-geometry-shader-input glProgramParameteriARB ; @@ -254,7 +254,7 @@ M: geometry-shader-vertices-out link-geometry-shader-parameter : link-geometry-shader-parameters ( program-handle parameters -- ) [ link-geometry-shader-parameter ] with each ; -GENERIC: (verify-feedback-format) ( program-instance format -- ) +GENERIC: (verify-feedback-format) ( program-instance format -- ) ; M: f (verify-feedback-format) 2drop ; @@ -418,7 +418,7 @@ M: vertex-array-object dispose PRIVATE> -GENERIC: bind-vertex-array ( vertex-array -- ) +GENERIC: bind-vertex-array ( vertex-array -- ) ; M: vertex-array-object bind-vertex-array handle>> glBindVertexArray ; inline @@ -440,7 +440,7 @@ M: vertex-array-collection bind-vertex-array : ( vertex-buffer program-instance -- vertex-array ) dup program>> vertex-formats>> first ; inline -GENERIC: vertex-array-buffers ( vertex-array -- buffers ) +GENERIC: vertex-array-buffers ( vertex-array -- buffers ) ; M: vertex-array-object vertex-array-buffers vertex-buffers>> ; inline diff --git a/frameworks/gpu/state/state.factor b/frameworks/gpu/state/state.factor index 7f53cac07e..f43a7fcf79 100755 --- a/frameworks/gpu/state/state.factor +++ b/frameworks/gpu/state/state.factor @@ -307,7 +307,7 @@ UNION: gpu-state PRIVATE> -GENERIC: set-gpu-state* ( state -- ) +GENERIC: set-gpu-state* ( state -- ) ; M: viewport-state set-gpu-state* rect>> [ loc>> ] [ dim>> ] bi gl-viewport ; diff --git a/frameworks/gpu/textures/textures.factor b/frameworks/gpu/textures/textures.factor index 9d3b66df0c..57ab66cdd3 100644 --- a/frameworks/gpu/textures/textures.factor +++ b/frameworks/gpu/textures/textures.factor @@ -79,7 +79,7 @@ TUPLE: texture-parameters > ; inline M: texture texture-object @@ -128,8 +128,8 @@ M: texture texture-object { { filter-nearest filter-linear } [ GL_NEAREST_MIPMAP_LINEAR ] } } case ; inline -GENERIC: texture-gl-target ( texture -- target ) -GENERIC: texture-data-gl-target ( texture -- target ) +GENERIC: texture-gl-target ( texture -- target ) ; +GENERIC: texture-data-gl-target ( texture -- target ) ; M: texture-1d texture-gl-target drop GL_TEXTURE_1D ; inline M: texture-2d texture-gl-target drop GL_TEXTURE_2D ; inline @@ -203,7 +203,7 @@ M: cube-map-face texture-data-gl-target PRIVATE> -GENERIC# allocate-texture 3 ( tdt level dim data -- ) +GENERIC# allocate-texture 3 ( tdt level dim data -- ) ; M: texture-1d-data-target allocate-texture ( tdt level dim data -- ) [ ] [ glTexImage1D ] (allocate-texture) ; @@ -214,7 +214,7 @@ M: texture-2d-data-target allocate-texture ( tdt level dim data -- ) M: texture-3d-data-target allocate-texture ( tdt level dim data -- ) [ first3 ] [ glTexImage3D ] (allocate-texture) ; -GENERIC# allocate-compressed-texture 3 ( tdt level dim compressed-data -- ) +GENERIC# allocate-compressed-texture 3 ( tdt level dim compressed-data -- ) ; M: texture-1d-data-target allocate-compressed-texture ( tdt level dim compressed-data -- ) [ ] [ glCompressedTexImage1D ] (allocate-compressed-texture) ; @@ -225,7 +225,7 @@ M: texture-2d-data-target allocate-compressed-texture ( tdt level dim compressed M: texture-3d-data-target allocate-compressed-texture ( tdt level dim compressed-data -- ) [ first3 ] [ glCompressedTexImage3D ] (allocate-compressed-texture) ; -GENERIC# update-texture 4 ( tdt level loc dim data -- ) +GENERIC# update-texture 4 ( tdt level loc dim data -- ) ; M: texture-1d-data-target update-texture ( tdt level loc dim data -- ) [ ] [ glTexSubImage1D ] (update-texture) ; @@ -236,7 +236,7 @@ M: texture-2d-data-target update-texture ( tdt level loc dim data -- ) M: texture-3d-data-target update-texture ( tdt level loc dim data -- ) [ first3 ] [ glTexSubImage3D ] (update-texture) ; -GENERIC# update-compressed-texture 4 ( tdt level loc dim compressed-data -- ) +GENERIC# update-compressed-texture 4 ( tdt level loc dim compressed-data -- ) ; M: texture-1d-data-target update-compressed-texture ( tdt level loc dim compressed-data -- ) [ ] [ glCompressedTexSubImage1D ] (update-compressed-texture) ; @@ -251,7 +251,7 @@ M: texture-3d-data-target update-compressed-texture ( tdt level loc dim compress { [ dim>> ] [ bitmap>> ] [ component-order>> ] [ component-type>> ] } cleave ; inline -GENERIC# texture-dim 1 ( tdt level -- dim ) +GENERIC# texture-dim 1 ( tdt level -- dim ) ; M:: texture-1d-data-target texture-dim ( tdt level -- dim ) tdt bind-tdt :> texture diff --git a/frameworks/gpu/util/wasd/wasd.factor b/frameworks/gpu/util/wasd/wasd.factor index 17404c32e2..3af0428392 100644 --- a/frameworks/gpu/util/wasd/wasd.factor +++ b/frameworks/gpu/util/wasd/wasd.factor @@ -18,22 +18,22 @@ CONSTANT: pi/2 $[ pi 2.0 / ] TUPLE: wasd-world < game-world location yaw pitch p-matrix ; -GENERIC: wasd-near-plane ( world -- near-plane ) +GENERIC: wasd-near-plane ( world -- near-plane ) ; M: wasd-world wasd-near-plane drop 0.25 ; -GENERIC: wasd-far-plane ( world -- far-plane ) +GENERIC: wasd-far-plane ( world -- far-plane ) ; M: wasd-world wasd-far-plane drop 1024.0 ; -GENERIC: wasd-movement-speed ( world -- speed ) +GENERIC: wasd-movement-speed ( world -- speed ) ; M: wasd-world wasd-movement-speed drop 1/16. ; -GENERIC: wasd-mouse-scale ( world -- scale ) +GENERIC: wasd-mouse-scale ( world -- scale ) ; M: wasd-world wasd-mouse-scale drop 1/600. ; -GENERIC: wasd-pitch-range ( world -- min max ) +GENERIC: wasd-pitch-range ( world -- min max ) ; M: wasd-world wasd-pitch-range drop -pi/2 pi/2 ; -GENERIC: wasd-fly-vertically? ( world -- ? ) +GENERIC: wasd-fly-vertically? ( world -- ? ) ; M: wasd-world wasd-fly-vertically? drop t ; : wasd-mv-matrix ( world -- matrix ) diff --git a/frameworks/ui/backend/backend.factor b/frameworks/ui/backend/backend.factor index b7ae44a412..708916c800 100644 --- a/frameworks/ui/backend/backend.factor +++ b/frameworks/ui/backend/backend.factor @@ -5,29 +5,29 @@ IN: ui.backend SYMBOL: ui-backend -HOOK: set-title ui-backend ( string world -- ) +HOOK: set-title ui-backend ( string world -- ) ; -HOOK: (set-fullscreen) ui-backend ( world ? -- ) +HOOK: (set-fullscreen) ui-backend ( world ? -- ) ; -HOOK: (fullscreen?) ui-backend ( world -- ? ) +HOOK: (fullscreen?) ui-backend ( world -- ? ) ; -HOOK: (open-window) ui-backend ( world -- ) +HOOK: (open-window) ui-backend ( world -- ) ; -HOOK: (close-window) ui-backend ( handle -- ) +HOOK: (close-window) ui-backend ( handle -- ) ; -HOOK: raise-window* ui-backend ( world -- ) +HOOK: raise-window* ui-backend ( world -- ) ; -GENERIC: select-gl-context ( handle -- ) +GENERIC: select-gl-context ( handle -- ) ; -GENERIC: flush-gl-context ( handle -- ) +GENERIC: flush-gl-context ( handle -- ) ; -HOOK: (with-ui) ui-backend ( quot -- ) +HOOK: (with-ui) ui-backend ( quot -- ) ; -HOOK: (grab-input) ui-backend ( handle -- ) +HOOK: (grab-input) ui-backend ( handle -- ) ; -HOOK: (ungrab-input) ui-backend ( handle -- ) +HOOK: (ungrab-input) ui-backend ( handle -- ) ; -HOOK: ui-backend-available? ui-backend ( -- ? ) +HOOK: ui-backend-available? ui-backend ( -- ? ) ; M: object ui-backend-available? f ; diff --git a/frameworks/ui/backend/gtk/input-methods/input-methods.factor b/frameworks/ui/backend/gtk/input-methods/input-methods.factor index 1ad6cd3693..32e1df960e 100644 --- a/frameworks/ui/backend/gtk/input-methods/input-methods.factor +++ b/frameworks/ui/backend/gtk/input-methods/input-methods.factor @@ -3,9 +3,9 @@ USING: kernel ui.gadgets ; IN: ui.backend.gtk.input-methods -GENERIC: support-input-methods? ( gadget -- ? ) -GENERIC: cursor-surrounding ( gadget -- text cursor-pos ) -GENERIC: delete-cursor-surrounding ( offset count gadget -- ) -GENERIC: cursor-loc&dim ( gadget -- loc dim ) +GENERIC: support-input-methods? ( gadget -- ? ) ; +GENERIC: cursor-surrounding ( gadget -- text cursor-pos ) ; +GENERIC: delete-cursor-surrounding ( offset count gadget -- ) ; +GENERIC: cursor-loc&dim ( gadget -- loc dim ) ; M: gadget support-input-methods? drop f ; diff --git a/frameworks/ui/backend/gtk/io/io.factor b/frameworks/ui/backend/gtk/io/io.factor index 04a69690da..5b81c80649 100644 --- a/frameworks/ui/backend/gtk/io/io.factor +++ b/frameworks/ui/backend/gtk/io/io.factor @@ -3,6 +3,6 @@ USING: io.backend kernel ; IN: ui.backend.gtk.io -HOOK: with-event-loop io-backend ( quot -- ) +HOOK: with-event-loop io-backend ( quot -- ) ; M: object with-event-loop call( -- ) ; diff --git a/frameworks/ui/baseline-alignment/baseline-alignment.factor b/frameworks/ui/baseline-alignment/baseline-alignment.factor index 27330d798a..7c6d81fa31 100644 --- a/frameworks/ui/baseline-alignment/baseline-alignment.factor +++ b/frameworks/ui/baseline-alignment/baseline-alignment.factor @@ -8,9 +8,9 @@ SYMBOL: +baseline+ TUPLE: aligned-gadget < gadget baseline cap-height ; -GENERIC: baseline* ( gadget -- y ) +GENERIC: baseline* ( gadget -- y ) ; -GENERIC: baseline ( gadget -- y ) +GENERIC: baseline ( gadget -- y ) ; M: gadget baseline drop f ; @@ -21,9 +21,9 @@ M: aligned-gadget baseline [ drop ] [ dupd baseline<< ] if ] ?if ; -GENERIC: cap-height* ( gadget -- y ) +GENERIC: cap-height* ( gadget -- y ) ; -GENERIC: cap-height ( gadget -- y ) +GENERIC: cap-height ( gadget -- y ) ; M: gadget cap-height drop f ; diff --git a/frameworks/ui/clipboards/clipboards.factor b/frameworks/ui/clipboards/clipboards.factor index ec7bb59931..9075bb917c 100644 --- a/frameworks/ui/clipboards/clipboards.factor +++ b/frameworks/ui/clipboards/clipboards.factor @@ -9,9 +9,9 @@ IN: ui.clipboards TUPLE: clipboard contents ; -GENERIC: clipboard-contents ( clipboard -- string ) +GENERIC: clipboard-contents ( clipboard -- string ) ; -GENERIC: set-clipboard-contents ( string clipboard -- ) +GENERIC: set-clipboard-contents ( string clipboard -- ) ; M: clipboard clipboard-contents contents>> ; @@ -19,12 +19,12 @@ M: clipboard set-clipboard-contents contents<< ; : ( -- clipboard ) "" clipboard boa ; -GENERIC: paste-clipboard ( gadget clipboard -- ) +GENERIC: paste-clipboard ( gadget clipboard -- ) ; M: object paste-clipboard clipboard-contents dup [ swap user-input ] [ 2drop ] if ; -GENERIC: copy-clipboard ( string gadget clipboard -- ) +GENERIC: copy-clipboard ( string gadget clipboard -- ) ; M: object copy-clipboard nip set-clipboard-contents ; diff --git a/frameworks/ui/commands/commands.factor b/frameworks/ui/commands/commands.factor index 3497f677c0..b721443fa0 100644 --- a/frameworks/ui/commands/commands.factor +++ b/frameworks/ui/commands/commands.factor @@ -10,15 +10,15 @@ SYMBOL: +description+ PREDICATE: listener-command < word +listener+ word-prop ; -GENERIC: invoke-command ( target command -- ) +GENERIC: invoke-command ( target command -- ) ; -GENERIC: command-name ( command -- str ) +GENERIC: command-name ( command -- str ) ; TUPLE: command-map blurb commands ; -GENERIC: command-description ( command -- str/f ) +GENERIC: command-description ( command -- str/f ) ; -GENERIC: command-word ( command -- word ) +GENERIC: command-word ( command -- word ) ; : ( blurb commands -- command-map ) { } like command-map boa ; diff --git a/frameworks/ui/event-loop/event-loop.factor b/frameworks/ui/event-loop/event-loop.factor index 6e2a19a170..9431c26242 100644 --- a/frameworks/ui/event-loop/event-loop.factor +++ b/frameworks/ui/event-loop/event-loop.factor @@ -11,7 +11,7 @@ IN: ui.event-loop [ f ] } cond ; -HOOK: do-events ui-backend ( -- ) +HOOK: do-events ui-backend ( -- ) ; : event-loop ( -- ) [ event-loop? ] [ do-events ] while ; diff --git a/frameworks/ui/gadgets/gadgets.factor b/frameworks/ui/gadgets/gadgets.factor index 74a0f06cf9..a9e06fed5d 100644 --- a/frameworks/ui/gadgets/gadgets.factor +++ b/frameworks/ui/gadgets/gadgets.factor @@ -51,11 +51,11 @@ M: gadget model-changed 2drop ; [ [ parent>> ] dip relative-loc ] [ drop loc>> ] 2bi v+ ] if ; -GENERIC: user-input* ( str gadget -- ? ) +GENERIC: user-input* ( str gadget -- ? ) ; M: gadget user-input* 2drop t ; -GENERIC: children-on ( rect gadget -- seq ) +GENERIC: children-on ( rect gadget -- seq ) ; M: gadget children-on nip children>> ; @@ -96,18 +96,18 @@ M: gadget contains-point? ( loc gadget -- ? ) [ children>> ] dip each ; inline ! Selection protocol -GENERIC: gadget-selection? ( gadget -- ? ) +GENERIC: gadget-selection? ( gadget -- ? ) ; M: gadget gadget-selection? drop f ; -GENERIC: gadget-selection ( gadget -- string/f ) +GENERIC: gadget-selection ( gadget -- string/f ) ; M: gadget gadget-selection drop f ; ! Text protocol -GENERIC: gadget-text* ( gadget -- ) +GENERIC: gadget-text* ( gadget -- ) ; -GENERIC: gadget-text-separator ( gadget -- str ) +GENERIC: gadget-text-separator ( gadget -- str ) ; M: gadget gadget-text-separator orientation>> vertical = "\n" "" ? ; @@ -171,7 +171,7 @@ PRIVATE> SYMBOL: in-layout? -GENERIC: dim-changed ( gadget -- ) +GENERIC: dim-changed ( gadget -- ) ; M: gadget dim-changed in-layout? get [ invalidate ] [ invalidate* ] if ; @@ -183,7 +183,7 @@ M: gadget dim<< ( dim gadget -- ) [ 2drop ] [ [ nip ] [ call-next-method ] 2bi dim-changed ] if ; -GENERIC: pref-dim* ( gadget -- dim ) +GENERIC: pref-dim* ( gadget -- dim ) ; : pref-dim ( gadget -- dim ) dup pref-dim>> [ ] [ @@ -195,7 +195,7 @@ GENERIC: pref-dim* ( gadget -- dim ) M: gadget pref-dim* dim>> ; -GENERIC: layout* ( gadget -- ) +GENERIC: layout* ( gadget -- ) ; M: gadget layout* drop ; @@ -208,11 +208,11 @@ M: gadget layout* drop ; dup [ layout ] each-child ] when drop ; -GENERIC: graft* ( gadget -- ) +GENERIC: graft* ( gadget -- ) ; M: gadget graft* drop ; -GENERIC: ungraft* ( gadget -- ) +GENERIC: ungraft* ( gadget -- ) ; M: gadget ungraft* drop ; @@ -298,7 +298,7 @@ PRIVATE> in-layout? get [ "Cannot add/remove gadgets in layout*" throw ] when ; -GENERIC: remove-gadget ( gadget parent -- ) +GENERIC: remove-gadget ( gadget parent -- ) ; M: gadget remove-gadget 2drop ; @@ -377,7 +377,7 @@ PRIVATE> [ parent>> child? ] } cond ; -GENERIC: focusable-child* ( gadget -- child/t ) +GENERIC: focusable-child* ( gadget -- child/t ) ; M: gadget focusable-child* drop t ; @@ -385,7 +385,7 @@ M: gadget focusable-child* drop t ; dup focusable-child* dup t eq? [ drop ] [ nip focusable-child ] if ; -GENERIC: request-focus-on ( child gadget -- ) +GENERIC: request-focus-on ( child gadget -- ) ; M: gadget request-focus-on parent>> request-focus-on ; diff --git a/frameworks/ui/gadgets/glass/glass.factor b/frameworks/ui/gadgets/glass/glass.factor index ba47f55e38..4e6b69b866 100644 --- a/frameworks/ui/gadgets/glass/glass.factor +++ b/frameworks/ui/gadgets/glass/glass.factor @@ -6,7 +6,7 @@ ui.gadgets.worlds ui.gadgets.wrappers ui.gestures vectors ; FROM: ui.gadgets.wrappers => wrapper ; IN: ui.gadgets.glass -GENERIC: hide-glass-hook ( gadget -- ) +GENERIC: hide-glass-hook ( gadget -- ) ; M: gadget hide-glass-hook drop ; diff --git a/frameworks/ui/gadgets/labels/labels.factor b/frameworks/ui/gadgets/labels/labels.factor index 7ef8d62039..81ceeea927 100644 --- a/frameworks/ui/gadgets/labels/labels.factor +++ b/frameworks/ui/gadgets/labels/labels.factor @@ -91,7 +91,7 @@ M: label-control model-changed "" label-control new-label swap >>model ; -GENERIC: >label ( obj -- gadget ) +GENERIC: >label ( obj -- gadget ) ; M: string >label