Add Forth lexer

docs/Languages.md

@@ -61,6 +61,7 @@
 - Erlang (`erlang`)
 - Escape (`escape`)
 - Factor (`factor`)
+- Forth (`forth`)
 - Fortran (`fortran`)
 - FreeFEM (`freefem`)
 - FSharp (`fsharp`)

lib/rouge/demos/forth

@@ -0,0 +1,5 @@
+: greet ( c-addr u -- )
+ 10 20 at-xy
+ ." Hello" type cr ;
+
+s" World" greet bye

lib/rouge/guessers/disambiguation.rb

@@ -138,6 +138,11 @@ def match?(filename)
 
  Puppet
  end
+
+ disambiguate '*.fs' do
+ next Forth if matches?(/:\s+.+?\s+\(\s+--\s+\)/)
+ next FSharp
+ end
  end
  end
 end

lib/rouge/lexers/forth.rb

@@ -0,0 +1,93 @@
+# -*- coding: utf-8 -*- #
+# frozen_string_literal: true
+
+module Rouge
+ module Lexers
+ class Forth < RegexLexer
+ title "Forth"
+ desc "The Forth programming language"
+ tag 'forth'
+ aliases 'fs'
+ filenames '*.fs', '*.fth', '*.4th'
+ mimetypes 'text/x-forth'
+
+ def self.detect?(text)
+ return true if text.shebang? 'gforth'
+ end
+
+ def self.keywords
+ @keywords ||= Set.new %w(
+ :NONAME ; DOES> [ ] ]L IMMEDIATE
+ DO ?DO LOOP +LOOP
+ BEGIN UNTIL AGAIN REPEAT WHILE
+ IF ELSE THEN
+ CASE ENDCASE OF ENDOF
+ LITERAL RECURSE
+ ['] [COMPILE] POSTPONE
+ TO IS
+ ' CHAR
+ )
+ end
+
+ state :root do
+ rule %r/\s+/m, Text::Whitespace
+
+ # comments
+ rule %r/\\\s+.*$/, Comment::Single
+ rule %r/#!\s+.*$/, Comment::Hashbang
+ rule %r/\(\s+/, Comment::Multiline, :comment_paren
+
+ # strings
+ rule %r/(s"|c"|."|abort")/i, Str::Double, :string_quote
+ rule %r/(\.\()/i, Str::Double, :string_paren
+
+ # single character
+ rule %r/(\[char\])(\s+)(\S)/i do
+ groups Keyword, Text, Str::Char
+ end
+
+ # numbers
+ rule %r/\-?\$\h+(?=\s)/, Num::Hex
+ rule %r/\-?%[01]+(?=\s)/, Num::Bin
+ rule %r/\-?#?\d+(?=\s)/, Num
+
+ # constants
+ rule %r/(true|false|bl|cell)(?=\s)/i, Keyword::Constant
+
+ # includes
+ rule %r/(require|include)(\s+)(\S+)/i do
+ groups Keyword::Namespace, Text::Whitespace, Str
+ end
+
+ # definitions
+ rule %r/(:|create|variable|constant|value|defer)(\s+)(\S+)/i do
+ groups Keyword::Declaration, Text::Whitespace, Name::Function
+ end
+
+ # keywords
+ rule %r/\S+/ do |m|
+ if self.class.keywords.include?(m[0].upcase)
+ token Keyword
+ else
+ token Name
+ end
+ end
+ end
+
+ state :comment_paren do
+ rule %r([^\)]+), Comment::Multiline
+ rule %r(\)), Comment::Multiline, :pop!
+ end
+
+ state :string_quote do
+ rule %r/[^\"]+/, Str::Double
+ rule %r/"/, Str::Double, :pop!
+ end
+
+ state :string_paren do
+ rule %r/[^\)]+/, Str::Double
+ rule %r/\)/, Str::Double, :pop!
+ end
+ end
+ end
+end

spec/lexers/forth_spec.rb

@@ -0,0 +1,24 @@
+# -*- coding: utf-8 -*- #
+# frozen_string_literal: true
+
+describe Rouge::Lexers::Forth do
+ let(:subject) { Rouge::Lexers::Forth.new }
+
+ describe 'guessing' do
+ include Support::Guessing
+
+ it 'guesses by filename' do
+ assert_guess :filename => 'foo.fs', :source => ': noop ( -- ) ;'
+ assert_guess :filename => 'foo.fth'
+ assert_guess :filename => 'foo.4th'
+ end
+
+ it 'guesses by mimetype' do
+ assert_guess :mimetype => 'text/x-forth'
+ end
+
+ it 'guesses by source' do
+ assert_guess :source => '#! /usr/bin/gforth'
+ end
+ end
+end

spec/lexers/fsharp_spec.rb

@@ -8,7 +8,7 @@
  include Support::Guessing
 
  it 'guesses by filename' do
- assert_guess :filename => 'foo.fs'
+ assert_guess :filename => 'foo.fs', :source => 'let foo = bar()'
  assert_guess :filename => 'foo.fsx'
  end
 

spec/visual/samples/forth

@@ -0,0 +1,32 @@
+\ Sample Forth program
+
+REQUIRE compat.fs
+
+: square ( n -- n ) DUP * ;
+
+10 CONSTANT pad-size
+CREATE extra-pad pad-size square CELLS ALLOT
+VARIABLE color $ec627a color !
+DEFER main
+
+: ix>weekday ( u -- c-addr u )
+ CASE
+ 0 OF s" Sunday" ENDOF
+ 1 OF s" Monday" ENDOF
+ 2 OF s" Tuesday" ENDOF
+ 3 OF s" Wednesday" ENDOF
+ 4 OF s" Thursday" ENDOF
+ 5 OF s" Friday" ENDOF
+ 6 OF s" Saturday" ENDOF
+ ENDCASE ;
+
+: .weekdays ( -- )
+ 7 0 ?DO
+ [CHAR] - EMIT SPACE
+ I ix>weekday TYPE CR
+ [ 10 square ]L MS
+ LOOP ;
+
+:noname ( -- )
+ ." Hello World!"
+ .weekdays BYE ; IS main