diff --git a/lib/linguist/heuristics.rb b/lib/linguist/heuristics.rb
index 13f0173f..d2aca7fe 100644
--- a/lib/linguist/heuristics.rb
+++ b/lib/linguist/heuristics.rb
@@ -39,6 +39,9 @@ module Linguist
         if languages.all? { |l| ["FORTRAN", "Forth"].include?(l) }
           result = disambiguate_f(data)
         end
+        if languages.all? { |l| ["F#", "Forth", "GLSL"].include?(l) }
+          result = disambiguate_fs(data)
+        end
         return result
       end
     end
@@ -151,6 +154,18 @@ module Linguist
       matches
     end
 
+    def self.disambiguate_fs(data)
+      matches = []
+      if /^(: |new-device)/.match(data)
+        matches << Language["Forth"]
+      elsif /^(#light|import|let|module|namespace|open|type)/.match(data)
+        matches << Language["F#"]
+      elsif /^(#include|#pragma|precision|uniform|varying|void)/.match(data)
+        matches << Language["GLSL"]
+      end
+      matches
+    end
+
     def self.active?
       !!ACTIVE
     end
diff --git a/lib/linguist/languages.yml b/lib/linguist/languages.yml
index c80fdb2b..699301aa 100644
--- a/lib/linguist/languages.yml
+++ b/lib/linguist/languages.yml
@@ -819,6 +819,7 @@ Forth:
   - .for
   - .forth
   - .frt
+  - .fs
 
 Frege:
   type: programming
@@ -872,6 +873,7 @@ GLSL:
   - .fp
   - .frag
   - .frg
+  - .fs
   - .fshader
   - .geo
   - .geom
diff --git a/samples/F#/sample.fs b/samples/F#/sample.fs
new file mode 100644
index 00000000..2b690f10
--- /dev/null
+++ b/samples/F#/sample.fs
@@ -0,0 +1,15 @@
+module Sample
+
+open System
+
+type Foo =
+    {
+        Bar : string
+    }
+
+type Baz = interface end
+
+let Sample1(xs : int list) : string =
+    xs
+    |> List.map (fun x -> string x)
+    |> String.concat ","
diff --git a/samples/Forth/core.fs b/samples/Forth/core.fs
new file mode 100644
index 00000000..4a13e217
--- /dev/null
+++ b/samples/Forth/core.fs
@@ -0,0 +1,252 @@
+: immediate   lastxt @ dup c@ negate swap c! ;
+
+: \   source nip >in ! ; immediate \ Copyright 2004, 2012 Lars Brinkhoff
+
+: char \ ( "word" -- char )
+    bl-word here 1+ c@ ;
+
+: ahead  here 0 , ;
+
+: resolve   here swap ! ;
+
+: '   bl-word here find 0branch [ ahead ] exit [ resolve ] 0 ;
+
+: postpone-nonimmediate   [ ' literal , ' compile, ] literal , ;
+
+: create   dovariable_code header, reveal ;
+
+create postponers
+    ' postpone-nonimmediate ,
+    ' abort ,
+    ' , ,
+
+: word \ ( char "<chars>string<char>" -- caddr )
+    drop bl-word here ;
+
+: postpone \ ( C: "word" -- )
+    bl word find 1+ cells  postponers + @ execute ; immediate
+
+: unresolved \ ( C: "word" -- orig )
+    postpone postpone  postpone ahead ; immediate
+
+: chars \ ( n1 -- n2 )
+    ;
+
+: else \ ( -- ) ( C: orig1 -- orig2 )
+    unresolved branch swap resolve ; immediate
+
+: if \ ( flag -- ) ( C: -- orig )
+    unresolved 0branch ; immediate
+
+: then \ ( -- ) ( C: orig -- )
+    resolve ; immediate
+
+: [char] \ ( "word" -- )
+    char  postpone literal ; immediate
+
+: (does>)   lastxt @ dodoes_code over >code ! r> swap >does ! ;
+
+: does>   postpone (does>) ; immediate
+
+: begin \ ( -- ) ( C: -- dest )
+    here ; immediate
+
+: while \ ( x -- ) ( C: dest -- orig dest )
+    unresolved 0branch swap ; immediate
+
+: repeat \ ( -- ) ( C: orig dest -- )
+    postpone branch ,  resolve ; immediate
+
+: until \ ( x -- ) ( C: dest -- )
+    postpone 0branch , ; immediate
+
+: recurse   lastxt @ compile, ; immediate
+
+: pad \ ( -- addr )
+    here 1024 + ;
+
+: parse \ ( char "string<char>" -- addr n )
+    pad >r  begin
+	source? if <source 2dup <> else 0 0 then
+    while
+	r@ c!  r> 1+ >r
+    repeat  2drop  pad r> over - ;
+
+: ( \ ( "string<paren>" -- )
+    [ char ) ] literal parse 2drop ; immediate
+    \ TODO: If necessary, refill and keep parsing.
+
+: string, ( addr n -- )
+    here over allot align  swap cmove ;
+
+: (s") ( -- addr n ) ( R: ret1 -- ret2 )
+    r> dup @ swap cell+ 2dup + aligned >r swap ;
+
+create squote   128 allot
+
+: s" ( "string<quote>" -- addr n )
+    state @ if
+	postpone (s")  [char] " parse  dup ,  string,
+    else
+	[char] " parse  >r squote r@ cmove  squote r>
+    then ; immediate
+
+: (abort") ( ... addr n -- ) ( R: ... -- )
+    cr type cr abort ;
+
+: abort" ( ... x "string<quote>" -- ) ( R: ... -- )
+    postpone if  postpone s"  postpone (abort")  postpone then ; immediate
+
+\ ----------------------------------------------------------------------
+
+( Core words. )
+
+\ TODO: #
+\ TODO: #>
+\ TODO: #s
+
+: and  ( x y -- x&y )   nand invert ;
+
+: *   1 2>r 0 swap begin r@ while
+         r> r> swap 2dup dup + 2>r and if swap over + swap then dup +
+      repeat r> r> 2drop drop ;
+
+\ TODO: */mod
+
+: +loop ( -- ) ( C: nest-sys -- )
+    postpone (+loop)  postpone 0branch  ,  postpone unloop ; immediate
+
+: space   bl emit ;
+
+: ?.-  dup 0 < if [char] - emit negate then ;
+
+: digit   [char] 0 + emit ;
+
+: (.)   base @ /mod  ?dup if recurse then  digit ;
+
+: ." ( "string<quote>" -- )   postpone s"  postpone type ; immediate
+
+: . ( x -- )   ?.- (.) space ;
+
+: postpone-number ( caddr -- )
+    0 0 rot count >number dup 0= if
+	2drop nip
+	postpone (literal)  postpone (literal)  postpone ,
+	postpone literal  postpone ,
+    else
+	." Undefined: " type cr abort
+    then ;
+
+' postpone-number  postponers cell+  !
+
+: / ( x y -- x/y )   /mod nip ;
+
+: 0< ( n -- flag )   0 < ;
+
+: 1- ( n -- n-1 )   -1 + ;
+
+: 2! ( x1 x2 addr -- )   swap over ! cell+ ! ;
+
+: 2* ( n -- 2n )   dup + ;
+
+\ Kernel: 2/
+
+: 2@ ( addr -- x1 x2 )   dup cell+ @ swap @ ;
+
+\ Kernel: 2drop
+\ Kernel: 2dup
+
+\ TODO: 2over ( x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2 )
+\           3 pick 3 pick ;
+
+\ TODO: 2swap
+
+\ TODO: <#
+
+: abs ( n -- |n| )
+    dup 0< if negate then ;
+
+\ TODO: accept
+
+: c, ( n -- )
+    here c!  1 chars allot ;
+
+: char+ ( n1 -- n2 )
+    1+ ;
+
+: constant   create , does> @ ;
+
+: decimal ( -- )
+    10 base ! ;
+
+: depth ( -- n )
+    data_stack 100 cells +  'SP @  - /cell /  2 - ;
+
+: do ( n1 n2 -- ) ( R: -- loop-sys ) ( C: -- do-sys )
+    postpone 2>r  here ; immediate
+
+\ TODO: environment?
+\ TODO: evaluate
+\ TODO: fill
+\ TODO: fm/mod )
+\ TODO: hold
+
+: j ( -- x1 ) ( R: x1 x2 x3 -- x1 x2 x3 )
+    'RP @ 3 cells + @ ;
+
+\ TODO: leave
+
+: loop ( -- ) ( C: nest-sys -- )
+    postpone 1  postpone (+loop)
+    postpone 0branch  ,
+    postpone unloop ; immediate
+
+: lshift   begin ?dup while 1- swap dup + swap repeat ;
+
+: rshift   1 begin over while dup + swap 1- swap repeat nip
+           2>r 0 1 begin r@ while
+              r> r> 2dup swap dup + 2>r and if swap over + swap then dup +
+           repeat r> r> 2drop drop ;
+
+: max ( x y -- max[x,y] )
+    2dup > if drop else nip then ;
+
+\ Kernel: min
+\ TODO:   mod
+\ TODO:   move
+
+: (quit) ( R: ... -- )
+    return_stack 100 cells + 'RP !
+    0 'source-id !  tib ''source !  #tib ''#source !
+    postpone [
+    begin
+	refill
+    while
+	interpret  state @ 0= if ." ok" cr then
+    repeat
+    bye ;
+
+' (quit)  ' quit >body cell+  !
+
+\ TODO: s>d
+\ TODO: sign
+\ TODO: sm/rem
+
+: spaces ( n -- )
+    0 do space loop ;
+
+\ TODO: u.
+
+: signbit ( -- n )   -1 1 rshift invert ;
+
+: xor ( x y -- x^y )    2dup nand >r r@ nand swap r> nand nand ;
+
+: u<  ( x y -- flag )  signbit xor swap signbit xor > ;
+
+\ TODO: um/mod
+
+: variable ( "word" -- )
+    create /cell allot ;
+
+: ['] \ ( C: "word" -- )
+    ' postpone literal ; immediate
diff --git a/samples/GLSL/recurse1.fs b/samples/GLSL/recurse1.fs
new file mode 100644
index 00000000..66b4c3fe
--- /dev/null
+++ b/samples/GLSL/recurse1.fs
@@ -0,0 +1,48 @@
+#version 330 core
+
+// cross-unit recursion
+
+void main() {}
+
+// two-level recursion
+
+float cbar(int);
+
+void cfoo(float)
+{
+	cbar(2);
+}
+
+// four-level, out of order
+
+void CB();
+void CD();
+void CA() { CB(); }
+void CC() { CD(); }
+
+// high degree
+
+void CBT();
+void CDT();
+void CAT() { CBT(); CBT(); CBT(); }
+void CCT() { CDT(); CDT(); CBT(); }
+
+// not recursive
+
+void norA() {}
+void norB() { norA(); }
+void norC() { norA(); }
+void norD() { norA(); }
+void norE() { norB(); }
+void norF() { norB(); }
+void norG() { norE(); }
+void norH() { norE(); }
+void norI() { norE(); }
+
+// not recursive, but with a call leading into a cycle if ignoring direction
+
+void norcA() { }
+void norcB() { norcA(); }
+void norcC() { norcB(); }
+void norcD() { norcC(); norcB(); } // head of cycle
+void norcE() { norcD(); } // lead into cycle
diff --git a/test/test_heuristics.rb b/test/test_heuristics.rb
index 40713ca7..e367a118 100644
--- a/test/test_heuristics.rb
+++ b/test/test_heuristics.rb
@@ -127,4 +127,14 @@ class TestHeuristcs < Test::Unit::TestCase
     results = Heuristics.disambiguate_sc(fixture("Scala/node11.sc"))
     assert_equal Language["Scala"], results.first
   end
+
+  def test_fs_by_heuristics
+    languages = ["F#", "Forth", "GLSL"]
+    languages.each do |language|
+      all_fixtures(language).each do |fixture|
+        results = Heuristics.disambiguate_fs(fixture("#{language}/#{File.basename(fixture)}"))
+        assert_equal Language[language], results.first
+      end
+    end
+  end
 end