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" - } ; + } [ 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 ) 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 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 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 ) [ 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 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 -- term' ) +M: string ; + +EBNF: parse-regexp + +Times = .* => [[ "foo" ]] + +Regexp = Times:t => [[ t ]] + +;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 ; 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 } ; : ( -- grid ) 9 [ ] 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 } } ; -: 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 } } : ( 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 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 -- * ) [ 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 ; 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 ; +: mangle-method ( method -- quot ) + 1quotation generic get extra-values \ drop + 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 ] bi* - prepend [ ] like ; - : ( 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 ] [ ] 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 ; -: 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