From e477f6996f57abc0d0f984d5b689ac731e408a82 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 8 Sep 2015 16:15:10 -0700 Subject: [PATCH] Fix comments to be ! not #!. --- basis/bootstrap/image/image.factor | 12 +- basis/cairo/cairo.factor | 8 +- basis/calendar/calendar.factor | 20 +- basis/calendar/format/format.factor | 8 +- basis/channels/examples/examples.factor | 8 +- basis/checksums/interleave/interleave.factor | 4 +- basis/checksums/md5/md5.factor | 10 +- basis/circular/circular.factor | 2 +- basis/cocoa/application/application.factor | 2 +- .../cfg/alias-analysis/alias-analysis.factor | 34 +- basis/compiler/compiler.factor | 36 +- basis/compiler/tree/cleanup/cleanup.factor | 20 +- .../tree/dead-code/branches/branches.factor | 4 +- .../tree/dead-code/recursive/recursive.factor | 8 +- .../tree/dead-code/simple/simple.factor | 8 +- .../recursive/recursive.factor | 2 +- .../introductions/introductions.factor | 6 +- .../tree/propagation/info/info.factor | 6 +- .../tree/propagation/simple/simple.factor | 12 +- .../tree/propagation/slots/slots.factor | 14 +- .../propagation/transforms/transforms.factor | 2 +- .../tree/tuple-unboxing/tuple-unboxing.factor | 2 +- .../concurrency/conditions/conditions.factor | 4 +- basis/concurrency/locks/locks.factor | 10 +- basis/cpu/x86/32/32.factor | 10 +- basis/cpu/x86/assembler/assembler.factor | 18 +- .../x86/assembler/operands/operands.factor | 6 +- basis/cpu/x86/x86.factor | 16 +- basis/db/queries/queries.factor | 2 +- basis/db/sqlite/lib/lib.factor | 2 +- basis/furnace/chloe-tags/chloe-tags.factor | 2 +- basis/furnace/utilities/utilities.factor | 2 +- basis/help/markup/markup.factor | 2 +- basis/html/components/components.factor | 2 +- basis/http/http.factor | 2 +- basis/http/parsers/parsers.factor | 8 +- basis/http/server/cgi/cgi.factor | 2 +- basis/http/server/server.factor | 4 +- basis/inspector/inspector.factor | 2 +- basis/io/files/info/unix/unix.factor | 2 +- basis/io/files/info/windows/windows.factor | 2 +- basis/io/files/windows/windows.factor | 2 +- basis/io/launcher/windows/windows.factor | 4 +- basis/io/monitors/recursive/recursive.factor | 2 +- basis/io/sockets/secure/unix/unix.factor | 8 +- basis/io/streams/duplex/duplex.factor | 6 +- basis/json/writer/writer.factor | 2 +- basis/locals/prettyprint/prettyprint.factor | 4 +- basis/locals/rewrite/closures/closures.factor | 4 +- basis/locals/types/types.factor | 2 +- basis/logging/logging.factor | 2 +- basis/logging/server/server.factor | 2 +- basis/math/functions/functions.factor | 2 +- basis/math/intervals/intervals.factor | 12 +- .../matrices/elimination/elimination.factor | 2 +- basis/math/statistics/statistics.factor | 4 +- basis/math/vectors/simd/simd-tests.factor | 14 +- basis/opengl/opengl.factor | 8 +- basis/opengl/textures/textures.factor | 8 +- basis/peg/ebnf/ebnf-tests.factor | 16 +- basis/peg/ebnf/ebnf.factor | 86 ++--- basis/peg/parsers/parsers.factor | 20 +- basis/peg/peg-tests.factor | 6 +- basis/peg/peg.factor | 116 +++--- basis/prettyprint/sections/sections.factor | 6 +- basis/serialize/serialize.factor | 10 +- basis/smtp/server/server.factor | 2 +- basis/smtp/smtp.factor | 2 +- basis/sorting/slots/slots.factor | 2 +- basis/soundex/soundex.factor | 4 +- basis/stack-checker/stack-checker.factor | 2 +- basis/syndication/syndication-tests.factor | 4 +- basis/syndication/syndication.factor | 2 +- .../tools/continuations/continuations.factor | 4 +- basis/tools/deploy/backend/backend.factor | 2 +- basis/tools/deploy/shaker/shaker.factor | 8 +- basis/ui/backend/cocoa/cocoa.factor | 6 +- basis/ui/backend/cocoa/views/views.factor | 2 +- basis/ui/backend/windows/windows.factor | 8 +- basis/ui/gadgets/buttons/buttons.factor | 4 +- basis/ui/gadgets/gadgets.factor | 6 +- basis/ui/gadgets/panes/panes.factor | 2 +- basis/ui/gadgets/sliders/sliders.factor | 6 +- basis/ui/gadgets/worlds/worlds.factor | 4 +- basis/ui/text/pango/pango.factor | 12 +- basis/ui/tools/debugger/debugger.factor | 2 +- basis/ui/tools/error-list/error-list.factor | 2 +- basis/ui/tools/listener/listener.factor | 6 +- basis/ui/ui.factor | 20 +- basis/validators/validators.factor | 2 +- basis/vocabs/hierarchy/hierarchy.factor | 2 +- basis/vocabs/refresh/monitor/monitor.factor | 4 +- basis/windows/privileges/privileges.factor | 4 +- basis/windows/time/time.factor | 2 +- basis/windows/winsock/winsock.factor | 2 +- basis/xml/elements/elements.factor | 2 +- basis/xml/entities/entities.factor | 2 +- basis/xml/tokenize/tokenize.factor | 8 +- core/byte-vectors/byte-vectors.factor | 8 +- core/checksums/checksums.factor | 6 +- core/classes/classes.factor | 4 +- core/classes/mixin/mixin.factor | 20 +- core/classes/tuple/tuple.factor | 2 +- core/generic/single/single.factor | 18 +- core/generic/standard/standard-tests.factor | 4 +- core/generic/standard/standard.factor | 6 +- core/io/io.factor | 6 +- core/io/streams/c/c.factor | 8 +- core/kernel/kernel.factor | 6 +- core/math/math.factor | 2 +- core/math/order/order.factor | 2 +- core/parser/parser.factor | 4 +- core/sbufs/sbufs.factor | 8 +- core/sequences/sequences.factor | 4 +- core/source-files/source-files.factor | 2 +- core/syntax/syntax-docs.factor | 6 +- core/vectors/vectors.factor | 8 +- core/words/words.factor | 6 +- extra/audio/vorbis/vorbis.factor | 4 +- extra/benchmark/backtrack/backtrack.factor | 2 +- extra/benchmark/fannkuch/fannkuch.factor | 4 +- extra/benchmark/raytracer/raytracer.factor | 2 +- extra/coroutines/coroutines.factor | 6 +- extra/cpu/8080/emulator/emulator.factor | 346 +++++++++--------- extra/cpu/8080/test/test.factor | 4 +- extra/cpu/arm/assembler/assembler.factor | 2 +- extra/crypto/aes/aes-tests.factor | 2 +- extra/crypto/aes/aes.factor | 24 +- extra/crypto/barrett/barrett.factor | 4 +- extra/crypto/rsa/rsa.factor | 2 +- extra/fjsc/resources/bootstrap.factor | 6 +- extra/html/elements/elements.factor | 36 +- extra/images/tga/tga.factor | 24 +- extra/jamshred/gl/gl.factor | 2 +- extra/jamshred/jamshred.factor | 4 +- extra/jamshred/oint/oint.factor | 6 +- extra/jamshred/tunnel/tunnel.factor | 12 +- extra/koszul/koszul.factor | 8 +- extra/mason/common/common.factor | 8 +- extra/mason/git/git.factor | 6 +- extra/mason/updates/updates.factor | 8 +- extra/math/analysis/analysis.factor | 16 +- .../parser-combinators.factor | 146 ++++---- extra/poker/poker.factor | 4 +- extra/pop3/server/server.factor | 2 +- extra/project-euler/070/070.factor | 2 +- extra/project-euler/099/099.factor | 2 +- extra/reports/noise/noise.factor | 4 +- extra/sequences/modified/modified.factor | 2 +- extra/space-invaders/space-invaders.factor | 88 ++--- extra/tetris/board/board.factor | 4 +- extra/tetris/game/game.factor | 2 +- extra/tetris/gl/gl.factor | 2 +- extra/tetris/piece/piece.factor | 6 +- extra/trees/avl/avl.factor | 6 +- extra/trees/trees.factor | 8 +- extra/turing/turing.factor | 12 +- extra/ui/gadgets/lists/lists.factor | 4 +- extra/ui/render/test/test.factor | 2 +- .../adsoda/solution2/solution2.factor | 2 +- unmaintained/arm/allot/allot.factor | 14 +- .../arm/architecture/architecture.factor | 26 +- unmaintained/arm/intrinsics/intrinsics.factor | 2 +- unmaintained/cont-responder/callbacks.factor | 34 +- unmaintained/db/mysql/lib/lib.factor | 4 +- unmaintained/odbc/odbc.factor | 2 +- unmaintained/ogg/player/player.factor | 58 +-- unmaintained/sandbox/syntax/syntax.factor | 2 +- unmaintained/sniffer/io/filter/bsd/bsd.factor | 2 +- unmaintained/triggers/triggers.factor | 4 +- unmaintained/webapps/numbers/numbers.factor | 2 +- 171 files changed, 965 insertions(+), 965 deletions(-) diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index 7edc3c00ea..e407d0399f 100755 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -112,7 +112,7 @@ SYMBOL: special-objects [ length test-quot call ] [ % ] bi ; inline : make-jit ( quot -- parameters literals code ) - #! code is a { relocation insns } pair + ! code is a { relocation insns } pair [ 0 extra-offset set init-relocation @@ -212,7 +212,7 @@ GENERIC: prepare-object ( obj -- ptr ) : bignum-radix ( -- n ) bignum-bits 2^ 1 - ; : bignum>sequence ( n -- seq ) - #! n is positive or zero. + ! n is positive or zero. [ dup 0 > ] [ [ bignum-bits neg shift ] [ bignum-radix bitand ] bi ] produce nip ; @@ -232,8 +232,8 @@ M: bignum prepare-object ! Fixnums M: fixnum prepare-object - #! When generating a 32-bit image on a 64-bit system, - #! some fixnums should be bignums. + ! When generating a 32-bit image on a 64-bit system, + ! some fixnums should be bignums. dup bootstrap-most-negative-fixnum bootstrap-most-positive-fixnum between? @@ -346,8 +346,8 @@ M: wrapper prepare-object ] emit-object ; M: string prepare-object - #! We pool strings so that each string is only written once - #! to the image + ! We pool strings so that each string is only written once + ! to the image [ emit-string ] cache-eql-object ; : assert-empty ( seq -- ) diff --git a/basis/cairo/cairo.factor b/basis/cairo/cairo.factor index d3edd9022a..f55023d69e 100644 --- a/basis/cairo/cairo.factor +++ b/basis/cairo/cairo.factor @@ -35,10 +35,10 @@ ERROR: cairo-error n message ; ubyte-components >>component-type ; inline : dummy-cairo ( -- cr ) - #! Sometimes we want a dummy context; eg with Pango, we want - #! to measure text dimensions to create a new image context with, - #! but we need an existing context to measure text dimensions - #! with so we use the dummy. + ! Sometimes we want a dummy context; eg with Pango, we want + ! to measure text dimensions to create a new image context with, + ! but we need an existing context to measure text dimensions + ! with so we use the dummy. \ dummy-cairo [ CAIRO_FORMAT_ARGB32 0 0 cairo_image_surface_create cairo_create diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index cee2358f67..d8586fe6b7 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -123,8 +123,8 @@ CONSTANT: minutes-per-year 5259492/10 CONSTANT: seconds-per-year 31556952 :: julian-day-number ( year month day -- n ) - #! Returns a composite date number - #! Not valid before year -4800 + ! Returns a composite date number + ! Not valid before year -4800 14 month - 12 /i :> a year 4800 + a - :> y month 12 a * + 3 - :> m @@ -133,7 +133,7 @@ CONSTANT: seconds-per-year 31556952 y 4 /i + y 100 /i - y 400 /i + 32045 - ; :: julian-day-number>date ( n -- year month day ) - #! Inverse of julian-day-number + ! Inverse of julian-day-number n 32044 + :> a 4 a * 3 + 146097 /i :> b a 146097 b * 4 /i - :> c @@ -204,7 +204,7 @@ GENERIC: +minute ( timestamp x -- timestamp ) GENERIC: +second ( timestamp x -- timestamp ) : /rem ( f n -- q r ) - #! q is positive or negative, r is positive from 0 <= r < n + ! q is positive or negative, r is positive from 0 <= r < n [ / floor >integer ] 2keep rem ; : float>whole-part ( float -- int float ) @@ -295,8 +295,8 @@ M: duration time+ ] if ; : duration>years ( duration -- x ) - #! Uses average month/year length since duration loses calendar - #! data + ! Uses average month/year length since duration loses calendar + ! data 0 swap { [ year>> + ] @@ -351,7 +351,7 @@ M: timestamp <=> ( ts1 ts2 -- n ) [ >time< [ [ 3600 * ] [ 60 * ] bi* ] dip + + ] bi@ - + ; M: timestamp time- - #! Exact calendar-time difference + ! Exact calendar-time difference (time-) seconds ; : time* ( obj1 obj2 -- obj3 ) @@ -420,9 +420,9 @@ M: duration time- : ago ( duration -- timestamp ) now swap time- ; : zeller-congruence ( year month day -- n ) - #! Zeller Congruence - #! http://web.textfiles.com/computers/formulas.txt - #! good for any date since October 15, 1582 + ! Zeller Congruence + ! http://web.textfiles.com/computers/formulas.txt + ! good for any date since October 15, 1582 [ dup 2 <= [ [ 1 - ] [ 12 + ] bi* ] when [ dup [ 4 /i + ] [ 100 /i - ] [ 400 /i + ] tri ] dip diff --git a/basis/calendar/format/format.factor b/basis/calendar/format/format.factor index a7f2c589a0..35c7f032ce 100644 --- a/basis/calendar/format/format.factor +++ b/basis/calendar/format/format.factor @@ -111,8 +111,8 @@ M: timestamp year. ( timestamp -- ) } case ; : timestamp>rfc822 ( timestamp -- str ) - #! RFC822 timestamp format - #! Example: Tue, 15 Nov 1994 08:12:31 +0200 + ! RFC822 timestamp format + ! Example: Tue, 15 Nov 1994 08:12:31 +0200 [ [ (timestamp>string) bl ] [ gmt-offset>> write-gmt-offset ] @@ -126,8 +126,8 @@ M: timestamp year. ( timestamp -- ) ] with-string-writer ; : timestamp>http-string ( timestamp -- str ) - #! http timestamp format - #! Example: Tue, 15 Nov 1994 08:12:31 GMT + ! http timestamp format + ! Example: Tue, 15 Nov 1994 08:12:31 GMT >gmt timestamp>rfc822 ; : (timestamp>cookie-string) ( timestamp -- ) diff --git a/basis/channels/examples/examples.factor b/basis/channels/examples/examples.factor index 8aec6f5935..b841a10695 100644 --- a/basis/channels/examples/examples.factor +++ b/basis/channels/examples/examples.factor @@ -17,9 +17,9 @@ IN: channels.examples [ from ] keep [ from ] keep from ; : filter ( send prime recv -- ) - #! Receives numbers from the 'send' channel, - #! filters out all those divisible by 'prime', - #! and sends to the 'recv' channel. + ! Receives numbers from the 'send' channel, + ! filters out all those divisible by 'prime', + ! and sends to the 'recv' channel. [ from swap dupd mod zero? not [ swap to ] [ 2drop ] if ] 3keep filter ; @@ -32,7 +32,7 @@ IN: channels.examples prime newc (sieve) ; : sieve ( prime -- ) - #! Send prime numbers to 'prime' channel + ! Send prime numbers to 'prime' channel dup [ counter ] curry "Counter" spawn drop (sieve) ; diff --git a/basis/checksums/interleave/interleave.factor b/basis/checksums/interleave/interleave.factor index caef033ec6..5feff8fd35 100644 --- a/basis/checksums/interleave/interleave.factor +++ b/basis/checksums/interleave/interleave.factor @@ -4,11 +4,11 @@ USING: assocs checksums grouping kernel locals math sequences ; IN: checksums.interleave : seq>2seq ( seq -- seq1 seq2 ) - #! { abcdefgh } -> { aceg } { bdfh } + ! { abcdefgh } -> { aceg } { bdfh } 2 group flip [ { } { } ] [ first2 ] if-empty ; : 2seq>seq ( seq1 seq2 -- seq ) - #! { aceg } { bdfh } -> { abcdefgh } + ! { aceg } { bdfh } -> { abcdefgh } [ zip concat ] keep like ; :: interleaved-checksum ( bytes checksum -- seq ) diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor index 136102c78d..71d60f3367 100644 --- a/basis/checksums/md5/md5.factor +++ b/basis/checksums/md5/md5.factor @@ -34,19 +34,19 @@ CONSTANT: T $[ ] :: F ( X Y Z -- FXYZ ) - #! F(X,Y,Z) = XY v not(X) Z + ! F(X,Y,Z) = XY v not(X) Z X Y bitand X bitnot Z bitand bitor ; inline :: G ( X Y Z -- GXYZ ) - #! G(X,Y,Z) = XZ v Y not(Z) + ! G(X,Y,Z) = XZ v Y not(Z) X Z bitand Y Z bitnot bitand bitor ; inline : H ( X Y Z -- HXYZ ) - #! H(X,Y,Z) = X xor Y xor Z + ! H(X,Y,Z) = X xor Y xor Z bitxor bitxor ; inline :: I ( X Y Z -- IXYZ ) - #! I(X,Y,Z) = Y xor (X v not(Z)) + ! I(X,Y,Z) = Y xor (X v not(Z)) Z bitnot X bitor Y bitxor ; inline CONSTANT: S11 7 @@ -72,7 +72,7 @@ CONSTANT: c 2 CONSTANT: d 3 :: (ABCD) ( x state a b c d k s i quot -- ) - #! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s) + ! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s) a state [ b state nth-unsafe c state nth-unsafe diff --git a/basis/circular/circular.factor b/basis/circular/circular.factor index 9eba3c94ad..a634b326aa 100644 --- a/basis/circular/circular.factor +++ b/basis/circular/circular.factor @@ -24,7 +24,7 @@ M: circular virtual@ circular-wrap seq>> ; inline M: circular virtual-exemplar seq>> ; inline : change-circular-start ( n circular -- ) - #! change start to (start + n) mod length + ! change start to (start + n) mod length circular-wrap start<< ; inline : rotate-circular ( circular -- ) diff --git a/basis/cocoa/application/application.factor b/basis/cocoa/application/application.factor index 9bd24385f5..86cd177916 100644 --- a/basis/cocoa/application/application.factor +++ b/basis/cocoa/application/application.factor @@ -39,7 +39,7 @@ FUNCTION: void NSBeep ( ) -> alloc -> init -> setDelegate: ; : running.app? ( -- ? ) - #! Test if we're running a .app. + ! Test if we're running a .app. ".app" NSBundle -> mainBundle -> bundlePath CF>string subseq? ; diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor index 9243af28d2..fcc42fec22 100644 --- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor +++ b/basis/compiler/cfg/alias-analysis/alias-analysis.factor @@ -30,14 +30,14 @@ SYMBOL: heap-ac acs>vregs get [ drop V{ } clone ] cache ; : vreg>ac ( vreg -- ac ) - #! Only vregs produced by ##allot, ##peek and ##slot can - #! ever be used as valid inputs to ##slot and ##set-slot, - #! so we assert this fact by not giving alias classes to - #! other vregs. + ! Only vregs produced by ##allot, ##peek and ##slot can + ! ever be used as valid inputs to ##slot and ##set-slot, + ! so we assert this fact by not giving alias classes to + ! other vregs. vregs>acs get [ heap-ac get [ ac>vregs push ] keep ] cache ; : aliases ( vreg -- vregs ) - #! All vregs which may contain the same value as vreg. + ! All vregs which may contain the same value as vreg. vreg>ac ac>vregs ; : each-alias ( vreg quot -- ) @@ -66,14 +66,14 @@ SYMBOL: dead-stores ERROR: vreg-not-new vreg ; :: set-ac ( vreg ac -- ) - #! Set alias class of newly-seen vreg. + ! Set alias class of newly-seen vreg. vreg vregs>acs get key? [ vreg vreg-not-new ] when ac vreg vregs>acs get set-at vreg ac ac>vregs push ; : live-slot ( slot#/f vreg -- vreg' ) - #! If the slot number is unknown, we never reuse a previous - #! value. + ! If the slot number is unknown, we never reuse a previous + ! value. over [ live-slots get at at ] [ 2drop f ] if ; : load-constant-slot ( value slot# vreg -- ) @@ -83,12 +83,12 @@ ERROR: vreg-not-new vreg ; over [ load-constant-slot ] [ 3drop ] if ; : record-constant-slot ( slot# vreg -- ) - #! A load can potentially read every store of this slot# - #! in that alias class. + ! A load can potentially read every store of this slot# + ! in that alias class. [ recent-stores get at delete-at ] with each-alias ; : record-computed-slot ( vreg -- ) - #! Computed load is like a load of every slot touched so far + ! Computed load is like a load of every slot touched so far [ recent-stores get at clear-assoc ] each-alias ; :: remember-slot ( value slot# vreg -- ) @@ -171,8 +171,8 @@ M: vreg-insn analyze-aliases def-acs ; M: allocation-insn analyze-aliases - #! A freshly allocated object is distinct from any other - #! object. + ! A freshly allocated object is distinct from any other + ! object. dup dst>> set-new-ac ; M: ##box-displaced-alien analyze-aliases @@ -188,8 +188,8 @@ M: read-insn analyze-aliases if ; : idempotent? ( value slot#/f vreg -- ? ) - #! Are we storing a value back to the same slot it was read - #! from? + ! Are we storing a value back to the same slot it was read + ! from? live-slot = ; M:: write-insn analyze-aliases ( insn -- insn ) @@ -207,8 +207,8 @@ M:: write-insn analyze-aliases ( insn -- insn ) insn ; M: ##copy analyze-aliases - #! The output vreg gets the same alias class as the input - #! vreg, since they both contain the same value. + ! The output vreg gets the same alias class as the input + ! vreg, since they both contain the same value. dup record-copy ; : useless-compare? ( insn -- ? ) diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index fe2620d177..87dc2e210c 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -14,7 +14,7 @@ IN: compiler SYMBOL: compiled : compile? ( word -- ? ) - #! Don't attempt to compile certain words. + ! Don't attempt to compile certain words. { [ "forgotten" word-prop ] [ inlined-block? ] @@ -46,17 +46,17 @@ M: predicate-engine-word combinator? "owner-generic" word-prop combinator? ; M: word combinator? inline? ; : ignore-error? ( word error -- ? ) - #! Ignore some errors on inline combinators, macros, and special - #! words such as 'call'. + ! Ignore some errors on inline combinators, macros, and special + ! words such as 'call'. { [ drop no-compile? ] [ [ combinator? ] [ unknown-macro-input? ] bi* and ] } 2|| ; : finish ( word -- ) - #! Recompile callers if the word's stack effect changed, then - #! save the word's dependencies so that if they change, the - #! word can get recompiled too. + ! Recompile callers if the word's stack effect changed, then + ! save the word's dependencies so that if they change, the + ! word can get recompiled too. [ compiled-unxref ] [ dup crossref? [ @@ -67,8 +67,8 @@ M: word combinator? inline? ; ] bi ; : deoptimize-with ( word def -- * ) - #! If the word failed to infer, compile it with the - #! non-optimizing compiler. + ! If the word failed to infer, compile it with the + ! non-optimizing compiler. swap [ finish ] [ compiled get set-at ] bi return ; : not-compiled-def ( word error -- def ) @@ -86,10 +86,10 @@ M: word combinator? inline? ; 2bi ; : deoptimize ( word error -- * ) - #! If the error is ignorable, compile the word with the - #! non-optimizing compiler, using its definition. Otherwise, - #! if the compiler error is not ignorable, use a dummy - #! definition from 'not-compiled-def' which throws an error. + ! If the error is ignorable, compile the word with the + ! non-optimizing compiler, using its definition. Otherwise, + ! if the compiler error is not ignorable, use a dummy + ! definition from 'not-compiled-def' which throws an error. { { [ dup inference-error? not ] [ rethrow ] } { [ 2dup ignore-error? ] [ ignore-error ] } @@ -106,8 +106,8 @@ M: word combinator? inline? ; dependencies get keys [ "break?" word-prop ] any? ; : frontend ( word -- tree ) - #! If the word contains breakpoints, don't optimize it, since - #! the walker does not support this. + ! If the word contains breakpoints, don't optimize it, since + ! the walker does not support this. dup optimize? [ [ [ build-tree ] [ deoptimize ] recover optimize-tree ] keep contains-breakpoints? [ nip deoptimize* ] [ drop ] if @@ -124,8 +124,8 @@ M: word combinator? inline? ; ] each ; : compile-word ( word -- ) - #! We return early if the word has breakpoints or if it - #! failed to infer. + ! We return early if the word has breakpoints or if it + ! failed to infer. '[ _ { [ start ] @@ -138,8 +138,8 @@ M: word combinator? inline? ; SINGLETON: optimizing-compiler M: optimizing-compiler update-call-sites ( class generic -- words ) - #! Words containing call sites with inferred type 'class' - #! which inlined a method on 'generic' + ! Words containing call sites with inferred type 'class' + ! which inlined a method on 'generic' generic-call-sites-of keys swap '[ _ 2dup [ valid-classoid? ] both? [ classes-intersect? ] [ 2drop f ] if diff --git a/basis/compiler/tree/cleanup/cleanup.factor b/basis/compiler/tree/cleanup/cleanup.factor index 3e7092a53a..2596d64180 100644 --- a/basis/compiler/tree/cleanup/cleanup.factor +++ b/basis/compiler/tree/cleanup/cleanup.factor @@ -24,8 +24,8 @@ M: node delete-node drop ; GENERIC: cleanup-tree* ( node -- node/nodes ) : cleanup-tree ( nodes -- nodes' ) - #! We don't recurse into children here, instead the methods - #! do it since the logic is a bit more involved + ! We don't recurse into children here, instead the methods + ! do it since the logic is a bit more involved [ cleanup-tree* ] map-flat ; ! Constant folding @@ -34,8 +34,8 @@ GENERIC: cleanup-tree* ( node -- node/nodes ) [ f ] [ [ literal?>> ] all? ] if-empty ; : (cleanup-folding) ( #call -- nodes ) - #! Replace a #call having a known result with a #drop of its - #! inputs followed by #push nodes for the outputs. + ! Replace a #call having a known result with a #drop of its + ! inputs followed by #push nodes for the outputs. [ [ node-output-infos ] [ out-d>> ] bi [ [ literal>> ] dip <#push> ] 2map @@ -114,8 +114,8 @@ M: #call cleanup-tree* ] change-children drop ; : fold-only-branch ( #branch -- node/nodes ) - #! If only one branch is live we don't need to branch at - #! all; just drop the condition value. + ! If only one branch is live we don't need to branch at + ! all; just drop the condition value. dup live-children sift dup length { { 0 [ drop in-d>> <#drop> ] } { 1 [ first swap in-d>> <#drop> prefix ] } @@ -152,7 +152,7 @@ M: #branch cleanup-tree* } case ; M: #phi cleanup-tree* - #! Remove #phi function inputs which no longer exist. + ! Remove #phi function inputs which no longer exist. live-branches get [ '[ _ sift-children ] change-phi-in-d ] [ '[ _ sift-children ] change-phi-info-d ] @@ -163,14 +163,14 @@ M: #phi cleanup-tree* : >copy ( node -- #copy ) [ in-d>> ] [ out-d>> ] bi <#copy> ; : flatten-recursive ( #recursive -- nodes ) - #! convert #enter-recursive and #return-recursive into - #! #copy nodes. + ! convert #enter-recursive and #return-recursive into + ! #copy nodes. child>> unclip >copy prefix unclip-last >copy suffix ; M: #recursive cleanup-tree* - #! Inline bodies of #recursive blocks with no calls left. + ! Inline bodies of #recursive blocks with no calls left. [ cleanup-tree ] change-child dup label>> calls>> empty? [ flatten-recursive ] when ; diff --git a/basis/compiler/tree/dead-code/branches/branches.factor b/basis/compiler/tree/dead-code/branches/branches.factor index 90d96f952e..fc03c85756 100644 --- a/basis/compiler/tree/dead-code/branches/branches.factor +++ b/basis/compiler/tree/dead-code/branches/branches.factor @@ -14,8 +14,8 @@ M: #dispatch mark-live-values* look-at-inputs ; [ index ] dip swap [ look-at-values ] [ drop ] if* ; M: #phi compute-live-values* - #! If any of the outputs of a #phi are live, then the - #! corresponding inputs are live too. + ! If any of the outputs of a #phi are live, then the + ! corresponding inputs are live too. [ out-d>> ] [ phi-in-d>> ] bi look-at-phi ; SYMBOL: if-node diff --git a/basis/compiler/tree/dead-code/recursive/recursive.factor b/basis/compiler/tree/dead-code/recursive/recursive.factor index c1ea770733..0e32cd3389 100644 --- a/basis/compiler/tree/dead-code/recursive/recursive.factor +++ b/basis/compiler/tree/dead-code/recursive/recursive.factor @@ -8,16 +8,16 @@ stack-checker.backend ; IN: compiler.tree.dead-code.recursive M: #enter-recursive compute-live-values* - #! If the output of an #enter-recursive is live, then the - #! corresponding inputs to the #call-recursive are live also. + ! If the output of an #enter-recursive is live, then the + ! corresponding inputs to the #call-recursive are live also. [ out-d>> ] [ recursive-phi-in ] bi look-at-phi ; M: #return-recursive compute-live-values* [ out-d>> ] [ in-d>> ] bi look-at-mapping ; M: #call-recursive compute-live-values* - #! If the output of a #call-recursive is live, then the - #! corresponding inputs to #return nodes are live also. + ! If the output of a #call-recursive is live, then the + ! corresponding inputs to #return nodes are live also. [ out-d>> ] [ label>> return>> in-d>> ] bi look-at-mapping ; :: drop-dead-inputs ( inputs outputs -- #shuffle ) diff --git a/basis/compiler/tree/dead-code/simple/simple.factor b/basis/compiler/tree/dead-code/simple/simple.factor index d0bbbc47db..55a2137b68 100644 --- a/basis/compiler/tree/dead-code/simple/simple.factor +++ b/basis/compiler/tree/dead-code/simple/simple.factor @@ -26,8 +26,8 @@ M: #return mark-live-values* look-at-inputs ; [ index ] dip over [ nth look-at-value ] [ 2drop ] if ; M: #copy compute-live-values* - #! If the output of a copy is live, then the corresponding - #! input is live also. + ! If the output of a copy is live, then the corresponding + ! input is live also. [ out-d>> ] [ in-d>> ] bi look-at-mapping ; M: #call compute-live-values* nip look-at-inputs ; @@ -41,8 +41,8 @@ M: #alien-node compute-live-values* nip look-at-inputs ; live-values get '[ drop _ key? ] assoc-filter ; : filter-corresponding ( new old -- old' ) - #! Remove elements from 'old' if the element with the same - #! index in 'new' is dead. + ! Remove elements from 'old' if the element with the same + ! index in 'new' is dead. zip filter-mapping values ; : filter-live ( values -- values' ) diff --git a/basis/compiler/tree/escape-analysis/recursive/recursive.factor b/basis/compiler/tree/escape-analysis/recursive/recursive.factor index 26e019e884..0fa30bb822 100644 --- a/basis/compiler/tree/escape-analysis/recursive/recursive.factor +++ b/basis/compiler/tree/escape-analysis/recursive/recursive.factor @@ -53,7 +53,7 @@ M: #recursive escape-analysis* ( #recursive -- ) ] bi ; M: #enter-recursive escape-analysis* ( #enter-recursive -- ) - #! Handled by #recursive + ! Handled by #recursive drop ; M: #call-recursive escape-analysis* ( #call-label -- ) diff --git a/basis/compiler/tree/normalization/introductions/introductions.factor b/basis/compiler/tree/normalization/introductions/introductions.factor index b4d38908a4..46ab98c977 100644 --- a/basis/compiler/tree/normalization/introductions/introductions.factor +++ b/basis/compiler/tree/normalization/introductions/introductions.factor @@ -9,9 +9,9 @@ SYMBOL: introductions GENERIC: count-introductions* ( node -- ) : count-introductions ( nodes -- n ) - #! Note: we use each, not each-node, since the #branch - #! method recurses into children directly and we don't - #! recurse into #recursive at all. + ! Note: we use each, not each-node, since the #branch + ! method recurses into children directly and we don't + ! recurse into #recursive at all. [ 0 introductions set [ count-introductions* ] each diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index 1705c4411a..9d1ba98e4a 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -34,8 +34,8 @@ CONSTANT: null-info T{ value-info-state f null empty-interval } CONSTANT: object-info T{ value-info-state f object full-interval } : interval>literal ( class interval -- literal literal? ) - #! If interval has zero length and the class is sufficiently - #! precise, we can turn it into a literal + ! If interval has zero length and the class is sufficiently + ! precise, we can turn it into a literal dup special-interval? [ 2drop f f ] [ @@ -60,7 +60,7 @@ DEFER: UNION: fixed-length array byte-array string ; : literal-class ( obj -- class ) - #! Handle forgotten tuples and singleton classes properly + ! Handle forgotten tuples and singleton classes properly dup singleton-class? [ class-of dup class? [ drop tuple diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor index 05ad2aeed3..3e105445ed 100644 --- a/basis/compiler/tree/propagation/simple/simple.factor +++ b/basis/compiler/tree/propagation/simple/simple.factor @@ -42,9 +42,9 @@ M: anonymous-intersection add-depends-on-class participants>> [ add-depends-on-class ] each ; M: #declare propagate-before - #! We need to force the caller word to recompile when the - #! classes mentioned in the declaration are redefined, since - #! now we're making assumptions about their definitions. + ! We need to force the caller word to recompile when the + ! classes mentioned in the declaration are redefined, since + ! now we're making assumptions about their definitions. declaration>> [ [ add-depends-on-class ] [ swap refine-value-info ] @@ -121,9 +121,9 @@ ERROR: invalid-outputs #call infos ; if ; : propagate-predicate ( #call word -- infos ) - #! We need to force the caller word to recompile when the class - #! is redefined, since now we're making assumptions but the - #! class definition itself. + ! We need to force the caller word to recompile when the class + ! is redefined, since now we're making assumptions but the + ! class definition itself. [ in-d>> first value-info ] [ "predicating" word-prop ] bi* [ nip add-depends-on-conditionally ] diff --git a/basis/compiler/tree/propagation/slots/slots.factor b/basis/compiler/tree/propagation/slots/slots.factor index f9955de705..bde048825a 100644 --- a/basis/compiler/tree/propagation/slots/slots.factor +++ b/basis/compiler/tree/propagation/slots/slots.factor @@ -51,13 +51,13 @@ IN: compiler.tree.propagation.slots dup [ read-only>> ] when ; : literal-info-slot ( slot object -- info/f ) - #! literal-info-slot makes an unsafe call to 'slot'. - #! Check that the layout is up to date to avoid accessing the - #! wrong slot during a compilation unit where reshaping took - #! place. This could happen otherwise because the "slots" word - #! property would reflect the new layout, but instances in the - #! heap would use the old layout since instances are updated - #! immediately after compilation. + ! literal-info-slot makes an unsafe call to 'slot'. + ! Check that the layout is up to date to avoid accessing the + ! wrong slot during a compilation unit where reshaping took + ! place. This could happen otherwise because the "slots" word + ! property would reflect the new layout, but instances in the + ! heap would use the old layout since instances are updated + ! immediately after compilation. { [ class-of read-only-slot? ] [ nip layout-up-to-date? ] diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index e95939b378..0d566228d1 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -246,7 +246,7 @@ ERROR: bad-partial-eval quot word ; CONSTANT: lookup-table-at-max 256 : lookup-table-at? ( assoc -- ? ) - #! Can we use a fast byte array test here? + ! Can we use a fast byte array test here? { [ assoc-size 4 > ] [ values [ ] all? ] diff --git a/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor b/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor index 808b3c32bd..a5766a2842 100644 --- a/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor +++ b/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor @@ -67,7 +67,7 @@ M: #call unbox-tuples* } case ; M: #declare unbox-tuples* - #! We don't look at declarations after escape analysis anyway. + ! We don't look at declarations after escape analysis anyway. drop f ; M: #copy unbox-tuples* diff --git a/basis/concurrency/conditions/conditions.factor b/basis/concurrency/conditions/conditions.factor index 48a685efda..f41303d4ed 100644 --- a/basis/concurrency/conditions/conditions.factor +++ b/basis/concurrency/conditions/conditions.factor @@ -10,8 +10,8 @@ IN: concurrency.conditions [ resume-now ] slurp-deque ; inline : queue-timeout ( queue timeout -- timer ) - #! Add an timer which removes the current thread from the - #! queue, and resumes it, passing it a value of t. + ! Add an timer which removes the current thread from the + ! queue, and resumes it, passing it a value of t. [ [ self swap push-front* ] keep '[ _ _ diff --git a/basis/concurrency/locks/locks.factor b/basis/concurrency/locks/locks.factor index f1945db084..9e56c04253 100644 --- a/basis/concurrency/locks/locks.factor +++ b/basis/concurrency/locks/locks.factor @@ -85,14 +85,14 @@ TUPLE: rw-lock readers writers reader# writer ; [ notify-writer ] [ readers>> notify-all ] if ; : reentrant-read-lock-ok? ( lock -- ? ) - #! If we already have a write lock, then we can grab a read - #! lock too. + ! If we already have a write lock, then we can grab a read + ! lock too. writer>> self eq? ; : reentrant-write-lock-ok? ( lock -- ? ) - #! The only case where we have a writer and > 1 reader is - #! write -> read re-entrancy, and in this case we prohibit - #! a further write -> read -> write re-entrancy. + ! The only case where we have a writer and > 1 reader is + ! write -> read re-entrancy, and in this case we prohibit + ! a further write -> read -> write re-entrancy. { [ writer>> self eq? ] [ reader#>> zero? ] } 1&& ; PRIVATE> diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index dcc0eda527..ce384bb0d0 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -189,16 +189,16 @@ M: x86.32 %end-callback ( -- ) "end_callback" f f %c-invoke ; : funny-large-struct-return? ( return abi -- ? ) - #! MINGW ABI incompatibility disaster + ! MINGW ABI incompatibility disaster [ large-struct? ] [ mingw eq? os windows? not or ] bi* and ; M: x86.32 %prepare-var-args ( -- ) ; M:: x86.32 stack-cleanup ( stack-size return abi -- n ) - #! a) Functions which are stdcall/fastcall/thiscall have to - #! clean up the caller's stack frame. - #! b) Functions returning large structs on MINGW have to - #! fix ESP. + ! a) Functions which are stdcall/fastcall/thiscall have to + ! clean up the caller's stack frame. + ! b) Functions returning large structs on MINGW have to + ! fix ESP. { { [ abi callee-cleanup? ] [ stack-size ] } { [ return abi funny-large-struct-return? ] [ 4 ] } diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor index 6426af85cd..b452b48f7f 100644 --- a/basis/cpu/x86/assembler/assembler.factor +++ b/basis/cpu/x86/assembler/assembler.factor @@ -116,7 +116,7 @@ M: register displacement, drop ; and and ; :: rex-prefix ( reg r/m rex.w -- ) - #! Compile an AMD64 REX prefix. + ! Compile an AMD64 REX prefix. rex.w reg r/m rex.w? 0b01001000 0b01000000 ? reg rex.r r/m rex.b @@ -129,8 +129,8 @@ M: register displacement, drop ; [ drop 16-prefix ] [ [ f ] 2dip rex-prefix ] 2bi ; : short-operand ( reg rex.w n -- ) - #! Some instructions encode their single operand as part of - #! the opcode. + ! Some instructions encode their single operand as part of + ! the opcode. [ dupd prefix-1 reg-code ] dip + , ; : opcode, ( opcode -- ) dup array? [ % ] [ , ] if ; @@ -145,8 +145,8 @@ M: register displacement, drop ; [ [ unclip-last ] dip bitor suffix ] [ bitor ] if ; : 1-operand ( operand reg,rex.w,opcode -- ) - #! The 'reg' is not really a register, but a value for the - #! 'reg' field of the mod-r/m byte. + ! The 'reg' is not really a register, but a value for the + ! 'reg' field of the mod-r/m byte. first3 [ [ over ] dip prefix-1 ] dip opcode, swap addressing ; : immediate-operand-size-bit ( dst imm reg,rex.w,opcode -- imm dst reg,rex.w,opcode ) @@ -165,10 +165,10 @@ M: register displacement, drop ; over integer? [ first3 0b10 opcode-or 3array ] when ; : immediate-1/4 ( dst imm reg,rex.w,opcode -- ) - #! If imm is a byte, compile the opcode and the byte. - #! Otherwise, set the 8-bit operand flag in the opcode, and - #! compile the cell. The 'reg' is not really a register, but - #! a value for the 'reg' field of the mod-r/m byte. + ! If imm is a byte, compile the opcode and the byte. + ! Otherwise, set the 8-bit operand flag in the opcode, and + ! compile the cell. The 'reg' is not really a register, but + ! a value for the 'reg' field of the mod-r/m byte. over fits-in-byte? [ immediate-fits-in-size-bit immediate-1 ] [ diff --git a/basis/cpu/x86/assembler/operands/operands.factor b/basis/cpu/x86/assembler/operands/operands.factor index 2a2faa4039..ecdc002475 100644 --- a/basis/cpu/x86/assembler/operands/operands.factor +++ b/basis/cpu/x86/assembler/operands/operands.factor @@ -59,7 +59,7 @@ M: indirect extended? base>> extended? ; [ f >>displacement ] when ; : canonicalize-EBP ( indirect -- indirect ) - #! { EBP } ==> { EBP 0 } + ! { EBP } ==> { EBP 0 } dup [ base>> { EBP RBP R13 } member? ] [ displacement>> not ] bi and [ 0 >>displacement ] when ; @@ -69,8 +69,8 @@ ERROR: bad-index indirect ; dup index>> { ESP RSP } member-eq? [ bad-index ] when ; : canonicalize ( indirect -- indirect ) - #! Modify the indirect to work around certain addressing mode - #! quirks. + ! Modify the indirect to work around certain addressing mode + ! quirks. canonicalize-displacement canonicalize-EBP check-ESP ; ! Utilities diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 0c5ea12907..5303aa14bf 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -104,7 +104,7 @@ M: x86 %inc ( loc -- ) M: x86 %call ( word -- ) 0 CALL rc-relative rel-word-pic ; : xt-tail-pic-offset ( -- n ) - #! See the comment in vm/cpu-x86.hpp + ! See the comment in vm/cpu-x86.hpp 4 1 + ; inline HOOK: %prepare-jump cpu ( -- ) @@ -617,10 +617,10 @@ M:: x86 %local-allot ( dst size align offset -- ) dst offset local-allot-offset special-offset stack@ LEA ; : next-stack@ ( n -- operand ) - #! nth parameter from the next stack frame. Used to box - #! input values to callbacks; the callback has its own - #! stack frame set up, and we want to read the frame - #! set up by the caller. + ! nth parameter from the next stack frame. Used to box + ! input values to callbacks; the callback has its own + ! stack frame set up, and we want to read the frame + ! set up by the caller. [ frame-reg ] dip 2 cells + reserved-stack-space + [+] ; : return-reg ( rep -- reg ) @@ -686,9 +686,9 @@ M: x86 %callback-outputs ( reg-inputs -- ) M: x86 %loop-entry 16 alignment [ NOP ] times ; M:: x86 %save-context ( temp1 temp2 -- ) - #! Save Factor stack pointers in case the C code calls a - #! callback which does a GC, which must reliably trace - #! all roots. + ! Save Factor stack pointers in case the C code calls a + ! callback which does a GC, which must reliably trace + ! all roots. temp1 %context temp2 stack-reg cell neg [+] LEA temp1 "callstack-top" context-field-offset [+] temp2 MOV diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index fb3a7e107a..3fcc32996f 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -47,7 +47,7 @@ M: retryable execute-statement* ( statement type -- ) [ db-columns ] [ db-table-name ] bi ; : query-make ( class quot -- statements ) - #! query, input, outputs, secondary queries + ! query, input, outputs, secondary queries over db-table-name "table-name" set [ sql-props ] dip [ 0 sql-counter rot with-variable ] curry diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor index 1f954688be..b36edc2920 100644 --- a/basis/db/sqlite/lib/lib.factor +++ b/basis/db/sqlite/lib/lib.factor @@ -117,7 +117,7 @@ ERROR: sqlite-sql-error < sql-error n string ; } case ; : sqlite-bind-type ( handle key value type -- ) - #! null and empty values need to be set by sqlite-bind-null-by-name + ! null and empty values need to be set by sqlite-bind-null-by-name over [ NULL = [ 2drop NULL NULL ] when ] [ diff --git a/basis/furnace/chloe-tags/chloe-tags.factor b/basis/furnace/chloe-tags/chloe-tags.factor index deecef8848..fc7f826bc4 100644 --- a/basis/furnace/chloe-tags/chloe-tags.factor +++ b/basis/furnace/chloe-tags/chloe-tags.factor @@ -55,7 +55,7 @@ CHLOE: atom CHLOE: write-atom drop [ write-atom-feeds ] [code] ; : compile-link-attrs ( tag -- ) - #! Side-effects current namespace. + ! Side-effects current namespace. '[ [ [ _ ] dip link-attr ] each-responder ] [code] ; : process-attrs ( assoc -- newassoc ) diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor index 57a6919ae9..7bf2e35ef6 100644 --- a/basis/furnace/utilities/utilities.factor +++ b/basis/furnace/utilities/utilities.factor @@ -92,7 +92,7 @@ M: object modify-form drop f ; CONSTANT: nested-forms-key "__n" : referrer ( -- referrer/f ) - #! Typo is intentional, it's in the HTTP spec! + ! Typo is intentional, it's in the HTTP spec! request get "referer" header dup [ >url ensure-port [ remap-port ] change-port ] when ; diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index 61b16ab746..d5c5592683 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -136,7 +136,7 @@ ALIAS: $slot $snippet ] ($code) ; : $unchecked-example ( element -- ) - #! help-lint ignores these. + ! help-lint ignores these. $example ; : $markup-example ( element -- ) diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor index a68db36f4f..256fd5950d 100644 --- a/basis/html/components/components.factor +++ b/basis/html/components/components.factor @@ -65,7 +65,7 @@ TUPLE: password size ; password new ; M: password render* - #! Don't send passwords back to the user + ! Don't send passwords back to the user [ drop "" ] 2dip size>> "password" render-field ; ! Text areas diff --git a/basis/http/http.factor b/basis/http/http.factor index d1b9968640..9e1f6377cd 100644 --- a/basis/http/http.factor +++ b/basis/http/http.factor @@ -32,7 +32,7 @@ CONSTANT: max-redirects 10 } cond ; : check-header-string ( str -- str ) - #! http://en.wikipedia.org/wiki/HTTP_Header_Injection + ! http://en.wikipedia.org/wiki/HTTP_Header_Injection dup "\r\n" intersects? [ "Header injection attack" throw ] when ; diff --git a/basis/http/parsers/parsers.factor b/basis/http/parsers/parsers.factor index 2a5b77874a..734e48e3fe 100644 --- a/basis/http/parsers/parsers.factor +++ b/basis/http/parsers/parsers.factor @@ -67,7 +67,7 @@ IN: http.parsers ] seq* [ "1.0" suffix! ] action ; PEG: parse-request-line ( string -- triple ) - #! Triple is { method url version } + ! Triple is { method url version } full-request-parser simple-request-parser 2array choice ; : text-parser ( -- parser ) @@ -80,7 +80,7 @@ PEG: parse-request-line ( string -- triple ) text-parser repeat0 case-sensitive ; PEG: parse-response-line ( string -- triple ) - #! Triple is { version code message } + ! Triple is { version code message } [ space-parser , http-version-parser , @@ -120,8 +120,8 @@ PEG: parse-response-line ( string -- triple ) 2choice ; PEG: parse-header-line ( string -- pair ) - #! Pair is either { name value } or { f value }. If f, its a - #! continuation of the previous header line. + ! Pair is either { name value } or { f value }. If f, its a + ! continuation of the previous header line. [ field-name-parser , space-parser , diff --git a/basis/http/server/cgi/cgi.factor b/basis/http/server/cgi/cgi.factor index 40e512a060..0299f0118d 100644 --- a/basis/http/server/cgi/cgi.factor +++ b/basis/http/server/cgi/cgi.factor @@ -7,7 +7,7 @@ math.parser fry urls urls.encoding calendar make ; IN: http.server.cgi : cgi-variables ( script-path -- assoc ) - #! This needs some work. + ! This needs some work. [ "CGI/1.0" "GATEWAY_INTERFACE" ,, "HTTP/" request get version>> append "SERVER_PROTOCOL" ,, diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index 9ad1a04393..d074fe4fcd 100644 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -57,8 +57,8 @@ GENERIC: write-full-response ( request response -- ) ] change-domain ; : write-response-header ( response -- response ) - #! We send one set-cookie header per cookie, because that's - #! what Firefox expects. + ! We send one set-cookie header per cookie, because that's + ! what Firefox expects. dup header>> >alist >vector over unparse-content-type "content-type" pick set-at over cookies>> [ diff --git a/basis/inspector/inspector.factor b/basis/inspector/inspector.factor index 5e6050bb32..eaeed3cf51 100644 --- a/basis/inspector/inspector.factor +++ b/basis/inspector/inspector.factor @@ -100,7 +100,7 @@ PRIVATE> : &rename ( key n -- ) key@ mirror get rename-at &push reinspect ; : &help ( -- ) - #! A tribute to Slate: + ! A tribute to Slate: "You are in a twisty little maze of objects, all alike." print nl "'n' is a slot number in the following:" print diff --git a/basis/io/files/info/unix/unix.factor b/basis/io/files/info/unix/unix.factor index 54bf324800..c0466cf3ba 100644 --- a/basis/io/files/info/unix/unix.factor +++ b/basis/io/files/info/unix/unix.factor @@ -197,7 +197,7 @@ CONSTANT: ALL-EXECUTE 0o0000111 PRIVATE> : set-file-times ( path timestamps -- ) - #! set access, write + ! set access, write [ normalize-path ] dip timestamps>byte-array [ utimes ] unix-system-call drop ; diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index fc651c366b..db85c22bd6 100755 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -224,7 +224,7 @@ M: windows file-systems ( -- array ) ] with-destructors ; : set-file-times ( path timestamp/f timestamp/f timestamp/f -- ) - #! timestamp order: creation access write + ! timestamp order: creation access write [ [ normalize-path open-existing &dispose handle>> diff --git a/basis/io/files/windows/windows.factor b/basis/io/files/windows/windows.factor index cb7e92ce63..222f96ac31 100755 --- a/basis/io/files/windows/windows.factor +++ b/basis/io/files/windows/windows.factor @@ -253,7 +253,7 @@ M: windows init-stdio f CreateFileW dup win32-error=0/f ; : maybe-create-file ( path -- win32-file ? ) - #! return true if file was just created + ! return true if file was just created flags{ GENERIC_READ GENERIC_WRITE } share-mode f diff --git a/basis/io/launcher/windows/windows.factor b/basis/io/launcher/windows/windows.factor index a2db855881..867de0ca83 100755 --- a/basis/io/launcher/windows/windows.factor +++ b/basis/io/launcher/windows/windows.factor @@ -148,8 +148,8 @@ M: windows (kill-process) ( process -- ) handle>> hProcess>> 255 TerminateProcess win32-error=0/f ; : dispose-process ( process-information -- ) - #! From MSDN: "Handles in PROCESS_INFORMATION must be closed - #! with CloseHandle when they are no longer needed." + ! From MSDN: "Handles in PROCESS_INFORMATION must be closed + ! with CloseHandle when they are no longer needed." [ hProcess>> [ CloseHandle drop ] when* ] [ hThread>> [ CloseHandle drop ] when* ] bi ; diff --git a/basis/io/monitors/recursive/recursive.factor b/basis/io/monitors/recursive/recursive.factor index b0c86a215f..cede5d52e7 100755 --- a/basis/io/monitors/recursive/recursive.factor +++ b/basis/io/monitors/recursive/recursive.factor @@ -19,7 +19,7 @@ DEFER: add-child-monitor monitor tget path>> prepend-path ; : add-child-monitors ( path -- ) - #! We yield since this directory scan might take a while. + ! We yield since this directory scan might take a while. dup [ [ append-path ] with map [ add-child-monitor ] each yield diff --git a/basis/io/sockets/secure/unix/unix.factor b/basis/io/sockets/secure/unix/unix.factor index 084cd5ded9..8ccc61a63a 100644 --- a/basis/io/sockets/secure/unix/unix.factor +++ b/basis/io/sockets/secure/unix/unix.factor @@ -32,10 +32,10 @@ M: secure (accept) ] with-destructors ; : check-shutdown-response ( handle r -- event ) - #! We don't do two-step shutdown here because I couldn't - #! figure out how to do it with non-blocking BIOs. Also, it - #! seems that SSL_shutdown always returns 0 -- this sounds - #! like a bug + ! We don't do two-step shutdown here because I couldn't + ! figure out how to do it with non-blocking BIOs. Also, it + ! seems that SSL_shutdown always returns 0 -- this sounds + ! like a bug over handle>> over SSL_get_error { { SSL_ERROR_NONE [ 2drop f ] } diff --git a/basis/io/streams/duplex/duplex.factor b/basis/io/streams/duplex/duplex.factor index ddc5974bde..fc1a55fc00 100644 --- a/basis/io/streams/duplex/duplex.factor +++ b/basis/io/streams/duplex/duplex.factor @@ -27,9 +27,9 @@ M: duplex-stream set-timeout >duplex-stream< [ set-timeout ] bi-curry@ bi ; M: duplex-stream dispose - #! The output stream is closed first, in case both streams - #! are attached to the same file descriptor, the output - #! buffer needs to be flushed before we close the fd. + ! The output stream is closed first, in case both streams + ! are attached to the same file descriptor, the output + ! buffer needs to be flushed before we close the fd. [ >duplex-stream< [ &dispose drop ] bi@ ] with-destructors ; : ( stream-in stream-out encoding -- duplex ) diff --git a/basis/json/writer/writer.factor b/basis/json/writer/writer.factor index 9795b993e1..2d5e4ca4c6 100644 --- a/basis/json/writer/writer.factor +++ b/basis/json/writer/writer.factor @@ -28,7 +28,7 @@ GENERIC# stream-json-print 1 ( obj stream -- ) output-stream get stream-json-print ; : >json ( obj -- string ) - #! Returns a string representing the factor object in JSON format + ! Returns a string representing the factor object in JSON format [ json-print ] with-string-writer ; M: f stream-json-print diff --git a/basis/locals/prettyprint/prettyprint.factor b/basis/locals/prettyprint/prettyprint.factor index bd4bedad6a..ac72801d91 100644 --- a/basis/locals/prettyprint/prettyprint.factor +++ b/basis/locals/prettyprint/prettyprint.factor @@ -5,8 +5,8 @@ prettyprint.custom prettyprint.sections sequences words ; IN: locals.prettyprint : pprint-var ( var -- ) - #! Prettyprint a read/write local as its writer, just like - #! in the input syntax: [| x! | ... x 3 + x! ] + ! Prettyprint a read/write local as its writer, just like + ! in the input syntax: [| x! | ... x 3 + x! ] dup local-reader? [ "local-writer" word-prop ] when pprint-word ; diff --git a/basis/locals/rewrite/closures/closures.factor b/basis/locals/rewrite/closures/closures.factor index b0f1426bec..cb17b3be62 100644 --- a/basis/locals/rewrite/closures/closures.factor +++ b/basis/locals/rewrite/closures/closures.factor @@ -44,8 +44,8 @@ M: quotation uses-vars* [ uses-vars* ] each ; [ uses-vars ] [ defs-vars ] bi diff ; M: callable rewrite-closures* - #! Turn free variables into bound variables, curry them - #! onto the body + ! Turn free variables into bound variables, curry them + ! onto the body dup free-vars [ ] map [ % ] [ var-defs prepend (rewrite-closures) point-free , ] diff --git a/basis/locals/types/types.factor b/basis/locals/types/types.factor index a930765b7c..1c2c27a067 100644 --- a/basis/locals/types/types.factor +++ b/basis/locals/types/types.factor @@ -29,7 +29,7 @@ C: multi-def PREDICATE: local < word "local?" word-prop ; : ( name -- word ) - #! Create a local variable identifier + ! Create a local variable identifier f dup t "local?" set-word-prop ; diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index 7b2d8205ca..9d0d4abd3a 100644 --- a/basis/logging/logging.factor +++ b/basis/logging/logging.factor @@ -137,7 +137,7 @@ PRIVATE> (define-logging) ; SYNTAX: LOG: - #! Syntax: name level + ! Syntax: name level scan-new-word dup scan-word '[ 1array stack>message _ _ log-message ] ( message -- ) define-declared ; diff --git a/basis/logging/server/server.factor b/basis/logging/server/server.factor index 4497b85dbb..b9d8cf78f1 100644 --- a/basis/logging/server/server.factor +++ b/basis/logging/server/server.factor @@ -52,7 +52,7 @@ SYMBOL: log-files ] unless-empty ; : (log-message) ( msg -- ) - #! msg: { msg word-name level service } + ! msg: { msg word-name level service } first4 log-stream [ write-message flush ] with-output-stream* ; : try-dispose ( obj -- ) diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 22e07db984..640f28be7b 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -11,7 +11,7 @@ M: real sqrt [ neg fsqrt [ 0.0 ] dip rect> ] [ fsqrt ] if ; inline : factor-2s ( n -- r s ) - #! factor an integer into 2^r * s + ! factor an integer into 2^r * s dup 0 = [ 1 ] [ [ 0 ] dip [ dup even? ] [ [ 1 + ] [ 2/ ] bi* ] while ] if ; inline diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor index 065c01dfa8..0b3f31d679 100644 --- a/basis/math/intervals/intervals.factor +++ b/basis/math/intervals/intervals.factor @@ -221,7 +221,7 @@ MEMO: array-capacity-interval ( -- interval ) ] dip [ 2drop [-inf,inf] ] if ; inline : interval-shift ( i1 i2 -- i3 ) - #! Inaccurate; could be tighter + ! Inaccurate; could be tighter [ [ [ interval-closure ] bi@ @@ -274,8 +274,8 @@ MEMO: array-capacity-interval ( -- interval ) [ [ [ / ] interval-op nan-not-ok ] interval-division-op ] do-empty-interval ; : interval/-safe ( i1 i2 -- i3 ) - #! Just a hack to make the compiler work if bootstrap.math - #! is not loaded. + ! Just a hack to make the compiler work if bootstrap.math + ! is not loaded. \ integer \ / ?lookup-method [ interval/ ] [ 2drop f ] if ; : interval/i ( i1 i2 -- i3 ) @@ -387,7 +387,7 @@ SYMBOL: incomparable from>> first 0 >= ; : interval-bitand ( i1 i2 -- i3 ) - #! Inaccurate. + ! Inaccurate. [ { { @@ -403,7 +403,7 @@ SYMBOL: incomparable ] do-empty-interval ; : interval-bitor ( i1 i2 -- i3 ) - #! Inaccurate. + ! Inaccurate. [ 2dup [ interval-nonnegative? ] both? [ @@ -413,7 +413,7 @@ SYMBOL: incomparable ] do-empty-interval ; : interval-bitxor ( i1 i2 -- i3 ) - #! Inaccurate. + ! Inaccurate. interval-bitor ; : interval-log2 ( i1 -- i2 ) diff --git a/basis/math/matrices/elimination/elimination.factor b/basis/math/matrices/elimination/elimination.factor index 021e086745..73c46730a2 100644 --- a/basis/math/matrices/elimination/elimination.factor +++ b/basis/math/matrices/elimination/elimination.factor @@ -24,7 +24,7 @@ SYMBOL: matrix over [ find-from drop ] dip swap [ nip ] [ length ] if* ; inline : first-col ( row# -- n ) - #! First non-zero column + ! First non-zero column 0 swap nth-row [ zero? not ] skip ; : clear-scale ( col# pivot-row i-row -- n ) diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor index a31da06a1a..fc25c01a06 100644 --- a/basis/math/statistics/statistics.factor +++ b/basis/math/statistics/statistics.factor @@ -61,7 +61,7 @@ PRIVATE> i! 0 :> j! @@ -90,7 +90,7 @@ PRIVATE> k seq nth-unsafe ; inline : (kth-object) ( seq k nth-quot exchange-quot quot: ( x y -- ? ) -- elt ) - #! The algorithm modifiers seq, so we clone it + ! The algorithm modifiers seq, so we clone it [ >array ] 4dip ((kth-object)) ; inline : kth-object-unsafe ( seq k quot: ( x y -- ? ) -- elt ) diff --git a/basis/math/vectors/simd/simd-tests.factor b/basis/math/vectors/simd/simd-tests.factor index 0883822b80..6bdb270e57 100644 --- a/basis/math/vectors/simd/simd-tests.factor +++ b/basis/math/vectors/simd/simd-tests.factor @@ -139,13 +139,13 @@ TUPLE: simd-test-failure -- failures ) - #! Use test-quot to generate a bunch of test cases from the - #! given inputs. Run each test case optimized and - #! unoptimized. Compare results with eq-quot. - #! - #! seq: sequence of inputs - #! test-quot: ( input -- input-quot: ( -- ..v ) code-quot: ( ..v -- result ) ) - #! eq-quot: ( result1 result2 -- ? ) + ! Use test-quot to generate a bunch of test cases from the + ! given inputs. Run each test case optimized and + ! unoptimized. Compare results with eq-quot. + ! + ! seq: sequence of inputs + ! test-quot: ( input -- input-quot: ( -- ..v ) code-quot: ( ..v -- result ) ) + ! eq-quot: ( result1 result2 -- ? ) seq [| input | input test-quot call :> ( input-quot code-quot ) input-quot [ class-of ] { } map-as :> input-classes diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 26a3410677..2fb27d0368 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -104,9 +104,9 @@ MACRO: all-enabled-client-state ( seq quot -- quot ) line-vertices GL_LINES 0 2 glDrawArrays ; :: (rect-vertices) ( loc dim -- vertices ) - #! We use GL_LINE_STRIP with a duplicated first vertex - #! instead of GL_LINE_LOOP to work around a bug in Apple's - #! X3100 driver. + ! We use GL_LINE_STRIP with a duplicated first vertex + ! instead of GL_LINE_LOOP to work around a bug in Apple's + ! X3100 driver. loc first2 [ 0.3 + ] bi@ :> ( x y ) dim first2 [ 0.6 - ] bi@ :> ( w h ) [ @@ -226,7 +226,7 @@ MACRO: set-draw-buffers ( buffers -- quot ) fix-coordinates glViewport ; : init-matrices ( -- ) - #! Leaves with matrix mode GL_MODELVIEW + ! Leaves with matrix mode GL_MODELVIEW GL_PROJECTION glMatrixMode glLoadIdentity GL_MODELVIEW glMatrixMode diff --git a/basis/opengl/textures/textures.factor b/basis/opengl/textures/textures.factor index ade19b2279..0accf6f846 100644 --- a/basis/opengl/textures/textures.factor +++ b/basis/opengl/textures/textures.factor @@ -12,8 +12,8 @@ IN: opengl.textures SYMBOL: non-power-of-2-textures? : check-extensions ( -- ) - #! ATI frglx driver doesn't implement GL_ARB_texture_non_power_of_two properly. - #! See thread 'Linux font display problem' April 2009 on Factor-talk + ! ATI frglx driver doesn't implement GL_ARB_texture_non_power_of_two properly. + ! See thread 'Linux font display problem' April 2009 on Factor-talk gl-vendor "ATI Technologies Inc." = not os macosx? or [ "2.0" { "GL_ARB_texture_non_power_of_two" } has-gl-version-or-extensions? @@ -409,8 +409,8 @@ CONSTANT: max-texture-size { 512 512 } PRIVATE> : make-texture ( image -- id ) - #! We use glTexSubImage2D to work around the power of 2 texture size - #! limitation + ! We use glTexSubImage2D to work around the power of 2 texture size + ! limitation gen-texture [ GL_TEXTURE_BIT [ GL_TEXTURE_2D swap glBindTexture diff --git a/basis/peg/ebnf/ebnf-tests.factor b/basis/peg/ebnf/ebnf-tests.factor index 3b1e6f1240..6f3b4922d3 100644 --- a/basis/peg/ebnf/ebnf-tests.factor +++ b/basis/peg/ebnf/ebnf-tests.factor @@ -266,20 +266,20 @@ IN: peg.ebnf.tests ] must-fail { V{ V{ 49 } "+" V{ 49 } } } [ - #! Test direct left recursion. - #! Using packrat, so first part of expr fails, causing 2nd choice to be used + ! Test direct left recursion. + ! Using packrat, so first part of expr fails, causing 2nd choice to be used "1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] ] unit-test { V{ V{ V{ 49 } "+" V{ 49 } } "+" V{ 49 } } } [ - #! Test direct left recursion. - #! Using packrat, so first part of expr fails, causing 2nd choice to be used + ! Test direct left recursion. + ! Using packrat, so first part of expr fails, causing 2nd choice to be used "1+1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] ] unit-test { V{ V{ V{ 49 } "+" V{ 49 } } "+" V{ 49 } } } [ - #! Test indirect left recursion. - #! Using packrat, so first part of expr fails, causing 2nd choice to be used + ! Test indirect left recursion. + ! Using packrat, so first part of expr fails, causing 2nd choice to be used "1+1+1" [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] ] unit-test @@ -511,8 +511,8 @@ foo= 'd' ] must-fail { t } [ - #! Rule lookup occurs in a namespace. This causes an incorrect duplicate rule - #! if a var in a namespace is set. This unit test is to remind me to fix this. + ! Rule lookup occurs in a namespace. This causes an incorrect duplicate rule + ! if a var in a namespace is set. This unit test is to remind me to fix this. [ "fail" "foo" set "foo='a'" ebnf-parser parse transform drop t ] with-scope ] unit-test diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor index 784d9d507b..402dba49fa 100644 --- a/basis/peg/ebnf/ebnf.factor +++ b/basis/peg/ebnf/ebnf.factor @@ -10,7 +10,7 @@ FROM: peg.search => replace ; IN: peg.ebnf : rule ( name word -- parser ) - #! Given an EBNF word produced from EBNF: return the EBNF rule + ! Given an EBNF word produced from EBNF: return the EBNF rule "ebnf-parser" word-prop at ; ERROR: no-rule rule parser ; @@ -85,17 +85,17 @@ C: ebnf-semantic C: ebnf : filter-hidden ( seq -- seq ) - #! Remove elements that produce no AST from sequence + ! Remove elements that produce no AST from sequence [ ebnf-ensure-not? ] reject [ ebnf-ensure? not ] filter ; : syntax ( string -- parser ) - #! Parses the string, ignoring white space, and - #! does not put the result in the AST. + ! Parses the string, ignoring white space, and + ! does not put the result in the AST. token sp hide ; : syntax-pack ( begin parser end -- parser ) - #! Parse parser-parser surrounded by syntax elements - #! begin and end. + ! Parse parser-parser surrounded by syntax elements + ! begin and end. [ syntax ] 2dip syntax pack ; : insert-escapes ( string -- string ) @@ -106,10 +106,10 @@ C: ebnf ] choice* replace ; : identifier-parser ( -- parser ) - #! Return a parser that parses an identifer delimited by - #! a quotation character. The quotation can be single - #! or double quotes. The AST produced is the identifier - #! between the quotes. + ! Return a parser that parses an identifer delimited by + ! a quotation character. The quotation can be single + ! or double quotes. The AST produced is the identifier + ! between the quotes. [ [ [ CHAR: \ = ] satisfy @@ -120,9 +120,9 @@ C: ebnf ] choice* [ "" flatten-as unescape-string ] action ; : non-terminal-parser ( -- parser ) - #! A non-terminal is the name of another rule. It can - #! be any non-blank character except for characters used - #! in the EBNF syntax itself. + ! A non-terminal is the name of another rule. It can + ! be any non-blank character except for characters used + ! in the EBNF syntax itself. [ { [ blank? ] @@ -131,12 +131,12 @@ C: ebnf ] satisfy repeat1 [ >string ] action ; : terminal-parser ( -- parser ) - #! A terminal is an identifier enclosed in quotations - #! and it represents the literal value of the identifier. + ! A terminal is an identifier enclosed in quotations + ! and it represents the literal value of the identifier. identifier-parser [ ] action ; : foreign-name-parser ( -- parser ) - #! Parse a valid foreign parser name + ! Parse a valid foreign parser name [ { [ blank? ] @@ -145,7 +145,7 @@ C: ebnf ] satisfy repeat1 [ >string ] action ; : foreign-parser ( -- parser ) - #! A foreign call is a call to a rule in another ebnf grammar + ! A foreign call is a call to a rule in another ebnf grammar [ " ebnf ] seq* [ first2 ] action ; : any-character-parser ( -- parser ) - #! A parser to match the symbol for any character match. + ! A parser to match the symbol for any character match. [ CHAR: . = ] satisfy [ drop ] action ; : range-parser-parser ( -- parser ) - #! Match the syntax for declaring character ranges + ! Match the syntax for declaring character ranges [ [ "[" syntax , "[" token ensure-not , ] seq* hide , [ CHAR: ] = not ] satisfy repeat1 , @@ -166,10 +166,10 @@ C: ebnf ] seq* [ first >string unescape-string ] action ; : (element-parser) ( -- parser ) - #! An element of a rule. It can be a terminal or a - #! non-terminal but must not be followed by a "=". - #! The latter indicates that it is the beginning of a - #! new rule. + ! An element of a rule. It can be a terminal or a + ! non-terminal but must not be followed by a "=". + ! The latter indicates that it is the beginning of a + ! new rule. [ [ [ @@ -206,9 +206,9 @@ DEFER: action-parser DEFER: choice-parser : grouped ( quot suffix -- parser ) - #! Parse a group of choices, with a suffix indicating - #! the type of group (repeat0, repeat1, etc) and - #! an quot that is the action that produces the AST. + ! Parse a group of choices, with a suffix indicating + ! the type of group (repeat0, repeat1, etc) and + ! an quot that is the action that produces the AST. 2dup [ "(" [ choice-parser sp ] delay ")" syntax-pack @@ -220,7 +220,7 @@ DEFER: choice-parser ] choice* ; : group-parser ( -- parser ) - #! A grouping with no suffix. Used for precedence. + ! A grouping with no suffix. Used for precedence. [ ] [ "~" token sp ensure-not , "*" token sp ensure-not , @@ -248,26 +248,26 @@ DEFER: choice-parser ] seq* repeat0 [ "" concat-as ] action ; : ensure-not-parser ( -- parser ) - #! Parses the '!' syntax to ensure that - #! something that matches the following elements do - #! not exist in the parse stream. + ! Parses the '!' syntax to ensure that + ! something that matches the following elements do + ! not exist in the parse stream. [ "!" syntax , group-parser sp , ] seq* [ first ] action ; : ensure-parser ( -- parser ) - #! Parses the '&' syntax to ensure that - #! something that matches the following elements does - #! exist in the parse stream. + ! Parses the '&' syntax to ensure that + ! something that matches the following elements does + ! exist in the parse stream. [ "&" syntax , group-parser sp , ] seq* [ first ] action ; : (sequence-parser) ( -- parser ) - #! A sequence of terminals and non-terminals, including - #! groupings of those. + ! A sequence of terminals and non-terminals, including + ! groupings of those. [ [ ensure-not-parser sp , @@ -290,8 +290,8 @@ DEFER: choice-parser "?[" factor-code-parser "]?" syntax-pack ; : sequence-parser ( -- parser ) - #! A sequence of terminals and non-terminals, including - #! groupings of those. + ! A sequence of terminals and non-terminals, including + ! groupings of those. [ [ (sequence-parser) , action-parser , ] seq* [ first2 ] action , @@ -375,9 +375,9 @@ M: ebnf-rule (transform) ( ast -- parser ) ] keep ; M: ebnf-sequence (transform) ( ast -- parser ) - #! If ignore-ws is set then each element of the sequence - #! ignores leading whitespace. This is not inherited by - #! subelements of the sequence. + ! If ignore-ws is set then each element of the sequence + ! ignores leading whitespace. This is not inherited by + ! subelements of the sequence. elements>> [ f ignore-ws [ (transform) ] with-variable ignore-ws get [ sp ] when @@ -393,7 +393,7 @@ M: ebnf-range (transform) ( ast -- parser ) pattern>> range-pattern ; : transform-group ( ast -- parser ) - #! convert a ast node with groups to a parser for that group + ! convert a ast node with groups to a parser for that group group>> (transform) ; M: ebnf-ensure (transform) ( ast -- parser ) @@ -420,8 +420,8 @@ M: ebnf-whitespace (transform) ( ast -- parser ) GENERIC: build-locals ( code ast -- code ) M: ebnf-sequence build-locals ( code ast -- code ) - #! Note the need to filter out this ebnf items that - #! leave nothing in the AST + ! Note the need to filter out this ebnf items that + ! leave nothing in the AST elements>> filter-hidden dup length 1 = [ first build-locals ] [ diff --git a/basis/peg/parsers/parsers.factor b/basis/peg/parsers/parsers.factor index fc8847272a..3feddd3447 100644 --- a/basis/peg/parsers/parsers.factor +++ b/basis/peg/parsers/parsers.factor @@ -81,8 +81,8 @@ PRIVATE> ] seq* [ first >string ] action ; : (range-pattern) ( pattern -- string ) - #! Given a range pattern, produce a string containing - #! all characters within that range. + ! Given a range pattern, produce a string containing + ! all characters within that range. [ any-char , [ CHAR: - = ] satisfy hide , @@ -93,14 +93,14 @@ PRIVATE> replace ; : range-pattern ( pattern -- parser ) - #! 'pattern' is a set of characters describing the - #! parser to be produced. Any single character in - #! the pattern matches that character. If the pattern - #! begins with a ^ then the set is negated (the element - #! matches any character not in the set). Any pair of - #! characters separated with a dash (-) represents the - #! range of characters from the first to the second, - #! inclusive. + ! 'pattern' is a set of characters describing the + ! parser to be produced. Any single character in + ! the pattern matches that character. If the pattern + ! begins with a ^ then the set is negated (the element + ! matches any character not in the set). Any pair of + ! characters separated with a dash (-) represents the + ! range of characters from the first to the second, + ! inclusive. dup first CHAR: ^ = [ rest (range-pattern) [ member? not ] curry satisfy ] [ diff --git a/basis/peg/peg-tests.factor b/basis/peg/peg-tests.factor index a491208041..3b38a80751 100644 --- a/basis/peg/peg-tests.factor +++ b/basis/peg/peg-tests.factor @@ -172,8 +172,8 @@ IN: peg.tests ] unit-test : expr ( -- parser ) - #! Test direct left recursion. Currently left recursion should cause a - #! failure of that parser. + ! Test direct left recursion. Currently left recursion should cause a + ! failure of that parser. [ expr ] delay "+" token "1" token 3seq "1" token 2choice ; { V{ V{ "1" "+" "1" } "+" "1" } } [ @@ -181,7 +181,7 @@ IN: peg.tests ] unit-test { t } [ - #! Ensure a circular parser doesn't loop infinitely + ! Ensure a circular parser doesn't loop infinitely [ f , "a" token , ] seq* dup peg>> parsers>> dupd 0 swap set-nth compile word? diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index b822b30ad7..b36213da3f 100644 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -49,12 +49,12 @@ SYMBOL: error-stack SYMBOL: ignore : packrat ( id -- cache ) - #! The packrat cache is a mapping of parser-id->cache. - #! For each parser it maps to a cache holding a mapping - #! of position->result. The packrat cache therefore keeps - #! track of all parses that have occurred at each position - #! of the input string and the results obtained from that - #! parser. + ! The packrat cache is a mapping of parser-id->cache. + ! For each parser it maps to a cache holding a mapping + ! of position->result. The packrat cache therefore keeps + ! track of all parses that have occurred at each position + ! of the input string and the results obtained from that + ! parser. \ packrat get [ drop H{ } clone ] cache ; SYMBOL: pos @@ -63,20 +63,20 @@ SYMBOL: fail SYMBOL: lrstack : heads ( -- cache ) - #! A mapping from position->peg-head. It maps a - #! position in the input string being parsed to - #! the head of the left recursion which is currently - #! being grown. It is 'f' at any position where - #! left recursion growth is not underway. + ! A mapping from position->peg-head. It maps a + ! position in the input string being parsed to + ! the head of the left recursion which is currently + ! being grown. It is 'f' at any position where + ! left recursion growth is not underway. \ heads get ; : failed? ( obj -- ? ) fail = ; : peg-cache ( -- cache ) - #! Holds a hashtable mapping a peg tuple to - #! the parser tuple for that peg. The parser tuple - #! holds a unique id and the compiled form of that peg. + ! Holds a hashtable mapping a peg tuple to + ! the parser tuple for that peg. The parser tuple + ! holds a unique id and the compiled form of that peg. \ peg-cache get-global [ H{ } clone dup \ peg-cache set-global ] unless* ; @@ -97,17 +97,17 @@ TUPLE: left-recursion seed rule-id head next ; TUPLE: peg-head rule-id involved-set eval-set ; : rule-id ( word -- id ) - #! A rule is the parser compiled down to a word. It has - #! a "peg-id" property containing the id of the original parser. + ! A rule is the parser compiled down to a word. It has + ! a "peg-id" property containing the id of the original parser. "peg-id" word-prop ; : input-slice ( -- slice ) - #! Return a slice of the input from the current parse position + ! Return a slice of the input from the current parse position input get pos get tail-slice ; : input-from ( input -- n ) - #! Return the index from the original string that the - #! input slice is based on. + ! Return the index from the original string that the + ! input slice is based on. dup slice? [ from>> ] [ drop 0 ] if ; : process-rule-result ( p result -- result ) @@ -118,17 +118,17 @@ TUPLE: peg-head rule-id involved-set eval-set ; ] if* ; : eval-rule ( rule -- ast ) - #! Evaluate a rule, return an ast resulting from it. - #! Return fail if the rule failed. The rule has - #! stack effect ( -- parse-result ) + ! Evaluate a rule, return an ast resulting from it. + ! Return fail if the rule failed. The rule has + ! stack effect ( -- parse-result ) pos get swap execute( -- parse-result ) process-rule-result ; inline : memo ( pos id -- memo-entry ) - #! Return the result from the memo cache. + ! Return the result from the memo cache. packrat at ; : set-memo ( memo-entry pos id -- ) - #! Store an entry in the cache + ! Store an entry in the cache packrat set-at ; : update-m ( ast m -- ) @@ -239,7 +239,7 @@ TUPLE: peg-head rule-id involved-set eval-set ; ] if* ; inline : with-packrat ( input quot -- result ) - #! Run the quotation with a packrat cache active. + ! Run the quotation with a packrat cache active. [ swap input ,, 0 pos ,, @@ -265,18 +265,18 @@ GENERIC: (compile) ( peg -- quot ) gensym [ >>compiled ] keep ; : define-parser-word ( parser word -- ) - #! Return the body of the word that is the compiled version - #! of the parser. + ! Return the body of the word that is the compiled version + ! of the parser. 2dup swap peg>> (compile) ( -- result ) define-declared swap id>> "peg-id" set-word-prop ; : compile-parser ( parser -- word ) - #! Look to see if the given parser has been compiled. - #! If not, compile it to a temporary word, cache it, - #! and return it. Otherwise return the existing one. - #! Circular parsers are supported by getting the word - #! name and storing it in the cache, before compiling, - #! so it is picked up when re-entered. + ! Look to see if the given parser has been compiled. + ! If not, compile it to a temporary word, cache it, + ! and return it. Otherwise return the existing one. + ! Circular parsers are supported by getting the word + ! name and storing it in the cache, before compiling, + ! so it is picked up when re-entered. dup compiled>> [ nip ] [ @@ -289,8 +289,8 @@ GENERIC: (compile) ( peg -- quot ) SYMBOL: delayed : fixup-delayed ( -- ) - #! Work through all delayed parsers and recompile their - #! words to have the correct bodies. + ! Work through all delayed parsers and recompile their + ! words to have the correct bodies. delayed get [ call( -- parser ) compile-parser-quot ( -- result ) define-declared ] assoc-each ; @@ -314,13 +314,13 @@ SYMBOL: delayed f f f add-error ] [ @@ -503,18 +503,18 @@ M: sp-parser (compile) TUPLE: delay-parser quot ; M: delay-parser (compile) - #! For efficiency we memoize the quotation. - #! This way it is run only once and the - #! parser constructed once at run time. + ! For efficiency we memoize the quotation. + ! This way it is run only once and the + ! parser constructed once at run time. quot>> gensym [ delayed get set-at ] keep 1quotation ; TUPLE: box-parser quot ; M: box-parser (compile) - #! Calls the quotation at compile time - #! to produce the parser to be compiled. - #! This differs from 'delay' which calls - #! it at run time. + ! Calls the quotation at compile time + ! to produce the parser to be compiled. + ! This differs from 'delay' which calls + ! it at run time. quot>> call( -- parser ) compile-parser-quot ; PRIVATE> @@ -589,17 +589,17 @@ PRIVATE> delay-parser boa wrap-peg ; : box ( quot -- parser ) - #! because a box has its quotation run at compile time - #! it must always have a new parser wrapper created, - #! not a cached one. This is because the same box, - #! compiled twice can have a different compiled word - #! due to running at compile time. - #! Why the [ ] action at the end? Box parsers don't get - #! memoized during parsing due to all box parsers being - #! unique. This breaks left recursion detection during the - #! parse. The action adds an indirection with a parser type - #! that gets memoized and fixes this. Need to rethink how - #! to fix boxes so this isn't needed... + ! because a box has its quotation run at compile time + ! it must always have a new parser wrapper created, + ! not a cached one. This is because the same box, + ! compiled twice can have a different compiled word + ! due to running at compile time. + ! Why the [ ] action at the end? Box parsers don't get + ! memoized during parsing due to all box parsers being + ! unique. This breaks left recursion detection during the + ! parse. The action adds an indirection with a parser type + ! that gets memoized and fixes this. Need to rethink how + ! to fix boxes so this isn't needed... box-parser boa f next-id parser boa [ ] action ; ERROR: parse-failed input word ; diff --git a/basis/prettyprint/sections/sections.factor b/basis/prettyprint/sections/sections.factor index c1d39aaee5..581d6757f8 100644 --- a/basis/prettyprint/sections/sections.factor +++ b/basis/prettyprint/sections/sections.factor @@ -262,9 +262,9 @@ TUPLE: flow < block ; flow new-block ; M: flow short-section? ( section -- ? ) - #! If we can make room for this entire block by inserting - #! a newline, do it; otherwise, don't bother, print it as - #! a short section + ! If we can make room for this entire block by inserting + ! a newline, do it; otherwise, don't bother, print it as + ! a short section { [ section-fits? ] [ [ end>> 1 - ] [ start>> ] bi - text-fits? not ] diff --git a/basis/serialize/serialize.factor b/basis/serialize/serialize.factor index 31a17dfa5b..0d0c34431a 100644 --- a/basis/serialize/serialize.factor +++ b/basis/serialize/serialize.factor @@ -21,12 +21,12 @@ GENERIC: (serialize) ( obj -- ) SYMBOL: serialized : add-object ( obj -- ) - #! Add an object to the sequence of already serialized - #! objects. + ! Add an object to the sequence of already serialized + ! objects. serialized get [ assoc-size swap ] keep set-at ; : object-id ( obj -- id ) - #! Return the id of an already serialized object + ! Return the id of an already serialized object serialized get at ; ! Positive numbers are serialized as follows: @@ -231,8 +231,8 @@ SYMBOL: deserialized [ set-array-nth ] curry each-index ; : deserialize-tuple ( -- array ) - #! Ugly because we have to intern the tuple before reading - #! slots + ! Ugly because we have to intern the tuple before reading + ! slots (deserialize) new [ intern-object ] [ diff --git a/basis/smtp/server/server.factor b/basis/smtp/server/server.factor index b810c26dfb..d7fd1e361e 100644 --- a/basis/smtp/server/server.factor +++ b/basis/smtp/server/server.factor @@ -71,7 +71,7 @@ SYMBOL: data-mode } cond nip [ process ] when ; :: mock-smtp-server ( promise -- ) - #! Store the port we are running on in the promise. + ! Store the port we are running on in the promise. [ [ "127.0.0.1" 0 ascii [ diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor index 48ea2c1814..043d6d81dc 100644 --- a/basis/smtp/smtp.factor +++ b/basis/smtp/smtp.factor @@ -67,7 +67,7 @@ TUPLE: email ERROR: bad-email-address email ; : validate-address ( string -- string' ) - #! Make sure we send funky stuff to the server by accident. + ! Make sure we send funky stuff to the server by accident. dup "\r\n>" intersects? [ bad-email-address ] when ; diff --git a/basis/sorting/slots/slots.factor b/basis/sorting/slots/slots.factor index 43c05ee207..2ef95afa1b 100644 --- a/basis/sorting/slots/slots.factor +++ b/basis/sorting/slots/slots.factor @@ -10,7 +10,7 @@ IN: sorting.slots '[ _ execute( tuple -- value ) ] bi@ ; : compare-slots ( obj1 obj2 sort-specs -- <=> ) - #! sort-spec: { accessors comparator } + ! sort-spec: { accessors comparator } [ dup array? [ unclip-last-slice diff --git a/basis/soundex/soundex.factor b/basis/soundex/soundex.factor index 196fa7522c..91110b3b98 100644 --- a/basis/soundex/soundex.factor +++ b/basis/soundex/soundex.factor @@ -9,8 +9,8 @@ TR: soundex-tr "00000000111122222222334556" ; : remove-duplicates ( seq -- seq' ) - #! Remove _consecutive_ duplicates (unlike prune which removes - #! all duplicates). + ! Remove _consecutive_ duplicates (unlike prune which removes + ! all duplicates). [ 2 [ = ] assoc-reject values ] [ first ] bi prefix ; : first>upper ( seq -- seq' ) 1 head >upper ; diff --git a/basis/stack-checker/stack-checker.factor b/basis/stack-checker/stack-checker.factor index 9c016f037a..1bf75e7ec9 100644 --- a/basis/stack-checker/stack-checker.factor +++ b/basis/stack-checker/stack-checker.factor @@ -14,5 +14,5 @@ M: callable infer ( quot -- effect ) (infer) ; : infer. ( quot -- ) - #! Safe to call from inference transforms. + ! Safe to call from inference transforms. infer effect>string print ; diff --git a/basis/syndication/syndication-tests.factor b/basis/syndication/syndication-tests.factor index ce3fa93329..5e63aefd20 100644 --- a/basis/syndication/syndication-tests.factor +++ b/basis/syndication/syndication-tests.factor @@ -3,8 +3,8 @@ calendar urls xml.writer ; IN: syndication.tests : load-news-file ( filename -- feed ) - #! Load an news syndication file and process it, returning - #! it as an feed tuple. + ! Load an news syndication file and process it, returning + ! it as an feed tuple. binary file-contents parse-feed ; { T{ diff --git a/basis/syndication/syndication.factor b/basis/syndication/syndication.factor index 27f709dd10..86ab6db5fe 100644 --- a/basis/syndication/syndication.factor +++ b/basis/syndication/syndication.factor @@ -107,7 +107,7 @@ M: string parse-feed [ string>xml xml>feed ] with-html-entities ; M: byte-array parse-feed [ bytes>xml xml>feed ] with-html-entities ; : download-feed ( url -- feed ) - #! Retrieve an news syndication file, return as a feed tuple. + ! Retrieve an news syndication file, return as a feed tuple. http-get nip parse-feed ; ! Atom generation diff --git a/basis/tools/continuations/continuations.factor b/basis/tools/continuations/continuations.factor index 4d7c8fea55..4afe06f2fa 100644 --- a/basis/tools/continuations/continuations.factor +++ b/basis/tools/continuations/continuations.factor @@ -92,8 +92,8 @@ M: object add-breakpoint ; ] when ; inline : change-frame ( continuation quot -- continuation' ) - #! Applies quot to innermost call frame of the - #! continuation. + ! Applies quot to innermost call frame of the + ! continuation. [ clone ] dip '[ _ (change-frame) ] change-call ; inline PRIVATE> diff --git a/basis/tools/deploy/backend/backend.factor b/basis/tools/deploy/backend/backend.factor index 1523cd5f98..ccd2e0c6bf 100644 --- a/basis/tools/deploy/backend/backend.factor +++ b/basis/tools/deploy/backend/backend.factor @@ -45,7 +45,7 @@ ERROR: can't-deploy-library-file library ; utf8 [ copy-lines ] with-process-reader ; : make-boot-image ( -- ) - #! If stage1 image doesn't exist, create one. + ! If stage1 image doesn't exist, create one. my-boot-image-name resource-path exists? [ make-my-image ] unless ; diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 73a6e52188..b0c4a9e711 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -599,11 +599,11 @@ SYMBOL: deploy-vocab clear-megamorphic-caches ; : die-with ( error original-error -- * ) - #! We don't want DCE to drop the error before the die call! + ! We don't want DCE to drop the error before the die call! [ die 1 exit ] ( a -- * ) call-effect-unsafe ; : die-with2 ( error original-error -- * ) - #! We don't want DCE to drop the error before the die call! + ! We don't want DCE to drop the error before the die call! [ die 1 exit ] ( a b -- * ) call-effect-unsafe ; : deploy-error-handler ( quot -- ) @@ -617,8 +617,8 @@ SYMBOL: deploy-vocab ] recover ; inline : (deploy) ( final-image vocab-manifest-out vocab config -- ) - #! Does the actual work of a deployment in the slave - #! stage2 image + ! Does the actual work of a deployment in the slave + ! stage2 image [ [ strip-debugger? [ diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor index c1f68d3cd8..fb050e863c 100644 --- a/basis/ui/backend/cocoa/cocoa.factor +++ b/basis/ui/backend/cocoa/cocoa.factor @@ -80,9 +80,9 @@ M: pasteboard set-clipboard-contents [ 0 0 ] dip dim>> first2 ; : auto-position ( window loc -- ) - #! Note: if this is the initial window, the length of the windows - #! vector should be 1, since (open-window) calls auto-position - #! after register-window. + ! Note: if this is the initial window, the length of the windows + ! vector should be 1, since (open-window) calls auto-position + ! after register-window. dup { 0 0 } = [ drop ui-windows get-global length 1 <= [ -> center ] [ diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor index c38963e850..ab6b7add8e 100644 --- a/basis/ui/backend/cocoa/views/views.factor +++ b/basis/ui/backend/cocoa/views/views.factor @@ -16,7 +16,7 @@ IN: ui.backend.cocoa.views ! Issue #1453 : button ( event -- n ) - #! Cocoa -> Factor UI button mapping + ! Cocoa -> Factor UI button mapping -> buttonNumber { { 0 [ 1 ] } { 1 [ 3 ] } diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index b7cccae853..47da2ecaa7 100755 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -271,8 +271,8 @@ CONSTANT: window-control>ex-style [ get-RECT-top-left ] [ get-RECT-width/height ] bi ; : handle-wm-paint ( hWnd uMsg wParam lParam -- ) - #! wParam and lParam are unused - #! only paint if width/height both > 0 + ! wParam and lParam are unused + ! only paint if width/height both > 0 3drop window relayout-1 yield ; : handle-wm-size ( hWnd uMsg wParam lParam -- ) @@ -531,11 +531,11 @@ SYMBOL: nc-buttons wParam mouse-scroll hand-loc get-global hWnd window send-scroll ; : handle-wm-cancelmode ( hWnd uMsg wParam lParam -- ) - #! message sent if windows needs application to stop dragging + ! message sent if windows needs application to stop dragging 4drop release-capture ; : handle-wm-mouseleave ( hWnd uMsg wParam lParam -- ) - #! message sent if mouse leaves main application + ! message sent if mouse leaves main application 4drop forget-rollover ; : system-background-color ( -- color ) diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor index 36f7aa5ada..80e2bf3fe2 100644 --- a/basis/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -152,8 +152,8 @@ repeat-button H{ } set-gestures : ( label quot: ( button -- ) -- button ) - #! Button that calls the quotation every 100ms as long as - #! the mouse is held down. + ! Button that calls the quotation every 100ms as long as + ! the mouse is held down. repeat-button new-button border-button-theme ; >name ] when* style { diff --git a/basis/ui/gadgets/sliders/sliders.factor b/basis/ui/gadgets/sliders/sliders.factor index 0234c1ecca..27417563f0 100644 --- a/basis/ui/gadgets/sliders/sliders.factor +++ b/basis/ui/gadgets/sliders/sliders.factor @@ -49,9 +49,9 @@ CONSTANT: min-thumb-dim 30 [ elevator-length ] bi min ; : slider-scale ( slider -- n ) - #! A scaling factor such that if x is a slider co-ordinate, - #! x*n is the screen position of the thumb, and conversely - #! for x/n. The '1 max' calls avoid division by zero. + ! A scaling factor such that if x is a slider co-ordinate, + ! x*n is the screen position of the thumb, and conversely + ! for x/n. The '1 max' calls avoid division by zero. [ [ elevator-length ] [ thumb-dim ] bi - 1 max ] [ slider-length* 1 max ] bi / ; diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index f4b494fa3f..5cf40ee329 100644 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/basis/ui/gadgets/worlds/worlds.factor @@ -197,8 +197,8 @@ M: world draw-world* } cleave ; : draw-world? ( world -- ? ) - #! We don't draw deactivated worlds, or those with 0 size. - #! On Windows, the latter case results in GL errors. + ! We don't draw deactivated worlds, or those with 0 size. + ! On Windows, the latter case results in GL errors. { [ active?>> ] [ handle>> ] [ dim>> [ 0 > ] all? ] } 1&& ; TUPLE: world-error error world ; diff --git a/basis/ui/text/pango/pango.factor b/basis/ui/text/pango/pango.factor index 96f716870c..d9331000bb 100644 --- a/basis/ui/text/pango/pango.factor +++ b/basis/ui/text/pango/pango.factor @@ -67,13 +67,13 @@ SYMBOL: dpi layout>> 0 pango_layout_get_line_readonly ; : line-offset>x ( layout n -- x ) - #! n is an index into the UTF8 encoding of the text + ! n is an index into the UTF8 encoding of the text [ drop first-line ] [ swap string>> >utf8-index ] 2bi f { int } [ pango_layout_line_index_to_x ] with-out-parameters pango>float ; : x>line-offset ( layout x -- n ) - #! n is an index into the UTF8 encoding of the text + ! n is an index into the UTF8 encoding of the text [ [ first-line ] dip float>pango @@ -118,8 +118,8 @@ SYMBOL: dpi ] make-bitmap-image ; : escape-nulls ( str -- str' ) - #! Replace nulls with something else since Pango uses null-terminated - #! strings + ! Replace nulls with something else since Pango uses null-terminated + ! strings H{ { 0 CHAR: zero-width-no-break-space } } substitute ; : unpack-selection ( layout string/selection -- layout ) @@ -140,8 +140,8 @@ SYMBOL: dpi swap &g_object_unref layout-extents drop dim>> second ; MEMO: missing-font-metrics ( font -- metrics ) - #! Pango doesn't provide x-height and cap-height but Core Text does, so we - #! simulate them on Pango. + ! Pango doesn't provide x-height and cap-height but Core Text does, so we + ! simulate them on Pango. [ [ metrics new ] dip [ "x" glyph-height >>x-height ] diff --git a/basis/ui/tools/debugger/debugger.factor b/basis/ui/tools/debugger/debugger.factor index 893471ae28..765bed7841 100644 --- a/basis/ui/tools/debugger/debugger.factor +++ b/basis/ui/tools/debugger/debugger.factor @@ -57,7 +57,7 @@ M: debugger focusable-child* dup restart-hook>> [ restart-list>> ] [ drop t ] if ; : debugger-window ( error continuation -- ) - #! No restarts for the debugger window + ! No restarts for the debugger window f f "Error" open-status-window ; GENERIC: error-in-debugger? ( error -- ? ) diff --git a/basis/ui/tools/error-list/error-list.factor b/basis/ui/tools/error-list/error-list.factor index 17b38e354d..49ed22ad19 100644 --- a/basis/ui/tools/error-list/error-list.factor +++ b/basis/ui/tools/error-list/error-list.factor @@ -25,7 +25,7 @@ MEMO: error-icon ( type -- image-name ) [ swap add-gadget ] assoc-each ; : ( -- model gadget ) - #! Linkage errors are not shown by default. + ! Linkage errors are not shown by default. error-types get [ fatal?>> ] assoc-map [ [ [ error-icon ] dip ] assoc-map ] [ ] bi ; diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 8caa3361ca..df16ebfb8b 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -34,7 +34,7 @@ INSTANCE: interactor input-stream thread>> thread-continuation ; : interactor-busy? ( interactor -- ? ) - #! We're busy if there's no thread to resume. + ! We're busy if there's no thread to resume. { [ waiting>> ] [ thread>> dup [ thread-registered? ] when ] @@ -233,7 +233,7 @@ M: listener-gadget focusable-child* input>> dup popup>> or ; : wait-for-listener ( listener -- ) - #! Wait for the listener to start. + ! Wait for the listener to start. input>> flag>> wait-for-flag ; : listener-busy? ( listener -- ? ) @@ -420,7 +420,7 @@ interactor "completion" f { ] "Listener" spawn drop ; : restart-listener ( listener -- ) - #! Returns when listener is ready to receive input. + ! Returns when listener is ready to receive input. { [ com-end ] [ clear-output ] diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index 580ff3936f..796a2d39f6 100644 --- a/basis/ui/ui.factor +++ b/basis/ui/ui.factor @@ -17,12 +17,12 @@ SYMBOL: ui-windows : window ( handle -- world ) ui-windows get-global at ; : register-window ( world handle -- ) - #! Add the new window just below the topmost window. Why? - #! So that if the new window doesn't actually receive focus - #! (eg, we're using focus follows mouse and the mouse is not - #! in the new window when it appears) Factor doesn't get - #! confused and send workspace operations to the new window, - #! etc. + ! Add the new window just below the topmost window. Why? + ! So that if the new window doesn't actually receive focus + ! (eg, we're using focus follows mouse and the mouse is not + ! in the new window when it appears) Factor doesn't get + ! confused and send workspace operations to the new window, + ! etc. swap 2array ui-windows get-global push ui-windows get-global dup length 1 > [ [ length 1 - dup 1 - ] keep exchange ] [ drop ] if ; @@ -156,10 +156,10 @@ PRIVATE> [ dup vocab-prefix? [ name>> ] when ] map ; : remove-redundant-prefixes ( seq -- seq' ) - #! Hack. + ! Hack. [ vocab-prefix? ] partition [ [ vocab-name ] map fast-set diff --git a/basis/vocabs/refresh/monitor/monitor.factor b/basis/vocabs/refresh/monitor/monitor.factor index 2320fc4a04..13e1e7beb3 100644 --- a/basis/vocabs/refresh/monitor/monitor.factor +++ b/basis/vocabs/refresh/monitor/monitor.factor @@ -29,8 +29,8 @@ TR: convert-separators "/\\" ".." ; chop-vocab-root path>vocab-name vocab-dir>vocab-name ; : monitor-loop ( monitor -- ) - #! On OS X, monitors give us the full path, so we chop it - #! off if its there. + ! On OS X, monitors give us the full path, so we chop it + ! off if its there. [ next-change path>> path>vocab [ changed-vocab ] [ reset-cache ] bi diff --git a/basis/windows/privileges/privileges.factor b/basis/windows/privileges/privileges.factor index 49c3a2dd24..e04dfa016a 100644 --- a/basis/windows/privileges/privileges.factor +++ b/basis/windows/privileges/privileges.factor @@ -18,11 +18,11 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES with-out-parameters ; : open-process-token ( -- handle ) - #! remember to CloseHandle + ! remember to CloseHandle GetCurrentProcess (open-process-token) ; : with-process-token ( quot -- ) - #! quot: ( token-handle -- token-handle ) + ! quot: ( token-handle -- token-handle ) [ open-process-token ] dip [ keep ] curry [ CloseHandle drop ] [ ] cleanup ; inline diff --git a/basis/windows/time/time.factor b/basis/windows/time/time.factor index 79c404fc2d..dea0e7de40 100644 --- a/basis/windows/time/time.factor +++ b/basis/windows/time/time.factor @@ -21,7 +21,7 @@ IN: windows.time FILETIME>windows-time ; : timestamp>windows-time ( timestamp -- n ) - #! 64bit number representing # of nanoseconds since Jan 1, 1601 (UTC) + ! 64bit number representing # of nanoseconds since Jan 1, 1601 (UTC) >gmt windows-1601 (time-) 10,000,000 * >integer ; : windows-time>FILETIME ( n -- FILETIME ) diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor index 6013169509..f105c07144 100644 --- a/basis/windows/winsock/winsock.factor +++ b/basis/windows/winsock/winsock.factor @@ -436,7 +436,7 @@ ERROR: winsock-exception n string ; ${ ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING } member? ; : (maybe-winsock-exception) ( n -- winsock-exception/f ) - ! #! WSAStartup returns the error code 'n' directly + ! ! WSAStartup returns the error code 'n' directly dup winsock-expected-error? [ drop f ] [ [ ] [ n>win32-error-string ] bi \ winsock-exception boa ] if ; diff --git a/basis/xml/elements/elements.factor b/basis/xml/elements/elements.factor index 900b59b1a7..8fcc19c540 100644 --- a/basis/xml/elements/elements.factor +++ b/basis/xml/elements/elements.factor @@ -18,7 +18,7 @@ IN: xml.elements [ quoteless-attr ] take-interpolated ; : start-tag ( -- name ? ) - #! Outputs the name and whether this is a closing tag + ! Outputs the name and whether this is a closing tag get-char CHAR: / eq? dup [ next ] when parse-name swap ; diff --git a/basis/xml/entities/entities.factor b/basis/xml/entities/entities.factor index cb1697bb3d..9213a2f922 100644 --- a/basis/xml/entities/entities.factor +++ b/basis/xml/entities/entities.factor @@ -20,7 +20,7 @@ CONSTANT: quoted-entities-out } : escape-string-by ( str table -- escaped ) - #! Convert <, >, &, ' and " to HTML entities. + ! Convert <, >, &, ' and " to HTML entities. [ '[ dup _ at [ % ] [ , ] ?if ] each ] "" make ; : escape-string ( str -- newstr ) diff --git a/basis/xml/tokenize/tokenize.factor b/basis/xml/tokenize/tokenize.factor index 660cbeaf36..0d04064022 100644 --- a/basis/xml/tokenize/tokenize.factor +++ b/basis/xml/tokenize/tokenize.factor @@ -72,9 +72,9 @@ HINTS: next* { spot } ; spot get (skip-until) ; inline : take-until ( ... quot: ( ... char -- ... ? ) -- ... string ) - #! Take the substring of a string starting at spot - #! from code until the quotation given is true and - #! advance spot to after the substring. + ! Take the substring of a string starting at spot + ! from code until the quotation given is true and + ! advance spot to after the substring. 10 [ '[ _ keep over [ drop ] [ _ push ] if ] skip-until ] keep "" like ; inline @@ -83,7 +83,7 @@ HINTS: next* { spot } ; '[ _ member? ] take-until ; inline : pass-blank ( -- ) - #! Advance code past any whitespace, including newlines + ! Advance code past any whitespace, including newlines [ blank? not ] skip-until ; : next-matching ( pos ch str -- pos' ) diff --git a/core/byte-vectors/byte-vectors.factor b/core/byte-vectors/byte-vectors.factor index 815ecbc53c..b53fd3866d 100644 --- a/core/byte-vectors/byte-vectors.factor +++ b/core/byte-vectors/byte-vectors.factor @@ -29,10 +29,10 @@ M: byte-vector equal? M: byte-vector contract 2drop ; inline M: byte-array like - #! If we have an byte-array, we're done. - #! If we have a byte-vector, and it's at full capacity, - #! we're done. Otherwise, call resize-byte-array, which is a - #! relatively fast primitive. + ! If we have an byte-array, we're done. + ! If we have a byte-vector, and it's at full capacity, + ! we're done. Otherwise, call resize-byte-array, which is a + ! relatively fast primitive. drop dup byte-array? [ dup byte-vector? [ [ length ] [ underlying>> ] bi diff --git a/core/checksums/checksums.factor b/core/checksums/checksums.factor index d89b7a744a..ce1c2a81d5 100644 --- a/core/checksums/checksums.factor +++ b/core/checksums/checksums.factor @@ -58,9 +58,9 @@ M: checksum checksum-lines [ B{ CHAR: \n } join ] dip checksum-bytes ; : checksum-file ( path checksum -- value ) - #! normalize-path (file-reader) is equivalent to - #! binary . We use the lower-level form - #! so that we can move io.encodings.binary to basis/. + ! normalize-path (file-reader) is equivalent to + ! binary . We use the lower-level form + ! so that we can move io.encodings.binary to basis/. [ normalize-path (file-reader) ] dip checksum-stream ; : hex-string ( seq -- str ) diff --git a/core/classes/classes.factor b/core/classes/classes.factor index 8c65a5d10b..f4623225b4 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -114,11 +114,11 @@ M: predicate reset-word swap superclass-of? ; : class-members ( class -- seq ) - #! Output f for non-classes to work with algebra code + ! Output f for non-classes to work with algebra code dup class? [ "members" word-prop ] [ drop f ] if ; : class-participants ( class -- seq ) - #! Output f for non-classes to work with algebra code + ! Output f for non-classes to work with algebra code dup class? [ "participants" word-prop ] [ drop f ] if ; GENERIC: implementors ( class/classes -- seq ) diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index bacb34a385..93bb8e2190 100644 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -41,11 +41,11 @@ ERROR: check-mixin-class-error class ; swap redefine-mixin-class ; inline : (add-mixin-instance) ( class mixin -- ) - #! Call update-methods before adding the member: - #! - Call sites of generics specializing on 'mixin' - #! where the inferred type is 'class' are updated, - #! - Call sites where the inferred type is a subtype - #! of 'mixin' disjoint from 'class' are not updated + ! Call update-methods before adding the member: + ! - Call sites of generics specializing on 'mixin' + ! where the inferred type is 'class' are updated, + ! - Call sites where the inferred type is a subtype + ! of 'mixin' disjoint from 'class' are not updated dup class-usages { [ nip update-methods ] [ drop [ suffix ] change-mixin-class ] @@ -54,11 +54,11 @@ ERROR: check-mixin-class-error class ; } 3cleave ; : (remove-mixin-instance) ( class mixin -- ) - #! Call update-methods after removing the member: - #! - Call sites of generics specializing on 'mixin' - #! where the inferred type is 'class' are updated, - #! - Call sites where the inferred type is a subtype - #! of 'mixin' disjoint from 'class' are not updated + ! Call update-methods after removing the member: + ! - Call sites of generics specializing on 'mixin' + ! where the inferred type is 'class' are updated, + ! - Call sites where the inferred type is a subtype + ! of 'mixin' disjoint from 'class' are not updated dup class-usages { [ drop [ swap remove ] change-mixin-class ] [ drop "instances" word-prop delete-at ] diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 7ad2d456e4..77993bba20 100644 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -133,7 +133,7 @@ M: object final-class? drop f ; ( methods -- engine ) diff --git a/core/generic/standard/standard-tests.factor b/core/generic/standard/standard-tests.factor index 888ce933d8..f194ac1959 100644 --- a/core/generic/standard/standard-tests.factor +++ b/core/generic/standard/standard-tests.factor @@ -285,7 +285,7 @@ TUPLE: ceo < executive ; GENERIC: salary ( person -- n ) M: intern salary - #! Intentional mistake. + ! Intentional mistake. call-next-method ; M: employee salary drop 24000 ; @@ -299,7 +299,7 @@ M: senior-manager salary call-next-method 15000 + ; M: executive salary call-next-method 2 * ; M: ceo salary - #! Intentional error. + ! Intentional error. drop 5 call-next-method 3 * ; [ salary ] must-infer diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index 0a7b8ef6c8..e097b2a552 100644 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -50,9 +50,9 @@ M: standard-generic effective-method [ [ literalize , ] [ , ] [ combination get #>> , { } , , ] tri* ] [ ] make ; M: standard-combination inline-cache-quots - #! Direct calls to the generic word (not tail calls or indirect calls) - #! will jump to the inline cache entry point instead of the megamorphic - #! dispatch entry point. + ! Direct calls to the generic word (not tail calls or indirect calls) + ! will jump to the inline cache entry point instead of the megamorphic + ! dispatch entry point. [ \ inline-cache-miss inline-cache-quot ] [ \ inline-cache-miss-tail inline-cache-quot ] 2bi ; diff --git a/core/io/io.factor b/core/io/io.factor index bad3551c4d..fc804f0680 100644 --- a/core/io/io.factor +++ b/core/io/io.factor @@ -86,9 +86,9 @@ SYMBOL: error-stream swapd [ with-output-stream* ] curry with-input-stream* ; inline : with-streams ( input output quot -- ) - #! We have to dispose of the output stream first, so that - #! if both streams point to the same FD, we get to flush the - #! buffer before closing the FD. + ! We have to dispose of the output stream first, so that + ! if both streams point to the same FD, we get to flush the + ! buffer before closing the FD. swapd [ with-output-stream ] curry with-input-stream ; inline : with-input-output+error-streams* ( input output+error quot -- ) diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index 455b1176a3..8dc14ef55f 100644 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -93,10 +93,10 @@ M: c-io-backend (file-appender) "ab" fopen ; : show ( msg -- ) - #! A word which directly calls primitives. It is used to - #! print stuff from contexts where the I/O system would - #! otherwise not work (tools.deploy.shaker, the I/O - #! multiplexer thread). + ! A word which directly calls primitives. It is used to + ! print stuff from contexts where the I/O system would + ! otherwise not work (tools.deploy.shaker, the I/O + ! multiplexer thread). "\n" append >byte-array dup length stdout-handle fwrite stdout-handle fflush ; diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index bf81876367..c38206198c 100644 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -78,9 +78,9 @@ GENERIC: execute ( word -- ) DEFER: if : ? ( ? true false -- true/false ) - #! 'if' and '?' can be defined in terms of each other - #! because the JIT special-cases an 'if' preceeded by - #! two literal quotations. + ! 'if' and '?' can be defined in terms of each other + ! because the JIT special-cases an 'if' preceeded by + ! two literal quotations. rot [ drop ] [ nip ] if ; inline : if ( ..a ? true: ( ..a -- ..b ) false: ( ..a -- ..b ) -- ..b ) ? call ; diff --git a/core/math/math.factor b/core/math/math.factor index ecf3e43001..92d8326b5c 100644 --- a/core/math/math.factor +++ b/core/math/math.factor @@ -252,7 +252,7 @@ GENERIC: prev-float ( m -- n ) : if-iterate? ( i n true false -- ) [ 2over < ] 2dip if ; inline : iterate-step ( i n quot -- i n quot ) - #! Apply quot to i, keep i and quot, hide n. + ! Apply quot to i, keep i and quot, hide n. [ nip call ] 3keep ; inline : iterate-rot ( ? i n quot -- i n quot ? ) diff --git a/core/math/order/order.factor b/core/math/order/order.factor index 4598d19d35..e26260bc8d 100644 --- a/core/math/order/order.factor +++ b/core/math/order/order.factor @@ -8,7 +8,7 @@ SYMBOL: +eq+ SYMBOL: +gt+ : invert-comparison ( <=> -- >=< ) - #! Can't use case, index or nth here + ! Can't use case, index or nth here dup +lt+ eq? [ drop +gt+ ] [ +eq+ eq? +eq+ +lt+ ? ] if ; GENERIC: <=> ( obj1 obj2 -- <=> ) diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 1bda0e48f7..9b9900f4d6 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -193,8 +193,8 @@ print-use-hook [ [ ] ] initialize filter-moved [ class? ] filter [ forget-class ] each ; : fix-class-words ( -- ) - #! If a class word had a compound definition which was - #! removed, it must go back to being a symbol. + ! If a class word had a compound definition which was + ! removed, it must go back to being a symbol. new-definitions get first2 filter-moved [ [ reset-generic ] [ define-symbol ] bi ] each ; diff --git a/core/sbufs/sbufs.factor b/core/sbufs/sbufs.factor index d90ae75108..b1118bd815 100644 --- a/core/sbufs/sbufs.factor +++ b/core/sbufs/sbufs.factor @@ -34,10 +34,10 @@ M: string new-resizable drop ; inline M: sbuf new-resizable drop ; inline M: string like - #! If we have a string, we're done. - #! If we have an sbuf, and it's at full capacity, we're done. - #! Otherwise, call resize-string, which is a relatively - #! fast primitive. + ! If we have a string, we're done. + ! If we have an sbuf, and it's at full capacity, we're done. + ! Otherwise, call resize-string, which is a relatively + ! fast primitive. drop dup string? [ dup sbuf? [ [ length ] [ underlying>> ] bi diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index a2ab3ee8e2..ba98a0ae56 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -926,8 +926,8 @@ PRIVATE> [ nth2-unsafe ] [ [ 2 + ] dip nth-unsafe ] 2bi ; inline : (binary-reduce) ( seq start quot: ( elt1 elt2 -- newelt ) from length -- value ) - #! We can't use case here since combinators depends on - #! sequences + ! We can't use case here since combinators depends on + ! sequences dup 4 < [ integer>fixnum { [ 2drop nip ] diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor index 2575ea686f..415ea711eb 100644 --- a/core/source-files/source-files.factor +++ b/core/source-files/source-files.factor @@ -67,7 +67,7 @@ SYMBOL: current-source-file swap >>error rethrow ; : with-source-file ( name quot -- ) - #! Should be called from inside with-compilation-unit. + ! Should be called from inside with-compilation-unit. [ [ path>source-file diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 97d3cdcdac..386a65dd78 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -29,7 +29,7 @@ $nl ARTICLE: "syntax-comments" "Comments" { $subsections POSTPONE: ! - POSTPONE: #! + POSTPONE: ! } ; ARTICLE: "syntax-immediate" "Parse time evaluation" @@ -664,9 +664,9 @@ HELP: ! { $values { "comment" "characters" } } { $description "Discards all input until the end of the line." } ; -{ POSTPONE: ! POSTPONE: #! } related-words +{ POSTPONE: ! POSTPONE: ! } related-words -HELP: #! +HELP: ! { $syntax "#!comment..." } { $values { "comment" "characters" } } { $description "Discards all input until the end of the line." } diff --git a/core/vectors/vectors.factor b/core/vectors/vectors.factor index 27cd1cf734..403cc63384 100644 --- a/core/vectors/vectors.factor +++ b/core/vectors/vectors.factor @@ -24,10 +24,10 @@ M: vector equal? over vector? [ sequence= ] [ 2drop f ] if ; M: array like - #! If we have an array, we're done. - #! If we have a vector, and it's at full capacity, we're done. - #! Otherwise, call resize-array, which is a relatively - #! fast primitive. + ! If we have an array, we're done. + ! If we have a vector, and it's at full capacity, we're done. + ! Otherwise, call resize-array, which is a relatively + ! fast primitive. drop dup array? [ dup vector? [ [ length ] [ underlying>> ] bi diff --git a/core/words/words.factor b/core/words/words.factor index 5b4e1f871f..71126cf933 100644 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -61,9 +61,9 @@ TUPLE: undefined-word word ; : undefined ( -- * ) get-callstack caller undefined-word boa throw ; : undefined-def ( -- quot ) - #! 'f' inhibits tail call optimization in non-optimizing - #! compiler, ensuring that we can pull out the caller word - #! above. + ! 'f' inhibits tail call optimization in non-optimizing + ! compiler, ensuring that we can pull out the caller word + ! above. [ undefined f ] ; PREDICATE: deferred < word def>> undefined-def = ; diff --git a/extra/audio/vorbis/vorbis.factor b/extra/audio/vorbis/vorbis.factor index d8036b4ee0..b8ab44773b 100644 --- a/extra/audio/vorbis/vorbis.factor +++ b/extra/audio/vorbis/vorbis.factor @@ -40,8 +40,8 @@ ERROR: no-vorbis-in-ogg ; stream-buffer-size ; inline : read-bytes-into ( dest size stream -- len ) - #! Read the given number of bytes from a stream - #! and store them in the destination byte array. + ! Read the given number of bytes from a stream + ! and store them in the destination byte array. stream-read >byte-array dup length [ memcpy ] keep ; : stream-into-buffer ( buffer size vorbis-stream -- len ) diff --git a/extra/benchmark/backtrack/backtrack.factor b/extra/benchmark/backtrack/backtrack.factor index 6ab2326061..b4bec779b1 100644 --- a/extra/benchmark/backtrack/backtrack.factor +++ b/extra/benchmark/backtrack/backtrack.factor @@ -16,7 +16,7 @@ IN: benchmark.backtrack { + - * } amb-execute ; : some-rots ( a b c -- a b c ) - #! Try to rot 0, 1 or 2 times. + ! Try to rot 0, 1 or 2 times. { nop rot -rot } amb-execute ; MEMO: 24-from-1 ( a -- ? ) diff --git a/extra/benchmark/fannkuch/fannkuch.factor b/extra/benchmark/fannkuch/fannkuch.factor index 218aa9fd2a..a81990aa3b 100644 --- a/extra/benchmark/fannkuch/fannkuch.factor +++ b/extra/benchmark/fannkuch/fannkuch.factor @@ -5,8 +5,8 @@ io prettyprint ; IN: benchmark.fannkuch : count ( quot: ( -- ? ) -- n ) - #! Call quot until it returns false, return number of times - #! it was true + ! Call quot until it returns false, return number of times + ! it was true [ 0 ] dip '[ _ dip swap [ [ 1 + ] when ] keep ] loop ; inline : count-flips ( perm -- flip# ) diff --git a/extra/benchmark/raytracer/raytracer.factor b/extra/benchmark/raytracer/raytracer.factor index 4ecc0a6a0a..c246f1538f 100644 --- a/extra/benchmark/raytracer/raytracer.factor +++ b/extra/benchmark/raytracer/raytracer.factor @@ -66,7 +66,7 @@ C: sphere dup 0.0 < [ 3drop 1/0. ] [ sqrt sphere-t nip ] if ; inline : if-ray-sphere ( hit ray sphere quot -- hit ) - #! quot: hit ray sphere l -- hit + ! quot: hit ray sphere l -- hit [ [ ] [ swap ray-sphere nip ] [ 2drop lambda>> ] 3tri [ drop ] [ < ] 2bi diff --git a/extra/coroutines/coroutines.factor b/extra/coroutines/coroutines.factor index 3038fea869..eec83525e9 100644 --- a/extra/coroutines/coroutines.factor +++ b/extra/coroutines/coroutines.factor @@ -21,9 +21,9 @@ TUPLE: coroutine resumecc exitcc originalcc ; [ >>exitcc resumecc>> call( -- ) - #! At this point, the coroutine quotation must have terminated - #! normally (without calling coyield, coreset, or coterminate). - #! This shouldn't happen. + ! At this point, the coroutine quotation must have terminated + ! normally (without calling coyield, coreset, or coterminate). + ! This shouldn't happen. f over ] callcc1 2nip ; diff --git a/extra/cpu/8080/emulator/emulator.factor b/extra/cpu/8080/emulator/emulator.factor index 1d48355f04..9aab8af27b 100644 --- a/extra/cpu/8080/emulator/emulator.factor +++ b/extra/cpu/8080/emulator/emulator.factor @@ -18,13 +18,13 @@ M: cpu update-video 3drop ; M: cpu read-port - #! Read a byte from the hardware port. 'port' should - #! be an 8-bit value. + ! Read a byte from the hardware port. 'port' should + ! be an 8-bit value. 2drop 0 ; M: cpu write-port - #! Write a byte to the hardware port, where 'port' is - #! an 8-bit value. + ! Write a byte to the hardware port, where 'port' is + ! an 8-bit value. 3drop ; CONSTANT: carry-flag 0x01 @@ -35,39 +35,39 @@ CONSTANT: zero-flag 0x40 CONSTANT: sign-flag 0x80 : >word< ( word -- byte byte ) - #! Explode a word into its two 8 bit values. + ! Explode a word into its two 8 bit values. dup 0xFF bitand swap -8 shift 0xFF bitand swap ; : af>> ( cpu -- word ) - #! Return the 16-bit pseudo register AF. + ! Return the 16-bit pseudo register AF. [ a>> 8 shift ] keep f>> bitor ; : af<< ( value cpu -- ) - #! Set the value of the 16-bit pseudo register AF + ! Set the value of the 16-bit pseudo register AF [ >word< ] dip swap >>f swap >>a drop ; : bc>> ( cpu -- word ) - #! Return the 16-bit pseudo register BC. + ! Return the 16-bit pseudo register BC. [ b>> 8 shift ] keep c>> bitor ; : bc<< ( value cpu -- ) - #! Set the value of the 16-bit pseudo register BC + ! Set the value of the 16-bit pseudo register BC [ >word< ] dip swap >>c swap >>b drop ; : de>> ( cpu -- word ) - #! Return the 16-bit pseudo register DE. + ! Return the 16-bit pseudo register DE. [ d>> 8 shift ] keep e>> bitor ; : de<< ( value cpu -- ) - #! Set the value of the 16-bit pseudo register DE + ! Set the value of the 16-bit pseudo register DE [ >word< ] dip swap >>e swap >>d drop ; : hl>> ( cpu -- word ) - #! Return the 16-bit pseudo register HL. + ! Return the 16-bit pseudo register HL. [ h>> 8 shift ] keep l>> bitor ; : hl<< ( value cpu -- ) - #! Set the value of the 16-bit pseudo register HL + ! Set the value of the 16-bit pseudo register HL [ >word< ] dip swap >>l swap >>h drop ; : flag-set? ( flag cpu -- bool ) @@ -77,41 +77,41 @@ CONSTANT: sign-flag 0x80 f>> bitand 0 = ; : flag-nz? ( cpu -- bool ) - #! Test flag status + ! Test flag status f>> zero-flag bitand 0 = ; : flag-z? ( cpu -- bool ) - #! Test flag status + ! Test flag status f>> zero-flag bitand 0 = not ; : flag-nc? ( cpu -- bool ) - #! Test flag status + ! Test flag status f>> carry-flag bitand 0 = ; : flag-c? ( cpu -- bool ) - #! Test flag status + ! Test flag status f>> carry-flag bitand 0 = not ; : flag-po? ( cpu -- bool ) - #! Test flag status + ! Test flag status f>> parity-flag bitand 0 = ; : flag-pe? ( cpu -- bool ) - #! Test flag status + ! Test flag status f>> parity-flag bitand 0 = not ; : flag-p? ( cpu -- bool ) - #! Test flag status + ! Test flag status f>> sign-flag bitand 0 = ; : flag-m? ( cpu -- bool ) - #! Test flag status + ! Test flag status f>> sign-flag bitand 0 = not ; : read-byte ( addr cpu -- byte ) - #! Read one byte from memory at the specified address. - #! The address is 16-bit, but if a value greater than - #! 0xFFFF is provided then return a default value. + ! Read one byte from memory at the specified address. + ! The address is 16-bit, but if a value greater than + ! 0xFFFF is provided then return a default value. over 0xFFFF <= [ ram>> nth ] [ @@ -119,13 +119,13 @@ CONSTANT: sign-flag 0x80 ] if ; : read-word ( addr cpu -- word ) - #! Read a 16-bit word from memory at the specified address. - #! The address is 16-bit, but if a value greater than - #! 0xFFFF is provided then return a default value. + ! Read a 16-bit word from memory at the specified address. + ! The address is 16-bit, but if a value greater than + ! 0xFFFF is provided then return a default value. [ read-byte ] 2keep [ 1 + ] dip read-byte 8 shift bitor ; : next-byte ( cpu -- byte ) - #! Return the value of the byte at PC, and increment PC. + ! Return the value of the byte at PC, and increment PC. { [ pc>> ] [ read-byte ] @@ -134,7 +134,7 @@ CONSTANT: sign-flag 0x80 } cleave ; : next-word ( cpu -- word ) - #! Return the value of the word at PC, and increment PC. + ! Return the value of the word at PC, and increment PC. [ pc>> ] keep [ read-word ] keep [ pc>> 2 + ] keep @@ -142,7 +142,7 @@ CONSTANT: sign-flag 0x80 : write-byte ( value addr cpu -- ) - #! Write a byte to the specified memory address. + ! Write a byte to the specified memory address. over dup 0x2000 < swap 0xFFFF > or [ 3drop ] [ @@ -152,47 +152,47 @@ CONSTANT: sign-flag 0x80 : write-word ( value addr cpu -- ) - #! Write a 16-bit word to the specified memory address. + ! Write a 16-bit word to the specified memory address. [ >word< ] 2dip [ write-byte ] 2keep [ 1 + ] dip write-byte ; : cpu-a-bitand ( quot cpu -- ) - #! A &= quot call + ! A &= quot call [ a>> swap call bitand ] keep a<< ; inline : cpu-a-bitor ( quot cpu -- ) - #! A |= quot call + ! A |= quot call [ a>> swap call bitor ] keep a<< ; inline : cpu-a-bitxor ( quot cpu -- ) - #! A ^= quot call + ! A ^= quot call [ a>> swap call bitxor ] keep a<< ; inline : cpu-a-bitxor= ( value cpu -- ) - #! cpu-a ^= value + ! cpu-a ^= value [ a>> bitxor ] keep a<< ; : cpu-f-bitand ( quot cpu -- ) - #! F &= quot call + ! F &= quot call [ f>> swap call bitand ] keep f<< ; inline : cpu-f-bitor ( quot cpu -- ) - #! F |= quot call + ! F |= quot call [ f>> swap call bitor ] keep f<< ; inline : cpu-f-bitxor ( quot cpu -- ) - #! F |= quot call + ! F |= quot call [ f>> swap call bitxor ] keep f<< ; inline : cpu-f-bitor= ( value cpu -- ) - #! cpu-f |= value + ! cpu-f |= value [ f>> bitor ] keep f<< ; : cpu-f-bitand= ( value cpu -- ) - #! cpu-f &= value + ! cpu-f &= value [ f>> bitand ] keep f<< ; : cpu-f-bitxor= ( value cpu -- ) - #! cpu-f ^= value + ! cpu-f ^= value [ f>> bitxor ] keep f<< ; : set-flag ( cpu flag -- ) @@ -202,42 +202,42 @@ CONSTANT: sign-flag 0x80 bitnot 0xFF bitand swap cpu-f-bitand= ; : update-zero-flag ( result cpu -- ) - #! If the result of an instruction has the value 0, this - #! flag is set, otherwise it is reset. + ! If the result of an instruction has the value 0, this + ! flag is set, otherwise it is reset. swap 0xFF bitand 0 = [ zero-flag set-flag ] [ zero-flag clear-flag ] if ; : update-sign-flag ( result cpu -- ) - #! If the most significant bit of the result - #! has the value 1 then the flag is set, otherwise - #! it is reset. + ! If the most significant bit of the result + ! has the value 1 then the flag is set, otherwise + ! it is reset. swap 0x80 bitand 0 = [ sign-flag clear-flag ] [ sign-flag set-flag ] if ; : update-parity-flag ( result cpu -- ) - #! If the modulo 2 sum of the bits of the result - #! is 0, (ie. if the result has even parity) this flag - #! is set, otherwise it is reset. + ! If the modulo 2 sum of the bits of the result + ! is 0, (ie. if the result has even parity) this flag + ! is set, otherwise it is reset. swap 0xFF bitand 2 mod 0 = [ parity-flag set-flag ] [ parity-flag clear-flag ] if ; : update-carry-flag ( result cpu -- ) - #! If the instruction resulted in a carry (from addition) - #! or a borrow (from subtraction or a comparison) out of the - #! higher order bit, this flag is set, otherwise it is reset. + ! If the instruction resulted in a carry (from addition) + ! or a borrow (from subtraction or a comparison) out of the + ! higher order bit, this flag is set, otherwise it is reset. swap dup 0x100 >= swap 0 < or [ carry-flag set-flag ] [ carry-flag clear-flag ] if ; : update-half-carry-flag ( original change-by result cpu -- ) - #! If the instruction caused a carry out of bit 3 and into bit 4 of the - #! resulting value, the half carry flag is set, otherwise it is reset. - #! The 'original' is the original value of the register being changed. - #! 'change-by' is the amount it is being added or decremented by. - #! 'result' is the result of that change. + ! If the instruction caused a carry out of bit 3 and into bit 4 of the + ! resulting value, the half carry flag is set, otherwise it is reset. + ! The 'original' is the original value of the register being changed. + ! 'change-by' is the amount it is being added or decremented by. + ! 'result' is the result of that change. [ bitxor bitxor 0x10 bitand 0 = not ] dip swap [ half-carry-flag set-flag ] [ half-carry-flag clear-flag ] if ; @@ -256,18 +256,18 @@ CONSTANT: sign-flag 0x80 [ update-zero-flag ] 2tri ; : add-byte ( lhs rhs cpu -- result ) - #! Add rhs to lhs + ! Add rhs to lhs [ 2dup + ] dip [ update-flags ] 2keep [ update-half-carry-flag ] 2keep drop 0xFF bitand ; : add-carry ( change-by result cpu -- change-by result ) - #! Add the effect of the carry flag to the result + ! Add the effect of the carry flag to the result flag-c? [ 1 + [ 1 + ] dip ] when ; : add-byte-with-carry ( lhs rhs cpu -- result ) - #! Add rhs to lhs plus carry. + ! Add rhs to lhs plus carry. [ 2dup + ] dip [ add-carry ] keep [ update-flags ] 2keep @@ -275,18 +275,18 @@ CONSTANT: sign-flag 0x80 drop 0xFF bitand ; : sub-carry ( change-by result cpu -- change-by result ) - #! Subtract the effect of the carry flag from the result + ! Subtract the effect of the carry flag from the result flag-c? [ 1 - [ 1 - ] dip ] when ; : sub-byte ( lhs rhs cpu -- result ) - #! Subtract rhs from lhs + ! Subtract rhs from lhs [ 2dup - ] dip [ update-flags ] 2keep [ update-half-carry-flag ] 2keep drop 0xFF bitand ; : sub-byte-with-carry ( lhs rhs cpu -- result ) - #! Subtract rhs from lhs and take carry into account + ! Subtract rhs from lhs and take carry into account [ 2dup - ] dip [ sub-carry ] keep [ update-flags ] 2keep @@ -294,41 +294,41 @@ CONSTANT: sign-flag 0x80 drop 0xFF bitand ; : inc-byte ( byte cpu -- result ) - #! Increment byte by one. Note that carry flag is not affected - #! by this operation. + ! Increment byte by one. Note that carry flag is not affected + ! by this operation. [ 1 2dup + ] dip [ update-flags-no-carry ] 2keep [ update-half-carry-flag ] 2keep drop 0xFF bitand ; : dec-byte ( byte cpu -- result ) - #! Decrement byte by one. Note that carry flag is not affected - #! by this operation. + ! Decrement byte by one. Note that carry flag is not affected + ! by this operation. [ 1 2dup - ] dip [ update-flags-no-carry ] 2keep [ update-half-carry-flag ] 2keep drop 0xFF bitand ; : inc-word ( w cpu -- w ) - #! Increment word by one. Note that no flags are modified. + ! Increment word by one. Note that no flags are modified. drop 1 + 0xFFFF bitand ; : dec-word ( w cpu -- w ) - #! Decrement word by one. Note that no flags are modified. + ! Decrement word by one. Note that no flags are modified. drop 1 - 0xFFFF bitand ; : add-word ( lhs rhs cpu -- result ) - #! Add rhs to lhs. Note that only the carry flag is modified - #! and only if there is a carry out of the double precision add. + ! Add rhs to lhs. Note that only the carry flag is modified + ! and only if there is a carry out of the double precision add. [ + ] dip over 0xFFFF > [ carry-flag set-flag ] [ drop ] if 0xFFFF bitand ; : bit3or ( lhs rhs -- 0|1 ) - #! bitor bit 3 of the two numbers on the stack + ! bitor bit 3 of the two numbers on the stack [ 0b00001000 bitand -3 shift ] bi@ bitor ; : and-byte ( lhs rhs cpu -- result ) - #! Logically and rhs to lhs. The carry flag is cleared and - #! the half carry is set to the ORing of bits 3 of the operands. + ! Logically and rhs to lhs. The carry flag is cleared and + ! the half carry is set to the ORing of bits 3 of the operands. [ drop bit3or ] 3keep ! bit3or lhs rhs cpu [ bitand ] dip [ update-flags ] 2keep [ carry-flag clear-flag ] keep @@ -336,31 +336,31 @@ CONSTANT: sign-flag 0x80 0xFF bitand ; : xor-byte ( lhs rhs cpu -- result ) - #! Logically xor rhs to lhs. The carry and half-carry flags are cleared. + ! Logically xor rhs to lhs. The carry and half-carry flags are cleared. [ bitxor ] dip [ update-flags ] 2keep half-carry-flag carry-flag bitor clear-flag 0xFF bitand ; : or-byte ( lhs rhs cpu -- result ) - #! Logically or rhs to lhs. The carry and half-carry flags are cleared. + ! Logically or rhs to lhs. The carry and half-carry flags are cleared. [ bitor ] dip [ update-flags ] 2keep half-carry-flag carry-flag bitor clear-flag 0xFF bitand ; : decrement-sp ( n cpu -- ) - #! Decrement the stackpointer by n. + ! Decrement the stackpointer by n. [ sp>> swap - ] keep sp<< ; : save-pc ( cpu -- ) - #! Save the value of the PC on the stack. + ! Save the value of the PC on the stack. [ pc>> ] [ sp>> ] [ write-word ] tri ; : push-pc ( cpu -- ) - #! Push the value of the PC on the stack. + ! Push the value of the PC on the stack. [ 2 swap decrement-sp ] [ save-pc ] bi ; : pop-pc ( cpu -- pc ) - #! Pop the value of the PC off the stack. + ! Pop the value of the PC off the stack. [ sp>> ] [ read-word ] [ -2 swap decrement-sp ] tri ; : push-sp ( value cpu -- ) @@ -370,7 +370,7 @@ CONSTANT: sign-flag 0x80 [ sp>> ] [ read-word ] [ -2 swap decrement-sp ] tri ; : call-sub ( addr cpu -- ) - #! Call the address as a subroutine. + ! Call the address as a subroutine. dup push-pc [ 0xFFFF bitand ] dip pc<< ; @@ -378,7 +378,7 @@ CONSTANT: sign-flag 0x80 [ pop-pc ] keep pc<< ; : interrupt ( number cpu -- ) - #! Perform a hardware interrupt + ! Perform a hardware interrupt ! "***Interrupt: " write over >hex print dup f>> interrupt-flag bitand 0 = not [ dup push-pc @@ -388,12 +388,12 @@ CONSTANT: sign-flag 0x80 ] if ; : inc-cycles ( n cpu -- ) - #! Increment the number of cpu cycles + ! Increment the number of cpu cycles [ cycles>> + ] keep cycles<< ; : instruction-cycles ( -- vector ) - #! Return a 256 element vector containing the cycles for - #! each opcode in the 8080 instruction set. + ! Return a 256 element vector containing the cycles for + ! each opcode in the 8080 instruction set. \ instruction-cycles get-global [ 256 f \ instruction-cycles set-global ] unless @@ -403,8 +403,8 @@ CONSTANT: sign-flag 0x80 drop ; : instructions ( -- vector ) - #! Return a 256 element vector containing the emulation words for - #! each opcode in the 8080 instruction set. + ! Return a 256 element vector containing the emulation words for + ! each opcode in the 8080 instruction set. \ instructions get-global [ 256 [ not-implemented ] \ instructions set-global ] unless @@ -414,7 +414,7 @@ CONSTANT: sign-flag 0x80 instructions set-nth ; M: cpu reset - #! Reset the CPU to its poweron state + ! Reset the CPU to its poweron state 0 >>b 0 >>c 0 >>d @@ -440,11 +440,11 @@ M: cpu reset 2drop ] if* ; - #! Reads the ROM from stdin and stores it in ROM from - #! offset n. + ! Reads the ROM from stdin and stores it in ROM from + ! offset n. : load-rom ( filename cpu -- ) - #! Load the contents of the file into ROM. - #! (address 0x0000-0x1FFF). + ! Load the contents of the file into ROM. + ! (address 0x0000-0x1FFF). ram>> swap binary [ 0 swap (load-rom) ] with-file-reader ; @@ -457,10 +457,10 @@ SYMBOL: rom-root ] unless* ; : load-rom* ( seq cpu -- ) - #! 'seq' is an array of arrays. Each array contains - #! an address and filename of a ROM file. The ROM - #! file will be loaded at the specified address. This - #! file path shoul dbe relative to the '/roms' resource path. + ! 'seq' is an array of arrays. Each array contains + ! an address and filename of a ROM file. The ROM + ! file will be loaded at the specified address. This + ! file path shoul dbe relative to the '/roms' resource path. rom-dir [ ram>> [ swap first2 rom-dir prepend-path binary [ @@ -474,8 +474,8 @@ SYMBOL: rom-root ] if ; : read-instruction ( cpu -- word ) - #! Read the next instruction from the cpu's program - #! counter, and increment the program counter. + ! Read the next instruction from the cpu's program + ! counter, and increment the program counter. [ pc>> ] keep ! pc cpu [ over 1 + swap pc<< ] keep read-byte ; @@ -483,8 +483,8 @@ SYMBOL: rom-root ERROR: undefined-8080-opcode n ; : get-cycles ( n -- opcode ) - #! Returns the cycles for the given instruction value. - #! If the opcode is not defined throw an error. + ! Returns the cycles for the given instruction value. + ! If the opcode is not defined throw an error. dup instruction-cycles nth [ nip ] [ @@ -492,7 +492,7 @@ ERROR: undefined-8080-opcode n ; ] if* ; : process-interrupts ( cpu -- ) - #! Process any hardware interrupts + ! Process any hardware interrupts [ cycles>> ] keep over 16667 < [ 2drop @@ -506,8 +506,8 @@ ERROR: undefined-8080-opcode n ; ] if ; : peek-instruction ( cpu -- word ) - #! Return the next instruction from the cpu's program - #! counter, but don't increment the counter. + ! Return the next instruction from the cpu's program + ! counter, but don't increment the counter. [ pc>> ] keep read-byte instructions nth first ; : cpu. ( cpu -- ) @@ -544,9 +544,9 @@ ERROR: undefined-8080-opcode n ; } cleave ; : register-lookup ( string -- vector ) - #! Given a string containing a register name, return a vector - #! where the 1st item is the getter and the 2nd is the setter - #! for that register. + ! Given a string containing a register name, return a vector + ! where the 1st item is the getter and the 2nd is the setter + ! for that register. H{ { "A" { a>> a<< } } { "B" { b>> b<< } } @@ -564,8 +564,8 @@ ERROR: undefined-8080-opcode n ; : flag-lookup ( string -- vector ) - #! Given a string containing a flag name, return a vector - #! where the 1st item is a word that tests that flag. + ! Given a string containing a flag name, return a vector + ! where the 1st item is a word that tests that flag. H{ { "NZ" { flag-nz? } } { "NC" { flag-nc? } } @@ -591,7 +591,7 @@ SYMBOLS: $1 $2 $3 $4 ; ] with deep-map ; : (emulate-RST) ( n cpu -- ) - #! RST nn + ! RST nn [ sp>> 2 - dup ] keep ! sp sp cpu [ sp<< ] keep ! sp cpu [ pc>> ] keep ! sp pc cpu @@ -599,7 +599,7 @@ SYMBOLS: $1 $2 $3 $4 ; [ 8 * ] dip pc<< ; : (emulate-CALL) ( cpu -- ) - #! 205 - CALL nn + ! 205 - CALL nn [ next-word 0xFFFF bitand ] keep ! addr cpu [ sp>> 2 - dup ] keep ! addr sp sp cpu [ sp<< ] keep ! addr sp cpu @@ -608,58 +608,58 @@ SYMBOLS: $1 $2 $3 $4 ; pc<< ; : (emulate-RLCA) ( cpu -- ) - #! The content of the accumulator is rotated left - #! one position. The low order bit and the carry flag - #! are both set to the value shifd out of the high - #! order bit position. Only the carry flag is affected. + ! The content of the accumulator is rotated left + ! one position. The low order bit and the carry flag + ! are both set to the value shifd out of the high + ! order bit position. Only the carry flag is affected. [ a>> -7 shift ] keep over 0 = [ dup carry-flag clear-flag ] [ dup carry-flag set-flag ] if [ a>> 1 shift 0xFF bitand ] keep [ bitor ] dip a<< ; : (emulate-RRCA) ( cpu -- ) - #! The content of the accumulator is rotated right - #! one position. The high order bit and the carry flag - #! are both set to the value shifd out of the low - #! order bit position. Only the carry flag is affected. + ! The content of the accumulator is rotated right + ! one position. The high order bit and the carry flag + ! are both set to the value shifd out of the low + ! order bit position. Only the carry flag is affected. [ a>> 1 bitand 7 shift ] keep over 0 = [ dup carry-flag clear-flag ] [ dup carry-flag set-flag ] if [ a>> 254 bitand -1 shift ] keep [ bitor ] dip a<< ; : (emulate-RLA) ( cpu -- ) - #! The content of the accumulator is rotated left - #! one position through the carry flag. The low - #! order bit is set equal to the carry flag and - #! the carry flag is set to the value shifd out - #! of the high order bit. Only the carry flag is - #! affected. + ! The content of the accumulator is rotated left + ! one position through the carry flag. The low + ! order bit is set equal to the carry flag and + ! the carry flag is set to the value shifd out + ! of the high order bit. Only the carry flag is + ! affected. [ carry-flag swap flag-set? [ 1 ] [ 0 ] if ] keep [ a>> 127 bitand 7 shift ] keep dup a>> 128 bitand 0 = [ dup carry-flag clear-flag ] [ dup carry-flag set-flag ] if [ bitor ] dip a<< ; : (emulate-RRA) ( cpu -- ) - #! The content of the accumulator is rotated right - #! one position through the carry flag. The high order - #! bit is set to the carry flag and the carry flag is - #! set to the value shifd out of the low order bit. - #! Only the carry flag is affected. + ! The content of the accumulator is rotated right + ! one position through the carry flag. The high order + ! bit is set to the carry flag and the carry flag is + ! set to the value shifd out of the low order bit. + ! Only the carry flag is affected. [ carry-flag swap flag-set? [ 0b10000000 ] [ 0 ] if ] keep [ a>> 254 bitand -1 shift ] keep dup a>> 1 bitand 0 = [ dup carry-flag clear-flag ] [ dup carry-flag set-flag ] if [ bitor ] dip a<< ; : (emulate-CPL) ( cpu -- ) - #! The contents of the accumulator are complemented - #! (zero bits become one, one bits becomes zero). - #! No flags are affected. + ! The contents of the accumulator are complemented + ! (zero bits become one, one bits becomes zero). + ! No flags are affected. 0xFF swap cpu-a-bitxor= ; : (emulate-DAA) ( cpu -- ) - #! The eight bit number in the accumulator is - #! adjusted to form two four-bit binary-coded-decimal - #! digits. + ! The eight bit number in the accumulator is + ! adjusted to form two four-bit binary-coded-decimal + ! digits. [ dup half-carry-flag swap flag-set? swap a>> 0b1111 bitand 9 > or [ 6 ] [ 0 ] if @@ -676,7 +676,7 @@ SYMBOLS: $1 $2 $3 $4 ; swap 0xFF bitand swap a<< ; : patterns ( -- hashtable ) - #! table of code quotation patterns for each type of instruction. + ! table of code quotation patterns for each type of instruction. H{ { "NOP" [ drop ] } { "RET-NN" [ ret-from-sub ] } @@ -756,59 +756,59 @@ SYMBOLS: $1 $2 $3 $4 ; } ; : 8-bit-registers ( -- parser ) - #! A parser for 8-bit registers. On a successfull parse the - #! parse tree contains a vector. The first item in the vector - #! is the getter word for that register with stack effect - #! ( cpu -- value ). The second item is the setter word with - #! stack effect ( value cpu -- ). + ! A parser for 8-bit registers. On a successfull parse the + ! parse tree contains a vector. The first item in the vector + ! is the getter word for that register with stack effect + ! ( cpu -- value ). The second item is the setter word with + ! stack effect ( value cpu -- ). [[ register-lookup ]] EBNF> ; : all-flags ( -- parser ) - #! A parser for 16-bit flags. + ! A parser for 16-bit flags. [[ flag-lookup ]] EBNF> ; : 16-bit-registers ( -- parser ) - #! A parser for 16-bit registers. On a successfull parse the - #! parse tree contains a vector. The first item in the vector - #! is the getter word for that register with stack effect - #! ( cpu -- value ). The second item is the setter word with - #! stack effect ( value cpu -- ). + ! A parser for 16-bit registers. On a successfull parse the + ! parse tree contains a vector. The first item in the vector + ! is the getter word for that register with stack effect + ! ( cpu -- value ). The second item is the setter word with + ! stack effect ( value cpu -- ). [[ register-lookup ]] EBNF> ; : all-registers ( -- parser ) - #! Return a parser that can parse the format - #! for 8 bit or 16 bit registers. + ! Return a parser that can parse the format + ! for 8 bit or 16 bit registers. [ 16-bit-registers , 8-bit-registers , ] choice* ; : indirect ( parser -- parser ) - #! Given a parser, return a parser which parses the original - #! wrapped in brackets, representing an indirect reference. - #! eg. BC -> (BC). The value of the original parser is left in - #! the parse tree. + ! Given a parser, return a parser which parses the original + ! wrapped in brackets, representing an indirect reference. + ! eg. BC -> (BC). The value of the original parser is left in + ! the parse tree. "(" ")" surrounded-by ; : generate-instruction ( vector string -- quot ) - #! Generate the quotation for an instruction, given the instruction in - #! the 'string' and a vector containing the arguments for that instruction. + ! Generate the quotation for an instruction, given the instruction in + ! the 'string' and a vector containing the arguments for that instruction. patterns at replace-patterns ; : simple-instruction ( token -- parser ) - #! Return a parser for then instruction identified by the token. - #! The parser return parses the token only and expects no additional - #! arguments to the instruction. + ! Return a parser for then instruction identified by the token. + ! The parser return parses the token only and expects no additional + ! arguments to the instruction. token [ '[ { } _ generate-instruction ] ] action ; : complex-instruction ( type token -- parser ) - #! Return a parser for an instruction identified by the token. - #! The instruction is expected to take additional arguments by - #! being combined with other parsers. Then 'type' is used for a lookup - #! in a pattern hashtable to return the instruction quotation pattern. + ! Return a parser for an instruction identified by the token. + ! The instruction is expected to take additional arguments by + ! being combined with other parsers. Then 'type' is used for a lookup + ! in a pattern hashtable to return the instruction quotation pattern. token swap [ nip '[ _ generate-instruction ] ] curry action ; : no-params ( ast -- ast ) @@ -1164,7 +1164,7 @@ SYMBOLS: $1 $2 $3 $4 ; ] seq* [ two-params ] action ; : LD-RR,NN-instruction ( -- parser ) - #! LD BC,nn + ! LD BC,nn [ "LD-RR,NN" "LD" complex-instruction , 16-bit-registers sp , @@ -1172,7 +1172,7 @@ SYMBOLS: $1 $2 $3 $4 ; ] seq* [ one-param ] action ; : LD-R,N-instruction ( -- parser ) - #! LD B,n + ! LD B,n [ "LD-R,N" "LD" complex-instruction , 8-bit-registers sp , @@ -1187,7 +1187,7 @@ SYMBOLS: $1 $2 $3 $4 ; ] seq* [ one-param ] action ; : LD-(RR),R-instruction ( -- parser ) - #! LD (BC),A + ! LD (BC),A [ "LD-(RR),R" "LD" complex-instruction , 16-bit-registers indirect sp , @@ -1363,18 +1363,18 @@ SYMBOLS: $1 $2 $3 $4 ; ] choice* [ call( -- quot ) ] action ; : instruction-quotations ( string -- emulate-quot ) - #! Given an instruction string, return the emulation quotation for - #! it. This will later be expanded to produce the disassembly and - #! assembly quotations. + ! Given an instruction string, return the emulation quotation for + ! it. This will later be expanded to produce the disassembly and + ! assembly quotations. 8080-generator-parser parse ; SYMBOL: last-instruction SYMBOL: last-opcode : parse-instructions ( list -- ) - #! Process the list of strings, which should make - #! up an 8080 instruction, and output a quotation - #! that would implement that instruction. + ! Process the list of strings, which should make + ! up an 8080 instruction, and output a quotation + ! that would implement that instruction. dup " " join instruction-quotations [ "_" join [ "emulate-" % % ] "" make create-word-in @@ -1384,10 +1384,10 @@ SYMBOL: last-opcode SYNTAX: INSTRUCTION: ";" parse-tokens parse-instructions ; SYNTAX: cycles: - #! Set the number of cycles for the last instruction that was defined. + ! Set the number of cycles for the last instruction that was defined. scan-token string>number last-opcode get-global instruction-cycles set-nth ; SYNTAX: opcode: - #! Set the opcode number for the last instruction that was defined. + ! Set the opcode number for the last instruction that was defined. last-instruction get-global 1quotation scan-token hex> dup last-opcode set-global set-instruction ; diff --git a/extra/cpu/8080/test/test.factor b/extra/cpu/8080/test/test.factor index 8bbf743602..de093ac059 100644 --- a/extra/cpu/8080/test/test.factor +++ b/extra/cpu/8080/test/test.factor @@ -15,7 +15,7 @@ USING: IN: cpu.8080.test : step ( cpu -- ) - #! Run a single 8080 instruction + ! Run a single 8080 instruction [ read-instruction ] keep ! n cpu over get-cycles over inc-cycles [ swap instructions nth call( cpu -- ) ] keep @@ -47,7 +47,7 @@ IN: cpu.8080.test [ 8 ] dip each ; inline : >ppm ( cpu filename -- cpu ) - #! Dump the current screen image to a ppm image file with the given name. + ! Dump the current screen image to a ppm image file with the given name. ascii [ "P3" print "256 224" print diff --git a/extra/cpu/arm/assembler/assembler.factor b/extra/cpu/arm/assembler/assembler.factor index eb2fb3d608..cd04754387 100644 --- a/extra/cpu/arm/assembler/assembler.factor +++ b/extra/cpu/arm/assembler/assembler.factor @@ -57,7 +57,7 @@ SYMBOL: cond-code cond-code set ; : CC> ( -- n ) - #! Default value is 0b1110 AL (= always) + ! Default value is 0b1110 AL (= always) cond-code [ f ] change 0b1110 or ; : EQ ( -- ) 0b0000 >CC ; diff --git a/extra/crypto/aes/aes-tests.factor b/extra/crypto/aes/aes-tests.factor index d3caebb910..ed331318e5 100644 --- a/extra/crypto/aes/aes-tests.factor +++ b/extra/crypto/aes/aes-tests.factor @@ -170,7 +170,7 @@ V{ 729683222 682545830 2885096840 164581180 2700803607 2287217841 2893506291 435870753 684796225 1465647214 3491035560 3387827593 3779005640 3059944614 } } [ - HEX{ 2b 7e 15 16 28 ae d2 a6 ab f7 15 88 09 cf 4f 3c } #! AES-128 key expansion test vector from FIPS-197 (appendix) + HEX{ 2b 7e 15 16 28 ae d2 a6 ab f7 15 88 09 cf 4f 3c } ! AES-128 key expansion test vector from FIPS-197 (appendix) 10 (expand-enc-key) ] unit-test diff --git a/extra/crypto/aes/aes.factor b/extra/crypto/aes/aes.factor index 36c73842c2..b655f607ab 100644 --- a/extra/crypto/aes/aes.factor +++ b/extra/crypto/aes/aes.factor @@ -11,9 +11,9 @@ CONSTANT: AES_BLOCK_SIZE 16 #! FIPS-197 AES #! input block, state, output block -- 4 32-bit words CONSTANT: FIPS-197 { - { 128 10 } #! aes-128 -- Key(4) Block(4) Rounds(10) - { 192 12 } #! aes-192 -- Key(6) Block(4) Rounds(12) - { 256 14 } #! aes-256 -- Key(8) Block(4) Rounds(14) + { 128 10 } ! aes-128 -- Key(4) Block(4) Rounds(10) + { 192 12 } ! aes-192 -- Key(6) Block(4) Rounds(12) + { 256 14 } ! aes-256 -- Key(8) Block(4) Rounds(14) } ui32 #! c0' - c0 gb0 c3 gb1 c2 gb2 c1 gb3 >ui32 #! c1' - c1 gb0 c0 gb1 c3 gb2 c2 gb3 >ui32 #! c2' - c2 gb0 c1 gb1 c0 gb2 c3 gb3 >ui32 ; #! c3' + c3 gb0 c2 gb1 c1 gb2 c0 gb3 >ui32 ! c0' + c0 gb0 c3 gb1 c2 gb2 c1 gb3 >ui32 ! c1' + c1 gb0 c0 gb1 c3 gb2 c2 gb3 >ui32 ! c2' + c2 gb0 c1 gb1 c0 gb2 c3 gb3 >ui32 ; ! c3' :: (unshift-rows) ( c0 c1 c2 c3 -- c0' c1' c2' c3' ) - c1 gb0 c2 gb1 c3 gb2 c0 gb3 >ui32 #! c0' - c2 gb0 c3 gb1 c0 gb2 c1 gb3 >ui32 #! c1' - c3 gb0 c0 gb1 c1 gb2 c2 gb3 >ui32 #! c2' - c0 gb0 c1 gb1 c2 gb2 c3 gb3 >ui32 ; #! c3' + c1 gb0 c2 gb1 c3 gb2 c0 gb3 >ui32 ! c0' + c2 gb0 c3 gb1 c0 gb2 c1 gb3 >ui32 ! c1' + c3 gb0 c0 gb1 c1 gb2 c2 gb3 >ui32 ! c2' + c0 gb0 c1 gb1 c2 gb2 c3 gb3 >ui32 ; ! c3' : (add-round-key) ( key state -- state' ) 4 [ bitxor ] unrolled-2map ; diff --git a/extra/crypto/barrett/barrett.factor b/extra/crypto/barrett/barrett.factor index 10f99058b5..2b5e63f7f7 100644 --- a/extra/crypto/barrett/barrett.factor +++ b/extra/crypto/barrett/barrett.factor @@ -4,7 +4,7 @@ USING: kernel math math.functions ; IN: crypto.barrett : barrett-mu ( n size -- mu ) - #! Calculates Barrett's reduction parameter mu - #! size = word size in bits (8, 16, 32, 64, ...) + ! Calculates Barrett's reduction parameter mu + ! size = word size in bits (8, 16, 32, 64, ...) [ [ log2 1 + ] [ / 2 * ] bi* ] [ 2^ rot ^ swap /i ] 2bi ; diff --git a/extra/crypto/rsa/rsa.factor b/extra/crypto/rsa/rsa.factor index a712a1a1f3..0fc59da8aa 100644 --- a/extra/crypto/rsa/rsa.factor +++ b/extra/crypto/rsa/rsa.factor @@ -24,7 +24,7 @@ CONSTANT: public-key 65537 2/ 2 swap unique-primes first2 ; : modulus-phi ( numbits -- n phi ) - #! Loop until phi is not divisible by the public key. + ! Loop until phi is not divisible by the public key. dup rsa-primes [ * ] 2keep [ 1 - ] bi@ * dup public-key coprime? [ diff --git a/extra/fjsc/resources/bootstrap.factor b/extra/fjsc/resources/bootstrap.factor index 4063426d5e..0b7ec5f74a 100644 --- a/extra/fjsc/resources/bootstrap.factor +++ b/extra/fjsc/resources/bootstrap.factor @@ -6,11 +6,11 @@ USE: kernel-internals "browser-dom" set-in : elements ( string -- result ) - #! Call JQuery's $ function + ! Call JQuery's $ function window { "result" } "" "$" { "string" } alien-invoke ; : html ( string -- element ) - #! Set the innerHTML of element using jQuery + ! Set the innerHTML of element using jQuery { } "" "html" { "string" } alien-invoke ; : bind-event ( name element quot -- ) @@ -35,5 +35,5 @@ USE: kernel-internals ] callcc0 ; : alert ( string -- ) - #! Display the string in an alert box + ! Display the string in an alert box window { } "" "alert" { "string" } alien-invoke ; diff --git a/extra/html/elements/elements.factor b/extra/html/elements/elements.factor index 921f434b31..b30a993776 100644 --- a/extra/html/elements/elements.factor +++ b/extra/html/elements/elements.factor @@ -19,66 +19,66 @@ SYMBOL: html CONSTANT: elements-vocab "html.elements" : html-word ( name def effect -- ) - #! Define 'word creating' word to allow - #! dynamically creating words. + ! Define 'word creating' word to allow + ! dynamically creating words. [ elements-vocab create-word ] 2dip define-declared ; : ( str -- ) "<" ">" surround ; : def-for-html-word- ( name -- ) - #! Return the name and code for the patterned - #! word. + ! Return the name and code for the patterned + ! word. dup swap '[ _ write-html ] ( -- ) html-word ; : ( str -- foo> ) ">" append ; : def-for-html-word-foo> ( name -- ) - #! Return the name and code for the foo> patterned - #! word. + ! Return the name and code for the foo> patterned + ! word. foo> [ ">" write-html ] ( -- ) html-word ; : ( str -- ) "" surround ; : def-for-html-word- ( name -- ) - #! Return the name and code for the patterned - #! word. + ! Return the name and code for the patterned + ! word. dup '[ _ write-html ] ( -- ) html-word ; : ( str -- ) "<" "/>" surround ; : def-for-html-word- ( name -- ) - #! Return the name and code for the patterned - #! word. + ! Return the name and code for the patterned + ! word. dup swap '[ _ write-html ] ( -- ) html-word ; : foo/> ( str -- str/> ) "/>" append ; : def-for-html-word-foo/> ( name -- ) - #! Return the name and code for the foo/> patterned - #! word. + ! Return the name and code for the foo/> patterned + ! word. foo/> [ "/>" write-html ] ( -- ) html-word ; : define-closed-html-word ( name -- ) - #! Given an HTML tag name, define the words for - #! that closable HTML tag. + ! Given an HTML tag name, define the words for + ! that closable HTML tag. dup def-for-html-word- dup def-for-html-word- def-for-html-word- ; : define-open-html-word ( name -- ) - #! Given an HTML tag name, define the words for - #! that open HTML tag. + ! Given an HTML tag name, define the words for + ! that open HTML tag. dup def-for-html-word- dup def-for-html-word- ; diff --git a/extra/images/tga/tga.factor b/extra/images/tga/tga.factor index c64f4907d8..d0b4177d23 100644 --- a/extra/images/tga/tga.factor +++ b/extra/images/tga/tga.factor @@ -169,7 +169,7 @@ ERROR: bad-tga-unsupported ; ] map >hashtable ; inline :: read-tga ( -- image ) - #! Read header + ! Read header read-id-length :> id-length read-color-map-type :> map-type read-image-type :> image-type @@ -187,13 +187,13 @@ ERROR: bad-tga-unsupported ; image-width image-height pixel-depth read-image-data :> image-data [ - #! Read optional footer + ! Read optional footer 26 seek-end seek-input read-extension-area-offset :> extension-offset read-developer-directory-offset :> directory-offset read-signature - #! Read optional extension section + ! Read optional extension section extension-offset 0 = [ extension-offset seek-absolute seek-input @@ -228,7 +228,7 @@ ERROR: bad-tga-unsupported ; scan-line-offset seek-absolute seek-input image-height read-scan-line-table :> scan-offsets - #! Read optional developer section + ! Read optional developer section directory-offset 0 = [ f ] [ @@ -238,14 +238,14 @@ ERROR: bad-tga-unsupported ; ] unless ] ignore-errors - #! Only 24-bit uncompressed BGR and 32-bit uncompressed BGRA are supported. - #! Other formats would need to be converted to work within the image class. + ! Only 24-bit uncompressed BGR and 32-bit uncompressed BGRA are supported. + ! Other formats would need to be converted to work within the image class. map-type 0 = [ bad-tga-unsupported ] unless image-type 2 = [ bad-tga-unsupported ] unless pixel-depth { 24 32 } member? [ bad-tga-unsupported ] unless pixel-order { 0 2 } member? [ bad-tga-unsupported ] unless - #! Create image instance + ! Create image instance image new alpha-bits 0 = [ BGR ] [ BGRA ] if >>component-order { image-width image-height } >>dim @@ -262,11 +262,11 @@ M: tga-image image>stream component-order>> { BGRA BGRA } member? [ bad-tga-unsupported ] unless ] keep - B{ 0 } write #! id-length - B{ 0 } write #! map-type - B{ 2 } write #! image-type - B{ 0 0 0 0 0 } write #! color map first, length, entry size - B{ 0 0 0 0 } write #! x-origin, y-origin + B{ 0 } write ! id-length + B{ 0 } write ! map-type + B{ 2 } write ! image-type + B{ 0 0 0 0 0 } write ! color map first, length, entry size + B{ 0 0 0 0 } write ! x-origin, y-origin { [ dim>> first 2 >le write ] [ dim>> second 2 >le write ] diff --git a/extra/jamshred/gl/gl.factor b/extra/jamshred/gl/gl.factor index 9e5d248c98..7816907a7d 100644 --- a/extra/jamshred/gl/gl.factor +++ b/extra/jamshred/gl/gl.factor @@ -43,7 +43,7 @@ CONSTANT: wall-drawing-offset 0.15 swap [ segment-vertex ] keep dupd segment-vertex-normal ; : equally-spaced-radians ( n -- seq ) - #! return a sequence of n numbers between 0 and 2pi + ! return a sequence of n numbers between 0 and 2pi [ iota ] keep [ / pi 2 * * ] curry map ; : draw-segment-vertex ( segment theta -- ) diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor index 967ab10cd7..36199a00b6 100644 --- a/extra/jamshred/jamshred.factor +++ b/extra/jamshred/jamshred.factor @@ -43,11 +43,11 @@ M: jamshred-gadget ungraft* ( gadget -- ) / pi 4 * * ; ! 2 / / pi 2 * * ; : x>radians ( x gadget -- theta ) - #! translate motion of x pixels to an angle + ! translate motion of x pixels to an angle dim>> first pix>radians neg ; : y>radians ( y gadget -- theta ) - #! translate motion of y pixels to an angle + ! translate motion of y pixels to an angle dim>> second pix>radians ; : (handle-mouse-motion) ( jamshred-gadget mouse-motion -- ) diff --git a/extra/jamshred/oint/oint.factor b/extra/jamshred/oint/oint.factor index b50d9ac2fb..8d9bfdca0c 100644 --- a/extra/jamshred/oint/oint.factor +++ b/extra/jamshred/oint/oint.factor @@ -62,7 +62,7 @@ PRIVATE> over forward>> rotate-oint ; : random-float+- ( n -- m ) - #! find a random float between -n/2 and n/2 + ! find a random float between -n/2 and n/2 dup 10000 * >integer random 10000 / swap 2 / - ; : random-turn ( oint theta -- ) @@ -81,7 +81,7 @@ PRIVATE> distance-vector norm ; : scalar-projection ( v1 v2 -- n ) - #! the scalar projection of v1 onto v2 + ! the scalar projection of v1 onto v2 [ v. ] [ norm ] bi / ; : proj-perp ( u v -- w ) @@ -92,7 +92,7 @@ PRIVATE> -rot up>> scalar-projection abs + ; :: reflect ( v n -- v' ) - #! bounce v on a surface with normal n + ! bounce v on a surface with normal n v v n v. n n v. / 2 * n n*v v- ; : half-way ( p1 p2 -- p3 ) diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index af47aa1427..7324cf7e0b 100644 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -57,8 +57,8 @@ CONSTANT: default-segment-radius 1 n-segments simple-segments ; : sub-tunnel ( from to segments -- segments ) - #! return segments between from and to, after clamping from and to to - #! valid values + ! return segments between from and to, after clamping from and to to + ! valid values [ '[ _ clamp-length ] bi@ ] keep ; : get-segment ( segments n -- segment ) @@ -71,7 +71,7 @@ CONSTANT: default-segment-radius 1 number>> 1 - get-segment ; : heading-segment ( segments current-segment heading -- segment ) - #! the next segment on the given heading + ! the next segment on the given heading over forward>> v. 0 <=> { { +gt+ [ next-segment ] } { +lt+ [ previous-segment ] } @@ -99,7 +99,7 @@ CONSTANT: default-segment-radius 1 CONSTANT: distant 1000 : max-real ( a b -- c ) - #! sometimes collision-coefficient yields complex roots, so we ignore these (hack) + ! sometimes collision-coefficient yields complex roots, so we ignore these (hack) dup real? [ over real? [ max ] [ nip ] if ] [ @@ -133,12 +133,12 @@ CONSTANT: distant 1000 [ wall-normal ] [ forward>> swap reflect ] [ forward<< ] tri ; : bounce-left ( segment oint -- ) - #! must be done after forward + ! must be done after forward [ forward>> vneg ] dip [ left>> swap reflect ] [ forward>> proj-perp normalize ] [ left<< ] tri ; : bounce-up ( segment oint -- ) - #! must be done after forward and left! + ! must be done after forward and left! nip [ forward>> ] [ left>> cross ] [ up<< ] tri ; : bounce-off-wall ( oint segment -- ) diff --git a/extra/koszul/koszul.factor b/extra/koszul/koszul.factor index e5995e10bc..ae1a7bbd34 100644 --- a/extra/koszul/koszul.factor +++ b/extra/koszul/koszul.factor @@ -133,7 +133,7 @@ DEFER: (d) ] if ; : interior ( x y -- i_y[x] ) - #! y is a generator + ! y is a generator swap >alt [ dupd (interior) ] linear-op nip ; ! Computing a basis @@ -172,7 +172,7 @@ DEFER: (d) ! Graded by degree : (graded-ker/im-d) ( n seq -- null/rank ) - #! d: C(n) ---> C(n+1) + ! d: C(n) ---> C(n+1) [ ?nth ] [ [ 1 + ] dip ?nth ] 2bi dim-im/ker-d ; @@ -184,7 +184,7 @@ DEFER: (d) ! Bi-graded for two-step complexes : (bigraded-ker/im-d) ( u-deg z-deg bigraded-basis -- null/rank ) - #! d: C(u,z) ---> C(u+2,z-1) + ! d: C(u,z) ---> C(u+2,z-1) [ ?nth ?nth ] 3keep [ [ 2 + ] dip 1 - ] dip ?nth ?nth dim-im/ker-d ; @@ -257,7 +257,7 @@ DEFER: (d) ] each-index ; : bigraded-triple ( u-deg z-deg bigraded-basis -- triple ) - #! d: C(u,z) ---> C(u+2,z-1) + ! d: C(u,z) ---> C(u+2,z-1) [ [ 2 - ] [ 1 + ] [ ] tri* ?nth ?nth ] [ ?nth ?nth ] [ [ 2 + ] [ 1 - ] [ ] tri* ?nth ?nth ] diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor index d01dff72d5..3bca866ea3 100644 --- a/extra/mason/common/common.factor +++ b/extra/mason/common/common.factor @@ -18,8 +18,8 @@ ERROR: no-host-name ; SYMBOL: current-git-id : short-running-process ( command -- ) - #! Give network operations and shell commands at most - #! 30 minutes to complete, to catch hangs. + ! Give network operations and shell commands at most + ! 30 minutes to complete, to catch hangs. >process 30 minutes >>timeout +new-group+ >>group @@ -30,8 +30,8 @@ SYMBOL: current-git-id '[ drop @ f ] attempt-all drop ; inline : upload-process ( process -- ) - #! Give network operations and shell commands at most - #! 30 minutes to complete, to catch hangs. + ! Give network operations and shell commands at most + ! 30 minutes to complete, to catch hangs. >process upload-timeout get >>timeout +new-group+ >>group diff --git a/extra/mason/git/git.factor b/extra/mason/git/git.factor index 69106180bc..66220e3742 100644 --- a/extra/mason/git/git.factor +++ b/extra/mason/git/git.factor @@ -21,7 +21,7 @@ IN: mason.git } ; : git-clone ( -- ) - #! Must be run from builds-dir + ! Must be run from builds-dir "Cloning initial repository" print-timestamp git-clone-cmd try-output-process ; @@ -58,7 +58,7 @@ IN: mason.git { "git" "status" } ; : git-status-failed ( error -- ) - #! Exit code 1 means there's nothing to commit. + ! Exit code 1 means there's nothing to commit. dup { [ process-failed? ] [ code>> 1 = ] } 1&& [ drop ] [ rethrow ] if ; @@ -87,7 +87,7 @@ IN: mason.git PRIVATE> : git-clone-or-pull ( -- id ) - #! Must be run from builds-dir. + ! Must be run from builds-dir. "factor" exists? [ check-repository [ "factor" [ diff --git a/extra/mason/updates/updates.factor b/extra/mason/updates/updates.factor index 839f1ea870..d92d307e94 100644 --- a/extra/mason/updates/updates.factor +++ b/extra/mason/updates/updates.factor @@ -23,7 +23,7 @@ SYMBOLS: latest-sources last-built-sources ; counter-url get-global http-get nip string>number ; : update-sources ( -- ) - #! Must be run from builds-dir + ! Must be run from builds-dir git-clone-or-pull latest-boot-image latest-counter latest-sources set-global ; @@ -31,7 +31,7 @@ SYMBOLS: latest-sources last-built-sources ; latest-sources get-global last-built-sources get-global = not ; : finish-build ( -- ) - #! If the build completed (successfully or not) without - #! mason crashing or being killed, don't build this git ID - #! and boot image hash again. + ! If the build completed (successfully or not) without + ! mason crashing or being killed, don't build this git ID + ! and boot image hash again. latest-sources get-global last-built-sources set-global ; diff --git a/extra/math/analysis/analysis.factor b/extra/math/analysis/analysis.factor index f7fd38f9ab..631f6ff661 100644 --- a/extra/math/analysis/analysis.factor +++ b/extra/math/analysis/analysis.factor @@ -21,16 +21,16 @@ CONSTANT: gamma-p6 [ + recip ] with { } map-integers 1.0 0 pick set-nth ; : (gamma-lanczos6) ( x -- log[gamma[x+1]] ) - #! log(gamma(x+1) + ! log(gamma(x+1) [ 0.5 + dup gamma-g6 + [ log * ] keep - ] [ 6 gamma-z gamma-p6 v. log ] bi + ; : gamma-lanczos6 ( x -- gamma[x] ) - #! gamma(x) = gamma(x+1) / x + ! gamma(x) = gamma(x+1) / x [ (gamma-lanczos6) e^ ] keep / ; : gammaln-lanczos6 ( x -- gammaln[x] ) - #! log(gamma(x)) = log(gamma(x+1)) - log(x) + ! log(gamma(x)) = log(gamma(x+1)) - log(x) [ (gamma-lanczos6) ] keep log - ; : gamma-neg ( gamma[abs[x]] x -- gamma[x] ) @@ -39,8 +39,8 @@ CONSTANT: gamma-p6 PRIVATE> : gamma ( x -- y ) - #! gamma(x) = integral 0..inf [ t^(x-1) exp(-t) ] dt - #! gamma(n+1) = n! for n > 0 + ! gamma(x) = integral 0..inf [ t^(x-1) exp(-t) ] dt + ! gamma(n+1) = n! for n > 0 dup { [ 0.0 <= ] [ 1.0 mod zero? ] } 1&& [ drop 1/0. ] [ @@ -48,8 +48,8 @@ PRIVATE> ] if ; : gammaln ( x -- gamma[x] ) - #! gammaln(x) is an alternative when gamma(x)'s range - #! varies too widely + ! gammaln(x) is an alternative when gamma(x)'s range + ! varies too widely dup 0 < [ drop 1/0. ] [ @@ -71,7 +71,7 @@ PRIVATE> ! copyright notice is preserved. : exp-int ( x -- y ) - #! For real values of x only. Accurate to 7 decimals. + ! For real values of x only. Accurate to 7 decimals. dup 1.0 < [ dup 0.00107857 * 0.00976004 - over * diff --git a/extra/parser-combinators/parser-combinators.factor b/extra/parser-combinators/parser-combinators.factor index 2294cf1c58..1958a5f6c0 100644 --- a/extra/parser-combinators/parser-combinators.factor +++ b/extra/parser-combinators/parser-combinators.factor @@ -72,9 +72,9 @@ TUPLE: satisfy-parser quot ; C: satisfy satisfy-parser M: satisfy-parser parse ( input parser -- list ) - #! A parser that succeeds if the predicate, - #! when passed the first character in the input, returns - #! true. + ! A parser that succeeds if the predicate, + ! when passed the first character in the input, returns + ! true. over empty? [ 2drop nil ] [ @@ -90,10 +90,10 @@ TUPLE: epsilon-parser ; C: epsilon epsilon-parser M: epsilon-parser parse ( input parser -- list ) - #! A parser that parses the empty string. It - #! does not consume any input and always returns - #! an empty list as the parse tree with the - #! unmodified input. + ! A parser that parses the empty string. It + ! does not consume any input and always returns + ! an empty list as the parse tree with the + ! unmodified input. drop "" swap ; TUPLE: succeed-parser result ; @@ -101,8 +101,8 @@ TUPLE: succeed-parser result ; C: succeed succeed-parser M: succeed-parser parse ( input parser -- list ) - #! A parser that always returns 'result' as a - #! successful parse with no input consumed. + ! A parser that always returns 'result' as a + ! successful parse with no input consumed. result>> swap ; TUPLE: fail-parser ; @@ -110,8 +110,8 @@ TUPLE: fail-parser ; C: fail fail-parser M: fail-parser parse ( input parser -- list ) - #! A parser that always fails and returns - #! an empty list of successes. + ! A parser that always fails and returns + ! an empty list of successes. 2drop nil ; TUPLE: ensure-parser test ; @@ -155,10 +155,10 @@ TUPLE: and-parser parsers ; ] with lazy-map lconcat ; M: and-parser parse ( input parser -- list ) - #! Parse 'input' by sequentially combining the - #! two parsers. First parser1 is applied to the - #! input then parser2 is applied to the rest of - #! the input strings from the first parser. + ! Parse 'input' by sequentially combining the + ! two parsers. First parser1 is applied to the + ! input then parser2 is applied to the rest of + ! the input strings from the first parser. parsers>> unclip swapd parse [ [ and-parser-parse ] reduce ] 2curry ; @@ -171,15 +171,15 @@ TUPLE: or-parser parsers ; 2array ; M: or-parser parse ( input parser1 -- list ) - #! Return the combined list resulting from the parses - #! of parser1 and parser2 being applied to the same - #! input. This implements the choice parsing operator. + ! Return the combined list resulting from the parses + ! of parser1 and parser2 being applied to the same + ! input. This implements the choice parsing operator. parsers>> sequence>list [ parse ] with lazy-map lconcat ; : trim-head-slice ( string -- string ) - #! Return a new string without any leading whitespace - #! from the original string. + ! Return a new string without any leading whitespace + ! from the original string. dup empty? [ dup first blank? [ rest-slice trim-head-slice ] when ] unless ; @@ -191,8 +191,8 @@ TUPLE: sp-parser p1 ; C: sp sp-parser M: sp-parser parse ( input parser -- list ) - #! Skip all leading whitespace from the input then call - #! the parser on the remaining input. + ! Skip all leading whitespace from the input then call + ! the parser on the remaining input. [ trim-head-slice ] dip p1>> parse ; TUPLE: just-parser p1 ; @@ -200,10 +200,10 @@ TUPLE: just-parser p1 ; C: just just-parser M: just-parser parse ( input parser -- result ) - #! Calls the given parser on the input removes - #! from the results anything where the remaining - #! input to be parsed is not empty. So ensures a - #! fully parsed input string. + ! Calls the given parser on the input removes + ! from the results anything where the remaining + ! input to be parsed is not empty. So ensures a + ! fully parsed input string. p1>> parse [ unparsed>> empty? ] lfilter ; TUPLE: apply-parser p1 quot ; @@ -211,11 +211,11 @@ TUPLE: apply-parser p1 quot ; C: <@ apply-parser M: apply-parser parse ( input parser -- result ) - #! Calls the parser on the input. For each successful - #! parse the quot is call with the parse result on the stack. - #! The result of that quotation then becomes the new parse result. - #! This allows modification of parse tree results (like - #! converting strings to integers, etc). + ! Calls the parser on the input. For each successful + ! parse the quot is call with the parse result on the stack. + ! The result of that quotation then becomes the new parse result. + ! This allows modification of parse tree results (like + ! converting strings to integers, etc). [ p1>> ] [ quot>> ] bi -rot parse [ [ parsed>> swap call ] keep @@ -227,43 +227,43 @@ TUPLE: some-parser p1 ; C: some some-parser M: some-parser parse ( input parser -- result ) - #! Calls the parser on the input, guarantees - #! the parse is complete (the remaining input is empty), - #! picks the first solution and only returns the parse - #! tree since the remaining input is empty. + ! Calls the parser on the input, guarantees + ! the parse is complete (the remaining input is empty), + ! picks the first solution and only returns the parse + ! tree since the remaining input is empty. p1>> just parse-1 ; : <& ( parser1 parser2 -- parser ) - #! Same as <&> except discard the results of the second parser. + ! Same as <&> except discard the results of the second parser. <&> [ first ] <@ ; : &> ( parser1 parser2 -- parser ) - #! Same as <&> except discard the results of the first parser. + ! Same as <&> except discard the results of the first parser. <&> [ second ] <@ ; : <:&> ( parser1 parser2 -- result ) - #! Same as <&> except flatten the result. + ! Same as <&> except flatten the result. <&> [ first2 suffix ] <@ ; : <&:> ( parser1 parser2 -- result ) - #! Same as <&> except flatten the result. + ! Same as <&> except flatten the result. <&> [ first2 swap prefix ] <@ ; : <:&:> ( parser1 parser2 -- result ) - #! Same as <&> except flatten the result. + ! Same as <&> except flatten the result. <&> [ first2 append ] <@ ; LAZY: <*> ( parser -- parser ) dup <*> <&:> { } succeed <|> ; : <+> ( parser -- parser ) - #! Return a parser that accepts one or more occurences of the original - #! parser. + ! Return a parser that accepts one or more occurences of the original + ! parser. dup <*> <&:> ; LAZY: ( parser -- parser ) - #! Return a parser that optionally uses the parser - #! if that parser would be successful. + ! Return a parser that optionally uses the parser + ! if that parser would be successful. [ 1array ] <@ f succeed <|> ; TUPLE: only-first-parser p1 ; @@ -272,62 +272,62 @@ LAZY: only-first ( parser -- parser ) only-first-parser boa ; M: only-first-parser parse ( input parser -- list ) - #! Transform a parser into a parser that only yields - #! the first possibility. + ! Transform a parser into a parser that only yields + ! the first possibility. p1>> parse 1 swap ltake ; LAZY: ( parser -- parser ) - #! Like <*> but only return one possible result - #! containing all matching parses. Does not return - #! partial matches. Useful for efficiency since that's - #! usually the effect you want and cuts down on backtracking - #! required. + ! Like <*> but only return one possible result + ! containing all matching parses. Does not return + ! partial matches. Useful for efficiency since that's + ! usually the effect you want and cuts down on backtracking + ! required. <*> only-first ; LAZY: ( parser -- parser ) - #! Like <+> but only return one possible result - #! containing all matching parses. Does not return - #! partial matches. Useful for efficiency since that's - #! usually the effect you want and cuts down on backtracking - #! required. + ! Like <+> but only return one possible result + ! containing all matching parses. Does not return + ! partial matches. Useful for efficiency since that's + ! usually the effect you want and cuts down on backtracking + ! required. <+> only-first ; LAZY: ( parser -- parser ) - #! Like but only return one possible result - #! containing all matching parses. Does not return - #! partial matches. Useful for efficiency since that's - #! usually the effect you want and cuts down on backtracking - #! required. + ! Like but only return one possible result + ! containing all matching parses. Does not return + ! partial matches. Useful for efficiency since that's + ! usually the effect you want and cuts down on backtracking + ! required. only-first ; LAZY: <(?)> ( parser -- parser ) - #! Like but take shortest match first. + ! Like but take shortest match first. f succeed swap [ 1array ] <@ <|> ; LAZY: <(*)> ( parser -- parser ) - #! Like <*> but take shortest match first. - #! Implementation by Matthew Willis. + ! Like <*> but take shortest match first. + ! Implementation by Matthew Willis. { } succeed swap dup <(*)> <&:> <|> ; LAZY: <(+)> ( parser -- parser ) - #! Like <+> but take shortest match first. - #! Implementation by Matthew Willis. + ! Like <+> but take shortest match first. + ! Implementation by Matthew Willis. dup <(*)> <&:> ; : pack ( close body open -- parser ) - #! Parse a construct enclosed by two symbols, - #! given a parser for the opening symbol, the - #! closing symbol, and the body. + ! Parse a construct enclosed by two symbols, + ! given a parser for the opening symbol, the + ! closing symbol, and the body. <& &> ; : nonempty-list-of ( items separator -- parser ) [ over &> <*> <&:> ] keep [ nip ] 2keep pack ; : list-of ( items separator -- parser ) - #! Given a parser for the separator and for the - #! items themselves, return a parser that parses - #! lists of those items. The parse tree is an - #! array of the parsed items. + ! Given a parser for the separator and for the + ! items themselves, return a parser that parses + ! lists of those items. The parse tree is an + ! array of the parsed items. nonempty-list-of { } succeed <|> ; LAZY: surrounded-by ( parser start end -- parser' ) diff --git a/extra/poker/poker.factor b/extra/poker/poker.factor index 50d0feebd1..7d5ef91be8 100644 --- a/extra/poker/poker.factor +++ b/extra/poker/poker.factor @@ -131,8 +131,8 @@ M: integer >ckf ; [ 0xFF bitand ] map-product ; : perfect-hash-find ( q -- value ) - #! magic to convert a hand's unique identifying bits to the - #! proper index for fast lookup in a table of hand values + ! magic to convert a hand's unique identifying bits to the + ! proper index for fast lookup in a table of hand values 0xE91AAA35 + dup -16 shift bitxor dup 8 shift w+ diff --git a/extra/pop3/server/server.factor b/extra/pop3/server/server.factor index 614dca6e5f..222667f657 100644 --- a/extra/pop3/server/server.factor +++ b/extra/pop3/server/server.factor @@ -245,7 +245,7 @@ This is the body of the second test. } cond nip [ process ] when ; :: mock-pop3-server ( promise -- ) - #! Store the port we are running on in the promise. + ! Store the port we are running on in the promise. [ [ "127.0.0.1" 0 utf8 [ diff --git a/extra/project-euler/070/070.factor b/extra/project-euler/070/070.factor index 38aa022b3d..499ce21c34 100644 --- a/extra/project-euler/070/070.factor +++ b/extra/project-euler/070/070.factor @@ -47,7 +47,7 @@ IN: project-euler.070 7 10^ sqrt >integer 1000 [ - ] [ + ] 2bi primes-between ; inline : n-and-phi ( seq -- seq' ) - #! ( seq = { p1, p2 } -- seq' = { n, φ(n) } ) + ! ( seq = { p1, p2 } -- seq' = { n, φ(n) } ) [ product ] [ [ 1 - ] map product ] bi 2array ; : fit-requirements? ( seq -- ? ) diff --git a/extra/project-euler/099/099.factor b/extra/project-euler/099/099.factor index 36fe7783fe..64c5533a69 100644 --- a/extra/project-euler/099/099.factor +++ b/extra/project-euler/099/099.factor @@ -35,7 +35,7 @@ IN: project-euler.099 ascii file-lines [ "," split [ string>number ] map ] map ; : simplify ( seq -- seq ) - #! exponent * log(base) + ! exponent * log(base) flip first2 swap [ log ] map v* ; : solve ( seq -- index ) diff --git a/extra/reports/noise/noise.factor b/extra/reports/noise/noise.factor index 8f30dd4244..3f4090c118 100644 --- a/extra/reports/noise/noise.factor +++ b/extra/reports/noise/noise.factor @@ -87,8 +87,8 @@ M: array noise [ noise ] map vsum ; : noise-factor ( x y -- z ) / 100 * >integer ; : quot-noise-factor ( quot -- n ) - #! For very short words, noise doesn't count so much - #! (so dup foo swap bar isn't penalized as badly). + ! For very short words, noise doesn't count so much + ! (so dup foo swap bar isn't penalized as badly). noise first2 { { [ over 4 <= ] [ [ drop 0 ] dip ] } { [ over 15 >= ] [ [ 2 * ] dip ] } diff --git a/extra/sequences/modified/modified.factor b/extra/sequences/modified/modified.factor index aa4cb57bb5..8b2132c6d2 100644 --- a/extra/sequences/modified/modified.factor +++ b/extra/sequences/modified/modified.factor @@ -55,7 +55,7 @@ M: summed length seqs>> longest length ; ; : bitmap-index ( point -- index ) - #! Point is a {x y}. + ! Point is a {x y}. first2 game-width 3 * * swap 3 * + ; :: set-bitmap-pixel ( bitmap point color -- ) @@ -30,7 +30,7 @@ CONSTANT: game-height 256 color third index 2 + bitmap set-nth ; : get-bitmap-pixel ( point array -- color ) - #! Point is a {x y}. color is a {r g b} + ! Point is a {x y}. color is a {r g b} [ bitmap-index ] dip [ nth ] [ [ 1 + ] dip nth ] @@ -81,35 +81,35 @@ CONSTANT: SOUND-UFO-HIT 8 swap sounds>> nth source-stop ; : read-port1 ( cpu -- byte ) - #! Port 1 maps the keys for space invaders - #! Bit 0 = coin slot - #! Bit 1 = two players button - #! Bit 2 = one player button - #! Bit 4 = player one fire - #! Bit 5 = player one left - #! Bit 6 = player one right + ! Port 1 maps the keys for space invaders + ! Bit 0 = coin slot + ! Bit 1 = two players button + ! Bit 2 = one player button + ! Bit 4 = player one fire + ! Bit 5 = player one left + ! Bit 6 = player one right [ dup 0xFE bitand ] change-port1 drop ; : read-port2 ( cpu -- byte ) - #! Port 2 maps player 2 controls and dip switches - #! Bit 0,1 = number of ships - #! Bit 2 = mode (1=easy, 0=hard) - #! Bit 4 = player two fire - #! Bit 5 = player two left - #! Bit 6 = player two right - #! Bit 7 = show or hide coin info + ! Port 2 maps player 2 controls and dip switches + ! Bit 0,1 = number of ships + ! Bit 2 = mode (1=easy, 0=hard) + ! Bit 4 = player two fire + ! Bit 5 = player two left + ! Bit 6 = player two right + ! Bit 7 = show or hide coin info [ port2i>> 0x8F bitand ] [ port1>> 0x70 bitand bitor ] bi ; : read-port3 ( cpu -- byte ) - #! Used to compute a special formula + ! Used to compute a special formula [ port4hi>> 8 shift ] keep [ port4lo>> bitor ] keep port2o>> shift -8 shift 0xFF bitand ; M: space-invaders read-port - #! Read a byte from the hardware port. 'port' should - #! be an 8-bit value. + ! Read a byte from the hardware port. 'port' should + ! be an 8-bit value. swap { { 1 [ read-port1 ] } { 2 [ read-port2 ] } @@ -118,7 +118,7 @@ M: space-invaders read-port } case ; : write-port2 ( value cpu -- ) - #! Setting this value affects the value read from port 3 + ! Setting this value affects the value read from port 3 port2o<< ; :: bit-newly-set? ( old-value new-value bit -- bool ) @@ -131,12 +131,12 @@ M: space-invaders read-port [ port5o>> swap ] dip bit-newly-set? ; : write-port3 ( value cpu -- ) - #! Connected to the sound hardware - #! Bit 0 = spaceship sound (looped) - #! Bit 1 = Shot - #! Bit 2 = Your ship hit - #! Bit 3 = Invader hit - #! Bit 4 = Extended play sound + ! Connected to the sound hardware + ! Bit 0 = spaceship sound (looped) + ! Bit 1 = Shot + ! Bit 2 = Your ship hit + ! Bit 3 = Invader hit + ! Bit 4 = Extended play sound over 0 bit? [ dup looping?>> [ dup SOUND-UFO play-invaders-sound @@ -155,17 +155,17 @@ M: space-invaders read-port port3o<< ; : write-port4 ( value cpu -- ) - #! Affects the value returned by reading port 3 + ! Affects the value returned by reading port 3 [ port4hi>> ] [ port4lo<< ] [ port4hi<< ] tri ; : write-port5 ( value cpu -- ) - #! Plays sounds - #! Bit 0 = invaders sound 1 - #! Bit 1 = invaders sound 2 - #! Bit 2 = invaders sound 3 - #! Bit 3 = invaders sound 4 - #! Bit 4 = spaceship hit - #! Bit 5 = amplifier enabled/disabled + ! Plays sounds + ! Bit 0 = invaders sound 1 + ! Bit 1 = invaders sound 2 + ! Bit 2 = invaders sound 3 + ! Bit 3 = invaders sound 4 + ! Bit 4 = spaceship hit + ! Bit 5 = amplifier enabled/disabled 2dup 0 port5-newly-set? [ dup SOUND-WALK1 play-invaders-sound ] when 2dup 1 port5-newly-set? [ dup SOUND-WALK2 play-invaders-sound ] when 2dup 2 port5-newly-set? [ dup SOUND-WALK3 play-invaders-sound ] when @@ -174,8 +174,8 @@ M: space-invaders read-port port5o<< ; M: space-invaders write-port - #! Write a byte to the hardware port, where 'port' is - #! an 8-bit value. + ! Write a byte to the hardware port, where 'port' is + ! an 8-bit value. swap { { 2 [ write-port2 ] } { 3 [ write-port3 ] } @@ -292,17 +292,17 @@ CONSTANT: green { 0 255 0 } CONSTANT: red { 255 0 0 } : addr>xy ( addr -- point ) - #! Convert video RAM address to base X Y value. point is a {x y}. + ! Convert video RAM address to base X Y value. point is a {x y}. 0x2400 - ! n dup 0x1f bitand 8 * 255 swap - ! n y swap -5 shift swap 2array ; : plot-bitmap-pixel ( bitmap point color -- ) - #! point is a {x y}. color is a {r g b}. + ! point is a {x y}. color is a {r g b}. set-bitmap-pixel ; : get-point-color ( point -- color ) - #! Return the color to use for the given x/y position. + ! Return the color to use for the given x/y position. first2 { { [ dup 184 238 between? pick 0 223 between? and ] [ 2drop green ] } @@ -312,7 +312,7 @@ CONSTANT: red { 255 0 0 } } cond ; : plot-bitmap-bits ( bitmap point byte bit -- ) - #! point is a {x y}. + ! point is a {x y}. [ first2 ] 2dip dup swapd -1 * shift 1 bitand 0 = [ - 2array ] dip @@ -330,15 +330,15 @@ M: space-invaders update-video ] if ; : sync-frame ( micros -- micros ) - #! Sleep until the time for the next frame arrives. + ! Sleep until the time for the next frame arrives. 16,667 + system:nano-count - dup 0 > [ 1,000 * threads:sleep ] [ drop threads:yield ] if system:nano-count ; : invaders-process ( micros gadget -- ) - #! Run a space invaders gadget inside a - #! concurrent process. Messages can be sent to - #! signal key presses, etc. + ! Run a space invaders gadget inside a + ! concurrent process. Messages can be sent to + ! signal key presses, etc. dup quit?>> [ 2drop ] [ diff --git a/extra/tetris/board/board.factor b/extra/tetris/board/board.factor index b6239348ab..00ddda0021 100644 --- a/extra/tetris/board/board.factor +++ b/extra/tetris/board/board.factor @@ -49,6 +49,6 @@ TUPLE: board { width integer } { height integer } rows ; [ [ row-not-full? ] filter ] change-rows ; : check-rows ( board -- n ) - #! remove full rows, then add blank ones at the top, returning the number - #! of rows removed (and added) + ! remove full rows, then add blank ones at the top, returning the number + ! of rows removed (and added) remove-full-rows dup height>> over rows>> length - swap top-up-rows ; diff --git a/extra/tetris/game/game.factor b/extra/tetris/game/game.factor index e2b00d9b56..ae7db29539 100644 --- a/extra/tetris/game/game.factor +++ b/extra/tetris/game/game.factor @@ -86,7 +86,7 @@ CONSTANT: default-height 20 [ drop board>> ] [ [ current-piece clone ] dip move-piece ] 2bi piece-valid? ; : tetris-move ( tetris move -- ? ) - #! moves the piece if possible, returns whether the piece was moved + ! moves the piece if possible, returns whether the piece was moved 2dup can-move? [ [ current-piece ] dip move-piece drop t ] [ diff --git a/extra/tetris/gl/gl.factor b/extra/tetris/gl/gl.factor index 788febace7..850fd653d4 100644 --- a/extra/tetris/gl/gl.factor +++ b/extra/tetris/gl/gl.factor @@ -36,7 +36,7 @@ IN: tetris.gl [ width>> ] [ height>> ] bi swapd [ / ] dup 2bi* 1 glScalef ; : draw-tetris ( width height tetris -- ) - #! width and height are in pixels + ! width and height are in pixels [ { [ board>> scale-board ] diff --git a/extra/tetris/piece/piece.factor b/extra/tetris/piece/piece.factor index 0a24b2033c..b7b0b096ca 100644 --- a/extra/tetris/piece/piece.factor +++ b/extra/tetris/piece/piece.factor @@ -16,11 +16,11 @@ TUPLE: piece piece new swap >>tetromino ; : (piece-blocks) ( piece -- blocks ) - #! rotates the piece + ! rotates the piece [ rotation>> ] [ tetromino>> states>> ] bi nth ; : piece-blocks ( piece -- blocks ) - #! rotates and positions the piece + ! rotates and positions the piece [ (piece-blocks) ] [ location>> ] bi [ v+ ] curry map ; : piece-width ( piece -- width ) @@ -36,7 +36,7 @@ TUPLE: piece [ [ ] curry ] keep [ ] curry lazy-cons ; : modulo ( n m -- n ) - #! -2 7 mod => -2, -2 7 modulo => 5 + ! -2 7 mod => -2, -2 7 modulo => 5 [ mod ] [ + ] [ mod ] tri ; : (rotate-piece) ( rotation inc n-states -- rotation' ) diff --git a/extra/trees/avl/avl.factor b/extra/trees/avl/avl.factor index 2d55e79f45..5e670abe1f 100644 --- a/extra/trees/avl/avl.factor +++ b/extra/trees/avl/avl.factor @@ -114,7 +114,7 @@ M: avl set-at ( value key node -- ) ] if* ; : replace-with-a-child ( node -- node shorter? ) - #! assumes that node is not a leaf, otherwise will recurse forever + ! assumes that node is not a leaf, otherwise will recurse forever dup node-link [ dupd [ avl-replace-with-extremity ] with-other-side [ over set-node-link ] dip [ balance-delete ] [ f ] if @@ -123,8 +123,8 @@ M: avl set-at ( value key node -- ) ] if* ; : avl-delete-node ( node -- node shorter? ) - #! delete this node, returning its replacement, and whether this subtree is - #! shorter as a result + ! delete this node, returning its replacement, and whether this subtree is + ! shorter as a result dup leaf? [ drop f t ] [ diff --git a/extra/trees/trees.factor b/extra/trees/trees.factor index b182d67aa6..e59af367cd 100644 --- a/extra/trees/trees.factor +++ b/extra/trees/trees.factor @@ -151,8 +151,8 @@ DEFER: delete-node ] if* ; : prune-extremity ( node -- new-extremity ) - #! remove and return the leftmost or rightmost child of this node. - #! assumes at least one child + ! remove and return the leftmost or rightmost child of this node. + ! assumes at least one child dup node-link (prune-extremity) ; : replace-with-child ( node -- node ) @@ -168,11 +168,11 @@ DEFER: delete-node ] if ; : delete-node-with-two-children ( node -- node ) - #! randomised to minimise tree unbalancing + ! randomised to minimise tree unbalancing random-side [ replace-with-extremity ] with-side ; : delete-node ( node -- node ) - #! delete this node, returning its replacement + ! delete this node, returning its replacement dup [ right>> ] [ left>> ] bi [ swap [ drop delete-node-with-two-children diff --git a/extra/turing/turing.factor b/extra/turing/turing.factor index 18d66a2e51..e4edf681b7 100644 --- a/extra/turing/turing.factor +++ b/extra/turing/turing.factor @@ -41,30 +41,30 @@ SYMBOL: tape 20 0 >vector tape set : sym ( -- sym ) - #! Symbol at head position. + ! Symbol at head position. position get tape get nth ; : set-sym ( sym -- ) - #! Set symbol at head position. + ! Set symbol at head position. position get tape get set-nth ; : next-state ( -- state ) - #! Look up the next state/symbol/direction triplet. + ! Look up the next state/symbol/direction triplet. state get sym 2array states get at ; : turing-step ( -- ) - #! Do one step of the turing machine. + ! Do one step of the turing machine. next-state dup sym>> set-sym dup dir>> position [ + ] change next>> state set ; : c ( -- ) - #! Print current turing machine state. + ! Print current turing machine state. state get . tape get . 2 position get 2 * + CHAR: \s write "^" print ; : n ( -- ) - #! Do one step and print new state. + ! Do one step and print new state. turing-step c ; diff --git a/extra/ui/gadgets/lists/lists.factor b/extra/ui/gadgets/lists/lists.factor index 249698e8dc..e30c887784 100644 --- a/extra/ui/gadgets/lists/lists.factor +++ b/extra/ui/gadgets/lists/lists.factor @@ -67,8 +67,8 @@ M: list focusable-child* drop t ; dup index>> swap control-value ?nth ; : scroll>selected ( list -- ) - #! We change the rectangle's width to zero to avoid - #! scrolling right. + ! We change the rectangle's width to zero to avoid + ! scrolling right. [ selected-rect rect-bounds { 0 1 } v* ] keep scroll>rect ; diff --git a/extra/ui/render/test/test.factor b/extra/ui/render/test/test.factor index abf3c31880..a55b5a6e31 100644 --- a/extra/ui/render/test/test.factor +++ b/extra/ui/render/test/test.factor @@ -23,7 +23,7 @@ M: line-test draw-interior SYMBOL: render-output : twiddle ( bytes -- bytes ) - #! On Windows, white is { 253 253 253 } ? + ! On Windows, white is { 253 253 253 } ? [ 10 /i ] map ; : bitmap= ( bitmap1 bitmap2 -- ? ) diff --git a/unmaintained/adsoda/solution2/solution2.factor b/unmaintained/adsoda/solution2/solution2.factor index 85bfb14d81..9b75e0573f 100644 --- a/unmaintained/adsoda/solution2/solution2.factor +++ b/unmaintained/adsoda/solution2/solution2.factor @@ -40,7 +40,7 @@ SYMBOL: matrix over [ find-from drop ] dip length or ; inline : first-col ( row# -- n ) - #! First non-zero column + ! First non-zero column 0 swap nth-row [ zero? not ] skip ; : clear-scale ( col# pivot-row i-row -- n ) diff --git a/unmaintained/arm/allot/allot.factor b/unmaintained/arm/allot/allot.factor index 27a4676926..6949d3b4f5 100644 --- a/unmaintained/arm/allot/allot.factor +++ b/unmaintained/arm/allot/allot.factor @@ -9,8 +9,8 @@ IN: cpu.arm.allot : load-zone-ptr ( reg -- ) "nursery" f rot %alien-global ; : %allot ( header size -- ) - #! Store a pointer to 'size' bytes allocated from the - #! nursery in R11 + ! Store a pointer to 'size' bytes allocated from the + ! nursery in R11 8 align ! align the size R12 load-zone-ptr ! nusery -> r12 R11 R12 cell <+> LDR ! nursery.here -> r11 @@ -25,17 +25,17 @@ IN: cpu.arm.allot >r dup fresh-object v>operand R11 r> tag-number ORR ; : %allot-bignum ( #digits -- ) - #! 1 cell header, 1 cell length, 1 cell sign, + digits - #! length is the # of digits + sign + ! 1 cell header, 1 cell length, 1 cell sign, + digits + ! length is the # of digits + sign bignum over 3 + cells %allot R12 swap 1+ v>operand MOV ! compute the length R12 R11 cell <+> STR ! store the length ; : %allot-bignum-signed-1 ( dst src -- ) - #! on entry, reg is a 30-bit quantity sign-extended to - #! 32-bits. - #! exits with tagged ptr to bignum in reg. + ! on entry, reg is a 30-bit quantity sign-extended to + ! 32-bits. + ! exits with tagged ptr to bignum in reg. [ "end" define-label ! is it zero? diff --git a/unmaintained/arm/architecture/architecture.factor b/unmaintained/arm/architecture/architecture.factor index 21b847f4f6..f4ad13d60c 100644 --- a/unmaintained/arm/architecture/architecture.factor +++ b/unmaintained/arm/architecture/architecture.factor @@ -100,8 +100,8 @@ M: arm-backend %epilogue ( n -- ) [ compile-dlsym ] keep dup 0 <+> LDR ; M: arm-backend %profiler-prologue ( -- ) - #! We can clobber R0 here since it is undefined at the start - #! of a word. + ! We can clobber R0 here since it is undefined at the start + ! of a word. R12 load-indirect R0 R12 profile-count-offset <+> LDR R0 R0 1 v>operand ADD @@ -112,7 +112,7 @@ M: arm-backend %call-label ( label -- ) BL ; M: arm-backend %jump-label ( label -- ) B ; : %prepare-primitive ( -- ) - #! Save stack pointer to stack_chain->callstack_top, load XT + ! Save stack pointer to stack_chain->callstack_top, load XT R1 SP 4 SUB ; M: arm-backend %call-primitive ( word -- ) @@ -132,7 +132,7 @@ M: arm-backend %jump-t ( label -- ) "flag" operand f v>operand CMP NE B ; : (%dispatch) ( word-table# -- ) - #! Load jump table target address into reg. + ! Load jump table target address into reg. "scratch" operand PC "n" operand 1 ADD "scratch" operand dup 0 <+> LDR rc-indirect-arm rel-dispatch @@ -210,14 +210,14 @@ M: arm-backend %unbox-long-long ( n func -- ) ] when* ; M: arm-backend %unbox-small-struct ( size -- ) - #! Alien must be in R0. + ! Alien must be in R0. drop "alien_offset" f %alien-invoke ! Load first cell R0 R0 0 <+> LDR ; M: arm-backend %unbox-large-struct ( n size -- ) - #! Alien must be in R0. + ! Alien must be in R0. ! Compute destination address R1 SP roll ADD R2 swap MOV @@ -239,7 +239,7 @@ M: arm-backend %box-long-long ( n func -- ) ] when* r> f %alien-invoke ; M: arm-backend %box-small-struct ( size -- ) - #! Box a 4-byte struct returned in R0. + ! Box a 4-byte struct returned in R0. R2 swap MOV "box_small_struct" f %alien-invoke ; @@ -270,9 +270,9 @@ M: arm-backend struct-small-enough? ( size -- ? ) 4 <= ; M: arm-backend %prepare-alien-invoke - #! Save Factor stack pointers in case the C code calls a - #! callback which does a GC, which must reliably trace - #! all roots. + ! Save Factor stack pointers in case the C code calls a + ! callback which does a GC, which must reliably trace + ! all roots. "stack_chain" f R12 %alien-global SP R12 0 <+> STR ds-reg R12 8 <+> STR @@ -331,9 +331,9 @@ M: arm-backend %unbox-f ( dst src -- ) drop v>operand 0 MOV ; M: arm-backend %unbox-any-c-ptr ( dst src -- ) - #! We need three registers here. R11 and R12 are reserved - #! temporary registers. The third one is R14, which we have - #! to save/restore. + ! We need three registers here. R11 and R12 are reserved + ! temporary registers. The third one is R14, which we have + ! to save/restore. "end" define-label "start" define-label ! Save R14. diff --git a/unmaintained/arm/intrinsics/intrinsics.factor b/unmaintained/arm/intrinsics/intrinsics.factor index e9902888eb..d7ddd0c659 100644 --- a/unmaintained/arm/intrinsics/intrinsics.factor +++ b/unmaintained/arm/intrinsics/intrinsics.factor @@ -277,7 +277,7 @@ IN: cpu.arm.intrinsics } define-intrinsic : userenv ( reg -- ) - #! Load the userenv pointer in a register. + ! Load the userenv pointer in a register. "userenv" f rot compile-dlsym ; \ getenv [ diff --git a/unmaintained/cont-responder/callbacks.factor b/unmaintained/cont-responder/callbacks.factor index d07abcbe76..088ae6d1bc 100644 --- a/unmaintained/cont-responder/callbacks.factor +++ b/unmaintained/cont-responder/callbacks.factor @@ -43,17 +43,17 @@ TUPLE: callback cont quot expires alarm responder ; callback-responder get callbacks>> set-at-unique ; : forward-to-url ( url -- * ) - #! When executed inside a 'show' call, this will force a - #! HTTP 302 to occur to instruct the browser to forward to - #! the request URL. + ! When executed inside a 'show' call, this will force a + ! HTTP 302 to occur to instruct the browser to forward to + ! the request URL. exit-with ; : cont-id "factorcontid" ; : forward-to-id ( id -- * ) - #! When executed inside a 'show' call, this will force a - #! HTTP 302 to occur to instruct the browser to forward to - #! the request URL. + ! When executed inside a 'show' call, this will force a + ! HTTP 302 to occur to instruct the browser to forward to + ! the request URL. swap cont-id set-query-param forward-to-url ; @@ -63,13 +63,13 @@ TUPLE: callback cont quot expires alarm responder ; SYMBOL: post-refresh-get? : redirect-to-here ( -- ) - #! Force a redirect to the client browser so that the browser - #! goes to the current point in the code. This forces an URL - #! change on the browser so that refreshing that URL will - #! immediately run from this code point. This prevents the - #! "this request will issue a POST" warning from the browser - #! and prevents re-running the previous POST logic. This is - #! known as the 'post-refresh-get' pattern. + ! Force a redirect to the client browser so that the browser + ! goes to the current point in the code. This forces an URL + ! change on the browser so that refreshing that URL will + ! immediately run from this code point. This prevents the + ! "this request will issue a POST" warning from the browser + ! and prevents re-running the previous POST logic. This is + ! known as the 'post-refresh-get' pattern. post-refresh-get? get [ [ [ ] t register-callback forward-to-id @@ -81,10 +81,10 @@ SYMBOL: post-refresh-get? SYMBOL: current-show : store-current-show ( -- ) - #! Store the current continuation in the variable 'current-show' - #! so it can be returned to later by 'quot-id'. Note that it - #! recalls itself when the continuation is called to ensure that - #! it resets its value back to the most recent show call. + ! Store the current continuation in the variable 'current-show' + ! so it can be returned to later by 'quot-id'. Note that it + ! recalls itself when the continuation is called to ensure that + ! it resets its value back to the most recent show call. [ current-show set f ] callcc1 [ restore-request store-current-show ] when* ; diff --git a/unmaintained/db/mysql/lib/lib.factor b/unmaintained/db/mysql/lib/lib.factor index db8c08180b..6c162488ed 100644 --- a/unmaintained/db/mysql/lib/lib.factor +++ b/unmaintained/db/mysql/lib/lib.factor @@ -53,8 +53,8 @@ TUPLE: mysql-result-set ; ! mysql-connection-resulthandle mysql_num_fields ; ! : mysql-char*-nth ( index object -- str ) - ! #! Utility based on 'char*-nth' to perform an additional sanity check on the value - ! #! extracted from the array of strings. + ! ! Utility based on 'char*-nth' to perform an additional sanity check on the value + ! ! extracted from the array of strings. ! void*-nth [ alien>char-string ] [ "" ] if* ; ! : mysql-row>seq ( object n -- seq ) diff --git a/unmaintained/odbc/odbc.factor b/unmaintained/odbc/odbc.factor index 6dcddb5bd5..91446630d6 100644 --- a/unmaintained/odbc/odbc.factor +++ b/unmaintained/odbc/odbc.factor @@ -115,7 +115,7 @@ SYMBOL: SQL-TYPE-UNKNOWN } case ; : succeeded? ( n -- bool ) - #! Did the call succeed (SQL-SUCCESS or SQL-SUCCESS-WITH-INFO) + ! Did the call succeed (SQL-SUCCESS or SQL-SUCCESS-WITH-INFO) { { SQL-SUCCESS [ t ] } { SQL-SUCCESS-WITH-INFO [ t ] } diff --git a/unmaintained/ogg/player/player.factor b/unmaintained/ogg/player/player.factor index cbdb83fd4c..30ee010637 100644 --- a/unmaintained/ogg/player/player.factor +++ b/unmaintained/ogg/player/player.factor @@ -170,7 +170,7 @@ HINTS: yuv>rgb byte-array byte-array ; [ buffers>> second uint alSourceQueueBuffers check-error ] keep ; : fill-processed-audio-buffer ( player n -- player ) - #! n is the number of audio buffers processed + ! n is the number of audio buffers processed over >r >r dup source>> r> pick buffer-indexes>> [ alSourceUnqueueBuffers check-error ] keep uint deref dup r> swap >r al-channel-format rot @@ -199,8 +199,8 @@ HINTS: yuv>rgb byte-array byte-array ; dup playing?>> [ append-audio ] [ start-audio ] if ; : read-bytes-into ( dest size stream -- len ) - #! Read the given number of bytes from a stream - #! and store them in the destination byte array. + ! Read the given number of bytes from a stream + ! and store them in the destination byte array. stream-read >byte-array dup length [ memcpy ] keep ; : check-not-negative ( int -- ) @@ -219,31 +219,31 @@ HINTS: yuv>rgb byte-array byte-array ; [ oy>> swap ogg_sync_wrote check-not-negative ] 2keep swap zero? ; : buffer-data ( player -- player eof? ) - #! Take some compressed bitstream data and sync it for - #! page extraction. + ! Take some compressed bitstream data and sync it for + ! page extraction. sync-buffer stream-into-buffer confirm-buffer ; : queue-page ( player -- player ) - #! Push a page into the stream for packetization + ! Push a page into the stream for packetization [ [ vo>> ] [ og>> ] bi ogg_stream_pagein drop ] [ [ to>> ] [ og>> ] bi ogg_stream_pagein drop ] [ ] tri ; : retrieve-page ( player -- player bool ) - #! Sync the streams and get a page. Return true if a page was - #! successfully retrieved. + ! Sync the streams and get a page. Return true if a page was + ! successfully retrieved. dup [ oy>> ] [ og>> ] bi ogg_sync_pageout 0 > ; : standard-initial-header? ( player -- player bool ) dup og>> ogg_page_bos zero? not ; : ogg-stream-init ( player -- state player ) - #! Init the encode/decode logical stream state + ! Init the encode/decode logical stream state [ temp-state>> ] keep [ og>> ogg_page_serialno ogg_stream_init check-not-negative ] 2keep ; : ogg-stream-pagein ( state player -- state player ) - #! Add the incoming page to the stream state + ! Add the incoming page to the stream state [ og>> ogg_stream_pagein drop ] 2keep ; : ogg-stream-packetout ( state player -- state player ) @@ -253,28 +253,28 @@ HINTS: yuv>rgb byte-array byte-array ; ogg-stream-init ogg-stream-pagein ogg-stream-packetout ; : theora-header? ( player -- player bool ) - #! Is the current page a theora header? + ! Is the current page a theora header? dup [ ti>> ] [ tc>> ] [ op>> ] tri theora_decode_header 0 >= ; : is-theora-packet? ( player -- player bool ) dup theora>> zero? [ theora-header? ] [ f ] if ; : copy-to-theora-state ( state player -- player ) - #! Copy the state to the theora state structure in the player + ! Copy the state to the theora state structure in the player [ to>> swap dup length memcpy ] keep ; : handle-initial-theora-header ( state player -- player ) copy-to-theora-state 1 >>theora ; : vorbis-header? ( player -- player bool ) - #! Is the current page a vorbis header? + ! Is the current page a vorbis header? dup [ vi>> ] [ vc>> ] [ op>> ] tri vorbis_synthesis_headerin 0 >= ; : is-vorbis-packet? ( player -- player bool ) dup vorbis>> zero? [ vorbis-header? ] [ f ] if ; : copy-to-vorbis-state ( state player -- player ) - #! Copy the state to the vorbis state structure in the player + ! Copy the state to the vorbis state structure in the player [ vo>> swap dup length memcpy ] keep ; : handle-initial-vorbis-header ( state player -- player ) @@ -284,7 +284,7 @@ HINTS: yuv>rgb byte-array byte-array ; swap ogg_stream_clear drop ; : process-initial-header ( player -- player bool ) - #! Is this a standard initial header? If not, stop parsing + ! Is this a standard initial header? If not, stop parsing standard-initial-header? [ decode-packet { { [ is-vorbis-packet? ] [ handle-initial-vorbis-header ] } @@ -296,13 +296,13 @@ HINTS: yuv>rgb byte-array byte-array ; ] if ; : parse-initial-headers ( player -- player ) - #! Parse Vorbis headers, ignoring any other type stored - #! in the Ogg container. + ! Parse Vorbis headers, ignoring any other type stored + ! in the Ogg container. retrieve-page [ process-initial-header [ parse-initial-headers ] [ - #! Don't leak the page, get it into the appropriate stream + ! Don't leak the page, get it into the appropriate stream queue-page ] if ] [ @@ -310,15 +310,15 @@ HINTS: yuv>rgb byte-array byte-array ; ] if ; : have-required-vorbis-headers? ( player -- player bool ) - #! Return true if we need to decode vorbis due to there being - #! vorbis headers read from the stream but we don't have them all - #! yet. + ! Return true if we need to decode vorbis due to there being + ! vorbis headers read from the stream but we don't have them all + ! yet. dup vorbis>> 1 2 between? not ; : have-required-theora-headers? ( player -- player bool ) - #! Return true if we need to decode theora due to there being - #! theora headers read from the stream but we don't have them all - #! yet. + ! Return true if we need to decode theora due to there being + ! theora headers read from the stream but we don't have them all + ! yet. dup theora>> 1 2 between? not ; : get-remaining-vorbis-header-packet ( player -- player bool ) @@ -472,7 +472,7 @@ HINTS: yuv>rgb byte-array byte-array ; ] when dup vd>> granulepos>> dup 0 >= [ ! numtoread player granulepos - #! This is wrong: fix + ! This is wrong: fix pick - >>audio-granulepos ] [ ! numtoread player granulepos @@ -481,20 +481,20 @@ HINTS: yuv>rgb byte-array byte-array ; [ vd>> swap vorbis_synthesis_read drop ] keep ; : no-pending-audio ( player -- player bool ) - #! No pending audio. Is there a pending packet to decode. + ! No pending audio. Is there a pending packet to decode. dup [ vo>> ] [ op>> ] bi ogg_stream_packetout 0 > [ dup [ vb>> ] [ op>> ] bi vorbis_synthesis 0 = [ dup [ vd>> ] [ vb>> ] bi vorbis_synthesis_blockin drop ] when t ] [ - #! Need more data. Break out to suck in another page. + ! Need more data. Break out to suck in another page. f ] if ; : decode-audio ( player -- player ) audio-buffer-not-ready? [ - #! If there's pending decoded audio, grab it + ! If there's pending decoded audio, grab it pending-decoded-audio? [ decode-pending-audio decode-audio ] [ @@ -579,7 +579,7 @@ HINTS: yuv>rgb byte-array byte-array ; delete-openal-source ; : wait-for-sound ( player -- player ) - #! Waits for the openal to finish playing remaining sounds + ! Waits for the openal to finish playing remaining sounds dup source>> AL_SOURCE_STATE 0 [ alGetSourcei check-error ] keep *int AL_PLAYING = [ 100 sleep diff --git a/unmaintained/sandbox/syntax/syntax.factor b/unmaintained/sandbox/syntax/syntax.factor index f04b05acd8..474ce12ef2 100644 --- a/unmaintained/sandbox/syntax/syntax.factor +++ b/unmaintained/sandbox/syntax/syntax.factor @@ -18,7 +18,7 @@ SYNTAX: APPLY: scan sandbox-use+ ; SYNTAX: APPLYING: ";" parse-tokens [ sandbox-use+ ] each ; REVEALING: - ! #! + ! ! HEX: OCT: BIN: f t CHAR: " [ { T{ ] } ; diff --git a/unmaintained/sniffer/io/filter/bsd/bsd.factor b/unmaintained/sniffer/io/filter/bsd/bsd.factor index 4f6d8b2420..3c32e34633 100644 --- a/unmaintained/sniffer/io/filter/bsd/bsd.factor +++ b/unmaintained/sniffer/io/filter/bsd/bsd.factor @@ -8,7 +8,7 @@ IN: io.sniffer.filter.bsd ! http://www.iana.org/assignments/ethernet-numbers : bpf-align ( n -- n' ) - #! Align to next higher word size + ! Align to next higher word size "long" heap-size align ; M: unix-io packet. ( string -- ) diff --git a/unmaintained/triggers/triggers.factor b/unmaintained/triggers/triggers.factor index ffdfe373cd..83dc4c56b6 100644 --- a/unmaintained/triggers/triggers.factor +++ b/unmaintained/triggers/triggers.factor @@ -13,8 +13,8 @@ IN: triggers swap triggers set-at ; : add-trigger ( key quot trigger -- ) - #! trigger should be a symbol. Note that symbols with the same name but - #! different vocab are not equal + ! trigger should be a symbol. Note that symbols with the same name but + ! different vocab are not equal trigger-graph add-vertex ; : before ( key1 key2 trigger -- ) diff --git a/unmaintained/webapps/numbers/numbers.factor b/unmaintained/webapps/numbers/numbers.factor index 59247e934c..5f0a1911ae 100644 --- a/unmaintained/webapps/numbers/numbers.factor +++ b/unmaintained/webapps/numbers/numbers.factor @@ -37,7 +37,7 @@ math.parser random webapps.continuation ; IN: webapps.numbers : web-print ( str -- ) - #! Display the string in a web page. + ! Display the string in a web page. [ swap dup -- 2.34.1