From 1951d739a0f699b62e2aec683580f87845a29495 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 23 Feb 2009 20:27:05 -0600
Subject: [PATCH 1/7] Stack effect declarations are mandatory on all words now
define-temp now takes an effect parameter Fix compiler bug that Dan found
Stricter enforcement of * effects Move compile-call from compiler.units to
compiler
---
basis/alien/c-types/c-types.factor | 6 +-
basis/checksums/openssl/openssl.factor | 4 +-
basis/cocoa/application/application.factor | 6 +-
basis/cocoa/dialogs/dialogs.factor | 4 +-
basis/cocoa/messages/messages.factor | 14 +-
basis/cocoa/pasteboard/pasteboard.factor | 2 +-
basis/cocoa/runtime/runtime.factor | 18 +-
basis/cocoa/subclassing/subclassing.factor | 6 +-
basis/cocoa/views/views.factor | 74 ++---
basis/compiler/compiler-docs.factor | 9 +-
basis/compiler/compiler.factor | 5 +-
basis/compiler/tests/codegen.factor | 4 +-
basis/compiler/tests/curry.factor | 8 +-
basis/compiler/tests/float.factor | 2 +-
basis/compiler/tests/intrinsics.factor | 2 +-
basis/compiler/tests/optimizer.factor | 9 +-
basis/compiler/tests/peg-regression-2.factor | 15 +
basis/compiler/tests/simple.factor | 2 +-
basis/compiler/tests/tuples.factor | 2 +-
.../tree/comparisons/comparisons.factor | 4 +-
basis/core-foundation/strings/strings.factor | 28 +-
basis/functors/functors.factor | 4 +-
basis/io/backend/unix/unix.factor | 2 +-
basis/none/none.factor | 2 +-
basis/opengl/glu/glu.factor | 294 +++++++++---------
basis/openssl/libcrypto/libcrypto.factor | 2 +-
basis/peg/parsers/parsers.factor | 4 +-
basis/stack-checker/backend/backend.factor | 48 +--
.../known-words/known-words.factor | 6 +
basis/threads/threads.factor | 2 +-
basis/tools/deploy/config/config.factor | 8 +-
basis/tools/deploy/shaker/shaker.factor | 2 +-
basis/ui/cocoa/views/views.factor | 8 +-
basis/ui/gadgets/buttons/buttons.factor | 2 +-
basis/ui/gadgets/frames/frames.factor | 18 +-
basis/ui/gadgets/sliders/sliders.factor | 2 +-
basis/ui/gadgets/theme/theme.factor | 4 +-
basis/ui/render/render.factor | 10 +-
basis/unicode/data/data.factor | 8 +-
core/bootstrap/primitives.factor | 2 +-
core/compiler/units/units-docs.factor | 4 -
core/compiler/units/units.factor | 3 -
core/continuations/continuations.factor | 8 +-
core/effects/effects.factor | 2 +
core/generic/standard/standard.factor | 12 +-
core/words/words-docs.factor | 4 +-
core/words/words.factor | 4 +-
47 files changed, 349 insertions(+), 340 deletions(-)
create mode 100644 basis/compiler/tests/peg-regression-2.factor
diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index a44b5cf2b6..c3fd41e689 100755
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: byte-arrays arrays assocs kernel kernel.private libc math
namespaces make parser sequences strings words assocs splitting
@@ -275,7 +275,7 @@ M: long-long-type box-return ( type -- )
: if-void ( type true false -- )
pick "void" = [ drop nip call ] [ nip call ] if ; inline
-: primitive-types
+CONSTANT: primitive-types
{
"char" "uchar"
"short" "ushort"
@@ -284,7 +284,7 @@ M: long-long-type box-return ( type -- )
"longlong" "ulonglong"
"float" "double"
"void*" "bool"
- } ;
+ }
[
<c-type>
diff --git a/basis/checksums/openssl/openssl.factor b/basis/checksums/openssl/openssl.factor
index 4bc7a7964a..58748b7c29 100644
--- a/basis/checksums/openssl/openssl.factor
+++ b/basis/checksums/openssl/openssl.factor
@@ -9,9 +9,9 @@ ERROR: unknown-digest name ;
TUPLE: openssl-checksum name ;
-: openssl-md5 T{ openssl-checksum f "md5" } ;
+CONSTANT: openssl-md5 T{ openssl-checksum f "md5" }
-: openssl-sha1 T{ openssl-checksum f "sha1" } ;
+CONSTANT: openssl-sha1 T{ openssl-checksum f "sha1" }
INSTANCE: openssl-checksum stream-checksum
diff --git a/basis/cocoa/application/application.factor b/basis/cocoa/application/application.factor
index ab2b6375a9..19d83b86d7 100644
--- a/basis/cocoa/application/application.factor
+++ b/basis/cocoa/application/application.factor
@@ -19,9 +19,9 @@ IN: cocoa.application
] curry assoc-each
] keep ;
-: NSApplicationDelegateReplySuccess 0 ;
-: NSApplicationDelegateReplyCancel 1 ;
-: NSApplicationDelegateReplyFailure 2 ;
+CONSTANT: NSApplicationDelegateReplySuccess 0
+CONSTANT: NSApplicationDelegateReplyCancel 1
+CONSTANT: NSApplicationDelegateReplyFailure 2
: with-autorelease-pool ( quot -- )
NSAutoreleasePool -> new slip -> release ; inline
diff --git a/basis/cocoa/dialogs/dialogs.factor b/basis/cocoa/dialogs/dialogs.factor
index 13f6f0b7d6..84a1ad46a3 100644
--- a/basis/cocoa/dialogs/dialogs.factor
+++ b/basis/cocoa/dialogs/dialogs.factor
@@ -18,8 +18,8 @@ IN: cocoa.dialogs
dup 0 -> setCanChooseDirectories:
dup 0 -> setAllowsMultipleSelection: ;
-: NSOKButton 1 ;
-: NSCancelButton 0 ;
+CONSTANT: NSOKButton 1
+CONSTANT: NSCancelButton 0
: open-panel ( -- paths )
<NSOpenPanel>
diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor
index ce66467203..9a1bebd38f 100644
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@@ -1,11 +1,11 @@
-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.strings arrays assocs
-continuations combinators compiler compiler.alien kernel math
-namespaces make parser quotations sequences strings words
-cocoa.runtime io macros memoize io.encodings.utf8
-effects libc libc.private parser lexer init core-foundation fry
-generalizations specialized-arrays.direct.alien call ;
+continuations combinators compiler compiler.alien stack-checker kernel
+math namespaces make parser quotations sequences strings words
+cocoa.runtime io macros memoize io.encodings.utf8 effects libc
+libc.private parser lexer init core-foundation fry generalizations
+specialized-arrays.direct.alien call ;
IN: cocoa.messages
: make-sender ( method function -- quot )
@@ -14,7 +14,7 @@ IN: cocoa.messages
: sender-stub ( method function -- word )
[ "( sender-stub )" f <word> dup ] 2dip
over first large-struct? [ "_stret" append ] when
- make-sender define ;
+ make-sender dup infer define-declared ;
SYMBOL: message-senders
SYMBOL: super-message-senders
diff --git a/basis/cocoa/pasteboard/pasteboard.factor b/basis/cocoa/pasteboard/pasteboard.factor
index 888f5452e2..1a21b338be 100644
--- a/basis/cocoa/pasteboard/pasteboard.factor
+++ b/basis/cocoa/pasteboard/pasteboard.factor
@@ -5,7 +5,7 @@ cocoa.classes cocoa.application sequences cocoa core-foundation
core-foundation.strings core-foundation.arrays ;
IN: cocoa.pasteboard
-: NSStringPboardType "NSStringPboardType" ;
+CONSTANT: NSStringPboardType "NSStringPboardType"
: pasteboard-string? ( pasteboard -- ? )
NSStringPboardType swap -> types CF>string-array member? ;
diff --git a/basis/cocoa/runtime/runtime.factor b/basis/cocoa/runtime/runtime.factor
index 1a741b789f..7817d0006c 100644
--- a/basis/cocoa/runtime/runtime.factor
+++ b/basis/cocoa/runtime/runtime.factor
@@ -21,15 +21,15 @@ C-STRUCT: objc-super
{ "id" "receiver" }
{ "Class" "class" } ;
-: CLS_CLASS HEX: 1 ;
-: CLS_META HEX: 2 ;
-: CLS_INITIALIZED HEX: 4 ;
-: CLS_POSING HEX: 8 ;
-: CLS_MAPPED HEX: 10 ;
-: CLS_FLUSH_CACHE HEX: 20 ;
-: CLS_GROW_CACHE HEX: 40 ;
-: CLS_NEED_BIND HEX: 80 ;
-: CLS_METHOD_ARRAY HEX: 100 ;
+CONSTANT: CLS_CLASS HEX: 1
+CONSTANT: CLS_META HEX: 2
+CONSTANT: CLS_INITIALIZED HEX: 4
+CONSTANT: CLS_POSING HEX: 8
+CONSTANT: CLS_MAPPED HEX: 10
+CONSTANT: CLS_FLUSH_CACHE HEX: 20
+CONSTANT: CLS_GROW_CACHE HEX: 40
+CONSTANT: CLS_NEED_BIND HEX: 80
+CONSTANT: CLS_METHOD_ARRAY HEX: 100
FUNCTION: int objc_getClassList ( void* buffer, int bufferLen ) ;
diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor
index be53364185..0896312670 100644
--- a/basis/cocoa/subclassing/subclassing.factor
+++ b/basis/cocoa/subclassing/subclassing.factor
@@ -38,9 +38,9 @@ IN: cocoa.subclassing
] map concat ;
: prepare-method ( ret types quot -- type imp )
- [ [ encode-types ] 2keep ] dip [
- "cdecl" swap 4array % \ alien-callback ,
- ] [ ] make define-temp ;
+ [ [ encode-types ] 2keep ] dip
+ '[ _ _ "cdecl" _ alien-callback ]
+ (( -- callback )) define-temp ;
: prepare-methods ( methods -- methods )
[
diff --git a/basis/cocoa/views/views.factor b/basis/cocoa/views/views.factor
index e74e912202..4bb6468fa6 100644
--- a/basis/cocoa/views/views.factor
+++ b/basis/cocoa/views/views.factor
@@ -5,43 +5,43 @@ cocoa cocoa.messages cocoa.classes cocoa.types sequences
continuations accessors ;
IN: cocoa.views
-: NSOpenGLPFAAllRenderers 1 ;
-: NSOpenGLPFADoubleBuffer 5 ;
-: NSOpenGLPFAStereo 6 ;
-: NSOpenGLPFAAuxBuffers 7 ;
-: NSOpenGLPFAColorSize 8 ;
-: NSOpenGLPFAAlphaSize 11 ;
-: NSOpenGLPFADepthSize 12 ;
-: NSOpenGLPFAStencilSize 13 ;
-: NSOpenGLPFAAccumSize 14 ;
-: NSOpenGLPFAMinimumPolicy 51 ;
-: NSOpenGLPFAMaximumPolicy 52 ;
-: NSOpenGLPFAOffScreen 53 ;
-: NSOpenGLPFAFullScreen 54 ;
-: NSOpenGLPFASampleBuffers 55 ;
-: NSOpenGLPFASamples 56 ;
-: NSOpenGLPFAAuxDepthStencil 57 ;
-: NSOpenGLPFAColorFloat 58 ;
-: NSOpenGLPFAMultisample 59 ;
-: NSOpenGLPFASupersample 60 ;
-: NSOpenGLPFASampleAlpha 61 ;
-: NSOpenGLPFARendererID 70 ;
-: NSOpenGLPFASingleRenderer 71 ;
-: NSOpenGLPFANoRecovery 72 ;
-: NSOpenGLPFAAccelerated 73 ;
-: NSOpenGLPFAClosestPolicy 74 ;
-: NSOpenGLPFARobust 75 ;
-: NSOpenGLPFABackingStore 76 ;
-: NSOpenGLPFAMPSafe 78 ;
-: NSOpenGLPFAWindow 80 ;
-: NSOpenGLPFAMultiScreen 81 ;
-: NSOpenGLPFACompliant 83 ;
-: NSOpenGLPFAScreenMask 84 ;
-: NSOpenGLPFAPixelBuffer 90 ;
-: NSOpenGLPFAAllowOfflineRenderers 96 ;
-: NSOpenGLPFAVirtualScreenCount 128 ;
+CONSTANT: NSOpenGLPFAAllRenderers 1
+CONSTANT: NSOpenGLPFADoubleBuffer 5
+CONSTANT: NSOpenGLPFAStereo 6
+CONSTANT: NSOpenGLPFAAuxBuffers 7
+CONSTANT: NSOpenGLPFAColorSize 8
+CONSTANT: NSOpenGLPFAAlphaSize 11
+CONSTANT: NSOpenGLPFADepthSize 12
+CONSTANT: NSOpenGLPFAStencilSize 13
+CONSTANT: NSOpenGLPFAAccumSize 14
+CONSTANT: NSOpenGLPFAMinimumPolicy 51
+CONSTANT: NSOpenGLPFAMaximumPolicy 52
+CONSTANT: NSOpenGLPFAOffScreen 53
+CONSTANT: NSOpenGLPFAFullScreen 54
+CONSTANT: NSOpenGLPFASampleBuffers 55
+CONSTANT: NSOpenGLPFASamples 56
+CONSTANT: NSOpenGLPFAAuxDepthStencil 57
+CONSTANT: NSOpenGLPFAColorFloat 58
+CONSTANT: NSOpenGLPFAMultisample 59
+CONSTANT: NSOpenGLPFASupersample 60
+CONSTANT: NSOpenGLPFASampleAlpha 61
+CONSTANT: NSOpenGLPFARendererID 70
+CONSTANT: NSOpenGLPFASingleRenderer 71
+CONSTANT: NSOpenGLPFANoRecovery 72
+CONSTANT: NSOpenGLPFAAccelerated 73
+CONSTANT: NSOpenGLPFAClosestPolicy 74
+CONSTANT: NSOpenGLPFARobust 75
+CONSTANT: NSOpenGLPFABackingStore 76
+CONSTANT: NSOpenGLPFAMPSafe 78
+CONSTANT: NSOpenGLPFAWindow 80
+CONSTANT: NSOpenGLPFAMultiScreen 81
+CONSTANT: NSOpenGLPFACompliant 83
+CONSTANT: NSOpenGLPFAScreenMask 84
+CONSTANT: NSOpenGLPFAPixelBuffer 90
+CONSTANT: NSOpenGLPFAAllowOfflineRenderers 96
+CONSTANT: NSOpenGLPFAVirtualScreenCount 128
-: kCGLRendererGenericFloatID HEX: 00020400 ;
+CONSTANT: kCGLRendererGenericFloatID HEX: 00020400
<PRIVATE
@@ -94,7 +94,7 @@ PRIVATE>
USE: opengl.gl
USE: alien.syntax
-: NSOpenGLCPSwapInterval 222 ;
+CONSTANT: NSOpenGLCPSwapInterval 222
LIBRARY: OpenGL
diff --git a/basis/compiler/compiler-docs.factor b/basis/compiler/compiler-docs.factor
index 1c6e7b796e..9169e9e0fa 100644
--- a/basis/compiler/compiler-docs.factor
+++ b/basis/compiler/compiler-docs.factor
@@ -1,5 +1,5 @@
USING: help.markup help.syntax words io parser
-assocs words.private sequences compiler.units ;
+assocs words.private sequences compiler.units quotations ;
IN: compiler
HELP: enable-compiler
@@ -16,6 +16,8 @@ ARTICLE: "compiler-usage" "Calling the optimizing compiler"
{ $subsection optimized-recompile-hook }
"Removing a word's optimized definition:"
{ $subsection decompile }
+"Compiling a single quotation:"
+{ $subsection compile-call }
"Higher-level words can be found in " { $link "compilation-units" } "." ;
ARTICLE: "compiler" "Optimizing compiler"
@@ -48,3 +50,8 @@ HELP: optimized-recompile-hook
{ $values { "words" "a sequence of words" } { "alist" "an association list" } }
{ $description "Compile a set of words." }
{ $notes "This is an internal word, and user code should call " { $link compile } " instead." } ;
+
+HELP: compile-call
+{ $values { "quot" quotation } }
+{ $description "Compiles and runs a quotation." }
+{ $notes "This word is used by compiler unit tests to test compilation of small pieces of code." } ;
diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor
index f2f4e7aa9e..d707dff983 100644
--- a/basis/compiler/compiler.factor
+++ b/basis/compiler/compiler.factor
@@ -49,7 +49,7 @@ SYMBOL: +failed+
H{ } clone generic-dependencies set
f swap compiler-error ;
-: fail ( word error -- )
+: fail ( word error -- * )
[ swap compiler-error ]
[
drop
@@ -112,6 +112,9 @@ t compile-dependencies? set-global
: decompile ( word -- )
f 2array 1array modify-code-heap ;
+: compile-call ( quot -- )
+ [ dup infer define-temp ] with-compilation-unit execute ;
+
: optimized-recompile-hook ( words -- alist )
[
<hashed-dlist> compile-queue set
diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor
index 78e95ffb91..2e02e5476c 100644
--- a/basis/compiler/tests/codegen.factor
+++ b/basis/compiler/tests/codegen.factor
@@ -51,7 +51,7 @@ unit-test
\ foo [ global >n get ndrop ] compile-call
] unit-test
-: blech drop ;
+: blech ( x -- ) drop ;
[ 3 ]
[
@@ -102,7 +102,7 @@ unit-test
[ ] [
[
[ 200 dup [ 200 3array ] curry map drop ] times
- ] [ define-temp ] with-compilation-unit drop
+ ] [ (( n -- )) define-temp ] with-compilation-unit drop
] unit-test
! Test how dispatch handles the end of a basic block
diff --git a/basis/compiler/tests/curry.factor b/basis/compiler/tests/curry.factor
index 1857baf503..2d1f15b9a8 100644
--- a/basis/compiler/tests/curry.factor
+++ b/basis/compiler/tests/curry.factor
@@ -1,5 +1,5 @@
USING: tools.test quotations math kernel sequences
-assocs namespaces make compiler.units ;
+assocs namespaces make compiler.units compiler ;
IN: compiler.tests
[ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test
@@ -32,15 +32,15 @@ IN: compiler.tests
compile-call
] unit-test
-: foobar ( quot -- )
- dup slip swap [ foobar ] [ drop ] if ; inline
+: foobar ( quot: ( -- ) -- )
+ dup slip swap [ foobar ] [ drop ] if ; inline recursive
[ ] [ [ [ f ] foobar ] compile-call ] unit-test
[ { 6 7 8 } ] [ { 1 2 3 } 5 [ [ + ] curry map ] compile-call ] unit-test
[ { 6 7 8 } ] [ { 1 2 3 } [ 5 [ + ] curry map ] compile-call ] unit-test
-: funky-assoc>map
+: funky-assoc>map ( assoc quot -- seq )
[
[ call f ] curry assoc-find 3drop
] { } make ; inline
diff --git a/basis/compiler/tests/float.factor b/basis/compiler/tests/float.factor
index 81ab750305..b439b5f6a4 100644
--- a/basis/compiler/tests/float.factor
+++ b/basis/compiler/tests/float.factor
@@ -1,5 +1,5 @@
IN: compiler.tests
-USING: compiler.units kernel kernel.private memory math
+USING: compiler.units compiler kernel kernel.private memory math
math.private tools.test math.floats.private ;
[ 5.0 ] [ [ 5.0 ] compile-call gc gc gc ] unit-test
diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor
index df5f484952..6c6d580c87 100644
--- a/basis/compiler/tests/intrinsics.factor
+++ b/basis/compiler/tests/intrinsics.factor
@@ -5,7 +5,7 @@ strings.private system random layouts vectors
sbufs strings.private slots.private alien math.order
alien.accessors alien.c-types alien.syntax alien.strings
namespaces libc sequences.private io.encodings.ascii
-classes ;
+classes compiler ;
IN: compiler.tests
! Make sure that intrinsic ops compile to correct code.
diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor
index c5bbe4a6c3..708d17f3d3 100644
--- a/basis/compiler/tests/optimizer.factor
+++ b/basis/compiler/tests/optimizer.factor
@@ -3,7 +3,8 @@ stack-checker kernel kernel.private math prettyprint sequences
sbufs strings tools.test vectors words sequences.private
quotations classes classes.algebra classes.tuple.private
continuations growable namespaces hints alien.accessors
-compiler.tree.builder compiler.tree.optimizer sequences.deep ;
+compiler.tree.builder compiler.tree.optimizer sequences.deep
+compiler ;
IN: optimizer.tests
GENERIC: xyz ( obj -- obj )
@@ -208,14 +209,14 @@ USE: sorting
USE: binary-search
USE: binary-search.private
-: old-binsearch ( elt quot seq -- elt quot i )
+: old-binsearch ( elt quot: ( -- ) seq -- elt quot i )
dup length 1 <= [
from>>
] [
[ midpoint swap call ] 3keep roll dup zero?
[ drop dup from>> swap midpoint@ + ]
- [ dup midpoint@ cut-slice old-binsearch ] if
- ] if ; inline
+ [ drop dup midpoint@ head-slice old-binsearch ] if
+ ] if ; inline recursive
[ 10 ] [
10 20 >vector <flat-slice>
diff --git a/basis/compiler/tests/peg-regression-2.factor b/basis/compiler/tests/peg-regression-2.factor
new file mode 100644
index 0000000000..1efadba3aa
--- /dev/null
+++ b/basis/compiler/tests/peg-regression-2.factor
@@ -0,0 +1,15 @@
+IN: compiler.tests
+USING: peg.ebnf strings tools.test ;
+
+GENERIC: <times> ( times -- term' )
+M: string <times> ;
+
+EBNF: parse-regexp
+
+Times = .* => [[ "foo" ]]
+
+Regexp = Times:t => [[ t <times> ]]
+
+;EBNF
+
+[ "foo" ] [ "a" parse-regexp ] unit-test
\ No newline at end of file
diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor
index a6d6c5dfb9..0fde270eac 100644
--- a/basis/compiler/tests/simple.factor
+++ b/basis/compiler/tests/simple.factor
@@ -54,7 +54,7 @@ IN: compiler.tests
! Labels
-: recursive-test ( ? -- ) [ f recursive-test ] when ; inline
+: recursive-test ( ? -- ) [ f recursive-test ] when ; inline recursive
[ ] [ t [ recursive-test ] compile-call ] unit-test
diff --git a/basis/compiler/tests/tuples.factor b/basis/compiler/tests/tuples.factor
index 602b438432..caa214b70c 100644
--- a/basis/compiler/tests/tuples.factor
+++ b/basis/compiler/tests/tuples.factor
@@ -1,5 +1,5 @@
IN: compiler.tests
-USING: kernel tools.test compiler.units ;
+USING: kernel tools.test compiler.units compiler ;
TUPLE: color red green blue ;
diff --git a/basis/compiler/tree/comparisons/comparisons.factor b/basis/compiler/tree/comparisons/comparisons.factor
index 5242302411..5f4b1e8dab 100644
--- a/basis/compiler/tree/comparisons/comparisons.factor
+++ b/basis/compiler/tree/comparisons/comparisons.factor
@@ -5,9 +5,9 @@ IN: compiler.tree.comparisons
! Some utilities for working with comparison operations.
-: comparison-ops { < > <= >= } ;
+CONSTANT: comparison-ops { < > <= >= }
-: generic-comparison-ops { before? after? before=? after=? } ;
+CONSTANT: generic-comparison-ops { before? after? before=? after=? }
: assumption ( i1 i2 op -- i3 )
{
diff --git a/basis/core-foundation/strings/strings.factor b/basis/core-foundation/strings/strings.factor
index c3a969a325..50c17dc6fd 100644
--- a/basis/core-foundation/strings/strings.factor
+++ b/basis/core-foundation/strings/strings.factor
@@ -7,20 +7,20 @@ IN: core-foundation.strings
TYPEDEF: void* CFStringRef
TYPEDEF: int CFStringEncoding
-: kCFStringEncodingMacRoman HEX: 0 ;
-: kCFStringEncodingWindowsLatin1 HEX: 0500 ;
-: kCFStringEncodingISOLatin1 HEX: 0201 ;
-: kCFStringEncodingNextStepLatin HEX: 0B01 ;
-: kCFStringEncodingASCII HEX: 0600 ;
-: kCFStringEncodingUnicode HEX: 0100 ;
-: kCFStringEncodingUTF8 HEX: 08000100 ;
-: kCFStringEncodingNonLossyASCII HEX: 0BFF ;
-: kCFStringEncodingUTF16 HEX: 0100 ;
-: kCFStringEncodingUTF16BE HEX: 10000100 ;
-: kCFStringEncodingUTF16LE HEX: 14000100 ;
-: kCFStringEncodingUTF32 HEX: 0c000100 ;
-: kCFStringEncodingUTF32BE HEX: 18000100 ;
-: kCFStringEncodingUTF32LE HEX: 1c000100 ;
+CONSTANT: kCFStringEncodingMacRoman HEX: 0
+CONSTANT: kCFStringEncodingWindowsLatin1 HEX: 0500
+CONSTANT: kCFStringEncodingISOLatin1 HEX: 0201
+CONSTANT: kCFStringEncodingNextStepLatin HEX: 0B01
+CONSTANT: kCFStringEncodingASCII HEX: 0600
+CONSTANT: kCFStringEncodingUnicode HEX: 0100
+CONSTANT: kCFStringEncodingUTF8 HEX: 08000100
+CONSTANT: kCFStringEncodingNonLossyASCII HEX: 0BFF
+CONSTANT: kCFStringEncodingUTF16 HEX: 0100
+CONSTANT: kCFStringEncodingUTF16BE HEX: 10000100
+CONSTANT: kCFStringEncodingUTF16LE HEX: 14000100
+CONSTANT: kCFStringEncodingUTF32 HEX: 0c000100
+CONSTANT: kCFStringEncodingUTF32BE HEX: 18000100
+CONSTANT: kCFStringEncodingUTF32LE HEX: 1c000100
FUNCTION: CFStringRef CFStringCreateWithBytes (
CFAllocatorRef alloc,
diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor
index 14151692f0..0b9c9caa45 100644
--- a/basis/functors/functors.factor
+++ b/basis/functors/functors.factor
@@ -80,9 +80,9 @@ M: object fake-quotations> ;
scan-param parsed
\ add-mixin-instance parsed ; parsing
-: `inline \ inline parsed ; parsing
+: `inline [ word make-inline ] over push-all ; parsing
-: `parsing \ parsing parsed ; parsing
+: `parsing [ word make-parsing ] over push-all ; parsing
: `(
")" parse-effect effect set ; parsing
diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor
index f5e6426859..f210180517 100644
--- a/basis/io/backend/unix/unix.factor
+++ b/basis/io/backend/unix/unix.factor
@@ -77,7 +77,7 @@ M: io-timeout summary drop "I/O operation timed out" ;
'[ handle>> _ wait-for-fd ] with-timeout ;
! Some general stuff
-: file-mode OCT: 0666 ;
+CONSTANT: file-mode OCT: 0666
! Readers
: (refill) ( port -- n )
diff --git a/basis/none/none.factor b/basis/none/none.factor
index 66a0de8328..77941479aa 100644
--- a/basis/none/none.factor
+++ b/basis/none/none.factor
@@ -1,6 +1,6 @@
! Just a dummy shell for the -run switch...
IN: none
-: none ;
+: none ( -- ) ;
MAIN: none
diff --git a/basis/opengl/glu/glu.factor b/basis/opengl/glu/glu.factor
index da19ac52fc..d603724a55 100644
--- a/basis/opengl/glu/glu.factor
+++ b/basis/opengl/glu/glu.factor
@@ -11,183 +11,183 @@ TYPEDEF: void* GLubyte*
TYPEDEF: void* GLUfuncptr
! StringName
-: GLU_VERSION 100800 ;
-: GLU_EXTENSIONS 100801 ;
+CONSTANT: GLU_VERSION 100800
+CONSTANT: GLU_EXTENSIONS 100801
! ErrorCode
-: GLU_INVALID_ENUM 100900 ;
-: GLU_INVALID_VALUE 100901 ;
-: GLU_OUT_OF_MEMORY 100902 ;
-: GLU_INCOMPATIBLE_GL_VERSION 100903 ;
-: GLU_INVALID_OPERATION 100904 ;
+CONSTANT: GLU_INVALID_ENUM 100900
+CONSTANT: GLU_INVALID_VALUE 100901
+CONSTANT: GLU_OUT_OF_MEMORY 100902
+CONSTANT: GLU_INCOMPATIBLE_GL_VERSION 100903
+CONSTANT: GLU_INVALID_OPERATION 100904
! NurbsDisplay
-: GLU_OUTLINE_POLYGON 100240 ;
-: GLU_OUTLINE_PATCH 100241 ;
+CONSTANT: GLU_OUTLINE_POLYGON 100240
+CONSTANT: GLU_OUTLINE_PATCH 100241
! NurbsCallback
-: GLU_NURBS_ERROR 100103 ;
-: GLU_ERROR 100103 ;
-: GLU_NURBS_BEGIN 100164 ;
-: GLU_NURBS_BEGIN_EXT 100164 ;
-: GLU_NURBS_VERTEX 100165 ;
-: GLU_NURBS_VERTEX_EXT 100165 ;
-: GLU_NURBS_NORMAL 100166 ;
-: GLU_NURBS_NORMAL_EXT 100166 ;
-: GLU_NURBS_COLOR 100167 ;
-: GLU_NURBS_COLOR_EXT 100167 ;
-: GLU_NURBS_TEXTURE_COORD 100168 ;
-: GLU_NURBS_TEX_COORD_EXT 100168 ;
-: GLU_NURBS_END 100169 ;
-: GLU_NURBS_END_EXT 100169 ;
-: GLU_NURBS_BEGIN_DATA 100170 ;
-: GLU_NURBS_BEGIN_DATA_EXT 100170 ;
-: GLU_NURBS_VERTEX_DATA 100171 ;
-: GLU_NURBS_VERTEX_DATA_EXT 100171 ;
-: GLU_NURBS_NORMAL_DATA 100172 ;
-: GLU_NURBS_NORMAL_DATA_EXT 100172 ;
-: GLU_NURBS_COLOR_DATA 100173 ;
-: GLU_NURBS_COLOR_DATA_EXT 100173 ;
-: GLU_NURBS_TEXTURE_COORD_DATA 100174 ;
-: GLU_NURBS_TEX_COORD_DATA_EXT 100174 ;
-: GLU_NURBS_END_DATA 100175 ;
-: GLU_NURBS_END_DATA_EXT 100175 ;
+CONSTANT: GLU_NURBS_ERROR 100103
+CONSTANT: GLU_ERROR 100103
+CONSTANT: GLU_NURBS_BEGIN 100164
+CONSTANT: GLU_NURBS_BEGIN_EXT 100164
+CONSTANT: GLU_NURBS_VERTEX 100165
+CONSTANT: GLU_NURBS_VERTEX_EXT 100165
+CONSTANT: GLU_NURBS_NORMAL 100166
+CONSTANT: GLU_NURBS_NORMAL_EXT 100166
+CONSTANT: GLU_NURBS_COLOR 100167
+CONSTANT: GLU_NURBS_COLOR_EXT 100167
+CONSTANT: GLU_NURBS_TEXTURE_COORD 100168
+CONSTANT: GLU_NURBS_TEX_COORD_EXT 100168
+CONSTANT: GLU_NURBS_END 100169
+CONSTANT: GLU_NURBS_END_EXT 100169
+CONSTANT: GLU_NURBS_BEGIN_DATA 100170
+CONSTANT: GLU_NURBS_BEGIN_DATA_EXT 100170
+CONSTANT: GLU_NURBS_VERTEX_DATA 100171
+CONSTANT: GLU_NURBS_VERTEX_DATA_EXT 100171
+CONSTANT: GLU_NURBS_NORMAL_DATA 100172
+CONSTANT: GLU_NURBS_NORMAL_DATA_EXT 100172
+CONSTANT: GLU_NURBS_COLOR_DATA 100173
+CONSTANT: GLU_NURBS_COLOR_DATA_EXT 100173
+CONSTANT: GLU_NURBS_TEXTURE_COORD_DATA 100174
+CONSTANT: GLU_NURBS_TEX_COORD_DATA_EXT 100174
+CONSTANT: GLU_NURBS_END_DATA 100175
+CONSTANT: GLU_NURBS_END_DATA_EXT 100175
! NurbsError
-: GLU_NURBS_ERROR1 100251 ;
-: GLU_NURBS_ERROR2 100252 ;
-: GLU_NURBS_ERROR3 100253 ;
-: GLU_NURBS_ERROR4 100254 ;
-: GLU_NURBS_ERROR5 100255 ;
-: GLU_NURBS_ERROR6 100256 ;
-: GLU_NURBS_ERROR7 100257 ;
-: GLU_NURBS_ERROR8 100258 ;
-: GLU_NURBS_ERROR9 100259 ;
-: GLU_NURBS_ERROR10 100260 ;
-: GLU_NURBS_ERROR11 100261 ;
-: GLU_NURBS_ERROR12 100262 ;
-: GLU_NURBS_ERROR13 100263 ;
-: GLU_NURBS_ERROR14 100264 ;
-: GLU_NURBS_ERROR15 100265 ;
-: GLU_NURBS_ERROR16 100266 ;
-: GLU_NURBS_ERROR17 100267 ;
-: GLU_NURBS_ERROR18 100268 ;
-: GLU_NURBS_ERROR19 100269 ;
-: GLU_NURBS_ERROR20 100270 ;
-: GLU_NURBS_ERROR21 100271 ;
-: GLU_NURBS_ERROR22 100272 ;
-: GLU_NURBS_ERROR23 100273 ;
-: GLU_NURBS_ERROR24 100274 ;
-: GLU_NURBS_ERROR25 100275 ;
-: GLU_NURBS_ERROR26 100276 ;
-: GLU_NURBS_ERROR27 100277 ;
-: GLU_NURBS_ERROR28 100278 ;
-: GLU_NURBS_ERROR29 100279 ;
-: GLU_NURBS_ERROR30 100280 ;
-: GLU_NURBS_ERROR31 100281 ;
-: GLU_NURBS_ERROR32 100282 ;
-: GLU_NURBS_ERROR33 100283 ;
-: GLU_NURBS_ERROR34 100284 ;
-: GLU_NURBS_ERROR35 100285 ;
-: GLU_NURBS_ERROR36 100286 ;
-: GLU_NURBS_ERROR37 100287 ;
+CONSTANT: GLU_NURBS_ERROR1 100251
+CONSTANT: GLU_NURBS_ERROR2 100252
+CONSTANT: GLU_NURBS_ERROR3 100253
+CONSTANT: GLU_NURBS_ERROR4 100254
+CONSTANT: GLU_NURBS_ERROR5 100255
+CONSTANT: GLU_NURBS_ERROR6 100256
+CONSTANT: GLU_NURBS_ERROR7 100257
+CONSTANT: GLU_NURBS_ERROR8 100258
+CONSTANT: GLU_NURBS_ERROR9 100259
+CONSTANT: GLU_NURBS_ERROR10 100260
+CONSTANT: GLU_NURBS_ERROR11 100261
+CONSTANT: GLU_NURBS_ERROR12 100262
+CONSTANT: GLU_NURBS_ERROR13 100263
+CONSTANT: GLU_NURBS_ERROR14 100264
+CONSTANT: GLU_NURBS_ERROR15 100265
+CONSTANT: GLU_NURBS_ERROR16 100266
+CONSTANT: GLU_NURBS_ERROR17 100267
+CONSTANT: GLU_NURBS_ERROR18 100268
+CONSTANT: GLU_NURBS_ERROR19 100269
+CONSTANT: GLU_NURBS_ERROR20 100270
+CONSTANT: GLU_NURBS_ERROR21 100271
+CONSTANT: GLU_NURBS_ERROR22 100272
+CONSTANT: GLU_NURBS_ERROR23 100273
+CONSTANT: GLU_NURBS_ERROR24 100274
+CONSTANT: GLU_NURBS_ERROR25 100275
+CONSTANT: GLU_NURBS_ERROR26 100276
+CONSTANT: GLU_NURBS_ERROR27 100277
+CONSTANT: GLU_NURBS_ERROR28 100278
+CONSTANT: GLU_NURBS_ERROR29 100279
+CONSTANT: GLU_NURBS_ERROR30 100280
+CONSTANT: GLU_NURBS_ERROR31 100281
+CONSTANT: GLU_NURBS_ERROR32 100282
+CONSTANT: GLU_NURBS_ERROR33 100283
+CONSTANT: GLU_NURBS_ERROR34 100284
+CONSTANT: GLU_NURBS_ERROR35 100285
+CONSTANT: GLU_NURBS_ERROR36 100286
+CONSTANT: GLU_NURBS_ERROR37 100287
! NurbsProperty
-: GLU_AUTO_LOAD_MATRIX 100200 ;
-: GLU_CULLING 100201 ;
-: GLU_SAMPLING_TOLERANCE 100203 ;
-: GLU_DISPLAY_MODE 100204 ;
-: GLU_PARAMETRIC_TOLERANCE 100202 ;
-: GLU_SAMPLING_METHOD 100205 ;
-: GLU_U_STEP 100206 ;
-: GLU_V_STEP 100207 ;
-: GLU_NURBS_MODE 100160 ;
-: GLU_NURBS_MODE_EXT 100160 ;
-: GLU_NURBS_TESSELLATOR 100161 ;
-: GLU_NURBS_TESSELLATOR_EXT 100161 ;
-: GLU_NURBS_RENDERER 100162 ;
-: GLU_NURBS_RENDERER_EXT 100162 ;
+CONSTANT: GLU_AUTO_LOAD_MATRIX 100200
+CONSTANT: GLU_CULLING 100201
+CONSTANT: GLU_SAMPLING_TOLERANCE 100203
+CONSTANT: GLU_DISPLAY_MODE 100204
+CONSTANT: GLU_PARAMETRIC_TOLERANCE 100202
+CONSTANT: GLU_SAMPLING_METHOD 100205
+CONSTANT: GLU_U_STEP 100206
+CONSTANT: GLU_V_STEP 100207
+CONSTANT: GLU_NURBS_MODE 100160
+CONSTANT: GLU_NURBS_MODE_EXT 100160
+CONSTANT: GLU_NURBS_TESSELLATOR 100161
+CONSTANT: GLU_NURBS_TESSELLATOR_EXT 100161
+CONSTANT: GLU_NURBS_RENDERER 100162
+CONSTANT: GLU_NURBS_RENDERER_EXT 100162
! NurbsSampling
-: GLU_OBJECT_PARAMETRIC_ERROR 100208 ;
-: GLU_OBJECT_PARAMETRIC_ERROR_EXT 100208 ;
-: GLU_OBJECT_PATH_LENGTH 100209 ;
-: GLU_OBJECT_PATH_LENGTH_EXT 100209 ;
-: GLU_PATH_LENGTH 100215 ;
-: GLU_PARAMETRIC_ERROR 100216 ;
-: GLU_DOMAIN_DISTANCE 100217 ;
+CONSTANT: GLU_OBJECT_PARAMETRIC_ERROR 100208
+CONSTANT: GLU_OBJECT_PARAMETRIC_ERROR_EXT 100208
+CONSTANT: GLU_OBJECT_PATH_LENGTH 100209
+CONSTANT: GLU_OBJECT_PATH_LENGTH_EXT 100209
+CONSTANT: GLU_PATH_LENGTH 100215
+CONSTANT: GLU_PARAMETRIC_ERROR 100216
+CONSTANT: GLU_DOMAIN_DISTANCE 100217
! NurbsTrim
-: GLU_MAP1_TRIM_2 100210 ;
-: GLU_MAP1_TRIM_3 100211 ;
+CONSTANT: GLU_MAP1_TRIM_2 100210
+CONSTANT: GLU_MAP1_TRIM_3 100211
! QuadricDrawStyle
-: GLU_POINT 100010 ;
-: GLU_LINE 100011 ;
-: GLU_FILL 100012 ;
-: GLU_SILHOUETTE 100013 ;
+CONSTANT: GLU_POINT 100010
+CONSTANT: GLU_LINE 100011
+CONSTANT: GLU_FILL 100012
+CONSTANT: GLU_SILHOUETTE 100013
! QuadricNormal
-: GLU_SMOOTH 100000 ;
-: GLU_FLAT 100001 ;
-: GLU_NONE 100002 ;
+CONSTANT: GLU_SMOOTH 100000
+CONSTANT: GLU_FLAT 100001
+CONSTANT: GLU_NONE 100002
! QuadricOrientation
-: GLU_OUTSIDE 100020 ;
-: GLU_INSIDE 100021 ;
+CONSTANT: GLU_OUTSIDE 100020
+CONSTANT: GLU_INSIDE 100021
! TessCallback
-: GLU_TESS_BEGIN 100100 ;
-: GLU_BEGIN 100100 ;
-: GLU_TESS_VERTEX 100101 ;
-: GLU_VERTEX 100101 ;
-: GLU_TESS_END 100102 ;
-: GLU_END 100102 ;
-: GLU_TESS_ERROR 100103 ;
-: GLU_TESS_EDGE_FLAG 100104 ;
-: GLU_EDGE_FLAG 100104 ;
-: GLU_TESS_COMBINE 100105 ;
-: GLU_TESS_BEGIN_DATA 100106 ;
-: GLU_TESS_VERTEX_DATA 100107 ;
-: GLU_TESS_END_DATA 100108 ;
-: GLU_TESS_ERROR_DATA 100109 ;
-: GLU_TESS_EDGE_FLAG_DATA 100110 ;
-: GLU_TESS_COMBINE_DATA 100111 ;
+CONSTANT: GLU_TESS_BEGIN 100100
+CONSTANT: GLU_BEGIN 100100
+CONSTANT: GLU_TESS_VERTEX 100101
+CONSTANT: GLU_VERTEX 100101
+CONSTANT: GLU_TESS_END 100102
+CONSTANT: GLU_END 100102
+CONSTANT: GLU_TESS_ERROR 100103
+CONSTANT: GLU_TESS_EDGE_FLAG 100104
+CONSTANT: GLU_EDGE_FLAG 100104
+CONSTANT: GLU_TESS_COMBINE 100105
+CONSTANT: GLU_TESS_BEGIN_DATA 100106
+CONSTANT: GLU_TESS_VERTEX_DATA 100107
+CONSTANT: GLU_TESS_END_DATA 100108
+CONSTANT: GLU_TESS_ERROR_DATA 100109
+CONSTANT: GLU_TESS_EDGE_FLAG_DATA 100110
+CONSTANT: GLU_TESS_COMBINE_DATA 100111
! TessContour
-: GLU_CW 100120 ;
-: GLU_CCW 100121 ;
-: GLU_INTERIOR 100122 ;
-: GLU_EXTERIOR 100123 ;
-: GLU_UNKNOWN 100124 ;
+CONSTANT: GLU_CW 100120
+CONSTANT: GLU_CCW 100121
+CONSTANT: GLU_INTERIOR 100122
+CONSTANT: GLU_EXTERIOR 100123
+CONSTANT: GLU_UNKNOWN 100124
! TessProperty
-: GLU_TESS_WINDING_RULE 100140 ;
-: GLU_TESS_BOUNDARY_ONLY 100141 ;
-: GLU_TESS_TOLERANCE 100142 ;
+CONSTANT: GLU_TESS_WINDING_RULE 100140
+CONSTANT: GLU_TESS_BOUNDARY_ONLY 100141
+CONSTANT: GLU_TESS_TOLERANCE 100142
! TessError
-: GLU_TESS_ERROR1 100151 ;
-: GLU_TESS_ERROR2 100152 ;
-: GLU_TESS_ERROR3 100153 ;
-: GLU_TESS_ERROR4 100154 ;
-: GLU_TESS_ERROR5 100155 ;
-: GLU_TESS_ERROR6 100156 ;
-: GLU_TESS_ERROR7 100157 ;
-: GLU_TESS_ERROR8 100158 ;
-: GLU_TESS_MISSING_BEGIN_POLYGON 100151 ;
-: GLU_TESS_MISSING_BEGIN_CONTOUR 100152 ;
-: GLU_TESS_MISSING_END_POLYGON 100153 ;
-: GLU_TESS_MISSING_END_CONTOUR 100154 ;
-: GLU_TESS_COORD_TOO_LARGE 100155 ;
-: GLU_TESS_NEED_COMBINE_CALLBACK 100156 ;
+CONSTANT: GLU_TESS_ERROR1 100151
+CONSTANT: GLU_TESS_ERROR2 100152
+CONSTANT: GLU_TESS_ERROR3 100153
+CONSTANT: GLU_TESS_ERROR4 100154
+CONSTANT: GLU_TESS_ERROR5 100155
+CONSTANT: GLU_TESS_ERROR6 100156
+CONSTANT: GLU_TESS_ERROR7 100157
+CONSTANT: GLU_TESS_ERROR8 100158
+CONSTANT: GLU_TESS_MISSING_BEGIN_POLYGON 100151
+CONSTANT: GLU_TESS_MISSING_BEGIN_CONTOUR 100152
+CONSTANT: GLU_TESS_MISSING_END_POLYGON 100153
+CONSTANT: GLU_TESS_MISSING_END_CONTOUR 100154
+CONSTANT: GLU_TESS_COORD_TOO_LARGE 100155
+CONSTANT: GLU_TESS_NEED_COMBINE_CALLBACK 100156
! TessWinding
-: GLU_TESS_WINDING_ODD 100130 ;
-: GLU_TESS_WINDING_NONZERO 100131 ;
-: GLU_TESS_WINDING_POSITIVE 100132 ;
-: GLU_TESS_WINDING_NEGATIVE 100133 ;
-: GLU_TESS_WINDING_ABS_GEQ_TWO 100134 ;
+CONSTANT: GLU_TESS_WINDING_ODD 100130
+CONSTANT: GLU_TESS_WINDING_NONZERO 100131
+CONSTANT: GLU_TESS_WINDING_POSITIVE 100132
+CONSTANT: GLU_TESS_WINDING_NEGATIVE 100133
+CONSTANT: GLU_TESS_WINDING_ABS_GEQ_TWO 100134
LIBRARY: glu
diff --git a/basis/openssl/libcrypto/libcrypto.factor b/basis/openssl/libcrypto/libcrypto.factor
index 3204b83bbb..9cbed1f752 100644
--- a/basis/openssl/libcrypto/libcrypto.factor
+++ b/basis/openssl/libcrypto/libcrypto.factor
@@ -99,7 +99,7 @@ FUNCTION: void* BIO_f_buffer ( ) ;
! evp.h
! ===============================================
-: EVP_MAX_MD_SIZE 64 ;
+CONSTANT: EVP_MAX_MD_SIZE 64
C-STRUCT: EVP_MD_CTX
{ "EVP_MD*" "digest" }
diff --git a/basis/peg/parsers/parsers.factor b/basis/peg/parsers/parsers.factor
index a9fb366812..aadbbaff16 100644
--- a/basis/peg/parsers/parsers.factor
+++ b/basis/peg/parsers/parsers.factor
@@ -7,12 +7,12 @@ IN: peg.parsers
TUPLE: just-parser p1 ;
-: just-pattern
+CONSTANT: just-pattern
[
execute dup [
dup remaining>> empty? [ drop f ] unless
] when
- ] ;
+ ]
M: just-parser (compile) ( parser -- quot )
diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor
index b08bdd8436..5f7eb5ceae 100755
--- a/basis/stack-checker/backend/backend.factor
+++ b/basis/stack-checker/backend/backend.factor
@@ -124,18 +124,13 @@ M: object apply-object push-literal ;
: undo-infer ( -- )
recorded get [ f "inferred-effect" set-word-prop ] each ;
-: consume/produce ( effect quot -- )
- #! quot is ( inputs outputs -- )
- [
- [
- [ in>> length consume-d ]
- [ out>> length produce-d ]
- bi
- ] dip call
- ] [
- drop
- terminated?>> [ terminate ] when
- ] 2bi ; inline
+: (consume/produce) ( effect -- inputs outputs )
+ [ in>> length consume-d ] [ out>> length produce-d ] bi ;
+
+: consume/produce ( effect quot: ( inputs outputs -- ) -- )
+ '[ (consume/produce) @ ]
+ [ terminated?>> [ terminate ] when ]
+ bi ; inline
: infer-word-def ( word -- )
[ specialized-def ] [ add-recursive-state ] bi infer-quot ;
@@ -143,23 +138,12 @@ M: object apply-object push-literal ;
: end-infer ( -- )
meta-d clone #return, ;
-: effect-required? ( word -- ? )
- {
- { [ dup deferred? ] [ drop f ] }
- { [ dup crossref? not ] [ drop f ] }
- [ def>> [ word? ] any? ]
- } cond ;
-
-: ?missing-effect ( word -- )
- dup effect-required?
- [ missing-effect inference-error ] [ drop ] if ;
+: required-stack-effect ( word -- effect )
+ dup stack-effect [ ] [ missing-effect inference-error ] ?if ;
: check-effect ( word effect -- )
- over stack-effect {
- { [ dup not ] [ 2drop ?missing-effect ] }
- { [ 2dup effect<= ] [ 3drop ] }
- [ effect-error ]
- } cond ;
+ over required-stack-effect 2dup effect<=
+ [ 3drop ] [ effect-error ] if ;
: finish-word ( word -- )
current-effect
@@ -183,22 +167,20 @@ M: object apply-object push-literal ;
dependencies off
generic-dependencies off
[ infer-word-def end-infer ]
- [ finish-word current-effect ]
- bi
+ [ finish-word ]
+ [ stack-effect ]
+ tri
] with-scope
] maybe-cannot-infer ;
: apply-word/effect ( word effect -- )
swap '[ _ #call, ] consume/produce ;
-: required-stack-effect ( word -- effect )
- dup stack-effect [ ] [ \ missing-effect inference-error ] ?if ;
-
: call-recursive-word ( word -- )
dup required-stack-effect apply-word/effect ;
: cached-infer ( word -- )
- dup "inferred-effect" word-prop apply-word/effect ;
+ dup stack-effect apply-word/effect ;
: with-infer ( quot -- effect visitor )
[
diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor
index 56aebb20e7..4ac9d802ed 100644
--- a/basis/stack-checker/known-words/known-words.factor
+++ b/basis/stack-checker/known-words/known-words.factor
@@ -319,12 +319,18 @@ M: object infer-call*
\ fixnum/i { fixnum fixnum } { integer } define-primitive
\ fixnum/i make-foldable
+\ fixnum/i-fast { fixnum fixnum } { fixnum } define-primitive
+\ fixnum/i-fast make-foldable
+
\ fixnum-mod { fixnum fixnum } { fixnum } define-primitive
\ fixnum-mod make-foldable
\ fixnum/mod { fixnum fixnum } { integer fixnum } define-primitive
\ fixnum/mod make-foldable
+\ fixnum/mod-fast { fixnum fixnum } { fixnum fixnum } define-primitive
+\ fixnum/mod-fast make-foldable
+
\ fixnum-bitand { fixnum fixnum } { fixnum } define-primitive
\ fixnum-bitand make-foldable
diff --git a/basis/threads/threads.factor b/basis/threads/threads.factor
index 305ef0cca3..8556167009 100644
--- a/basis/threads/threads.factor
+++ b/basis/threads/threads.factor
@@ -118,7 +118,7 @@ DEFER: stop
[ ] while
drop ;
-: start ( namestack thread -- )
+: start ( namestack thread -- * )
[
set-self
set-namestack
diff --git a/basis/tools/deploy/config/config.factor b/basis/tools/deploy/config/config.factor
index 1d9761e885..63c8393b51 100644
--- a/basis/tools/deploy/config/config.factor
+++ b/basis/tools/deploy/config/config.factor
@@ -14,12 +14,12 @@ SYMBOL: deploy-threads?
SYMBOL: deploy-io
-: deploy-io-options
+CONSTANT: deploy-io-options
{
{ 1 "Level 1 - No input/output" }
{ 2 "Level 2 - Basic ANSI C streams" }
{ 3 "Level 3 - Non-blocking streams and networking" }
- } ;
+ }
: strip-io? ( -- ? ) deploy-io get 1 = ;
@@ -27,7 +27,7 @@ SYMBOL: deploy-io
SYMBOL: deploy-reflection
-: deploy-reflection-options
+CONSTANT: deploy-reflection-options
{
{ 1 "Level 1 - No reflection" }
{ 2 "Level 2 - Retain word names" }
@@ -35,7 +35,7 @@ SYMBOL: deploy-reflection
{ 4 "Level 4 - Debugger" }
{ 5 "Level 5 - Parser" }
{ 6 "Level 6 - Full environment" }
- } ;
+ }
: strip-word-names? ( -- ? ) deploy-reflection get 2 < ;
: strip-prettyprint? ( -- ? ) deploy-reflection get 3 < ;
diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 5095f9e93e..e61021e633 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -190,7 +190,7 @@ IN: tools.deploy.shaker
"Stripping default methods" show
[
[ generic? ] instances
- [ "No method" throw ] define-temp
+ [ "No method" throw ] (( -- * )) define-temp
dup t "default" set-word-prop
'[
[ _ "default-method" set-word-prop ] [ make-generic ] bi
diff --git a/basis/ui/cocoa/views/views.factor b/basis/ui/cocoa/views/views.factor
index 3201779cc5..9e32f2f4de 100644
--- a/basis/ui/cocoa/views/views.factor
+++ b/basis/ui/cocoa/views/views.factor
@@ -14,15 +14,15 @@ IN: ui.cocoa.views
#! Cocoa -> Factor UI button mapping
-> buttonNumber H{ { 0 1 } { 2 2 } { 1 3 } } at ;
-: modifiers
+CONSTANT: modifiers
{
{ S+ HEX: 20000 }
{ C+ HEX: 40000 }
{ A+ HEX: 100000 }
{ M+ HEX: 80000 }
- } ;
+ }
-: key-codes
+CONSTANT: key-codes
H{
{ 71 "CLEAR" }
{ 36 "RET" }
@@ -47,7 +47,7 @@ IN: ui.cocoa.views
{ 126 "UP" }
{ 116 "PAGE_UP" }
{ 121 "PAGE_DOWN" }
- } ;
+ }
: key-code ( event -- string ? )
dup -> keyCode key-codes at
diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor
index dabc12d3ae..3deb280c83 100644
--- a/basis/ui/gadgets/buttons/buttons.factor
+++ b/basis/ui/gadgets/buttons/buttons.factor
@@ -173,7 +173,7 @@ TUPLE: radio-paint < caching-pen color interior-vertices boundary-vertices ;
<PRIVATE
-: circle-steps 8 ;
+CONSTANT: circle-steps 8
PRIVATE>
diff --git a/basis/ui/gadgets/frames/frames.factor b/basis/ui/gadgets/frames/frames.factor
index ae4c7d929a..a4d6b46129 100644
--- a/basis/ui/gadgets/frames/frames.factor
+++ b/basis/ui/gadgets/frames/frames.factor
@@ -13,16 +13,16 @@ M: glue pref-dim* drop { 0 0 } ;
: <frame-grid> ( -- grid ) 9 [ <glue> ] replicate 3 group ;
-: @center 1 1 ; inline
-: @left 0 1 ; inline
-: @right 2 1 ; inline
-: @top 1 0 ; inline
-: @bottom 1 2 ; inline
+: @center ( -- i j ) 1 1 ; inline
+: @left ( -- i j ) 0 1 ; inline
+: @right ( -- i j ) 2 1 ; inline
+: @top ( -- i j ) 1 0 ; inline
+: @bottom ( -- i j ) 1 2 ; inline
-: @top-left 0 0 ; inline
-: @top-right 2 0 ; inline
-: @bottom-left 0 2 ; inline
-: @bottom-right 2 2 ; inline
+: @top-left ( -- i j ) 0 0 ; inline
+: @top-right ( -- i j ) 2 0 ; inline
+: @bottom-left ( -- i j ) 0 2 ; inline
+: @bottom-right ( -- i j ) 2 2 ; inline
TUPLE: frame < grid ;
diff --git a/basis/ui/gadgets/sliders/sliders.factor b/basis/ui/gadgets/sliders/sliders.factor
index 1c2055156e..f22bd08ba2 100644
--- a/basis/ui/gadgets/sliders/sliders.factor
+++ b/basis/ui/gadgets/sliders/sliders.factor
@@ -18,7 +18,7 @@ TUPLE: slider < frame elevator thumb saved line ;
: elevator-length ( slider -- n )
[ elevator>> dim>> ] [ orientation>> ] bi v. ;
-: min-thumb-dim 15 ;
+CONSTANT: min-thumb-dim 15
: slider-value ( gadget -- n ) model>> range-value >fixnum ;
: slider-page ( gadget -- n ) model>> range-page-value ;
diff --git a/basis/ui/gadgets/theme/theme.factor b/basis/ui/gadgets/theme/theme.factor
index 6ca3868d87..7dabd994c2 100644
--- a/basis/ui/gadgets/theme/theme.factor
+++ b/basis/ui/gadgets/theme/theme.factor
@@ -56,6 +56,6 @@ IN: ui.gadgets.theme
T{ gray f 0.5 1.0 }
} <gradient> ;
-: sans-serif-font { "sans-serif" plain 12 } ;
+CONSTANT: sans-serif-font { "sans-serif" plain 12 }
-: monospace-font { "monospace" plain 12 } ;
+CONSTANT: monospace-font { "monospace" plain 12 }
diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor
index 5cbac9798a..a913c78f7d 100755
--- a/basis/ui/render/render.factor
+++ b/basis/ui/render/render.factor
@@ -191,11 +191,11 @@ M: polygon draw-interior
[ [ GL_POLYGON 0 ] dip interior-count>> glDrawArrays ]
tri ;
-: arrow-up { { 3 0 } { 6 6 } { 0 6 } } ;
-: arrow-right { { 0 0 } { 6 3 } { 0 6 } } ;
-: arrow-down { { 0 0 } { 6 0 } { 3 6 } } ;
-: arrow-left { { 0 3 } { 6 0 } { 6 6 } } ;
-: close-box { { 0 0 } { 6 0 } { 6 6 } { 0 6 } } ;
+CONSTANT: arrow-up { { 3 0 } { 6 6 } { 0 6 } }
+CONSTANT: arrow-right { { 0 0 } { 6 3 } { 0 6 } }
+CONSTANT: arrow-down { { 0 0 } { 6 0 } { 3 6 } }
+CONSTANT: arrow-left { { 0 3 } { 6 0 } { 6 6 } }
+CONSTANT: close-box { { 0 0 } { 6 0 } { 6 6 } { 0 6 } }
: <polygon-gadget> ( color points -- gadget )
dup max-dim
diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor
index de8d28ad2e..bff4ddeaab 100644
--- a/basis/unicode/data/data.factor
+++ b/basis/unicode/data/data.factor
@@ -97,8 +97,8 @@ VALUE: properties
[ nip zero? not ] assoc-filter
>hashtable ;
-: categories ( -- names )
- ! For non-existent characters, use Cn
+! For non-existent characters, use Cn
+CONSTANT: categories
{ "Cn"
"Lu" "Ll" "Lt" "Lm" "Lo"
"Mn" "Mc" "Me"
@@ -106,9 +106,9 @@ VALUE: properties
"Pc" "Pd" "Ps" "Pe" "Pi" "Pf" "Po"
"Sm" "Sc" "Sk" "So"
"Zs" "Zl" "Zp"
- "Cc" "Cf" "Cs" "Co" } ;
+ "Cc" "Cf" "Cs" "Co" }
-: num-chars HEX: 2FA1E ;
+CONSTANT: num-chars HEX: 2FA1E
! the maximum unicode char in the first 3 planes
diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index ceeab571b8..9e064cf99c 100644
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -538,4 +538,4 @@ tuple
[ [ first2 ] dip make-primitive ] each-index
! Bump build number
-"build" "kernel" create build 1+ 1quotation define
+"build" "kernel" create build 1+ [ ] curry (( -- n )) define-declared
diff --git a/core/compiler/units/units-docs.factor b/core/compiler/units/units-docs.factor
index 09baf91018..46d3dbc33f 100644
--- a/core/compiler/units/units-docs.factor
+++ b/core/compiler/units/units-docs.factor
@@ -67,7 +67,3 @@ HELP: modify-code-heap ( alist -- )
HELP: compile
{ $values { "words" "a sequence of words" } }
{ $description "Compiles a set of words." } ;
-
-HELP: compile-call
-{ $values { "quot" "a quotation" } }
-{ $description "Compiles and runs a quotation." } ;
diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor
index ac3e99e24c..0577f8b83c 100644
--- a/core/compiler/units/units.factor
+++ b/core/compiler/units/units.factor
@@ -172,9 +172,6 @@ SYMBOL: remake-generics-hook
] [ ] cleanup
] with-scope ; inline
-: compile-call ( quot -- )
- [ define-temp ] with-compilation-unit execute ;
-
: default-recompile-hook ( words -- alist )
[ f ] { } map>assoc ;
diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor
index c7056856b6..37418b85f5 100644
--- a/core/continuations/continuations.factor
+++ b/core/continuations/continuations.factor
@@ -92,10 +92,10 @@ C: <continuation> continuation
PRIVATE>
-: continue-with ( obj continuation -- )
+: continue-with ( obj continuation -- * )
[ (continue-with) ] 2 (throw) ;
-: continue ( continuation -- )
+: continue ( continuation -- * )
f swap continue-with ;
SYMBOL: return-continuation
@@ -103,7 +103,7 @@ SYMBOL: return-continuation
: with-return ( quot -- )
[ [ return-continuation set ] prepose callcc0 ] with-scope ; inline
-: return ( -- )
+: return ( -- * )
return-continuation get continue ;
: with-datastack ( stack quot -- newstack )
@@ -173,7 +173,7 @@ TUPLE: restart name obj continuation ;
C: <restart> restart
-: restart ( restart -- )
+: restart ( restart -- * )
[ obj>> ] [ continuation>> ] bi continue-with ;
M: object compute-restarts drop { } ;
diff --git a/core/effects/effects.factor b/core/effects/effects.factor
index 8a06653eb8..0e40d926d8 100644
--- a/core/effects/effects.factor
+++ b/core/effects/effects.factor
@@ -48,6 +48,8 @@ M: word stack-effect
{ "declared-effect" "inferred-effect" }
swap props>> [ at ] curry map [ ] find nip ;
+M: deferred stack-effect call-next-method (( -- * )) or ;
+
M: effect clone
[ in>> clone ] [ out>> clone ] bi <effect> ;
diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor
index 9ace1a01f4..f9fe3a6e9e 100644
--- a/core/generic/standard/standard.factor
+++ b/core/generic/standard/standard.factor
@@ -50,16 +50,16 @@ ERROR: no-method object generic ;
convert-hi-tag-methods
<lo-tag-dispatch-engine> ;
+: mangle-method ( method -- quot )
+ 1quotation generic get extra-values \ drop <repetition>
+ prepend [ ] like ;
+
: find-default ( methods -- quot )
#! Side-effects methods.
object bootstrap-word swap delete-at* [
- drop generic get "default-method" word-prop 1quotation
+ drop generic get "default-method" word-prop mangle-method
] unless ;
-: mangle-method ( method generic -- quot )
- [ 1quotation ] [ extra-values \ drop <repetition> ] bi*
- prepend [ ] like ;
-
: <standard-engine> ( word -- engine )
object bootstrap-word assumed set {
[ generic set ]
@@ -67,7 +67,7 @@ ERROR: no-method object generic ;
[ V{ } clone "engines" set-word-prop ]
[
"methods" word-prop
- [ generic get mangle-method ] assoc-map
+ [ mangle-method ] assoc-map
[ find-default default set ]
[ <big-dispatch-engine> ]
bi
diff --git a/core/words/words-docs.factor b/core/words/words-docs.factor
index 4dfa2d49bc..f5990c295e 100644
--- a/core/words/words-docs.factor
+++ b/core/words/words-docs.factor
@@ -288,12 +288,12 @@ HELP: define-declared
{ $side-effects "word" } ;
HELP: define-temp
-{ $values { "quot" quotation } { "word" word } }
+{ $values { "quot" quotation } { "effect" effect } { "word" word } }
{ $description "Creates an uninterned word that will call " { $snippet "quot" } " when executed." }
{ $notes
"The following phrases are equivalent:"
{ $code "[ 2 2 + . ] call" }
- { $code "[ 2 2 + . ] define-temp execute" }
+ { $code "[ 2 2 + . ] (( -- )) define-temp execute" }
"This word must be called from inside " { $link with-compilation-unit } "."
} ;
diff --git a/core/words/words.factor b/core/words/words.factor
index 4a3c1b2d52..43a391e46a 100755
--- a/core/words/words.factor
+++ b/core/words/words.factor
@@ -212,8 +212,8 @@ M: word subwords drop f ;
: gensym ( -- word )
"( gensym )" f <word> ;
-: define-temp ( quot -- word )
- [ gensym dup ] dip define ;
+: define-temp ( quot effect -- word )
+ [ gensym dup ] 2dip define-declared ;
: reveal ( word -- )
dup [ name>> ] [ vocabulary>> ] bi dup vocab-words
From f1d20719b2b7a75662cea4037c61b2b589da6e94 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 23 Feb 2009 20:51:14 -0600
Subject: [PATCH 2/7] inferred-effect word prop is just a boolean now, not an
effect object
---
basis/stack-checker/backend/backend.factor | 9 ++++-----
core/effects/effects.factor | 4 +---
2 files changed, 5 insertions(+), 8 deletions(-)
diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor
index 5f7eb5ceae..3c298bdfed 100755
--- a/basis/stack-checker/backend/backend.factor
+++ b/basis/stack-checker/backend/backend.factor
@@ -146,11 +146,10 @@ M: object apply-object push-literal ;
[ 3drop ] [ effect-error ] if ;
: finish-word ( word -- )
- current-effect
- [ check-effect ]
- [ drop recorded get push ]
- [ "inferred-effect" set-word-prop ]
- 2tri ;
+ [ current-effect check-effect ]
+ [ recorded get push ]
+ [ t "inferred-effect" set-word-prop ]
+ tri ;
: cannot-infer-effect ( word -- * )
"cannot-infer" word-prop throw ;
diff --git a/core/effects/effects.factor b/core/effects/effects.factor
index 0e40d926d8..a9f9634d46 100644
--- a/core/effects/effects.factor
+++ b/core/effects/effects.factor
@@ -44,9 +44,7 @@ M: effect effect>string ( effect -- string )
GENERIC: stack-effect ( word -- effect/f )
-M: word stack-effect
- { "declared-effect" "inferred-effect" }
- swap props>> [ at ] curry map [ ] find nip ;
+M: word stack-effect "declared-effect" word-prop ;
M: deferred stack-effect call-next-method (( -- * )) or ;
From eaad0c766018f8c3eec6cb242a3169e911f975bb Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 23 Feb 2009 21:40:17 -0600
Subject: [PATCH 3/7] Updating code to use CONSTANT: instead of : foo 123 ;
inline
---
.../bootstrap/image/download/download.factor | 2 +-
basis/cairo/ffi/ffi.factor | 6 +-
basis/farkup/farkup.factor | 2 +-
basis/furnace/actions/actions.factor | 2 +-
basis/furnace/alloy/alloy.factor | 2 +-
basis/furnace/asides/asides.factor | 2 +-
basis/furnace/auth/login/login.factor | 2 +-
basis/furnace/auth/providers/null/null.factor | 4 +-
.../conversations/conversations.factor | 2 +-
basis/furnace/sessions/sessions.factor | 2 +-
basis/furnace/utilities/utilities.factor | 4 +-
.../html/templates/chloe/syntax/syntax.factor | 2 +-
basis/io/encodings/8-bit/8-bit.factor | 11 +-
basis/logging/server/server.factor | 2 +-
basis/math/quaternions/quaternions.factor | 10 +-
basis/windows/kernel32/kernel32.factor | 4 +-
basis/x11/constants/constants.factor | 350 +++++++++---------
basis/x11/glx/glx.factor | 34 +-
basis/x11/xim/xim.factor | 2 +-
basis/xml/entities/entities.factor | 12 +-
basis/xml/errors/errors.factor | 4 +-
extra/24-game/24-game.factor | 2 +-
extra/benchmark/backtrack/backtrack.factor | 4 +-
extra/benchmark/fasta/fasta.factor | 10 +-
extra/benchmark/raytracer/raytracer.factor | 7 +-
extra/benchmark/sockets/sockets.factor | 2 +-
extra/galois-talk/galois-talk.factor | 4 +-
extra/game-input/iokit/iokit.factor | 4 +-
.../google-tech-talk/google-tech-talk.factor | 4 +-
extra/irc/client/client.factor | 2 +-
extra/irc/ui/ui.factor | 6 +-
extra/joystick-demo/joystick-demo.factor | 8 +-
extra/key-caps/key-caps.factor | 6 +-
extra/lint/lint.factor | 2 +-
extra/lisppaste/lisppaste.factor | 2 +-
extra/mason/common/common.factor | 28 +-
extra/math/analysis/analysis.factor | 4 +-
extra/maze/maze.factor | 2 +-
.../minneapolis-talk/minneapolis-talk.factor | 4 +-
extra/minneapolis-talk/minneapolis-talk.txt | 116 ------
extra/nehe/2/2.factor | 4 +-
extra/nehe/3/3.factor | 4 +-
extra/nehe/4/4.factor | 4 +-
extra/nehe/5/5.factor | 4 +-
extra/otug-talk/otug-talk.factor | 4 +-
extra/slides/slides.factor | 4 +-
extra/vpri-talk/vpri-talk.factor | 4 +-
extra/yahoo/yahoo.factor | 6 +-
unfinished/benchmark/richards/richards.factor | 272 --------------
unfinished/sql/sql-tests.factor | 42 ---
unfinished/sql/sql.factor | 172 ---------
51 files changed, 295 insertions(+), 903 deletions(-)
delete mode 100755 extra/minneapolis-talk/minneapolis-talk.txt
delete mode 100644 unfinished/benchmark/richards/richards.factor
delete mode 100644 unfinished/sql/sql-tests.factor
delete mode 100755 unfinished/sql/sql.factor
diff --git a/basis/bootstrap/image/download/download.factor b/basis/bootstrap/image/download/download.factor
index f9b7b56779..5bfc5f7ccc 100644
--- a/basis/bootstrap/image/download/download.factor
+++ b/basis/bootstrap/image/download/download.factor
@@ -4,7 +4,7 @@ USING: http.client checksums checksums.md5 splitting assocs
kernel io.files bootstrap.image sequences io urls ;
IN: bootstrap.image.download
-: url URL" http://factorcode.org/images/latest/" ;
+CONSTANT: url URL" http://factorcode.org/images/latest/"
: download-checksums ( -- alist )
url "checksums.txt" >url derive-url http-get nip
diff --git a/basis/cairo/ffi/ffi.factor b/basis/cairo/ffi/ffi.factor
index d29a3fb097..c2daa05374 100644
--- a/basis/cairo/ffi/ffi.factor
+++ b/basis/cairo/ffi/ffi.factor
@@ -72,9 +72,9 @@ C-ENUM:
CAIRO_STATUS_INVALID_STRIDE ;
TYPEDEF: int cairo_content_t
-: CAIRO_CONTENT_COLOR HEX: 1000 ;
-: CAIRO_CONTENT_ALPHA HEX: 2000 ;
-: CAIRO_CONTENT_COLOR_ALPHA HEX: 3000 ;
+CONSTANT: CAIRO_CONTENT_COLOR HEX: 1000
+CONSTANT: CAIRO_CONTENT_ALPHA HEX: 2000
+CONSTANT: CAIRO_CONTENT_COLOR_ALPHA HEX: 3000
TYPEDEF: void* cairo_write_func_t
: cairo-write-func ( quot -- callback )
diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor
index eea30a3040..50ee938659 100755
--- a/basis/farkup/farkup.factor
+++ b/basis/farkup/farkup.factor
@@ -157,7 +157,7 @@ stand-alone
= (line | code | heading | list | table | paragraph | nl)*
;EBNF
-: invalid-url "javascript:alert('Invalid URL in farkup');" ;
+CONSTANT: invalid-url "javascript:alert('Invalid URL in farkup');"
: check-url ( href -- href' )
{
diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor
index 97cb73c9cb..166d2a88a2 100644
--- a/basis/furnace/actions/actions.factor
+++ b/basis/furnace/actions/actions.factor
@@ -63,7 +63,7 @@ TUPLE: action rest init authorize display validate submit ;
: param ( name -- value )
params get at ;
-: revalidate-url-key "__u" ;
+CONSTANT: revalidate-url-key "__u"
: revalidate-url ( -- url/f )
revalidate-url-key param
diff --git a/basis/furnace/alloy/alloy.factor b/basis/furnace/alloy/alloy.factor
index 0fe80427b9..dc280c1e44 100644
--- a/basis/furnace/alloy/alloy.factor
+++ b/basis/furnace/alloy/alloy.factor
@@ -10,7 +10,7 @@ furnace.auth.providers
furnace.auth.login.permits ;
IN: furnace.alloy
-: state-classes { session aside conversation permit } ; inline
+CONSTANT: state-classes { session aside conversation permit }
: init-furnace-tables ( -- )
state-classes ensure-tables
diff --git a/basis/furnace/asides/asides.factor b/basis/furnace/asides/asides.factor
index 7489d19f94..ecf6d0a628 100644
--- a/basis/furnace/asides/asides.factor
+++ b/basis/furnace/asides/asides.factor
@@ -23,7 +23,7 @@ aside "ASIDES" {
{ "post-data" "POST_DATA" FACTOR-BLOB }
} define-persistent
-: aside-id-key "__a" ;
+CONSTANT: aside-id-key "__a"
TUPLE: asides < server-state-manager ;
diff --git a/basis/furnace/auth/login/login.factor b/basis/furnace/auth/login/login.factor
index 0ceafa7f86..915ae1c224 100644
--- a/basis/furnace/auth/login/login.factor
+++ b/basis/furnace/auth/login/login.factor
@@ -64,7 +64,7 @@ SYMBOL: capabilities
PRIVATE>
-: flashed-variables { description capabilities } ;
+CONSTANT: flashed-variables { description capabilities }
: login-failed ( -- * )
"invalid username or password" validation-error
diff --git a/basis/furnace/auth/providers/null/null.factor b/basis/furnace/auth/providers/null/null.factor
index 39ea812ae7..0fab3c5b09 100644
--- a/basis/furnace/auth/providers/null/null.factor
+++ b/basis/furnace/auth/providers/null/null.factor
@@ -3,9 +3,7 @@
USING: furnace.auth.providers kernel ;
IN: furnace.auth.providers.null
-TUPLE: no-users ;
-
-: no-users T{ no-users } ;
+SINGLETON: no-users
M: no-users get-user 2drop f ;
diff --git a/basis/furnace/conversations/conversations.factor b/basis/furnace/conversations/conversations.factor
index 266958c8a4..bbb84e2f05 100644
--- a/basis/furnace/conversations/conversations.factor
+++ b/basis/furnace/conversations/conversations.factor
@@ -20,7 +20,7 @@ conversation "CONVERSATIONS" {
{ "session" "SESSION" BIG-INTEGER +not-null+ }
} define-persistent
-: conversation-id-key "__c" ;
+CONSTANT: conversation-id-key "__c"
TUPLE: conversations < server-state-manager ;
diff --git a/basis/furnace/sessions/sessions.factor b/basis/furnace/sessions/sessions.factor
index 52e705c153..3eb7a11215 100644
--- a/basis/furnace/sessions/sessions.factor
+++ b/basis/furnace/sessions/sessions.factor
@@ -73,7 +73,7 @@ TUPLE: sessions < server-state-manager domain verify? ;
[ session set ] [ save-session-after ] bi
sessions get responder>> call-responder ;
-: session-id-key "__s" ;
+CONSTANT: session-id-key "__s"
: verify-session ( session -- session )
sessions get verify?>> [
diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor
index 4fc68f7735..c0cb7dbced 100755
--- a/basis/furnace/utilities/utilities.factor
+++ b/basis/furnace/utilities/utilities.factor
@@ -89,7 +89,7 @@ M: object modify-form drop f ;
[XML <input type="hidden" value=<-> name=<->/> XML]
] [ drop ] if ;
-: nested-forms-key "__n" ;
+CONSTANT: nested-forms-key "__n"
: request-params ( request -- assoc )
dup method>> {
@@ -131,7 +131,7 @@ M: object modify-form drop f ;
SYMBOL: exit-continuation
-: exit-with ( value -- )
+: exit-with ( value -- * )
exit-continuation get continue-with ;
: with-exit-continuation ( quot -- value )
diff --git a/basis/html/templates/chloe/syntax/syntax.factor b/basis/html/templates/chloe/syntax/syntax.factor
index faf8bed66b..9e7079023d 100644
--- a/basis/html/templates/chloe/syntax/syntax.factor
+++ b/basis/html/templates/chloe/syntax/syntax.factor
@@ -18,7 +18,7 @@ tags [ H{ } clone ] initialize
: CHLOE:
scan parse-definition define-chloe-tag ; parsing
-: chloe-ns "http://factorcode.org/chloe/1.0" ; inline
+CONSTANT: chloe-ns "http://factorcode.org/chloe/1.0"
: chloe-name? ( name -- ? )
url>> chloe-ns = ;
diff --git a/basis/io/encodings/8-bit/8-bit.factor b/basis/io/encodings/8-bit/8-bit.factor
index bad2d9fd82..9ef2b07322 100644
--- a/basis/io/encodings/8-bit/8-bit.factor
+++ b/basis/io/encodings/8-bit/8-bit.factor
@@ -4,12 +4,12 @@ USING: math.parser arrays io.encodings sequences kernel assocs
hashtables io.encodings.ascii generic parser classes.tuple words
words.symbol io io.files splitting namespaces math
compiler.units accessors classes.singleton classes.mixin
-io.encodings.iana ;
+io.encodings.iana fry ;
IN: io.encodings.8-bit
<PRIVATE
-: mappings {
+CONSTANT: mappings {
! encoding-name iana-name file-name
{ "latin1" "ISO_8859-1:1987" "8859-1" }
{ "latin2" "ISO_8859-2:1987" "8859-2" }
@@ -30,11 +30,10 @@ IN: io.encodings.8-bit
{ "windows-1252" "windows-1252" "CP1252" }
{ "ebcdic" "IBM037" "CP037" }
{ "mac-roman" "macintosh" "ROMAN" }
-} ;
+}
: encoding-file ( file-name -- stream )
- "vocab:io/encodings/8-bit/" swap ".TXT"
- 3append ;
+ "vocab:io/encodings/8-bit/" ".TXT" surround ;
: process-contents ( lines -- assoc )
[ "#" split1 drop ] map harvest
@@ -42,7 +41,7 @@ IN: io.encodings.8-bit
: byte>ch ( assoc -- array )
256 replacement-char <array>
- [ [ swapd set-nth ] curry assoc-each ] keep ;
+ [ '[ swap _ set-nth ] assoc-each ] keep ;
: ch>byte ( assoc -- newassoc )
[ swap ] assoc-map >hashtable ;
diff --git a/basis/logging/server/server.factor b/basis/logging/server/server.factor
index 618dba544c..7dced852fd 100644
--- a/basis/logging/server/server.factor
+++ b/basis/logging/server/server.factor
@@ -63,7 +63,7 @@ SYMBOL: log-files
dup values [ try-dispose ] each
clear-assoc ;
-: keep-logs 10 ;
+CONSTANT: keep-logs 10
: ?delete-file ( path -- )
dup exists? [ delete-file ] [ drop ] if ;
diff --git a/basis/math/quaternions/quaternions.factor b/basis/math/quaternions/quaternions.factor
index bc6da9f564..f2c2c6d226 100755
--- a/basis/math/quaternions/quaternions.factor
+++ b/basis/math/quaternions/quaternions.factor
@@ -45,13 +45,13 @@ PRIVATE>
first2 [ imaginary-part ] dip >rect 3array ;
! Zero
-: q0 { 0 0 } ;
+CONSTANT: q0 { 0 0 }
! Units
-: q1 { 1 0 } ;
-: qi { C{ 0 1 } 0 } ;
-: qj { 0 1 } ;
-: qk { 0 C{ 0 1 } } ;
+CONSTANT: q1 { 1 0 }
+CONSTANT: qi { C{ 0 1 } 0 }
+CONSTANT: qj { 0 1 }
+CONSTANT: qk { 0 C{ 0 1 } }
! Euler angles
diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor
index 8a271f7210..36acc5e346 100755
--- a/basis/windows/kernel32/kernel32.factor
+++ b/basis/windows/kernel32/kernel32.factor
@@ -993,8 +993,8 @@ FUNCTION: BOOL DuplicateHandle (
BOOL bInheritHandle,
DWORD dwOptions ) ;
-: DUPLICATE_CLOSE_SOURCE 1 ;
-: DUPLICATE_SAME_ACCESS 2 ;
+CONSTANT: DUPLICATE_CLOSE_SOURCE 1
+CONSTANT: DUPLICATE_SAME_ACCESS 2
! FUNCTION: EncodePointer
! FUNCTION: EncodeSystemPointer
diff --git a/basis/x11/constants/constants.factor b/basis/x11/constants/constants.factor
index fcce09380f..1fe825d6af 100644
--- a/basis/x11/constants/constants.factor
+++ b/basis/x11/constants/constants.factor
@@ -12,17 +12,17 @@ TYPEDEF: uchar KeyCode
! Reserved Resource and Constant Definitions
-: ParentRelative 1 ;
-: CopyFromParent 0 ;
-: PointerWindow 0 ;
-: InputFocus 1 ;
-: PointerRoot 1 ;
-: AnyPropertyType 0 ;
-: AnyKey 0 ;
-: AnyButton 0 ;
-: AllTemporary 0 ;
-: CurrentTime 0 ;
-: NoSymbol 0 ;
+CONSTANT: ParentRelative 1
+CONSTANT: CopyFromParent 0
+CONSTANT: PointerWindow 0
+CONSTANT: InputFocus 1
+CONSTANT: PointerRoot 1
+CONSTANT: AnyPropertyType 0
+CONSTANT: AnyKey 0
+CONSTANT: AnyButton 0
+CONSTANT: AllTemporary 0
+CONSTANT: CurrentTime 0
+CONSTANT: NoSymbol 0
! Key masks. Used as modifiers to GrabButton and GrabKey, results of QueryPointer,
! state in various key-, mouse-, and button-related events.
@@ -31,14 +31,14 @@ TYPEDEF: uchar KeyCode
! modifier names. Used to build a SetModifierMapping request or
! to read a GetModifierMapping request. These correspond to the
! masks defined above.
-: ShiftMapIndex 0 ;
-: LockMapIndex 1 ;
-: ControlMapIndex 2 ;
-: Mod1MapIndex 3 ;
-: Mod2MapIndex 4 ;
-: Mod3MapIndex 5 ;
-: Mod4MapIndex 6 ;
-: Mod5MapIndex 7 ;
+CONSTANT: ShiftMapIndex 0
+CONSTANT: LockMapIndex 1
+CONSTANT: ControlMapIndex 2
+CONSTANT: Mod1MapIndex 3
+CONSTANT: Mod2MapIndex 4
+CONSTANT: Mod3MapIndex 5
+CONSTANT: Mod4MapIndex 6
+CONSTANT: Mod5MapIndex 7
! button masks. Used in same manner as Key masks above. Not to be confused
@@ -53,100 +53,100 @@ TYPEDEF: uchar KeyCode
! Notify modes
-: NotifyNormal 0 ;
-: NotifyGrab 1 ;
-: NotifyUngrab 2 ;
-: NotifyWhileGrabbed 3 ;
+CONSTANT: NotifyNormal 0
+CONSTANT: NotifyGrab 1
+CONSTANT: NotifyUngrab 2
+CONSTANT: NotifyWhileGrabbed 3
-: NotifyHint 1 ; ! for MotionNotify events
+CONSTANT: NotifyHint 1 ! for MotionNotify events
! Notify detail
-: NotifyAncestor 0 ;
-: NotifyVirtual 1 ;
-: NotifyInferior 2 ;
-: NotifyNonlinear 3 ;
-: NotifyNonlinearVirtual 4 ;
-: NotifyPointer 5 ;
-: NotifyPointerRoot 6 ;
-: NotifyDetailNone 7 ;
+CONSTANT: NotifyAncestor 0
+CONSTANT: NotifyVirtual 1
+CONSTANT: NotifyInferior 2
+CONSTANT: NotifyNonlinear 3
+CONSTANT: NotifyNonlinearVirtual 4
+CONSTANT: NotifyPointer 5
+CONSTANT: NotifyPointerRoot 6
+CONSTANT: NotifyDetailNone 7
! Visibility notify
-: VisibilityUnobscured 0 ;
-: VisibilityPartiallyObscured 1 ;
-: VisibilityFullyObscured 2 ;
+CONSTANT: VisibilityUnobscured 0
+CONSTANT: VisibilityPartiallyObscured 1
+CONSTANT: VisibilityFullyObscured 2
! Circulation request
-: PlaceOnTop 0 ;
-: PlaceOnBottom 1 ;
+CONSTANT: PlaceOnTop 0
+CONSTANT: PlaceOnBottom 1
! protocol families
-: FamilyInternet 0 ; ! IPv4
-: FamilyDECnet 1 ;
-: FamilyChaos 2 ;
-: FamilyInternet6 6 ; ! IPv6
+CONSTANT: FamilyInternet 0 ! IPv4
+CONSTANT: FamilyDECnet 1
+CONSTANT: FamilyChaos 2
+CONSTANT: FamilyInternet6 6 ! IPv6
! authentication families not tied to a specific protocol
-: FamilyServerInterpreted 5 ;
+CONSTANT: FamilyServerInterpreted 5
! Property notification
-: PropertyNewValue 0 ;
-: PropertyDelete 1 ;
+CONSTANT: PropertyNewValue 0
+CONSTANT: PropertyDelete 1
! Color Map notification
-: ColormapUninstalled 0 ;
-: ColormapInstalled 1 ;
+CONSTANT: ColormapUninstalled 0
+CONSTANT: ColormapInstalled 1
! GrabPointer, GrabButton, GrabKeyboard, GrabKey Modes
-: GrabModeSync 0 ;
-: GrabModeAsync 1 ;
+CONSTANT: GrabModeSync 0
+CONSTANT: GrabModeAsync 1
! GrabPointer, GrabKeyboard reply status
-: GrabSuccess 0 ;
-: AlreadyGrabbed 1 ;
-: GrabInvalidTime 2 ;
-: GrabNotViewable 3 ;
-: GrabFrozen 4 ;
+CONSTANT: GrabSuccess 0
+CONSTANT: AlreadyGrabbed 1
+CONSTANT: GrabInvalidTime 2
+CONSTANT: GrabNotViewable 3
+CONSTANT: GrabFrozen 4
! AllowEvents modes
-: AsyncPointer 0 ;
-: SyncPointer 1 ;
-: ReplayPointer 2 ;
-: AsyncKeyboard 3 ;
-: SyncKeyboard 4 ;
-: ReplayKeyboard 5 ;
-: AsyncBoth 6 ;
-: SyncBoth 7 ;
+CONSTANT: AsyncPointer 0
+CONSTANT: SyncPointer 1
+CONSTANT: ReplayPointer 2
+CONSTANT: AsyncKeyboard 3
+CONSTANT: SyncKeyboard 4
+CONSTANT: ReplayKeyboard 5
+CONSTANT: AsyncBoth 6
+CONSTANT: SyncBoth 7
! Used in SetInputFocus, GetInputFocus
: RevertToNone ( -- n ) None ;
: RevertToPointerRoot ( -- n ) PointerRoot ;
-: RevertToParent 2 ;
+CONSTANT: RevertToParent 2
! *****************************************************************
! * ERROR CODES
! *****************************************************************
-: Success 0 ; ! everything's okay
-: BadRequest 1 ; ! bad request code
-: BadValue 2 ; ! int parameter out of range
-: BadWindow 3 ; ! parameter not a Window
-: BadPixmap 4 ; ! parameter not a Pixmap
-: BadAtom 5 ; ! parameter not an Atom
-: BadCursor 6 ; ! parameter not a Cursor
-: BadFont 7 ; ! parameter not a Font
-: BadMatch 8 ; ! parameter mismatch
-: BadDrawable 9 ; ! parameter not a Pixmap or Window
-: BadAccess 10 ; ! depending on context:
+CONSTANT: Success 0 ! everything's okay
+CONSTANT: BadRequest 1 ! bad request code
+CONSTANT: BadValue 2 ! int parameter out of range
+CONSTANT: BadWindow 3 ! parameter not a Window
+CONSTANT: BadPixmap 4 ! parameter not a Pixmap
+CONSTANT: BadAtom 5 ! parameter not an Atom
+CONSTANT: BadCursor 6 ! parameter not a Cursor
+CONSTANT: BadFont 7 ! parameter not a Font
+CONSTANT: BadMatch 8 ! parameter mismatch
+CONSTANT: BadDrawable 9 ! parameter not a Pixmap or Window
+CONSTANT: BadAccess 10 ! depending on context:
! - key/button already grabbed
! - attempt to free an illegal
! cmap entry
@@ -154,16 +154,16 @@ TYPEDEF: uchar KeyCode
! color map entry.
! - attempt to modify the access control
! list from other than the local host.
-: BadAlloc 11 ; ! insufficient resources
-: BadColor 12 ; ! no such colormap
-: BadGC 13 ; ! parameter not a GC
-: BadIDChoice 14 ; ! choice not in range or already used
-: BadName 15 ; ! font or color name doesn't exist
-: BadLength 16 ; ! Request length incorrect
-: BadImplementation 17 ; ! server is defective
+CONSTANT: BadAlloc 11 ! insufficient resources
+CONSTANT: BadColor 12 ! no such colormap
+CONSTANT: BadGC 13 ! parameter not a GC
+CONSTANT: BadIDChoice 14 ! choice not in range or already used
+CONSTANT: BadName 15 ! font or color name doesn't exist
+CONSTANT: BadLength 16 ! Request length incorrect
+CONSTANT: BadImplementation 17 ! server is defective
-: FirstExtensionError 128 ;
-: LastExtensionError 255 ;
+CONSTANT: FirstExtensionError 128
+CONSTANT: LastExtensionError 255
! *****************************************************************
! * WINDOW DEFINITIONS
@@ -172,44 +172,44 @@ TYPEDEF: uchar KeyCode
! Window classes used by CreateWindow
! Note that CopyFromParent is already defined as 0 above
-: InputOutput 1 ;
-: InputOnly 2 ;
+CONSTANT: InputOutput 1
+CONSTANT: InputOnly 2
! Used in CreateWindow for backing-store hint
-: NotUseful 0 ;
-: WhenMapped 1 ;
-: Always 2 ;
+CONSTANT: NotUseful 0
+CONSTANT: WhenMapped 1
+CONSTANT: Always 2
! Used in ChangeSaveSet
-: SetModeInsert 0 ;
-: SetModeDelete 1 ;
+CONSTANT: SetModeInsert 0
+CONSTANT: SetModeDelete 1
! Used in ChangeCloseDownMode
-: DestroyAll 0 ;
-: RetainPermanent 1 ;
-: RetainTemporary 2 ;
+CONSTANT: DestroyAll 0
+CONSTANT: RetainPermanent 1
+CONSTANT: RetainTemporary 2
! Window stacking method (in configureWindow)
-: Above 0 ;
-: Below 1 ;
-: TopIf 2 ;
-: BottomIf 3 ;
-: Opposite 4 ;
+CONSTANT: Above 0
+CONSTANT: Below 1
+CONSTANT: TopIf 2
+CONSTANT: BottomIf 3
+CONSTANT: Opposite 4
! Circulation direction
-: RaiseLowest 0 ;
-: LowerHighest 1 ;
+CONSTANT: RaiseLowest 0
+CONSTANT: LowerHighest 1
! Property modes
-: PropModeReplace 0 ;
-: PropModePrepend 1 ;
-: PropModeAppend 2 ;
+CONSTANT: PropModeReplace 0
+CONSTANT: PropModePrepend 1
+CONSTANT: PropModeAppend 2
! *****************************************************************
! * GRAPHICS DEFINITIONS
@@ -217,62 +217,62 @@ TYPEDEF: uchar KeyCode
! LineStyle
-: LineSolid 0 ;
-: LineOnOffDash 1 ;
-: LineDoubleDash 2 ;
+CONSTANT: LineSolid 0
+CONSTANT: LineOnOffDash 1
+CONSTANT: LineDoubleDash 2
! capStyle
-: CapNotLast 0 ;
-: CapButt 1 ;
-: CapRound 2 ;
-: CapProjecting 3 ;
+CONSTANT: CapNotLast 0
+CONSTANT: CapButt 1
+CONSTANT: CapRound 2
+CONSTANT: CapProjecting 3
! joinStyle
-: JoinMiter 0 ;
-: JoinRound 1 ;
-: JoinBevel 2 ;
+CONSTANT: JoinMiter 0
+CONSTANT: JoinRound 1
+CONSTANT: JoinBevel 2
! fillStyle
-: FillSolid 0 ;
-: FillTiled 1 ;
-: FillStippled 2 ;
-: FillOpaqueStippled 3 ;
+CONSTANT: FillSolid 0
+CONSTANT: FillTiled 1
+CONSTANT: FillStippled 2
+CONSTANT: FillOpaqueStippled 3
! fillRule
-: EvenOddRule 0 ;
-: WindingRule 1 ;
+CONSTANT: EvenOddRule 0
+CONSTANT: WindingRule 1
! subwindow mode
-: ClipByChildren 0 ;
-: IncludeInferiors 1 ;
+CONSTANT: ClipByChildren 0
+CONSTANT: IncludeInferiors 1
! SetClipRectangles ordering
-: Unsorted 0 ;
-: YSorted 1 ;
-: YXSorted 2 ;
-: YXBanded 3 ;
+CONSTANT: Unsorted 0
+CONSTANT: YSorted 1
+CONSTANT: YXSorted 2
+CONSTANT: YXBanded 3
! CoordinateMode for drawing routines
-: CoordModeOrigin 0 ; ! relative to the origin
-: CoordModePrevious 1 ; ! relative to previous point
+CONSTANT: CoordModeOrigin 0 ! relative to the origin
+CONSTANT: CoordModePrevious 1 ! relative to previous point
! Polygon shapes
-: Complex 0 ; ! paths may intersect
-: Nonconvex 1 ; ! no paths intersect, but not convex
-: Convex 2 ; ! wholly convex
+CONSTANT: Complex 0 ! paths may intersect
+CONSTANT: Nonconvex 1 ! no paths intersect, but not convex
+CONSTANT: Convex 2 ! wholly convex
! Arc modes for PolyFillArc
-: ArcChord 0 ; ! join endpoints of arc
-: ArcPieSlice 1 ; ! join endpoints to center of arc
+CONSTANT: ArcChord 0 ! join endpoints of arc
+CONSTANT: ArcPieSlice 1 ! join endpoints to center of arc
! *****************************************************************
! * FONTS
@@ -280,10 +280,10 @@ TYPEDEF: uchar KeyCode
! used in QueryFont -- draw direction
-: FontLeftToRight 0 ;
-: FontRightToLeft 1 ;
+CONSTANT: FontLeftToRight 0
+CONSTANT: FontRightToLeft 1
-: FontChange 255 ;
+CONSTANT: FontChange 255
! *****************************************************************
! * IMAGING
@@ -291,9 +291,9 @@ TYPEDEF: uchar KeyCode
! ImageFormat -- PutImage, GetImage
-: XYBitmap 0 ; ! depth 1, XYFormat
-: XYPixmap 1 ; ! depth == drawable depth
-: ZPixmap 2 ; ! depth == drawable depth
+CONSTANT: XYBitmap 0 ! depth 1, XYFormat
+CONSTANT: XYPixmap 1 ! depth == drawable depth
+CONSTANT: ZPixmap 2 ! depth == drawable depth
! *****************************************************************
! * COLOR MAP STUFF
@@ -301,8 +301,8 @@ TYPEDEF: uchar KeyCode
! For CreateColormap
-: AllocNone 0 ; ! create map with no entries
-: AllocAll 1 ; ! allocate entire map writeable
+CONSTANT: AllocNone 0 ! create map with no entries
+CONSTANT: AllocAll 1 ! allocate entire map writeable
! Flags used in StoreNamedColor, StoreColors
@@ -317,20 +317,20 @@ TYPEDEF: uchar KeyCode
! QueryBestSize Class
-: CursorShape 0 ; ! largest size that can be displayed
-: TileShape 1 ; ! size tiled fastest
-: StippleShape 2 ; ! size stippled fastest
+CONSTANT: CursorShape 0 ! largest size that can be displayed
+CONSTANT: TileShape 1 ! size tiled fastest
+CONSTANT: StippleShape 2 ! size stippled fastest
! *****************************************************************
! * KEYBOARD/POINTER STUFF
! *****************************************************************
-: AutoRepeatModeOff 0 ;
-: AutoRepeatModeOn 1 ;
-: AutoRepeatModeDefault 2 ;
+CONSTANT: AutoRepeatModeOff 0
+CONSTANT: AutoRepeatModeOn 1
+CONSTANT: AutoRepeatModeDefault 2
-: LedModeOff 0 ;
-: LedModeOn 1 ;
+CONSTANT: LedModeOff 0
+CONSTANT: LedModeOn 1
! masks for ChangeKeyboardControl
@@ -343,33 +343,33 @@ TYPEDEF: uchar KeyCode
: KBKey ( -- n ) 6 2^ ;
: KBAutoRepeatMode ( -- n ) 7 2^ ;
-: MappingSuccess 0 ;
-: MappingBusy 1 ;
-: MappingFailed 2 ;
+CONSTANT: MappingSuccess 0
+CONSTANT: MappingBusy 1
+CONSTANT: MappingFailed 2
-: MappingModifier 0 ;
-: MappingKeyboard 1 ;
-: MappingPointer 2 ;
+CONSTANT: MappingModifier 0
+CONSTANT: MappingKeyboard 1
+CONSTANT: MappingPointer 2
! *****************************************************************
! * SCREEN SAVER STUFF
! *****************************************************************
-: DontPreferBlanking 0 ;
-: PreferBlanking 1 ;
-: DefaultBlanking 2 ;
+CONSTANT: DontPreferBlanking 0
+CONSTANT: PreferBlanking 1
+CONSTANT: DefaultBlanking 2
-: DisableScreenSaver 0 ;
-: DisableScreenInterval 0 ;
+CONSTANT: DisableScreenSaver 0
+CONSTANT: DisableScreenInterval 0
-: DontAllowExposures 0 ;
-: AllowExposures 1 ;
-: DefaultExposures 2 ;
+CONSTANT: DontAllowExposures 0
+CONSTANT: AllowExposures 1
+CONSTANT: DefaultExposures 2
! for ForceScreenSaver
-: ScreenSaverReset 0 ;
-: ScreenSaverActive 1 ;
+CONSTANT: ScreenSaverReset 0
+CONSTANT: ScreenSaverActive 1
! *****************************************************************
! * HOSTS AND CONNECTIONS
@@ -377,30 +377,30 @@ TYPEDEF: uchar KeyCode
! for ChangeHosts
-: HostInsert 0 ;
-: HostDelete 1 ;
+CONSTANT: HostInsert 0
+CONSTANT: HostDelete 1
! for ChangeAccessControl
-: EnableAccess 1 ;
-: DisableAccess 0 ;
+CONSTANT: EnableAccess 1
+CONSTANT: DisableAccess 0
! Display classes used in opening the connection
! Note that the statically allocated ones are even numbered and the
! dynamically changeable ones are odd numbered
-: StaticGray 0 ;
-: GrayScale 1 ;
-: StaticColor 2 ;
-: PseudoColor 3 ;
-: TrueColor 4 ;
-: DirectColor 5 ;
+CONSTANT: StaticGray 0
+CONSTANT: GrayScale 1
+CONSTANT: StaticColor 2
+CONSTANT: PseudoColor 3
+CONSTANT: TrueColor 4
+CONSTANT: DirectColor 5
! Byte order used in imageByteOrder and bitmapBitOrder
-: LSBFirst 0 ;
-: MSBFirst 1 ;
+CONSTANT: LSBFirst 0
+CONSTANT: MSBFirst 1
! *****************************************************************
! * EXTENDED WINDOW MANAGER HINTS
diff --git a/basis/x11/glx/glx.factor b/basis/x11/glx/glx.factor
index 11473d6e83..e6001d3e59 100644
--- a/basis/x11/glx/glx.factor
+++ b/basis/x11/glx/glx.factor
@@ -9,23 +9,23 @@ IN: x11.glx
LIBRARY: glx
! Visual Config Attributes (glXGetConfig, glXGetFBConfigAttrib)
-: GLX_USE_GL 1 ; ! support GLX rendering
-: GLX_BUFFER_SIZE 2 ; ! depth of the color buffer
-: GLX_LEVEL 3 ; ! level in plane stacking
-: GLX_RGBA 4 ; ! true if RGBA mode
-: GLX_DOUBLEBUFFER 5 ; ! double buffering supported
-: GLX_STEREO 6 ; ! stereo buffering supported
-: GLX_AUX_BUFFERS 7 ; ! number of aux buffers
-: GLX_RED_SIZE 8 ; ! number of red component bits
-: GLX_GREEN_SIZE 9 ; ! number of green component bits
-: GLX_BLUE_SIZE 10 ; ! number of blue component bits
-: GLX_ALPHA_SIZE 11 ; ! number of alpha component bits
-: GLX_DEPTH_SIZE 12 ; ! number of depth bits
-: GLX_STENCIL_SIZE 13 ; ! number of stencil bits
-: GLX_ACCUM_RED_SIZE 14 ; ! number of red accum bits
-: GLX_ACCUM_GREEN_SIZE 15 ; ! number of green accum bits
-: GLX_ACCUM_BLUE_SIZE 16 ; ! number of blue accum bits
-: GLX_ACCUM_ALPHA_SIZE 17 ; ! number of alpha accum bits
+CONSTANT: GLX_USE_GL 1 ! support GLX rendering
+CONSTANT: GLX_BUFFER_SIZE 2 ! depth of the color buffer
+CONSTANT: GLX_LEVEL 3 ! level in plane stacking
+CONSTANT: GLX_RGBA 4 ! true if RGBA mode
+CONSTANT: GLX_DOUBLEBUFFER 5 ! double buffering supported
+CONSTANT: GLX_STEREO 6 ! stereo buffering supported
+CONSTANT: GLX_AUX_BUFFERS 7 ! number of aux buffers
+CONSTANT: GLX_RED_SIZE 8 ! number of red component bits
+CONSTANT: GLX_GREEN_SIZE 9 ! number of green component bits
+CONSTANT: GLX_BLUE_SIZE 10 ! number of blue component bits
+CONSTANT: GLX_ALPHA_SIZE 11 ! number of alpha component bits
+CONSTANT: GLX_DEPTH_SIZE 12 ! number of depth bits
+CONSTANT: GLX_STENCIL_SIZE 13 ! number of stencil bits
+CONSTANT: GLX_ACCUM_RED_SIZE 14 ! number of red accum bits
+CONSTANT: GLX_ACCUM_GREEN_SIZE 15 ! number of green accum bits
+CONSTANT: GLX_ACCUM_BLUE_SIZE 16 ! number of blue accum bits
+CONSTANT: GLX_ACCUM_ALPHA_SIZE 17 ! number of alpha accum bits
TYPEDEF: XID GLXContextID
TYPEDEF: XID GLXPixmap
diff --git a/basis/x11/xim/xim.factor b/basis/x11/xim/xim.factor
index 534e47ac37..e06872fa83 100644
--- a/basis/x11/xim/xim.factor
+++ b/basis/x11/xim/xim.factor
@@ -34,7 +34,7 @@ SYMBOL: xim
XNResourceClass over 0 XCreateIC
[ "XCreateIC() failed" throw ] unless* ;
-: buf-size 100 ;
+CONSTANT: buf-size 100
SYMBOL: keybuf
SYMBOL: keysym
diff --git a/basis/xml/entities/entities.factor b/basis/xml/entities/entities.factor
index 3e768b1b88..7eac725052 100644
--- a/basis/xml/entities/entities.factor
+++ b/basis/xml/entities/entities.factor
@@ -4,20 +4,20 @@ USING: namespaces make kernel assocs sequences fry values
io.files io.encodings.binary xml.state ;
IN: xml.entities
-: entities-out
+CONSTANT: entities-out
H{
{ CHAR: < "<" }
{ CHAR: > ">" }
{ CHAR: & "&" }
- } ;
+ }
-: quoted-entities-out
+CONSTANT: quoted-entities-out
H{
{ CHAR: & "&" }
{ CHAR: ' "'" }
{ CHAR: " """ }
{ CHAR: < "<" }
- } ;
+ }
: escape-string-by ( str table -- escaped )
#! Convert <, >, &, ' and " to HTML entities.
@@ -29,14 +29,14 @@ IN: xml.entities
: escape-quoted-string ( str -- newstr )
quoted-entities-out escape-string-by ;
-: entities
+CONSTANT: entities
H{
{ "lt" CHAR: < }
{ "gt" CHAR: > }
{ "amp" CHAR: & }
{ "apos" CHAR: ' }
{ "quot" CHAR: " }
- } ;
+ }
: with-entities ( entities quot -- )
[ swap extra-entities set call ] with-scope ; inline
diff --git a/basis/xml/errors/errors.factor b/basis/xml/errors/errors.factor
index 304b38f2bd..35111f5a54 100644
--- a/basis/xml/errors/errors.factor
+++ b/basis/xml/errors/errors.factor
@@ -290,7 +290,7 @@ M: quoteless-attr summary
TUPLE: attr-w/< < xml-error-at ;
-: attr-w/< ( value -- * )
+: attr-w/< ( -- * )
\ attr-w/< xml-error-at throw ;
M: attr-w/< summary
@@ -299,7 +299,7 @@ M: attr-w/< summary
TUPLE: text-w/]]> < xml-error-at ;
-: text-w/]]> ( text -- * )
+: text-w/]]> ( -- * )
\ text-w/]]> xml-error-at throw ;
M: text-w/]]> summary
diff --git a/extra/24-game/24-game.factor b/extra/24-game/24-game.factor
index f842d5f4cb..f22ca001f4 100644
--- a/extra/24-game/24-game.factor
+++ b/extra/24-game/24-game.factor
@@ -7,7 +7,7 @@ arrays words quotations accessors math.parser backtrack assocs ;
IN: 24-game
SYMBOL: commands
-: nop ;
+: nop ( -- ) ;
: do-something ( a b -- c ) { + - * } amb-execute ;
: maybe-swap ( a b -- a b ) { nop swap } amb-execute ;
: some-rots ( a b c -- a b c )
diff --git a/extra/benchmark/backtrack/backtrack.factor b/extra/benchmark/backtrack/backtrack.factor
index df67872b11..0ae7d792dd 100755
--- a/extra/benchmark/backtrack/backtrack.factor
+++ b/extra/benchmark/backtrack/backtrack.factor
@@ -10,7 +10,7 @@ IN: benchmark.backtrack
! placing them on the stack, and applying the operations
! +, -, * and rot as many times as we wish.
-: nop ;
+: nop ( -- ) ;
: do-something ( a b -- c )
{ + - * } amb-execute ;
@@ -42,7 +42,7 @@ MEMO: 24-from-4 ( a b c d -- ? )
] sigma
] sigma ;
-: words { 24-from-1 24-from-2 24-from-3 24-from-4 } ;
+CONSTANT: words { 24-from-1 24-from-2 24-from-3 24-from-4 }
: backtrack-benchmark ( -- )
words [ reset-memoized ] each
diff --git a/extra/benchmark/fasta/fasta.factor b/extra/benchmark/fasta/fasta.factor
index 61d9e9fd43..2ae5ada8a1 100755
--- a/extra/benchmark/fasta/fasta.factor
+++ b/extra/benchmark/fasta/fasta.factor
@@ -10,8 +10,6 @@ CONSTANT: IC 29573
CONSTANT: initial-seed 42
CONSTANT: line-length 60
-USE: math.private
-
: random ( seed -- n seed )
>float IA * IC + IM mod [ IM /f ] keep ; inline
@@ -19,7 +17,7 @@ HINTS: random fixnum ;
CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA"
-: IUB
+CONSTANT: IUB
{
{ CHAR: a 0.27 }
{ CHAR: c 0.12 }
@@ -37,15 +35,15 @@ CONSTANT: ALU "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACC
{ CHAR: V 0.02 }
{ CHAR: W 0.02 }
{ CHAR: Y 0.02 }
- } ; inline
+ }
-: homo-sapiens
+CONSTANT: homo-sapiens
{
{ CHAR: a 0.3029549426680 }
{ CHAR: c 0.1979883004921 }
{ CHAR: g 0.1975473066391 }
{ CHAR: t 0.3015094502008 }
- } ; inline
+ }
: make-cumulative ( freq -- chars floats )
dup keys >byte-array
diff --git a/extra/benchmark/raytracer/raytracer.factor b/extra/benchmark/raytracer/raytracer.factor
index 8d07ae1c65..a4df1fe04d 100755
--- a/extra/benchmark/raytracer/raytracer.factor
+++ b/extra/benchmark/raytracer/raytracer.factor
@@ -8,13 +8,14 @@ hints ;
IN: benchmark.raytracer
! parameters
-: light
- #! Normalized { -1 -3 2 }.
+
+! Normalized { -1 -3 2 }.
+CONSTANT: light
double-array{
-0.2672612419124244
-0.8017837257372732
0.5345224838248488
- } ; inline
+ }
CONSTANT: oversampling 4
diff --git a/extra/benchmark/sockets/sockets.factor b/extra/benchmark/sockets/sockets.factor
index 20c905156b..d6e4f29b86 100755
--- a/extra/benchmark/sockets/sockets.factor
+++ b/extra/benchmark/sockets/sockets.factor
@@ -10,7 +10,7 @@ SYMBOL: counter
SYMBOL: port-promise
SYMBOL: server
-: number-of-requests 1000 ;
+CONSTANT: number-of-requests 1000
: server-addr ( -- addr )
"127.0.0.1" port-promise get ?promise <inet4> ;
diff --git a/extra/galois-talk/galois-talk.factor b/extra/galois-talk/galois-talk.factor
index 259fa446af..ccba90fb6f 100644
--- a/extra/galois-talk/galois-talk.factor
+++ b/extra/galois-talk/galois-talk.factor
@@ -8,7 +8,7 @@ help.topics math.functions compiler.tree.optimizer
compiler.cfg.optimizer fry ;
IN: galois-talk
-: galois-slides
+CONSTANT: galois-slides
{
{ $slide "Factor!"
{ $url "http://factorcode.org" }
@@ -305,7 +305,7 @@ IN: galois-talk
"Factor has many cool things that I didn't talk about"
"Questions?"
}
-} ;
+}
: galois-talk ( -- ) galois-slides slides-window ;
diff --git a/extra/game-input/iokit/iokit.factor b/extra/game-input/iokit/iokit.factor
index 8a10535306..254ed61ab0 100755
--- a/extra/game-input/iokit/iokit.factor
+++ b/extra/game-input/iokit/iokit.factor
@@ -121,12 +121,12 @@ CONSTANT: hat-switch-matching-hash
: hat-switch? ( {usage-page,usage} -- ? )
{ 1 HEX: 39 } = ; inline
-: pov-values
+CONSTANT: pov-values
{
pov-up pov-up-right pov-right pov-down-right
pov-down pov-down-left pov-left pov-up-left
pov-neutral
- } ; inline
+ }
: button-value ( value -- f/(0,1] )
IOHIDValueGetIntegerValue dup zero? [ drop f ] when ;
diff --git a/extra/google-tech-talk/google-tech-talk.factor b/extra/google-tech-talk/google-tech-talk.factor
index 9bd3c5854b..4d4e3b0507 100644
--- a/extra/google-tech-talk/google-tech-talk.factor
+++ b/extra/google-tech-talk/google-tech-talk.factor
@@ -8,7 +8,7 @@ help.topics math.functions compiler.tree.optimizer
compiler.cfg.optimizer fry ;
IN: google-tech-talk
-: google-slides
+CONSTANT: google-slides
{
{ $slide "Factor!"
{ $url "http://factorcode.org" }
@@ -562,7 +562,7 @@ IN: google-tech-talk
"Put your prejudices aside and give it a shot!"
}
{ $slide "Questions?" }
-} ;
+}
: google-talk ( -- ) google-slides slides-window ;
diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor
index 0eba6f6af5..2770471093 100755
--- a/extra/irc/client/client.factor
+++ b/extra/irc/client/client.factor
@@ -12,7 +12,7 @@ IN: irc.client
! Setup and running objects
! ======================================
-: irc-port 6667 ; ! Default irc port
+CONSTANT: irc-port 6667 ! Default irc port
TUPLE: irc-profile server port nickname password ;
C: <irc-profile> irc-profile
diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor
index 59e4cf6cb4..791639d260 100755
--- a/extra/irc/ui/ui.factor
+++ b/extra/irc/ui/ui.factor
@@ -28,9 +28,9 @@ TUPLE: irc-tab < frame chat client window ;
: write-color ( str color -- )
foreground associate format ;
-: dark-red T{ rgba f 0.5 0.0 0.0 1 } ;
-: dark-green T{ rgba f 0.0 0.5 0.0 1 } ;
-: dark-blue T{ rgba f 0.0 0.0 0.5 1 } ;
+CONSTANT: dark-red T{ rgba f 0.5 0.0 0.0 1 }
+CONSTANT: dark-green T{ rgba f 0.0 0.5 0.0 1 }
+CONSTANT: dark-blue T{ rgba f 0.0 0.0 0.5 1 }
: dot-or-parens ( string -- string )
[ "." ]
diff --git a/extra/joystick-demo/joystick-demo.factor b/extra/joystick-demo/joystick-demo.factor
index 9e457c7bdd..188095dd2e 100755
--- a/extra/joystick-demo/joystick-demo.factor
+++ b/extra/joystick-demo/joystick-demo.factor
@@ -5,8 +5,8 @@ calendar locals strings ui.gadgets.buttons
combinators math.parser assocs threads ;
IN: joystick-demo
-: SIZE { 151 151 } ;
-: INDICATOR-SIZE { 4 4 } ;
+CONSTANT: SIZE { 151 151 }
+CONSTANT: INDICATOR-SIZE { 4 4 }
: FREQUENCY ( -- f ) 30 recip seconds ;
TUPLE: axis-gadget < gadget indicator z-indicator pov ;
@@ -21,7 +21,7 @@ M: axis-gadget pref-dim* drop SIZE ;
: indicator-polygon ( -- polygon )
{ 0 0 } INDICATOR-SIZE (rect-polygon) ;
-: pov-polygons
+CONSTANT: pov-polygons
V{
{ pov-neutral { { 70 75 } { 75 70 } { 80 75 } { 75 80 } } }
{ pov-up { { 70 65 } { 75 60 } { 80 65 } } }
@@ -32,7 +32,7 @@ M: axis-gadget pref-dim* drop SIZE ;
{ pov-down-left { { 67 90 } { 60 90 } { 60 83 } } }
{ pov-left { { 65 70 } { 60 75 } { 65 80 } } }
{ pov-up-left { { 67 60 } { 60 60 } { 60 67 } } }
- } ;
+ }
: <indicator-gadget> ( color -- indicator )
indicator-polygon <polygon-gadget> ;
diff --git a/extra/key-caps/key-caps.factor b/extra/key-caps/key-caps.factor
index 05edb205d2..acf20f90ab 100755
--- a/extra/key-caps/key-caps.factor
+++ b/extra/key-caps/key-caps.factor
@@ -4,7 +4,7 @@ words arrays assocs math calendar fry alarms ui
ui.gadgets.borders ui.gestures ;
IN: key-caps
-: key-locations H{
+CONSTANT: key-locations H{
{ key-escape { { 0 0 } { 10 10 } } }
{ key-f1 { { 20 0 } { 10 10 } } }
@@ -129,9 +129,9 @@ IN: key-caps
{ key-keypad-0 { { 190 55 } { 20 10 } } }
{ key-keypad-. { { 210 55 } { 10 10 } } }
-} ;
+}
-: KEYBOARD-SIZE { 230 65 } ;
+CONSTANT: KEYBOARD-SIZE { 230 65 }
: FREQUENCY ( -- f ) 30 recip seconds ;
TUPLE: key-caps-gadget < gadget keys alarm ;
diff --git a/extra/lint/lint.factor b/extra/lint/lint.factor
index 849cc540a3..9877c70062 100755
--- a/extra/lint/lint.factor
+++ b/extra/lint/lint.factor
@@ -42,7 +42,7 @@ SYMBOL: def-hash-keys
set-alien-float alien-float
} ;
-: trivial-defs
+: trivial-defs ( -- seq )
{
[ drop ] [ 2array ]
[ bitand ]
diff --git a/extra/lisppaste/lisppaste.factor b/extra/lisppaste/lisppaste.factor
index df85f01f26..43b5b78097 100644
--- a/extra/lisppaste/lisppaste.factor
+++ b/extra/lisppaste/lisppaste.factor
@@ -1,7 +1,7 @@
USING: arrays kernel xml-rpc ;
IN: lisppaste
-: url "http://www.common-lisp.net:8185/RPC2" ;
+CONSTANT: url "http://www.common-lisp.net:8185/RPC2"
: channels ( -- seq )
{ } "listchannels" url invoke-method ;
diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor
index ec0cbdbc9c..3cd38e1ff4 100644
--- a/extra/mason/common/common.factor
+++ b/extra/mason/common/common.factor
@@ -67,24 +67,24 @@ SYMBOL: stamp
: ?prepare-build-machine ( -- )
builds/factor exists? [ prepare-build-machine ] unless ;
-: load-everything-vocabs-file "load-everything-vocabs" ;
-: load-everything-errors-file "load-everything-errors" ;
+CONSTANT: load-everything-vocabs-file "load-everything-vocabs"
+CONSTANT: load-everything-errors-file "load-everything-errors"
-: test-all-vocabs-file "test-all-vocabs" ;
-: test-all-errors-file "test-all-errors" ;
+CONSTANT: test-all-vocabs-file "test-all-vocabs"
+CONSTANT: test-all-errors-file "test-all-errors"
-: help-lint-vocabs-file "help-lint-vocabs" ;
-: help-lint-errors-file "help-lint-errors" ;
+CONSTANT: help-lint-vocabs-file "help-lint-vocabs"
+CONSTANT: help-lint-errors-file "help-lint-errors"
-: boot-time-file "boot-time" ;
-: load-time-file "load-time" ;
-: compiler-errors-file "compiler-errors" ;
-: test-time-file "test-time" ;
-: help-lint-time-file "help-lint-time" ;
-: benchmark-time-file "benchmark-time" ;
-: html-help-time-file "html-help-time" ;
+CONSTANT: boot-time-file "boot-time"
+CONSTANT: load-time-file "load-time"
+CONSTANT: compiler-errors-file "compiler-errors"
+CONSTANT: test-time-file "test-time"
+CONSTANT: help-lint-time-file "help-lint-time"
+CONSTANT: benchmark-time-file "benchmark-time"
+CONSTANT: html-help-time-file "html-help-time"
-: benchmarks-file "benchmarks" ;
+CONSTANT: benchmarks-file "benchmarks"
SYMBOL: status
diff --git a/extra/math/analysis/analysis.factor b/extra/math/analysis/analysis.factor
index 9c773f748e..fa01b0376d 100755
--- a/extra/math/analysis/analysis.factor
+++ b/extra/math/analysis/analysis.factor
@@ -11,11 +11,11 @@ IN: math.analysis
CONSTANT: gamma-g6 5.15
-: gamma-p6
+CONSTANT: gamma-p6
{
2.50662827563479526904 225.525584619175212544 -268.295973841304927459
80.9030806934622512966 -5.00757863970517583837 0.0114684895434781459556
- } ; inline
+ }
: gamma-z ( x n -- seq )
[ + recip ] with map 1.0 0 pick set-nth ;
diff --git a/extra/maze/maze.factor b/extra/maze/maze.factor
index de345e732e..a490a8bbfc 100644
--- a/extra/maze/maze.factor
+++ b/extra/maze/maze.factor
@@ -4,7 +4,7 @@ arrays kernel random ui ui.gadgets ui.gadgets.canvas ui.render
math.order math.geometry.rect ;
IN: maze
-: line-width 8 ;
+CONSTANT: line-width 8
SYMBOL: visited
diff --git a/extra/minneapolis-talk/minneapolis-talk.factor b/extra/minneapolis-talk/minneapolis-talk.factor
index 25bad4061a..6f1df44bfb 100755
--- a/extra/minneapolis-talk/minneapolis-talk.factor
+++ b/extra/minneapolis-talk/minneapolis-talk.factor
@@ -2,7 +2,7 @@ USING: slides help.markup math arrays hashtables namespaces
sequences kernel sequences parser memoize ;
IN: minneapolis-talk
-: minneapolis-slides
+CONSTANT: minneapolis-slides
{
{ $slide "What is Factor?"
"Dynamically typed, stack language"
@@ -175,7 +175,7 @@ IN: minneapolis-talk
"Mailing list: factor-talk@lists.sf.net"
}
{ $slide "Questions?" }
-} ;
+}
: minneapolis-talk ( -- ) minneapolis-slides slides-window ;
diff --git a/extra/minneapolis-talk/minneapolis-talk.txt b/extra/minneapolis-talk/minneapolis-talk.txt
deleted file mode 100755
index 5310accf5b..0000000000
--- a/extra/minneapolis-talk/minneapolis-talk.txt
+++ /dev/null
@@ -1,116 +0,0 @@
-- how to create a small module
-- editor integration
-- presentations
-- module system
-- copy and paste factoring, inverse
-- help system
-- tetris
-- memoization
-- editing inspector demo
-- dynamic scope, lexical scope
-
-Factor: contradictions?
------------------------
-
-Have our cake and eat it too
-
-Research -vs- practical
-High level -vs- fast
-Interactive -vs- deployment
-
-Factor from 10,000 feet
------------------------
-
-word: named function
-vocabulary: module
-quotation: anonymous function
-classes, objects, etc.
-
-The stack
----------
-
-- Stack -vs- applicative
-- Pass by reference, dynamically typed
-- Stack languages: you can omit names where they're not needed
-- More compositional style
-- If you need to name things for clarity, you can:
- lexical vars, dynamic vars, sequences, assocs, objects...
-
-Functional programming
-----------------------
-
-Quotations
-Curry
-Continuations
-
-Object-oriented programming
----------------------------
-
-Generic words: sort of like open classes
-Tuple reshaping
-Editing inspector
-
-Meta programming
-----------------
-
-Simple, orthogonal core
-
-Why use a stack at all?
------------------------
-
-Nice idioms: 10 days ago
-Copy and paste factoring
-Easy meta-programming
-Sequence operations correspond to functional operations:
-- curry is adding at the front
-- compose is append
-
-UI
---
-
-Written in Factor
-renders with OpenGL
-Windows, X11, Cocoa backends
-You can call Windows, X11, Cocoa APIs directly
-OpenGL 2.1 shaders, OpenAL 3D audio...
-
-Tools
------
-
-Edit
-Usages
-Profiler
-Easy to make your own tools
-
-Implementation
---------------
-
-Two compilers
-Generational garbage collector
-Non-blocking I/O
-
-Hands on
---------
-
-Community
----------
-
-Factor started in 2003
-About a dozen contributors
-Handful of "core contributors"
-Web site: http://factorcode.org
-IRC: #concatenative on irc.freenode.net
-Mailing list: factor-talk@lists.sf.net
-
-C library interface
--------------------
-
-Efficient
-No need to write C code
-Supports floats, structs, unions, ...
-Function pointers, callbacks
-Here is an example
-
-TerminateProcess
-
-process-handle TerminateProcess
diff --git a/extra/nehe/2/2.factor b/extra/nehe/2/2.factor
index 29d4ccffc1..fdb53ef254 100644
--- a/extra/nehe/2/2.factor
+++ b/extra/nehe/2/2.factor
@@ -4,8 +4,8 @@ IN: nehe.2
TUPLE: nehe2-gadget < gadget ;
-: width 256 ;
-: height 256 ;
+CONSTANT: width 256
+CONSTANT: height 256
: <nehe2-gadget> ( -- gadget )
nehe2-gadget new-gadget ;
diff --git a/extra/nehe/3/3.factor b/extra/nehe/3/3.factor
index 75f2e573cc..557655a029 100644
--- a/extra/nehe/3/3.factor
+++ b/extra/nehe/3/3.factor
@@ -4,8 +4,8 @@ IN: nehe.3
TUPLE: nehe3-gadget < gadget ;
-: width 256 ;
-: height 256 ;
+CONSTANT: width 256
+CONSTANT: height 256
: <nehe3-gadget> ( -- gadget )
nehe3-gadget new-gadget ;
diff --git a/extra/nehe/4/4.factor b/extra/nehe/4/4.factor
index fda22d2f1e..00308277ea 100644
--- a/extra/nehe/4/4.factor
+++ b/extra/nehe/4/4.factor
@@ -5,8 +5,8 @@ IN: nehe.4
TUPLE: nehe4-gadget < gadget rtri rquad thread quit? ;
-: width 256 ;
-: height 256 ;
+CONSTANT: width 256
+CONSTANT: height 256
: redraw-interval ( -- dt ) 10 milliseconds ;
: <nehe4-gadget> ( -- gadget )
diff --git a/extra/nehe/5/5.factor b/extra/nehe/5/5.factor
index 30d0991fd8..3723014c83 100755
--- a/extra/nehe/5/5.factor
+++ b/extra/nehe/5/5.factor
@@ -4,8 +4,8 @@ calendar ;
IN: nehe.5
TUPLE: nehe5-gadget < gadget rtri rquad thread quit? ;
-: width 256 ;
-: height 256 ;
+CONSTANT: width 256
+CONSTANT: height 256
: redraw-interval ( -- dt ) 10 milliseconds ;
: <nehe5-gadget> ( -- gadget )
diff --git a/extra/otug-talk/otug-talk.factor b/extra/otug-talk/otug-talk.factor
index b52749dbe1..ef5782dda7 100644
--- a/extra/otug-talk/otug-talk.factor
+++ b/extra/otug-talk/otug-talk.factor
@@ -39,7 +39,7 @@ M: png-gadget ungraft* ( gadget -- )
: $tetris ( element -- )
drop [ <default-tetris> <tetris-gadget> gadget. ] ($block) ;
-: otug-slides
+CONSTANT: otug-slides
{
{ $slide "Factor!"
{ $url "http://factorcode.org" }
@@ -361,7 +361,7 @@ var price = (order == null ? null : order.price);"> }
"Factor has many cool things that I didn't talk about"
"Questions?"
}
-} ;
+}
: otug-talk ( -- ) otug-slides slides-window ;
diff --git a/extra/slides/slides.factor b/extra/slides/slides.factor
index 0ce946dc49..ba21ba9c84 100755
--- a/extra/slides/slides.factor
+++ b/extra/slides/slides.factor
@@ -6,7 +6,7 @@ ui.gadgets.books ui.gadgets.panes ui.gestures ui.render
parser accessors colors ;
IN: slides
-: stylesheet
+CONSTANT: stylesheet
H{
{ default-span-style
H{
@@ -40,7 +40,7 @@ IN: slides
H{ { table-gap { 10 20 } } }
}
{ bullet "\u0000b7" }
- } ;
+ }
: $title ( string -- )
[ H{ { font "sans-serif" } { font-size 48 } } format ] ($block) ;
diff --git a/extra/vpri-talk/vpri-talk.factor b/extra/vpri-talk/vpri-talk.factor
index 35d8bb52ff..5d7620101f 100644
--- a/extra/vpri-talk/vpri-talk.factor
+++ b/extra/vpri-talk/vpri-talk.factor
@@ -8,7 +8,7 @@ help.topics math.functions compiler.tree.optimizer
compiler.cfg.optimizer fry ;
IN: vpri-talk
-: vpri-slides
+CONSTANT: vpri-slides
{
{ $slide "Factor!"
{ $url "http://factorcode.org" }
@@ -485,7 +485,7 @@ IN: vpri-talk
"Factor has many cool things that I didn't talk about"
"Questions?"
}
-} ;
+}
: vpri-talk ( -- ) vpri-slides slides-window ;
diff --git a/extra/yahoo/yahoo.factor b/extra/yahoo/yahoo.factor
index b58a11747f..5e0c08b430 100755
--- a/extra/yahoo/yahoo.factor
+++ b/extra/yahoo/yahoo.factor
@@ -18,8 +18,7 @@ format similar-ok language country site subscription license ;
first3 <result>
] map ;
-: yahoo-url ( -- str )
- URL" http://search.yahooapis.com/WebSearchService/V1/webSearch" ;
+CONSTANT: yahoo-url URL" http://search.yahooapis.com/WebSearchService/V1/webSearch"
:: param ( search url name quot -- search url )
search url search quot call
@@ -49,8 +48,7 @@ format similar-ok language country site subscription license ;
"similar_ok" [ similar-ok>> ] bool-param
nip ;
-: factor-id
- "fRrVAKzV34GDyeRw6bUHDhEWHRedwfOC7e61wwXZLgGF80E67spxdQXuugBe2pgIevMmKwA-" ;
+CONSTANT: factor-id "fRrVAKzV34GDyeRw6bUHDhEWHRedwfOC7e61wwXZLgGF80E67spxdQXuugBe2pgIevMmKwA-"
: <search> ( query -- search )
search new
diff --git a/unfinished/benchmark/richards/richards.factor b/unfinished/benchmark/richards/richards.factor
deleted file mode 100644
index 90d4304eee..0000000000
--- a/unfinished/benchmark/richards/richards.factor
+++ /dev/null
@@ -1,272 +0,0 @@
-! Based on http://research.sun.com/people/mario/java_benchmarking/
-! Ported by Factor by Slava Pestov
-!
-! Based on original version written in BCPL by Dr Martin Richards
-! in 1981 at Cambridge University Computer Laboratory, England
-! Java version: Copyright (C) 1995 Sun Microsystems, Inc.
-! by Jonathan Gibbons.
-! Outer loop added 8/7/96 by Alex Jacoby
-USING: values kernel accessors math math.bitwise sequences
-arrays combinators fry locals ;
-IN: benchmark.richards
-
-! Packets
-TUPLE: packet link id kind a1 a2 ;
-
-: BUFSIZE 4 ; inline
-
-: <packet> ( link id kind -- packet )
- packet new
- swap >>kind
- swap >>id
- swap >>link
- 0 >>a1
- BUFSIZE 0 <array> >>a2 ;
-
-: last-packet ( packet -- last )
- dup link>> [ last-packet ] [ ] ?if ;
-
-: append-to ( packet list -- packet )
- [ f >>link ] dip
- [ tuck last-packet >>link drop ] when* ;
-
-! Tasks
-: I_IDLE 1 ; inline
-: I_WORK 2 ; inline
-: I_HANDLERA 3 ; inline
-: I_HANDLERB 4 ; inline
-: I_DEVA 5 ; inline
-: I_DEVB 6 ; inline
-
-! Packet types
-: K_DEV 1000 ; inline
-: K_WORK 1001 ; inline
-
-: PKTBIT 1 ; inline
-: WAITBIT 2 ; inline
-: HOLDBIT 4 ; inline
-
-: S_RUN 0 ; inline
-: S_RUNPKT ( -- n ) { PKTBIT } flags ; inline
-: S_WAIT ( -- n ) { WAITBIT } flags ; inline
-: S_WAITPKT ( -- n ) { WAITBIT PKTBIT } flags ; inline
-: S_HOLD ( -- n ) { HOLDBIT } flags ; inline
-: S_HOLDPKT ( -- n ) { HOLDBIT PKTBIT } flags ; inline
-: S_HOLDWAIT ( -- n ) { HOLDBIT WAITBIT } flags ; inline
-: S_HOLDWAITPKT ( -- n ) { HOLDBIT WAITBIT PKTBIT } flags ; inline
-
-: task-tab-size 10 ; inline
-
-VALUE: task-tab
-VALUE: task-list
-VALUE: tracing
-VALUE: hold-count
-VALUE: qpkt-count
-
-TUPLE: task link id pri wkq state ;
-
-: new-task ( id pri wkq state class -- task )
- new
- swap >>state
- swap >>wkq
- swap >>pri
- swap >>id
- task-list >>link
- dup to: task-list
- dup dup id>> task-tab set-nth ; inline
-
-GENERIC: fn ( packet task -- task )
-
-: state-on ( task flag -- task )
- '[ _ bitor ] change-state ; inline
-
-: state-off ( task flag -- task )
- '[ _ bitnot bitand ] change-state ; inline
-
-: wait-task ( task -- task )
- WAITBIT state-on ;
-
-: hold ( task -- task )
- hold-count 1+ to: hold-count
- HOLDBIT state-on
- link>> ;
-
-: highest-priority ( t1 t2 -- t1/t2 )
- [ [ pri>> ] bi@ > ] most ;
-
-: find-tcb ( i -- task )
- task-tab nth [ "Bad task" throw ] unless* ;
-
-: release ( task i -- task )
- find-tcb HOLDBIT state-off highest-priority ;
-
-:: qpkt ( task pkt -- task )
- [let | t [ pkt id>> find-tcb ] |
- t [
- qpkt-count 1+ to: qpkt-count
- f pkt (>>link)
- task id>> pkt (>>id)
- t wkq>> [
- pkt t wkq>> append-to t (>>wkq)
- task
- ] [
- pkt t (>>wkq)
- t PKTBIT state-on drop
- t task highest-priority
- ] if
- ] [ task ] if
- ] ;
-
-: schedule-waitpkt ( task -- task pkt )
- dup wkq>>
- 2dup link>> >>wkq drop
- 2dup S_RUNPKT S_RUN ? >>state drop ; inline
-
-: schedule-run ( task pkt -- task )
- swap fn ; inline
-
-: schedule-wait ( task -- task )
- link>> ; inline
-
-: (schedule) ( task -- )
- [
- dup state>> {
- { S_WAITPKT [ schedule-waitpkt schedule-run (schedule) ] }
- { S_RUN [ f schedule-run (schedule) ] }
- { S_RUNPKT [ f schedule-run (schedule) ] }
- { S_WAIT [ schedule-wait (schedule) ] }
- { S_HOLD [ schedule-wait (schedule) ] }
- { S_HOLDPKT [ schedule-wait (schedule) ] }
- { S_HOLDWAIT [ schedule-wait (schedule) ] }
- { S_HOLDWAITPKT [ schedule-wait (schedule) ] }
- [ 2drop ]
- } case
- ] when* ;
-
-: schedule ( -- )
- task-list (schedule) ;
-
-! Device task
-TUPLE: device-task < task v1 ;
-
-: <device-task> ( id pri wkq -- task )
- dup S_WAITPKT S_WAIT ? device-task new-task ;
-
-M:: device-task fn ( pkt task -- task )
- pkt [
- task dup v1>>
- [ wait-task ]
- [ [ f ] change-v1 swap qpkt ] if
- ] [ pkt task (>>v1) task hold ] if ;
-
-TUPLE: handler-task < task workpkts devpkts ;
-
-: <handler-task> ( id pri wkq -- task )
- dup S_WAITPKT S_WAIT ? handler-task new-task ;
-
-M:: handler-task fn ( pkt task -- task )
- pkt [
- task over kind>> K_WORK =
- [ [ append-to ] change-workpkts ]
- [ [ append-to ] change-devpkts ]
- if drop
- ] when*
-
- task workpkts>> [
- [let* | devpkt [ task devpkts>> ]
- workpkt [ task workpkts>> ]
- count [ workpkt a1>> ] |
- count BUFSIZE > [
- workpkt link>> task (>>workpkts)
- task workpkt qpkt
- ] [
- devpkt [
- devpkt link>> task (>>devpkts)
- count workpkt a2>> nth devpkt (>>a1)
- count 1+ workpkt (>>a1)
- task devpkt qpkt
- ] [
- task wait-task
- ] if
- ] if
- ]
- ] [ task wait-task ] if ;
-
-! Idle task
-TUPLE: idle-task < task { v1 fixnum } { v2 fixnum } ;
-
-: <idle-task> ( i a1 a2 -- task )
- [ 0 f S_RUN idle-task new-task ] 2dip
- [ >>v1 ] [ >>v2 ] bi* ;
-
-M: idle-task fn ( pkt task -- task )
- nip
- [ 1- ] change-v2
- dup v2>> 0 = [ hold ] [
- dup v1>> 1 bitand 0 = [
- [ -1 shift ] change-v1
- I_DEVA release
- ] [
- [ -1 shift HEX: d008 bitor ] change-v1
- I_DEVB release
- ] if
- ] if ;
-
-! Work task
-TUPLE: work-task < task { handler fixnum } { n fixnum } ;
-
-: <work-task> ( id pri w -- work-task )
- dup S_WAITPKT S_WAIT ? work-task new-task
- I_HANDLERA >>handler
- 0 >>n ;
-
-M:: work-task fn ( pkt task -- task )
- pkt [
- task [ I_HANDLERA = I_HANDLERB I_HANDLERA ? ] change-handler drop
- task handler>> pkt (>>id)
- 0 pkt (>>a1)
- BUFSIZE [| i |
- task [ 1+ ] change-n drop
- task n>> 26 > [ 1 task (>>n) ] when
- task n>> 1 - CHAR: A + i pkt a2>> set-nth
- ] each
- task pkt qpkt
- ] [ task wait-task ] if ;
-
-! Main
-: init ( -- )
- task-tab-size f <array> to: task-tab
- f to: tracing
- 0 to: hold-count
- 0 to: qpkt-count ;
-
-: start ( -- )
- I_IDLE 1 10000 <idle-task> drop
-
- I_WORK 1000
- f 0 K_WORK <packet> 0 K_WORK <packet>
- <work-task> drop
-
- I_HANDLERA 2000
- f I_DEVA K_DEV <packet>
- I_DEVA K_DEV <packet>
- I_DEVA K_DEV <packet>
- <handler-task> drop
-
- I_HANDLERB 3000
- f I_DEVB K_DEV <packet>
- I_DEVB K_DEV <packet>
- I_DEVB K_DEV <packet>
- <handler-task> drop
-
- I_DEVA 4000 f <device-task> drop
- I_DEVB 4000 f <device-task> drop ;
-
-: check ( -- )
- qpkt-count 23246 assert=
- hold-count 9297 assert= ;
-
-: run ( -- )
- init
- start
- schedule check ;
diff --git a/unfinished/sql/sql-tests.factor b/unfinished/sql/sql-tests.factor
deleted file mode 100644
index 0b57c2d8fa..0000000000
--- a/unfinished/sql/sql-tests.factor
+++ /dev/null
@@ -1,42 +0,0 @@
-USING: kernel namespaces db.sql sequences math ;
-IN: db.sql.tests
-
-! TUPLE: person name age ;
-: insert-1
- { insert
- {
- { table "person" }
- { columns "name" "age" }
- { values "erg" 26 }
- }
- } ;
-
-: update-1
- { update "person"
- { set { "name" "erg" }
- { "age" 6 } }
- { where { "age" 6 } }
- } ;
-
-: select-1
- { select
- { columns
- "branchno"
- { count "staffno" as "mycount" }
- { sum "salary" as "mysum" } }
- { from "staff" "lol" }
- { where
- { "salary" > all
- { select
- { columns "salary" }
- { from "staff" }
- { where { "branchno" = "b003" } }
- }
- }
- { "branchno" > 3 } }
- { group-by "branchno" "lol2" }
- { having { count "staffno" > 1 } }
- { order-by "branchno" }
- { offset 40 }
- { limit 20 }
- } ;
diff --git a/unfinished/sql/sql.factor b/unfinished/sql/sql.factor
deleted file mode 100755
index ba0673ae24..0000000000
--- a/unfinished/sql/sql.factor
+++ /dev/null
@@ -1,172 +0,0 @@
-USING: kernel parser quotations classes.tuple words math.order
-nmake namespaces sequences arrays combinators
-prettyprint strings math.parser math symbols db ;
-IN: db.sql
-
-SYMBOLS: insert update delete select distinct columns from as
-where group-by having order-by limit offset is-null desc all
-any count avg table values ;
-
-: input-spec, ( obj -- ) 1, ;
-: output-spec, ( obj -- ) 2, ;
-: input, ( obj -- ) 3, ;
-: output, ( obj -- ) 4, ;
-
-DEFER: sql%
-
-: (sql-interleave) ( seq sep -- )
- [ sql% ] curry [ sql% ] interleave ;
-
-: sql-interleave ( seq str sep -- )
- swap sql% (sql-interleave) ;
-
-: sql-function, ( seq function -- )
- sql% "(" sql% unclip sql% ")" sql% [ sql% ] each ;
-
-: sql-where, ( seq -- )
- [
- [ second 0, ]
- [ first 0, ]
- [ third 1, \ ? 0, ] tri
- ] each ;
-
-HOOK: sql-create db ( object -- )
-M: db sql-create ( object -- )
- drop
- "create table" sql% ;
-
-HOOK: sql-drop db ( object -- )
-M: db sql-drop ( object -- )
- drop
- "drop table" sql% ;
-
-HOOK: sql-insert db ( object -- )
-M: db sql-insert ( object -- )
- drop
- "insert into" sql% ;
-
-HOOK: sql-update db ( object -- )
-M: db sql-update ( object -- )
- drop
- "update" sql% ;
-
-HOOK: sql-delete db ( object -- )
-M: db sql-delete ( object -- )
- drop
- "delete" sql% ;
-
-HOOK: sql-select db ( object -- )
-M: db sql-select ( object -- )
- "select" sql% "," (sql-interleave) ;
-
-HOOK: sql-columns db ( object -- )
-M: db sql-columns ( object -- )
- "," (sql-interleave) ;
-
-HOOK: sql-from db ( object -- )
-M: db sql-from ( object -- )
- "from" "," sql-interleave ;
-
-HOOK: sql-where db ( object -- )
-M: db sql-where ( object -- )
- "where" 0, sql-where, ;
-
-HOOK: sql-group-by db ( object -- )
-M: db sql-group-by ( object -- )
- "group by" "," sql-interleave ;
-
-HOOK: sql-having db ( object -- )
-M: db sql-having ( object -- )
- "having" "," sql-interleave ;
-
-HOOK: sql-order-by db ( object -- )
-M: db sql-order-by ( object -- )
- "order by" "," sql-interleave ;
-
-HOOK: sql-offset db ( object -- )
-M: db sql-offset ( object -- )
- "offset" sql% sql% ;
-
-HOOK: sql-limit db ( object -- )
-M: db sql-limit ( object -- )
- "limit" sql% sql% ;
-
-! GENERIC: sql-subselect db ( object -- )
-! M: db sql-subselectselect ( object -- )
- ! "(select" sql% sql% ")" sql% ;
-
-HOOK: sql-table db ( object -- )
-M: db sql-table ( object -- )
- sql% ;
-
-HOOK: sql-set db ( object -- )
-M: db sql-set ( object -- )
- "set" "," sql-interleave ;
-
-HOOK: sql-values db ( object -- )
-M: db sql-values ( object -- )
- "values(" sql% "," (sql-interleave) ")" sql% ;
-
-HOOK: sql-count db ( object -- )
-M: db sql-count ( object -- )
- "count" sql-function, ;
-
-HOOK: sql-sum db ( object -- )
-M: db sql-sum ( object -- )
- "sum" sql-function, ;
-
-HOOK: sql-avg db ( object -- )
-M: db sql-avg ( object -- )
- "avg" sql-function, ;
-
-HOOK: sql-min db ( object -- )
-M: db sql-min ( object -- )
- "min" sql-function, ;
-
-HOOK: sql-max db ( object -- )
-M: db sql-max ( object -- )
- "max" sql-function, ;
-
-: sql-array% ( array -- )
- unclip
- {
- { \ create [ sql-create ] }
- { \ drop [ sql-drop ] }
- { \ insert [ sql-insert ] }
- { \ update [ sql-update ] }
- { \ delete [ sql-delete ] }
- { \ select [ sql-select ] }
- { \ columns [ sql-columns ] }
- { \ from [ sql-from ] }
- { \ where [ sql-where ] }
- { \ group-by [ sql-group-by ] }
- { \ having [ sql-having ] }
- { \ order-by [ sql-order-by ] }
- { \ offset [ sql-offset ] }
- { \ limit [ sql-limit ] }
- { \ table [ sql-table ] }
- { \ set [ sql-set ] }
- { \ values [ sql-values ] }
- { \ count [ sql-count ] }
- { \ sum [ sql-sum ] }
- { \ avg [ sql-avg ] }
- { \ min [ sql-min ] }
- { \ max [ sql-max ] }
- [ sql% [ sql% ] each ]
- } case ;
-
-ERROR: no-sql-match ;
-: sql% ( obj -- )
- {
- { [ dup string? ] [ 0, ] }
- { [ dup array? ] [ sql-array% ] }
- { [ dup number? ] [ number>string sql% ] }
- { [ dup symbol? ] [ unparse sql% ] }
- { [ dup word? ] [ unparse sql% ] }
- { [ dup quotation? ] [ call ] }
- [ no-sql-match ]
- } cond ;
-
-: parse-sql ( obj -- sql in-spec out-spec in out )
- [ [ sql% ] each ] { { } { } { } } nmake
- [ " " join ] 2dip ;
From 901bcccc1c6d70e5beeaf96cd0dc32ed40291d21 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 23 Feb 2009 23:25:13 -0600
Subject: [PATCH 4/7] Fix remaining text failures
---
basis/compiler/compiler.factor | 5 +----
basis/compiler/tests/optimizer.factor | 22 ++++++++++---------
basis/compiler/tests/simple.factor | 4 ++--
.../tree/cleanup/cleanup-tests.factor | 2 +-
.../tree/recursive/recursive-tests.factor | 2 +-
basis/tools/profiler/profiler-tests.factor | 2 +-
6 files changed, 18 insertions(+), 19 deletions(-)
diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor
index d707dff983..f2f4e7aa9e 100644
--- a/basis/compiler/compiler.factor
+++ b/basis/compiler/compiler.factor
@@ -49,7 +49,7 @@ SYMBOL: +failed+
H{ } clone generic-dependencies set
f swap compiler-error ;
-: fail ( word error -- * )
+: fail ( word error -- )
[ swap compiler-error ]
[
drop
@@ -112,9 +112,6 @@ t compile-dependencies? set-global
: decompile ( word -- )
f 2array 1array modify-code-heap ;
-: compile-call ( quot -- )
- [ dup infer define-temp ] with-compilation-unit execute ;
-
: optimized-recompile-hook ( words -- alist )
[
<hashed-dlist> compile-queue set
diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor
index 708d17f3d3..cfeb5d01ac 100644
--- a/basis/compiler/tests/optimizer.factor
+++ b/basis/compiler/tests/optimizer.factor
@@ -55,7 +55,7 @@ TUPLE: pred-test ;
! regression
-: literal-not-branch 0 not [ ] [ ] if ;
+: literal-not-branch ( -- ) 0 not [ ] [ ] if ;
[ ] [ literal-not-branch ] unit-test
@@ -108,12 +108,12 @@ GENERIC: void-generic ( obj -- * )
[ 10 ] [ branch-fold-regression-1 ] unit-test
! another regression
-: constant-branch-fold-0 "hey" ; foldable
+: constant-branch-fold-0 ( -- value ) "hey" ; foldable
: constant-branch-fold-1 ( -- ? ) constant-branch-fold-0 "hey" = ; inline
[ 1 ] [ [ constant-branch-fold-1 [ 1 ] [ 2 ] if ] compile-call ] unit-test
! another regression
-: foo f ;
+: foo ( -- value ) f ;
: bar ( -- ? ) foo 4 4 = and ;
[ f ] [ bar ] unit-test
@@ -134,15 +134,15 @@ M: slice foozul ;
] unit-test
! regression
-: constant-fold-2 f ; foldable
-: constant-fold-3 4 ; foldable
+: constant-fold-2 ( -- value ) f ; foldable
+: constant-fold-3 ( -- value ) 4 ; foldable
[ f t ] [
[ constant-fold-2 constant-fold-3 4 = ] compile-call
] unit-test
-: constant-fold-4 f ; foldable
-: constant-fold-5 f ; foldable
+: constant-fold-4 ( -- value ) f ; foldable
+: constant-fold-5 ( -- value ) f ; foldable
[ f ] [
[ constant-fold-4 constant-fold-5 or ] compile-call
@@ -247,7 +247,7 @@ USE: binary-search.private
[ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test
[ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test
-: lift-loop-tail-test-1 ( a quot -- )
+: lift-loop-tail-test-1 ( a quot: ( -- ) -- )
over even? [
[ [ 3 - ] dip call ] keep lift-loop-tail-test-1
] [
@@ -256,11 +256,13 @@ USE: binary-search.private
] [
[ [ 2 - ] dip call ] keep lift-loop-tail-test-1
] if
- ] if ; inline
+ ] if ; inline recursive
-: lift-loop-tail-test-2
+: lift-loop-tail-test-2 ( -- a b c )
10 [ ] lift-loop-tail-test-1 1 2 3 ;
+\ lift-loop-tail-test-2 must-infer
+
[ 1 2 3 ] [ lift-loop-tail-test-2 ] unit-test
! Forgot a recursive inline check
diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor
index 0fde270eac..d53b864b06 100644
--- a/basis/compiler/tests/simple.factor
+++ b/basis/compiler/tests/simple.factor
@@ -18,13 +18,13 @@ IN: compiler.tests
[ "hey" ] [ [ "hey" ] compile-call ] unit-test
! Calls
-: no-op ;
+: no-op ( -- ) ;
[ ] [ [ no-op ] compile-call ] unit-test
[ 3 ] [ [ no-op 3 ] compile-call ] unit-test
[ 3 ] [ [ 3 no-op ] compile-call ] unit-test
-: bar 4 ;
+: bar ( -- value ) 4 ;
[ 4 ] [ [ bar no-op ] compile-call ] unit-test
[ 4 3 ] [ [ no-op bar 3 ] compile-call ] unit-test
diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor
index 751a335a13..54f8aaf20e 100755
--- a/basis/compiler/tree/cleanup/cleanup-tests.factor
+++ b/basis/compiler/tree/cleanup/cleanup-tests.factor
@@ -474,7 +474,7 @@ cell-bits 32 = [
] unit-test
! A reduction
-: buffalo-sauce f ;
+: buffalo-sauce ( -- value ) f ;
: steak ( -- )
buffalo-sauce [ steak ] when ; inline recursive
diff --git a/basis/compiler/tree/recursive/recursive-tests.factor b/basis/compiler/tree/recursive/recursive-tests.factor
index b1f9406092..d548d58bc6 100644
--- a/basis/compiler/tree/recursive/recursive-tests.factor
+++ b/basis/compiler/tree/recursive/recursive-tests.factor
@@ -87,7 +87,7 @@ compiler.tree.combinators ;
] contains-node?
] unit-test
-: blah f ;
+: blah ( -- value ) f ;
DEFER: a
diff --git a/basis/tools/profiler/profiler-tests.factor b/basis/tools/profiler/profiler-tests.factor
index 197ace74d8..5bf62ef156 100644
--- a/basis/tools/profiler/profiler-tests.factor
+++ b/basis/tools/profiler/profiler-tests.factor
@@ -1,6 +1,6 @@
IN: tools.profiler.tests
USING: accessors tools.profiler tools.test kernel memory math
-threads alien tools.profiler.private sequences compiler.units
+threads alien tools.profiler.private sequences compiler
words ;
[ t ] [
From e7243da0b80dda06cfea3e55954431a7c70b8fb7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 23 Feb 2009 23:28:02 -0600
Subject: [PATCH 5/7] Clean up memoize code to not use gensym anymore
---
basis/macros/macros.factor | 4 +-
basis/memoize/memoize-tests.factor | 8 ++-
basis/memoize/memoize.factor | 67 ++++++++++++-------------
basis/tools/deploy/shaker/shaker.factor | 2 +-
4 files changed, 41 insertions(+), 40 deletions(-)
diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor
index 4fba7efba3..21a91e567d 100644
--- a/basis/macros/macros.factor
+++ b/basis/macros/macros.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: parser kernel sequences words effects combinators assocs
definitions quotations namespaces memoize accessors ;
@@ -7,7 +7,7 @@ IN: macros
<PRIVATE
: real-macro-effect ( word -- effect' )
- "declared-effect" word-prop in>> 1 <effect> ;
+ stack-effect in>> 1 <effect> ;
PRIVATE>
diff --git a/basis/memoize/memoize-tests.factor b/basis/memoize/memoize-tests.factor
index 7ee56866ce..03549d9b80 100644
--- a/basis/memoize/memoize-tests.factor
+++ b/basis/memoize/memoize-tests.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg.
+! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel memoize tools.test parser generalizations
prettyprint io.streams.string sequences eval ;
@@ -17,6 +17,10 @@ MEMO: see-test ( a -- b ) reverse ;
[ [ \ see-test see ] with-string-writer ]
unit-test
-[ ] [ "IN: memoize.tests : fib ;" eval ] unit-test
+[ ] [ "IN: memoize.tests : fib ( -- ) ;" eval ] unit-test
[ "IN: memoize.tests\n: fib ( -- ) ;\n" ] [ [ \ fib see ] with-string-writer ] unit-test
+
+[ sq ] (( a -- b )) memoize-quot "q" set
+
+[ 9 ] [ 3 "q" get call ] unit-test
diff --git a/basis/memoize/memoize.factor b/basis/memoize/memoize.factor
index 7b8c30c534..3bc573dff5 100644
--- a/basis/memoize/memoize.factor
+++ b/basis/memoize/memoize.factor
@@ -1,47 +1,45 @@
-! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg.
+! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel hashtables sequences arrays words namespaces make
parser math assocs effects definitions quotations summary
-accessors ;
+accessors fry ;
IN: memoize
-: packer ( n -- quot )
- { [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ;
-
-: unpacker ( n -- quot )
- { [ drop ] [ ] [ first2 ] [ first3 ] [ first4 ] } nth ;
-
-: #in ( word -- n )
- stack-effect in>> length ;
-
-: #out ( word -- n )
- stack-effect out>> length ;
-
-: pack/unpack ( quot word -- newquot )
- [ dup #in unpacker % swap % #out packer % ] [ ] make ;
-
-: make-memoizer ( quot word -- quot )
- [
- [ #in packer % ] keep
- [ "memoize" word-prop , ] keep
- [ pack/unpack , ] keep
- \ cache ,
- #out unpacker %
- ] [ ] make ;
-
ERROR: too-many-arguments ;
M: too-many-arguments summary
drop "There must be no more than 4 input and 4 output arguments" ;
-: check-memoized ( word -- )
- [ #in ] [ #out ] bi [ 4 > ] either? [ too-many-arguments ] when ;
+<PRIVATE
+
+: packer ( seq -- quot )
+ length { [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ;
+
+: unpacker ( seq -- quot )
+ length { [ drop ] [ ] [ first2 ] [ first3 ] [ first4 ] } nth ;
+
+: pack/unpack ( quot effect -- newquot )
+ [ in>> packer ] [ out>> unpacker ] bi surround ;
+
+: unpack/pack ( quot effect -- newquot )
+ [ in>> unpacker ] [ out>> packer ] bi surround ;
+
+: check-memoized ( effect -- )
+ [ in>> ] [ out>> ] bi [ length 4 > ] either? [ too-many-arguments ] when ;
+
+: make-memoizer ( table quot effect -- quot )
+ [ check-memoized ] keep
+ [ unpack/pack '[ _ _ cache ] ] keep
+ pack/unpack ;
+
+PRIVATE>
: define-memoized ( word quot -- )
- over check-memoized
- 2dup "memo-quot" set-word-prop
- over H{ } clone "memoize" set-word-prop
- over make-memoizer define ;
+ [ H{ } clone ] dip
+ [ pick stack-effect make-memoizer define ]
+ [ nip "memo-quot" set-word-prop ]
+ [ drop "memoize" set-word-prop ]
+ 3tri ;
: MEMO: (:) define-memoized ; parsing
@@ -57,11 +55,10 @@ M: memoized reset-word
bi ;
: memoize-quot ( quot effect -- memo-quot )
- gensym swap dupd "declared-effect" set-word-prop
- dup rot define-memoized 1quotation ;
+ [ H{ } clone ] 2dip make-memoizer ;
: reset-memoized ( word -- )
"memoize" word-prop clear-assoc ;
: invalidate-memoized ( inputs... word -- )
- [ #in packer call ] [ "memoize" word-prop delete-at ] bi ;
+ [ stack-effect in>> packer call ] [ "memoize" word-prop delete-at ] bi ;
diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index e61021e633..5095f9e93e 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -190,7 +190,7 @@ IN: tools.deploy.shaker
"Stripping default methods" show
[
[ generic? ] instances
- [ "No method" throw ] (( -- * )) define-temp
+ [ "No method" throw ] define-temp
dup t "default" set-word-prop
'[
[ _ "default-method" set-word-prop ] [ make-generic ] bi
From b06903b0efc727bcce5c7269aa033cf94dcc2400 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 23 Feb 2009 23:28:22 -0600
Subject: [PATCH 6/7] Update tree shaker for define-temp changes
---
basis/tools/deploy/shaker/shaker.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 5095f9e93e..961d0ff26d 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -95,7 +95,7 @@ IN: tools.deploy.shaker
"cannot-infer"
"coercer"
"combination"
- "compiled-effect"
+ "compiled-status"
"compiled-generic-uses"
"compiled-uses"
"constraints"
@@ -190,7 +190,7 @@ IN: tools.deploy.shaker
"Stripping default methods" show
[
[ generic? ] instances
- [ "No method" throw ] define-temp
+ [ "No method" throw ] (( -- * )) define-temp
dup t "default" set-word-prop
'[
[ _ "default-method" set-word-prop ] [ make-generic ] bi
From 65a53e1fa5fa120988ec108ed57358bba221c94a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 23 Feb 2009 23:55:16 -0600
Subject: [PATCH 7/7] Don't keep compiled-effect around anymore
---
basis/compiler/cfg/debugger/debugger.factor | 2 +-
basis/compiler/compiler.factor | 62 ++++++++++---------
basis/compiler/tests/optimizer.factor | 2 +-
.../tree/builder/builder-tests.factor | 2 +-
basis/compiler/tree/builder/builder.factor | 8 +--
basis/compiler/tree/debugger/debugger.factor | 2 +-
6 files changed, 41 insertions(+), 37 deletions(-)
diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor
index ba58e60a4a..6d0a8f8c8e 100644
--- a/basis/compiler/cfg/debugger/debugger.factor
+++ b/basis/compiler/cfg/debugger/debugger.factor
@@ -16,7 +16,7 @@ M: callable test-cfg
build-tree optimize-tree gensym build-cfg ;
M: word test-cfg
- [ build-tree-from-word nip optimize-tree ] keep build-cfg ;
+ [ build-tree-from-word optimize-tree ] keep build-cfg ;
SYMBOL: allocate-registers?
diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor
index f2f4e7aa9e..d6da95408d 100644
--- a/basis/compiler/compiler.factor
+++ b/basis/compiler/compiler.factor
@@ -1,46 +1,47 @@
! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel namespaces arrays sequences io
-words fry continuations vocabs assocs dlists definitions math
-graphs generic combinators deques search-deques io
-stack-checker stack-checker.state stack-checker.inlining
-compiler.errors compiler.units compiler.tree.builder
-compiler.tree.optimizer compiler.cfg.builder
-compiler.cfg.optimizer compiler.cfg.linearization
-compiler.cfg.two-operand compiler.cfg.linear-scan
-compiler.cfg.stack-frame compiler.codegen compiler.utilities ;
+USING: accessors kernel namespaces arrays sequences io words fry
+continuations vocabs assocs dlists definitions math graphs
+generic combinators deques search-deques io stack-checker
+stack-checker.state stack-checker.inlining
+combinators.short-circuit compiler.errors compiler.units
+compiler.tree.builder compiler.tree.optimizer
+compiler.cfg.builder compiler.cfg.optimizer
+compiler.cfg.linearization compiler.cfg.two-operand
+compiler.cfg.linear-scan compiler.cfg.stack-frame
+compiler.codegen compiler.utilities ;
IN: compiler
SYMBOL: compile-queue
SYMBOL: compiled
-: queue-compile ( word -- )
+: queue-compile? ( word -- ? )
{
- { [ dup "forgotten" word-prop ] [ ] }
- { [ dup compiled get key? ] [ ] }
- { [ dup inlined-block? ] [ ] }
- { [ dup primitive? ] [ ] }
- [ dup compile-queue get push-front ]
- } cond drop ;
+ [ "forgotten" word-prop ]
+ [ compiled get key? ]
+ [ inlined-block? ]
+ [ primitive? ]
+ } 1|| not ;
+
+: queue-compile ( word -- )
+ dup queue-compile? [ compile-queue get push-front ] [ drop ] if ;
: maybe-compile ( word -- )
dup optimized>> [ drop ] [ queue-compile ] if ;
-SYMBOL: +failed+
+SYMBOLS: +optimized+ +unoptimized+ ;
: ripple-up ( words -- )
- dup "compiled-effect" word-prop +failed+ eq?
+ dup "compiled-status" word-prop +unoptimized+ eq?
[ usage [ word? ] filter ] [ compiled-usage keys ] if
[ queue-compile ] each ;
-: ripple-up? ( word effect -- ? )
- #! If the word has previously been compiled and had a
- #! different stack effect, we have to recompile any callers.
- swap "compiled-effect" word-prop [ = not ] keep and ;
+: ripple-up? ( word status -- ? )
+ swap "compiled-status" word-prop [ = not ] keep and ;
-: save-effect ( word effect -- )
+: save-compiled-status ( word status -- )
[ dupd ripple-up? [ ripple-up ] [ drop ] if ]
- [ "compiled-effect" set-word-prop ]
+ [ "compiled-status" set-word-prop ]
2bi ;
: start ( word -- )
@@ -49,18 +50,18 @@ SYMBOL: +failed+
H{ } clone generic-dependencies set
f swap compiler-error ;
-: fail ( word error -- )
+: fail ( word error -- * )
[ swap compiler-error ]
[
drop
[ compiled-unxref ]
[ f swap compiled get set-at ]
- [ +failed+ save-effect ]
+ [ +unoptimized+ save-compiled-status ]
tri
] 2bi
return ;
-: frontend ( word -- effect nodes )
+: frontend ( word -- nodes )
[ build-tree-from-word ] [ fail ] recover optimize-tree ;
! Only switch this off for debugging.
@@ -84,8 +85,8 @@ t compile-dependencies? set-global
save-asm
] each ;
-: finish ( effect word -- )
- [ swap save-effect ]
+: finish ( word -- )
+ [ +optimized+ save-compiled-status ]
[ compiled-unxref ]
[
dup crossref?
@@ -112,6 +113,9 @@ t compile-dependencies? set-global
: decompile ( word -- )
f 2array 1array modify-code-heap ;
+: compile-call ( quot -- )
+ [ dup infer define-temp ] with-compilation-unit execute ;
+
: optimized-recompile-hook ( words -- alist )
[
<hashed-dlist> compile-queue set
diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor
index cfeb5d01ac..b5cb0ddbdb 100644
--- a/basis/compiler/tests/optimizer.factor
+++ b/basis/compiler/tests/optimizer.factor
@@ -303,7 +303,7 @@ HINTS: recursive-inline-hang-3 array ;
: member-test ( obj -- ? ) { + - * / /i } member? ;
\ member-test must-infer
-[ ] [ \ member-test build-tree-from-word optimize-tree 2drop ] unit-test
+[ ] [ \ member-test build-tree-from-word optimize-tree drop ] unit-test
[ t ] [ \ + member-test ] unit-test
[ f ] [ \ append member-test ] unit-test
diff --git a/basis/compiler/tree/builder/builder-tests.factor b/basis/compiler/tree/builder/builder-tests.factor
index d758e2a34d..4982a3986c 100755
--- a/basis/compiler/tree/builder/builder-tests.factor
+++ b/basis/compiler/tree/builder/builder-tests.factor
@@ -8,4 +8,4 @@ compiler.tree ;
: inline-recursive ( -- ) inline-recursive ; inline recursive
-[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? nip ] unit-test
+[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? ] unit-test
diff --git a/basis/compiler/tree/builder/builder.factor b/basis/compiler/tree/builder/builder.factor
index b715223445..4cb7650b1d 100644
--- a/basis/compiler/tree/builder/builder.factor
+++ b/basis/compiler/tree/builder/builder.factor
@@ -12,18 +12,18 @@ IN: compiler.tree.builder
: with-tree-builder ( quot -- nodes )
'[ V{ } clone stack-visitor set @ ]
- with-infer ; inline
+ with-infer nip ; inline
: build-tree ( quot -- nodes )
#! Not safe to call from inference transforms.
- [ f initial-recursive-state infer-quot ] with-tree-builder nip ;
+ [ f initial-recursive-state infer-quot ] with-tree-builder ;
: build-tree-with ( in-stack quot -- nodes out-stack )
#! Not safe to call from inference transforms.
[
[ >vector \ meta-d set ]
[ f initial-recursive-state infer-quot ] bi*
- ] with-tree-builder nip
+ ] with-tree-builder
unclip-last in-d>> ;
: build-sub-tree ( #call quot -- nodes )
@@ -45,7 +45,7 @@ IN: compiler.tree.builder
: check-no-compile ( word -- )
dup "no-compile" word-prop [ cannot-infer-effect ] [ drop ] if ;
-: build-tree-from-word ( word -- effect nodes )
+: build-tree-from-word ( word -- nodes )
[
[
{
diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor
index 9f2cc0536e..188dcdb935 100644
--- a/basis/compiler/tree/debugger/debugger.factor
+++ b/basis/compiler/tree/debugger/debugger.factor
@@ -144,7 +144,7 @@ SYMBOL: node-count
: make-report ( word/quot -- assoc )
[
- dup word? [ build-tree-from-word nip ] [ build-tree ] if
+ dup word? [ build-tree-from-word ] [ build-tree ] if
optimize-tree
H{ } clone words-called set