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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-05-21 00:08:52 -05:00
parent 7d328011e8 57d38b1dd0
commit a2d83c1650
21 changed files with 529 additions and 357 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
basis/checksums/md5/md5.factor
View File

@ -5,7 +5,7 @@ math.functions math.parser namespaces splitting grouping strings
sequences byte-arrays locals sequences.private macros fry
io.encodings.binary math.bitwise checksums accessors
checksums.common checksums.stream combinators combinators.smart
specialized-arrays.uint literals ;
specialized-arrays.uint literals hints ;
IN: checksums.md5
SINGLETON: md5
@ -28,7 +28,7 @@ M: md5 initialize-checksum-state drop <md5-state> ;
: update-md5 ( md5 -- )
[ state>> ] [ old-state>> v-w+ dup clone ] [ ] tri
[ (>>old-state) ] [ (>>state) ] bi ; inline
[ (>>old-state) ] [ (>>state) ] bi ;
CONSTANT: T
$[
@ -106,7 +106,7 @@ MACRO: with-md5-round ( ops quot -- )
[ d a b c 13 S12 14 ]
[ c d a b 14 S13 15 ]
[ b c d a 15 S14 16 ]
} [ F ] with-md5-round ; inline
} [ F ] with-md5-round ;
: (process-md5-block-G) ( block state -- )
{
@ -126,7 +126,7 @@ MACRO: with-md5-round ( ops quot -- )
[ d a b c 2 S22 30 ]
[ c d a b 7 S23 31 ]
[ b c d a 12 S24 32 ]
} [ G ] with-md5-round ; inline
} [ G ] with-md5-round ;
: (process-md5-block-H) ( block state -- )
{
@ -146,7 +146,7 @@ MACRO: with-md5-round ( ops quot -- )
[ d a b c 12 S32 46 ]
[ c d a b 15 S33 47 ]
[ b c d a 2 S34 48 ]
} [ H ] with-md5-round ; inline
} [ H ] with-md5-round ;
: (process-md5-block-I) ( block state -- )
{
@ -166,7 +166,12 @@ MACRO: with-md5-round ( ops quot -- )
[ d a b c 11 S42 62 ]
[ c d a b 2 S43 63 ]
[ b c d a 9 S44 64 ]
} [ I ] with-md5-round ; inline
} [ I ] with-md5-round ;
HINTS: (process-md5-block-F) { uint-array md5-state } ;
HINTS: (process-md5-block-G) { uint-array md5-state } ;
HINTS: (process-md5-block-H) { uint-array md5-state } ;
HINTS: (process-md5-block-I) { uint-array md5-state } ;
M: md5-state checksum-block ( block state -- )
[

1
basis/furnace/actions/actions.factor
View File

@ -12,7 +12,6 @@ furnace.conversations
furnace.chloe-tags
html.forms
html.components
html.components
html.templates.chloe
html.templates.chloe.syntax
html.templates.chloe.compiler ;

13
basis/html/templates/fhtml/fhtml-tests.factor
View File

@ -1,5 +1,5 @@
USING: io io.files io.streams.string io.encodings.utf8
html.templates html.templates.fhtml kernel
html.templates html.templates.fhtml kernel multiline
tools.test sequences parser splitting prettyprint ;
IN: html.templates.fhtml.tests
@ -17,3 +17,14 @@ IN: html.templates.fhtml.tests
[
[ ] [ "<%\n%>" parse-template drop ] unit-test
] with-file-vocabs
[
[ ] [
<"
<%
IN: html.templates.fhtml.tests
: test-word ( -- ) ;
%>
"> parse-template drop
] unit-test
] with-file-vocabs

6
basis/html/templates/fhtml/fhtml.factor
View File

@ -4,7 +4,7 @@
USING: continuations sequences kernel namespaces debugger
combinators math quotations generic strings splitting accessors
assocs fry vocabs.parser parser parser.notes lexer io io.files
io.streams.string io.encodings.utf8 html.templates ;
io.streams.string io.encodings.utf8 html.templates compiler.units ;
IN: html.templates.fhtml
! We use a custom lexer so that %> ends a token even if not
@ -58,11 +58,13 @@ SYNTAX: %> lexer get parse-%> ;
: parse-template ( string -- quot )
[
[
"quiet" on
parser-notes off
"html.templates.fhtml" use-vocab
string-lines parse-template-lines
] with-file-vocabs ;
] with-file-vocabs
] with-compilation-unit ;
: eval-template ( string -- )
parse-template call( -- ) ;

4
basis/math/vectors/vectors.factor
View File

@ -58,6 +58,10 @@ IN: math.vectors
: vnlerp ( a b t -- a_t )
[ lerp ] curry 2map ;
: vbilerp ( aa ba ab bb {t,u} -- a_tu )
[ first vnlerp ] [ second vnlerp ] bi-curry
[ 2bi@ ] [ call ] bi* ;
HINTS: vneg { array } ;
HINTS: norm-sq { array } ;
HINTS: norm { array } ;

55
basis/random/windows/windows.factor
View File

@ -1,6 +1,7 @@
USING: accessors alien.c-types byte-arrays continuations
kernel windows.advapi32 init namespaces random destructors
locals windows.errors ;
USING: accessors alien.c-types byte-arrays
combinators.short-circuit continuations destructors init kernel
locals namespaces random windows.advapi32 windows.errors
windows.kernel32 ;
IN: random.windows
TUPLE: windows-rng provider type ;
@ -12,25 +13,40 @@ C: <windows-crypto-context> windows-crypto-context
M: windows-crypto-context dispose ( tuple -- )
handle>> 0 CryptReleaseContext win32-error=0/f ;
: factor-crypto-container ( -- string ) "FactorCryptoContainer" ; inline
CONSTANT: factor-crypto-container "FactorCryptoContainer"
:: (acquire-crypto-context) ( provider type flags -- handle )
[let | handle [ "HCRYPTPROV" <c-object> ] |
handle
factor-crypto-container
provider
type
flags
CryptAcquireContextW win32-error=0/f
handle *void* ] ;
:: (acquire-crypto-context) ( provider type flags -- handle ret )
"HCRYPTPROV" <c-object> :> handle
handle
factor-crypto-container
provider
type
flags
CryptAcquireContextW handle swap ;
: acquire-crypto-context ( provider type -- handle )
[ 0 (acquire-crypto-context) ]
[ drop CRYPT_NEWKEYSET (acquire-crypto-context) ] recover ;
0 (acquire-crypto-context)
0 = [
GetLastError NTE_BAD_KEYSET =
[ drop f ] [ win32-error-string throw ] if
] [
*void*
] if ;
: create-crypto-context ( provider type -- handle )
CRYPT_NEWKEYSET (acquire-crypto-context) win32-error=0/f *void* ;
ERROR: acquire-crypto-context-failed provider type ;
: attempt-crypto-context ( provider type -- handle )
{
[ acquire-crypto-context ]
[ create-crypto-context ]
[ acquire-crypto-context-failed ]
} 2|| ;
: windows-crypto-context ( provider type -- context )
acquire-crypto-context <windows-crypto-context> ;
attempt-crypto-context <windows-crypto-context> ;
M: windows-rng random-bytes* ( n tuple -- bytes )
[
@ -44,9 +60,8 @@ M: windows-rng random-bytes* ( n tuple -- bytes )
MS_DEF_PROV
PROV_RSA_FULL <windows-rng> system-random-generator set-global
MS_STRONG_PROV
PROV_RSA_FULL <windows-rng> secure-random-generator set-global
[ MS_STRONG_PROV PROV_RSA_FULL <windows-rng> ]
[ drop MS_ENH_RSA_AES_PROV PROV_RSA_AES <windows-rng> ] recover
secure-random-generator set-global
! MS_ENH_RSA_AES_PROV
! PROV_RSA_AES <windows-rng> secure-random-generator set-global
] "random.windows" add-init-hook

37
basis/windows/advapi32/advapi32.factor Normal file → Executable file
View File

@ -1,4 +1,5 @@
USING: alien.syntax kernel math windows.types math.bitwise ;
USING: alien.syntax kernel math windows.types windows.kernel32
math.bitwise ;
IN: windows.advapi32
LIBRARY: advapi32
@ -291,6 +292,40 @@ CONSTANT: SE_GROUP_ENABLED 4
CONSTANT: SE_GROUP_OWNER 8
CONSTANT: SE_GROUP_LOGON_ID -1073741824
CONSTANT: NTE_BAD_UID HEX: 80090001
CONSTANT: NTE_BAD_HASH HEX: 80090002
CONSTANT: NTE_BAD_KEY HEX: 80090003
CONSTANT: NTE_BAD_LEN HEX: 80090004
CONSTANT: NTE_BAD_DATA HEX: 80090005
CONSTANT: NTE_BAD_SIGNATURE HEX: 80090006
CONSTANT: NTE_BAD_VER HEX: 80090007
CONSTANT: NTE_BAD_ALGID HEX: 80090008
CONSTANT: NTE_BAD_FLAGS HEX: 80090009
CONSTANT: NTE_BAD_TYPE HEX: 8009000A
CONSTANT: NTE_BAD_KEY_STATE HEX: 8009000B
CONSTANT: NTE_BAD_HASH_STATE HEX: 8009000C
CONSTANT: NTE_NO_KEY HEX: 8009000D
CONSTANT: NTE_NO_MEMORY HEX: 8009000E
CONSTANT: NTE_EXISTS HEX: 8009000F
CONSTANT: NTE_PERM HEX: 80090010
CONSTANT: NTE_NOT_FOUND HEX: 80090011
CONSTANT: NTE_DOUBLE_ENCRYPT HEX: 80090012
CONSTANT: NTE_BAD_PROVIDER HEX: 80090013
CONSTANT: NTE_BAD_PROV_TYPE HEX: 80090014
CONSTANT: NTE_BAD_PUBLIC_KEY HEX: 80090015
CONSTANT: NTE_BAD_KEYSET HEX: 80090016
CONSTANT: NTE_PROV_TYPE_NOT_DEF HEX: 80090017
CONSTANT: NTE_PROV_TYPE_ENTRY_BAD HEX: 80090018
CONSTANT: NTE_KEYSET_NOT_DEF HEX: 80090019
CONSTANT: NTE_KEYSET_ENTRY_BAD HEX: 8009001A
CONSTANT: NTE_PROV_TYPE_NO_MATCH HEX: 8009001B
CONSTANT: NTE_SIGNATURE_FILE_BAD HEX: 8009001C
CONSTANT: NTE_PROVIDER_DLL_FAIL HEX: 8009001D
CONSTANT: NTE_PROV_DLL_NOT_FOUND HEX: 8009001E
CONSTANT: NTE_BAD_KEYSET_PARAM HEX: 8009001F
CONSTANT: NTE_FAIL HEX: 80090020
CONSTANT: NTE_SYS_ERR HEX: 80090021
! SID is a variable length structure
TYPEDEF: void* PSID

2
extra/galois-talk/galois-talk.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: slides help.markup math arrays hashtables namespaces
sequences kernel sequences parser memoize io.encodings.binary
sequences kernel parser memoize io.encodings.binary
locals kernel.private help.vocabs assocs quotations
urls peg.ebnf tools.annotations tools.crossref
help.topics math.functions compiler.tree.optimizer

48
extra/grid-meshes/grid-meshes.factor Normal file
View File

@ -0,0 +1,48 @@
! (c)2009 Joe Groff bsd license
USING: accessors arrays destructors kernel math opengl
opengl.gl sequences sequences.product specialized-arrays.float ;
IN: grid-meshes
TUPLE: grid-mesh dim buffer row-length ;
<PRIVATE
: vertex-array-vertex ( dim x z -- vertex )
[ swap first /f ]
[ swap second /f ] bi-curry* bi
[ 0 ] dip float-array{ } 3sequence ;
: vertex-array-row ( dim z -- vertices )
dup 1 + 2array
over first 1 + iota
2array [ first2 swap vertex-array-vertex ] with product-map
concat ;
: vertex-array ( dim -- vertices )
dup second iota
[ vertex-array-row ] with map concat ;
: >vertex-buffer ( bytes -- buffer )
[ GL_ARRAY_BUFFER ] dip GL_STATIC_DRAW <gl-buffer> ;
: draw-vertex-buffer-row ( grid-mesh i -- )
swap [ GL_TRIANGLE_STRIP ] 2dip
row-length>> [ * ] keep
glDrawArrays ;
PRIVATE>
: draw-grid-mesh ( grid-mesh -- )
GL_ARRAY_BUFFER over buffer>> [
[ 3 GL_FLOAT 0 f glVertexPointer ] dip
dup dim>> second iota [ draw-vertex-buffer-row ] with each
] with-gl-buffer ;
: <grid-mesh> ( dim -- grid-mesh )
[ ] [ vertex-array >vertex-buffer ] [ first 1 + 2 * ] tri
grid-mesh boa ;
M: grid-mesh dispose
[ [ delete-gl-buffer ] when* f ] change-buffer
drop ;

23
extra/html/parser/parser-tests.factor
View File

@ -73,3 +73,26 @@ V{
T{ tag f "head" H{ } f t }
}
] [ "<head<title>Spagna</title></head" parse-html ] unit-test
[
V{
T{ tag
{ name dtd }
{ text
"DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Draft//EN\""
}
}
}
]
[
"<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Draft//EN\">"
parse-html
] unit-test
[
V{
T{ tag { name comment } { text "comment" } }
}
] [
"<!--comment-->" parse-html
] unit-test

8
extra/html/parser/parser.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays hashtables sequence-parser
html.parser.utils kernel namespaces sequences
html.parser.utils kernel namespaces sequences math
unicode.case unicode.categories combinators.short-circuit
quoting fry ;
IN: html.parser
@ -63,10 +63,12 @@ SYMBOL: tagstack
[ blank? ] trim ;
: read-comment ( sequence-parser -- )
"-->" take-until-sequence comment new-tag push-tag ;
[ "-->" take-until-sequence comment new-tag push-tag ]
[ '[ _ advance drop ] 3 swap times ] bi ;
: read-dtd ( sequence-parser -- )
">" take-until-sequence dtd new-tag push-tag ;
[ ">" take-until-sequence dtd new-tag push-tag ]
[ advance drop ] bi ;
: read-bang ( sequence-parser -- )
advance dup { [ current CHAR: - = ] [ peek-next CHAR: - = ] } 1&&

2
extra/minneapolis-talk/minneapolis-talk.factor
View File

@ -1,5 +1,5 @@
USING: slides help.markup math arrays hashtables namespaces
sequences kernel sequences parser memoize ;
sequences kernel parser memoize ;
IN: minneapolis-talk
CONSTANT: minneapolis-slides

18
extra/spheres/spheres.factor
View File

@ -3,7 +3,6 @@ opengl.shaders opengl.framebuffers opengl.capabilities multiline
ui.gadgets accessors sequences ui.render ui math locals arrays
generalizations combinators ui.gadgets.worlds
literals ui.pixel-formats ;
FROM: opengl.demo-support => rect-vertices ;
IN: spheres
STRING: plane-vertex-shader
@ -117,11 +116,11 @@ TUPLE: spheres-world < demo-world
reflection-framebuffer reflection-depthbuffer
reflection-texture ;
M: spheres-world near-plane ( gadget -- z )
M: spheres-world near-plane
drop 1.0 ;
M: spheres-world far-plane ( gadget -- z )
M: spheres-world far-plane
drop 512.0 ;
M: spheres-world distance-step ( gadget -- dz )
M: spheres-world distance-step
drop 0.5 ;
: (reflection-dim) ( -- w h )
@ -175,6 +174,9 @@ M: spheres-world distance-step ( gadget -- dz )
M: spheres-world begin-world
"2.0" { "GL_ARB_shader_objects" } require-gl-version-or-extensions
{ "GL_EXT_framebuffer_object" } require-gl-extensions
GL_DEPTH_TEST glEnable
GL_VERTEX_ARRAY glEnableClientState
0.15 0.15 1.0 1.0 glClearColor
20.0 10.0 20.0 set-demo-orientation
(plane-program) >>plane-program
(solid-sphere-program) >>solid-sphere-program
@ -194,13 +196,13 @@ M: spheres-world end-world
[ plane-program>> [ delete-gl-program ] when* ]
} cleave ;
M: spheres-world pref-dim* ( gadget -- dim )
M: spheres-world pref-dim*
drop { 640 480 } ;
:: (draw-sphere) ( program center radius -- )
program "center" glGetAttribLocation center first3 glVertexAttrib3f
program "radius" glGetAttribLocation radius glVertexAttrib1f
{ -1.0 -1.0 } { 1.0 1.0 } rect-vertices ;
{ -1.0 -1.0 } { 2.0 2.0 } gl-fill-rect ;
:: (draw-colored-sphere) ( program center radius surfacecolor -- )
program "surface_color" glGetAttribLocation surfacecolor first4 glVertexAttrib4f
@ -283,9 +285,7 @@ M: spheres-world pref-dim* ( gadget -- dim )
} cleave ] with-framebuffer ;
M: spheres-world draw-world*
GL_DEPTH_TEST glEnable
GL_SCISSOR_TEST glDisable
0.15 0.15 1.0 1.0 glClearColor {
{
[ (draw-reflection-texture) ]
[ demo-world-set-matrix ]
[ sphere-scene ]

2
extra/terrain/authors.txt Normal file
View File

@ -0,0 +1,2 @@
Joe Groff
Doug Coleman

1
extra/terrain/summary.txt Normal file
View File

@ -0,0 +1 @@
Walk around on procedurally generated terrain

44
extra/terrain/terrain.factor
View File

@ -1,3 +1,4 @@
! (c)2009 Joe Groff, Doug Coleman. bsd license
USING: accessors arrays combinators game-input game-loop
game-input.scancodes grouping kernel literals locals
math math.constants math.functions math.matrices math.order
@ -6,7 +7,8 @@ opengl.shaders opengl.textures opengl.textures.private
sequences sequences.product specialized-arrays.float
terrain.generation terrain.shaders ui ui.gadgets
ui.gadgets.worlds ui.pixel-formats game-worlds method-chains
math.affine-transforms noise ui.gestures combinators.short-circuit ;
math.affine-transforms noise ui.gestures combinators.short-circuit
destructors grid-meshes ;
IN: terrain
CONSTANT: FOV $[ 2.0 sqrt 1+ ]
@ -26,8 +28,6 @@ CONSTANT: SKY-PERIOD 1200
CONSTANT: SKY-SPEED 0.0005
CONSTANT: terrain-vertex-size { 512 512 }
CONSTANT: terrain-vertex-distance { $[ 1.0 512.0 / ] $[ 1.0 512.0 / ] }
CONSTANT: terrain-vertex-row-length $[ 512 1 + 2 * ]
TUPLE: player
location yaw pitch velocity velocity-modifier
@ -37,7 +37,7 @@ TUPLE: terrain-world < game-world
player
sky-image sky-texture sky-program
terrain terrain-segment terrain-texture terrain-program
terrain-vertex-buffer
terrain-mesh
history ;
: <player> ( -- player )
@ -65,35 +65,6 @@ M: terrain-world tick-length
[ yaw>> 0.0 1.0 0.0 glRotatef ]
[ location>> vneg first3 glTranslatef ] tri ;
: vertex-array-vertex ( x z -- vertex )
[ terrain-vertex-distance first * ]
[ terrain-vertex-distance second * ] bi*
[ 0 ] dip float-array{ } 3sequence ;
: vertex-array-row ( z -- vertices )
dup 1 + 2array
terrain-vertex-size first 1 + iota
2array [ first2 swap vertex-array-vertex ] product-map
concat ;
: vertex-array ( -- vertices )
terrain-vertex-size second iota
[ vertex-array-row ] map concat ;
: >vertex-buffer ( bytes -- buffer )
[ GL_ARRAY_BUFFER ] dip GL_STATIC_DRAW <gl-buffer> ;
: draw-vertex-buffer-row ( i -- )
[ GL_TRIANGLE_STRIP ] dip
terrain-vertex-row-length * terrain-vertex-row-length
glDrawArrays ;
: draw-vertex-buffer ( buffer -- )
[ GL_ARRAY_BUFFER ] dip [
3 GL_FLOAT 0 f glVertexPointer
terrain-vertex-size second iota [ draw-vertex-buffer-row ] each
] with-gl-buffer ;
: degrees ( deg -- rad )
pi 180.0 / * ;
@ -119,7 +90,6 @@ M: terrain-world tick-length
: clamp-pitch ( pitch -- pitch' )
90.0 min -90.0 max ;
: walk-forward ( player -- )
dup forward-vector [ v+ ] curry change-velocity drop ;
: walk-backward ( player -- )
@ -274,12 +244,12 @@ BEFORE: terrain-world begin-world
>>sky-program
terrain-vertex-shader terrain-pixel-shader <simple-gl-program>
>>terrain-program
vertex-array >vertex-buffer >>terrain-vertex-buffer
terrain-vertex-size <grid-mesh> >>terrain-mesh
drop ;
AFTER: terrain-world end-world
{
[ terrain-vertex-buffer>> delete-gl-buffer ]
[ terrain-mesh>> dispose ]
[ terrain-program>> delete-gl-program ]
[ terrain-texture>> delete-texture ]
[ sky-program>> delete-gl-program ]
@ -306,7 +276,7 @@ M: terrain-world draw-world*
[ GL_DEPTH_TEST glEnable dup terrain-program>> [
[ "heightmap" glGetUniformLocation 0 glUniform1i ]
[ "component_scale" glGetUniformLocation COMPONENT-SCALE first4 glUniform4f ] bi
terrain-vertex-buffer>> draw-vertex-buffer
terrain-mesh>> draw-grid-mesh
] with-gl-program ]
} cleave gl-error ;

256
misc/factor.vim.fgen
View File

@ -1,15 +1,26 @@
<% USING: kernel io prettyprint vocabs sequences ;
%>" Vim syntax file
" Language: factor
" Maintainer: Alex Chapman <chapman.alex@gmail.com>
" Last Change: 2008 Apr 28
<%
USING: kernel io prettyprint vocabs sequences multiline ;
IN: factor.vim.fgen
: print-keywords ( vocab -- )
words [
"syn keyword factorKeyword " write
[ bl ] [ pprint ] interleave nl
] when* ;
%>
" Vim syntax file
" Language: factor
" Maintainer: Alex Chapman <chapman.alex@gmail.com>
" Last Change: 2009 May 19
" To run: USE: html.templates.fhtml "resource:misc/factor.vim.fgen" <fhtml> call-template
" For version 5.x: Clear all syntax items
" For version 6.x: Quit when a syntax file was already loaded
if version < 600
syntax clear
syntax clear
elseif exists("b:current_syntax")
finish
finish
endif
" factor is case sensitive.
@ -47,25 +58,27 @@ syn keyword factorBoolean boolean f general-t t
syn keyword factorCompileDirective inline foldable parsing
<%
! uncomment this if you want all words from all vocabularies highlighted. Note
! that this changes factor.vim from around 8k to around 100k (and is a bit
! broken)
! vocabs [ words [ "syn keyword factorKeyword " write [ pprint " " write ] each "\n" write ] when* ] each
! vocabs [ print-keywords ] each
{
"kernel" "assocs" "combinators" "math" "sequences"
"namespaces" "arrays" "io" "strings" "vectors"
"continuations"
} [ print-keywords ] each
%>
" kernel vocab keywords
<% { "kernel" "assocs" "combinators" "math" "sequences" "namespaces" "arrays" "io" "strings" "vectors" "continuations" } [
words "syn keyword factorKeyword " write [ pprint " " write ] each "\n" write
] each %>
syn cluster factorReal contains=factorInt,factorFloat,factorRatio,factorBinary,factorHex,factorOctal
syn cluster factorNumber contains=@factorReal,factorComplex
syn cluster factorNumErr contains=factorBinErr,factorHexErr,factorOctErr
syn match factorInt /\<-\=\d\+\>/
syn match factorFloat /\<-\=\d*\.\d\+\>/
syn match factorRatio /\<-\=\d*\.*\d\+\/-\=\d*\.*\d\+\>/
syn region factorComplex start=/\<C{\>/ end=/\<}\>/ contains=@factorReal
syn cluster factorReal contains=factorInt,factorFloat,factorRatio,factorBinary,factorHex,factorOctal
syn cluster factorNumber contains=@factorReal,factorComplex
syn cluster factorNumErr contains=factorBinErr,factorHexErr,factorOctErr
syn match factorInt /\<-\=\d\+\>/
syn match factorFloat /\<-\=\d*\.\d\+\>/
syn match factorRatio /\<-\=\d*\.*\d\+\/-\=\d*\.*\d\+\>/
syn region factorComplex start=/\<C{\>/ end=/\<}\>/ contains=@factorReal
syn match factorBinErr /\<BIN:\s\+[01]*[^\s01]\S*\>/
syn match factorBinary /\<BIN:\s\+[01]\+\>/
syn match factorHexErr /\<HEX:\s\+\x*[^\x\s]\S*\>/
@ -73,31 +86,36 @@ syn match factorHex /\<HEX:\s\+\x\+\>/
syn match factorOctErr /\<OCT:\s\+\o*[^\o\s]\S*\>/
syn match factorOctal /\<OCT:\s\+\o\+\>/
syn match factorIn /\<IN:\s\+\S\+\>/
syn match factorUse /\<USE:\s\+\S\+\>/
syn match factorIn /\<IN:\s\+\S\+\>/
syn match factorUse /\<USE:\s\+\S\+\>/
syn match factorUnuse /\<UNUSE:\s\+\S\+\>/
syn match factorCharErr /\<CHAR:\s\+\S\+/
syn match factorChar /\<CHAR:\s\+\\\=\S\>/
syn match factorCharErr /\<CHAR:\s\+\S\+/
syn match factorChar /\<CHAR:\s\+\\\=\S\>/
syn match factorBackslash /\<\\\>\s\+\S\+\>/
syn match factorBackslash /\<\\\>\s\+\S\+\>/
syn region factorUsing start=/\<USING:\>/ end=/;/
syn region factorRequires start=/\<REQUIRES:\>/ end=/;/
syn region factorUsing start=/\<USING:\>/ end=/;/
syn region factorSingletons start=/\<SINGLETONS:\>/ end=/;/
syn match factorSymbol /\<SYMBOL:\s\+\S\+\>/
syn region factorSymbols start=/\<SYMBOLS:\>/ end=/;/
syn region factorConstructor2 start=/\<CONSTRUCTOR:\?/ end=/;/
syn region factorTuple start=/\<TUPLE:\>/ end=/\<;\>/
syn cluster factorWordOps contains=factorSymbol,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor
syn match factorSymbol /\<SYMBOL:\s\+\S\+\>/
syn match factorPostpone /\<POSTPONE:\s\+\S\+\>/
syn match factorDefer /\<DEFER:\s\+\S\+\>/
syn match factorForget /\<FORGET:\s\+\S\+\>/
syn match factorMixin /\<MIXIN:\s\+\S\+\>/
syn match factorInstance /\<INSTANCE:\s\+\S\+\s\+\S\+\>/
syn match factorHook /\<HOOK:\s\+\S\+\s\+\S\+\>/
syn match factorMain /\<MAIN:\s\+\S\+\>/
syn match factorConstructor /\<C:\s\+\S\+\s\+\S\+\>/
syn match factorConstant /\<CONSTANT:\s\+\S\+\>/
syn match factorSingleton /\<SINGLETON:\s\+\S\+\>/
syn match factorPostpone /\<POSTPONE:\s\+\S\+\>/
syn match factorDefer /\<DEFER:\s\+\S\+\>/
syn match factorForget /\<FORGET:\s\+\S\+\>/
syn match factorMixin /\<MIXIN:\s\+\S\+\>/
syn match factorInstance /\<INSTANCE:\s\+\S\+\s\+\S\+\>/
syn match factorHook /\<HOOK:\s\+\S\+\s\+\S\+\>/
syn match factorMain /\<MAIN:\s\+\S\+\>/
syn match factorConstructor /\<C:\s\+\S\+\s\+\S\+\>/
syn match factorAlien /\<ALIEN:\s\+\d\+\>/
syn match factorAlien /\<ALIEN:\s\+\d\+\>/
syn cluster factorWordOps contains=factorSymbol,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor
syn region factorTuple start=/\<TUPLE:\>/ end=/\<;\>/
"TODO:
"misc:
@ -116,6 +134,12 @@ syn region factorTuple start=/\<TUPLE:\>/ end=/\<;\>/
" TYPEDEF:
" LIBRARY:
" C-UNION:
"QUALIFIED:
"QUALIFIED-WITH:
"FROM:
"ALIAS:
"! POSTPONE: "
"#\ "
syn region factorString start=/"/ skip=/\\"/ end=/"/ oneline
syn region factorSbuf start=/SBUF" / skip=/\\"/ end=/"/ oneline
@ -165,88 +189,92 @@ syn sync lines=100
if version >= 508 || !exists("did_factor_syn_inits")
if version <= 508
let did_factor_syn_inits = 1
command -nargs=+ HiLink hi link <args>
let did_factor_syn_inits = 1
command -nargs=+ HiLink hi link <args>
else
command -nargs=+ HiLink hi def link <args>
command -nargs=+ HiLink hi def link <args>
endif
HiLink factorComment Comment
HiLink factorStackEffect Typedef
HiLink factorTodo Todo
HiLink factorInclude Include
HiLink factorRepeat Repeat
HiLink factorConditional Conditional
HiLink factorKeyword Keyword
HiLink factorOperator Operator
HiLink factorBoolean Boolean
HiLink factorDefnDelims Typedef
HiLink factorMethodDelims Typedef
HiLink factorGenericDelims Typedef
HiLink factorGenericNDelims Typedef
HiLink factorConstructor Typedef
HiLink factorPrivate Special
HiLink factorPrivateDefnDelims Special
HiLink factorPrivateMethodDelims Special
HiLink factorPGenericDelims Special
HiLink factorComment Comment
HiLink factorStackEffect Typedef
HiLink factorTodo Todo
HiLink factorInclude Include
HiLink factorRepeat Repeat
HiLink factorConditional Conditional
HiLink factorKeyword Keyword
HiLink factorOperator Operator
HiLink factorBoolean Boolean
HiLink factorDefnDelims Typedef
HiLink factorMethodDelims Typedef
HiLink factorGenericDelims Typedef
HiLink factorGenericNDelims Typedef
HiLink factorConstructor Typedef
HiLink factorConstructor2 Typedef
HiLink factorPrivate Special
HiLink factorPrivateDefnDelims Special
HiLink factorPrivateMethodDelims Special
HiLink factorPGenericDelims Special
HiLink factorPGenericNDelims Special
HiLink factorString String
HiLink factorSbuf String
HiLink factorMultiStringContents String
HiLink factorMultiStringDelims Typedef
HiLink factorBracketErr Error
HiLink factorComplex Number
HiLink factorRatio Number
HiLink factorBinary Number
HiLink factorBinErr Error
HiLink factorHex Number
HiLink factorHexErr Error
HiLink factorOctal Number
HiLink factorOctErr Error
HiLink factorFloat Float
HiLink factorInt Number
HiLink factorUsing Include
HiLink factorUse Include
HiLink factorRequires Include
HiLink factorIn Define
HiLink factorChar Character
HiLink factorCharErr Error
HiLink factorDelimiter Delimiter
HiLink factorBackslash Special
HiLink factorCompileDirective Typedef
HiLink factorSymbol Define
HiLink factorMixin Typedef
HiLink factorInstance Typedef
HiLink factorHook Typedef
HiLink factorMain Define
HiLink factorPostpone Define
HiLink factorDefer Define
HiLink factorForget Define
HiLink factorAlien Define
HiLink factorTuple Typedef
HiLink factorString String
HiLink factorSbuf String
HiLink factorMultiStringContents String
HiLink factorMultiStringDelims Typedef
HiLink factorBracketErr Error
HiLink factorComplex Number
HiLink factorRatio Number
HiLink factorBinary Number
HiLink factorBinErr Error
HiLink factorHex Number
HiLink factorHexErr Error
HiLink factorOctal Number
HiLink factorOctErr Error
HiLink factorFloat Float
HiLink factorInt Number
HiLink factorUsing Include
HiLink factorUse Include
HiLink factorUnuse Include
HiLink factorIn Define
HiLink factorChar Character
HiLink factorCharErr Error
HiLink factorDelimiter Delimiter
HiLink factorBackslash Special
HiLink factorCompileDirective Typedef
HiLink factorSymbol Define
HiLink factorConstant Define
HiLink factorSingleton Define
HiLink factorSingletons Define
HiLink factorMixin Typedef
HiLink factorInstance Typedef
HiLink factorHook Typedef
HiLink factorMain Define
HiLink factorPostpone Define
HiLink factorDefer Define
HiLink factorForget Define
HiLink factorAlien Define
HiLink factorTuple Typedef
if &bg == "dark"
hi hlLevel0 ctermfg=red guifg=red1
hi hlLevel1 ctermfg=yellow guifg=orange1
hi hlLevel2 ctermfg=green guifg=yellow1
hi hlLevel3 ctermfg=cyan guifg=greenyellow
hi hlLevel4 ctermfg=magenta guifg=green1
hi hlLevel5 ctermfg=red guifg=springgreen1
hi hlLevel6 ctermfg=yellow guifg=cyan1
hi hlLevel7 ctermfg=green guifg=slateblue1
hi hlLevel8 ctermfg=cyan guifg=magenta1
hi hlLevel9 ctermfg=magenta guifg=purple1
hi hlLevel0 ctermfg=red guifg=red1
hi hlLevel1 ctermfg=yellow guifg=orange1
hi hlLevel2 ctermfg=green guifg=yellow1
hi hlLevel3 ctermfg=cyan guifg=greenyellow
hi hlLevel4 ctermfg=magenta guifg=green1
hi hlLevel5 ctermfg=red guifg=springgreen1
hi hlLevel6 ctermfg=yellow guifg=cyan1
hi hlLevel7 ctermfg=green guifg=slateblue1
hi hlLevel8 ctermfg=cyan guifg=magenta1
hi hlLevel9 ctermfg=magenta guifg=purple1
else
hi hlLevel0 ctermfg=red guifg=red3
hi hlLevel1 ctermfg=darkyellow guifg=orangered3
hi hlLevel2 ctermfg=darkgreen guifg=orange2
hi hlLevel3 ctermfg=blue guifg=yellow3
hi hlLevel4 ctermfg=darkmagenta guifg=olivedrab4
hi hlLevel5 ctermfg=red guifg=green4
hi hlLevel6 ctermfg=darkyellow guifg=paleturquoise3
hi hlLevel7 ctermfg=darkgreen guifg=deepskyblue4
hi hlLevel8 ctermfg=blue guifg=darkslateblue
hi hlLevel9 ctermfg=darkmagenta guifg=darkviolet
hi hlLevel0 ctermfg=red guifg=red3
hi hlLevel1 ctermfg=darkyellow guifg=orangered3
hi hlLevel2 ctermfg=darkgreen guifg=orange2
hi hlLevel3 ctermfg=blue guifg=yellow3
hi hlLevel4 ctermfg=darkmagenta guifg=olivedrab4
hi hlLevel5 ctermfg=red guifg=green4
hi hlLevel6 ctermfg=darkyellow guifg=paleturquoise3
hi hlLevel7 ctermfg=darkgreen guifg=deepskyblue4
hi hlLevel8 ctermfg=blue guifg=darkslateblue
hi hlLevel9 ctermfg=darkmagenta guifg=darkviolet
endif
delcommand HiLink

276
misc/vim/syntax/factor.vim
View File

@ -1,14 +1,15 @@
" Vim syntax file
" Language: factor
" Maintainer: Alex Chapman <chapman.alex@gmail.com>
" Last Change: 2008 Apr 28
" Language: factor
" Maintainer: Alex Chapman <chapman.alex@gmail.com>
" Last Change: 2009 May 19
" To run: USE: html.templates.fhtml "resource:misc/factor.vim.fgen" <fhtml> call-template
" For version 5.x: Clear all syntax items
" For version 6.x: Quit when a syntax file was already loaded
if version < 600
syntax clear
syntax clear
elseif exists("b:current_syntax")
finish
finish
endif
" factor is case sensitive.
@ -45,29 +46,26 @@ syn region None matchgroup=factorPrivate start=/\<<PRIVATE\>/ end=/\<PRIVATE>\>/
syn keyword factorBoolean boolean f general-t t
syn keyword factorCompileDirective inline foldable parsing
syn keyword factorKeyword or tuck 2bi 2tri while wrapper nip 4dip wrapper? bi* callstack>array both? hashcode die dupd callstack callstack? 3dup tri@ pick curry build ?execute 3bi prepose >boolean ?if clone eq? tri* ? = swapd call-clear 2over 2keep 3keep clear 2dup when not tuple? dup 2bi* 2tri* call tri-curry object bi@ do unless* if* loop bi-curry* drop when* assert= retainstack assert? -rot execute 2bi@ 2tri@ boa with either? 3drop bi curry? datastack until 3dip over 3curry roll tri-curry* swap tri-curry@ 2nip and throw set-retainstack bi-curry (clone) hashcode* compose spin 2dip if 3tri unless compose? tuple keep 2curry equal? set-datastack assert tri 2drop most <wrapper> boolean? identity-tuple? null new set-callstack dip bi-curry@ rot -roll xor identity-tuple boolean
syn keyword factorKeyword ?at assoc? assoc-clone-like assoc= delete-at* assoc-partition extract-keys new-assoc value? assoc-size map>assoc push-at assoc-like key? assoc-intersect update assoc-union assoc-combine at* assoc-empty? at+ set-at assoc-all? assoc-subset? assoc-hashcode change-at assoc-each assoc-diff zip values value-at rename-at inc-at enum? at cache assoc>map <enum> assoc assoc-map enum value-at* remove-all assoc-map-as >alist assoc-filter-as substitute-here clear-assoc assoc-stack substitute assoc-filter 2cache delete-at assoc-find keys assoc-any? at-default unzip
syn keyword factorKeyword case execute-effect dispatch-case-quot <buckets> no-cond no-case? 3cleave>quot contiguous-range? 2cleave cond>quot wrong-values? no-cond? cleave>quot no-case hash-dispatch-quot case>quot 3cleave wrong-values alist>quot hash-case-table hash-case-quot case-find (distribute-buckets) cond cleave distribute-buckets call-effect 2cleave>quot recursive-hashcode linear-case-quot spread spread>quot
syn keyword factorKeyword byte-array>bignum sgn >bignum next-float number= each-integer next-power-of-2 ?1+ fp-special? imaginary-part mod recip float>bits rational >float number? 2^ bignum? integer fixnum? neg fixnum sq bignum fp-snan? fp-infinity? denominator (all-integers?) times find-last-integer (each-integer) bit? * + fp-bitwise= - fp-qnan? / power-of-2? >= bitand find-integer complex <fp-nan> < log2 > integer? real number bits>double double>bits bitor 2/ zero? rem fp-nan-payload all-integers? (find-integer) real-part prev-float align bits>float float? shift float 1+ 1- fp-nan? abs bitxor ratio? even? <= /mod odd? >integer ratio rational? bitnot real? >fixnum complex? /i numerator /f
syn keyword factorKeyword append assert-sequence= find-last-from trim-head-slice clone-like 3sequence assert-sequence? map-as filter-here last-index-from prepare-index reversed index-from cut* pad-tail (indices) concat-as remq but-last snip trim-tail nths nth 2pusher sequence slice? <slice> partition remove-nth tail-slice empty? tail* if-empty find-from virtual-sequence? member? set-length delq drop-prefix unclip iota unclip-last-slice bounds-error? sequence-hashcode-step map start midpoint@ rest-slice prepend fourth sift delete sigma new-sequence follow like delete-nth first4 1sequence reverse slice unless-empty padding virtual@ repetition? index 4sequence max-length set-second immutable-sequence first2 first3 replicate-as reduce-index unclip-slice supremum insert-nth trim-tail-slice tail 3append short count suffix concat flip filter sum immutable? 2sequence delete-all start* indices snip-slice check-slice sequence? head map-find reduce append-as reverse-here sequence= halves collapse-slice interleave 2map binary-reduce virtual-seq slice-error? product bounds-check? bounds-check harvest immutable find produce remove pad-head replicate set-fourth peek shorten reversed? map-find-last 3map-as 2unclip-slice shorter? 3map find-last head-slice pop* 2map-as tail-slice* but-last-slice 2map-reduce iota? accumulate each pusher cut-slice new-resizable each-index head-slice* 2reverse-each sequence-hashcode memq? pop set-nth ?nth <flat-slice> second change-each join when-empty accumulator immutable-sequence? <reversed> all? 3append-as virtual-sequence subseq? push-either new-like length last-index push-if 2all? lengthen assert-sequence copy map-reduce move third first 3each tail? set-first prefix bounds-error any? <repetition> trim-slice exchange surround 2reduce cut change-nth min-length set-third produce-as push-all head? delete-slice rest sum-lengths 2each head* infimum glue slice-error subseq replace-slice push repetition map-index trim-head unclip-last mismatch trim
syn keyword factorKeyword global +@ change set-namestack change-global init-namespaces on off set-global namespace set with-scope bind with-variable inc dec counter initialize namestack get get-global make-assoc
syn keyword factorKeyword <array> 2array 3array pair >array 1array 4array pair? array resize-array array?
syn keyword factorKeyword +character+ bad-seek-type? readln stream-seek read print with-output-stream contents write1 stream-write1 stream-copy stream-element-type with-input-stream stream-print stream-read stream-contents bl seek-output bad-seek-type nl stream-nl write flush stream-lines +byte+ stream-flush read1 seek-absolute? stream-read1 lines stream-readln stream-read-until each-line seek-end with-output-stream* seek-absolute with-streams seek-input seek-relative? input-stream stream-write read-partial seek-end? seek-relative error-stream read-until with-input-stream* with-streams* each-block output-stream stream-read-partial
syn keyword factorKeyword resize-string >string <string> 1string string string?
syn keyword factorKeyword vector? <vector> ?push vector >vector 1vector
syn keyword factorKeyword with-return restarts return-continuation with-datastack recover rethrow-restarts <restart> ifcc set-catchstack >continuation< cleanup ignore-errors restart? compute-restarts attempt-all-error error-thread continue <continuation> attempt-all-error? condition? <condition> throw-restarts error catchstack continue-with thread-error-hook continuation rethrow callcc1 error-continuation callcc0 attempt-all condition continuation? restart return
" kernel vocab keywords
syn keyword factorKeyword or construct-delegate set-slots tuck 2bi 2tri while wrapper nip bi* wrapper? hashcode callstack>array both? die set-delegate dupd callstack callstack? 3dup tri@ pick curry build prepose 3bi >boolean ?if clone eq? tri* ? = swapd call-clear 2over 2keep 3keep construct clear 2dup when not tuple? 3compose dup 2bi* call object bi@ wrapped unless* if* >r curry-quot drop when* retainstack -rot 2bi@ delegate boa with 3slip slip compose-first compose-second 3drop either? bi curry? datastack curry-obj over 3curry roll throw swap and 2nip set-retainstack (clone) hashcode* get-slots compose spin if 3tri unless compose? tuple keep 2curry equal? set-datastack 2slip tri 2drop most <wrapper> identity-tuple? null r> new set-callstack dip xor rot -roll identity-tuple
syn keyword factorKeyword assoc? assoc-clone-like delete-any assoc= delete-at* new-assoc subassoc? assoc-size map>assoc search-alist assoc-like key? assoc-intersect update assoc-union at* assoc-empty? at+ set-enum-seq set-at assoc-all? assoc-hashcode change-at assoc-each assoc-diff zip values value-at rename-at (assoc-stack) enum? at cache assoc>map assoc-any? <enum> assoc assoc-map assoc-pusher (assoc>map) enum assoc-push-if remove-all >alist (substitute) substitute-here clear-assoc assoc-stack substitute assoc-filter delete-at assoc-find enum-seq keys
syn keyword factorKeyword case dispatch-case-quot with-datastack <buckets> no-cond no-case? 3cleave>quot (distribute-buckets) contiguous-range? 2cleave cond>quot no-cond? cleave>quot no-case recursive-hashcode case>quot 3cleave alist>quot dispatch-case hash-case-table hash-case-quot case-find cond cleave distribute-buckets 2cleave>quot linear-case-quot spread spread>quot hash-dispatch-quot
syn keyword factorKeyword byte-array>bignum sgn >bignum number= each-integer next-power-of-2 ?1+ imaginary-part mod recip float>bits rational >float number? 2^ bignum? integer fixnum? neg fixnum sq bignum (all-integers?) times denominator find-last-integer (each-integer) bit? * + power-of-2? - / >= bitand find-integer complex < real > log2 integer? number bits>double double>bits bitor 2/ zero? rem all-integers? (find-integer) real-part align bits>float float? shift float 1+ 1- fp-nan? ratio? bitxor even? ratio <= /mod >integer odd? rational? bitnot real? >fixnum complex? (next-power-of-2) /i numerator /f
syn keyword factorKeyword slice-to append left-trim find-last-from clone-like 3sequence map-as last-index-from reversed index-from pad-left cut* nth sequence slice? <slice> tail-slice empty? tail* find-from member? virtual-sequence? unclip set-length drop-prefix bounds-error? set-slice-seq map start open-slice midpoint@ set-immutable-seq move-forward rest-slice prepend fourth delete set-slice-to new-sequence follow all-eq? monotonic? set-reversed-seq like delete-nth first4 repetition-len (open-slice) reverse slice padding virtual@ repetition? index 4sequence max-length set-second first2 first3 (3append) supremum unclip-slice move-backward tail 3append sequence-hashcode-step right-trim reversed-seq pad-right suffix concat set-slice-from flip filter sum immutable? 2sequence delete-all start* immutable-sequence? (append) check-slice sequence? head set-slice-error-reason reduce set-bounds-error-index reverse-here sequence= halves collapse-slice interleave 2map binary-reduce virtual-seq slice-error? product bounds-check? bounds-check immutable find remove ((append)) set-fourth peek any? reversed? shorter? push-new find-last head-slice pop* immutable-seq tail-slice* accumulate each pusher all-equal? new-resizable cut-slice head-slice* 2reverse-each pop memq? set-nth ?nth <flat-slice> second change-each join set-repetition-len <reversed> all? virtual-sequence set-repetition-elt subseq? immutable-sequence slice-error-reason new-like length last-index push-if 2all? lengthen joined-length copy set-bounds-error-seq cache-nth move third first slice-from repetition-elt tail? set-first prefix bounds-error bounds-error-seq bounds-error-index <repetition> unfold exchange slice-seq cut 2reduce change-nth min-length set-third (delete) push-all head? delete-slice rest sum-lengths 2each head* infimum sequence-hashcode slice-error subseq replace-slice repetition push trim mismatch
syn keyword factorKeyword global +@ set-namestack with-variable on set bind dec namestack get get-global change init-namespaces with-scope off set-global namespace % make , inc counter building make-assoc
syn keyword factorKeyword <array> 3array >array 4array pair? array pair 2array 1array resize-array array?
syn keyword factorKeyword readln stream-read-until stream-read-partial stderr with-stream read with-stream* print contents make-span-stream write1 stream-write1 stream-format make-block-stream stream-copy with-cell stream-write format with-row stream-print stream-read with-nesting (stream-copy) bl write-object nl stream-nl write stdio flush read-until tabular-output make-cell-stream write-cell stream-flush read1 lines stream-read1 stream-write-table with-style stream-readln
syn keyword factorKeyword resize-string >string <string> 1string string string?
syn keyword factorKeyword vector? <vector> ?push vector >vector 1vector
syn keyword factorKeyword rethrow-restarts restarts recover set-restart-name set-continuation-name condition-continuation <restart> ifcc continuation-name condition-error set-restart-continuation ignore-errors continuation-retain continue <continuation> restart-continuation with-disposal set-continuation-catch set-condition-error restart-obj error thread-error-hook set-continuation-retain continuation rethrow callcc1 callcc0 condition continuation? continuation-call continuation-data set-condition-restarts set-catchstack >continuation< error-continuation cleanup restart? compute-restarts condition? error-thread set-continuation-call set-condition-continuation <condition> set-restart-obj dispose set-continuation-data throw-restarts catchstack continue-with attempt-all restart restart-name continuation-catch condition-restarts
syn cluster factorReal contains=factorInt,factorFloat,factorRatio,factorBinary,factorHex,factorOctal
syn cluster factorNumber contains=@factorReal,factorComplex
syn cluster factorNumErr contains=factorBinErr,factorHexErr,factorOctErr
syn match factorInt /\<-\=\d\+\>/
syn match factorFloat /\<-\=\d*\.\d\+\>/
syn match factorRatio /\<-\=\d*\.*\d\+\/-\=\d*\.*\d\+\>/
syn region factorComplex start=/\<C{\>/ end=/\<}\>/ contains=@factorReal
syn cluster factorReal contains=factorInt,factorFloat,factorRatio,factorBinary,factorHex,factorOctal
syn cluster factorNumber contains=@factorReal,factorComplex
syn cluster factorNumErr contains=factorBinErr,factorHexErr,factorOctErr
syn match factorInt /\<-\=\d\+\>/
syn match factorFloat /\<-\=\d*\.\d\+\>/
syn match factorRatio /\<-\=\d*\.*\d\+\/-\=\d*\.*\d\+\>/
syn region factorComplex start=/\<C{\>/ end=/\<}\>/ contains=@factorReal
syn match factorBinErr /\<BIN:\s\+[01]*[^\s01]\S*\>/
syn match factorBinary /\<BIN:\s\+[01]\+\>/
syn match factorHexErr /\<HEX:\s\+\x*[^\x\s]\S*\>/
@ -75,31 +73,36 @@ syn match factorHex /\<HEX:\s\+\x\+\>/
syn match factorOctErr /\<OCT:\s\+\o*[^\o\s]\S*\>/
syn match factorOctal /\<OCT:\s\+\o\+\>/
syn match factorIn /\<IN:\s\+\S\+\>/
syn match factorUse /\<USE:\s\+\S\+\>/
syn match factorIn /\<IN:\s\+\S\+\>/
syn match factorUse /\<USE:\s\+\S\+\>/
syn match factorUnuse /\<UNUSE:\s\+\S\+\>/
syn match factorCharErr /\<CHAR:\s\+\S\+/
syn match factorChar /\<CHAR:\s\+\\\=\S\>/
syn match factorCharErr /\<CHAR:\s\+\S\+/
syn match factorChar /\<CHAR:\s\+\\\=\S\>/
syn match factorBackslash /\<\\\>\s\+\S\+\>/
syn match factorBackslash /\<\\\>\s\+\S\+\>/
syn region factorUsing start=/\<USING:\>/ end=/;/
syn region factorRequires start=/\<REQUIRES:\>/ end=/;/
syn region factorUsing start=/\<USING:\>/ end=/;/
syn region factorSingletons start=/\<SINGLETONS:\>/ end=/;/
syn match factorSymbol /\<SYMBOL:\s\+\S\+\>/
syn region factorSymbols start=/\<SYMBOLS:\>/ end=/;/
syn region factorConstructor2 start=/\<CONSTRUCTOR:\?/ end=/;/
syn region factorTuple start=/\<TUPLE:\>/ end=/\<;\>/
syn cluster factorWordOps contains=factorSymbol,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor
syn match factorSymbol /\<SYMBOL:\s\+\S\+\>/
syn match factorPostpone /\<POSTPONE:\s\+\S\+\>/
syn match factorDefer /\<DEFER:\s\+\S\+\>/
syn match factorForget /\<FORGET:\s\+\S\+\>/
syn match factorMixin /\<MIXIN:\s\+\S\+\>/
syn match factorInstance /\<INSTANCE:\s\+\S\+\s\+\S\+\>/
syn match factorHook /\<HOOK:\s\+\S\+\s\+\S\+\>/
syn match factorMain /\<MAIN:\s\+\S\+\>/
syn match factorConstructor /\<C:\s\+\S\+\s\+\S\+\>/
syn match factorConstant /\<CONSTANT:\s\+\S\+\>/
syn match factorSingleton /\<SINGLETON:\s\+\S\+\>/
syn match factorPostpone /\<POSTPONE:\s\+\S\+\>/
syn match factorDefer /\<DEFER:\s\+\S\+\>/
syn match factorForget /\<FORGET:\s\+\S\+\>/
syn match factorMixin /\<MIXIN:\s\+\S\+\>/
syn match factorInstance /\<INSTANCE:\s\+\S\+\s\+\S\+\>/
syn match factorHook /\<HOOK:\s\+\S\+\s\+\S\+\>/
syn match factorMain /\<MAIN:\s\+\S\+\>/
syn match factorConstructor /\<C:\s\+\S\+\s\+\S\+\>/
syn match factorAlien /\<ALIEN:\s\+\d\+\>/
syn match factorAlien /\<ALIEN:\s\+\d\+\>/
syn cluster factorWordOps contains=factorSymbol,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor
syn region factorTuple start=/\<TUPLE:\>/ end=/\<;\>/
"TODO:
"misc:
@ -118,6 +121,12 @@ syn region factorTuple start=/\<TUPLE:\>/ end=/\<;\>/
" TYPEDEF:
" LIBRARY:
" C-UNION:
"QUALIFIED:
"QUALIFIED-WITH:
"FROM:
"ALIAS:
"! POSTPONE: "
"#\ "
syn region factorString start=/"/ skip=/\\"/ end=/"/ oneline
syn region factorSbuf start=/SBUF" / skip=/\\"/ end=/"/ oneline
@ -131,18 +140,18 @@ syn region factorStackEffect start=/\<(\>/ end=/\<)\>/ contained
"adapted from lisp.vim
if exists("g:factor_norainbow")
syn region factorQuotation0 matchgroup=factorDelimiter start=/\<\'\?\[\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL
syn region factorQuotation matchgroup=factorDelimiter start=/\<\[\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL
else
syn region factorQuotation0 matchgroup=hlLevel0 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1
syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2
syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3
syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4
syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5
syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6
syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7
syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8
syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9
syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\'\?\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0
syn region factorQuotation0 matchgroup=hlLevel0 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1
syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2
syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3
syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4
syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5
syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6
syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7
syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8
syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9
syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\[\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0
endif
if exists("g:factor_norainbow")
@ -167,88 +176,92 @@ syn sync lines=100
if version >= 508 || !exists("did_factor_syn_inits")
if version <= 508
let did_factor_syn_inits = 1
command -nargs=+ HiLink hi link <args>
let did_factor_syn_inits = 1
command -nargs=+ HiLink hi link <args>
else
command -nargs=+ HiLink hi def link <args>
command -nargs=+ HiLink hi def link <args>
endif
HiLink factorComment Comment
HiLink factorStackEffect Typedef
HiLink factorTodo Todo
HiLink factorInclude Include
HiLink factorRepeat Repeat
HiLink factorConditional Conditional
HiLink factorKeyword Keyword
HiLink factorOperator Operator
HiLink factorBoolean Boolean
HiLink factorDefnDelims Typedef
HiLink factorMethodDelims Typedef
HiLink factorGenericDelims Typedef
HiLink factorGenericNDelims Typedef
HiLink factorConstructor Typedef
HiLink factorPrivate Special
HiLink factorPrivateDefnDelims Special
HiLink factorPrivateMethodDelims Special
HiLink factorPGenericDelims Special
HiLink factorComment Comment
HiLink factorStackEffect Typedef
HiLink factorTodo Todo
HiLink factorInclude Include
HiLink factorRepeat Repeat
HiLink factorConditional Conditional
HiLink factorKeyword Keyword
HiLink factorOperator Operator
HiLink factorBoolean Boolean
HiLink factorDefnDelims Typedef
HiLink factorMethodDelims Typedef
HiLink factorGenericDelims Typedef
HiLink factorGenericNDelims Typedef
HiLink factorConstructor Typedef
HiLink factorConstructor2 Typedef
HiLink factorPrivate Special
HiLink factorPrivateDefnDelims Special
HiLink factorPrivateMethodDelims Special
HiLink factorPGenericDelims Special
HiLink factorPGenericNDelims Special
HiLink factorString String
HiLink factorSbuf String
HiLink factorMultiStringContents String
HiLink factorMultiStringDelims Typedef
HiLink factorBracketErr Error
HiLink factorComplex Number
HiLink factorRatio Number
HiLink factorBinary Number
HiLink factorBinErr Error
HiLink factorHex Number
HiLink factorHexErr Error
HiLink factorOctal Number
HiLink factorOctErr Error
HiLink factorFloat Float
HiLink factorInt Number
HiLink factorUsing Include
HiLink factorUse Include
HiLink factorRequires Include
HiLink factorIn Define
HiLink factorChar Character
HiLink factorCharErr Error
HiLink factorDelimiter Delimiter
HiLink factorBackslash Special
HiLink factorCompileDirective Typedef
HiLink factorSymbol Define
HiLink factorMixin Typedef
HiLink factorInstance Typedef
HiLink factorHook Typedef
HiLink factorMain Define
HiLink factorPostpone Define
HiLink factorDefer Define
HiLink factorForget Define
HiLink factorAlien Define
HiLink factorTuple Typedef
HiLink factorString String
HiLink factorSbuf String
HiLink factorMultiStringContents String
HiLink factorMultiStringDelims Typedef
HiLink factorBracketErr Error
HiLink factorComplex Number
HiLink factorRatio Number
HiLink factorBinary Number
HiLink factorBinErr Error
HiLink factorHex Number
HiLink factorHexErr Error
HiLink factorOctal Number
HiLink factorOctErr Error
HiLink factorFloat Float
HiLink factorInt Number
HiLink factorUsing Include
HiLink factorUse Include
HiLink factorUnuse Include
HiLink factorIn Define
HiLink factorChar Character
HiLink factorCharErr Error
HiLink factorDelimiter Delimiter
HiLink factorBackslash Special
HiLink factorCompileDirective Typedef
HiLink factorSymbol Define
HiLink factorConstant Define
HiLink factorSingleton Define
HiLink factorSingletons Define
HiLink factorMixin Typedef
HiLink factorInstance Typedef
HiLink factorHook Typedef
HiLink factorMain Define
HiLink factorPostpone Define
HiLink factorDefer Define
HiLink factorForget Define
HiLink factorAlien Define
HiLink factorTuple Typedef
if &bg == "dark"
hi hlLevel0 ctermfg=red guifg=red1
hi hlLevel1 ctermfg=yellow guifg=orange1
hi hlLevel2 ctermfg=green guifg=yellow1
hi hlLevel3 ctermfg=cyan guifg=greenyellow
hi hlLevel4 ctermfg=magenta guifg=green1
hi hlLevel5 ctermfg=red guifg=springgreen1
hi hlLevel6 ctermfg=yellow guifg=cyan1
hi hlLevel7 ctermfg=green guifg=slateblue1
hi hlLevel8 ctermfg=cyan guifg=magenta1
hi hlLevel9 ctermfg=magenta guifg=purple1
hi hlLevel0 ctermfg=red guifg=red1
hi hlLevel1 ctermfg=yellow guifg=orange1
hi hlLevel2 ctermfg=green guifg=yellow1
hi hlLevel3 ctermfg=cyan guifg=greenyellow
hi hlLevel4 ctermfg=magenta guifg=green1
hi hlLevel5 ctermfg=red guifg=springgreen1
hi hlLevel6 ctermfg=yellow guifg=cyan1
hi hlLevel7 ctermfg=green guifg=slateblue1
hi hlLevel8 ctermfg=cyan guifg=magenta1
hi hlLevel9 ctermfg=magenta guifg=purple1
else
hi hlLevel0 ctermfg=red guifg=red3
hi hlLevel1 ctermfg=darkyellow guifg=orangered3
hi hlLevel2 ctermfg=darkgreen guifg=orange2
hi hlLevel3 ctermfg=blue guifg=yellow3
hi hlLevel4 ctermfg=darkmagenta guifg=olivedrab4
hi hlLevel5 ctermfg=red guifg=green4
hi hlLevel6 ctermfg=darkyellow guifg=paleturquoise3
hi hlLevel7 ctermfg=darkgreen guifg=deepskyblue4
hi hlLevel8 ctermfg=blue guifg=darkslateblue
hi hlLevel9 ctermfg=darkmagenta guifg=darkviolet
hi hlLevel0 ctermfg=red guifg=red3
hi hlLevel1 ctermfg=darkyellow guifg=orangered3
hi hlLevel2 ctermfg=darkgreen guifg=orange2
hi hlLevel3 ctermfg=blue guifg=yellow3
hi hlLevel4 ctermfg=darkmagenta guifg=olivedrab4
hi hlLevel5 ctermfg=red guifg=green4
hi hlLevel6 ctermfg=darkyellow guifg=paleturquoise3
hi hlLevel7 ctermfg=darkgreen guifg=deepskyblue4
hi hlLevel8 ctermfg=blue guifg=darkslateblue
hi hlLevel9 ctermfg=darkmagenta guifg=darkviolet
endif
delcommand HiLink
@ -262,4 +275,3 @@ set expandtab
set autoindent " annoying?
" vim: syntax=vim

54
vm/callstack.cpp
View File

@ -107,41 +107,43 @@ stack_frame *frame_successor(stack_frame *frame)
/* Allocates memory */
cell frame_scan(stack_frame *frame)
{
if(frame_type(frame) == QUOTATION_TYPE)
switch(frame_type(frame))
{
cell quot = frame_executing(frame);
if(quot == F)
return F;
else
case QUOTATION_TYPE:
{
char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame);
char *quot_xt = (char *)(frame_code(frame) + 1);
cell quot = frame_executing(frame);
if(quot == F)
return F;
else
{
char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame);
char *quot_xt = (char *)(frame_code(frame) + 1);
return tag_fixnum(quot_code_offset_to_scan(
quot,(cell)(return_addr - quot_xt)));
return tag_fixnum(quot_code_offset_to_scan(
quot,(cell)(return_addr - quot_xt)));
}
}
}
else
case WORD_TYPE:
return F;
default:
critical_error("Bad frame type",frame_type(frame));
return F;
}
}
namespace
{
struct stack_frame_counter {
cell count;
stack_frame_counter() : count(0) {}
void operator()(stack_frame *frame) { count += 2; }
};
struct stack_frame_accumulator {
cell index;
gc_root<array> frames;
stack_frame_accumulator(cell count) : index(0), frames(allot_array(count,F)) {}
growable_array frames;
void operator()(stack_frame *frame)
{
set_array_nth(frames.untagged(),index++,frame_executing(frame));
set_array_nth(frames.untagged(),index++,frame_scan(frame));
gc_root<object> executing(frame_executing(frame));
gc_root<object> scan(frame_scan(frame));
frames.add(executing.value());
frames.add(scan.value());
}
};
@ -151,13 +153,11 @@ PRIMITIVE(callstack_to_array)
{
gc_root<callstack> callstack(dpop());
stack_frame_counter counter;
iterate_callstack_object(callstack.untagged(),counter);
stack_frame_accumulator accum(counter.count);
stack_frame_accumulator accum;
iterate_callstack_object(callstack.untagged(),accum);
accum.frames.trim();
dpush(accum.frames.value());
dpush(accum.frames.elements.value());
}
stack_frame *innermost_stack_frame(callstack *stack)

14
vm/callstack.hpp
View File

@ -33,9 +33,19 @@ template<typename T> void iterate_callstack(cell top, cell bottom, T &iterator)
}
}
template<typename T> void iterate_callstack_object(callstack *stack, T &iterator)
/* This is a little tricky. The iterator may allocate memory, so we
keep the callstack in a GC root and use relative offsets */
template<typename T> void iterate_callstack_object(callstack *stack_, T &iterator)
{
iterate_callstack((cell)stack->top(),(cell)stack->bottom(),iterator);
gc_root<callstack> stack(stack_);
fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
while(frame_offset >= 0)
{
stack_frame *frame = stack->frame_at(frame_offset);
frame_offset -= frame->size;
iterator(frame);
}
}
}

5
vm/layouts.hpp
View File

@ -309,6 +309,11 @@ struct callstack : public object {
/* tagged */
cell length;
stack_frame *frame_at(cell offset)
{
return (stack_frame *)((char *)(this + 1) + offset);
}
stack_frame *top() { return (stack_frame *)(this + 1); }
stack_frame *bottom() { return (stack_frame *)((cell)(this + 1) + untag_fixnum(length)); }
};