mirror of
https://github.com/KevinMidboe/linguist.git
synced 2025-10-29 01:30:22 +00:00
Add F# and GLSL samples. Add Forth and GLSL extension .fs.
Add heuristic to disambiguate between F#, Forth, and GLSL.
This commit is contained in:
Lars Brinkhoff
@@ -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
|
||||
|
||||
@@ -819,6 +819,7 @@ Forth:
|
||||
- .for
|
||||
- .forth
|
||||
- .frt
|
||||
- .fs
|
||||
|
||||
Frege:
|
||||
type: programming
|
||||
@@ -872,6 +873,7 @@ GLSL:
|
||||
- .fp
|
||||
- .frag
|
||||
- .frg
|
||||
- .fs
|
||||
- .fshader
|
||||
- .geo
|
||||
- .geom
|
||||
|
||||
15
samples/F#/sample.fs
Normal file
15
samples/F#/sample.fs
Normal file
@@ -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 ","
|
||||
252
samples/Forth/core.fs
Normal file
252
samples/Forth/core.fs
Normal file
@@ -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
|
||||
48
samples/GLSL/recurse1.fs
Normal file
48
samples/GLSL/recurse1.fs
Normal file
@@ -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
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user