# HG changeset patch # User Christian Brabandt # Date 1693463407 -7200 # Node ID 1549d0cc5fc7b51400052c6bbcb3c6069f07c68c # Parent 51b4577d57bf1d77cbcbbecbe0c328ac0e0a9b34 runtime(forth): Update syntax and ftplugin files (#12976) Commit: https://github.com/vim/vim/commit/1610528cc3052103e368c4175b09db6f9a6c150c Author: dkearns Date: Thu Aug 31 16:17:16 2023 +1000 runtime(forth): Update syntax and ftplugin files (https://github.com/vim/vim/issues/12976) Signed-off-by: Christian Brabandt diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -133,6 +133,7 @@ runtime/ftplugin/eruby.vim @tpope @dkea runtime/ftplugin/expect.vim @dkearns runtime/ftplugin/fennel.vim @gpanders runtime/ftplugin/fetchmail.vim @dkearns +runtime/ftplugin/forth.vim @jkotlinski runtime/ftplugin/fpcmake.vim @dkearns runtime/ftplugin/freebasic.vim @dkearns runtime/ftplugin/fstab.vim @rid9 diff --git a/runtime/ftplugin/forth.vim b/runtime/ftplugin/forth.vim new file mode 100644 --- /dev/null +++ b/runtime/ftplugin/forth.vim @@ -0,0 +1,71 @@ +" Vim filetype plugin +" Language: Forth +" Maintainer: Johan Kotlinski +" Last Change: 2023 Aug 08 +" URL: https://github.com/jkotlinski/forth.vim + +if exists("b:did_ftplugin") + finish +endif +let b:did_ftplugin = 1 + +let s:cpo_save = &cpo +set cpo&vim + +setlocal commentstring=\\\ %s +setlocal comments=s:(,mb:\ ,e:),b:\\ +setlocal iskeyword=33-126,128-255 + +let s:include_patterns =<< trim EOL + + \<\%(INCLUDE\|REQUIRE\)\>\s\+\zs\k\+\ze + \ +EOL +let &l:include = $'\c{ s:include_patterns[1:]->join('\|') }' + +let s:define_patterns =<< trim EOL + : + [2F]\=CONSTANT + [2F]\=VALUE + [2F]\=VARIABLE + BEGIN-STRUCTURE + BUFFER: + CODE + CREATE + MARKER + SYNONYM +EOL +let &l:define = $'\c\<\%({ s:define_patterns->join('\|') }\)' + +" assume consistent intra-project file extensions +let &l:suffixesadd = "." .. expand("%:e") + +let b:undo_ftplugin = "setl cms< com< def< inc< isk< sua<" + +if exists("loaded_matchit") && !exists("b:match_words") + let s:matchit_patterns =<< trim EOL + + \<\:\%(NONAME\)\=\>:\:\<;\> + \:\:\ + \<\[IF]\>:\<\[ELSE]\>:\<\[THEN]\> + \:\:\<+\=LOOP\> + \:\ + \:\ + \:\:\<\%(AGAIN\|REPEAT\|UNTIL\)\> + \:\ + \:\ + EOL + let b:match_ignorecase = 1 + let b:match_words = s:matchit_patterns[1:]->join(',') + let b:undo_ftplugin ..= "| unlet! b:match_ignorecase b:match_words" +endif + +if (has("gui_win32") || has("gui_gtk")) && !exists("b:browsefilter") + let b:browsefilter = "Forth Source Files (*.f *.fs *.ft *.fth *.4th)\t*.f;*.fs;*.ft;*.fth;*.4th\n" .. + \ "All Files (*.*)\t*.*\n" + let b:undo_ftplugin ..= " | unlet! b:browsefilter" +endif + +let &cpo = s:cpo_save +unlet s:cpo_save +unlet s:define_patterns s:include_patterns s:matchit_patterns diff --git a/runtime/syntax/forth.vim b/runtime/syntax/forth.vim --- a/runtime/syntax/forth.vim +++ b/runtime/syntax/forth.vim @@ -1,10 +1,20 @@ " Vim syntax file -" Language: FORTH -" Current Maintainer: Johan Kotlinski -" Previous Maintainer: Christian V. J. Br�ssow -" Last Change: 2023-01-12 -" Filenames: *.fs,*.ft -" URL: https://github.com/jkotlinski/forth.vim +" Language: Forth +" Maintainer: Johan Kotlinski +" Previous Maintainer: Christian V. J. Brüssow +" Last Change: 2023 Aug 13 +" Filenames: *.f,*.fs,*.ft,*.fth,*.4th +" URL: https://github.com/jkotlinski/forth.vim + +" Supports the Forth-2012 Standard. +" +" Removed words from the earlier Forth-79, Forth-83 and Forth-94 standards are +" also included. +" +" These have been organised according to the version in which they were +" initially included and the version in which they were removed (obsolescent +" status is ignored). Words with "experimental" or "uncontrolled" status are +" not included unless they were later standardised. " quit when a syntax file was already loaded if exists("b:current_syntax") @@ -15,19 +25,15 @@ let s:cpo_save = &cpo set cpo&vim " Synchronization method -syn sync ccomment -syn sync maxlines=200 +exe "syn sync minlines=" .. get(g:, "forth_minlines", 50) -" I use gforth, so I set this to case ignore syn case ignore -" Some special, non-FORTH keywords -syn keyword forthTodo contained TODO FIXME XXX - " Characters allowed in keywords " I don't know if 128-255 are allowed in ANS-FORTH -setlocal iskeyword=!,@,33-35,%,$,38-64,A-Z,91-96,a-z,123-126,128-255 +syn iskeyword 33-126,128-255 +" Space errors {{{1 " when wanted, highlight trailing white space if exists("forth_space_errors") if !exists("forth_no_trail_space_error") @@ -38,188 +44,369 @@ if exists("forth_space_errors") endif endif -" Keywords +" Core words {{{1 + +" basic mathematical and logical operators {{{2 +syn keyword forthOperators * */ */MOD + - / /MOD 0< 0= 1+ 1- 2* 2/ < = > ABS +syn keyword forthOperators AND FM/MOD INVERT LSHIFT M* MAX MIN MOD NEGATE OR +syn keyword forthOperators RSHIFT SM/REM U< UM* UM/MOD XOR + " extension words +syn keyword forthOperators 0<> 0> <> U> WITHIN + " Forth-79 +syn keyword forthOperators U* U/ U/MOD + " Forth-79, Forth-83 +syn keyword forthOperators NOT + " Forth-83 +syn keyword forthOperators 2+ 2- + +" non-standard basic mathematical and logical operators +syn keyword forthOperators 0<= 0>= 8* <= >= ?DNEGATE ?NEGATE U<= U>= UNDER+ + +" various words that take an input and do something with it {{{2 +syn keyword forthFunction . U. + " extension words +syn keyword forthFunction .R U.R -" basic mathematical and logical operators -syn keyword forthOperators + - * / MOD /MOD NEGATE ABS MIN MAX -syn keyword forthOperators AND OR XOR NOT LSHIFT RSHIFT INVERT 2* 2/ 1+ -syn keyword forthOperators 1- 2+ 2- 8* UNDER+ -syn keyword forthOperators M+ */ */MOD M* UM* M*/ UM/MOD FM/MOD SM/REM -syn keyword forthOperators D+ D- DNEGATE DABS DMIN DMAX D2* D2/ -syn keyword forthOperators F+ F- F* F/ FNEGATE FABS FMAX FMIN FLOOR FROUND -syn keyword forthOperators F** FSQRT FEXP FEXPM1 FLN FLNP1 FLOG FALOG FSIN -syn keyword forthOperators FCOS FSINCOS FTAN FASIN FACOS FATAN FATAN2 FSINH -syn keyword forthOperators FCOSH FTANH FASINH FACOSH FATANH F2* F2/ 1/F -syn keyword forthOperators F~REL F~ABS F~ -syn keyword forthOperators 0< 0<= 0<> 0= 0> 0>= < <= <> = > >= U< U<= -syn keyword forthOperators U> U>= D0< D0<= D0<> D0= D0> D0>= D< D<= D<> -syn keyword forthOperators D= D> D>= DU< DU<= DU> DU>= WITHIN ?NEGATE -syn keyword forthOperators ?DNEGATE TRUE FALSE +" stack manipulations {{{2 +syn keyword forthStack 2DROP 2DUP 2OVER 2SWAP >R ?DUP DROP DUP OVER R> R@ ROT +syn keyword forthStack SWAP + " extension words +syn keyword forthStack NIP PICK ROLL TUCK +syn keyword forthRStack 2>R 2R> 2R@ + +" non-standard stack manipulations +syn keyword forthStack -ROT 3DROP 3DUP 4-ROT 4DROP 4DUP 4ROT 4SWAP 4TUCK +syn keyword forthStack 5DROP 5DUP 8DROP 8DUP 8SWAP +syn keyword forthRStack 4>R 4R> 4R@ 4RDROP RDROP + +" stack pointer manipulations {{{2 +syn keyword forthSP DEPTH -" various words that take an input and do something with it -syn keyword forthFunction . U. .R U.R +" non-standard stack pointer manipulations +syn keyword forthSP FP! FP@ LP! LP@ RP! RP@ SP! SP@ + +" address operations {{{2 +syn keyword forthMemory ! +! 2! 2@ @ C! C@ +syn keyword forthAdrArith ALIGN ALIGNED ALLOT CELL+ CELLS CHAR+ CHARS +syn keyword forthMemBlks FILL MOVE + " extension words +syn keyword forthMemBlks ERASE UNUSED + +" non-standard address operations +syn keyword forthAdrArith ADDRESS-UNIT-BITS CELL CFALIGN CFALIGNED FLOAT +syn keyword forthAdrArith MAXALIGN MAXALIGNED + +" conditionals {{{2 +syn keyword forthCond ELSE IF THEN + " extension words +syn keyword forthCond CASE ENDCASE ENDOF OF -" stack manipulations -syn keyword forthStack DROP NIP DUP OVER TUCK SWAP ROT -ROT ?DUP PICK ROLL -syn keyword forthStack 2DROP 2NIP 2DUP 2OVER 2TUCK 2SWAP 2ROT 2-ROT -syn keyword forthStack 3DUP 4DUP 5DUP 3DROP 4DROP 5DROP 8DROP 4SWAP 4ROT -syn keyword forthStack 4-ROT 4TUCK 8SWAP 8DUP -syn keyword forthRStack >R R> R@ RDROP 2>R 2R> 2R@ 2RDROP -syn keyword forthRstack 4>R 4R> 4R@ 4RDROP -syn keyword forthFStack FDROP FNIP FDUP FOVER FTUCK FSWAP FROT +" non-standard conditionals +syn keyword forthCond ?DUP-0=-IF ?DUP-IF ENDIF + +" iterations {{{2 +syn keyword forthLoop +LOOP BEGIN DO EXIT I J LEAVE LOOP RECURSE REPEAT UNLOOP +syn keyword forthLoop UNTIL WHILE + " extension words +syn keyword forthLoop ?DO AGAIN + +" non-standard iterations +syn keyword forthLoop +DO -DO -LOOP ?LEAVE DONE FOR K NEXT U+DO U-DO -" stack pointer manipulations -syn keyword forthSP SP@ SP! FP@ FP! RP@ RP! LP@ LP! DEPTH +" new words {{{2 +syn match forthColonDef "\<:\s*[^ \t]\+\>" +syn keyword forthEndOfColonDef ; +syn keyword forthDefine ' , C, CONSTANT CREATE DOES> EXECUTE IMMEDIATE LITERAL +syn keyword forthDefine POSTPONE STATE VARIABLE ] +syn match forthDefine "\<\[']\>" +syn match forthDefine "\<\[\>" + " extension words +syn keyword forthColonDef :NONAME +syn keyword forthDefine BUFFER: COMPILE, DEFER IS MARKER TO VALUE +syn match forthDefine "\<\[COMPILE]\>" + " Forth-79, Forth-83 +syn keyword forthDefine COMPILE -" address operations -syn keyword forthMemory @ ! +! C@ C! 2@ 2! F@ F! SF@ SF! DF@ DF! -syn keyword forthAdrArith CHARS CHAR+ CELLS CELL+ CELL ALIGN ALIGNED FLOATS -syn keyword forthAdrArith FLOAT+ FLOAT FALIGN FALIGNED SFLOATS SFLOAT+ -syn keyword forthAdrArith SFALIGN SFALIGNED DFLOATS DFLOAT+ DFALIGN DFALIGNED -syn keyword forthAdrArith MAXALIGN MAXALIGNED CFALIGN CFALIGNED -syn keyword forthAdrArith ADDRESS-UNIT-BITS ALLOT ALLOCATE HERE -syn keyword forthMemBlks MOVE ERASE CMOVE CMOVE> FILL BLANK UNUSED +" non-standard new words +syn match forthClassDef "\<:CLASS\s*[^ \t]\+\>" +syn keyword forthEndOfClassDef ;CLASS +syn match forthObjectDef "\<:OBJECT\s*[^ \t]\+\>" +syn keyword forthEndOfObjectDef ;OBJECT +syn match forthColonDef "\<:M\s*[^ \t]\+\>" +syn keyword forthEndOfColonDef ;M +syn keyword forthDefine 2, COMPILE-ONLY CREATE-INTERPRET/COMPILE +syn keyword forthDefine CVARIABLE F, FIND-NAME INTERPRET INTERPRETATION> +syn keyword forthDefine LASTXT NAME>COMP NAME>INT NAME?INT POSTPONE, RESTRICT +syn keyword forthDefine USER +syn match forthDefine "\<\[COMP']\>" -" conditionals -syn keyword forthCond IF ELSE ENDIF THEN CASE OF ENDOF ENDCASE ?DUP-IF -syn keyword forthCond ?DUP-0=-IF AHEAD CS-PICK CS-ROLL CATCH THROW WITHIN +" basic character operations {{{2 +syn keyword forthCharOps BL COUNT CR EMIT FIND KEY SPACE SPACES TYPE WORD +" recognize 'char (' or '[CHAR] (' correctly, so it doesn't +" highlight everything after the paren as a comment till a closing ')' +syn match forthCharOps '\ #S <# >NUMBER HOLD S>D SIGN + " extension words +syn keyword forthConversion HOLDS + " Forth-79, Forth-83, Forth-93 +syn keyword forthConversion CONVERT + +" non-standard char-number conversion +syn keyword forthConversion #>> (NUMBER) (NUMBER?) <<# DIGIT DPL HLD NUMBER -" new words -syn match forthClassDef '\<:class\s*[^ \t]\+\>' -syn match forthObjectDef '\<:object\s*[^ \t]\+\>' -syn match forthColonDef '\<:m\?\s*[^ \t]\+\>' -syn keyword forthEndOfColonDef ; ;M ;m -syn keyword forthEndOfClassDef ;class -syn keyword forthEndOfObjectDef ;object -syn keyword forthDefine CONSTANT 2CONSTANT FCONSTANT VARIABLE 2VARIABLE -syn keyword forthDefine FVARIABLE CREATE USER VALUE TO DEFER IS IMMEDIATE -syn keyword forthDefine COMPILE-ONLY COMPILE RESTRICT INTERPRET POSTPONE EXECUTE -syn keyword forthDefine LITERAL CREATE-INTERPRET/COMPILE INTERPRETATION> -syn keyword forthDefine INT NAME?INT NAME>COMP -syn keyword forthDefine NAME>STRING STATE C; CVARIABLE BUFFER: MARKER -syn keyword forthDefine , 2, F, C, COMPILE, -syn match forthDefine "\[DEFINED]" -syn match forthDefine "\[UNDEFINED]" -syn match forthDefine "\[IF]" -syn match forthDefine "\[IFDEF]" -syn match forthDefine "\[IFUNDEF]" -syn match forthDefine "\[THEN]" -syn match forthDefine "\[ENDIF]" -syn match forthDefine "\[ELSE]" -syn match forthDefine "\[?DO]" -syn match forthDefine "\[DO]" -syn match forthDefine "\[LOOP]" -syn match forthDefine "\[+LOOP]" -syn match forthDefine "\[NEXT]" -syn match forthDefine "\[BEGIN]" -syn match forthDefine "\[UNTIL]" -syn match forthDefine "\[AGAIN]" -syn match forthDefine "\[WHILE]" -syn match forthDefine "\[REPEAT]" -syn match forthDefine "\[COMP']" -syn match forthDefine "'" -syn match forthDefine '\<\[\>' -syn match forthDefine "\[']" -syn match forthDefine '\[COMPILE]' -syn match forthDefine '\[CHAR]' +" interpreter, wordbook, compiler {{{2 +syn keyword forthForth >BODY >IN ACCEPT ENVIRONMENT? EVALUATE HERE QUIT SOURCE + " extension words +syn keyword forthForth ACTION-OF DEFER! DEFER@ PAD PARSE PARSE-NAME REFILL +syn keyword forthForth RESTORE-INPUT SAVE-INPUT SOURCE-ID + " Forth-79 +syn keyword forthForth 79-STANDARD + " Forth-83 +syn keyword forthForth MARK >RESOLVE ?BRANCH BRANCH FORTH-83 + " Forth-79, Forth-83, Forth-94 +syn keyword forthForth QUERY + " Forth-83, Forth-94 +syn keyword forthForth SPAN + +" non-standard interpreter, wordbook, compiler +syn keyword forthForth ) >LINK >NEXT >VIEW ASSERT( ASSERT0( ASSERT1( ASSERT2( +syn keyword forthForth ASSERT3( BODY> CFA COLD L>NAME LINK> N>LINK NAME> VIEW +syn keyword forthForth VIEW> + +" booleans {{{2 + " extension words +syn match forthBoolean "\<\%(TRUE\|FALSE\)\>" -" debugging -syn keyword forthDebug PRINTDEBUGDATA PRINTDEBUGLINE -syn match forthDebug "\<\~\~\>" +" numbers {{{2 +syn keyword forthMath BASE DECIMAL + " extension words +syn keyword forthMath HEX +syn match forthInteger '\<-\=\d\+\.\=\>' +syn match forthInteger '\<#-\=\d\+\.\=\>' +syn match forthInteger '\<\$-\=\x\+\.\=\>' +syn match forthInteger '\<%-\=[01]\+\.\=\>' -" Assembler -syn keyword forthAssembler ASSEMBLER CODE END-CODE ;CODE FLUSH-ICACHE C, +" characters {{{2 +syn match forthCharacter "'\k'" + +" strings {{{2 -" basic character operations -syn keyword forthCharOps (.) CHAR EXPECT FIND WORD TYPE -TRAILING EMIT KEY -syn keyword forthCharOps KEY? TIB CR BL COUNT SPACE SPACES -" recognize 'char (' or '[char] (' correctly, so it doesn't -" highlight everything after the paren as a comment till a closing ')' -syn match forthCharOps '\ #>> #S (NUMBER) (NUMBER?) CONVERT D>F -syn keyword forthConversion D>S DIGIT DPL F>D HLD HOLD NUMBER S>D SIGN >NUMBER -syn keyword forthConversion F>S S>F HOLDS +" comments {{{2 + +syn keyword forthTodo contained TODO FIXME XXX + +" Some special, non-FORTH keywords +syn match forthTodo contained "\<\%(TODO\|FIXME\|XXX\)\%(\>\|:\@=\)" + +" XXX If you find this overkill you can remove it. This has to come after the +" highlighting for numbers and booleans otherwise it has no effect. +syn region forthComment start='\<\%(0\|FALSE\)\s\+\[IF]' end='\<\[ENDIF]' end='\<\[THEN]' contains=forthTodo -" interpreter, wordbook, compiler -syn keyword forthForth (LOCAL) BYE COLD ABORT >BODY >NEXT >LINK CFA >VIEW HERE -syn keyword forthForth PAD WORDS VIEW VIEW> N>LINK NAME> LINK> L>NAME FORGET -syn keyword forthForth BODY> ASSERT( ASSERT0( ASSERT1( ASSERT2( ASSERT3( ) -syn keyword forthForth >IN ACCEPT ENVIRONMENT? EVALUATE QUIT SOURCE ACTION-OF -syn keyword forthForth DEFER! DEFER@ PARSE PARSE-NAME REFILL RESTORE-INPUT -syn keyword forthForth SAVE-INPUT SOURCE-ID -syn region forthForth start=+ABORT"\s+ skip=+\\"+ end=+"+ +if get(g:, "forth_no_comment_fold", 0) + syn region forthComment start='\<(\>' end=')' contains=@Spell,forthTodo,forthSpaceError + " extension words + syn match forthComment '\<\\\>.*$' contains=@Spell,forthTodo,forthSpaceError +else + syn region forthComment start='\<(\>' end=')' contains=@Spell,forthTodo,forthSpaceError fold + " extension words + syn match forthComment '\<\\\>.*$' contains=@Spell,forthTodo,forthSpaceError + syn region forthMultilineComment start="^\s*\\\>" end="\n\%(\s*\\\>\)\@!" contains=forthComment transparent fold +endif -" vocabularies -syn keyword forthVocs ONLY FORTH ALSO ROOT SEAL VOCS ORDER CONTEXT #VOCS -syn keyword forthVocs VOCABULARY DEFINITIONS + " extension words +syn region forthComment start='\<\.(\>' end=')' end='$' contains=@Spell,forthTodo,forthSpaceError -" File keywords -syn keyword forthFileMode R/O R/W W/O BIN -syn keyword forthFileWords OPEN-FILE CREATE-FILE CLOSE-FILE DELETE-FILE -syn keyword forthFileWords RENAME-FILE READ-FILE READ-LINE KEY-FILE -syn keyword forthFileWords KEY?-FILE WRITE-FILE WRITE-LINE EMIT-FILE -syn keyword forthFileWords FLUSH-FILE FILE-STATUS FILE-POSITION -syn keyword forthFileWords REPOSITION-FILE FILE-SIZE RESIZE-FILE -syn keyword forthFileWords SLURP-FILE SLURP-FID STDIN STDOUT STDERR -syn keyword forthFileWords INCLUDE-FILE INCLUDED REQUIRED -syn keyword forthBlocks OPEN-BLOCKS USE LOAD --> BLOCK-OFFSET -syn keyword forthBlocks GET-BLOCK-FID BLOCK-POSITION LIST SCR BLOCK -syn keyword forthBlocks BUFER EMPTY-BUFFERS EMPTY-BUFFER UPDATE UPDATED? -syn keyword forthBlocks SAVE-BUFFERS SAVE-BUFFER FLUSH THRU +LOAD +THRU -syn keyword forthBlocks BLOCK-INCLUDED BLK +" ABORT {{{2 +syn keyword forthForth ABORT +syn region forthForth start=+\+ end=+$+ + +" The optional Block word set {{{1 +" Handled as Core words - REFILL +syn keyword forthBlocks BLK BLOCK BUFFER FLUSH LOAD SAVE-BUFFERS UPDATE + " extension words +syn keyword forthBlocks EMPTY-BUFFERS LIST SCR THRU + +" Non-standard Block words +syn keyword forthBlocks +LOAD +THRU --> BLOCK-INCLUDED BLOCK-OFFSET +syn keyword forthBlocks BLOCK-POSITION EMPTY-BUFFER GET-BLOCK-FID OPEN-BLOCKS +syn keyword forthBlocks SAVE-BUFFER UPDATED? USE -" numbers -syn keyword forthMath DECIMAL HEX BASE -syn match forthInteger '\<-\=[0-9]\+.\=\>' -syn match forthInteger '\<&-\=[0-9]\+.\=\>' -syn match forthInteger '\<#-\=[0-9]\+.\=\>' -" recognize hex and binary numbers, the '$' and '%' notation is for gforth -syn match forthInteger '\<\$\x*\x\+\>' " *1* --- don't mess -syn match forthInteger '\<\x*\d\x*\>' " *2* --- this order! -syn match forthInteger '\<%[0-1]*[0-1]\+\>' -syn match forthFloat '\<-\=\d*[.]\=\d\+[DdEe]\d\+\>' -syn match forthFloat '\<-\=\d*[.]\=\d\+[DdEe][-+]\d\+\>' +" The optional Double-Number word set {{{1 +syn keyword forthConversion D>S +syn keyword forthDefine 2CONSTANT 2LITERAL 2VARIABLE +syn keyword forthFunction D. D.R +syn keyword forthOperators D+ D- D0= D2* D2/ D= DABS DMAX DMIN DNEGATE +syn keyword forthOperators D0< D< M+ M*/ + " extension words +syn keyword forthDefine 2VALUE +syn keyword forthOperators DU< +syn keyword forthStack 2ROT -" XXX If you find this overkill you can remove it. this has to come after the -" highlighting for numbers otherwise it has no effect. -syn region forthComment start='0 \[if\]' end='\[endif\]' end='\[then\]' contains=forthTodo +" Non-standard Double-Number words +syn keyword forthOperators D0<= D0<> D0> D0>= D<= D<> D> D>= DU<= DU> DU>= +syn keyword forthStack 2-ROT 2NIP 2RDROP 2TUCK + +" The optional Exception word set {{{1 +" Handled as Core words - ABORT ABORT" +syn keyword forthCond CATCH THROW -" Strings -syn region forthString start=+\.*\"+ end=+"+ end=+$+ contains=@Spell -" XXX -syn region forthString start=+s\"+ end=+"+ end=+$+ contains=@Spell -syn region forthString start=+s\\\"+ end=+"+ end=+$+ contains=@Spell -syn region forthString start=+c\"+ end=+"+ end=+$+ contains=@Spell +" The optional Facility word set {{{1 +syn keyword forthCharOps AT-XY KEY? PAGE + " extension words +syn keyword forthCharOps EKEY EKEY>CHAR EKEY>FKEY EKEY? EMIT? K-ALT-MASK +syn keyword forthCharOps K-CTRL-MASK K-DELETE K-DOWN K-END K-F1 K-F10 K-F11 +syn keyword forthCharOps K-F12 K-F2 K-F3 K-F4 K-F5 K-F6 K-F7 K-F8 K-F9 K-HOME +syn keyword forthCharOps K-INSERT K-LEFT K-NEXT K-PRIOR K-RIGHT K-SHIFT-MASK +syn keyword forthCharOps K-UP +syn keyword forthDefine +FIELD BEGIN-STRUCTURE CFIELD: END-STRUCTURE FIELD: +syn keyword forthForth MS TIME&DATE -" Comments -syn match forthComment '\\\%(\s.*\)\=$' contains=@Spell,forthTodo,forthSpaceError -syn region forthComment start='\\S\s' end='.*' contains=@Spell,forthTodo,forthSpaceError -syn match forthComment '\.(\s[^)]*)' contains=@Spell,forthTodo,forthSpaceError -syn region forthComment start='\(^\|\s\)\zs(\s' skip='\\)' end=')' contains=@Spell,forthTodo,forthSpaceError -syn region forthComment start='/\*' end='\*/' contains=@Spell,forthTodo,forthSpaceError +" The optional File-Access word set {{{1 +" Handled as Core words - REFILL SOURCE-ID S\" S" ( +syn keyword forthFileMode BIN R/O R/W W/O +syn keyword forthFileWords CLOSE-FILE CREATE-FILE DELETE-FILE FILE-POSITION +syn keyword forthFileWords FILE-SIZE INCLUDE-FILE INCLUDED OPEN-FILE READ-FILE +syn keyword forthFileWords READ-LINE REPOSITION-FILE RESIZE-FILE WRITE-FILE +syn keyword forthFileWords WRITE-LINE + " extension words +syn keyword forthFileWords FILE-STATUS FLUSH-FILE RENAME-FILE REQUIRED +syn match forthInclude '\' + +syn keyword forthConversion >FLOAT D>F F>D +syn keyword forthAdrArith FALIGN FALIGNED FLOAT+ FLOATS +syn keyword forthDefine FCONSTANT FLITERAL FVARIABLE +syn keyword forthFStack FDROP FDUP FOVER FROT FSWAP +syn keyword forthFunction REPRESENT +syn keyword forthMemory F! F@ +syn keyword forthOperators F* F+ F- F/ F0< F0= F< FLOOR FMAX FMIN FNEGATE +syn keyword forthOperators FROUND +syn keyword forthSP FDEPTH + " extension words +syn keyword forthConversion F>S S>F +syn keyword forthAdrArith DFALIGN DFALIGNED DFLOAT+ DFLOATS SFALIGN +syn keyword forthAdrArith SFALIGNED SFLOAT+ SFLOATS +syn keyword forthDefine DFFIELD: FFIELD: FVALUE SFFIELD: +syn keyword forthFunction F. FE. FS. PRECISION SET-PRECISION +syn keyword forthMemory DF! DF@ SF! SF@ +syn keyword forthOperators F** FABS FACOS FACOSH FALOG FASIN FASINH FATAN +syn keyword forthOperators FATAN2 FATANH FCOS FCOSH FEXP FEXPM1 FLN FLNP1 +syn keyword forthOperators FLOG FSIN FSINCOS FSINH FSQRT FTAN FTANH FTRUNC F~ + +" Non-standard Floating-Point words +syn keyword forthOperators 1/F F2* F2/ F~ABS F~REL +syn keyword forthFStack FNIP FTUCK + +" The optional Locals word set {{{1 +syn keyword forthForth (LOCAL) + " extension words +syn region forthLocals start="\<{:\>" end="\<:}\>" +syn region forthLocals start="\" end="\<|\>" + +" Non-standard Locals words +syn region forthLocals start="\<{\>" end="\<}\>" + +" The optional Memory-Allocation word set {{{1 +syn keyword forthMemory ALLOCATE FREE RESIZE -" Define the default highlighting. +" The optional Programming-Tools wordset {{{1 +syn keyword forthDebug .S ? DUMP SEE WORDS + " extension words +syn keyword forthAssembler ;CODE ASSEMBLER CODE END-CODE +syn keyword forthCond AHEAD CS-PICK CS-ROLL +syn keyword forthDefine NAME>COMPILE NAME>INTERPRET NAME>STRING SYNONYM +syn keyword forthDefine TRAVERSE-WORDLIST +syn match forthDefine "\<\[DEFINED]\>" +syn match forthDefine "\<\[ELSE]\>" +syn match forthDefine "\<\[IF]\>" +syn match forthDefine "\<\[THEN]\>" +syn match forthDefine "\<\[UNDEFINED]\>" +syn keyword forthForth BYE FORGET +syn keyword forthStack N>R NR> +syn keyword forthVocs EDITOR + +" Non-standard Programming-Tools words +syn keyword forthAssembler FLUSH-ICACHE +syn keyword forthDebug PRINTDEBUGDATA PRINTDEBUGLINE +syn match forthDebug "\<\~\~\>" +syn match forthDefine "\<\[+LOOP]\>" +syn match forthDefine "\<\[?DO]\>" +syn match forthDefine "\<\[AGAIN]\>" +syn match forthDefine "\<\[BEGIN]\>" +syn match forthDefine "\<\[DO]\>" +syn match forthDefine "\<\[ENDIF]\>" +syn match forthDefine "\<\[IFDEF]\>" +syn match forthDefine "\<\[IFUNDEF]\>" +syn match forthDefine "\<\[LOOP]\>" +syn match forthDefine "\<\[NEXT]\>" +syn match forthDefine "\<\[REPEAT]\>" +syn match forthDefine "\<\[UNTIL]\>" +syn match forthDefine "\<\[WHILE]\>" + +" The optional Search-Order word set {{{1 +" Handled as Core words - FIND +syn keyword forthVocs DEFINITIONS FORTH-WORDLIST GET-CURRENT GET-ORDER +syn keyword forthVocs SEARCH-WORDLIST SET-CURRENT SET-ORDER WORDLIST + " extension words +syn keyword forthVocs ALSO FORTH ONLY ORDER PREVIOUS + " Forth-79, Forth-83 +syn keyword forthVocs CONTEXT CURRENT VOCABULARY + +" Non-standard Search-Order words +syn keyword forthVocs #VOCS ROOT SEAL VOCS + +" The optional String word set {{{1 +syn keyword forthFunction -TRAILING /STRING BLANK CMOVE CMOVE> COMPARE SEARCH +syn keyword forthFunction SLITERAL + " extension words +syn keyword forthFunction REPLACES SUBSTITUTE UNESCAPE + +" The optional Extended-Character word set {{{1 +" Handled as Core words - [CHAR] CHAR and PARSE +syn keyword forthAdrArith XCHAR+ +syn keyword forthCharOps X-SIZE XC-SIZE XEMIT XKEY XKEY? +syn keyword forthDefine XC, +syn keyword forthMemory XC!+ XC!+? XC@+ + " extension words +syn keyword forthAdrArith XCHAR- +X/STRING X\\STRING- +syn keyword forthCharOps EKEY>XCHAR X-WIDTH XC-WIDTH +syn keyword forthConversion XHOLD +syn keyword forthString -TRAILING-GARBAGE + +" Define the default highlighting {{{1 +hi def link forthBoolean Boolean +hi def link forthCharacter Character hi def link forthTodo Todo hi def link forthOperators Operator hi def link forthMath Number @@ -243,6 +430,7 @@ hi def link forthCharOps Character hi def link forthConversion String hi def link forthForth Statement hi def link forthVocs Statement +hi def link forthEscape Special hi def link forthString String hi def link forthComment Comment hi def link forthClassDef Define @@ -251,16 +439,17 @@ hi def link forthObjectDef Define hi def link forthEndOfObjectDef Define hi def link forthInclude Include hi def link forthLocals Type " nothing else uses type and locals must stand out -hi def link forthDeprecated Error " if you must, change to Type hi def link forthFileMode Function hi def link forthFunction Function hi def link forthFileWords Statement hi def link forthBlocks Statement hi def link forthSpaceError Error +"}}} let b:current_syntax = "forth" let &cpo = s:cpo_save unlet s:cpo_save -" vim:ts=8:sw=4:nocindent:smartindent: +" vim:ts=8:sw=4:nocindent:smartindent:fdm=marker:tw=78 +