Merge pull request #1075 from github/release-2.10.12

cut a 2.10.12 release

.travis.yml

@@ -1,6 +1,5 @@
 before_install: 
   - sudo apt-get install libicu-dev -y
-  # Short-term fix addressing https://github.com/bundler/bundler/issues/2784
   - gem update --system 2.1.11
 rvm:
   - 1.8.7

README.md

@@ -6,12 +6,9 @@ We use this library at GitHub to detect blob languages, highlight code, ignore b
 
 ### Language detection
 
-Linguist defines a list of all languages known to GitHub in a [yaml file](https://github.com/github/linguist/blob/master/lib/linguist/languages.yml). In order for a file to be highlighted, a language and lexer must be defined there.
+Linguist defines a list of all languages known to GitHub in a [yaml file](https://github.com/github/linguist/blob/master/lib/linguist/languages.yml). In order for a file to be highlighted, a language and a lexer must be defined there.
 
-Most languages are detected by their file extension. This is the fastest and most common situation.
-
-For disambiguating between files with common extensions, we first apply
-some common-sense heuristics to pick out obvious languages. After that, we use a
+Most languages are detected by their file extension. For disambiguating between files with common extensions, we first apply some common-sense heuristics to pick out obvious languages. After that, we use a
 [statistical
 classifier](https://github.com/github/linguist/blob/master/lib/linguist/classifier.rb).
 This process can help us tell the difference between, for example, `.h` files which could be either C, C++, or Obj-C.
@@ -31,7 +28,7 @@ The actual syntax highlighting is handled by our Pygments wrapper, [pygments.rb]
 
 ### Stats
 
-The Language stats bar that you see on every repository is built by aggregating the languages of each file in that repository. The top language in the graph determines the project's primary language. Collectively, these stats make up the [Top Languages](https://github.com/languages) page.
+The Language stats bar that you see on every repository is built by aggregating the languages of each file in that repository. The top language in the graph determines the project's primary language.
 
 The repository stats API, accessed through `#languages`, can be used on a directory:
 

github-linguist.gemspec

@@ -1,6 +1,6 @@
 Gem::Specification.new do |s|
   s.name    = 'github-linguist'
-  s.version = '2.10.11'
+  s.version = '2.10.12'
   s.summary = "GitHub Language detection"
   s.description = 'We use this library at GitHub to detect blob languages, highlight code, ignore binary files, suppress generated files in diffs, and generate language breakdown graphs.'
 

lib/linguist/generated.rb

@@ -62,7 +62,8 @@ module Linguist
         generated_protocol_buffer? ||
         generated_jni_header? ||
         composer_lock? ||
-        node_modules?
+        node_modules? ||
+        vcr_cassette?
     end
 
     # Internal: Is the blob an XCode project file?
@@ -235,5 +236,15 @@ module Linguist
     def composer_lock?
       !!name.match(/composer.lock/)
     end
+
+    # Is the blob a VCR Cassette file?
+    #
+    # Returns true or false
+    def vcr_cassette?
+      return false unless extname == '.yml'
+      return false unless lines.count > 2
+      # VCR Cassettes have "recorded_with: VCR" in the second last line.
+      return lines[-2].include?("recorded_with: VCR")
+    end
   end
 end

lib/linguist/heuristics.rb

@@ -19,9 +19,15 @@ module Linguist
         if languages.all? { |l| ["Perl", "Prolog"].include?(l) }
           disambiguate_pl(data, languages)
         end
+        if languages.all? { |l| ["ECL", "Prolog"].include?(l) }
+          disambiguate_ecl(data, languages)
+        end
         if languages.all? { |l| ["TypeScript", "XML"].include?(l) }
           disambiguate_ts(data, languages)
         end
+        if languages.all? { |l| ["Common Lisp", "OpenCL"].include?(l) }
+          disambiguate_cl(data, languages)
+        end
       end
     end
 
@@ -43,6 +49,13 @@ module Linguist
       matches
     end
 
+    def self.disambiguate_ecl(data, languages)
+      matches = []
+      matches << Language["Prolog"] if data.include?(":-")
+      matches << Language["ECL"] if data.include?(":=")
+      matches
+    end
+
     def self.disambiguate_ts(data, languages)
       matches = []
       if (data.include?("</translation>"))
@@ -53,6 +66,13 @@ module Linguist
       matches
     end
 
+    def self.disambiguate_cl(data, languages)
+      matches = []
+      matches << Language["Common Lisp"] if data.include?("(defun ")
+      matches << Language["OpenCL"] if /\/\* |\/\/ |^\}/.match(data)
+      matches
+    end
+
     def self.active?
       !!ACTIVE
     end

lib/linguist/languages.yml

@@ -53,6 +53,18 @@ ASP:
   - .aspx
   - .axd
 
+ATS:
+  type: programming
+  color: "#1ac620"
+  primary_extension: .dats
+  lexer: OCaml
+  aliases:
+  - ats2
+  extensions:
+  - .atxt
+  - .hats
+  - .sats
+
 ActionScript:
   type: programming
   lexer: ActionScript 3
@@ -92,6 +104,8 @@ AppleScript:
   primary_extension: .applescript
   extensions:
   - .scpt
+  interpreters:
+  - osascript
 
 Arc:
   type: programming
@@ -214,6 +228,7 @@ C:
   color: "#555"
   primary_extension: .c
   extensions:
+  - .cats
   - .w
 
 C#:
@@ -239,6 +254,7 @@ C++:
   extensions:
   - .C
   - .c++
+  - .cc
   - .cxx
   - .H
   - .h++
@@ -296,6 +312,16 @@ ChucK:
   lexer: Java
   primary_extension: .ck
 
+Cirru:
+  type: programming
+  color: "#aaaaff"
+  primary_extension: .cirru
+  # ace_mode: cirru
+  # lexer: Cirru
+  lexer: Text only
+  extensions:
+  - .cr
+
 Clean:
   type: programming
   color: "#3a81ad"
@@ -316,6 +342,7 @@ Clojure:
   - .cljscm
   - .cljx
   - .hic
+  - .cljs.hl
   filenames:
   - riemann.config
 
@@ -333,6 +360,8 @@ CoffeeScript:
   - .iced
   filenames:
   - Cakefile
+  interpreters:
+  - coffee
 
 ColdFusion:
   type: programming
@@ -463,6 +492,9 @@ Dylan:
   type: programming
   color: "#3ebc27"
   primary_extension: .dylan
+  extensions:
+  - .intr
+  - .lid
 
 Ecere Projects:
   type: data
@@ -528,6 +560,14 @@ F#:
   - .fsi
   - .fsx
 
+FLUX:
+  type: programming
+  color: "#33CCFF"
+  primary_extension: .fx
+  lexer: Text only
+  extensions:
+  - .flux
+
 FORTRAN:
   type: programming
   lexer: Fortran
@@ -566,7 +606,7 @@ Fancy:
   - .fancypack
   filenames:
   - Fakefile
-
+  
 Fantom:
   type: programming
   color: "#dbded5"
@@ -653,6 +693,8 @@ Groovy:
   ace_mode: groovy
   color: "#e69f56"
   primary_extension: .groovy
+  interpreters:
+  - groovy
 
 Groovy Server Pages:
   group: Groovy
@@ -670,6 +712,7 @@ HTML:
   extensions:
   - .htm
   - .xhtml
+  - .html.hl
 
 HTML+Django:
   type: markup
@@ -723,7 +766,7 @@ Harbour:
   lexer: Text only
   color: "#0e60e3"
   primary_extension: .hb
- 
+
 Haskell:
   type: programming
   color: "#29b544"
@@ -818,6 +861,13 @@ JSON5:
   lexer: JavaScript
   primary_extension: .json5
 
+JSONLD:
+  type: data
+  group: JavaScript
+  ace_mode: json
+  lexer: JavaScript
+  primary_extension: .jsonld
+
 Jade:
   group: HTML
   type: markup
@@ -848,6 +898,7 @@ JavaScript:
   extensions:
   - ._js
   - .bones
+  - .es6
   - .jake
   - .jsfl
   - .jsm
@@ -1005,6 +1056,13 @@ Markdown:
   - .mkdown
   - .ron
 
+Mask:
+  type: markup
+  lexer: SCSS
+  color: "#f97732"
+  ace_mode: scss
+  primary_extension: .mask
+
 Matlab:
   type: programming
   color: "#bb92ac"
@@ -1184,7 +1242,7 @@ PAWN:
   lexer: C++
   color: "#dbb284"
   primary_extension: .pwn
-  
+
 PHP:
   type: programming
   ace_mode: php
@@ -1307,7 +1365,8 @@ Prolog:
   type: programming
   color: "#74283c"
   primary_extension: .prolog
-  extensions: 
+  extensions:
+  - .ecl
   - .pl
 
 Protocol Buffer:
@@ -1372,6 +1431,7 @@ R:
   primary_extension: .r
   extensions:
   - .R
+  - .rsx
   filenames:
   - .Rprofile
   interpreters:
@@ -1485,6 +1545,7 @@ Ruby:
   - Appraisals
   - Berksfile
   - Gemfile
+  - Gemfile.lock
   - Guardfile
   - Podfile
   - Thorfile
@@ -1536,6 +1597,7 @@ Scheme:
   color: "#1e4aec"
   primary_extension: .scm
   extensions:
+  - .sld
   - .sls
   - .ss
   interpreters:
@@ -1574,6 +1636,12 @@ Shell:
   filenames:
   - Dockerfile
 
+Shen:
+  type: programming
+  color: "#120F14"
+  lexer: Text only
+  primary_extension: .shen
+
 Slash:
   type: programming
   color: "#007eff"
@@ -1790,6 +1858,7 @@ XML:
   - .kml
   - .launch
   - .mxml
+  - .osm
   - .plist
   - .pluginspec
   - .ps1xml

lib/linguist/vendor.yml

@@ -47,6 +47,9 @@
 # Debian packaging
 - ^debian/
 
+# Haxelib projects often contain a neko bytecode file named run.n
+- run.n$
+
 ## Commonly Bundled JavaScript frameworks ##
 
 # jQuery
@@ -63,6 +66,9 @@
 - (^|/)controls\.js$
 - (^|/)dragdrop\.js$
 
+# Typescript definition files
+- (.*?)\.d\.ts$
+
 # MooTools
 - (^|/)mootools([^.]*)\d+\.\d+.\d+([^.]*)\.js$
 
@@ -111,6 +117,13 @@
 # Sparkle
 - (^|/)Sparkle/
 
+## Groovy ##
+
+# Gradle
+- (^|/)gradlew$
+- (^|/)gradlew\.bat$
+- (^|/)gradle/wrapper/
+
 ## .NET ##
 
 # Visual Studio IntelliSense

samples/ATS/CoYonedaLemma.dats

@@ -0,0 +1,110 @@
+(* ****** ****** *)
+//
+// HX-2014-01
+// CoYoneda Lemma:
+//
+(* ****** ****** *)
+//
+#include
+"share/atspre_staload.hats"
+//
+(* ****** ****** *)
+
+staload
+"libats/ML/SATS/basis.sats"
+staload
+"libats/ML/SATS/list0.sats"
+
+(* ****** ****** *)
+
+staload _ = "libats/ML/DATS/list0.dats"
+
+(* ****** ****** *)
+
+sortdef ftype = type -> type
+
+(* ****** ****** *)
+
+infixr (->) ->>
+typedef ->> (a:type, b:type) = a -<cloref1> b
+
+(* ****** ****** *)
+
+typedef
+functor(F:ftype) =
+  {a,b:type} (a ->> b) ->> F(a) ->> F(b)
+
+(* ****** ****** *)
+
+typedef
+list0 (a:type) = list0 (a)
+extern
+val functor_list0 : functor (list0)
+
+(* ****** ****** *)
+
+implement
+functor_list0{a,b}
+  (f) = lam xs => list0_map<a><b> (xs, f)
+
+(* ****** ****** *)
+
+datatype
+CoYoneda
+ (F:ftype, r:type) = {a:type} CoYoneda of (a ->> r, F(a))
+// end of [CoYoneda]
+
+(* ****** ****** *)
+//
+extern
+fun CoYoneda_phi
+  : {F:ftype}functor(F) -> {r:type} (F (r) ->> CoYoneda (F, r))
+extern
+fun CoYoneda_psi
+  : {F:ftype}functor(F) -> {r:type} (CoYoneda (F, r) ->> F (r))
+//
+(* ****** ****** *)
+
+implement
+CoYoneda_phi(ftor) = lam (fx) => CoYoneda (lam x => x, fx)
+implement
+CoYoneda_psi(ftor) = lam (CoYoneda(f, fx)) => ftor (f) (fx)
+
+(* ****** ****** *)
+
+datatype int0 = I of (int)
+datatype bool = True | False // boxed boolean
+
+(* ****** ****** *)
+//
+fun bool2string
+  (x:bool): string =
+(
+  case+ x of True() => "True" | False() => "False"
+)
+//
+implement
+fprint_val<bool> (out, x) = fprint (out, bool2string(x))
+//
+(* ****** ****** *)
+
+fun int2bool (i: int0): bool =
+  let val+I(i) = i in if i > 0 then True else False end
+
+(* ****** ****** *)
+
+val myintlist0 = g0ofg1($list{int0}((I)1, (I)0, (I)1, (I)0, (I)0))
+val myboolist0 = CoYoneda{list0,bool}{int0}(lam (i) => int2bool(i), myintlist0)
+val myboolist0 = CoYoneda_psi{list0}(functor_list0){bool}(myboolist0)
+
+(* ****** ****** *)
+
+val ((*void*)) = fprintln! (stdout_ref, "myboolist0 = ", myboolist0)
+
+(* ****** ****** *)
+
+implement main0 () = ()
+
+(* ****** ****** *)
+
+(* end of [CoYonedaLemma.dats] *)

samples/ATS/DiningPhil2.dats

@@ -0,0 +1,178 @@
+(* ****** ****** *)
+//
+// HX-2013-11
+//
+// Implementing a variant of
+// the problem of Dining Philosophers
+//
+(* ****** ****** *)
+//
+#include
+"share/atspre_define.hats"
+#include
+"share/atspre_staload.hats"
+//
+(* ****** ****** *)
+
+staload
+UN = "prelude/SATS/unsafe.sats"
+
+(* ****** ****** *)
+
+staload "libc/SATS/stdlib.sats"
+staload "libc/SATS/unistd.sats"
+
+(* ****** ****** *)
+
+staload "{$LIBATSHWXI}/teaching/mythread/SATS/channel.sats"
+
+(* ****** ****** *)
+
+staload _ = "libats/DATS/deqarray.dats"
+staload _ = "{$LIBATSHWXI}/teaching/mythread/DATS/channel.dats"
+
+(* ****** ****** *)
+
+staload "./DiningPhil2.sats"
+
+(* ****** ****** *)
+
+implement phil_left (n) = n
+implement phil_right (n) = (n+1) \nmod NPHIL
+
+(* ****** ****** *)
+//
+extern
+fun randsleep (n: intGte(1)): void
+//
+implement
+randsleep (n) =
+  ignoret (sleep($UN.cast{uInt}(rand() mod n + 1)))
+// end of [randsleep]
+//
+(* ****** ****** *)
+
+implement
+phil_think (n) =
+{
+val () = println! ("phil_think(", n, ") starts")
+val () = randsleep (6)
+val () = println! ("phil_think(", n, ") finishes")
+}
+
+(* ****** ****** *)
+
+implement
+phil_dine (n, lf, rf) =
+{
+val () = println! ("phil_dine(", n, ") starts")
+val () = randsleep (3)
+val () = println! ("phil_dine(", n, ") finishes")
+}
+
+(* ****** ****** *)
+
+implement
+phil_loop (n) = let
+//
+val () = phil_think (n)
+//
+val nl = phil_left (n)
+val nr = phil_right (n)
+//
+val ch_lfork = fork_changet (nl)
+val ch_rfork = fork_changet (nr)
+//
+val lf = channel_takeout (ch_lfork)
+val () = println! ("phil_loop(", n, ") picks left fork")
+//
+val () = randsleep (2) // HX: try to actively induce deadlock
+//
+val rf = channel_takeout (ch_rfork)
+val () = println! ("phil_loop(", n, ") picks right fork")
+//
+val () = phil_dine (n, lf, rf)
+//
+val ch_forktray = forktray_changet ()
+val () = channel_insert (ch_forktray, lf)
+val () = channel_insert (ch_forktray, rf)
+//
+in
+  phil_loop (n)
+end // end of [phil_loop]
+
+(* ****** ****** *)
+
+implement
+cleaner_wash (f) =
+{
+val f = fork_get_num (f)
+val () = println! ("cleaner_wash(", f, ") starts")
+val () = randsleep (1)
+val () = println! ("cleaner_wash(", f, ") finishes")
+}
+
+(* ****** ****** *)
+
+implement
+cleaner_return (f) =
+{
+  val n = fork_get_num (f)
+  val ch = fork_changet (n)
+  val () = channel_insert (ch, f)
+}
+
+(* ****** ****** *)
+
+implement
+cleaner_loop () = let
+//
+val ch = forktray_changet ()
+val f0 = channel_takeout (ch)
+//
+val () = cleaner_wash (f0)
+val () = cleaner_return (f0)
+//
+in
+  cleaner_loop ()
+end // end of [cleaner_loop]
+
+(* ****** ****** *)
+
+dynload "DiningPhil2.sats"
+dynload "DiningPhil2_fork.dats"
+dynload "DiningPhil2_thread.dats"
+
+(* ****** ****** *)
+
+local
+//
+staload
+"{$LIBATSHWXI}/teaching/mythread/SATS/mythread.sats"
+//
+in (* in of [local] *)
+//
+val () = mythread_create_cloptr (llam () => phil_loop (0))
+val () = mythread_create_cloptr (llam () => phil_loop (1))
+val () = mythread_create_cloptr (llam () => phil_loop (2))
+val () = mythread_create_cloptr (llam () => phil_loop (3))
+val () = mythread_create_cloptr (llam () => phil_loop (4))
+//
+val () = mythread_create_cloptr (llam () => cleaner_loop ())
+//
+end // end of [local]
+
+(* ****** ****** *)
+
+implement
+main0 () =
+{
+//
+val () = println! ("DiningPhil2: starting")
+val ((*void*)) = while (true) ignoret (sleep(1))
+//
+} (* end of [main0] *)
+
+(* ****** ****** *)
+
+(* end of [DiningPhil2.dats] *)

samples/ATS/DiningPhil2.sats

@@ -0,0 +1,71 @@
+(* ****** ****** *)
+//
+// HX-2013-11
+//
+// Implementing a variant of
+// the problem of Dining Philosophers
+//
+(* ****** ****** *)
+
+#include
+"share/atspre_define.hats"
+
+(* ****** ****** *)
+
+staload "{$LIBATSHWXI}/teaching/mythread/SATS/channel.sats"
+
+(* ****** ****** *)
+
+%{#
+#define NPHIL 5
+%} // end of [%{#]
+#define NPHIL 5
+
+(* ****** ****** *)
+
+typedef nphil = natLt(NPHIL)
+
+(* ****** ****** *)
+
+fun phil_left (n: nphil): nphil
+fun phil_right (n: nphil): nphil
+
+(* ****** ****** *)
+//
+fun phil_loop (n: nphil): void
+//
+(* ****** ****** *)
+
+fun cleaner_loop ((*void*)): void
+
+(* ****** ****** *)
+
+absvtype fork_vtype = ptr
+vtypedef fork = fork_vtype
+
+(* ****** ****** *)
+
+fun fork_get_num (!fork): nphil
+
+(* ****** ****** *)
+
+fun phil_dine
+  (n: nphil, lf: !fork, rf: !fork): void
+// end of [phil_dine]
+
+fun phil_think (n: nphil): void
+
+(* ****** ****** *)
+
+fun cleaner_wash (f: !fork): void
+fun cleaner_return (f: fork): void
+
+(* ****** ****** *)
+//
+fun fork_changet (n: nphil): channel(fork)
+//
+fun forktray_changet ((*void*)): channel(fork)
+//
+(* ****** ****** *)
+
+(* end of [DiningPhil2.sats] *)

samples/ATS/DiningPhil2_fork.dats

@@ -0,0 +1,89 @@
+(* ****** ****** *)
+//
+// HX-2013-11
+//
+// Implementing a variant of
+// the problem of Dining Philosophers
+//
+(* ****** ****** *)
+//
+#include
+"share/atspre_define.hats"
+#include
+"share/atspre_staload.hats"
+//
+(* ****** ****** *)
+
+staload
+UN = "prelude/SATS/unsafe.sats"
+
+(* ****** ****** *)
+
+staload "{$LIBATSHWXI}/teaching/mythread/SATS/channel.sats"
+
+(* ****** ****** *)
+
+staload _ = "libats/DATS/deqarray.dats"
+staload _ = "{$LIBATSHWXI}/teaching/mythread/DATS/channel.dats"
+
+(* ****** ****** *)
+
+staload "./DiningPhil2.sats"
+
+(* ****** ****** *)
+
+datavtype fork = FORK of (nphil)
+
+(* ****** ****** *)
+
+assume fork_vtype = fork
+
+(* ****** ****** *)
+
+implement
+fork_get_num (f) = let val FORK(n) = f in n end
+
+(* ****** ****** *)
+
+local
+
+val
+the_forkarray = let
+//
+typedef t = channel(fork)
+//
+implement
+array_tabulate$fopr<t>
+  (n) = ch where
+{
+  val n = $UN.cast{nphil}(n)
+  val ch = channel_create_exn<fork> (i2sz(2))
+  val () = channel_insert (ch, FORK (n))
+}
+//
+in
+  arrayref_tabulate<t> (i2sz(NPHIL))
+end // end of [val]
+
+in (* in of [local] *)
+
+implement fork_changet (n) = the_forkarray[n]
+
+end // end of [local]
+
+(* ****** ****** *)
+
+local
+
+val the_forktray =
+  channel_create_exn<fork> (i2sz(NPHIL+1))
+
+in (* in of [local] *)
+
+implement forktray_changet () = the_forktray
+
+end // end of [local]
+
+(* ****** ****** *)
+
+(* end of [DiningPhil2_fork.dats] *)

samples/ATS/DiningPhil2_thread.dats

@@ -0,0 +1,43 @@
+(* ****** ****** *)
+//
+// HX-2013-11
+//
+// Implementing a variant of
+// the problem of Dining Philosophers
+//
+(* ****** ****** *)
+//
+#include "share/atspre_define.hats"
+#include "share/atspre_staload.hats"
+//
+(* ****** ****** *)
+
+staload "{$LIBATSHWXI}/teaching/mythread/SATS/mythread.sats"
+
+(* ****** ****** *)
+
+local
+//
+#include "{$LIBATSHWXI}/teaching/mythread/DATS/mythread.dats"
+//
+in (* in of [local] *)
+//
+// HX: it is intentionally left to be empty
+//
+end // end of [local]
+
+(* ****** ****** *)
+
+local
+//
+#include "{$LIBATSHWXI}/teaching/mythread/DATS/mythread_posix.dats"
+//
+in (* in of [local] *)
+//
+// HX: it is intentionally left to be empty
+//
+end // end of [local]
+
+(* ****** ****** *)
+
+(* end of [DiningPhil2_thread.dats] *)

samples/ATS/YonedaLemma.dats

@@ -0,0 +1,178 @@
+(* ****** ****** *)
+//
+// HX-2014-01
+// Yoneda Lemma:
+// The hardest "trivial" theorem :)
+//
+(* ****** ****** *)
+//
+#include
+"share/atspre_staload.hats"
+//
+(* ****** ****** *)
+
+staload
+"libats/ML/SATS/basis.sats"
+staload
+"libats/ML/SATS/list0.sats"
+staload
+"libats/ML/SATS/option0.sats"
+
+(* ****** ****** *)
+
+staload _ = "libats/ML/DATS/list0.dats"
+staload _ = "libats/ML/DATS/option0.dats"
+
+(* ****** ****** *)
+
+sortdef ftype = type -> type
+
+(* ****** ****** *)
+
+infixr (->) ->>
+typedef ->> (a:type, b:type) = a -<cloref1> b
+
+(* ****** ****** *)
+
+typedef
+functor(F:ftype) =
+  {a,b:type} (a ->> b) ->> F(a) ->> F(b)
+
+(* ****** ****** *)
+
+typedef
+list0 (a:type) = list0 (a)
+extern
+val functor_list0 : functor (list0)
+
+(* ****** ****** *)
+
+implement
+functor_list0{a,b}
+  (f) = lam xs => list0_map<a><b> (xs, f)
+
+(* ****** ****** *)
+
+typedef
+option0 (a:type) = option0 (a)  
+extern
+val functor_option0 : functor (option0)
+  
+(* ****** ****** *)
+
+implement
+functor_option0{a,b}
+  (f) = lam opt => option0_map<a><b> (opt, f)
+
+(* ****** ****** *)
+
+extern
+val functor_homres
+  : {c:type} functor (lam(r:type) => c ->> r)
+
+(* ****** ****** *)
+
+implement
+functor_homres{c}{a,b} (f) = lam (r) => lam (x) => f (r(x))
+
+(* ****** ****** *)
+//
+extern
+fun Yoneda_phi : {F:ftype}functor(F) ->
+  {a:type}F(a) ->> ({r:type}(a ->> r) ->> F(r))
+extern
+fun Yoneda_psi : {F:ftype}functor(F) ->
+  {a:type}({r:type}(a ->> r) ->> F(r)) ->> F(a)
+//
+(* ****** ****** *)
+//
+implement
+Yoneda_phi
+  (ftor) = lam(fx) => lam (m) => ftor(m)(fx)
+//
+implement
+Yoneda_psi (ftor) = lam(mf) => mf(lam x => x)
+//
+(* ****** ****** *)
+
+(*
+
+(* ****** ****** *)
+//
+// HX-2014-01-05:
+// Another version based on Natural Transformation
+//
+(* ****** ****** *)
+
+typedef
+natrans(F:ftype, G:ftype) = {x:type} (F(x) ->> G(x))
+
+(* ****** ****** *)
+//
+extern
+fun Yoneda_phi_nat : {F:ftype}functor(F) ->
+  {a:type} F(a) ->> natrans(lam (r:type) => (a ->> r), F)
+extern
+fun Yoneda_psi_nat : {F:ftype}functor(F) ->
+  {a:type} natrans(lam (r:type) => (a ->> r), F) ->> F(a)
+//
+(* ****** ****** *)
+//
+implement
+Yoneda_phi_nat
+  (ftor) = lam(fx) => lam (m) => ftor(m)(fx)
+//
+implement
+Yoneda_psi_nat (ftor) = lam(mf) => mf(lam x => x)
+//
+(* ****** ****** *)
+
+*)
+
+(* ****** ****** *)
+
+datatype bool = True | False // boxed boolean
+
+(* ****** ****** *)
+//
+fun bool2string
+  (x:bool): string =
+(
+  case+ x of True() => "True" | False() => "False"
+)
+//
+implement
+fprint_val<bool> (out, x) = fprint (out, bool2string(x))
+//
+(* ****** ****** *)
+//
+val myboolist0 =
+  $list_t{bool}(True, False, True, False, False)
+val myboolist0 = g0ofg1_list (myboolist0)
+//
+(* ****** ****** *)
+//
+extern
+val Yoneda_bool_list0 : {r:type} (bool ->> r) ->> list0(r)
+//
+implement
+Yoneda_bool_list0 =
+  Yoneda_phi(functor_list0){bool}(myboolist0)
+//
+(* ****** ****** *)
+//
+val myboolist1 =
+  Yoneda_psi(functor_list0){bool}(Yoneda_bool_list0)
+//
+(* ****** ****** *)
+
+val () = fprintln! (stdout_ref, "myboolist0 = ", myboolist0)
+val () = fprintln! (stdout_ref, "myboolist1 = ", myboolist1)
+
+(* ****** ****** *)
+
+implement main0 () = ()
+
+(* ****** ****** *)
+
+(* end of [YonedaLemma.dats] *)

samples/ATS/linset.hats

@@ -0,0 +1,187 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                         Applied Type System                         *)
+(*                                                                     *)
+(***********************************************************************)
+
+(*
+** ATS/Postiats - Unleashing the Potential of Types!
+** Copyright (C) 2011-2013 Hongwei Xi, ATS Trustful Software, Inc.
+** All rights reserved
+**
+** ATS is free software;  you can  redistribute it and/or modify it under
+** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
+** Free Software Foundation; either version 3, or (at  your  option)  any
+** later version.
+** 
+** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
+** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
+** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
+** for more details.
+** 
+** You  should  have  received  a  copy of the GNU General Public License
+** along  with  ATS;  see the  file COPYING.  If not, please write to the
+** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
+** 02110-1301, USA.
+*)
+
+(* ****** ****** *)
+
+(* Author: Hongwei Xi *)
+(* Authoremail: hwxi AT cs DOT bu DOT edu *)
+(* Start time: December, 2012 *)
+
+(* ****** ****** *)
+//
+// HX: shared by linset_listord (* ordered list *)
+// HX: shared by linset_avltree (* AVL-tree-based *)
+//
+(* ****** ****** *)
+//
+// HX-2013-02:
+// for sets of nonlinear elements
+//
+absvtype set_vtype (a:t@ype+) = ptr
+//
+(* ****** ****** *)
+
+vtypedef set (a:t0p) = set_vtype (a)
+
+(* ****** ****** *)
+
+fun{a:t0p}
+compare_elt_elt (x1: a, x2: a):<> int
+
+(* ****** ****** *)
+
+fun{} linset_nil{a:t0p} ():<> set(a)
+fun{} linset_make_nil{a:t0p} ():<> set(a)
+
+(* ****** ****** *)
+
+fun{a:t0p} linset_sing (x: a):<!wrt> set(a)
+fun{a:t0p} linset_make_sing (x: a):<!wrt> set(a)
+
+(* ****** ****** *)
+
+fun{a:t0p}
+linset_make_list (xs: List(INV(a))):<!wrt> set(a)
+
+(* ****** ****** *)
+
+fun{}
+linset_is_nil {a:t0p} (xs: !set(INV(a))):<> bool
+fun{}
+linset_isnot_nil {a:t0p} (xs: !set(INV(a))):<> bool
+
+(* ****** ****** *)
+
+fun{a:t0p} linset_size (!set(INV(a))): size_t
+
+(* ****** ****** *)
+
+fun{a:t0p}
+linset_is_member (xs: !set(INV(a)), x0: a):<> bool
+fun{a:t0p}
+linset_isnot_member (xs: !set(INV(a)), x0: a):<> bool
+
+(* ****** ****** *)
+
+fun{a:t0p}
+linset_copy (!set(INV(a))):<!wrt> set(a)
+fun{a:t0p}
+linset_free (xs: set(INV(a))):<!wrt> void
+
+(* ****** ****** *)
+//
+fun{a:t0p}
+linset_insert
+  (xs: &set(INV(a)) >> _, x0: a):<!wrt> bool
+//
+(* ****** ****** *)
+//
+fun{a:t0p}
+linset_takeout
+(
+  &set(INV(a)) >> _, a, res: &(a?) >> opt(a, b)
+) :<!wrt> #[b:bool] bool(b) // endfun
+fun{a:t0p}
+linset_takeout_opt (&set(INV(a)) >> _, a):<!wrt> Option_vt(a)
+//
+(* ****** ****** *)
+//
+fun{a:t0p}
+linset_remove
+  (xs: &set(INV(a)) >> _, x0: a):<!wrt> bool
+//
+(* ****** ****** *)
+//
+// HX: choosing an element in an unspecified manner
+//
+fun{a:t0p}
+linset_choose
+(
+  xs: !set(INV(a)), x: &a? >> opt (a, b)
+) :<!wrt> #[b:bool] bool(b)
+//
+fun{a:t0p}
+linset_choose_opt (xs: !set(INV(a))):<!wrt> Option_vt(a)
+//
+(* ****** ****** *)
+
+fun{a:t0p}
+linset_takeoutmax
+(
+  xs: &set(INV(a)) >> _, res: &a? >> opt(a, b)
+) :<!wrt> #[b:bool] bool (b)
+fun{a:t0p}
+linset_takeoutmax_opt (xs: &set(INV(a)) >> _):<!wrt> Option_vt(a)
+
+(* ****** ****** *)
+
+fun{a:t0p}
+linset_takeoutmin
+(
+  xs: &set(INV(a)) >> _, res: &a? >> opt(a, b)
+) :<!wrt> #[b:bool] bool (b)
+fun{a:t0p}
+linset_takeoutmin_opt (xs: &set(INV(a)) >> _):<!wrt> Option_vt(a)
+
+(* ****** ****** *)
+//
+fun{}
+fprint_linset$sep (FILEref): void // ", "
+//
+fun{a:t0p}
+fprint_linset (out: FILEref, xs: !set(INV(a))): void
+//
+overload fprint with fprint_linset
+//
+(* ****** ****** *)
+//
+fun{
+a:t0p}{env:vt0p
+} linset_foreach$fwork
+  (x: a, env: &(env) >> _): void
+//
+fun{a:t0p}
+linset_foreach (set: !set(INV(a))): void
+fun{
+a:t0p}{env:vt0p
+} linset_foreach_env
+  (set: !set(INV(a)), env: &(env) >> _): void
+// end of [linset_foreach_env]
+//
+(* ****** ****** *)
+
+fun{a:t0p}
+linset_listize (xs: set(INV(a))): List0_vt (a)
+
+(* ****** ****** *)
+
+fun{a:t0p}
+linset_listize1 (xs: !set(INV(a))): List0_vt (a)
+
+(* ****** ****** *)
+
+(* end of [linset.hats] *)

samples/ATS/linset_listord.dats

@@ -0,0 +1,504 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                         Applied Type System                         *)
+(*                                                                     *)
+(***********************************************************************)
+
+(*
+** ATS/Postiats - Unleashing the Potential of Types!
+** Copyright (C) 2011-2013 Hongwei Xi, ATS Trustful Software, Inc.
+** All rights reserved
+**
+** ATS is free software;  you can  redistribute it and/or modify it under
+** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
+** Free Software Foundation; either version 3, or (at  your  option)  any
+** later version.
+** 
+** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
+** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
+** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
+** for more details.
+** 
+** You  should  have  received  a  copy of the GNU General Public License
+** along  with  ATS;  see the  file COPYING.  If not, please write to the
+** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
+** 02110-1301, USA.
+*)
+
+(* ****** ****** *)
+
+(* Author: Hongwei Xi *)
+(* Authoremail: hwxi AT cs DOT bu DOT edu *)
+(* Start time: February, 2013 *)
+
+(* ****** ****** *)
+//
+// HX-2013-08:
+// a set is represented as a sorted list in descending order;
+// note that descending order is chosen to faciliate set comparison
+//
+(* ****** ****** *)
+
+staload
+UN = "prelude/SATS/unsafe.sats"
+
+(* ****** ****** *)
+
+staload "libats/SATS/linset_listord.sats"
+
+(* ****** ****** *)
+
+#include "./SHARE/linset.hats" // code reuse
+#include "./SHARE/linset_node.hats" // code reuse
+
+(* ****** ****** *)
+
+assume
+set_vtype (elt:t@ype) = List0_vt (elt)
+
+(* ****** ****** *)
+
+implement{}
+linset_nil () = list_vt_nil ()
+implement{}
+linset_make_nil () = list_vt_nil ()
+
+(* ****** ****** *)
+
+implement
+{a}(*tmp*)
+linset_sing
+  (x) = list_vt_cons{a}(x, list_vt_nil)
+// end of [linset_sing]
+implement{a}
+linset_make_sing
+  (x) = list_vt_cons{a}(x, list_vt_nil)
+// end of [linset_make_sing]
+
+(* ****** ****** *)
+
+implement{}
+linset_is_nil (xs) = list_vt_is_nil (xs)
+implement{}
+linset_isnot_nil (xs) = list_vt_is_cons (xs)
+
+(* ****** ****** *)
+
+implement{a}
+linset_size (xs) =
+  let val n = list_vt_length(xs) in i2sz(n) end
+// end of [linset_size]
+
+(* ****** ****** *)
+
+implement{a}
+linset_is_member
+  (xs, x0) = let
+//
+fun aux
+  {n:nat} .<n>.
+(
+  xs: !list_vt (a, n)
+) :<> bool = let
+in
+//
+case+ xs of
+| list_vt_cons (x, xs) => let
+    val sgn = compare_elt_elt<a> (x0, x) in
+    if sgn > 0 then false else (if sgn < 0 then aux (xs) else true)
+  end // end of [list_vt_cons]
+| list_vt_nil ((*void*)) => false
+//
+end // end of [aux]
+//
+in
+  aux (xs)
+end // end of [linset_is_member]
+
+(* ****** ****** *)
+
+implement{a}
+linset_copy (xs) = list_vt_copy<a> (xs)
+implement{a}
+linset_free (xs) = list_vt_free<a> (xs)
+
+(* ****** ****** *)
+
+implement{a}
+linset_insert
+  (xs, x0) = let
+//
+fun
+mynode_cons
+  {n:nat} .<>.
+(
+  nx: mynode1 (a), xs: list_vt (a, n)
+) : list_vt (a, n+1) = let
+//
+val xs1 =
+$UN.castvwtp0{List1_vt(a)}(nx)
+val+@list_vt_cons (_, xs2) = xs1
+prval () = $UN.cast2void (xs2); val () = (xs2 := xs)
+//
+in
+  fold@ (xs1); xs1
+end // end of [mynode_cons]
+//
+fun ins
+  {n:nat} .<n>. // tail-recursive
+(
+  xs: &list_vt (a, n) >> list_vt (a, n1)
+) : #[n1:nat | n <= n1; n1 <= n+1] bool =
+(
+case+ xs of
+| @list_vt_cons
+    (x, xs1) => let
+    val sgn =
+      compare_elt_elt<a> (x0, x)
+    // end of [val]
+  in
+    if sgn > 0 then let
+      prval () = fold@ (xs)
+      val nx = mynode_make_elt<a> (x0)
+      val ((*void*)) = xs := mynode_cons (nx, xs)
+    in
+      false
+    end else if sgn < 0 then let
+      val ans = ins (xs1)
+      prval () = fold@ (xs)
+    in
+      ans
+    end else let // [x0] is found
+      prval () = fold@ (xs)
+    in
+      true (* [x0] in [xs] *)
+    end (* end of [if] *)
+  end // end of [list_vt_cons]
+| list_vt_nil () => let
+    val nx = mynode_make_elt<a> (x0)
+    val ((*void*)) = xs := mynode_cons (nx, xs)
+  in
+    false
+  end // end of [list_vt_nil]
+) (* end of [ins] *)
+//
+in
+  $effmask_all (ins (xs))
+end // end of [linset_insert]
+
+(* ****** ****** *)
+
+(*
+//
+HX-2013-08:
+[linset_remove] moved up
+//
+implement{a}
+linset_remove
+  (xs, x0) = let
+//
+fun rem
+  {n:nat} .<n>. // tail-recursive
+(
+  xs: &list_vt (a, n) >> list_vt (a, n1)
+) : #[n1:nat | n1 <= n; n <= n1+1] bool =
+(
+case+ xs of
+| @list_vt_cons
+    (x, xs1) => let
+    val sgn =
+      compare_elt_elt<a> (x0, x)
+    // end of [val]
+  in
+    if sgn > 0 then let
+      prval () = fold@ (xs)
+    in
+      false
+    end else if sgn < 0 then let
+      val ans = rem (xs1)
+      prval () = fold@ (xs)
+    in
+      ans
+    end else let // x0 = x
+      val xs1_ = xs1
+      val ((*void*)) = free@{a}{0}(xs)
+      val () = xs := xs1_
+    in
+      true // [x0] in [xs]
+    end (* end of [if] *)
+  end // end of [list_vt_cons]
+| list_vt_nil () => false
+) (* end of [rem] *)
+//
+in
+  $effmask_all (rem (xs))
+end // end of [linset_remove]
+*)
+
+(* ****** ****** *)
+(*
+** By Brandon Barker
+*)
+implement
+{a}(*tmp*)
+linset_choose
+  (xs, x0) = let
+in
+//
+case+ xs of
+| list_vt_cons
+    (x, xs1) => let
+    val () = x0 := x
+    prval () = opt_some{a}(x0)
+  in
+    true
+  end // end of [list_vt_cons]
+| list_vt_nil () => let
+    prval () = opt_none{a}(x0)
+  in
+    false
+  end // end of [list_vt_nil]
+//
+end // end of [linset_choose]
+
+(* ****** ****** *)
+
+implement
+{a}{env}
+linset_foreach_env (xs, env) = let
+//
+implement
+list_vt_foreach$fwork<a><env>
+  (x, env) = linset_foreach$fwork<a><env> (x, env)
+//
+in
+  list_vt_foreach_env<a><env> (xs, env)
+end // end of [linset_foreach_env]
+
+(* ****** ****** *)
+
+implement{a}
+linset_listize (xs) = xs
+
+(* ****** ****** *)
+
+implement{a}
+linset_listize1 (xs) = list_vt_copy (xs)
+
+(* ****** ****** *)
+//
+// HX: functions for processing mynodes
+//
+(* ****** ****** *)
+
+implement{
+} mynode_null{a} () =
+  $UN.castvwtp0{mynode(a,null)}(the_null_ptr)
+// end of [mynode_null]
+
+(* ****** ****** *)
+
+implement
+{a}(*tmp*)
+mynode_make_elt
+  (x) = let
+//
+val nx = list_vt_cons{a}{0}(x, _ )
+//
+in
+  $UN.castvwtp0{mynode1(a)}(nx)
+end // end of [mynode_make_elt]
+
+(* ****** ****** *)
+
+implement{
+} mynode_free
+  {a}(nx) = () where {
+val nx =
+  $UN.castvwtp0{List1_vt(a)}(nx)
+//
+val+~list_vt_cons (_, nx2) = nx
+//
+prval ((*void*)) = $UN.cast2void (nx2)
+//
+} (* end of [mynode_free] *)
+
+(* ****** ****** *)
+
+implement
+{a}(*tmp*)
+mynode_get_elt
+  (nx) = (x) where {
+//
+val nx1 =
+  $UN.castvwtp1{List1_vt(a)}(nx)
+//
+val+list_vt_cons (x, _) = nx1
+//
+prval ((*void*)) = $UN.cast2void (nx1)
+//
+} (* end of [mynode_get_elt] *)
+
+(* ****** ****** *)
+
+implement
+{a}(*tmp*)
+mynode_set_elt
+  {l} (nx, x0) =
+{
+//
+val nx1 =
+  $UN.castvwtp1{List1_vt(a)}(nx)
+//
+val+@list_vt_cons (x, _) = nx1
+//
+val () = x := x0
+//
+prval () = fold@ (nx1)
+prval () = $UN.cast2void (nx1)
+//
+prval () = __assert (nx) where
+{
+  extern praxi __assert (nx: !mynode(a?, l) >> mynode (a, l)): void
+} (* end of [prval] *)
+//
+} (* end of [mynode_set_elt] *)
+
+(* ****** ****** *)
+
+implement
+{a}(*tmp*)
+mynode_getfree_elt
+  (nx) = (x) where {
+//
+val nx =
+  $UN.castvwtp0{List1_vt(a)}(nx)
+//
+val+~list_vt_cons (x, nx2) = nx
+//
+prval ((*void*)) = $UN.cast2void (nx2)
+//
+} (* end of [mynode_getfree_elt] *)
+
+(* ****** ****** *)
+
+(*
+fun{a:t0p}
+linset_takeout_ngc
+  (set: &set(INV(a)) >> _, x0: a):<!wrt> mynode0 (a)
+// end of [linset_takeout_ngc]
+*)
+implement
+{a}(*tmp*)
+linset_takeout_ngc
+  (set, x0) = let
+//
+fun takeout
+(
+  xs: &List0_vt (a) >> _
+) : mynode0(a) = let
+in
+//
+case+ xs of
+| @list_vt_cons
+    (x, xs1) => let
+    prval pf_x = view@x
+    prval pf_xs1 = view@xs1
+    val sgn =
+      compare_elt_elt<a> (x0, x)
+    // end of [val]
+  in
+    if sgn > 0 then let
+      prval () = fold@ (xs)
+    in
+      mynode_null{a}((*void*))
+    end else if sgn < 0 then let
+      val res = takeout (xs1)
+      prval ((*void*)) = fold@ (xs)
+    in
+      res
+    end else let // x0 = x
+      val xs1_ = xs1
+      val res = $UN.castvwtp0{mynode1(a)}((pf_x, pf_xs1 | xs))
+      val () = xs := xs1_
+    in
+      res // [x0] in [xs]
+    end (* end of [if] *)
+  end // end of [list_vt_cons]
+| list_vt_nil () => mynode_null{a}((*void*))
+//
+end (* end of [takeout] *)
+//
+in
+  $effmask_all (takeout (set))
+end // end of [linset_takeout_ngc]
+
+(* ****** ****** *)
+
+implement
+{a}(*tmp*)
+linset_takeoutmax_ngc
+  (xs) = let
+in
+//
+case+ xs of
+| @list_vt_cons
+    (x, xs1) => let
+    prval pf_x = view@x
+    prval pf_xs1 = view@xs1
+    val xs_ = xs
+    val () = xs := xs1
+  in
+    $UN.castvwtp0{mynode1(a)}((pf_x, pf_xs1 | xs_))
+  end // end of [list_vt_cons]
+| @list_vt_nil () => let
+    prval () = fold@ (xs)
+  in
+    mynode_null{a}((*void*))
+  end // end of [list_vt_nil]
+//
+end // end of [linset_takeoutmax_ngc]
+
+(* ****** ****** *)
+
+implement
+{a}(*tmp*)
+linset_takeoutmin_ngc
+  (xs) = let
+//
+fun unsnoc
+  {n:pos} .<n>.
+(
+  xs: &list_vt (a, n) >> list_vt (a, n-1)
+) :<!wrt> mynode1 (a) = let
+//
+val+@list_vt_cons (x, xs1) = xs
+//
+prval pf_x = view@x and pf_xs1 = view@xs1
+//
+in
+//
+case+ xs1 of
+| list_vt_cons _ =>
+    let val res = unsnoc(xs1) in fold@xs; res end
+  // end of [list_vt_cons]
+| list_vt_nil () => let
+    val xs_ = xs
+    val () = xs := list_vt_nil{a}()
+  in
+    $UN.castvwtp0{mynode1(a)}((pf_x, pf_xs1 | xs_))
+  end // end of [list_vt_nil]
+//
+end // end of [unsnoc]
+//
+in
+//
+case+ xs of
+| list_vt_cons _ => unsnoc (xs)
+| list_vt_nil () => mynode_null{a}((*void*))
+//
+end // end of [linset_takeoutmin_ngc]
+
+(* ****** ****** *)
+
+(* end of [linset_listord.dats] *)

samples/ATS/linset_listord.sats

@@ -0,0 +1,51 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                         Applied Type System                         *)
+(*                                                                     *)
+(***********************************************************************)
+
+(*
+** ATS/Postiats - Unleashing the Potential of Types!
+** Copyright (C) 2011-2013 Hongwei Xi, ATS Trustful Software, Inc.
+** All rights reserved
+**
+** ATS is free software;  you can  redistribute it and/or modify it under
+** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
+** Free Software Foundation; either version 3, or (at  your  option)  any
+** later version.
+** 
+** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
+** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
+** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
+** for more details.
+** 
+** You  should  have  received  a  copy of the GNU General Public License
+** along  with  ATS;  see the  file COPYING.  If not, please write to the
+** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
+** 02110-1301, USA.
+*)
+
+(* ****** ****** *)
+//
+// Author: Hongwei Xi
+// Authoremail: hwxiATcsDOTbuDOTedu
+// Time: October, 2010
+//
+(* ****** ****** *)
+
+#define ATS_PACKNAME "ATSLIB.libats.linset_listord"
+#define ATS_STALOADFLAG 0 // no static loading at run-time
+
+(* ****** ****** *)
+
+#include "./SHARE/linset.hats"
+#include "./SHARE/linset_node.hats"
+
+(* ****** ****** *)
+
+castfn
+linset2list {a:t0p} (xs: set (INV(a))):<> List0_vt (a)
+
+(* ****** ****** *)
+
+(* end of [linset_listord.sats] *)

samples/ATS/main.atxt

@@ -0,0 +1,215 @@
+%{
+#include "./../ATEXT/atextfun.hats"
+%}
+
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+   "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+
+<head>
+<meta http-equiv="content-type" content="text/html; charset=UTF-8" />
+<title>EFFECTIVATS-DiningPhil2</title>
+#patscode_style()
+</head>
+
+<body>
+
+<h1>
+Effective ATS: Dining Philosophers
+</h1>
+
+In this article, I present an implementation of a slight variant of the
+famous problem of 5-Dining-Philosophers by Dijkstra that makes simple but
+convincing use of linear types.
+
+<h2>
+The Original Problem 
+</h2>
+
+There are five philosophers sitting around a table and there are also 5
+forks placed on the table such that each fork is located between the left
+hand of a philosopher and the right hand of another philosopher. Each
+philosopher does the following routine repeatedly: thinking and dining.  In
+order to dine, a philosopher needs to first acquire two forks: one located
+on his left-hand side and the other on his right-hand side. After
+finishing dining, a philosopher puts the two acquired forks onto the table:
+one on his left-hand side and the other on his right-hand side.
+
+<h2>
+A Variant of the Original Problem 
+</h2>
+
+The following twist is added to the original version:
+
+<p>
+
+After a fork is used, it becomes a "dirty" fork and needs to be put in a
+tray for dirty forks. There is a cleaner who cleans dirty forks and then
+puts them back on the table.
+
+<h2>
+Channels for Communication
+</h2>
+
+A channel is just a shared queue of fixed capacity. The following two
+functions are for inserting an element into and taking an element out of a
+given channel:
+
+<pre
+class="patsyntax">
+#pats2xhtml_sats("\
+fun{a:vt0p} channel_insert (channel (a), a): void
+fun{a:vt0p} channel_takeout (chan: channel (a)): (a) 
+")</pre>
+
+If [channel_insert] is called on a channel that is full, then the caller is
+blocked until an element is taken out of the channel.  If [channel_takeout]
+is called on a channel that is empty, then the caller is blocked until an
+element is inserted into the channel.
+
+<h2>
+A Channel for Each Fork
+</h2>
+
+Forks are resources given a linear type. Each fork is initially stored in a
+channel, which can be obtained by calling the following function:
+
+<pre
+class="patsyntax">
+#pats2xhtml_sats("\
+fun fork_changet (n: nphil): channel(fork)
+")</pre>
+
+where the type [nphil] is defined to be [natLt(5)] (for natural numbers
+less than 5). The channels for storing forks are chosen to be of capacity
+2. The reason that channels of capacity 2 are chosen to store at most one
+element (in each of them) is to guarantee that these channels can never be
+full (so that there is no attempt made to send signals to awake callers
+supposedly being blocked due to channels being full).
+
+
+<h2>
+A Channel for the Fork Tray
+</h2>
+
+A tray for storing "dirty" forks is also a channel, which can be obtained
+by calling the following function:
+
+<pre
+class="patsyntax">
+#pats2xhtml_sats("\
+fun forktray_changet ((*void*)): channel(fork)
+")</pre>
+
+The capacity chosen for the channel is 6 (instead of 5) so that it can
+never become full (as there are only 5 forks in total).
+
+<h2>
+Philosopher Loop
+</h2>
+
+Each philosopher is implemented as a loop:
+
+<pre
+class="patsyntax">
+#pats2xhtml_dats('\
+implement
+phil_loop (n) = let
+//
+val () = phil_think (n)
+//
+val nl = phil_left (n) // = n
+val nr = phil_right (n) // = (n+1) % 5
+//
+val ch_lfork = fork_changet (nl)
+val ch_rfork = fork_changet (nr)
+//
+val lf = channel_takeout (ch_lfork)
+val () = println! ("phil_loop(", n, ") picks left fork")
+//
+val () = randsleep (2) // sleep up to 2 seconds
+//
+val rf = channel_takeout (ch_rfork)
+val () = println! ("phil_loop(", n, ") picks right fork")
+//
+val () = phil_dine (n, lf, rf)
+//
+val ch_forktray = forktray_changet ()
+val () = channel_insert (ch_forktray, lf) // left fork to dirty tray
+val () = channel_insert (ch_forktray, rf) // right fork to dirty tray
+//
+in
+  phil_loop (n)
+end // end of [phil_loop]
+')</pre>
+
+It should be straighforward to follow the code for [phil_loop].
+
+<h2>
+Fork Cleaner Loop
+</h2>
+
+A cleaner is implemented as a loop:
+
+<pre
+class="patsyntax">
+#pats2xhtml_dats('\
+implement
+cleaner_loop () = let
+//
+val ch = forktray_changet ()
+val f0 = channel_takeout (ch) // [f0] is dirty
+//
+val () = cleaner_wash (f0) // washes dirty [f0]
+val () = cleaner_return (f0) // puts back cleaned [f0]
+//
+in
+  cleaner_loop ()
+end // end of [cleaner_loop]
+')</pre>
+
+The function [cleaner_return] first finds out the number of a given fork
+and then uses the number to locate the channel for storing the fork. Its
+actual implementation is given as follows:
+
+<pre
+class="patsyntax">
+#pats2xhtml_dats('\
+implement
+cleaner_return (f) =
+{
+  val n = fork_get_num (f)
+  val ch = fork_changet (n)
+  val () = channel_insert (ch, f)
+}
+')</pre>
+
+It should now be straighforward to follow the code for [cleaner_loop].
+
+<h2>
+Testing
+</h2>
+
+The entire code of this implementation is stored in the following files:
+
+<pre>
+DiningPhil2.sats
+DiningPhil2.dats
+DiningPhil2_fork.dats
+DiningPhil2_thread.dats
+</pre>
+
+There is also a Makefile available for compiling the ATS source code into
+an excutable for testing. One should be able to encounter a deadlock after
+running the simulation for a while.
+
+<hr size="2">
+
+This article is written by <a href="http://www.cs.bu.edu/~hwxi/">Hongwei Xi</a>.
+
+</body>
+</html>
+
+%{
+implement main () = fprint_filsub (stdout_ref, "main_atxt.txt")
+%}

samples/C/dynarray.cats

@@ -0,0 +1,56 @@
+/* ******************************************************************* */
+/*                                                                     */
+/*                         Applied Type System                         */
+/*                                                                     */
+/* ******************************************************************* */
+
+/*
+** ATS/Postiats - Unleashing the Potential of Types!
+** Copyright (C) 2011-20?? Hongwei Xi, ATS Trustful Software, Inc.
+** All rights reserved
+**
+** ATS is free software;  you can  redistribute it and/or modify it under
+** the terms of  the GNU GENERAL PUBLIC LICENSE (GPL) as published by the
+** Free Software Foundation; either version 3, or (at  your  option)  any
+** later version.
+** 
+** ATS is distributed in the hope that it will be useful, but WITHOUT ANY
+** WARRANTY; without  even  the  implied  warranty  of MERCHANTABILITY or
+** FITNESS FOR A PARTICULAR PURPOSE.  See the  GNU General Public License
+** for more details.
+** 
+** You  should  have  received  a  copy of the GNU General Public License
+** along  with  ATS;  see the  file COPYING.  If not, please write to the
+** Free Software Foundation,  51 Franklin Street, Fifth Floor, Boston, MA
+** 02110-1301, USA.
+*/
+
+/* ****** ****** */
+
+/*
+(* Author: Hongwei Xi *)
+(* Authoremail: hwxi AT cs DOT bu DOT edu *)
+(* Start time: March, 2013 *)
+*/
+
+/* ****** ****** */
+
+#ifndef ATSHOME_LIBATS_DYNARRAY_CATS
+#define ATSHOME_LIBATS_DYNARRAY_CATS
+
+/* ****** ****** */
+
+#include <string.h>
+
+/* ****** ****** */
+
+#define atslib_dynarray_memcpy memcpy
+#define atslib_dynarray_memmove memmove
+
+/* ****** ****** */
+
+#endif // ifndef ATSHOME_LIBATS_DYNARRAY_CATS
+
+/* ****** ****** */
+
+/* end of [dynarray.cats] */

samples/C/readline.cats

@@ -0,0 +1,47 @@
+/*
+** API in ATS for GNU-readline
+*/
+
+/* ****** ****** */
+
+/*
+** Permission to use, copy, modify, and distribute this software for any
+** purpose with or without fee is hereby granted, provided that the above
+** copyright notice and this permission notice appear in all copies.
+** 
+** THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+** WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+** MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+** ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+** WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+** ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+** OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+*/
+
+/* ****** ****** */
+
+#ifndef READLINE_READLINE_CATS
+#define READLINE_READLINE_CATS
+
+/* ****** ****** */
+
+#include <readline/readline.h>
+
+/* ****** ****** */
+//
+#define \
+atscntrb_readline_rl_library_version() ((char*)rl_library_version)
+//
+#define atscntrb_readline_rl_readline_version() (rl_readline_version)
+//
+/* ****** ****** */
+
+#define atscntrb_readline_readline readline
+
+/* ****** ****** */
+
+#endif // ifndef READLINE_READLINE_CATS
+
+/* ****** ****** */
+
+/* end of [readline.cats] */

samples/Cirru/array.cirru

@@ -0,0 +1,12 @@
+
+print $ array
+  int 1
+  string 2
+
+print $ array
+  int 1
+  array
+    int 2
+    string 3
+    array
+      string 4

samples/Cirru/block.cirru

@@ -0,0 +1,7 @@
+
+set f $ block (a b c)
+  print a b c
+
+call f (int 1) (int 2) (int 3)
+
+f (int 1) (int 2) (int 3)

samples/Cirru/bool.cirru

@@ -0,0 +1,7 @@
+
+print $ bool true
+print $ bool false
+print $ bool yes
+print $ bool no
+print $ bool 1
+print $ bool 0

samples/Cirru/map.cirru

@@ -0,0 +1,14 @@
+
+print $ map
+  a $ int 5
+  b $ array (int 1) (int 2)
+  c $ map
+    int 1
+    array (int 4)
+
+set m $ map
+  a $ int 1
+
+set m b $ int 2
+
+print m

samples/Cirru/number.cirru

@@ -0,0 +1,3 @@
+
+print $ int 1
+print $ float 1.2

samples/Cirru/require.cirru

@@ -0,0 +1,2 @@
+
+require ./stdio.cr

samples/Cirru/scope.cirru

@@ -0,0 +1,23 @@
+
+set a (int 2)
+
+print (self)
+
+set c (child)
+
+under c
+  under parent
+    print a
+
+print $ get c a
+
+set c x (int 3)
+print $ get c x
+
+set just-print $ code
+  print a
+
+print just-print
+
+eval (self) just-print
+eval just-print

samples/Cirru/stdio.cirru

@@ -0,0 +1,55 @@
+
+set a $ string 1
+print a
+
+print (string 1)
+
+print nothing
+
+print
+  map
+    a (int 4)
+    b $ map
+      a $ int 5
+      b $ int 6
+      c $ map
+        int 7
+
+print
+  array
+    int 1
+    int 2
+    array
+      int 3
+      int 4
+
+print
+  array
+    int 1
+    map
+      a $ int 2
+      b $ array
+        int 3
+
+print
+  int 1
+  int 2
+
+print $ code
+  set a 1
+  print (get a)
+  print $ array
+    int a
+    array
+      int a
+
+set container (map)
+set container code $ code
+  set a 1
+  print (get a)
+  print $ array
+    int a
+    array
+      int a
+
+print container

samples/Cirru/string.cirru

@@ -0,0 +1,3 @@
+
+print $ string a
+print $ string "a b"

samples/JSONLD/sample.jsonld

@@ -0,0 +1,30 @@
+{
+  "@context": {
+    "property": "http://example.com/vocab#property"
+  },
+  "@id": "../document-relative",
+  "@type": "#document-relative",
+  "property": {
+    "@context": {
+      "@base": "http://example.org/test/"
+    },
+    "@id": "../document-base-overwritten",
+    "@type": "#document-base-overwritten",
+    "property": [
+      {
+        "@context": null,
+        "@id": "../document-relative",
+        "@type": "#document-relative",
+        "property": "context completely reset, drops property"
+      },
+      {
+        "@context": {
+          "@base": null
+        },
+        "@id": "../document-relative",
+        "@type": "#document-relative",
+        "property": "only @base is cleared"
+      }
+    ]
+  }
+}

samples/Mask/view.mask

@@ -0,0 +1,61 @@
+
+// HTML Elements
+header {
+    
+    img .logo src='/images/~[currentLogo].png' alt=logo;
+    
+    h4 > 'Bar View'
+    
+    if (currentUser) {
+        
+        .account >
+            a href='/acount' >
+                'Hello, ~[currentUser.username]'
+    }
+}
+
+.view {
+    ul {
+       
+        // Iteration
+        for ((user, index) of users) {
+            
+            li.user data-id='~[user.id]' {
+                
+                // interpolation
+                .name > '~[ user.username ]'
+                
+                // expression
+                .count > '~[: user.level.toFixed(2) ]'
+                
+                // util
+                /* Localization sample
+                 * lastActivity: "Am {0:dd. MM} war der letzte Eintrag"
+                 */
+                .date > '~[ L: "lastActivity",  user.date]'
+            }
+        }
+    }
+    
+    // Component
+    :countdownComponent {
+        input type = text >
+            :dualbind value='number';
+            
+        button x-signal='click: countdownStart' > 'Start';
+        
+        h5 {
+            '~[bind: number]'
+            
+            :animation x-slot='countdownStart' {
+                @model > 'transition | scale(0) > scale(1) | 500ms'
+                @next  > 'background-color | red > blue | 2s linear'
+            }
+        }
+    }
+}
+
+footer > :bazCompo {
+    
+    'Component generated at ~[: $u.format($c.date, "HH-mm") ]'
+}

samples/Prolog/or-constraint.ecl

@@ -0,0 +1,90 @@
+:- lib(ic).
+
+/**
+ * Question 1.11
+ * vabs(?Val, ?AbsVal)
+ */
+vabs(Val, AbsVal):-
+	AbsVal #> 0,
+	(
+		Val #= AbsVal
+	;
+		Val #= -AbsVal
+	),
+	labeling([Val, AbsVal]).
+
+/**
+ * vabsIC(?Val, ?AbsVal)
+ */
+vabsIC(Val, AbsVal):-
+	AbsVal #> 0,
+	Val #= AbsVal or Val #= -AbsVal,
+	labeling([Val, AbsVal]).
+
+/**
+ * Question 1.12
+ */
+% X #:: -10..10, vabs(X, Y).
+% X #:: -10..10, vabsIC(X, Y).
+
+/**
+ * Question 1.13
+ * faitListe(?ListVar, ?Taille, +Min, +Max)
+ */
+faitListe([], 0, _, _):-!.
+faitListe([First|Rest], Taille, Min, Max):-
+	First #:: Min..Max,
+	Taille1 #= Taille - 1,
+	faitListe(Rest, Taille1, Min, Max).
+
+/**
+ * Question 1.14
+ * suite(?ListVar)
+ */
+suite([Xi, Xi1, Xi2]):-
+	checkRelation(Xi, Xi1, Xi2).
+suite([Xi, Xi1, Xi2|Rest]):-
+	checkRelation(Xi, Xi1, Xi2),
+	suite([Xi1, Xi2|Rest]).
+
+/**
+ * checkRelation(?Xi, ?Xi1, ?Xi2)
+ */
+checkRelation(Xi, Xi1, Xi2):-
+	vabs(Xi1, VabsXi1),
+	Xi2 #= VabsXi1 - Xi.
+
+/**
+ * Question 1.15
+ * checkPeriode(+ListVar).
+ */
+% TODO Any better solution?
+checkPeriode(ListVar):-
+	length(ListVar, Length),
+	Length < 10.
+checkPeriode([X1, X2, X3, X4, X5, X6, X7, X8, X9, X10|Rest]):-
+	X1 =:= X10,
+	checkPeriode([X2, X3, X4, X5, X6, X7, X8, X9, X10|Rest]).
+% faitListe(ListVar, 18, -9, 9), suite(ListVar), checkPeriode(ListVar). => 99 solutions
+
+
+/**
+ * Tests
+ */
+/*
+vabs(5, 5). => Yes
+vabs(5, -5). => No
+vabs(-5, 5). => Yes
+vabs(X, 5).
+vabs(X, AbsX). 
+vabsIC(5, 5). => Yes
+vabsIC(5, -5). => No
+vabsIC(-5, 5). => Yes
+vabsIC(X, 5).
+vabsIC(X, AbsX).
+
+faitListe(ListVar, 5, 1, 3). => 243 solutions
+faitListe([_, _, _, _, _], Taille, 1, 3). => Taille = 5 !!!!!!!!!!!!!!!!
+
+faitListe(ListVar, 18, -9, 9), suite(ListVar). => 99 solutions
+*/

samples/R/R-qgis-extension.rsx

@@ -0,0 +1,5 @@
+##polyg=vector
+##numpoints=number 10
+##output=output vector
+##[Example scripts]=group
+pts=spsample(polyg,numpoints,type="regular")

samples/Scheme/basic.sld

@@ -0,0 +1,7 @@
+(define-library (libs basic)
+    (export list2 x)
+    (begin
+        (define (list2 . objs)  objs)
+        (define x 'libs-basic)
+        (define not-exported 'should-not-be-exported)
+        ))

samples/Shen/graph.shen

@@ -0,0 +1,321 @@
+\* graph.shen --- a library for graph definition and manipulation
+
+Copyright (C) 2011,  Eric Schulte
+
+*** License:
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+ - Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+ - Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+*** Commentary:
+
+Graphs are represented as two dictionaries one for vertices and one
+for edges.  It is important to note that the dictionary implementation
+used is able to accept arbitrary data structures as keys.  This
+structure technically encodes hypergraphs (a generalization of graphs
+in which each edge may contain any number of vertices).  Examples of a
+regular graph G and a hypergraph H with the corresponding data
+structure are given below.
+
+
+--G=<graph Vertices Edges>------------------------------------------------
+                            Vertices                  Edges
+                           ----------                -------
+ +----Graph G-----+      hash | key -> value      hash |  key  -> value
+ |                |      -----+------>--------    -----+-------->---------
+ | a---b---c   g  |         1 |  a  -> [1]           1 | [a b] -> [1 2]
+ |     |   |      |         2 |  b  -> [1 2 3]       2 | [b c] -> [2 3]
+ |     d---e---f  |         3 |  c  -> [2 4]         3 | [b d] -> [2 4]
+ |                |         4 |  d  -> [3 5]         4 | [c e] -> [3 5]
+ +----------------+         5 |  e  -> [4 5 6]       5 | [d e] -> [4 5]
+                            6 |  f  -> [6]           6 | [e f] -> [5 6]
+                            7 |  g  -> []
+
+
+--H=<graph Vertices Edges>------------------------------------------------
+                            Vertices                  Edges
+                           ----------                -------
+                         hash | key -> value      hash |  key  -> value
+ +-- Hypergraph H----+   -----+------>--------    -----+-------->---------
+ |                   |      1 |  a  -> [1]           1 | [a b     [1 2
+ |        +------+   |      2 |  b  -> [1]             |  c d  ->  3 4
+ | +------+------+   |      3 |  c  -> [1]             |  e f]     5 6]
+ | |a b c |d e f |   |      4 |  d  -> [1 2]           |
+ | +------+------+   |      5 |  e  -> [1 2]         2 | [d e     [4 5
+ |        |g h i | j |      6 |  f  -> [1 2]           |  f g  ->  6 7
+ |        +------+   |      7 |  g  -> [2]             |  h i]     8 9]
+ |                   |      8 |  h  -> [2]
+ +-------------------+      9 |  i  -> [2]
+                           10 |  j  -> []
+
+
+--G=<graph Vertices Edges>-------Graph with associated edge/vertex data---------
+                            Vertices                    Edges
+                           ----------                  -------
+ +----Graph G-----+      hash | key -> value        hash |  key  -> value
+ |   4   6     7  |      -----+------>--------      -----+-------->---------
+ |0a---b---c   g  |         1 |  a  -> (@p 0 [1])      1 | [a b] -> (@p 4 [1 2])
+ |    1|  3|      |         2 |  b  -> [1 2 3]         2 | [b c] -> (@p 6 [2 3])
+ |     d---e---f  |         3 |  c  -> [2 4]           3 | [b d] -> (@p 1 [2 4])
+ |       2   5    |         4 |  d  -> [3 5]           4 | [c e] -> (@p 3 [3 5])
+ +----------------+         5 |  e  -> [4 5 6]         5 | [d e] -> (@p 2 [4 5])
+                            6 |  f  -> [6]             6 | [e f] -> (@p 5 [5 6])
+                            7 |  g  -> (@p 7 [])
+
+V = # of vertices
+E = # of edges
+M = # of vertex edge associations
+
+size = size of all vertices +            all vertices stored in Vertices dict
+       M * sizeof(int) * 4 +             indices into Vertices & Edge dicts
+       V * sizeof(dict entry) +          storage in the Vertex dict
+       E * sizeof(dict entry) +          storage in the Edge dict
+       2 * sizeof(dict)                  the Vertices and Edge dicts
+
+*** Code: *\
+(require dict)
+(require sequence)
+
+(datatype graph
+  Vertices : dictionary;
+     Edges : dictoinary;
+  ===================
+  (vector symbol Vertices Edges);)
+
+(package graph- [graph graph? vertices edges add-vertex
+                 add-edge has-edge? has-vertex? edges-for
+                 neighbors connected-to connected? connected-components
+                 vertex-partition bipartite?
+                 \* included from the sequence library\ *\
+                 take drop take-while drop-while range flatten
+                 filter complement seperate zip indexed reduce
+                 mapcon partition partition-with unique frequencies
+                 shuffle pick remove-first interpose subset?
+                 cartesian-product
+                 \* included from the dict library\ *\
+                 dict? dict dict-> <-dict contents key? keys vals
+                 dictionary make-dict]
+
+(define graph?
+  X -> (= graph (<-address X 0)))
+
+(define make-graph
+  \* create a graph with specified sizes for the vertex dict and edge dict *\
+  {number --> number --> graph}
+  Vertsize Edgesize ->
+    (let Graph (absvector 3)
+      (do (address-> Graph 0 graph)
+          (address-> Graph 1 (make-dict Vertsize))
+          (address-> Graph 2 (make-dict Edgesize))
+          Graph)))
+
+(defmacro graph-macro
+  \* return a graph taking optional sizes for the vertex and edge dicts *\
+  [graph] -> [make-graph 1024 1024]
+  [graph N] -> [make-graph N 1024]
+  [graph N M] -> [make-graph N M])
+
+(define vert-dict Graph -> (<-address Graph 1))
+
+(define edge-dict Graph -> (<-address Graph 2))
+
+(define vertices
+  {graph --> (list A)}
+  Graph -> (keys (vert-dict Graph)))
+
+(define edges
+  {graph --> (list (list A))}
+  Graph -> (keys (edge-dict Graph)))
+
+(define get-data
+  Value V -> (if (tuple? Value)
+                 (fst Value)
+                 (error (make-string "no data for ~S~%" V))))
+
+(define vertex-data
+  Graph V -> (get-data (<-dict (vert-dict Graph) V) V))
+
+(define edge-data
+  Graph V -> (get-data (<-dict (edge-dict Graph) V) V))
+
+(define resolve
+  {(vector (list A)) --> (@p number number) --> A}
+  Vector (@p Index Place) -> (nth (+ 1 Place) (<-vector Vector Index)))
+
+(define resolve-vert
+  {graph --> (@p number number) --> A}
+  Graph Place -> (resolve (<-address (vert-dict Graph) 2) Place))
+
+(define resolve-edge
+  {graph --> (@p number number) --> A}
+  Graph Place -> (resolve (<-address (edge-dict Graph) 2) Place))
+
+(define edges-for
+  {graph --> A --> (list (list A))}
+  Graph Vert -> (let Val (trap-error (<-dict (vert-dict Graph) Vert) (/. E []))
+                     Edges (if (tuple? Val) (snd Val) Val)
+                  (map (lambda X (fst (resolve-edge Graph X))) Val)))
+
+(define add-vertex-w-data
+  \* add a vertex to a graph *\
+  {graph --> A --> B --> A}
+  G V Data -> (do (dict-> (vert-dict G) V (@p Data (edges-for G V))) V))
+
+(define add-vertex-w/o-data
+  \* add a vertex to a graph *\
+  {graph --> A --> B --> A}
+  G V -> (do (dict-> (vert-dict G) V (edges-for G V)) V))
+
+(defmacro add-vertex-macro
+  [add-vertex G V]   -> [add-vertex-w/o-data G V]
+  [add-vertex G V D] -> [add-vertex-w-data G V D])
+
+(define update-vert
+  \* in a dict, add an edge to a vertex's edge list *\
+  {vector --> (@p number number) --> A --> number}
+  Vs Edge V -> (let Store (<-address Vs 2)
+                    N (hash V (limit Store))
+                    VertLst (trap-error (<-vector Store N) (/. E []))
+                    Contents (trap-error (<-dict Vs V) (/. E []))
+                 (do (dict-> Vs V (if (tuple? Contents)
+                                      (@p (fst Contents)
+                                          (adjoin Edge (snd Contents)))
+                                      (adjoin Edge Contents)))
+                     (@p N (length VertLst)))))
+
+(define update-edges-vertices
+  \* add an edge to a graph *\
+  {graph --> (list A) --> (list A)}
+  Graph Edge ->
+  (let Store (<-address (edge-dict Graph) 2)
+       EdgeID (hash Edge (limit Store))
+       EdgeLst (trap-error (<-vector Store EdgeID) (/. E []))
+    (map (update-vert (vert-dict Graph) (@p EdgeID (length EdgeLst))) Edge)))
+
+(define add-edge-w-data
+  G E D -> (do (dict-> (edge-dict G) E (@p D (update-edges-vertices G E))) E))
+
+(define add-edge-w/o-data
+  G E -> (do (dict-> (edge-dict G) E (update-edges-vertices G E)) E))
+
+(defmacro add-edge-macro
+  [add-edge G E]   -> [add-edge-w/o-data G E]
+  [add-edge G E V] -> [add-edge-w-data G E V])
+
+(define has-edge?
+  {graph --> (list A) --> boolean}
+  Graph Edge -> (key? (edge-dict Graph) Edge))
+
+(define has-vertex?
+  {graph --> A --> boolean}
+  Graph Vertex -> (key? (vert-dict Graph) Vertex))
+
+(define neighbors
+  \* Return the neighbors of a vertex *\
+  {graph --> A --> (list A)}
+  Graph Vert -> (unique (mapcon (remove-first Vert) (edges-for Graph Vert))))
+
+(define connected-to-
+  {graph --> (list A) --> (list A) --> (list A)}
+  Graph [] Already -> Already
+  Graph New Already ->
+  (let Reachable (unique (mapcon (neighbors Graph) New))
+       New (difference Reachable Already)
+    (connected-to- Graph New (append New Already))))
+
+(define connected-to
+  \* return all vertices connected to the given vertex, including itself *\
+  {graph --> A --> (list A)}
+  Graph V -> (connected-to- Graph [V] [V]))
+
+(define connected?
+  \* return if a graph is fully connected *\
+  {graph --> boolean}
+  Graph -> (reduce (/. V Acc
+                       (and Acc
+                            (subset? (vertices Graph) (connected-to Graph V))))
+                   true (vertices Graph)))
+
+(define connected-components-
+  \* given a graph return a list of connected components *\
+  {graph --> (list A) --> (list (list A)) --> (list graph)}
+  Graph [] _ -> []
+  Graph VS [] -> (map (/. V (let Component (graph 1 0)
+                              (do (add-vertex Component V) Component)))
+                      VS)
+  Graph [V|VS] ES ->
+    (let Con-verts (connected-to Graph V)
+         Con-edges (filter (/. E (subset? E Con-verts)) ES)
+         Component (graph (length Con-verts) (length Con-edges))
+      (do (map (add-edge-w/o-data Component) Con-edges)
+          (cons Component (connected-components- Graph
+                                                 (difference VS Con-verts)
+                                                 (difference ES Con-edges))))))
+
+(define connected-components
+  {graph --> (list graph)}
+  Graph -> (connected-components- Graph (vertices Graph) (edges Graph)))
+
+(define place-vertex
+  \* given a graph, vertex and list of partitions, partition the vertex *\
+  {graph --> A --> (list (list A)) --> (list (list A))}
+  Graph V [] -> (if (element? V (neighbors Graph V))
+                    (simple-error
+                     (make-string "self-loop ~S, no vertex partition" V))
+                    [[V]])
+  Graph V [C|CS] -> (let Neighbors (neighbors Graph V)
+                      (if (element? V Neighbors)
+                          (simple-error
+                           (make-string "self-loop ~S, no vertex partition" V))
+                          (if (empty? (intersection C Neighbors))
+                              [[V|C]|CS]
+                              [C|(place-vertex Graph V CS)]))))
+
+(define vertex-partition
+  \* partition the vertices of a graph *\
+  {graph --> (list (list A))}
+  Graph -> (reduce (place-vertex Graph) [] (vertices Graph)))
+
+(define bipartite?
+  \* check if a graph is bipartite *\
+  {graph --> boolean}
+  Graph -> (= 2 (length (vertex-partition Graph))))
+
+)
+
+\* simple tests
+
+(set g (graph))
+(add-edge (value g) [chris patton])
+(add-edge (value g) [eric chris])
+(add-vertex (value g) nobody)
+(has-edge? (value g) [patton chris])
+(edges-for (value g) chris)
+(neighbors (value g) chris)
+(neighbors (value g) nobody)
+(connected-to (value g) chris)
+(connected? (value g))
+(connected-components (value g)) <- fail when package wrapper is used
+(map (function vertices) (connected-components (value g)))
+
+*\

samples/Shen/html.shen

@@ -0,0 +1,102 @@
+\* html.shen --- html generation functions for shen
+
+Copyright (C) 2011,  Eric Schulte
+
+*** License:
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+ - Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+ - Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+*** Commentary:
+
+The standard lisp-to-html conversion tool suite.  Follows some of
+the convertions of Clojure's hiccup.
+
+  an example...
+
+(8-) (html [ul#todo1.tasks.stuff [: [title "today"]]
+          (map (lambda Str [li Str]) ["get milk" "dishes"])])
+"<ul class='tasks stuff' id='todo1' title='today'>
+ <li>get milk</li><li>dishes</li></ul>"
+
+*** Code: *\
+(trap-error
+ (require string)
+ (/. E (load "../string/string.shen")))
+
+(package string- [html
+                  \* symbols included from string *\
+                  takestr dropstr substr length-str index-str
+                  reverse-str starts-with substr? replace-str
+                  join split trim-left trim-right chomp trim]
+
+(define to-str
+  \* return argument as a string, if already a string do not change *\
+  X -> X where (string? X)
+  X -> (str X))
+
+(define gassoc
+  X Y -> (hd (tl (assoc X Y))))
+
+(define dassoc
+  X Y -> (remove (assoc X Y) Y))
+
+(define passoc
+  [] Y -> Y
+  [X XV] Y -> (let Orig (gassoc X Y)
+                   New (if (cons? Orig) [XV|Orig] XV)
+                [[X New]|(dassoc X Y)]))
+
+(define html
+  X -> X where (string? X)
+  [Tag [: |Attrs] |Body] ->
+    (let Tag-comps (css-parse-symbol Tag)
+         Tag (gassoc tag Tag-comps)
+         New-attrs (passoc (assoc class Tag-comps)
+                           (passoc (assoc id Tag-comps) Attrs))
+      (@s (make-string "<~S" Tag) (attributes New-attrs) ">"
+          (html Body)
+          (make-string "</~S>" Tag))) where (symbol? Tag)
+  [Tag|Body] -> (html [Tag [:] Body]) where (symbol? Tag)
+  [H|HS] -> (@s (html H) (html HS))
+  [] -> "")
+
+(define css-parse-symbol
+  {symbol --> [[symbol A]]}
+  Symbol -> (let String (str Symbol)
+                 Class-split (split (str .) String)
+                 Class (map (function intern) (tl Class-split))
+                 Id-split (split (str #) (hd Class-split))
+                 Tag (hd Id-split)
+                 Id (tl Id-split)
+              ((if (= [] Id) (/. X X) (cons [id (intern (hd Id))]))
+               ((if (= [] Class) (/. X X) (cons [class Class])) 
+                [[tag (intern Tag)]]))))
+
+(define attributes
+  [] -> ""
+  [[K V]|AS] -> (@s " " (to-str K) "='"
+                    (if (cons? V) (join " " (map (function str) V)) (to-str V))
+                    "'" (attributes AS)))
+
+)

samples/Shen/json.shen

@@ -0,0 +1,39 @@
+(load "grammar.shen")
+
+\*
+
+JSON Lexer
+
+1. Read a stream of characters
+2. Whitespace characters not in strings should be discarded.
+3. Whitespace characters in strings should be preserved
+4. Strings can contain escaped double quotes. e.g. "\""
+
+*\
+
+(define whitespacep
+  \* e.g. ASCII 32 == #\Space. *\
+  \* All the others are whitespace characters from an ASCII table. *\
+  Char -> (member Char ["c#9;" "c#10;" "c#11;" "c#12;" "c#13;" "c#32;"]))
+
+(define replace-whitespace
+  "" -> ""
+  (@s Whitespace Suffix) -> (@s "" (replace-whitespace Suffix)) where (whitespacep Whitespace)
+  (@s Prefix Suffix) -> (@s Prefix (replace-whitespace Suffix)))
+
+(define fetch-until-unescaped-doublequote
+  [] -> []
+  ["\" "c#34;" | Chars] -> ["\" "c#34;" | (fetch-until-unescaped-doublequote Chars)]
+  ["c#34;" | Chars] -> []
+  [Char | Chars] -> [Char | (fetch-until-unescaped-doublequote Chars)])
+
+\* (define strip-whitespace-chars *\
+\*   [] -> [] *\
+\*   ["c#34;" | Chars] -> ["c#34;" | ( *\
+\*   [WhitespaceChar | Chars] -> (strip-whitespace-chars Chars) where (whitespace? WhitespaceChar) *\
+\*   [Char | Chars] -> [Char | (strip-whitespace-chars Chars)]) *\
+
+(define tokenise
+  JSONString ->
+  (let CharList (explode JSONString)
+       CharList))

samples/YAML/vcr_cassette.yml

@@ -0,0 +1,20 @@
+---
+http_interactions:
+- request:
+    method: get
+    uri: http://example.com/
+    body: ''
+    headers: {}
+  response:
+    status:
+      code: 200
+      message: OK
+    headers:
+      Content-Type:
+      - text/html;charset=utf-8
+      Content-Length:
+      - '26'
+    body: This is the response body
+    http_version: '1.1'
+  recorded_at: Tue, 01 Nov 2011 04:58:44 GMT
+recorded_with: VCR 2.0.0

test/test_blob.rb

@@ -211,6 +211,9 @@ class TestBlob < Test::Unit::TestCase
     assert !blob("CSS/bootstrap.css").generated?
     assert blob("CSS/bootstrap.min.css").generated?
 
+    # Generated VCR
+    assert blob("YAML/vcr_cassette.yml").generated?
+
     assert Linguist::Generated.generated?("node_modules/grunt/lib/grunt.js", nil)
   end
 
@@ -343,6 +346,14 @@ class TestBlob < Test::Unit::TestCase
 
     # Vagrant
     assert blob("Vagrantfile").vendored?
+
+    # Gradle
+    assert blob("gradlew").vendored?
+    assert blob("gradlew.bat").vendored?
+    assert blob("gradle/wrapper/gradle-wrapper.properties").vendored?
+    assert blob("subproject/gradlew").vendored?
+    assert blob("subproject/gradlew.bat").vendored?
+    assert blob("subproject/gradle/wrapper/gradle-wrapper.properties").vendored?
   end
 
   def test_language

test/test_heuristics.rb

@@ -15,14 +15,14 @@ class TestHeuristcs < Test::Unit::TestCase
     File.read(File.join(samples_path, name))
   end
 
-  # Only calling out '.h' filenames as these are the ones causing issues
-  def all_h_fixtures(language_name)
-    Dir.glob("#{samples_path}/#{language_name}/*.h")
+  def all_fixtures(language_name, file="*")
+    Dir.glob("#{samples_path}/#{language_name}/#{file}")
   end
 
   def test_obj_c_by_heuristics
     languages = ["C++", "Objective-C"]
-    all_h_fixtures("Objective-C").each do |fixture|
+    # Only calling out '.h' filenames as these are the ones causing issues
+    all_fixtures("Objective-C", "*.h").each do |fixture|
       results = Heuristics.disambiguate_c(fixture("Objective-C/#{File.basename(fixture)}"), languages)
       assert_equal Language["Objective-C"], results.first
     end
@@ -50,6 +50,18 @@ class TestHeuristcs < Test::Unit::TestCase
     results = Heuristics.disambiguate_pl(fixture("Perl/perl-test.t"), languages)
     assert_equal Language["Perl"], results.first
   end
+  
+  def test_ecl_prolog_by_heuristics
+    languages = ["ECL", "Prolog"]
+    results = Heuristics.disambiguate_ecl(fixture("Prolog/or-constraint.ecl"), languages)
+    assert_equal Language["Prolog"], results.first
+  end
+  
+  def test_ecl_ecl_by_heuristics
+    languages = ["ECL", "Prolog"]
+    results = Heuristics.disambiguate_ecl(fixture("ECL/sample.ecl"), languages)
+    assert_equal Language["ECL"], results.first
+  end
 
   def test_ts_typescript_by_heuristics
     languages = ["TypeScript", "XML"]
@@ -62,4 +74,14 @@ class TestHeuristcs < Test::Unit::TestCase
     results = Heuristics.disambiguate_ts(fixture("XML/pt_BR.xml"), languages)
     assert_equal Language["XML"], results.first
   end
+
+  def test_cl_by_heuristics
+    languages = ["Common Lisp", "OpenCL"]
+    languages.each do |language|
+      all_fixtures(language).each do |fixture|
+        results = Heuristics.disambiguate_cl(fixture("#{language}/#{File.basename(fixture)}"), languages)
+        assert_equal Language[language], results.first
+      end
+    end
+  end
 end