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