Merge pull request #2264 from github/grammar-update

Updating grammars

.gitmodules

@@ -645,3 +645,9 @@
 [submodule "vendor/grammars/perl.tmbundle"]
 	path = vendor/grammars/perl.tmbundle
 	url = https://github.com/textmate/perl.tmbundle
+[submodule "vendor/grammars/sublime-netlinx"]
+	path = vendor/grammars/sublime-netlinx
+	url = https://github.com/amclain/sublime-netlinx
+[submodule "vendor/grammars/Sublime-Red"]
+	path = vendor/grammars/Sublime-Red
+	url = https://github.com/Oldes/Sublime-Red

github-linguist.gemspec

@@ -16,7 +16,7 @@ Gem::Specification.new do |s|
   s.add_dependency 'charlock_holmes', '~> 0.7.3'
   s.add_dependency 'escape_utils',    '~> 1.0.1'
   s.add_dependency 'mime-types',      '>= 1.19'
-  s.add_dependency 'rugged',          '~> 0.22.0b4'
+  s.add_dependency 'rugged',          '~> 0.23.0b1'
 
   s.add_development_dependency 'minitest', '>= 5.0'
   s.add_development_dependency 'mocha'

grammars.yml

@@ -113,6 +113,8 @@ vendor/grammars/Sublime-QML:
 - source.qml
 vendor/grammars/Sublime-REBOL:
 - source.rebol
+vendor/grammars/Sublime-Red:
+- source.red
 vendor/grammars/Sublime-SQF-Language:
 - source.sqf
 vendor/grammars/Sublime-Text-2-OpenEdge-ABL:
@@ -475,6 +477,9 @@ vendor/grammars/sublime-idris:
 - source.idris
 vendor/grammars/sublime-mask:
 - source.mask
+vendor/grammars/sublime-netlinx:
+- source.netlinx
+- source.netlinx.erb
 vendor/grammars/sublime-nginx:
 - source.nginx
 vendor/grammars/sublime-nix:

lib/linguist/generated.rb

@@ -58,6 +58,7 @@ module Linguist
       godeps? ||
       generated_by_zephir? ||
       minified_files? ||
+      source_map? ||
       compiled_coffeescript? ||
       generated_parser? ||
       generated_net_docfile? ||
@@ -96,6 +97,20 @@ module Linguist
       end
     end
 
+    # Internal: Is the blob a generated source map?
+    #
+    # Source Maps usually have .css.map or .js.map extensions. In case they
+    # are not following the name convention, detect them based on the content.
+    #
+    # Returns true or false.
+    def source_map?
+      return false unless extname.downcase == '.map'
+
+      name =~ /(\.css|\.js)\.map$/i ||                 # Name convention
+      lines[0] =~ /^{"version":\d+,/ ||                # Revision 2 and later begin with the version number
+      lines[0] =~ /^\/\*\* Begin line maps\. \*\*\/{/  # Revision 1 begins with a magic comment
+    end
+
     # Internal: Is the blob of JS generated by CoffeeScript?
     #
     # CoffeeScript is meant to output JS that would be difficult to

lib/linguist/heuristics.rb

@@ -164,7 +164,7 @@ module Linguist
       end
     end
 
-    disambiguate "FORTRAN", "Forth" do |data|
+    disambiguate "FORTRAN", "Forth", "Formatted" do |data|
       if /^: /.match(data)
         Language["Forth"]
       elsif /^([c*][^a-z]|      (subroutine|program)\s|\s*!)/i.match(data)
@@ -261,5 +261,22 @@ module Linguist
         Language["Makefile"]
       end
     end
+
+    disambiguate "OCaml", "Standard ML" do |data|
+      if /module|let rec |match\s+(\S+\s)+with/.match(data)
+        Language["OCaml"]
+      elsif /=> |case\s+(\S+\s)+of/.match(data)
+        Language["Standard ML"]
+      end
+    end
+
+    disambiguate "NL", "NewLisp" do |data|
+      if /^g3 /.match(data)
+        Language["NL"]
+      else
+        Language["NewLisp"]
+      end
+    end
+
   end
 end

lib/linguist/languages.yml

@@ -150,7 +150,6 @@ ApacheConf:
   - apache
   extensions:
   - .apacheconf
-  - .conf
   tm_scope: source.apache-config
   ace_mode: apache_conf
 
@@ -516,6 +515,7 @@ Clojure:
   color: "#db5855"
   extensions:
   - .clj
+  - .boot
   - .cl2
   - .cljc
   - .cljs
@@ -711,6 +711,8 @@ DM:
 
 DTrace:
   type: programming
+  aliases:
+  - dtrace-script
   extensions:
   - .d
   interpreters:
@@ -719,7 +721,7 @@ DTrace:
   ace_mode: c_cpp
 
 Darcs Patch:
-  type: programming
+  type: data
   search_term: dpatch
   aliases:
   - dpatch
@@ -737,12 +739,14 @@ Dart:
   ace_mode: dart
 
 Diff:
-  type: programming
+  type: data
+  color: "#88dddd"
   extensions:
   - .diff
   - .patch
   aliases:
   - udiff
+  tm_scope: source.diff
   ace_mode: diff
 
 Dockerfile:
@@ -931,6 +935,13 @@ Fantom:
   tm_scope: source.fan
   ace_mode: text
 
+Formatted:
+  type: data
+  extensions:
+  - .for
+  tm_scope: none
+  ace_mode: text
+
 Forth:
   type: programming
   color: "#341708"
@@ -1149,7 +1160,7 @@ Graphviz (DOT):
   ace_mode: text
 
 Groff:
-  type: programming
+  type: markup
   extensions:
   - .man
   - '.1'
@@ -1259,6 +1270,7 @@ Haml:
 
 Handlebars:
   type: markup
+  color: "#01a9d6"
   aliases:
   - hbs
   - htmlbars
@@ -1945,6 +1957,24 @@ Nemerle:
   - .n
   ace_mode: text
 
+NetLinx:
+  type: programming
+  color: "#0000ff"
+  extensions:
+  - .axs
+  - .axi
+  tm_scope: source.netlinx
+  ace_mode: text
+
+NetLinx+ERB:
+  type: programming
+  color: "#407fff"
+  extensions:
+  - .axs.erb
+  - .axi.erb
+  tm_scope: source.netlinx.erb
+  ace_mode: text
+
 NetLogo:
   type: programming
   color: "#ff2b2b"
@@ -2203,7 +2233,7 @@ PHP:
   aliases:
   - inc
 
-#Oracle 
+#Oracle
 PLSQL:
   type: programming
   ace_mode: sql
@@ -2216,7 +2246,7 @@ PLSQL:
   - .plsql
   - .sql
 
-#Postgres 
+#Postgres
 PLpgSQL:
   type: programming
   ace_mode: pgsql
@@ -2584,6 +2614,8 @@ Racket:
   - .rktd
   - .rktl
   - .scrbl
+  interpreters:
+  - racket
   tm_scope: source.racket
   ace_mode: lisp
 
@@ -2618,6 +2650,7 @@ Rebol:
   - .r3
   - .rebol
   ace_mode: text
+  tm_scope: source.rebol
 
 Red:
   type: programming
@@ -2627,7 +2660,7 @@ Red:
   - .reds
   aliases:
   - red/system
-  tm_scope: none
+  tm_scope: source.red
   ace_mode: text
 
 Redcode:
@@ -2837,7 +2870,6 @@ Scheme:
   - .ss
   interpreters:
   - guile
-  - racket
   - bigloo
   - chicken
   ace_mode: scheme
@@ -3194,12 +3226,15 @@ VimL:
   search_term: vim
   aliases:
   - vim
+  - nvim
   extensions:
   - .vim
   filenames:
+  - .nvimrc
   - .vimrc
   - _vimrc
   - gvimrc
+  - nvimrc
   - vimrc
   ace_mode: text
 
@@ -3295,6 +3330,7 @@ XML:
   - .rss
   - .scxml
   - .srdf
+  - .storyboard
   - .stTheme
   - .sublime-snippet
   - .targets
@@ -3318,6 +3354,7 @@ XML:
   - .x3d
   - .xacro
   - .xaml
+  - .xib
   - .xlf
   - .xliff
   - .xmi

lib/linguist/version.rb

@@ -1,3 +1,3 @@
 module Linguist
-  VERSION = "4.5.1"
+  VERSION = "4.5.2"
 end

samples/Clojure/build.boot

@@ -0,0 +1,15 @@
+;; from: https://github.com/boot-clj/boot#configure-task-options
+
+(set-env!
+  :source-paths #{"src"}
+  :dependencies '[[me.raynes/conch "0.8.0"]])
+
+(task-options!
+  pom {:project 'my-project
+       :version "0.1.0"}
+  jar {:manifest {"Foo" "bar"}})
+
+(deftask build
+  "Build my project."
+  []
+  (comp (pom) (jar) (install)))

samples/DTrace/javascript-trace.d

@@ -1,4 +1,4 @@
-/* -*- Mode: C++; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*- */
+/* -*- Mode: dtrace-script; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*- */
 /* ***** BEGIN LICENSE BLOCK *****
  * Version: MPL 1.1/GPL 2.0/LGPL 2.1
  *

samples/NetLinx+ERB/sample.axi.erb

@@ -0,0 +1,78 @@
+(***********************************************************
+    Sample File
+    
+    For testing syntax highlighting
+************************************************************)
+
+#if_not_defined Sample
+#define Sample 1
+(***********************************************************)
+(* System Type : NetLinx                                   *)
+(***********************************************************)
+(*           DEVICE NUMBER DEFINITIONS GO BELOW            *)
+(***********************************************************)
+DEFINE_DEVICE
+
+(***********************************************************)
+(*              CONSTANT DEFINITIONS GO BELOW              *)
+(***********************************************************)
+DEFINE_CONSTANT
+
+<% global_constant_justify = 20 -%>
+// Video Source Select Buttons
+<%=
+    video_sources = {
+        BTN_VID_FOH_PC:   { btn: 11, input: :VID_SRC_FOH_PC },
+        BTN_VID_STAGE_PC: { btn: 12, input: :VID_SRC_STAGE_PC },
+        BTN_VID_BLURAY:   { btn: 13, input: :VID_SRC_BLURAY },
+    }
+    
+    print_constant_hash video_sources.remap(:btn),
+        justify: global_constant_justify
+%>
+
+(***********************************************************)
+(*                    INCLUDES GO BELOW                    *)
+(***********************************************************)
+
+(***********************************************************)
+(*              DATA TYPE DEFINITIONS GO BELOW             *)
+(***********************************************************)
+DEFINE_TYPE
+
+(***********************************************************)
+(*              VARIABLE DEFINITIONS GO BELOW              *)
+(***********************************************************)
+DEFINE_VARIABLE
+
+(***********************************************************)
+(*         SUBROUTINE/FUNCTION DEFINITIONS GO BELOW        *)
+(***********************************************************)
+
+(***********************************************************)
+(*                 STARTUP CODE GOES BELOW                 *)
+(***********************************************************)
+DEFINE_START
+
+(***********************************************************)
+(*                   THE EVENTS GO BELOW                   *)
+(***********************************************************)
+DEFINE_EVENT
+
+// Video Source Select
+<%=
+    justify group(video_sources.remap :input) { |name, input|
+        "[#{@dvTP}, #{name}] = (outputs[VID_DEST_PROJECTOR].input == #{input});"
+    }
+%>
+
+(***********************************************************)
+(*                 THE MAINLINE GOES BELOW                 *)
+(***********************************************************)
+DEFINE_PROGRAM
+
+(***********************************************************)
+(*                     END OF PROGRAM                      *)
+(*          DO NOT PUT ANY CODE BELOW THIS COMMENT         *)
+(***********************************************************)
+#end_if

samples/NetLinx+ERB/sample.axs.erb

@@ -0,0 +1,78 @@
+(***********************************************************
+    Sample File
+    
+    For testing syntax highlighting
+************************************************************)
+
+#if_not_defined Sample
+#define Sample 1
+(***********************************************************)
+(* System Type : NetLinx                                   *)
+(***********************************************************)
+(*           DEVICE NUMBER DEFINITIONS GO BELOW            *)
+(***********************************************************)
+DEFINE_DEVICE
+
+(***********************************************************)
+(*              CONSTANT DEFINITIONS GO BELOW              *)
+(***********************************************************)
+DEFINE_CONSTANT
+
+<% global_constant_justify = 20 -%>
+// Video Source Select Buttons
+<%=
+    video_sources = {
+        BTN_VID_FOH_PC:   { btn: 11, input: :VID_SRC_FOH_PC },
+        BTN_VID_STAGE_PC: { btn: 12, input: :VID_SRC_STAGE_PC },
+        BTN_VID_BLURAY:   { btn: 13, input: :VID_SRC_BLURAY },
+    }
+    
+    print_constant_hash video_sources.remap(:btn),
+        justify: global_constant_justify
+%>
+
+(***********************************************************)
+(*                    INCLUDES GO BELOW                    *)
+(***********************************************************)
+
+(***********************************************************)
+(*              DATA TYPE DEFINITIONS GO BELOW             *)
+(***********************************************************)
+DEFINE_TYPE
+
+(***********************************************************)
+(*              VARIABLE DEFINITIONS GO BELOW              *)
+(***********************************************************)
+DEFINE_VARIABLE
+
+(***********************************************************)
+(*         SUBROUTINE/FUNCTION DEFINITIONS GO BELOW        *)
+(***********************************************************)
+
+(***********************************************************)
+(*                 STARTUP CODE GOES BELOW                 *)
+(***********************************************************)
+DEFINE_START
+
+(***********************************************************)
+(*                   THE EVENTS GO BELOW                   *)
+(***********************************************************)
+DEFINE_EVENT
+
+// Video Source Select
+<%=
+    justify group(video_sources.remap :input) { |name, input|
+        "[#{@dvTP}, #{name}] = (outputs[VID_DEST_PROJECTOR].input == #{input});"
+    }
+%>
+
+(***********************************************************)
+(*                 THE MAINLINE GOES BELOW                 *)
+(***********************************************************)
+DEFINE_PROGRAM
+
+(***********************************************************)
+(*                     END OF PROGRAM                      *)
+(*          DO NOT PUT ANY CODE BELOW THIS COMMENT         *)
+(***********************************************************)
+#end_if

samples/NetLinx/projector.axi

@@ -0,0 +1,132 @@
+(***********************************************************
+    Mock Projector
+    
+    For testing syntax highlighting
+************************************************************)
+
+#if_not_defined MOCK_PROJECTOR
+#define MOCK_PROJECTOR 1
+(***********************************************************)
+(* System Type : NetLinx                                   *)
+(***********************************************************)
+(*           DEVICE NUMBER DEFINITIONS GO BELOW            *)
+(***********************************************************)
+DEFINE_DEVICE
+
+dvPROJECTOR = 5001:1:0;
+
+(***********************************************************)
+(*              CONSTANT DEFINITIONS GO BELOW              *)
+(***********************************************************)
+DEFINE_CONSTANT
+
+// Power States
+POWER_STATE_ON      = 0;
+POWER_STATE_OFF     = 1;
+POWER_STATE_WARMING = 2;
+POWER_STATE_COOLING = 3;
+
+// Inputs
+INPUT_HDMI          = 0;
+INPUT_VGA           = 1;
+INPUT_COMPOSITE     = 2;
+INPUT_SVIDEO        = 3;
+
+(***********************************************************)
+(*                    INCLUDES GO BELOW                    *)
+(***********************************************************)
+
+#include 'amx-lib-log'
+
+(***********************************************************)
+(*              DATA TYPE DEFINITIONS GO BELOW             *)
+(***********************************************************)
+DEFINE_TYPE
+
+struct projector_t
+{
+    integer power_state;
+    integer input;
+    integer lamp_hours;
+}
+
+(***********************************************************)
+(*              VARIABLE DEFINITIONS GO BELOW              *)
+(***********************************************************)
+DEFINE_VARIABLE
+
+volatile projector_t proj_1;
+
+(***********************************************************)
+(*         SUBROUTINE/FUNCTION DEFINITIONS GO BELOW        *)
+(***********************************************************)
+
+define_function initialize(projector_t self)
+{
+    self.power_state = POWER_STATE_OFF;
+    self.input = INPUT_HDMI;
+    self.lamp_hours = 0;
+}
+
+define_function switch_input(projector_t self, integer input)
+{
+    self.input = input;
+    print(LOG_LEVEL_INFO, "'Projector set to input: ', itoa(input)");
+}
+
+(***********************************************************)
+(*                 STARTUP CODE GOES BELOW                 *)
+(***********************************************************)
+DEFINE_START
+
+initialize(proj_1);
+
+(***********************************************************)
+(*                   THE EVENTS GO BELOW                   *)
+(***********************************************************)
+DEFINE_EVENT
+
+data_event[dvPROJECTOR]
+{
+    string:
+    {
+        parse_message(data.text);
+    }
+    
+    command: {}
+    online:  {}
+    offline: {}
+}
+
+button_event[dvTP, BTN_HDMI]
+button_event[dvTP, BTN_VGA]
+button_event[dvTP, BTN_COMPOSITE]
+button_event[dvTP, BTN_SVIDEO]
+{
+    push:
+    {
+        switch (button.input.channel)
+        {
+            case BTN_HDMI:      switch_input(proj_1, INPUT_HDMI);
+            case BTN_VGA:       switch_input(proj_1, INPUT_VGA);
+            case BTN_COMPOSITE: switch_input(proj_1, INPUT_COMPOSITE);
+            case BTN_SVIDEO:    switch_input(proj_1, INPUT_SVIDEO);
+        }
+    }
+    
+    release: {}
+}
+
+(***********************************************************)
+(*                 THE MAINLINE GOES BELOW                 *)
+(***********************************************************)
+DEFINE_PROGRAM
+
+[dvTP, BTN_POWER_ON]  = (proj_1.power_state == POWER_STATE_ON);
+[dvTP, BTN_POWER_OFF] = (proj_1.power_state == POWER_STATE_OFF);
+
+(***********************************************************)
+(*                     END OF PROGRAM                      *)
+(*          DO NOT PUT ANY CODE BELOW THIS COMMENT         *)
+(***********************************************************)
+#end_if

samples/NetLinx/volume-array.axs

@@ -0,0 +1,158 @@
+(***********************************************************
+    AMX VOLUME CONTROL
+    VOLUME ARRAY EXAMPLE
+    
+    Website: https://sourceforge.net/projects/amx-lib-volume/
+    
+    
+    This application demonstrates the use of volume control
+    arrays using the amx-lib-volume library.
+    
+    Volume control operation can be viewed by watching the
+    master's internal diagnostic output.
+    
+    I/O PORT CONNECTIONS:
+    Ch 1: Volume Up Button
+    Ch 2: Volume Down Button
+************************************************************
+Copyright 2011, 2012, 2014 Alex McLain
+
+Licensed under the Apache License, Version 2.0 (the "License");
+you may not use this file except in compliance with the License.
+You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+Unless required by applicable law or agreed to in writing, software
+distributed under the License is distributed on an "AS IS" BASIS,
+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+See the License for the specific language governing permissions and
+limitations under the License.
+************************************************************)
+
+PROGRAM_NAME='volume array'
+(***********************************************************)
+(***********************************************************)
+(* System Type : NetLinx                                   *)
+(***********************************************************)
+(* REV HISTORY:                                            *)
+(***********************************************************)
+(*
+    $History: See version control repository.
+*)
+(***********************************************************)
+(*                   INCLUDES GO BELOW                     *)
+(***********************************************************)
+
+// Include the volume control library.
+#include 'amx-lib-volume'
+
+(***********************************************************)
+(*          DEVICE NUMBER DEFINITIONS GO BELOW             *)
+(***********************************************************)
+DEFINE_DEVICE
+
+dvDebug = 0:0:0;        // For debug output.
+
+dvIO    = 36000:1:0;    // Volume up/down button connections.
+
+(***********************************************************)
+(*               CONSTANT DEFINITIONS GO BELOW             *)
+(***********************************************************)
+DEFINE_CONSTANT
+
+// Volume control indexes.
+MIC1    = 1;    // Microphone 1.
+MIC2    = 2;    // Microphone 2.
+MIC3    = 3;    // Microphone 3.
+MIC4    = 4;    // Microphone 4.
+WLS1    = 5;    // Wireless mic 1.
+WLS2    = 6;    // Wireless mic 2.
+IPOD    = 7;    // iPod input.
+CD      = 8;    // CD player input.
+
+(***********************************************************)
+(*              DATA TYPE DEFINITIONS GO BELOW             *)
+(***********************************************************)
+DEFINE_TYPE
+
+(***********************************************************)
+(*               VARIABLE DEFINITIONS GO BELOW             *)
+(***********************************************************)
+DEFINE_VARIABLE
+
+// Define a volume control array for the input devices.
+volume inputs[8];
+
+(***********************************************************)
+(*               LATCHING DEFINITIONS GO BELOW             *)
+(***********************************************************)
+DEFINE_LATCHING
+
+(***********************************************************)
+(*       MUTUALLY EXCLUSIVE DEFINITIONS GO BELOW           *)
+(***********************************************************)
+DEFINE_MUTUALLY_EXCLUSIVE
+
+(***********************************************************)
+(*        SUBROUTINE/FUNCTION DEFINITIONS GO BELOW         *)
+(***********************************************************)
+(* EXAMPLE: DEFINE_FUNCTION <RETURN_TYPE> <NAME> (<PARAMETERS>) *)
+(* EXAMPLE: DEFINE_CALL '<NAME>' (<PARAMETERS>) *)
+
+(***********************************************************)
+(*                STARTUP CODE GOES BELOW                  *)
+(***********************************************************)
+DEFINE_START
+
+// Initialize the array of volume controls.
+volArrayInit(inputs, 0, VOL_UNMUTED, 10000, 20000, 5);
+
+(***********************************************************)
+(*                THE EVENTS GO BELOW                      *)
+(***********************************************************)
+DEFINE_EVENT
+
+// Volume Up
+button_event[dvIO, 1]
+{
+    PUSH:
+    {
+        volArrayIncrement(inputs); // Increment the volume up a step.
+        send_string dvDebug, "'Volume Up MIC1: ', itoa(volGetLevel(inputs[MIC1]))";
+        send_string dvDebug, "'Volume Up MIC2: ', itoa(volGetLevel(inputs[MIC2]))";
+        send_string dvDebug, "'Volume Up MIC3: ', itoa(volGetLevel(inputs[MIC3]))";
+        send_string dvDebug, "'Volume Up MIC4: ', itoa(volGetLevel(inputs[MIC4]))";
+        send_string dvDebug, "'Volume Up WLS1: ', itoa(volGetLevel(inputs[WLS1]))";
+        send_string dvDebug, "'Volume Up WLS2: ', itoa(volGetLevel(inputs[WLS2]))";
+        send_string dvDebug, "'Volume Up IPOD: ', itoa(volGetLevel(inputs[IPOD]))";
+        send_string dvDebug, "'Volume Up   CD: ', itoa(volGetLevel(inputs[CD]))";
+    }
+}
+
+// Volume Down
+button_event[dvIO, 2]
+{
+    PUSH:
+    {
+        volArrayDecrement(inputs); // Decrement the volume down a step.
+        send_string dvDebug, "'Volume Dn MIC1: ', itoa(volGetLevel(inputs[MIC1]))";
+        send_string dvDebug, "'Volume Dn MIC2: ', itoa(volGetLevel(inputs[MIC2]))";
+        send_string dvDebug, "'Volume Dn MIC3: ', itoa(volGetLevel(inputs[MIC3]))";
+        send_string dvDebug, "'Volume Dn MIC4: ', itoa(volGetLevel(inputs[MIC4]))";
+        send_string dvDebug, "'Volume Dn WLS1: ', itoa(volGetLevel(inputs[WLS1]))";
+        send_string dvDebug, "'Volume Dn WLS2: ', itoa(volGetLevel(inputs[WLS2]))";
+        send_string dvDebug, "'Volume Dn IPOD: ', itoa(volGetLevel(inputs[IPOD]))";
+        send_string dvDebug, "'Volume Dn   CD: ', itoa(volGetLevel(inputs[CD]))";
+    }
+}
+
+(***********************************************************)
+(*            THE ACTUAL PROGRAM GOES BELOW                *)
+(***********************************************************)
+DEFINE_PROGRAM
+
+(***********************************************************)
+(*                     END OF PROGRAM                      *)
+(*        DO NOT PUT ANY CODE BELOW THIS COMMENT           *)
+(***********************************************************)

samples/OCaml/common.ml

@@ -0,0 +1,14 @@
+(*
+ * Copyright (c) 2013 Jeremy Yallop.
+ *
+ * This file is distributed under the terms of the MIT License.
+ * See the file LICENSE for details.
+ *)
+
+let string_of format v = 
+  let buf = Buffer.create 100 in
+  let fmt = Format.formatter_of_buffer buf in begin
+    format fmt v;
+    Format.pp_print_flush fmt ();
+    Buffer.contents buf
+  end

samples/OCaml/date.ml

@@ -0,0 +1,40 @@
+(*
+ * Copyright (c) 2013 Jeremy Yallop.
+ *
+ * This file is distributed under the terms of the MIT License.
+ * See the file LICENSE for details.
+ *)
+
+open Ctypes
+open PosixTypes
+open Foreign
+
+type tm
+let tm = structure "tm"
+let (-:) ty label = field tm label ty
+let tm_sec   = int -: "tm_sec"   (* seconds *)
+let tm_min   = int -: "tm_min"   (* minutes *)
+let tm_hour  = int -: "tm_hour"  (* hours *)
+let tm_mday  = int -: "tm_mday"  (* day of the month *)
+let tm_mon   = int -: "tm_mon"   (* month *)
+let tm_year  = int -: "tm_year"  (* year *)
+let tm_wday  = int -: "tm_wday"  (* day of the week *)
+let tm_yday  = int -: "tm_yday"  (* day in the year *)
+let tm_isdst = int -: "tm_isdst" (* daylight saving time *)
+let () = seal (tm : tm structure typ)
+
+let time = foreign "time" ~check_errno:true (ptr time_t @-> returning time_t)
+
+let asctime = foreign "asctime" (ptr tm @-> returning string)
+
+let localtime = foreign "localtime" (ptr time_t @-> returning (ptr tm))
+
+let () = begin
+  let timep = allocate_n ~count:1 time_t in
+  let time = time timep in
+  assert (time = !@timep);
+  let tm = localtime timep in
+  Printf.printf "tm.tm_mon  = %d\n" (getf !@tm tm_mon);
+  Printf.printf "tm.tm_year = %d\n" (getf !@tm tm_year);
+  print_endline (asctime tm)
+end

samples/OCaml/map.ml

@@ -0,0 +1,337 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the GNU Library General Public License, with    *)
+(*  the special exception on linking described in file ../LICENSE.     *)
+(*                                                                     *)
+(***********************************************************************)
+
+module type OrderedType =
+  sig
+    type t
+    val compare: t -> t -> int
+  end
+
+module type S =
+  sig
+    type key
+    type +'a t
+    val empty: 'a t
+    val is_empty: 'a t -> bool
+    val mem:  key -> 'a t -> bool
+    val add: key -> 'a -> 'a t -> 'a t
+    val singleton: key -> 'a -> 'a t
+    val remove: key -> 'a t -> 'a t
+    val merge:
+          (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t
+    val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
+    val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+    val iter: (key -> 'a -> unit) -> 'a t -> unit
+    val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+    val for_all: (key -> 'a -> bool) -> 'a t -> bool
+    val exists: (key -> 'a -> bool) -> 'a t -> bool
+    val filter: (key -> 'a -> bool) -> 'a t -> 'a t
+    val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
+    val cardinal: 'a t -> int
+    val bindings: 'a t -> (key * 'a) list
+    val min_binding: 'a t -> (key * 'a)
+    val max_binding: 'a t -> (key * 'a)
+    val choose: 'a t -> (key * 'a)
+    val split: key -> 'a t -> 'a t * 'a option * 'a t
+    val find: key -> 'a t -> 'a
+    val map: ('a -> 'b) -> 'a t -> 'b t
+    val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
+  end
+
+module Make(Ord: OrderedType) = struct
+
+    type key = Ord.t
+
+    type 'a t =
+        Empty
+      | Node of 'a t * key * 'a * 'a t * int
+
+    let height = function
+        Empty -> 0
+      | Node(_,_,_,_,h) -> h
+
+    let create l x d r =
+      let hl = height l and hr = height r in
+      Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
+
+    let singleton x d = Node(Empty, x, d, Empty, 1)
+
+    let bal l x d r =
+      let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in
+      let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in
+      if hl > hr + 2 then begin
+        match l with
+          Empty -> invalid_arg "Map.bal"
+        | Node(ll, lv, ld, lr, _) ->
+            if height ll >= height lr then
+              create ll lv ld (create lr x d r)
+            else begin
+              match lr with
+                Empty -> invalid_arg "Map.bal"
+              | Node(lrl, lrv, lrd, lrr, _)->
+                  create (create ll lv ld lrl) lrv lrd (create lrr x d r)
+            end
+      end else if hr > hl + 2 then begin
+        match r with
+          Empty -> invalid_arg "Map.bal"
+        | Node(rl, rv, rd, rr, _) ->
+            if height rr >= height rl then
+              create (create l x d rl) rv rd rr
+            else begin
+              match rl with
+                Empty -> invalid_arg "Map.bal"
+              | Node(rll, rlv, rld, rlr, _) ->
+                  create (create l x d rll) rlv rld (create rlr rv rd rr)
+            end
+      end else
+        Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
+
+    let empty = Empty
+
+    let is_empty = function Empty -> true | _ -> false
+
+    let rec add x data = function
+        Empty ->
+          Node(Empty, x, data, Empty, 1)
+      | Node(l, v, d, r, h) ->
+          let c = Ord.compare x v in
+          if c = 0 then
+            Node(l, x, data, r, h)
+          else if c < 0 then
+            bal (add x data l) v d r
+          else
+            bal l v d (add x data r)
+
+    let rec find x = function
+        Empty ->
+          raise Not_found
+      | Node(l, v, d, r, _) ->
+          let c = Ord.compare x v in
+          if c = 0 then d
+          else find x (if c < 0 then l else r)
+
+    let rec mem x = function
+        Empty ->
+          false
+      | Node(l, v, d, r, _) ->
+          let c = Ord.compare x v in
+          c = 0 || mem x (if c < 0 then l else r)
+
+    let rec min_binding = function
+        Empty -> raise Not_found
+      | Node(Empty, x, d, r, _) -> (x, d)
+      | Node(l, x, d, r, _) -> min_binding l
+
+    let rec max_binding = function
+        Empty -> raise Not_found
+      | Node(l, x, d, Empty, _) -> (x, d)
+      | Node(l, x, d, r, _) -> max_binding r
+
+    let rec remove_min_binding = function
+        Empty -> invalid_arg "Map.remove_min_elt"
+      | Node(Empty, x, d, r, _) -> r
+      | Node(l, x, d, r, _) -> bal (remove_min_binding l) x d r
+
+    let merge t1 t2 =
+      match (t1, t2) with
+        (Empty, t) -> t
+      | (t, Empty) -> t
+      | (_, _) ->
+          let (x, d) = min_binding t2 in
+          bal t1 x d (remove_min_binding t2)
+
+    let rec remove x = function
+        Empty ->
+          Empty
+      | Node(l, v, d, r, h) ->
+          let c = Ord.compare x v in
+          if c = 0 then
+            merge l r
+          else if c < 0 then
+            bal (remove x l) v d r
+          else
+            bal l v d (remove x r)
+
+    let rec iter f = function
+        Empty -> ()
+      | Node(l, v, d, r, _) ->
+          iter f l; f v d; iter f r
+
+    let rec map f = function
+        Empty ->
+          Empty
+      | Node(l, v, d, r, h) ->
+          let l' = map f l in
+          let d' = f d in
+          let r' = map f r in
+          Node(l', v, d', r', h)
+
+    let rec mapi f = function
+        Empty ->
+          Empty
+      | Node(l, v, d, r, h) ->
+          let l' = mapi f l in
+          let d' = f v d in
+          let r' = mapi f r in
+          Node(l', v, d', r', h)
+
+    let rec fold f m accu =
+      match m with
+        Empty -> accu
+      | Node(l, v, d, r, _) ->
+          fold f r (f v d (fold f l accu))
+
+    let rec for_all p = function
+        Empty -> true
+      | Node(l, v, d, r, _) -> p v d && for_all p l && for_all p r
+
+    let rec exists p = function
+        Empty -> false
+      | Node(l, v, d, r, _) -> p v d || exists p l || exists p r
+
+    (* Beware: those two functions assume that the added k is *strictly*
+       smaller (or bigger) than all the present keys in the tree; it
+       does not test for equality with the current min (or max) key.
+
+       Indeed, they are only used during the "join" operation which
+       respects this precondition.
+    *)
+
+    let rec add_min_binding k v = function
+      | Empty -> singleton k v
+      | Node (l, x, d, r, h) ->
+        bal (add_min_binding k v l) x d r
+
+    let rec add_max_binding k v = function
+      | Empty -> singleton k v
+      | Node (l, x, d, r, h) ->
+        bal l x d (add_max_binding k v r)
+
+    (* Same as create and bal, but no assumptions are made on the
+       relative heights of l and r. *)
+
+    let rec join l v d r =
+      match (l, r) with
+        (Empty, _) -> add_min_binding v d r
+      | (_, Empty) -> add_max_binding v d l
+      | (Node(ll, lv, ld, lr, lh), Node(rl, rv, rd, rr, rh)) ->
+          if lh > rh + 2 then bal ll lv ld (join lr v d r) else
+          if rh > lh + 2 then bal (join l v d rl) rv rd rr else
+          create l v d r
+
+    (* Merge two trees l and r into one.
+       All elements of l must precede the elements of r.
+       No assumption on the heights of l and r. *)
+
+    let concat t1 t2 =
+      match (t1, t2) with
+        (Empty, t) -> t
+      | (t, Empty) -> t
+      | (_, _) ->
+          let (x, d) = min_binding t2 in
+          join t1 x d (remove_min_binding t2)
+
+    let concat_or_join t1 v d t2 =
+      match d with
+      | Some d -> join t1 v d t2
+      | None -> concat t1 t2
+
+    let rec split x = function
+        Empty ->
+          (Empty, None, Empty)
+      | Node(l, v, d, r, _) ->
+          let c = Ord.compare x v in
+          if c = 0 then (l, Some d, r)
+          else if c < 0 then
+            let (ll, pres, rl) = split x l in (ll, pres, join rl v d r)
+          else
+            let (lr, pres, rr) = split x r in (join l v d lr, pres, rr)
+
+    let rec merge f s1 s2 =
+      match (s1, s2) with
+        (Empty, Empty) -> Empty
+      | (Node (l1, v1, d1, r1, h1), _) when h1 >= height s2 ->
+          let (l2, d2, r2) = split v1 s2 in
+          concat_or_join (merge f l1 l2) v1 (f v1 (Some d1) d2) (merge f r1 r2)
+      | (_, Node (l2, v2, d2, r2, h2)) ->
+          let (l1, d1, r1) = split v2 s1 in
+          concat_or_join (merge f l1 l2) v2 (f v2 d1 (Some d2)) (merge f r1 r2)
+      | _ ->
+          assert false
+
+    let rec filter p = function
+        Empty -> Empty
+      | Node(l, v, d, r, _) ->
+          (* call [p] in the expected left-to-right order *)
+          let l' = filter p l in
+          let pvd = p v d in
+          let r' = filter p r in
+          if pvd then join l' v d r' else concat l' r'
+
+    let rec partition p = function
+        Empty -> (Empty, Empty)
+      | Node(l, v, d, r, _) ->
+          (* call [p] in the expected left-to-right order *)
+          let (lt, lf) = partition p l in
+          let pvd = p v d in
+          let (rt, rf) = partition p r in
+          if pvd
+          then (join lt v d rt, concat lf rf)
+          else (concat lt rt, join lf v d rf)
+
+    type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration
+
+    let rec cons_enum m e =
+      match m with
+        Empty -> e
+      | Node(l, v, d, r, _) -> cons_enum l (More(v, d, r, e))
+
+    let compare cmp m1 m2 =
+      let rec compare_aux e1 e2 =
+          match (e1, e2) with
+          (End, End) -> 0
+        | (End, _)  -> -1
+        | (_, End) -> 1
+        | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
+            let c = Ord.compare v1 v2 in
+            if c <> 0 then c else
+            let c = cmp d1 d2 in
+            if c <> 0 then c else
+            compare_aux (cons_enum r1 e1) (cons_enum r2 e2)
+      in compare_aux (cons_enum m1 End) (cons_enum m2 End)
+
+    let equal cmp m1 m2 =
+      let rec equal_aux e1 e2 =
+          match (e1, e2) with
+          (End, End) -> true
+        | (End, _)  -> false
+        | (_, End) -> false
+        | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
+            Ord.compare v1 v2 = 0 && cmp d1 d2 &&
+            equal_aux (cons_enum r1 e1) (cons_enum r2 e2)
+      in equal_aux (cons_enum m1 End) (cons_enum m2 End)
+
+    let rec cardinal = function
+        Empty -> 0
+      | Node(l, _, _, r, _) -> cardinal l + 1 + cardinal r
+
+    let rec bindings_aux accu = function
+        Empty -> accu
+      | Node(l, v, d, r, _) -> bindings_aux ((v, d) :: bindings_aux accu r) l
+
+    let bindings s =
+      bindings_aux [] s
+
+    let choose = min_binding
+
+end

samples/OCaml/reload.ml

@@ -0,0 +1,125 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+open Cmm
+open Arch
+open Reg
+open Mach
+
+(* Reloading for the AMD64 *)
+
+(* Summary of instruction set constraints:
+   "S" means either stack or register, "R" means register only.
+   Operation                    Res     Arg1    Arg2
+     Imove                      R       S
+                             or S       R
+     Iconst_int                 S if 32-bit signed, R otherwise
+     Iconst_float               R
+     Iconst_symbol (not PIC)    S
+     Iconst_symbol (PIC)        R
+     Icall_ind                          R
+     Itailcall_ind                      R
+     Iload                      R       R       R
+     Istore                             R       R
+     Iintop(Icomp)              R       R       S
+                            or  S       S       R
+     Iintop(Imul|Idiv|mod)      R       R       S
+     Iintop(shift)              S       S       R
+     Iintop(others)             R       R       S
+                            or  S       S       R
+     Iintop_imm(Iadd, n)/lea    R       R
+     Iintop_imm(others)         S       S
+     Inegf...Idivf              R       R       S
+     Ifloatofint                R       S
+     Iintoffloat                R       S
+     Ispecific(Ilea)            R       R       R
+     Ispecific(Ifloatarithmem)  R       R       R
+
+   Conditional branches:
+     Iinttest                           S       R
+                                    or  R       S
+     Ifloattest                         R       S    (or  S R if swapped test)
+     other tests                        S
+*)
+
+let stackp r =
+  match r.loc with
+    Stack _ -> true
+  | _ -> false
+
+class reload = object (self)
+
+inherit Reloadgen.reload_generic as super
+
+method! reload_operation op arg res =
+  match op with
+  | Iintop(Iadd|Isub|Iand|Ior|Ixor|Icomp _|Icheckbound) ->
+      (* One of the two arguments can reside in the stack, but not both *)
+      if stackp arg.(0) && stackp arg.(1)
+      then ([|arg.(0); self#makereg arg.(1)|], res)
+      else (arg, res)
+  | Iintop_imm(Iadd, _) when arg.(0).loc <> res.(0).loc ->
+      (* This add will be turned into a lea; args and results must be
+         in registers *)
+      super#reload_operation op arg res
+  | Iintop(Idiv | Imod | Ilsl | Ilsr | Iasr)
+  | Iintop_imm(_, _) ->
+      (* The argument(s) and results can be either in register or on stack *)
+      (* Note: Idiv, Imod: arg(0) and res(0) already forced in regs
+               Ilsl, Ilsr, Iasr: arg(1) already forced in regs *)
+      (arg, res)
+  | Iintop(Imul) | Iaddf | Isubf | Imulf | Idivf ->
+      (* First argument (= result) must be in register, second arg
+         can reside in the stack *)
+      if stackp arg.(0)
+      then (let r = self#makereg arg.(0) in ([|r; arg.(1)|], [|r|]))
+      else (arg, res)
+  | Ifloatofint | Iintoffloat ->
+      (* Result must be in register, but argument can be on stack *)
+      (arg, (if stackp res.(0) then [| self#makereg res.(0) |] else res))
+  | Iconst_int n ->
+      if n <= 0x7FFFFFFFn && n >= -0x80000000n
+      then (arg, res)
+      else super#reload_operation op arg res
+  | Iconst_symbol _ ->
+      if !pic_code || !Clflags.dlcode
+      then super#reload_operation op arg res
+      else (arg, res)
+  | _ -> (* Other operations: all args and results in registers *)
+      super#reload_operation op arg res
+
+method! reload_test tst arg =
+  match tst with
+    Iinttest cmp ->
+      (* One of the two arguments can reside on stack *)
+      if stackp arg.(0) && stackp arg.(1)
+      then [| self#makereg arg.(0); arg.(1) |]
+      else arg
+  | Ifloattest((Clt|Cle), _) ->
+      (* Cf. emit.mlp: we swap arguments in this case *)
+      (* First argument can be on stack, second must be in register *)
+      if stackp arg.(1)
+      then [| arg.(0); self#makereg arg.(1) |]
+      else arg
+  | Ifloattest((Ceq|Cne|Cgt|Cge), _) ->
+      (* Second argument can be on stack, first must be in register *)
+      if stackp arg.(0)
+      then [| self#makereg arg.(0); arg.(1) |]
+      else arg
+  | _ ->
+      (* The argument(s) can be either in register or on stack *)
+      arg
+
+end
+
+let fundecl f =
+  (new reload)#fundecl f

samples/OCaml/sigset.ml

@@ -0,0 +1,70 @@
+(*
+ * Copyright (c) 2013 Jeremy Yallop.
+ *
+ * This file is distributed under the terms of the MIT License.
+ * See the file LICENSE for details.
+ *)
+
+open PosixTypes
+open Ctypes
+open Foreign
+
+type t = sigset_t ptr
+
+let t = ptr sigset_t
+
+(* This function initializes the signal set set to exclude all of the defined
+   signals. It always returns 0.  *)
+let sigemptyset = foreign "sigemptyset" (ptr sigset_t @-> returning int)
+
+let empty () =
+  let setp = allocate_n ~count:1 sigset_t in begin
+    ignore (sigemptyset setp);
+    setp
+  end
+
+(* This function initializes the signal set set to include all of the defined
+   signals. Again, the return value is 0. *)
+let sigfillset = foreign "sigfillset" (ptr sigset_t @-> returning int)
+
+let full () =
+  let setp = allocate_n ~count:1 sigset_t in begin
+    ignore (sigfillset setp);
+    setp
+  end
+
+(* This function adds the signal signum to the signal set set. All sigaddset
+   does is modify set; it does not block or unblock any signals.
+
+   The return value is 0 on success and -1 on failure. The following errno
+   error condition is defined for this function:
+
+   EINVAL The signum argument doesn't specify a valid signal. 
+*)
+let sigaddset = foreign "sigaddset" ~check_errno:true
+  (ptr sigset_t @-> int @-> returning int)
+
+let add set signal = ignore (sigaddset set signal)
+
+(* This function removes the signal signum from the signal set set. All
+   sigdelset does is modify set; it does not block or unblock any signals.
+
+   The return value and error conditions are the same as for
+   sigaddset.  *)
+let sigdelset = foreign "sigdelset" ~check_errno:true
+  (ptr sigset_t @-> int @-> returning int)
+
+let del set signal = ignore (sigdelset set signal)
+
+(* The sigismember function tests whether the signal signum is a member of the
+   signal set set. It returns 1 if the signal is in the set, 0 if not, and -1 if
+   there is an error.
+
+   The following errno error condition is defined for this function:
+
+   EINVAL The signum argument doesn't specify a valid signal. 
+*)
+let sigismember = foreign "sigismember" ~check_errno:true
+  (ptr sigset_t @-> int @-> returning int)
+
+let mem set signal = sigismember set signal <> 0

samples/OCaml/uutf.ml

@@ -0,0 +1,810 @@
+(*---------------------------------------------------------------------------
+   Copyright 2012 Daniel C. Bünzli. All rights reserved.
+   Distributed under the BSD3 license, see license at the end of the file.
+   %%NAME%% release %%VERSION%%
+  ---------------------------------------------------------------------------*)
+
+let io_buffer_size = 65536                           (* IO_BUFFER_SIZE 4.0.0 *)
+
+let pp = Format.fprintf
+let invalid_encode () = invalid_arg "expected `Await encode"
+let invalid_bounds j l =
+  invalid_arg (Printf.sprintf "invalid bounds (index %d, length %d)" j l)
+
+(* Unsafe string byte manipulations. If you don't believe the author's
+   invariants, replacing with safe versions makes everything safe in
+   the module. He won't be upset. *)
+
+let unsafe_chr = Char.unsafe_chr
+let unsafe_blit = String.unsafe_blit
+let unsafe_array_get = Array.unsafe_get
+let unsafe_byte s j = Char.code (String.unsafe_get s j)
+let unsafe_set_byte s j byte = String.unsafe_set s j (Char.unsafe_chr byte)
+
+(* Unicode characters *)
+
+type uchar = int
+let u_bom = 0xFEFF                                                   (* BOM. *)
+let u_rep = 0xFFFD                                 (* replacement character. *)
+let is_uchar cp =
+  (0x0000 <= cp && cp <= 0xD7FF) || (0xE000 <= cp && cp <= 0x10FFFF)
+
+let pp_cp ppf cp =
+  if cp < 0 || cp > 0x10FFFF then pp ppf "U+Invalid(%X)" cp else
+  if cp <= 0xFFFF then pp ppf "U+%04X" cp else
+  pp ppf "U+%X" cp
+
+let cp_to_string cp =                                    (* NOT thread safe. *)
+  pp Format.str_formatter "%a" pp_cp cp; Format.flush_str_formatter ()
+
+(* Unicode encoding schemes *)
+
+type encoding = [ `UTF_8 | `UTF_16 | `UTF_16BE | `UTF_16LE ]
+type decoder_encoding = [ encoding | `US_ASCII | `ISO_8859_1 ]
+
+let encoding_of_string s = match String.uppercase s with      (* IANA names. *)
+| "UTF-8" -> Some `UTF_8
+| "UTF-16" -> Some `UTF_16
+| "UTF-16LE" -> Some `UTF_16LE
+| "UTF-16BE" -> Some `UTF_16BE
+| "ANSI_X3.4-1968" | "ISO-IR-6" | "ANSI_X3.4-1986" | "ISO_646.IRV:1991"
+| "ASCII" | "ISO646-US" | "US-ASCII" | "US" | "IBM367" | "CP367" | "CSASCII" ->
+    Some `US_ASCII
+| "ISO_8859-1:1987" | "ISO-IR-100" | "ISO_8859-1" | "ISO-8859-1"
+| "LATIN1" | "L1" | "IBM819" | "CP819" | "CSISOLATIN1" ->
+    Some `ISO_8859_1
+| _ -> None
+
+let encoding_to_string = function
+| `UTF_8 -> "UTF-8" | `UTF_16 -> "UTF-16" | `UTF_16BE -> "UTF-16BE"
+| `UTF_16LE -> "UTF-16LE" | `US_ASCII -> "US-ASCII"
+| `ISO_8859_1 -> "ISO-8859-1"
+
+(* Base character decoders. They assume enough data. *)
+
+let malformed s j l = `Malformed (String.sub s j l)
+let malformed_pair be hi s j l =    (* missing or half low surrogate at eoi. *)
+  let bs1 = String.sub s j l in
+  let bs0 = String.create 2 in
+  let j0, j1 = if be then (0, 1) else (1, 0) in
+  unsafe_set_byte bs0 j0 (hi lsr 8);
+  unsafe_set_byte bs0 j1 (hi land 0xFF);
+  `Malformed (bs0 ^ bs1)
+
+let r_us_ascii s j =
+  (* assert (0 <= j && j < String.length s); *)
+  let b0 = unsafe_byte s j in
+  if b0 <= 127 then `Uchar b0 else malformed s j 1
+
+let r_iso_8859_1 s j =
+  (* assert (0 <= j && j < String.length s); *)
+  `Uchar (unsafe_byte s j)
+
+let utf_8_len = [| (* uchar byte length according to first UTF-8 byte. *)
+  1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1;
+  1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1;
+  1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1;
+  1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1;
+  1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1; 1;
+  1; 1; 1; 1; 1; 1; 1; 1; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
+  0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
+  0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0;
+  0; 0; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2; 2;
+  2; 2; 2; 2; 2; 2; 2; 2; 3; 3; 3; 3; 3; 3; 3; 3; 3; 3; 3; 3; 3; 3; 3; 3;
+  4; 4; 4; 4; 4; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0 |]
+
+let r_utf_8 s j l =
+  (* assert (0 <= j && 0 <= l && j + l <= String.length s); *)
+  match l with
+  | 1 -> `Uchar (unsafe_byte s j)
+  | 2 ->
+      let b0 = unsafe_byte s j in let b1 = unsafe_byte s (j + 1) in
+      if b1 lsr 6 != 0b10 then malformed s j l else
+      `Uchar (((b0 land 0x1F) lsl 6) lor (b1 land 0x3F))
+  | 3 ->
+      let b0 = unsafe_byte s j in let b1 = unsafe_byte s (j + 1) in
+      let b2 = unsafe_byte s (j + 2) in
+      let c = `Uchar (((b0 land 0x0F) lsl 12) lor
+                      ((b1 land 0x3F) lsl 6) lor
+          (b2 land 0x3F))
+      in
+      if b2 lsr 6 != 0b10 then malformed s j l else
+      begin match b0 with
+      | 0xE0 -> if b1 < 0xA0 || 0xBF < b1 then malformed s j l else c
+      | 0xED -> if b1 < 0x80 || 0x9F < b1 then malformed s j l else c
+      | _ -> if b1 lsr 6 != 0b10 then malformed s j l else c
+      end
+  | 4 ->
+      let b0 = unsafe_byte s j in let b1 = unsafe_byte s (j + 1) in
+      let b2 = unsafe_byte s (j + 2) in let b3 = unsafe_byte s (j + 3) in
+      let c = `Uchar (((b0 land 0x07) lsl 18) lor
+                      ((b1 land 0x3F) lsl 12) lor
+          ((b2 land 0x3F) lsl 6) lor
+                      (b3 land 0x3F))
+      in
+      if b3 lsr 6 != 0b10 || b2 lsr 6 != 0b10 then malformed s j l else
+      begin match b0 with
+      | 0xF0 -> if b1 < 0x90 || 0xBF < b1 then malformed s j l else c
+      | 0xF4 -> if b1 < 0x80 || 0x8F < b1 then malformed s j l else c
+      | _ -> if b1 lsr 6 != 0b10 then malformed s j l else c
+      end
+  | _ -> assert false
+
+let r_utf_16 s j0 j1 =                       (* May return a high surrogate. *)
+  (* assert (0 <= j0 && 0 <= j1 && max j0 j1 < String.length s); *)
+  let b0 = unsafe_byte s j0 in let b1 = unsafe_byte s j1 in
+  let u = (b0 lsl 8) lor b1 in
+  if u < 0xD800 || u > 0xDFFF then `Uchar u else
+  if u > 0xDBFF then malformed s (min j0 j1) 2 else `Hi u
+
+let r_utf_16_lo hi s j0 j1 =          (* Combines [hi] with a low surrogate. *)
+  (* assert (0 <= j0 && 0 <= j1 && max j0 j1 < String.length s); *)
+  let b0 = unsafe_byte s j0 in
+  let b1 = unsafe_byte s j1 in
+  let lo = (b0 lsl 8) lor b1 in
+  if lo < 0xDC00 || lo > 0xDFFF
+  then malformed_pair (j0 < j1 (* true => be *)) hi s (min j0 j1) 2
+  else `Uchar ((((hi land 0x3FF) lsl 10) lor (lo land 0x3FF)) + 0x10000)
+
+let r_encoding s j l =                  (* guess encoding with max. 3 bytes. *)
+  (* assert (0 <= j && 0 <= l && j + l <= String.length s) *)
+  let some i = if i < l then Some (unsafe_byte s (j + i)) else None in
+  match (some 0), (some 1), (some 2) with
+  | Some 0xEF, Some 0xBB, Some 0xBF                 -> `UTF_8 `BOM
+  | Some 0xFE, Some 0xFF, _                         -> `UTF_16BE `BOM
+  | Some 0xFF, Some 0xFE, _                         -> `UTF_16LE `BOM
+  | Some 0x00, Some    p, _              when p > 0 -> `UTF_16BE (`ASCII p)
+  | Some    p, Some 0x00, _              when p > 0 -> `UTF_16LE (`ASCII p)
+  | Some    u,         _, _ when utf_8_len.(u) <> 0 -> `UTF_8 `Decode
+  | Some    _, Some    _, _                         -> `UTF_16BE `Decode
+  | Some    _, None     , None                      -> `UTF_8 `Decode
+  | None     , None     , None                      -> `UTF_8 `End
+  | None     , Some    _, _                         -> assert false
+  | Some    _, None     , Some _                    -> assert false
+  | None     , None     , Some _                    -> assert false
+
+(* Decode *)
+
+type src = [ `Channel of in_channel | `String of string | `Manual ]
+type nln = [ `ASCII of uchar | `NLF of uchar | `Readline of uchar ]
+type decode = [ `Await | `End | `Malformed of string | `Uchar of uchar]
+
+let pp_decode ppf = function
+| `Uchar u -> pp ppf "@[`Uchar %a@]" pp_cp u
+| `End -> pp ppf "`End"
+| `Await -> pp ppf "`Await"
+| `Malformed bs ->
+    let l = String.length bs in
+    pp ppf "@[`Malformed (";
+    if l > 0 then pp ppf "%02X" (Char.code (bs.[0]));
+    for i = 1 to l - 1 do pp ppf " %02X" (Char.code (bs.[i])) done;
+    pp ppf ")@]"
+
+type decoder =
+  { src : src;                                              (* input source. *)
+    mutable encoding : decoder_encoding;                (* decoded encoding. *)
+    nln : nln option;                     (* newline normalization (if any). *)
+    nl : int;                            (* newline normalization character. *)
+    mutable i : string;                              (* current input chunk. *)
+    mutable i_pos : int;                          (* input current position. *)
+    mutable i_max : int;                          (* input maximal position. *)
+    t : string;        (* four bytes temporary buffer for overlapping reads. *)
+    mutable t_len : int;                      (* current byte length of [t]. *)
+    mutable t_need : int;                  (* number of bytes needed in [t]. *)
+    mutable removed_bom : bool;     (* [true] if an initial BOM was removed. *)
+    mutable last_cr : bool;                   (* [true] if last char was CR. *)
+    mutable line : int;                                      (* line number. *)
+    mutable col : int;                                     (* column number. *)
+    mutable byte_count : int;                                 (* byte count. *)
+    mutable count : int;                                      (* char count. *)
+    mutable pp :        (* decoder post-processor for BOM, position and nln. *)
+      decoder -> [ `Malformed of string | `Uchar of uchar ] -> decode;
+    mutable k : decoder -> decode }                 (* decoder continuation. *)
+
+(* On decodes that overlap two (or more) [d.i] buffers, we use [t_fill] to copy
+   the input data to [d.t] and decode from there. If the [d.i] buffers are not
+   too small this is faster than continuation based byte per byte writes.
+
+   End of input (eoi) is signalled by [d.i_pos = 0] and [d.i_max = min_int]
+   which implies that [i_rem d < 0] is [true]. *)
+
+let i_rem d = d.i_max - d.i_pos + 1     (* remaining bytes to read in [d.i]. *)
+let eoi d = d.i <- ""; d.i_pos <- 0; d.i_max <- min_int   (* set eoi in [d]. *)
+let src d s j l =                                     (* set [d.i] with [s]. *)
+  if (j < 0 || l < 0 || j + l > String.length s) then invalid_bounds j l else
+  if (l = 0) then eoi d else
+  (d.i <- s; d.i_pos <- j; d.i_max <- j + l - 1)
+
+let refill k d = match d.src with  (* get new input in [d.i] and [k]ontinue. *)
+| `Manual -> d.k <- k; `Await
+| `String _ -> eoi d; k d
+| `Channel ic ->
+    let rc = input ic d.i 0 (String.length d.i) in
+    (src d d.i 0 rc; k d)
+
+let t_need d need = d.t_len <- 0; d.t_need <- need
+let rec t_fill k d =      (* get [d.t_need] bytes (or less if eoi) in [i.t]. *)
+  let blit d l =
+    unsafe_blit d.i d.i_pos d.t d.t_len (* write pos. *) l;
+    d.i_pos <- d.i_pos + l; d.t_len <- d.t_len + l;
+  in
+  let rem = i_rem d in
+  if rem < 0 (* eoi *) then k d else
+  let need = d.t_need - d.t_len in
+  if rem < need then (blit d rem; refill (t_fill k) d) else (blit d need; k d)
+
+let ret k v byte_count d =                     (* return post-processed [v]. *)
+  d.k <- k; d.byte_count <- d.byte_count + byte_count; d.pp d v
+
+(* Decoders. *)
+
+let rec decode_us_ascii d =
+  let rem = i_rem d in
+  if rem <= 0 then (if rem < 0 then `End else refill decode_us_ascii d) else
+  let j = d.i_pos in
+  d.i_pos <- d.i_pos + 1; ret decode_us_ascii (r_us_ascii d.i j) 1 d
+
+let rec decode_iso_8859_1 d =
+  let rem = i_rem d in
+  if rem <= 0 then (if rem < 0 then `End else refill decode_iso_8859_1 d) else
+  let j = d.i_pos in
+  d.i_pos <- d.i_pos + 1; ret decode_iso_8859_1 (r_iso_8859_1 d.i j) 1 d
+
+(* UTF-8 decoder *)
+
+let rec t_decode_utf_8 d =                             (* decode from [d.t]. *)
+  if d.t_len < d.t_need
+  then ret decode_utf_8 (malformed d.t 0 d.t_len) d.t_len d
+  else ret decode_utf_8 (r_utf_8 d.t 0 d.t_len) d.t_len d
+
+and decode_utf_8 d =
+  let rem = i_rem d in
+  if rem <= 0 then (if rem < 0 then `End else refill decode_utf_8 d) else
+  let need = unsafe_array_get utf_8_len (unsafe_byte d.i d.i_pos) in
+  if rem < need then (t_need d need; t_fill t_decode_utf_8 d) else
+  let j = d.i_pos in
+  if need = 0
+  then (d.i_pos <- d.i_pos + 1; ret decode_utf_8 (malformed d.i j 1) 1 d)
+  else (d.i_pos <- d.i_pos + need; ret decode_utf_8 (r_utf_8 d.i j need) need d)
+
+(* UTF-16BE decoder *)
+
+let rec t_decode_utf_16be_lo hi d =                    (* decode from [d.t]. *)
+  let bcount = d.t_len + 2 (* hi count *) in
+  if d.t_len < d.t_need
+  then ret decode_utf_16be (malformed_pair true hi d.t 0 d.t_len) bcount d
+  else ret decode_utf_16be (r_utf_16_lo hi d.t 0 1) bcount d
+
+and t_decode_utf_16be d =                              (* decode from [d.t]. *)
+  if d.t_len < d.t_need
+  then ret decode_utf_16be (malformed d.t 0 d.t_len) d.t_len d
+  else decode_utf_16be_lo (r_utf_16 d.t 0 1) d
+
+and decode_utf_16be_lo v d = match v with
+| `Uchar _ | `Malformed _ as v -> ret decode_utf_16be v 2 d
+| `Hi hi ->
+    let rem = i_rem d in
+    if rem < 2 then (t_need d 2; t_fill (t_decode_utf_16be_lo hi) d) else
+    let j = d.i_pos in
+    d.i_pos <- d.i_pos + 2;
+    ret decode_utf_16be (r_utf_16_lo hi d.i j (j + 1)) 4 d
+
+and decode_utf_16be d =
+  let rem = i_rem d in
+  if rem <= 0 then (if rem < 0 then `End else refill decode_utf_16be d) else
+  if rem < 2 then (t_need d 2; t_fill t_decode_utf_16be d) else
+  let j = d.i_pos in
+  d.i_pos <- d.i_pos + 2; decode_utf_16be_lo (r_utf_16 d.i j (j + 1)) d
+
+(* UTF-16LE decoder, same as UTF-16BE with byte swapped. *)
+
+let rec t_decode_utf_16le_lo hi d =                    (* decode from [d.t]. *)
+  let bcount = d.t_len + 2 (* hi count *) in
+  if d.t_len < d.t_need
+  then ret decode_utf_16le (malformed_pair false hi d.t 0 d.t_len) bcount d
+  else ret decode_utf_16le (r_utf_16_lo hi d.t 1 0) bcount d
+
+and t_decode_utf_16le d =                              (* decode from [d.t]. *)
+  if d.t_len < d.t_need
+  then ret decode_utf_16le (malformed d.t 0 d.t_len) d.t_len d
+  else decode_utf_16le_lo (r_utf_16 d.t 1 0) d
+
+and decode_utf_16le_lo v d = match v with
+| `Uchar _ | `Malformed _ as v -> ret decode_utf_16le v 2 d
+| `Hi hi ->
+    let rem = i_rem d in
+    if rem < 2 then (t_need d 2; t_fill (t_decode_utf_16le_lo hi) d) else
+    let j = d.i_pos in
+    d.i_pos <- d.i_pos + 2;
+    ret decode_utf_16le (r_utf_16_lo hi d.i (j + 1) j) 4 d
+
+and decode_utf_16le d =
+  let rem = i_rem d in
+  if rem <= 0 then (if rem < 0 then `End else refill decode_utf_16le d) else
+  if rem < 2 then (t_need d 2; t_fill t_decode_utf_16le d) else
+  let j = d.i_pos in
+  d.i_pos <- d.i_pos + 2; decode_utf_16le_lo (r_utf_16 d.i (j + 1) j) d
+
+(* Encoding guessing. The guess is simple but starting the decoder
+   after is tedious, uutf's decoders are not designed to put bytes
+   back in the stream. *)
+
+let guessed_utf_8 d =                   (* start decoder after `UTF_8 guess. *)
+  let b3 d =                                 (* handles the third read byte. *)
+    let b3 = unsafe_byte d.t 2 in
+    match utf_8_len.(b3) with
+    | 0 -> ret decode_utf_8 (malformed d.t 2 1) 1 d
+    | n ->
+        d.t_need <- n; d.t_len <- 1; unsafe_set_byte d.t 0 b3;
+        t_fill t_decode_utf_8 d
+  in
+  let b2 d =                                     (* handle second read byte. *)
+    let b2 = unsafe_byte d.t 1 in
+    let b3 = if d.t_len > 2 then b3 else decode_utf_8 (* decodes `End *) in
+    match utf_8_len.(b2) with
+    | 0 -> ret b3 (malformed d.t 1 1) 1 d
+    | 1 -> ret b3 (r_utf_8 d.t 1 1) 1 d
+    | n ->                         (* copy d.t.(1-2) to d.t.(0-1) and decode *)
+        d.t_need <- n;
+        unsafe_set_byte d.t 0 b2;
+        if (d.t_len < 3) then d.t_len <- 1 else
+        (d.t_len <- 2; unsafe_set_byte d.t 1 (unsafe_byte d.t 2); );
+        t_fill t_decode_utf_8 d
+  in
+  let b1 = unsafe_byte d.t 0 in                   (* handle first read byte. *)
+  let b2 = if d.t_len > 1 then b2 else decode_utf_8 (* decodes `End *) in
+  match utf_8_len.(b1) with
+  | 0 -> ret b2 (malformed d.t 0 1) 1 d
+  | 1 -> ret b2 (r_utf_8 d.t 0 1) 1 d
+  | 2 ->
+      if d.t_len < 2 then ret decode_utf_8 (malformed d.t 0 1) 1 d else
+      if d.t_len < 3 then ret decode_utf_8 (r_utf_8 d.t 0 2) 2 d else
+      ret b3 (r_utf_8 d.t 0 2) 2 d
+  | 3 ->
+      if d.t_len < 3
+      then ret decode_utf_8 (malformed d.t 0 d.t_len) d.t_len d
+      else ret decode_utf_8 (r_utf_8 d.t 0 3) 3 d
+  | 4 ->
+      if d.t_len < 3
+      then ret decode_utf_8 (malformed d.t 0 d.t_len) d.t_len d
+      else (d.t_need <- 4; t_fill t_decode_utf_8 d)
+  | n -> assert false
+
+let guessed_utf_16 d be v =     (* start decoder after `UTF_16{BE,LE} guess. *)
+  let decode_utf_16, t_decode_utf_16, t_decode_utf_16_lo, j0, j1 =
+    if be then decode_utf_16be, t_decode_utf_16be, t_decode_utf_16be_lo, 0, 1
+    else decode_utf_16le, t_decode_utf_16le, t_decode_utf_16le_lo, 1, 0
+  in
+  let b3 k d =
+    if d.t_len < 3 then decode_utf_16 d (* decodes `End *) else
+    begin                             (* copy d.t.(2) to d.t.(0) and decode. *)
+      d.t_need <- 2; d.t_len <- 1;
+      unsafe_set_byte d.t 0 (unsafe_byte d.t 2);
+      t_fill k d
+    end
+  in
+  match v with
+  | `BOM -> ret (b3 t_decode_utf_16) (`Uchar u_bom) 2 d
+  | `ASCII u -> ret (b3 t_decode_utf_16) (`Uchar u) 2 d
+  | `Decode ->
+      match r_utf_16 d.t j0 j1 with
+      | `Malformed _ | `Uchar _ as v -> ret (b3 t_decode_utf_16) v 2 d
+      | `Hi hi ->
+        if d.t_len < 3
+        then ret decode_utf_16 (malformed_pair be hi "" 0 0) d.t_len d
+        else (b3 (t_decode_utf_16_lo hi)) d
+
+let guess_encoding d =                  (* guess encoding and start decoder. *)
+  let setup d = match r_encoding d.t 0 d.t_len with
+  | `UTF_8 r ->
+      d.encoding <- `UTF_8; d.k <- decode_utf_8;
+      begin match r with
+      | `BOM -> ret decode_utf_8 (`Uchar u_bom) 3 d
+      | `Decode -> guessed_utf_8 d
+      | `End -> `End
+      end
+  | `UTF_16BE r ->
+      d.encoding <- `UTF_16BE; d.k <- decode_utf_16be; guessed_utf_16 d true r
+  | `UTF_16LE r ->
+      d.encoding <- `UTF_16LE; d.k <- decode_utf_16le; guessed_utf_16 d false r
+
+  in
+  (t_need d 3; t_fill setup d)
+
+(* Character post-processors. Used for BOM handling, newline
+   normalization and position tracking. The [pp_remove_bom] is only
+   used for the first character to remove a possible initial BOM and
+   handle UTF-16 endianness recognition. *)
+
+let nline d = d.col <- 0; d.line <- d.line + 1                   (* inlined. *)
+let ncol d = d.col <- d.col + 1                                  (* inlined. *)
+let ncount d = d.count <- d.count + 1                            (* inlined. *)
+let cr d b = d.last_cr <- b                                      (* inlined. *)
+
+let pp_remove_bom utf16 pp d = function(* removes init. BOM, handles UTF-16. *)
+| `Uchar 0xFEFF (* BOM *) ->
+    if utf16 then (d.encoding <- `UTF_16BE; d.k <- decode_utf_16be);
+    d.removed_bom <- true; d.pp <- pp; d.k d
+| `Uchar 0xFFFE (* BOM reversed from decode_utf_16be *) when utf16 ->
+    d.encoding <- `UTF_16LE; d.k <- decode_utf_16le;
+    d.removed_bom <- true; d.pp <- pp; d.k d
+| `Malformed _ | `Uchar _ as v ->
+    d.removed_bom <- false; d.pp <- pp; d.pp d v
+
+let pp_nln_none d = function
+| `Uchar 0x000A (* LF *) as v ->
+    let last_cr = d.last_cr in
+    cr d false; ncount d; if last_cr then v else (nline d; v)
+| `Uchar 0x000D (* CR *) as v -> cr d true; ncount d; nline d; v
+| `Uchar (0x0085 | 0x000C | 0x2028 | 0x2029) (* NEL | FF | LS | PS *) as v ->
+    cr d false; ncount d; nline d; v
+| `Uchar _ | `Malformed _ as v -> cr d false; ncount d; ncol d; v
+
+let pp_nln_readline d = function
+| `Uchar 0x000A (* LF *) ->
+    let last_cr = d.last_cr in
+    cr d false; if last_cr then d.k d else (ncount d; nline d; `Uchar d.nl)
+| `Uchar 0x000D (* CR *) -> cr d true; ncount d; nline d; `Uchar d.nl
+| `Uchar (0x0085 | 0x000C | 0x2028 | 0x2029) (* NEL | FF | LS | PS *) ->
+    cr d false; ncount d; nline d; `Uchar d.nl
+| `Uchar _ | `Malformed _ as v -> cr d false; ncount d; ncol d; v
+
+let pp_nln_nlf d = function
+| `Uchar 0x000A (* LF *) ->
+    let last_cr = d.last_cr in
+    cr d false; if last_cr then d.k d else (ncount d; nline d; `Uchar d.nl)
+| `Uchar 0x000D (* CR *) -> cr d true; ncount d; nline d; `Uchar d.nl
+| `Uchar 0x0085 (* NEL *) -> cr d false; ncount d; nline d; `Uchar d.nl
+| `Uchar (0x000C | 0x2028 | 0x2029) as v (* FF | LS | PS *) ->
+    cr d false; ncount d; nline d; v
+| `Uchar _ | `Malformed _ as v -> cr d false; ncount d; ncol d; v
+
+let pp_nln_ascii d = function
+| `Uchar 0x000A (* LF *) ->
+    let last_cr = d.last_cr in
+    cr d false; if last_cr then d.k d else (ncount d; nline d; `Uchar d.nl)
+| `Uchar 0x000D (* CR *) -> cr d true; ncount d; nline d; `Uchar d.nl
+| `Uchar (0x0085 | 0x000C | 0x2028 | 0x2029) as v (* NEL | FF | LS | PS *) ->
+    cr d false; ncount d; nline d; v
+| `Uchar _ | `Malformed _ as v -> cr d false; ncount d; ncol d; v
+
+let decode_fun = function
+| `UTF_8 -> decode_utf_8
+| `UTF_16 -> decode_utf_16be                         (* see [pp_remove_bom]. *)
+| `UTF_16BE -> decode_utf_16be
+| `UTF_16LE -> decode_utf_16le
+| `US_ASCII -> decode_us_ascii
+| `ISO_8859_1 -> decode_iso_8859_1
+
+let decoder ?nln ?encoding src =
+  let pp, nl = match nln with
+  | None -> pp_nln_none, 0x000A (* not used. *)
+  | Some (`ASCII nl) -> pp_nln_ascii, nl
+  | Some (`NLF nl) -> pp_nln_nlf, nl
+  | Some (`Readline nl) -> pp_nln_readline, nl
+  in
+  let encoding, k = match encoding with
+  | None -> `UTF_8, guess_encoding
+  | Some e -> (e :> decoder_encoding), decode_fun e
+  in
+  let i, i_pos, i_max = match src with
+  | `Manual -> "", 1, 0                            (* implies src_rem d = 0. *)
+  | `Channel _ -> String.create io_buffer_size, 1, 0                (* idem. *)
+  | `String s -> s, 0, String.length s - 1
+  in
+  { src = (src :> src); encoding; nln = (nln :> nln option); nl;
+    i; i_pos; i_max; t = String.create 4; t_len = 0; t_need = 0;
+    removed_bom = false; last_cr = false; line = 1; col = 0;
+    byte_count = 0; count = 0;
+    pp = pp_remove_bom (encoding = `UTF_16) pp; k }
+
+let decode d = d.k d
+let decoder_line d = d.line
+let decoder_col d = d.col
+let decoder_byte_count d = d.byte_count
+let decoder_count d = d.count
+let decoder_removed_bom d = d.removed_bom
+let decoder_src d = d.src
+let decoder_nln d = d.nln
+let decoder_encoding d = d.encoding
+let set_decoder_encoding d e =
+  d.encoding <- (e :> decoder_encoding); d.k <- decode_fun e
+
+(* Encode *)
+
+type dst = [ `Channel of out_channel | `Buffer of Buffer.t | `Manual ]
+type encode = [ `Await | `End | `Uchar of uchar ]
+type encoder =
+  { dst : dst;                                        (* output destination. *)
+    encoding : encoding;                                (* encoded encoding. *)
+    mutable o : string;                             (* current output chunk. *)
+    mutable o_pos : int;                   (* next output position to write. *)
+    mutable o_max : int;                (* maximal output position to write. *)
+    t : string;                 (* four bytes buffer for overlapping writes. *)
+    mutable t_pos : int;                    (* next position to read in [t]. *)
+    mutable t_max : int;                 (* maximal position to read in [t]. *)
+    mutable k :                                     (* encoder continuation. *)
+      encoder -> encode -> [ `Ok | `Partial ] }
+
+(* On encodes that overlap two (or more) [e.o] buffers, we encode the
+   character to the temporary buffer [o.t] and continue with
+   [tmp_flush] to write this data on the different [e.o] buffers. If
+   the [e.o] buffers are not too small this is faster than
+   continuation based byte per byte writes. *)
+
+let o_rem e = e.o_max - e.o_pos + 1    (* remaining bytes to write in [e.o]. *)
+let dst e s j l =                                     (* set [e.o] with [s]. *)
+  if (j < 0 || l < 0 || j + l > String.length s) then invalid_bounds j l;
+  e.o <- s; e.o_pos <- j; e.o_max <- j + l - 1
+
+let partial k e = function `Await -> k e | `Uchar _ | `End -> invalid_encode ()
+let flush k e = match e.dst with(* get free storage in [d.o] and [k]ontinue. *)
+| `Manual -> e.k <- partial k; `Partial
+| `Buffer b -> Buffer.add_substring b e.o 0 e.o_pos; e.o_pos <- 0; k e
+| `Channel oc -> output oc e.o 0 e.o_pos; e.o_pos <- 0; k e
+
+let t_range e max = e.t_pos <- 0; e.t_max <- max
+let rec t_flush k e =               (* flush [d.t] up to [d.t_max] in [d.i]. *)
+  let blit e l =
+    unsafe_blit e.t e.t_pos e.o e.o_pos l;
+    e.o_pos <- e.o_pos + l; e.t_pos <- e.t_pos + l
+  in
+  let rem = o_rem e in
+  let len = e.t_max - e.t_pos + 1 in
+  if rem < len then (blit e rem; flush (t_flush k) e) else (blit e len; k e)
+
+(* Encoders. *)
+
+let rec encode_utf_8 e v =
+  let k e = e.k <- encode_utf_8; `Ok in
+  match v with
+  | `Await -> k e
+  | `End -> flush k e
+  | `Uchar u as v ->
+      let rem = o_rem e in
+      if u <= 0x007F then
+      if rem < 1 then flush (fun e -> encode_utf_8 e v) e else
+      (unsafe_set_byte e.o e.o_pos u; e.o_pos <- e.o_pos + 1; k e)
+      else if u <= 0x07FF then
+      begin
+        let s, j, k =
+          if rem < 2 then (t_range e 1; e.t, 0, t_flush k) else
+          let j = e.o_pos in (e.o_pos <- e.o_pos + 2; e.o, j, k)
+        in
+        unsafe_set_byte s j (0xC0 lor (u lsr 6));
+        unsafe_set_byte s (j + 1) (0x80 lor (u land 0x3F));
+        k e
+      end
+      else if u <= 0xFFFF then
+      begin
+        let s, j, k =
+          if rem < 3 then (t_range e 2; e.t, 0, t_flush k) else
+          let j = e.o_pos in (e.o_pos <- e.o_pos + 3; e.o, j, k)
+        in
+        unsafe_set_byte s j (0xE0 lor (u lsr 12));
+        unsafe_set_byte s (j + 1) (0x80 lor ((u lsr 6) land 0x3F));
+        unsafe_set_byte s (j + 2) (0x80 lor (u land 0x3F));
+        k e
+      end
+      else
+      begin
+        let s, j, k =
+          if rem < 4 then (t_range e 3; e.t, 0, t_flush k) else
+          let j = e.o_pos in (e.o_pos <- e.o_pos + 4; e.o, j, k)
+        in
+        unsafe_set_byte s j (0xF0 lor (u lsr 18));
+        unsafe_set_byte s (j + 1) (0x80 lor ((u lsr 12) land 0x3F));
+        unsafe_set_byte s (j + 2) (0x80 lor ((u lsr 6) land 0x3F));
+        unsafe_set_byte s (j + 3) (0x80 lor (u land 0x3F));
+        k e
+      end
+
+let rec encode_utf_16be e v =
+  let k e = e.k <- encode_utf_16be; `Ok in
+  match v with
+  | `Await -> k e
+  | `End -> flush k e
+  | `Uchar u ->
+      let rem = o_rem e in
+      if u < 0x10000 then
+      begin
+        let s, j, k =
+          if rem < 2 then (t_range e 1; e.t, 0, t_flush k) else
+          let j = e.o_pos in (e.o_pos <- e.o_pos + 2; e.o, j, k)
+        in
+        unsafe_set_byte s j (u lsr 8);
+        unsafe_set_byte s (j + 1) (u land 0xFF);
+        k e
+      end else begin
+        let s, j, k =
+          if rem < 4 then (t_range e 3; e.t, 0, t_flush k) else
+          let j = e.o_pos in (e.o_pos <- e.o_pos + 4; e.o, j, k)
+        in
+        let u' = u - 0x10000 in
+        let hi = (0xD800 lor (u' lsr 10)) in
+        let lo = (0xDC00 lor (u' land 0x3FF)) in
+        unsafe_set_byte s j (hi lsr 8);
+        unsafe_set_byte s (j + 1) (hi land 0xFF);
+        unsafe_set_byte s (j + 2) (lo lsr 8);
+        unsafe_set_byte s (j + 3) (lo land 0xFF);
+        k e
+      end
+
+let rec encode_utf_16le e v =         (* encode_uft_16be with bytes swapped. *)
+  let k e = e.k <- encode_utf_16le; `Ok in
+  match v with
+  | `Await -> k e
+  | `End -> flush k e
+  | `Uchar u ->
+    let rem = o_rem e in
+    if u < 0x10000 then
+    begin
+      let s, j, k =
+        if rem < 2 then (t_range e 1; e.t, 0, t_flush k) else
+        let j = e.o_pos in (e.o_pos <- e.o_pos + 2; e.o, j, k)
+      in
+      unsafe_set_byte s j (u land 0xFF);
+      unsafe_set_byte s (j + 1) (u lsr 8);
+      k e
+    end
+    else
+    begin
+      let s, j, k =
+        if rem < 4 then (t_range e 3; e.t, 0, t_flush k) else
+        let j = e.o_pos in (e.o_pos <- e.o_pos + 4; e.o, j, k)
+      in
+      let u' = u - 0x10000 in
+      let hi = (0xD800 lor (u' lsr 10)) in
+      let lo = (0xDC00 lor (u' land 0x3FF)) in
+      unsafe_set_byte s j (hi land 0xFF);
+      unsafe_set_byte s (j + 1) (hi lsr 8);
+      unsafe_set_byte s (j + 2) (lo land 0xFF);
+      unsafe_set_byte s (j + 3) (lo lsr 8);
+      k e
+    end
+
+let encode_fun = function
+| `UTF_8 -> encode_utf_8
+| `UTF_16 -> encode_utf_16be
+| `UTF_16BE -> encode_utf_16be
+| `UTF_16LE -> encode_utf_16le
+
+let encoder encoding dst =
+  let o, o_pos, o_max = match dst with
+  | `Manual -> "", 1, 0                              (* implies o_rem e = 0. *)
+  | `Buffer _
+  | `Channel _ -> String.create io_buffer_size, 0, io_buffer_size - 1
+  in
+  { dst = (dst :> dst); encoding = (encoding :> encoding); o; o_pos; o_max;
+    t = String.create 4; t_pos = 1; t_max = 0; k = encode_fun encoding}
+
+let encode e v = e.k e (v :> encode)
+let encoder_encoding e = e.encoding
+let encoder_dst e = e.dst
+
+(* Manual sources and destinations. *)
+
+module Manual = struct
+  let src = src
+  let dst = dst
+  let dst_rem = o_rem
+end
+
+(* Strings folders and Buffer encoders *)
+
+module String = struct
+  let encoding_guess s = match r_encoding s 0 (max (String.length s) 3) with
+  | `UTF_8 d -> `UTF_8, (d = `BOM)
+  | `UTF_16BE d -> `UTF_16BE, (d = `BOM)
+  | `UTF_16LE d -> `UTF_16LE, (d = `BOM)
+
+  type 'a folder =
+    'a -> int -> [ `Uchar of uchar | `Malformed of string ] -> 'a
+
+  let fold_utf_8 f acc s =
+    let rec loop acc f s i l =
+      if i = l then acc else
+      let need = unsafe_array_get utf_8_len (unsafe_byte s i) in
+      if need = 0 then loop (f acc i (malformed s i 1)) f s (i + 1) l else
+      let rem = l - i in
+      if rem < need then f acc i (malformed s i rem) else
+      loop (f acc i (r_utf_8 s i need)) f s (i + need) l
+    in
+    loop acc f s 0 (String.length s)
+
+  let fold_utf_16be f acc s =
+    let rec loop acc f s i l =
+      if i = l then acc else
+      let rem = l - i in
+      if rem < 2 then f acc i (malformed s i 1) else
+      match r_utf_16 s i (i + 1) with
+      | `Uchar _ | `Malformed _ as v -> loop (f acc i v) f s (i + 2) l
+      | `Hi hi ->
+          if rem < 4 then f acc i (malformed s i rem)  else
+          loop (f acc i (r_utf_16_lo hi s (i + 2) (i + 3))) f s (i + 4) l
+    in
+    loop acc f s 0 (String.length s)
+
+  let fold_utf_16le f acc s =             (* [fold_utf_16be], bytes swapped. *)
+    let rec loop acc f s i l =
+      if i = l then acc else
+      let rem = l - i in
+      if rem < 2 then f acc i (malformed s i 1) else
+      match r_utf_16 s (i + 1) i with
+      | `Uchar _ | `Malformed _ as v -> loop (f acc i v) f s (i + 2) l
+      | `Hi hi ->
+          if rem < 4 then f acc i (malformed s i rem)  else
+          loop (f acc i (r_utf_16_lo hi s (i + 3) (i + 2))) f s (i + 4) l
+    in
+    loop acc f s 0 (String.length s)
+end
+
+module Buffer = struct
+  let add_utf_8 b u =
+    let w byte = Buffer.add_char b (unsafe_chr byte) in          (* inlined. *)
+    if u <= 0x007F then
+    (w u)
+    else if u <= 0x07FF then
+    (w (0xC0 lor (u lsr 6));
+     w (0x80 lor (u land 0x3F)))
+    else if u <= 0xFFFF then
+    (w (0xE0 lor (u lsr 12));
+     w (0x80 lor ((u lsr 6) land 0x3F));
+     w (0x80 lor (u land 0x3F)))
+    else
+    (w (0xF0 lor (u lsr 18));
+     w (0x80 lor ((u lsr 12) land 0x3F));
+     w (0x80 lor ((u lsr 6) land 0x3F));
+     w (0x80 lor (u land 0x3F)))
+
+  let add_utf_16be b u =
+    let w byte = Buffer.add_char b (unsafe_chr byte) in          (* inlined. *)
+    if u < 0x10000 then (w (u lsr 8); w (u land 0xFF)) else
+    let u' = u - 0x10000 in
+    let hi = (0xD800 lor (u' lsr 10)) in
+    let lo = (0xDC00 lor (u' land 0x3FF)) in
+    w (hi lsr 8); w (hi land 0xFF);
+    w (lo lsr 8); w (lo land 0xFF)
+
+  let add_utf_16le b u =                            (* swapped add_utf_16be. *)
+    let w byte = Buffer.add_char b (unsafe_chr byte) in          (* inlined. *)
+    if u < 0x10000 then (w (u land 0xFF); w (u lsr 8)) else
+    let u' = u - 0x10000 in
+    let hi = (0xD800 lor (u' lsr 10)) in
+    let lo = (0xDC00 lor (u' land 0x3FF)) in
+    w (hi land 0xFF); w (hi lsr 8);
+    w (lo land 0xFF); w (lo lsr 8)
+end
+
+(*---------------------------------------------------------------------------
+   Copyright 2012 Daniel C. Bünzli
+   All rights reserved.
+
+   Redistribution and use in source and binary forms, with or without
+   modification, are permitted provided that the following conditions
+   are met:
+
+   1. Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+   2. 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.
+
+   3. Neither the name of Daniel C. Bünzli nor the names of
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+   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
+   OWNER 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.
+  ---------------------------------------------------------------------------*)

samples/VimL/filenames/.nvimrc

@@ -0,0 +1,10 @@
+set nocompatible
+set ignorecase
+set smartcase
+set showmatch
+set showcmd
+
+syntax on
+
+set hlsearch " Highlight searches
+set incsearch " Do incremental searching

samples/XML/Application.xib

@@ -0,0 +1,20 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<document type="com.apple.InterfaceBuilder3.CocoaTouch.XIB" version="3.0" toolsVersion="6211" systemVersion="14A298i" targetRuntime="iOS.CocoaTouch" propertyAccessControl="none" useAutolayout="YES" useTraitCollections="YES">
+    <dependencies>
+        <plugIn identifier="com.apple.InterfaceBuilder.IBCocoaTouchPlugin" version="6204"/>
+    </dependencies>
+    <objects>
+        <placeholder placeholderIdentifier="IBFilesOwner" id="-1" userLabel="File's Owner" customClass="UIApplication">
+            <connections>
+                <outlet property="delegate" destination="bYg-Ix-Cfg" id="h4M-LL-qlT"/>
+            </connections>
+        </placeholder>
+        <placeholder placeholderIdentifier="IBFirstResponder" id="-2" customClass="UIResponder"/>
+        <customObject id="bYg-Ix-Cfg" userLabel="App Delegate"/>
+        <window opaque="NO" clearsContextBeforeDrawing="NO" contentMode="scaleToFill" id="Na2-4i-xf1">
+            <rect key="frame" x="0.0" y="0.0" width="600" height="600"/>
+            <autoresizingMask key="autoresizingMask" flexibleMaxX="YES" flexibleMaxY="YES"/>
+            <color key="backgroundColor" red="1" green="1" blue="1" alpha="1" colorSpace="calibratedRGB"/>
+        </window>
+    </objects>
+</document>

samples/XML/Storyboard.storyboard

@@ -0,0 +1,7 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<document type="com.apple.InterfaceBuilder3.CocoaTouch.Storyboard.XIB" version="3.0" toolsVersion="6211" systemVersion="14A298i" targetRuntime="iOS.CocoaTouch" propertyAccessControl="none" useAutolayout="YES" useTraitCollections="YES">
+    <dependencies>
+        <plugIn identifier="com.apple.InterfaceBuilder.IBCocoaTouchPlugin" version="6204"/>
+    </dependencies>
+    <scenes/>
+</document>

test/fixtures/Data/sourcemap.v1.map

@@ -0,0 +1,12 @@
+/** Begin line maps. **/{ “file”:”out.js”, "count": 2 }
+[0,0,0,0,0,0,1,1,1,1,2]
+[2,2,2,2,2,2,3,4,4,4,4,4]
+/** Begin file information. **/
+[“a.js”, “b.js”]
+[“b.js”, “c.js”, “d.js”]
+/** Begin mapping definitions. **/
+["a.js", 1, 34]
+["a.js", 5, 2]
+["b.js", 1, 3, "event"]
+["c.js", 1, 4]
+["d.js", 3, 78, "foo"]

test/fixtures/Data/sourcemap.v3.map

@@ -0,0 +1 @@
+{"version":3,"file":"out.js","sourceRoot":"","sources":["foo.js","bar.js"],"sourcesContent":[null,null],"names":["src","maps","are","fun"],"mappings":"A,AAAB;;ABCDE;"}

test/test_generated.rb

@@ -5,47 +5,66 @@ class TestGenerated < Minitest::Test
 
   class DataLoadedError < StandardError; end
 
-  def generated_without_loading_data(name)
-    blob = File.join(samples_path, name)
+  def generated_without_loading_data(blob)
     begin
-      assert Generated.generated?(blob, lambda { raise DataLoadedError.new }), "#{name} was not recognized as a generated file"
+      assert Generated.generated?(blob, lambda { raise DataLoadedError.new }), "#{blob} was not recognized as a generated file"
     rescue DataLoadedError
-      assert false, "Data was loaded when calling generated? on #{name}"
+      assert false, "Data was loaded when calling generated? on #{blob}"
     end
   end
 
-  def generated_loading_data(name)
-    blob = File.join(samples_path, name)
-    assert_raises(DataLoadedError, "Data wasn't loaded when calling generated? on #{name}") do
+  def generated_loading_data(blob)
+    assert_raises(DataLoadedError, "Data wasn't loaded when calling generated? on #{blob}") do
       Generated.generated?(blob, lambda { raise DataLoadedError.new })
     end
   end
 
-  def test_check_generated_without_loading_data
+  def generated_fixture_without_loading_data(name)
+    generated_without_loading_data(File.join(fixtures_path, name))
+  end
+
+  def generated_fixture_loading_data(name)
+    generated_loading_data(File.join(fixtures_path, name))
+  end
+
+  def generated_sample_without_loading_data(name)
+    generated_without_loading_data(File.join(samples_path, name))
+  end
+
+  def generated_sample_loading_data(name)
+    generated_loading_data(File.join(samples_path, name))
+  end
+
+  def test_check_generated
     # Xcode project files
-    generated_without_loading_data("Binary/MainMenu.nib")
-    generated_without_loading_data("Dummy/foo.xcworkspacedata")
-    generated_without_loading_data("Dummy/foo.xcuserstate")
+    generated_sample_without_loading_data("Binary/MainMenu.nib")
+    generated_sample_without_loading_data("Dummy/foo.xcworkspacedata")
+    generated_sample_without_loading_data("Dummy/foo.xcuserstate")
 
     # .NET designer file
-    generated_without_loading_data("Dummu/foo.designer.cs")
+    generated_sample_without_loading_data("Dummu/foo.designer.cs")
 
     # Composer generated composer.lock file
-    generated_without_loading_data("JSON/composer.lock")
+    generated_sample_without_loading_data("JSON/composer.lock")
 
     # Node modules
-    generated_without_loading_data("Dummy/node_modules/foo.js")
+    generated_sample_without_loading_data("Dummy/node_modules/foo.js")
 
     # Godep saved dependencies
-    generated_without_loading_data("Godeps/Godeps.json")
-    generated_without_loading_data("Godeps/_workspace/src/github.com/kr/s3/sign.go")
+    generated_sample_without_loading_data("Godeps/Godeps.json")
+    generated_sample_without_loading_data("Godeps/_workspace/src/github.com/kr/s3/sign.go")
 
     # Generated by Zephir
-    generated_without_loading_data("C/exception.zep.c")
-    generated_without_loading_data("C/exception.zep.h")
-    generated_without_loading_data("PHP/exception.zep.php")
+    generated_sample_without_loading_data("C/exception.zep.c")
+    generated_sample_without_loading_data("C/exception.zep.h")
+    generated_sample_without_loading_data("PHP/exception.zep.php")
 
     # Minified files
-    generated_loading_data("JavaScript/jquery-1.6.1.min.js")
+    generated_sample_loading_data("JavaScript/jquery-1.6.1.min.js")
+
+    # Source Map
+    generated_fixture_without_loading_data("Data/bootstrap.css.map")
+    generated_fixture_loading_data("Data/sourcemap.v3.map")
+    generated_fixture_loading_data("Data/sourcemap.v1.map")
   end
 end

test/test_grammars.rb

@@ -13,7 +13,6 @@ class TestGrammars < Minitest::Test
     # These grammars have no license but have been grandfathered in. New grammars
     # must have a license that allows redistribution.
     "vendor/grammars/Sublime-Lasso",
-    "vendor/grammars/Sublime-REBOL",
     "vendor/grammars/x86-assembly-textmate-bundle"
   ].freeze