steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
db4
Slava Pestov 2009-02-23 20:27:05 -06:00
parent 0c090699c2
commit 1951d739a0
47 changed files with 349 additions and 340 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/alien/c-types/c-types.factor
View File

@ -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>

4
basis/checksums/openssl/openssl.factor
View File

@ -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

6
basis/cocoa/application/application.factor
View File

@ -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

4
basis/cocoa/dialogs/dialogs.factor
View File

@ -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>

14
basis/cocoa/messages/messages.factor
View File

@ -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

2
basis/cocoa/pasteboard/pasteboard.factor
View File

@ -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? ;

18
basis/cocoa/runtime/runtime.factor
View File

@ -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 ) ;

6
basis/cocoa/subclassing/subclassing.factor
View File

@ -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 )
[

74
basis/cocoa/views/views.factor
View File

@ -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

9
basis/compiler/compiler-docs.factor
View File

@ -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." } ;

5
basis/compiler/compiler.factor
View File

@ -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

4
basis/compiler/tests/codegen.factor
View File

@ -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

8
basis/compiler/tests/curry.factor
View File

@ -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

2
basis/compiler/tests/float.factor
View File

@ -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

2
basis/compiler/tests/intrinsics.factor
View File

@ -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.

9
basis/compiler/tests/optimizer.factor
View File

@ -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>

15
basis/compiler/tests/peg-regression-2.factor Normal file
View File

@ -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

2
basis/compiler/tests/simple.factor
View File

@ -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

2
basis/compiler/tests/tuples.factor
View File

@ -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 ;

4
basis/compiler/tree/comparisons/comparisons.factor
View File

@ -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 )
{

28
basis/core-foundation/strings/strings.factor
View File

@ -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,

4
basis/functors/functors.factor
View File

@ -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

2
basis/io/backend/unix/unix.factor
View File

@ -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 )

2
basis/none/none.factor
View File

@ -1,6 +1,6 @@
! Just a dummy shell for the -run switch...
IN: none
: none ;
: none ( -- ) ;
MAIN: none

294
basis/opengl/glu/glu.factor
View File

@ -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

2
basis/openssl/libcrypto/libcrypto.factor
View File

@ -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" }

4
basis/peg/parsers/parsers.factor
View File

@ -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 )

48
basis/stack-checker/backend/backend.factor
View File

@ -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 )
[

6
basis/stack-checker/known-words/known-words.factor
View File

@ -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

2
basis/threads/threads.factor
View File

@ -118,7 +118,7 @@ DEFER: stop
[ ] while
drop ;
: start ( namestack thread -- )
: start ( namestack thread -- * )
[
set-self
set-namestack

8
basis/tools/deploy/config/config.factor
View File

@ -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 < ;

2
basis/tools/deploy/shaker/shaker.factor
View File

@ -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

8
basis/ui/cocoa/views/views.factor
View File

@ -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

2
basis/ui/gadgets/buttons/buttons.factor
View File

@ -173,7 +173,7 @@ TUPLE: radio-paint < caching-pen color interior-vertices boundary-vertices ;
<PRIVATE
: circle-steps 8 ;
CONSTANT: circle-steps 8
PRIVATE>

18
basis/ui/gadgets/frames/frames.factor
View File

@ -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 ;

2
basis/ui/gadgets/sliders/sliders.factor
View File

@ -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 ;

4
basis/ui/gadgets/theme/theme.factor
View File

@ -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 }

10
basis/ui/render/render.factor
View File

@ -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

8
basis/unicode/data/data.factor
View File

@ -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

2
core/bootstrap/primitives.factor
View File

@ -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

4
core/compiler/units/units-docs.factor
View File

@ -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." } ;

3
core/compiler/units/units.factor
View File

@ -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 ;

8
core/continuations/continuations.factor
View File

@ -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 { } ;

2
core/effects/effects.factor
View File

@ -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> ;

12
core/generic/standard/standard.factor
View File

@ -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

4
core/words/words-docs.factor
View File

@ -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 } "."
} ;

4
core/words/words.factor
View File

@ -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