Merge pull request #1587 from github/linguist-3.2.1

Linguist v3.2.1

.gitignore

@@ -1 +1,5 @@
 Gemfile.lock
+.bundle/
+vendor/
+benchmark/
+lib/linguist/samples.json

.travis.yml

@@ -1,12 +1,11 @@
-before_install: 
+before_install:
+  - git fetch origin master:master
+  - git fetch origin v2.0.0:v2.0.0
+  - git fetch origin test/attributes:test/attributes
   - 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
-  - 1.9.2
   - 1.9.3
   - 2.0.0
-  - ree
+  - 2.1.1
 notifications:
   disabled: true

Gemfile

@@ -1,7 +1,3 @@
 source 'https://rubygems.org'
 gemspec
-
-if RUBY_VERSION < "1.9.3"
-  # escape_utils 1.0.0 requires 1.9.3 and above
-  gem "escape_utils", "0.3.2"
-end
+gem 'rugged', '0.21.1b2'

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:
 
@@ -105,12 +102,50 @@ We try to only add languages once they have some usage on GitHub, so please note
 
 Almost all bug fixes or new language additions should come with some additional code samples. Just drop them under [`samples/`](https://github.com/github/linguist/tree/master/samples) in the correct subdirectory and our test suite will automatically test them. In most cases you shouldn't need to add any new assertions.
 
-To update the `samples.json` after adding new files to [`samples/`](https://github.com/github/linguist/tree/master/samples):
+### A note on language extensions
 
-    bundle exec rake samples
+Linguist has a number of methods available to it for identifying the language of a particular file. The initial lookup is based upon the extension of the file, possible file extensions are defined in an array called `extensions`. Take a look at this example for example for `Perl`:
+
+```
+Perl:
+  type: programming
+  ace_mode: perl
+  color: "#0298c3"
+  extensions:
+  - .pl
+  - .PL
+  - .perl
+  - .ph
+  - .plx
+  - .pm
+  - .pod
+  - .psgi
+  interpreters:
+  - perl
+```
+Any of the extensions defined are valid but the first in this array should be the most popular.
 
 ### Testing
 
 Sometimes getting the tests running can be too much work, especially if you don't have much Ruby experience. It's okay: be lazy and let our build bot [Travis](http://travis-ci.org/#!/github/linguist) run the tests for you. Just open a pull request and the bot will start cranking away.
 
 Here's our current build status, which is hopefully green: [![Build Status](https://secure.travis-ci.org/github/linguist.png?branch=master)](http://travis-ci.org/github/linguist)
+
+### Releasing
+
+If you are the current maintainer of this gem:
+
+ 0. Create a branch for the release: `git checkout -b cut-release-vxx.xx.xx`
+ 0. Make sure your local dependencies are up to date: `bundle install`
+ 0. Ensure that samples are updated: `bundle exec rake samples`
+ 0. Ensure that tests are green: `bundle exec rake test`
+ 0. Bump gem version in `lib/linguist/version.rb`.  For example, [like this](https://github.com/github/linguist/commit/8d2ea90a5ba3b2fe6e1508b7155aa4632eea2985).
+ 0. Make a PR to github/linguist.  For example, [#1238](https://github.com/github/linguist/pull/1238).
+ 0. Build a local gem: `gem build github-linguist.gemspec`
+ 0. Testing:
+   0. Bump the Gemfile and Gemfile.lock versions for an app which relies on this gem
+   0. Install the new gem locally
+   0. Test behavior locally, branch deploy, whatever needs to happen
+ 0. Merge github/linguist PR
+ 0. Tag and push: `git tag vx.xx.xx; git push --tags`
+ 0. Push to rubygems.org -- `gem push github-linguist-3.0.0.gem`

Rakefile

@@ -7,6 +7,16 @@ task :default => :test
 
 Rake::TestTask.new
 
+# Extend test task to check for samples
+task :test => :check_samples
+
+desc "Check that we have samples.json generated"
+task :check_samples do
+  unless File.exist?('lib/linguist/samples.json')
+    Rake::Task[:samples].invoke
+  end
+end
+
 task :samples do
   require 'linguist/samples'
   require 'yajl'
@@ -15,13 +25,74 @@ task :samples do
   File.open('lib/linguist/samples.json', 'w') { |io| io.write json }
 end
 
-task :build_gem do
+task :build_gem => :samples do
   languages = YAML.load_file("lib/linguist/languages.yml")
   File.write("lib/linguist/languages.json", JSON.dump(languages))
   `gem build github-linguist.gemspec`
   File.delete("lib/linguist/languages.json")
 end
 
+namespace :benchmark do
+  benchmark_path = "benchmark/results"
+
+  # $ bundle exec rake benchmark:generate CORPUS=path/to/samples
+  desc "Generate results for"
+  task :generate do
+    ref = `git rev-parse HEAD`.strip[0,8]
+
+    corpus = File.expand_path(ENV["CORPUS"] || "samples")
+
+    require 'linguist/language'
+
+    results = Hash.new
+    Dir.glob("#{corpus}/**/*").each do |file|
+      next unless File.file?(file)
+      filename = file.gsub("#{corpus}/", "")
+      results[filename] = Linguist::FileBlob.new(file).language
+    end
+
+    # Ensure results directory exists
+    FileUtils.mkdir_p("benchmark/results")
+
+    # Write results
+    if `git status`.include?('working directory clean')
+      result_filename = "benchmark/results/#{File.basename(corpus)}-#{ref}.json"
+    else
+      result_filename = "benchmark/results/#{File.basename(corpus)}-#{ref}-unstaged.json"
+    end
+
+    File.write(result_filename, results.to_json)
+    puts "wrote #{result_filename}"
+  end
+
+  # $ bundle exec rake benchmark:compare REFERENCE=path/to/reference.json CANDIDATE=path/to/candidate.json
+  desc "Compare results"
+  task :compare do
+    reference_file = ENV["REFERENCE"]
+    candidate_file = ENV["CANDIDATE"]
+
+    reference = JSON.parse(File.read(reference_file))
+    reference_counts = Hash.new(0)
+    reference.each { |filename, language| reference_counts[language] += 1 }
+
+    candidate = JSON.parse(File.read(candidate_file))
+    candidate_counts = Hash.new(0)
+    candidate.each { |filename, language| candidate_counts[language] += 1 }
+
+    changes = diff(reference_counts, candidate_counts)
+
+    if changes.any?
+      changes.each do |language, (before, after)|
+        before_percent = 100 * before / reference.size.to_f
+        after_percent = 100 * after / candidate.size.to_f
+        puts "%s changed from %.1f%% to %.1f%%" % [language || 'unknown', before_percent, after_percent]
+      end
+    else
+      puts "No changes"
+    end
+  end
+end
+
 namespace :classifier do
   LIMIT = 1_000
 
@@ -37,7 +108,7 @@ namespace :classifier do
       next if file_language.nil? || file_language == 'Text'
       begin
         data = open(file_url).read
-        guessed_language, score = Linguist::Classifier.classify(Linguist::Samples::DATA, data).first
+        guessed_language, score = Linguist::Classifier.classify(Linguist::Samples.cache, data).first
 
         total += 1
         guessed_language == file_language ? correct += 1 : incorrect += 1
@@ -71,3 +142,10 @@ namespace :classifier do
     end
   end
 end
+
+
+def diff(a, b)
+  (a.keys | b.keys).each_with_object({}) do |key, diff|
+    diff[key] = [a[key], b[key]] unless a[key] == b[key]
+  end
+end

bin/linguist

@@ -4,7 +4,9 @@
 #     usage: linguist <path> [<--breakdown>]
 
 require 'linguist/file_blob'
+require 'linguist/language'
 require 'linguist/repository'
+require 'rugged'
 
 path = ARGV[0] || Dir.pwd
 
@@ -18,7 +20,8 @@ ARGV.shift
 breakdown = true if ARGV[0] == "--breakdown"
 
 if File.directory?(path)
-  repo = Linguist::Repository.from_directory(path)
+  rugged = Rugged::Repository.new(path)
+  repo = Linguist::Repository.new(rugged, rugged.head.target_id)
   repo.languages.sort_by { |_, size| size }.reverse.each do |language, size|
     percentage = ((size / repo.size.to_f) * 100)
     percentage = sprintf '%.2f' % percentage
@@ -28,7 +31,7 @@ if File.directory?(path)
     puts
     file_breakdown = repo.breakdown_by_file
     file_breakdown.each do |lang, files|
-      puts "#{lang}:" 
+      puts "#{lang}:"
       files.each do |file|
         puts file
       end

github-linguist.gemspec

@@ -1,6 +1,8 @@
+require File.expand_path('../lib/linguist/version', __FILE__)
+
 Gem::Specification.new do |s|
   s.name    = 'github-linguist'
-  s.version = '2.10.11'
+  s.version = Linguist::VERSION
   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.'
 
@@ -11,13 +13,14 @@ Gem::Specification.new do |s|
   s.files = Dir['lib/**/*']
   s.executables << 'linguist'
 
-  s.add_dependency 'charlock_holmes', '~> 0.6.6'
-  s.add_dependency 'escape_utils',    '>= 0.3.1'
+  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 'pygments.rb',     '~> 0.5.4'
+  s.add_dependency 'pygments.rb',     '~> 0.6.0'
 
   s.add_development_dependency 'json'
   s.add_development_dependency 'mocha'
+  s.add_development_dependency 'pry'
   s.add_development_dependency 'rake'
   s.add_development_dependency 'yajl-ruby'
 end

lib/linguist.rb

@@ -4,3 +4,4 @@ require 'linguist/heuristics'
 require 'linguist/language'
 require 'linguist/repository'
 require 'linguist/samples'
+require 'linguist/version'

lib/linguist/blob_helper.rb

@@ -1,6 +1,4 @@
 require 'linguist/generated'
-require 'linguist/language'
-
 require 'charlock_holmes'
 require 'escape_utils'
 require 'mime/types'
@@ -112,6 +110,12 @@ module Linguist
       end
     end
 
+    def ruby_encoding
+      if hash = detect_encoding
+        hash[:ruby_encoding]
+      end
+    end
+
     # Try to guess the encoding
     #
     # Returns: a Hash, with :encoding, :confidence, :type
@@ -241,7 +245,31 @@ module Linguist
     def lines
       @lines ||=
         if viewable? && data
-          data.split(/\r\n|\r|\n/, -1)
+          # `data` is usually encoded as ASCII-8BIT even when the content has
+          # been detected as a different encoding. However, we are not allowed
+          # to change the encoding of `data` because we've made the implicit
+          # guarantee that each entry in `lines` is encoded the same way as
+          # `data`.
+          #
+          # Instead, we re-encode each possible newline sequence as the
+          # detected encoding, then force them back to the encoding of `data`
+          # (usually a binary encoding like ASCII-8BIT). This means that the
+          # byte sequence will match how newlines are likely encoded in the
+          # file, but we don't have to change the encoding of `data` as far as
+          # Ruby is concerned. This allows us to correctly parse out each line
+          # without changing the encoding of `data`, and
+          # also--importantly--without having to duplicate many (potentially
+          # large) strings.
+          begin
+            encoded_newlines = ["\r\n", "\r", "\n"].
+              map { |nl| nl.encode(ruby_encoding, "ASCII-8BIT").force_encoding(data.encoding) }
+
+            data.split(Regexp.union(encoded_newlines), -1)
+          rescue Encoding::ConverterNotFoundError
+            # The data is not splittable in the detected encoding.  Assume it's
+            # one big line.
+            [data]
+          end
         else
           []
         end
@@ -283,15 +311,7 @@ module Linguist
     #
     # Returns a Language or nil if none is detected
     def language
-      return @language if defined? @language
-
-      if defined?(@data) && @data.is_a?(String)
-        data = @data
-      else
-        data = lambda { (binary_mime_type? || binary?) ? "" : self.data }
-      end
-
-      @language = Language.detect(name.to_s, data, mode)
+      @language ||= Language.detect(self)
     end
 
     # Internal: Get the lexer of the blob.

lib/linguist/file_blob.rb

@@ -52,5 +52,20 @@ module Linguist
     def size
       File.size(@path)
     end
+
+    # Public: Get file extension.
+    #
+    # Returns a String.
+    def extension
+      # File.extname returns nil if the filename is an extension.
+      extension = File.extname(name)
+      basename = File.basename(name)
+      # Checks if the filename is an extension.
+      if extension.empty? && basename[0] == "."
+        basename
+      else
+        extension
+      end
+    end
   end
 end

lib/linguist/generated.rb

@@ -54,7 +54,7 @@ module Linguist
       name == 'Gemfile.lock' ||
         minified_files? ||
         compiled_coffeescript? ||
-        xcode_project_file? ||
+        xcode_file? ||
         generated_parser? ||
         generated_net_docfile? ||
         generated_net_designer_file? ||
@@ -62,17 +62,20 @@ module Linguist
         generated_protocol_buffer? ||
         generated_jni_header? ||
         composer_lock? ||
-        node_modules?
+        node_modules? ||
+        godeps? ||
+        vcr_cassette? ||
+        generated_by_zephir?
     end
 
-    # Internal: Is the blob an XCode project file?
+    # Internal: Is the blob an Xcode file?
     #
-    # Generated if the file extension is an XCode project
+    # Generated if the file extension is an Xcode 
     # file extension.
     #
     # Returns true of false.
-    def xcode_project_file?
-      ['.xib', '.nib', '.storyboard', '.pbxproj', '.xcworkspacedata', '.xcuserstate'].include?(extname)
+    def xcode_file?
+      ['.nib', '.xcworkspacedata', '.xcuserstate'].include?(extname)
     end
 
     # Internal: Is the blob minified files?
@@ -229,11 +232,37 @@ module Linguist
       !!name.match(/node_modules\//)
     end
 
+    # Internal: Is the blob part of Godeps/,
+    # which are not meant for humans in pull requests.
+    #
+    # Returns true or false.
+    def godeps?
+      !!name.match(/Godeps\//)
+    end
+
     # Internal: Is the blob a generated php composer lock file?
     #
     # Returns true or false.
     def composer_lock?
-      !!name.match(/composer.lock/)
+      !!name.match(/composer\.lock/)
+    end
+
+    # Internal: Is the blob a generated by Zephir
+    #
+    # Returns true or false.
+    def generated_by_zephir?
+      !!name.match(/.\.zep\.(?:c|h|php)$/)
+    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

@@ -1,7 +1,7 @@
 module Linguist
   # A collection of simple heuristics that can be used to better analyze languages.
   class Heuristics
-    ACTIVE = false
+    ACTIVE = true
 
     # Public: Given an array of String language names,
     # apply heuristics against the given data and return an array
@@ -13,19 +13,20 @@ module Linguist
     # Returns an array of Languages or []
     def self.find_by_heuristics(data, languages)
       if active?
-        if languages.all? { |l| ["Objective-C", "C++"].include?(l) }
-          disambiguate_c(data, languages)
-        end
         if languages.all? { |l| ["Perl", "Prolog"].include?(l) }
-          disambiguate_pl(data, languages)
+          result = disambiguate_pl(data, languages)
         end
-        if languages.all? { |l| ["TypeScript", "XML"].include?(l) }
-          disambiguate_ts(data, languages)
+        if languages.all? { |l| ["ECL", "Prolog"].include?(l) }
+          result = disambiguate_ecl(data, languages)
         end
+        if languages.all? { |l| ["Common Lisp", "OpenCL"].include?(l) }
+          result = disambiguate_cl(data, languages)
+        end
+        return result
       end
     end
 
-    # .h extensions are ambigious between C, C++, and Objective-C.
+    # .h extensions are ambiguous between C, C++, and Objective-C.
     # We want to shortcut look for Objective-C _and_ now C++ too!
     #
     # Returns an array of Languages or []
@@ -43,6 +44,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 +61,20 @@ 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.disambiguate_r(data, languages)
+      matches = []
+      matches << Language["Rebol"] if /\bRebol\b/i.match(data)
+      matches << Language["R"] if data.include?("<-")
+      matches
+    end
+
     def self.active?
       !!ACTIVE
     end

lib/linguist/language.rb

@@ -9,6 +9,8 @@ end
 require 'linguist/classifier'
 require 'linguist/heuristics'
 require 'linguist/samples'
+require 'linguist/file_blob'
+require 'linguist/blob_helper'
 
 module Linguist
   # Language names that are recognizable by GitHub. Defined languages
@@ -24,7 +26,6 @@ module Linguist
     @extension_index          = Hash.new { |h,k| h[k] = [] }
     @interpreter_index        = Hash.new { |h,k| h[k] = [] }
     @filename_index           = Hash.new { |h,k| h[k] = [] }
-    @primary_extension_index  = {}
 
     # Valid Languages types
     TYPES = [:data, :markup, :programming, :prose]
@@ -80,12 +81,6 @@ module Linguist
         @extension_index[extension] << language
       end
 
-      if @primary_extension_index.key?(language.primary_extension)
-        raise ArgumentError, "Duplicate primary extension: #{language.primary_extension}"
-      end
-
-      @primary_extension_index[language.primary_extension] = language
-
       language.interpreters.each do |interpreter|
         @interpreter_index[interpreter] << language
       end
@@ -99,18 +94,25 @@ module Linguist
 
     # Public: Detects the Language of the blob.
     #
-    # name - String filename
-    # data - String blob data. A block also maybe passed in for lazy
-    #        loading. This behavior is deprecated and you should always
-    #        pass in a String.
-    # mode - Optional String mode (defaults to nil)
+    # blob - an object that includes the Linguist `BlobHelper` interface;
+    #       see Linguist::LazyBlob and Linguist::FileBlob for examples
     #
     # Returns Language or nil.
-    def self.detect(name, data, mode = nil)
+    def self.detect(blob)
+      name = blob.name.to_s
+
+      # Check if the blob is possibly binary and bail early; this is a cheap
+      # test that uses the extension name to guess a binary binary mime type.
+      #
+      # We'll perform a more comprehensive test later which actually involves
+      # looking for binary characters in the blob
+      return nil if blob.likely_binary? || blob.binary?
+
       # A bit of an elegant hack. If the file is executable but extensionless,
       # append a "magic" extension so it can be classified with other
       # languages that have shebang scripts.
-      if File.extname(name).empty? && mode && (mode.to_i(8) & 05) == 05
+      extension = FileBlob.new(name).extension
+      if extension.empty? && blob.mode && (blob.mode.to_i(8) & 05) == 05
         name += ".script!"
       end
 
@@ -121,10 +123,10 @@ module Linguist
       # extension at all, in the case of extensionless scripts), we need to continue
       # our detection work
       if possible_languages.length > 1
-        data = data.call() if data.respond_to?(:call)
+        data = blob.data
         possible_language_names = possible_languages.map(&:name)
 
-        # Don't bother with emptiness
+        # Don't bother with binary contents or an empty file
         if data.nil? || data == ""
           nil
         # Check if there's a shebang line and use that as authoritative
@@ -133,8 +135,8 @@ module Linguist
         # No shebang. Still more work to do. Try to find it with our heuristics.
         elsif (determined = Heuristics.find_by_heuristics(data, possible_language_names)) && !determined.empty?
           determined.first
-        # Lastly, fall back to the probablistic classifier.
-        elsif classified = Classifier.classify(Samples::DATA, data, possible_language_names ).first
+        # Lastly, fall back to the probabilistic classifier.
+        elsif classified = Classifier.classify(Samples.cache, data, possible_language_names).first
           # Return the actual Language object based of the string language name (i.e., first element of `#classify`)
           Language[classified[0]]
         end
@@ -190,9 +192,9 @@ module Linguist
     #
     # Returns all matching Languages or [] if none were found.
     def self.find_by_filename(filename)
-      basename, extname = File.basename(filename), File.extname(filename)
-      langs = [@primary_extension_index[extname]] +
-              @filename_index[basename] +
+      basename = File.basename(filename)
+      extname = FileBlob.new(filename).extension
+      langs = @filename_index[basename] +
               @extension_index[extname]
       langs.compact.uniq
     end
@@ -299,15 +301,6 @@ module Linguist
       @interpreters = attributes[:interpreters]   || []
       @filenames  = attributes[:filenames]  || []
 
-      unless @primary_extension = attributes[:primary_extension]
-        raise ArgumentError, "#{@name} is missing primary extension"
-      end
-
-      # Prepend primary extension unless its already included
-      if primary_extension && !extensions.include?(primary_extension)
-        @extensions = [primary_extension] + extensions
-      end
-
       # Set popular, and searchable flags
       @popular    = attributes.key?(:popular)    ? attributes[:popular]    : false
       @searchable = attributes.key?(:searchable) ? attributes[:searchable] : true
@@ -395,20 +388,6 @@ module Linguist
     # Returns the extensions Array
     attr_reader :extensions
 
-    # Deprecated: Get primary extension
-    #
-    # Defaults to the first extension but can be overridden
-    # in the languages.yml.
-    #
-    # The primary extension can not be nil. Tests should verify this.
-    #
-    # This attribute is only used by app/helpers/gists_helper.rb for
-    # creating the language dropdown. It really should be using `name`
-    # instead. Would like to drop primary extension.
-    #
-    # Returns the extension String.
-    attr_reader :primary_extension
-
     # Public: Get interpreters
     #
     # Examples
@@ -427,6 +406,27 @@ module Linguist
     # Returns the extensions Array
     attr_reader :filenames
 
+    # Public: Return all possible extensions for language
+    def all_extensions
+      (extensions + [primary_extension]).uniq
+    end
+
+    # Deprecated: Get primary extension
+    #
+    # Defaults to the first extension but can be overridden
+    # in the languages.yml.
+    #
+    # The primary extension can not be nil. Tests should verify this.
+    #
+    # This method is only used by app/helpers/gists_helper.rb for creating
+    # the language dropdown. It really should be using `name` instead.
+    # Would like to drop primary extension.
+    #
+    # Returns the extension String.
+    def primary_extension
+      extensions.first
+    end
+
     # Public: Get URL escaped name.
     #
     # Examples
@@ -485,7 +485,7 @@ module Linguist
     #
     # Returns html String
     def colorize(text, options = {})
-      lexer.highlight(text, options = {})
+      lexer.highlight(text, options)
     end
 
     # Public: Return name as String representation
@@ -510,9 +510,9 @@ module Linguist
     end
   end
 
-  extensions = Samples::DATA['extnames']
-  interpreters = Samples::DATA['interpreters']
-  filenames = Samples::DATA['filenames']
+  extensions = Samples.cache['extnames']
+  interpreters = Samples.cache['interpreters']
+  filenames = Samples.cache['filenames']
   popular = YAML.load_file(File.expand_path("../popular.yml", __FILE__))
 
   languages_yml = File.expand_path("../languages.yml", __FILE__)
@@ -532,6 +532,7 @@ module Linguist
     if extnames = extensions[name]
       extnames.each do |extname|
         if !options['extensions'].include?(extname)
+          warn "#{name} has a sample with extension (#{extname}) that isn't explicitly defined in languages.yml" unless extname == '.script!'
           options['extensions'] << extname
         end
       end
@@ -568,9 +569,8 @@ module Linguist
       :group_name        => options['group'],
       :searchable        => options.key?('searchable') ? options['searchable'] : true,
       :search_term       => options['search_term'],
-      :extensions        => options['extensions'].sort,
+      :extensions        => [options['extensions'].first] + options['extensions'][1..-1].sort,
       :interpreters      => options['interpreters'].sort,
-      :primary_extension => options['primary_extension'],
       :filenames         => options['filenames'],
       :popular           => popular.include?(name)
     )

lib/linguist/lazy_blob.rb

@@ -0,0 +1,71 @@
+require 'linguist/blob_helper'
+require 'linguist/language'
+require 'rugged'
+
+module Linguist
+  class LazyBlob
+    GIT_ATTR = ['linguist-language', 'linguist-vendored']
+    GIT_ATTR_OPTS = { :priority => [:index], :skip_system => true }
+    GIT_ATTR_FLAGS = Rugged::Repository::Attributes.parse_opts(GIT_ATTR_OPTS)
+
+    include BlobHelper
+
+    MAX_SIZE = 128 * 1024
+
+    attr_reader :repository
+    attr_reader :oid
+    attr_reader :name
+    attr_reader :mode
+
+    def initialize(repo, oid, name, mode = nil)
+      @repository = repo
+      @oid = oid
+      @name = name
+      @mode = mode
+    end
+
+    def git_attributes
+      @git_attributes ||= repository.fetch_attributes(
+        name, GIT_ATTR, GIT_ATTR_FLAGS)
+    end
+
+    def vendored?
+      if attr = git_attributes['linguist-vendored']
+        return boolean_attribute(attr)
+      else
+        return super
+      end
+    end
+
+    def language
+      return @language if defined?(@language)
+
+      @language = if lang = git_attributes['linguist-language']
+        Language.find_by_name(lang)
+      else
+        super
+      end
+    end
+
+    def data
+      load_blob!
+      @data
+    end
+
+    def size
+      load_blob!
+      @size
+    end
+
+    protected
+
+    # Returns true if the attribute is present and not the string "false".
+    def boolean_attribute(attr)
+      attr != "false"
+    end
+
+    def load_blob!
+      @data, @size = Rugged::Blob.to_buffer(repository, oid, MAX_SIZE) if @data.nil?
+    end
+  end
+end

lib/linguist/repository.rb

@@ -1,4 +1,5 @@
-require 'linguist/file_blob'
+require 'linguist/lazy_blob'
+require 'rugged'
 
 module Linguist
   # A Repository is an abstraction of a Grit::Repo or a basic file
@@ -7,100 +8,158 @@ module Linguist
   # Its primary purpose is for gathering language statistics across
   # the entire project.
   class Repository
-    # Public: Initialize a new Repository from a File directory
-    #
-    # base_path - A path String
-    #
-    # Returns a Repository
-    def self.from_directory(base_path)
-      new Dir["#{base_path}/**/*"].
-        select { |f| File.file?(f) }.
-        map { |path| FileBlob.new(path, base_path) }
+    attr_reader :repository
+
+    # Public: Create a new Repository based on the stats of
+    # an existing one
+    def self.incremental(repo, commit_oid, old_commit_oid, old_stats)
+      repo = self.new(repo, commit_oid)
+      repo.load_existing_stats(old_commit_oid, old_stats)
+      repo
     end
 
-    # Public: Initialize a new Repository
+    # Public: Initialize a new Repository to be analyzed for language
+    # data
     #
-    # enum - Enumerator that responds to `each` and
-    #        yields Blob objects
+    # repo - a Rugged::Repository object
+    # commit_oid - the sha1 of the commit that will be analyzed;
+    #              this is usually the master branch
     #
     # Returns a Repository
-    def initialize(enum)
-      @enum = enum
-      @computed_stats = false
-      @language = @size = nil
-      @sizes = Hash.new { 0 }
-      @file_breakdown = Hash.new { |h,k| h[k] = Array.new }
+    def initialize(repo, commit_oid)
+      @repository = repo
+      @commit_oid = commit_oid
+
+      raise TypeError, 'commit_oid must be a commit SHA1' unless commit_oid.is_a?(String)
+    end
+
+    # Public: Load the results of a previous analysis on this repository
+    # to speed up the new scan.
+    #
+    # The new analysis will be performed incrementally as to only take
+    # into account the file changes since the last time the repository
+    # was scanned
+    #
+    # old_commit_oid - the sha1 of the commit that was previously analyzed
+    # old_stats - the result of the previous analysis, obtained by calling
+    #             Repository#cache on the old repository
+    #
+    # Returns nothing
+    def load_existing_stats(old_commit_oid, old_stats)
+      @old_commit_oid = old_commit_oid
+      @old_stats = old_stats
+      nil
     end
 
     # Public: Returns a breakdown of language stats.
     #
     # Examples
     #
-    #   # => { Language['Ruby'] => 46319,
-    #          Language['JavaScript'] => 258 }
+    #   # => { 'Ruby' => 46319,
+    #          'JavaScript' => 258 }
     #
-    # Returns a Hash of Language keys and Integer size values.
+    # Returns a Hash of language names and Integer size values.
     def languages
-      compute_stats
-      @sizes
+      @sizes ||= begin
+        sizes = Hash.new { 0 }
+        cache.each do |_, (language, size)|
+          sizes[language] += size
+        end
+        sizes
+      end
     end
 
     # Public: Get primary Language of repository.
     #
-    # Returns a Language
+    # Returns a language name
     def language
-      compute_stats
-      @language
+      @language ||= begin
+        primary = languages.max_by { |(_, size)| size }
+        primary && primary[0]
+      end
     end
 
     # Public: Get the total size of the repository.
     #
     # Returns a byte size Integer
     def size
-      compute_stats
-      @size
+      @size ||= languages.inject(0) { |s,(_,v)| s + v }
     end
 
     # Public: Return the language breakdown of this repository by file
+    #
+    # Returns a map of language names => [filenames...]
     def breakdown_by_file
-      compute_stats
-      @file_breakdown
+      @file_breakdown ||= begin
+        breakdown = Hash.new { |h,k| h[k] = Array.new }
+        cache.each do |filename, (language, _)|
+          breakdown[language] << filename
+        end
+        breakdown
+      end
     end
 
-    # Internal: Compute language breakdown for each blob in the Repository.
+    # Public: Return the cached results of the analysis
     #
-    # Returns nothing
-    def compute_stats
-      return if @computed_stats
+    # This is a per-file breakdown that can be passed to other instances
+    # of Linguist::Repository to perform incremental scans
+    #
+    # Returns a map of filename => [language, size]
+    def cache
+      @cache ||= begin
+        if @old_commit_oid == @commit_oid
+          @old_stats
+        else
+          compute_stats(@old_commit_oid, @old_stats)
+        end
+      end
+    end
 
-      @enum.each do |blob|
-        # Skip files that are likely binary
-        next if blob.likely_binary?
+    def read_index
+      attr_index = Rugged::Index.new
+      attr_index.read_tree(current_tree)
+      repository.index = attr_index
+    end
 
-        # Skip vendored or generated blobs
-        next if blob.vendored? || blob.generated? || blob.language.nil?
+    def current_tree
+      @tree ||= Rugged::Commit.lookup(repository, @commit_oid).tree
+    end
 
-        # Only include programming languages and acceptable markup languages
-        if blob.language.type == :programming || Language.detectable_markup.include?(blob.language.name)
+    protected
 
-          # Build up the per-file breakdown stats
-          @file_breakdown[blob.language.group.name] << blob.name
+    def compute_stats(old_commit_oid, cache = nil)
+      file_map = cache ? cache.dup : {}
+      old_tree = old_commit_oid && Rugged::Commit.lookup(repository, old_commit_oid).tree
 
-          @sizes[blob.language.group] += blob.size
+      read_index
+
+      diff = Rugged::Tree.diff(repository, old_tree, current_tree)
+
+      diff.each_delta do |delta|
+        old = delta.old_file[:path]
+        new = delta.new_file[:path]
+
+        file_map.delete(old)
+        next if delta.binary
+
+        if [:added, :modified].include? delta.status
+          # Skip submodules
+          mode = delta.new_file[:mode]
+          next if (mode & 040000) != 0
+
+          blob = Linguist::LazyBlob.new(repository, delta.new_file[:oid], new, mode.to_s(8))
+
+          # Skip vendored or generated blobs
+          next if blob.vendored? || blob.generated? || blob.language.nil?
+
+          # Only include programming languages and acceptable markup languages
+          if blob.language.type == :programming || Language.detectable_markup.include?(blob.language.name)
+            file_map[new] = [blob.language.group.name, blob.size]
+          end
         end
       end
 
-      # Compute total size
-      @size = @sizes.inject(0) { |s,(_,v)| s + v }
-
-      # Get primary language
-      if primary = @sizes.max_by { |(_, size)| size }
-        @language = primary[0]
-      end
-
-      @computed_stats = true
-
-      nil
+      file_map
     end
   end
 end

lib/linguist/samples.rb

@@ -17,9 +17,11 @@ module Linguist
     PATH = File.expand_path('../samples.json', __FILE__)
 
     # Hash of serialized samples object
-    if File.exist?(PATH)
-      serializer = defined?(JSON) ? JSON : YAML
-      DATA = serializer.load(File.read(PATH))
+    def self.cache
+      @cache ||= begin
+        serializer = defined?(JSON) ? JSON : YAML
+        serializer.load(File.read(PATH))
+      end
     end
 
     # Public: Iterate over each sample.
@@ -28,7 +30,7 @@ module Linguist
     #
     # Returns nothing.
     def self.each(&block)
-      Dir.entries(ROOT).each do |category|
+      Dir.entries(ROOT).sort!.each do |category|
         next if category == '.' || category == '..'
 
         # Skip text and binary for now

lib/linguist/vendor.yml

@@ -10,7 +10,7 @@
 ## Vendor Conventions ##
 
 # Caches
-- cache/
+- (^|/)cache/
 
 # Dependencies
 - ^[Dd]ependencies/
@@ -33,20 +33,43 @@
 # Erlang bundles
 - ^rebar$
 
+# Go dependencies
+- Godeps/_workspace/
+
 # Bootstrap minified css and js
 - (^|/)bootstrap([^.]*)(\.min)?\.(js|css)$
 
+# Font Awesome
+- font-awesome.min.css
+- font-awesome.css
+
 # Foundation css
 - foundation.min.css
 - foundation.css
 
+# Normalize.css
+- normalize.css
+
+# Bourbon SCSS
+- (^|/)[Bb]ourbon/.*\.css$
+- (^|/)[Bb]ourbon/.*\.scss$
+
+# Animate.css
+- animate.css
+- animate.min.css
+
 # Vendored dependencies
-- thirdparty/
+- third[-_]?party/
+- 3rd[-_]?party/
 - vendors?/
+- extern(al)?/
 
 # Debian packaging
 - ^debian/
 
+# Haxelib projects often contain a neko bytecode file named run.n
+- run.n$
+
 ## Commonly Bundled JavaScript frameworks ##
 
 # jQuery
@@ -63,6 +86,9 @@
 - (^|/)controls\.js$
 - (^|/)dragdrop\.js$
 
+# Typescript definition files
+- (.*?)\.d\.ts$
+
 # MooTools
 - (^|/)mootools([^.]*)\d+\.\d+.\d+([^.]*)\.js$
 
@@ -92,6 +118,20 @@
 # AngularJS
 - (^|/)angular([^.]*)(\.min)?\.js$
 
+# D3.js
+- (^|\/)d3(\.v\d+)?([^.]*)(\.min)?\.js$
+
+# React
+- (^|/)react(-[^.]*)?(\.min)?\.js$
+
+# Modernizr
+- (^|/)modernizr\-\d\.\d+(\.\d+)?(\.min)?\.js$
+- (^|/)modernizr\.custom\.\d+\.js$
+
+# Knockout
+- (^|/)knockout-(\d+\.){3}(debug\.)?js$
+- knockout-min.js
+
 ## Python ##
 
 # django
@@ -108,13 +148,24 @@
 
 ## Obj-C ##
 
+# Cocoapods
+- ^Pods/
+
 # Sparkle
 - (^|/)Sparkle/
 
+## Groovy ##
+
+# Gradle
+- (^|/)gradlew$
+- (^|/)gradlew\.bat$
+- (^|/)gradle/wrapper/
+
 ## .NET ##
 
 # Visual Studio IntelliSense
 - -vsdoc\.js$
+- \.intellisense\.js$
 
 # jQuery validation plugin (MS bundles this with asp.net mvc)
 - (^|/)jquery([^.]*)\.validate(\.unobtrusive)?(\.min)?\.js$
@@ -124,7 +175,7 @@
 - (^|/)[Mm]icrosoft([Mm]vc)?([Aa]jax|[Vv]alidation)(\.debug)?\.js$
 
 # NuGet
-- ^[Pp]ackages/
+- ^[Pp]ackages\/.+\.\d+\/
 
 # ExtJS
 - (^|/)extjs/.*?\.js$
@@ -144,6 +195,9 @@
 - (^|/)extjs/src/
 - (^|/)extjs/welcome/
 
+# Html5shiv
+- (^|/)html5shiv(\.min)?\.js$
+
 # Samples folders
 - ^[Ss]amples/
 
@@ -164,8 +218,27 @@
 - (^|/)cordova([^.]*)(\.min)?\.js$
 - (^|/)cordova\-\d\.\d(\.\d)?(\.min)?\.js$
 
+# Foundation js
+- foundation(\..*)?\.js$
+
 # Vagrant
 - ^Vagrantfile$
 
 # .DS_Store's
 - .[Dd][Ss]_[Ss]tore$
+
+# Mercury --use-subdirs
+- Mercury/
+
+# R packages
+- ^vignettes/
+- ^inst/extdata/
+
+# Octicons
+- octicons.css
+- octicons.min.css
+- sprockets-octicons.scss
+
+# Typesafe Activator
+- (^|/)activator$
+- (^|/)activator\.bat$

lib/linguist/version.rb

@@ -0,0 +1,3 @@
+module Linguist
+  VERSION = "3.2.1"
+end

samples/AGS Script/GlobalScript.asc

@@ -0,0 +1,521 @@
+// main global script file
+
+// A function that initializes a bunch of stuff.
+function initialize_control_panel() { 
+  // Centre the control panel
+  gPanel.Centre(); 
+  // Centre the Restart dialog as well
+  gRestartYN.Centre(); 
+  if (!IsSpeechVoxAvailable()) { 
+    // If there is no speech-vox file, and therefore no speech,
+    // disable all the controls related with speech.
+    lblVoice.Visible = false;  
+    btnVoice.Visible = false;  
+    sldVoice.Visible = false;
+  }
+  else {
+    // If there *is*, then set it to voice and text. It's best to use
+    // both whenever possible, for the player's sake.
+    SetVoiceMode(eSpeechVoiceAndText); 
+    // And reflect this in the control panel.
+    btnVoice.Text = "Voice and Text"; 
+  }
+  if (!System.SupportsGammaControl) {
+    // If we can't change the gamma settings, disable the relevant options.
+    sldGamma.Visible = false; 
+    lblGamma.Visible = false;
+  } 
+  
+  //And now, set all the defaults
+  System.Volume = 100;
+  sldAudio.Value = System.Volume;
+  SetGameSpeed(40);
+  sldSpeed.Value = 40;
+  if (IsSpeechVoxAvailable()) {
+     SetVoiceMode(eSpeechVoiceAndText);
+     btnVoice.Text = "Voice and Text";
+     sldVoice.Value = 255;
+     SetSpeechVolume(255);
+  }
+  if (System.SupportsGammaControl) {
+    System.Gamma = 100;
+    sldGamma.Value = 100;
+  }
+}
+
+// Called when the game starts, before the first room is loaded
+function game_start() {   
+  // Put the code all in a function and then just call the function. 
+  // It saves cluttering up places like game_start.
+  initialize_control_panel(); 
+  // Use the KeyboardMovement module to, per default, replicate the standard
+  // keyboard movement of most Sierra games. See KeyboardMovement.txt for more info
+  KeyboardMovement.SetMode(eKeyboardMovement_Tapping); 
+}
+
+function repeatedly_execute() {
+  
+  // Put here anything you want to happen every game cycle, even when
+  // the game is paused. This will not run when the game is blocked
+  // inside a command like a blocking Walk()
+  
+  if (IsGamePaused() == 1) return;
+
+  // Put here anything you want to happen every game cycle, but not
+  // when the game is paused.
+}
+
+function repeatedly_execute_always() {
+  
+  // Put anything you want to happen every game cycle, even
+  // when the game is blocked inside a command like a
+  // blocking Walk().
+  // You cannot run blocking commands from this function.
+  
+}
+
+function show_inventory_window () 
+{
+  gInventory.Visible = true;
+  // switch to the Use cursor (to select items with)
+  mouse.Mode = eModeInteract;
+  // But, override the appearance to look like the arrow
+  mouse.UseModeGraphic(eModePointer);
+}
+
+function show_save_game_dialog()
+{
+  gSaveGame.Visible = true;
+  // Get the list of save games
+  lstSaveGamesList.FillSaveGameList();
+  if (lstSaveGamesList.ItemCount > 0)
+  {
+    // If there is at least one, set the default text
+    // to be the first game's name
+    txtNewSaveName.Text = lstSaveGamesList.Items[0];
+  }
+  else
+  {
+    // No save games yet, default empty text.
+    txtNewSaveName.Text = "";
+  }
+  mouse.UseModeGraphic(eModePointer);
+  gIconbar.Visible = false;
+}
+
+function show_restore_game_dialog()
+{
+  gRestoreGame.Visible = true;
+  lstRestoreGamesList.FillSaveGameList();
+  mouse.UseModeGraphic(eModePointer);
+  gIconbar.Visible = false;
+}
+
+function close_save_game_dialog()
+{
+  gSaveGame.Visible = false;
+  mouse.UseDefaultGraphic();
+  gIconbar.Visible = true;
+}
+
+function close_restore_game_dialog()
+{
+  gRestoreGame.Visible = false;
+  mouse.UseDefaultGraphic();
+  gIconbar.Visible = true;
+}
+
+// Called when a key is pressed. keycode holds the key's ASCII code
+function on_key_press(eKeyCode keycode) {
+  // The following is called before "if game is paused keycode=0", so
+  // it'll happen even when the game is paused.
+  
+  if ((keycode == eKeyEscape) && gRestartYN.Visible) {
+    //Use ESC to cancel restart.
+    gRestartYN.Visible = false; 
+    gIconbar.Visible = true;
+    // If the panel's not ON, then the player must have gotten here by tapping F9,
+    // therefore his cursor needs restoring. If the panel IS on, then it doesn't,
+    // because it's already a pointer. Get used to thinking like this!!
+    if (!gPanel.Visible) mouse.UseDefaultGraphic(); 
+    return;
+  }
+  if ((keycode == eKeyEscape) && gPanel.Visible) {
+    // Use ESC to turn the panel off.
+    gPanel.Visible = false; 
+    mouse.UseDefaultGraphic();
+    gIconbar.Visible = true;
+    return;
+  }
+  if ((keycode == eKeyEscape) && (gSaveGame.Visible))
+  {
+    // Use ESC to close the save game dialog
+    close_save_game_dialog();
+    return;
+  }
+  if ((keycode == eKeyEscape) && (gRestoreGame.Visible))
+  {
+    // Use ESC to close the restore game dialog
+    close_restore_game_dialog();
+    return;
+  }
+  
+  if (keycode == eKeyReturn) { 
+    // ENTER, in this case merely confirms restart
+    if (gRestartYN.Visible) RestartGame();
+  }
+
+  if (IsGamePaused() || (IsInterfaceEnabled() == 0))
+  {
+    // If the game is paused with a modal GUI on the
+    // screen, or the player interface is disabled in
+    // a cut scene, ignore any keypresses.
+    return;
+  }
+
+  // FUNCTION KEYS AND SYSTEM SHORTCUTS
+  if (keycode == eKeyEscape) {
+    // ESC
+    gPanel.Visible = true; 
+    gIconbar.Visible = false;
+    mouse.UseModeGraphic(eModePointer);
+  }
+  if (keycode == eKeyCtrlQ)  QuitGame(1);   // Ctrl-Q
+  if (keycode == eKeyF5) show_save_game_dialog();   // F5
+  if (keycode == eKeyF7) show_restore_game_dialog();  // F7
+  if (keycode == eKeyF9) {
+    // F9, asks the player to confirm restarting (so much better to always confirm first)
+    gRestartYN.Visible = true;  
+    gIconbar.Visible = false;
+    mouse.UseModeGraphic(eModePointer);
+  }
+  if (keycode == eKeyF12) SaveScreenShot("scrnshot.bmp");  // F12
+  if (keycode == eKeyTab)   show_inventory_window();  // Tab, show inventory
+
+  // GAME COMMAND SHORTCUTS
+  if (keycode == 'W') mouse.Mode=eModeWalkto; //Notice this alternate way to indicate keycodes.
+  if (keycode == 'L') mouse.Mode=eModeLookat; //Note that all we do here is set modes.
+  if (keycode == 'U') mouse.Mode=eModeInteract; //If you want something else to happen, such as GUI buttons highlighting,
+  if (keycode == 'T') mouse.Mode=eModeTalkto; //you'll need some more scripting done.
+  if (keycode == 'I') mouse.Mode=eModeUseinv; //But this will, as-is, give you some standard keyboard shortcuts your players will very much appreciate.
+
+  // For extra cursor modes, such as pick up, feel free to add as you will.
+  // Uncomment the line below if you use the "Pick Up" mode.
+  //if (keycode == 'P' || keycode == 'G') mouse.Mode=eModePickup; 
+
+  // DEBUG FUNCTIONS
+  if (keycode == eKeyCtrlS)  Debug(0,0);  // Ctrl-S, give all inventory
+  if (keycode == eKeyCtrlV)  Debug(1,0);  // Ctrl-V, version
+  if (keycode == eKeyCtrlA)  Debug(2,0);  // Ctrl-A, show walkable areas
+  if (keycode == eKeyCtrlX)  Debug(3,0);  // Ctrl-X, teleport to room
+  if (keycode == eKeyCtrlW && game.debug_mode) 
+    player.PlaceOnWalkableArea(); //Ctrl-W, move to walkable area 
+}
+
+
+function on_mouse_click(MouseButton button) {
+  // called when a mouse button is clicked. button is either LEFT or RIGHT
+  if (IsGamePaused() == 1) {
+    // Game is paused, so do nothing (ie. don't allow mouse click)
+  }
+  else if (button == eMouseLeft) {
+    ProcessClick(mouse.x, mouse.y, mouse.Mode );
+  }
+  else if (button == eMouseRight || button == eMouseWheelSouth){
+    // right-click our mouse-wheel down, so cycle cursor
+    mouse.SelectNextMode();
+  }
+  else if (button == eMouseMiddle) { 
+    // Middle-button-click, default make character walk to clicked area (a little shortcut)
+    // Could have been just "player.Walk(mouse.x,mouse.y)", but it's best to
+    // leave our options open - what if you have a special script triggered
+    // on "walking" mode?
+    ProcessClick(mouse.x, mouse.y, eModeWalkto); 
+  }
+  else if (button == eMouseWheelNorth) { 
+    // Mouse-wheel up, cycle cursors 
+    // If mode isn't WALK, set the previous mode (notice usage of numbers instead
+    // of eNums, when it suits us)...
+    if (mouse.Mode>0) mouse.Mode=mouse.Mode-1; 
+    else 
+    { 
+      // ...but if it is WALK mode...
+      if (player.ActiveInventory!=null) 
+      {
+        //...and the player has a selected inventory item, set mouse mode to UseInv. 
+        mouse.Mode=eModeUseinv; 
+      }
+      else 
+      {
+        // If they don't, however, just set it to mode TALK (change this line if you add more cursor modes)
+        mouse.Mode=eModeTalkto; 
+      }
+    }
+  }
+}
+
+function interface_click(int interface, int button) {
+  // This function is obsolete, from 2.62 and earlier versions.
+}
+
+function btnInvUp_Click(GUIControl *control, MouseButton button) {
+  invCustomInv.ScrollUp();
+}
+
+function btnInvDown_Click(GUIControl *control, MouseButton button) {
+  invCustomInv.ScrollDown();
+}
+
+function btnInvOK_Click(GUIControl *control, MouseButton button) {
+	// They pressed the OK button, close the GUI
+	gInventory.Visible = false;
+	mouse.UseDefaultGraphic();
+}
+
+function btnInvSelect_Click(GUIControl *control, MouseButton button) {
+  
+	// They pressed SELECT, so switch to the Get cursor
+	mouse.Mode = eModeInteract;
+	// But, override the appearance to look like the arrow
+	mouse.UseModeGraphic(eModePointer);
+}
+
+function btnIconInv_Click(GUIControl *control, MouseButton button) {
+  
+  show_inventory_window();
+}
+
+function btnIconCurInv_Click(GUIControl *control, MouseButton button) {
+  
+  if (player.ActiveInventory != null)
+    mouse.Mode = eModeUseinv;
+}
+
+function btnIconSave_Click(GUIControl *control, MouseButton button) 
+{
+  show_save_game_dialog();
+}
+
+function btnIconLoad_Click(GUIControl *control, MouseButton button) 
+{
+  show_restore_game_dialog();
+}
+
+function btnIconExit_Click(GUIControl *control, MouseButton button) {
+  
+  QuitGame(1);
+}
+
+function btnIconAbout_Click(GUIControl *control, MouseButton button) {
+  
+  gPanel.Visible=true;
+  gIconbar.Visible=false;
+  mouse.UseModeGraphic(eModePointer);
+}
+
+function cEgo_Look()
+{
+  Display("Damn, I'm looking good!");
+}
+
+function cEgo_Interact()
+{
+  Display("You rub your hands up and down your clothes.");
+}
+
+function cEgo_Talk()
+{
+  Display("Talking to yourself is a sign of madness!");
+}
+
+//START OF CONTROL PANEL FUNCTIONS
+function btnSave_OnClick(GUIControl *control, MouseButton button)
+{
+  gPanel.Visible = false;
+  mouse.UseDefaultGraphic();
+  gIconbar.Visible = true;
+  Wait(1);
+  btnIconSave_Click(btnIconSave, eMouseLeft);
+}
+
+function gControl_OnClick(GUI *theGui, MouseButton button)
+{
+
+}
+
+function btnAbout_OnClick(GUIControl *control, MouseButton button)
+{
+Display("Adventure Game Studio run-time engine default game.");
+}
+
+function btnQuit_OnClick(GUIControl *control, MouseButton button)
+{
+  gPanel.Visible = false;
+  Wait(1);
+  QuitGame(1);
+  gPanel.Visible = true;
+  gIconbar.Visible = false;
+  mouse.UseModeGraphic(eModePointer);
+}
+
+function btnLoad_OnClick(GUIControl *control, MouseButton button)
+{
+  gPanel.Visible = false;
+  mouse.UseDefaultGraphic();
+  gIconbar.Visible = true;
+  Wait(1);
+  btnIconLoad_Click(btnIconLoad, eMouseLeft);
+}
+
+function btnResume_OnClick(GUIControl *control, MouseButton button)
+{
+  gPanel.Visible = false;
+  mouse.UseDefaultGraphic();
+  gIconbar.Visible = true;
+}
+
+function sldAudio_OnChange(GUIControl *control)
+{
+  System.Volume = sldAudio.Value;
+}
+
+function sldVoice_OnChange(GUIControl *control)
+{
+  // Sets voice volume. Note that we don't check for the existence of speech.vox - 
+  // we did that in game_start, so if it's not there the slider won't even be available.
+  SetSpeechVolume(sldVoice.Value); 
+}
+
+function btnVoice_OnClick(GUIControl *control, MouseButton button)
+{
+  // Note that we don't check for the existence of speech.vox - we did that in game_start,
+  // so if it's not there the button won't even be available.
+  if (btnVoice.Text == "Voice and Text") { 
+    SetVoiceMode(eSpeechVoiceOnly); 
+    btnVoice.Text = "Voice only";
+  }
+  else if (btnVoice.Text == "Voice only") {
+    SetVoiceMode(eSpeechTextOnly);
+    btnVoice.Text = "Text only";
+  }
+  else if (btnVoice.Text == "Text only") {
+    SetVoiceMode(eSpeechVoiceAndText);
+    btnVoice.Text = "Voice and Text";
+  }
+}
+
+function sldGamma_OnChange(GUIControl *control)
+{
+  // Set the gamma. Note there's no need to check for anything else, as we ensured,
+  // in game_start, that the slider won't even appear if it's not possible to do this.
+  System.Gamma = sldGamma.Value; 
+}
+
+function btnDefault_OnClick(GUIControl *control, MouseButton button)
+{
+  // Reset everything to default. You'll have to edit these as well as the sliders
+  // if you'd rather have different default parameters.
+  System.Volume = 100;
+  sldAudio.Value = System.Volume;
+  sldSpeed.Value = 40;
+  SetGameSpeed(40);
+  if (IsSpeechVoxAvailable()) {
+     SetVoiceMode(eSpeechVoiceAndText);
+     btnVoice.Text = "Voice and Text";
+     sldVoice.Value = 255;
+     SetSpeechVolume(255);
+  }
+  if (System.SupportsGammaControl) {
+    System.Gamma = 100;
+    sldGamma.Value = 100;
+  }
+}
+//END OF CONTROL PANEL FUNCTIONS
+
+function dialog_request(int param) 
+{
+  // This is used by the dialog text parser if you need to process
+  // text that the player types in to the parser.
+  // It is not used by default.
+}
+
+function sldSpeed_OnChange(GUIControl *control)
+{
+  SetGameSpeed(sldSpeed.Value);
+}
+
+function btnRestart_OnClick(GUIControl *control, MouseButton button)
+{
+  gRestartYN.Visible=true;
+  gIconbar.Visible=false;
+}
+
+function btnRestartYes_OnClick(GUIControl *control, MouseButton button)
+{
+  RestartGame();
+}
+
+function btnRestartNo_OnClick(GUIControl *control, MouseButton button)
+{
+  gRestartYN.Visible = false;
+  gIconbar.Visible = true;
+  // If the panel's not ON, then the player must have gotten here by tapping F9,
+  // therefore his cursor needs restoring. If the panel IS on, then it doesn't,
+  // because it's already a pointer. Get used to thinking like this!!
+  if (!gPanel.Visible) mouse.UseDefaultGraphic(); 
+}
+
+function btnCancelSave_OnClick(GUIControl *control, MouseButton button)
+{
+  close_save_game_dialog();
+}
+
+function btnSaveGame_OnClick(GUIControl *control, MouseButton button)
+{
+  int gameSlotToSaveInto = lstSaveGamesList.ItemCount + 1;
+  int i = 0;
+  while (i < lstSaveGamesList.ItemCount)
+  {
+    if (lstSaveGamesList.Items[i] == txtNewSaveName.Text)
+    {
+      gameSlotToSaveInto = lstSaveGamesList.SaveGameSlots[i];
+    }
+    i++;
+  }
+  SaveGameSlot(gameSlotToSaveInto, txtNewSaveName.Text);
+  close_save_game_dialog();
+}
+
+function btnCancelRestore_OnClick(GUIControl *control, MouseButton button)
+{
+  close_restore_game_dialog();
+}
+
+function btnRestoreGame_OnClick(GUIControl *control, MouseButton button)
+{
+  if (lstRestoreGamesList.SelectedIndex >= 0)
+  {
+    RestoreGameSlot(lstRestoreGamesList.SaveGameSlots[lstRestoreGamesList.SelectedIndex]);
+  }
+  close_restore_game_dialog();
+}
+
+function lstSaveGamesList_OnSelectionCh(GUIControl *control)
+{
+  txtNewSaveName.Text = lstSaveGamesList.Items[lstSaveGamesList.SelectedIndex];
+}
+
+function txtNewSaveName_OnActivate(GUIControl *control)
+{
+  // Pressing return in the text box simulates clicking the Save button
+  btnSaveGame_OnClick(control, eMouseLeft);
+}
+
+function btnDeleteSave_OnClick(GUIControl *control, MouseButton button)
+{
+  if (lstSaveGamesList.SelectedIndex >= 0)
+  {
+    DeleteSaveSlot(lstSaveGamesList.SaveGameSlots[lstSaveGamesList.SelectedIndex]);
+    lstSaveGamesList.FillSaveGameList();
+  }
+}

samples/AGS Script/GlobalScript.ash

@@ -0,0 +1,4 @@
+// Main header script - this will be included into every script in
+// the game (local and global). Do not place functions here; rather,
+// place import definitions and #define names here to be used by all
+// scripts.

samples/AGS Script/KeyboardMovement_102.asc

@@ -0,0 +1,216 @@
+// Main script for module 'KeyboardMovement'
+
+//****************************************************************************************************
+// DEFINITIONS
+//****************************************************************************************************
+
+#define DISTANCE 10000// distance player walks in Tapping mode before he stops
+
+enum KeyboardMovement_Directions {
+	eKeyboardMovement_Stop, 
+	eKeyboardMovement_DownLeft, 
+	eKeyboardMovement_Down, 
+	eKeyboardMovement_DownRight, 
+	eKeyboardMovement_Left, 
+	eKeyboardMovement_Right, 
+	eKeyboardMovement_UpLeft, 
+	eKeyboardMovement_Up, 
+	eKeyboardMovement_UpRight
+};
+
+//****************************************************************************************************
+// VARIABLES
+//****************************************************************************************************
+
+// keycodes as variables for future key customization functions (static variables?):
+int KeyboardMovement_KeyDown = 380; // down arrow
+int KeyboardMovement_KeyLeft = 375; // left arrow
+int KeyboardMovement_KeyRight = 377; // right arrow
+int KeyboardMovement_KeyUp = 372; // up arrow
+int KeyboardMovement_KeyDownRight = 381; // PgDn (numpad)
+int KeyboardMovement_KeyUpRight = 373; // PgUp (numpad)
+int KeyboardMovement_KeyDownLeft = 379; // End (numpad)
+int KeyboardMovement_KeyUpLeft = 371; // Home (numpad)
+int KeyboardMovement_KeyStop = 376; // 5 (numpad)
+
+KeyboardMovement_Modes KeyboardMovement_Mode = eKeyboardMovement_None; // stores current keyboard control mode (disabled by default)
+
+KeyboardMovement_Directions KeyboardMovement_CurrentDirection = eKeyboardMovement_Stop; // stores current walking direction of player character
+
+//****************************************************************************************************
+// USER FUNCTIONS
+//****************************************************************************************************
+
+//====================================================================================================
+
+static function KeyboardMovement::SetMode(KeyboardMovement_Modes mode) {
+	KeyboardMovement_Mode = mode;
+}
+
+//====================================================================================================
+
+// key customization functions here
+
+//====================================================================================================
+
+//****************************************************************************************************
+// EVENT HANDLER FUNCTIONS
+//****************************************************************************************************
+
+//====================================================================================================
+
+function repeatedly_execute() {
+
+	//--------------------------------------------------
+	// Pressing mode
+	//--------------------------------------------------
+
+	if ((IsGamePaused() == true) || (KeyboardMovement_Mode != eKeyboardMovement_Pressing) || (IsInterfaceEnabled() == false) || (player.on == false)) return 0;
+	  // if game is paused, module or mode disabled, interface disabled or player character hidden, quit function
+
+	KeyboardMovement_Directions newdirection; // declare variable storing new direction
+
+	// get new direction:
+	if ( ((IsKeyPressed(KeyboardMovement_KeyDown)) && (IsKeyPressed(KeyboardMovement_KeyRight))) || (IsKeyPressed(KeyboardMovement_KeyDownRight)) ) newdirection = eKeyboardMovement_DownRight; // if down&right arrows or PgDn (numeric pad) held down, set new direction to Down-Right
+	else if ( ((IsKeyPressed(KeyboardMovement_KeyUp)) && (IsKeyPressed(KeyboardMovement_KeyRight))) || (IsKeyPressed(KeyboardMovement_KeyUpRight)) ) newdirection = eKeyboardMovement_UpRight; // up&right arrows or PgUp (numpad)
+	else if ( ((IsKeyPressed(KeyboardMovement_KeyDown)) && (IsKeyPressed(KeyboardMovement_KeyLeft))) || (IsKeyPressed(KeyboardMovement_KeyDownLeft)) ) newdirection = eKeyboardMovement_DownLeft; // down&left arrows or End (numpad)
+	else if ( ((IsKeyPressed(KeyboardMovement_KeyUp)) && (IsKeyPressed(KeyboardMovement_KeyLeft))) || (IsKeyPressed(KeyboardMovement_KeyUpLeft)) ) newdirection = eKeyboardMovement_UpLeft; // up&left arrows or Home (numpad)
+	else if (IsKeyPressed(KeyboardMovement_KeyDown)) newdirection = eKeyboardMovement_Down; // down arrow
+	else if (IsKeyPressed(KeyboardMovement_KeyLeft)) newdirection = eKeyboardMovement_Left; // left arrow
+	else if (IsKeyPressed(KeyboardMovement_KeyRight)) newdirection = eKeyboardMovement_Right; // right arrow
+	else if (IsKeyPressed(KeyboardMovement_KeyUp)) newdirection = eKeyboardMovement_Up; // up arrow
+	else newdirection = eKeyboardMovement_Stop; // if none of the above held down, set it to stop player character
+
+	if (IsKeyPressed(KeyboardMovement_KeyStop)) newdirection = eKeyboardMovement_Stop; // if 5 (numeric pad) held down, stop player character, regardless of whether some of the above are held down
+
+	if (newdirection != KeyboardMovement_CurrentDirection) { // if new direction is different from current direction
+
+		if (newdirection == eKeyboardMovement_Stop) player.StopMoving(); // if new direction is the Stop command, stop movement of player character
+		else { // if new direction is NOT the Stop command
+
+			int dx, dy; // declare variables storing new walk coordinates
+			if (newdirection == eKeyboardMovement_DownRight) {
+				dx = DISTANCE;
+				dy = DISTANCE;
+			}
+			else if (newdirection == eKeyboardMovement_UpRight) {
+				dx = DISTANCE;
+				dy = -DISTANCE;
+			}
+			else if (newdirection == eKeyboardMovement_DownLeft) {
+				dx = -DISTANCE;
+				dy = DISTANCE;
+			}
+			else if (newdirection == eKeyboardMovement_UpLeft) {
+				dx = -DISTANCE;
+				dy = -DISTANCE;
+			}
+			else if (newdirection == eKeyboardMovement_Down) {
+				dx = 0;
+				dy = DISTANCE;
+			}
+			else if (newdirection == eKeyboardMovement_Left) {
+				dx = -DISTANCE;
+				dy = 0;
+			}
+			else if (newdirection == eKeyboardMovement_Right) {
+				dx = DISTANCE;
+				dy = 0;
+			}
+			else if (newdirection == eKeyboardMovement_Up) {
+				dx = 0;
+				dy = -DISTANCE;
+			}
+
+			player.WalkStraight(player.x + dx, player.y + dy, eNoBlock); // walk player character to the new coordinates
+		}
+		KeyboardMovement_CurrentDirection = newdirection; // update current direction to new direction
+
+	}
+
+}
+
+//====================================================================================================
+
+function on_key_press(int keycode) {
+
+	//--------------------------------------------------
+	// Tapping mode
+	//--------------------------------------------------
+
+	if ((IsGamePaused() == true) || (KeyboardMovement_Mode != eKeyboardMovement_Tapping) || (IsInterfaceEnabled() == false) || (player.on == false)) return 0;
+	  // if game is paused, module or mode disabled, interface disabled or player character hidden, quit function
+
+	KeyboardMovement_Directions newdirection; // declare variable storing new direction
+
+	// get new direction:
+	if (keycode == KeyboardMovement_KeyDownRight) newdirection = eKeyboardMovement_DownRight; // if down-right key pressed, set new direction to Down-Right
+	else if (keycode == KeyboardMovement_KeyUpRight) newdirection = eKeyboardMovement_UpRight;
+	else if (keycode == KeyboardMovement_KeyDownLeft) newdirection = eKeyboardMovement_DownLeft;
+	else if (keycode == KeyboardMovement_KeyUpLeft) newdirection = eKeyboardMovement_UpLeft;
+	else if (keycode == KeyboardMovement_KeyDown) newdirection = eKeyboardMovement_Down;
+	else if (keycode == KeyboardMovement_KeyLeft) newdirection = eKeyboardMovement_Left;
+	else if (keycode == KeyboardMovement_KeyRight) newdirection = eKeyboardMovement_Right;
+	else if (keycode == KeyboardMovement_KeyUp) newdirection = eKeyboardMovement_Up;
+	else if (keycode == KeyboardMovement_KeyStop) newdirection = eKeyboardMovement_Stop; // if stop key pressed, set to stop player character
+
+	if (newdirection != KeyboardMovement_CurrentDirection) { // if new direction is different from current direction
+
+		if (newdirection == eKeyboardMovement_Stop) player.StopMoving(); // if new direction is the Stop command, stop movement of player character
+		else { // if new direction is NOT the Stop command
+
+			int dx, dy; // declare variables storing new walk coordinates
+			if (newdirection == eKeyboardMovement_DownRight) {
+				dx = DISTANCE;
+				dy = DISTANCE;
+			}
+			else if (newdirection == eKeyboardMovement_UpRight) {
+				dx = DISTANCE;
+				dy = -DISTANCE;
+			}
+			else if (newdirection == eKeyboardMovement_DownLeft) {
+				dx = -DISTANCE;
+				dy = DISTANCE;
+			}
+			else if (newdirection == eKeyboardMovement_UpLeft) {
+				dx = -DISTANCE;
+				dy = -DISTANCE;
+			}
+			else if (newdirection == eKeyboardMovement_Down) {
+				dx = 0;
+				dy = DISTANCE;
+			}
+			else if (newdirection == eKeyboardMovement_Left) {
+				dx = -DISTANCE;
+				dy = 0;
+			}
+			else if (newdirection == eKeyboardMovement_Right) {
+				dx = DISTANCE;
+				dy = 0;
+			}
+			else if (newdirection == eKeyboardMovement_Up) {
+				dx = 0;
+				dy = -DISTANCE;
+			}
+
+			player.WalkStraight(player.x + dx, player.y + dy, eNoBlock); // walk player character to the new coordinates
+		}
+		KeyboardMovement_CurrentDirection = newdirection; // update current direction to new direction
+
+	}
+	else { // if new direction is same as current direction
+		player.StopMoving(); // stop player character
+		KeyboardMovement_CurrentDirection = eKeyboardMovement_Stop; // update current direction
+	}
+
+}
+
+//====================================================================================================
+
+function on_event(EventType event, int data) {
+
+	if (event == eEventLeaveRoom) KeyboardMovement_CurrentDirection = eKeyboardMovement_Stop;
+
+}
+
+//====================================================================================================

samples/AGS Script/KeyboardMovement_102.ash

@@ -0,0 +1,13 @@
+// Script header for module 'KeyboardMovement'
+
+#define KeyboardMovement_VERSION 101
+
+enum KeyboardMovement_Modes {
+	eKeyboardMovement_None, 
+	eKeyboardMovement_Tapping, 
+	eKeyboardMovement_Pressing
+};
+
+struct KeyboardMovement {
+	import static function SetMode(KeyboardMovement_Modes mode);
+};

samples/APL/DeepakChopra.apl

@@ -0,0 +1,18 @@
+⍝   You can try this at http://tryapl.org/
+⍝   I can not explain how much I suddenly love this crypto-language
+
+
+
+Starts     ← 'Experiential truth ' 'The physical world ' 'Non-judgment '       'Quantum physics '
+Middles    ← 'nurtures an '        'projects onto '      'imparts reality to ' 'constructs with '
+Qualifiers ← 'abundance of '       'the barrier of '     'self-righteous '     'potential '
+Finishes   ← 'marvel.'             'choices.'            'creativity.'         'actions.'
+
+rf     ← {(?⍴⍵)⊃⍵}
+erf    ← {rf ¨ ⍵}
+
+deepak ← {erf Starts Middles Qualifiers Finishes}
+
+
+
+deepak ⍬

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/Alloy/file_system.als

@@ -0,0 +1,59 @@
+module examples/systems/file_system
+
+/*
+ * Model of a generic file system.
+ */
+
+abstract sig Object {}
+
+sig Name {}
+
+sig File extends Object {} { some d: Dir | this in d.entries.contents }
+
+sig Dir extends Object {
+  entries: set DirEntry,
+  parent: lone Dir
+} {
+  parent = this.~@contents.~@entries
+  all e1, e2 : entries | e1.name = e2.name => e1 = e2
+  this !in this.^@parent
+  this != Root => Root in this.^@parent
+}
+
+one sig Root extends Dir {} { no parent }
+
+lone sig Cur extends Dir {}
+
+sig DirEntry {
+  name: Name,
+  contents: Object
+} {
+  one this.~entries
+}
+
+
+/**
+ * all directories besides root have one parent
+ */
+pred OneParent_buggyVersion {
+    all d: Dir - Root | one d.parent
+}
+
+/**
+ * all directories besides root have one parent
+ */
+pred OneParent_correctVersion {
+    all d: Dir - Root | (one d.parent && one contents.d)
+}
+
+/**
+ * Only files may be linked (that is, have more than one entry)
+ * That is, all directories are the contents of at most one directory entry
+ */
+pred NoDirAliases {
+    all o: Dir | lone o.~contents
+}
+
+check { OneParent_buggyVersion => NoDirAliases } for 5 expect 1
+
+check { OneParent_correctVersion => NoDirAliases } for 5 expect 0

samples/Alloy/marksweepgc.als

@@ -0,0 +1,83 @@
+module examples/systems/marksweepgc
+
+/*
+ * Model of mark and sweep garbage collection.
+ */
+
+// a node in the heap
+sig Node {}
+
+sig HeapState {
+  left, right : Node -> lone Node,
+  marked : set Node,
+  freeList : lone Node
+}
+
+pred clearMarks[hs, hs' : HeapState] {
+  // clear marked set
+  no hs'.marked
+  // left and right fields are unchanged
+  hs'.left = hs.left
+  hs'.right = hs.right
+}
+
+/**
+ * simulate the recursion of the mark() function using transitive closure
+ */
+fun reachable[hs: HeapState, n: Node] : set Node {
+  n + n.^(hs.left + hs.right)
+}
+
+pred mark[hs: HeapState, from : Node, hs': HeapState] {
+  hs'.marked = hs.reachable[from]
+  hs'.left = hs.left
+  hs'.right = hs.right
+}
+
+/**
+ * complete hack to simulate behavior of code to set freeList
+ */
+pred setFreeList[hs, hs': HeapState] {
+  // especially hackish
+  hs'.freeList.*(hs'.left) in (Node - hs.marked)
+  all n: Node |
+    (n !in hs.marked) => {
+      no hs'.right[n]
+      hs'.left[n] in (hs'.freeList.*(hs'.left))
+      n in hs'.freeList.*(hs'.left)
+    } else {
+      hs'.left[n] = hs.left[n]
+      hs'.right[n] = hs.right[n]
+    }
+  hs'.marked = hs.marked
+}
+
+pred GC[hs: HeapState, root : Node, hs': HeapState] {
+  some hs1, hs2: HeapState |
+    hs.clearMarks[hs1] && hs1.mark[root, hs2] && hs2.setFreeList[hs']
+}
+
+assert Soundness1 {
+  all h, h' : HeapState, root : Node |
+    h.GC[root, h'] =>
+      (all live : h.reachable[root] | {
+        h'.left[live] = h.left[live]
+        h'.right[live] = h.right[live]
+      })
+}
+
+assert Soundness2 {
+  all h, h' : HeapState, root : Node |
+    h.GC[root, h'] =>
+      no h'.reachable[root] & h'.reachable[h'.freeList]
+}
+
+assert Completeness {
+  all h, h' : HeapState, root : Node |
+    h.GC[root, h'] =>
+      (Node - h'.reachable[root]) in h'.reachable[h'.freeList]
+}
+
+check Soundness1 for 3 expect 0
+check Soundness2 for 3 expect 0
+check Completeness for 3 expect 0

samples/Alloy/views.als

@@ -0,0 +1,217 @@
+module examples/systems/views
+
+/*
+ * Model of views in object-oriented programming.
+ *
+ * Two object references, called the view and the backing,
+ * are related by a view mechanism when changes to the
+ * backing are automatically propagated to the view. Note
+ * that the state of a view need not be a projection of the
+ * state of the backing; the keySet method of Map, for
+ * example, produces two view relationships, and for the
+ * one in which the map is modified by changes to the key
+ * set, the value of the new map cannot be determined from
+ * the key set. Note that in the iterator view mechanism,
+ * the iterator is by this definition the backing object,
+ * since changes are propagated from iterator to collection
+ * and not vice versa. Oddly, a reference may be a view of
+ * more than one backing: there can be two iterators on the
+ * same collection, eg. A reference cannot be a view under
+ * more than one view type.
+ *
+ * A reference is made dirty when it is a backing for a view
+ * with which it is no longer related by the view invariant.
+ * This usually happens when a view is modified, either
+ * directly or via another backing. For example, changing a
+ * collection directly when it has an iterator invalidates
+ * it, as does changing the collection through one iterator
+ * when there are others.
+ *
+ * More work is needed if we want to model more closely the
+ * failure of an iterator when its collection is invalidated.
+ *
+ * As a terminological convention, when there are two
+ * complementary view relationships, we will give them types
+ * t and t'. For example, KeySetView propagates from map to
+ * set, and KeySetView' propagates from set to map.
+ *
+ * author: Daniel Jackson
+ */
+
+open util/ordering[State] as so
+open util/relation as rel
+
+sig Ref {}
+sig Object {}
+
+-- t->b->v in views when v is view of type t of backing b
+-- dirty contains refs that have been invalidated
+sig State {
+  refs: set Ref,
+  obj: refs -> one Object,
+  views: ViewType -> refs -> refs,
+  dirty: set refs
+--  , anyviews: Ref -> Ref -- for visualization
+  }
+-- {anyviews = ViewType.views}
+
+sig Map extends Object {
+  keys: set Ref,
+  map: keys -> one Ref
+  }{all s: State |  keys + Ref.map in s.refs}
+sig MapRef extends Ref {}
+fact {State.obj[MapRef] in Map}
+
+sig Iterator extends Object {
+  left, done: set Ref,
+  lastRef: lone done
+  }{all s: State | done + left + lastRef in s.refs}
+sig IteratorRef extends Ref {}
+fact {State.obj[IteratorRef] in Iterator}
+
+sig Set extends Object {
+  elts: set Ref
+  }{all s: State | elts in s.refs}
+sig SetRef extends Ref {}
+fact {State.obj[SetRef] in Set}
+
+abstract sig ViewType {}
+one sig KeySetView, KeySetView', IteratorView extends ViewType {}
+fact ViewTypes {
+  State.views[KeySetView] in MapRef -> SetRef
+  State.views[KeySetView'] in SetRef -> MapRef
+  State.views[IteratorView] in IteratorRef -> SetRef
+  all s: State | s.views[KeySetView] = ~(s.views[KeySetView'])
+  }
+
+/**
+ * mods is refs modified directly or by view mechanism
+ * doesn't handle possibility of modifying an object and its view at once?
+ * should we limit frame conds to non-dirty refs?
+ */
+pred modifies [pre, post: State, rs: set Ref] {
+  let vr = pre.views[ViewType], mods = rs.*vr {
+    all r: pre.refs - mods | pre.obj[r] = post.obj[r]
+    all b: mods, v: pre.refs, t: ViewType |
+      b->v in pre.views[t] => viewFrame [t, pre.obj[v], post.obj[v], post.obj[b]]
+    post.dirty = pre.dirty +
+      {b: pre.refs | some v: Ref, t: ViewType |
+          b->v in pre.views[t] && !viewFrame [t, pre.obj[v], post.obj[v], post.obj[b]]
+      }
+    }
+  }
+
+pred allocates [pre, post: State, rs: set Ref] {
+  no rs & pre.refs
+  post.refs = pre.refs + rs
+  }
+
+/** 
+ * models frame condition that limits change to view object from v to v' when backing object changes to b'
+ */
+pred viewFrame [t: ViewType, v, v', b': Object] {
+  t in KeySetView => v'.elts = dom [b'.map]
+  t in KeySetView' => b'.elts = dom [v'.map]
+  t in KeySetView' => (b'.elts) <: (v.map) = (b'.elts) <: (v'.map)
+  t in IteratorView => v'.elts = b'.left + b'.done
+  }
+
+pred MapRef.keySet [pre, post: State, setRefs: SetRef] {
+  post.obj[setRefs].elts = dom [pre.obj[this].map]
+  modifies [pre, post, none]
+  allocates [pre, post, setRefs]
+  post.views = pre.views + KeySetView->this->setRefs + KeySetView'->setRefs->this
+  }
+
+pred MapRef.put [pre, post: State, k, v: Ref] {
+  post.obj[this].map = pre.obj[this].map ++ k->v
+  modifies [pre, post, this]
+  allocates [pre, post, none]
+  post.views = pre.views
+  }
+
+pred SetRef.iterator [pre, post: State, iterRef: IteratorRef] {
+  let i = post.obj[iterRef] {
+    i.left = pre.obj[this].elts
+    no i.done + i.lastRef
+    }
+  modifies [pre,post,none]
+  allocates [pre, post, iterRef]
+  post.views = pre.views + IteratorView->iterRef->this
+  }
+
+pred IteratorRef.remove [pre, post: State] {
+  let i = pre.obj[this], i' = post.obj[this] {
+    i'.left = i.left
+    i'.done = i.done - i.lastRef
+    no i'.lastRef
+    }
+  modifies [pre,post,this]
+  allocates [pre, post, none]
+  pre.views = post.views
+  }
+
+pred IteratorRef.next [pre, post: State, ref: Ref] {
+  let i = pre.obj[this], i' = post.obj[this] {
+    ref in i.left
+    i'.left = i.left - ref
+    i'.done = i.done + ref
+    i'.lastRef = ref
+    }
+  modifies [pre, post, this]
+  allocates [pre, post, none]
+  pre.views = post.views
+  }
+
+pred IteratorRef.hasNext [s: State] {
+  some s.obj[this].left
+  }
+
+assert zippishOK {
+  all
+    ks, vs: SetRef,
+    m: MapRef,
+    ki, vi: IteratorRef,
+    k, v: Ref |
+    let s0=so/first,
+    s1=so/next[s0],
+    s2=so/next[s1],
+    s3=so/next[s2],
+    s4=so/next[s3],
+    s5=so/next[s4],
+    s6=so/next[s5],
+    s7=so/next[s6] |
+  ({
+    precondition [s0, ks, vs, m]
+    no s0.dirty
+    ks.iterator [s0, s1, ki]
+    vs.iterator [s1, s2, vi]
+    ki.hasNext [s2]
+    vi.hasNext [s2]
+    ki.this/next [s2, s3, k]
+    vi.this/next [s3, s4, v]
+    m.put [s4, s5, k, v]
+    ki.remove [s5, s6]
+    vi.remove [s6, s7]
+  } => no State.dirty)
+  }
+
+pred precondition [pre: State, ks, vs, m: Ref] {
+  // all these conditions and other errors discovered in scope of 6 but 8,3
+  // in initial state, must have view invariants hold
+  (all t: ViewType, b, v: pre.refs |
+    b->v in pre.views[t] => viewFrame [t, pre.obj[v], pre.obj[v], pre.obj[b]])
+  // sets are not aliases
+--  ks != vs
+  // sets are not views of map
+--  no (ks+vs)->m & ViewType.pre.views
+  // no iterator currently on either set
+--  no Ref->(ks+vs) & ViewType.pre.views
+  }
+
+check zippishOK for 6 but 8 State, 3 ViewType expect 1
+
+/** 
+ * experiment with controlling heap size
+ */
+fact {all s: State | #s.obj < 5}

samples/AspectJ/CacheAspect.aj

@@ -0,0 +1,41 @@
+package com.blogspot.miguelinlas3.aspectj.cache;
+
+import java.util.Map;
+import java.util.WeakHashMap;
+
+import org.aspectj.lang.JoinPoint;
+
+import com.blogspot.miguelinlas3.aspectj.cache.marker.Cachable;
+
+/**
+ * This simple aspect simulates the behaviour of a very simple cache
+ *  
+ * @author migue
+ *
+ */
+public aspect CacheAspect {
+
+	public pointcut cache(Cachable cachable): execution(@Cachable * * (..)) && @annotation(cachable);
+	
+	Object around(Cachable cachable): cache(cachable){
+	
+		String evaluatedKey = this.evaluateKey(cachable.scriptKey(), thisJoinPoint);
+		
+		if(cache.containsKey(evaluatedKey)){
+			System.out.println("Cache hit for key " + evaluatedKey);
+			return this.cache.get(evaluatedKey);
+		}
+		
+		System.out.println("Cache miss for key " + evaluatedKey);
+		Object value = proceed(cachable);
+		cache.put(evaluatedKey, value);
+		return value;
+	}
+	
+	protected String evaluateKey(String key, JoinPoint joinPoint) {
+		// TODO add some smart staff to allow simple scripting in @Cachable annotation
+		return key;
+	}
+	
+	protected Map<String, Object> cache = new WeakHashMap<String, Object>();
+}

samples/AspectJ/OptimizeRecursionCache.aj

@@ -0,0 +1,50 @@
+package aspects.caching;
+
+import java.util.Map;
+
+/**
+ * Cache aspect for optimize recursive functions.
+ * 
+ * @author Migueli
+ * @date 05/11/2013
+ * @version 1.0
+ *
+ */
+public abstract aspect OptimizeRecursionCache {
+		
+	@SuppressWarnings("rawtypes")
+	private Map _cache;
+	
+	public OptimizeRecursionCache() {
+		_cache = getCache();
+	}
+	
+	@SuppressWarnings("rawtypes")
+	abstract public Map getCache();
+	
+	abstract public pointcut operation(Object o);
+
+	pointcut topLevelOperation(Object o): operation(o) && !cflowbelow(operation(Object));
+
+	before(Object o) : topLevelOperation(o) {
+		System.out.println("Seeking value for " + o);
+	}
+
+	Object around(Object o) : operation(o) {
+		Object cachedValue = _cache.get(o);
+		if (cachedValue != null) {
+			System.out.println("Found cached value for " + o + ": " + cachedValue);
+			return cachedValue;
+		}
+		return proceed(o);
+	}
+
+	@SuppressWarnings("unchecked")
+	after(Object o) returning(Object result) : topLevelOperation(o) {
+		_cache.put(o, result);
+	}
+	
+	after(Object o) returning(Object result) : topLevelOperation(o) {
+		System.out.println("cache size: " + _cache.size());
+	}
+}

samples/Assembly/FASM.asm

@@ -0,0 +1,350 @@
+
+; flat assembler interface for Win32
+; Copyright (c) 1999-2014, Tomasz Grysztar.
+; All rights reserved.
+
+	format	PE console
+
+section '.text' code readable executable
+
+start:
+
+	mov	[con_handle],STD_OUTPUT_HANDLE
+	mov	esi,_logo
+	call	display_string
+
+	call	get_params
+	jc	information
+
+	call	init_memory
+
+	mov	esi,_memory_prefix
+	call	display_string
+	mov	eax,[memory_end]
+	sub	eax,[memory_start]
+	add	eax,[additional_memory_end]
+	sub	eax,[additional_memory]
+	shr	eax,10
+	call	display_number
+	mov	esi,_memory_suffix
+	call	display_string
+
+	call	[GetTickCount]
+	mov	[start_time],eax
+
+	call	preprocessor
+	call	parser
+	call	assembler
+	call	formatter
+
+	call	display_user_messages
+	movzx	eax,[current_pass]
+	inc	eax
+	call	display_number
+	mov	esi,_passes_suffix
+	call	display_string
+	call	[GetTickCount]
+	sub	eax,[start_time]
+	xor	edx,edx
+	mov	ebx,100
+	div	ebx
+	or	eax,eax
+	jz	display_bytes_count
+	xor	edx,edx
+	mov	ebx,10
+	div	ebx
+	push	edx
+	call	display_number
+	mov	dl,'.'
+	call	display_character
+	pop	eax
+	call	display_number
+	mov	esi,_seconds_suffix
+	call	display_string
+      display_bytes_count:
+	mov	eax,[written_size]
+	call	display_number
+	mov	esi,_bytes_suffix
+	call	display_string
+	xor	al,al
+	jmp	exit_program
+
+information:
+	mov	esi,_usage
+	call	display_string
+	mov	al,1
+	jmp	exit_program
+
+get_params:
+	mov	[input_file],0
+	mov	[output_file],0
+	mov	[symbols_file],0
+	mov	[memory_setting],0
+	mov	[passes_limit],100
+	call	[GetCommandLine]
+	mov	esi,eax
+	mov	edi,params
+    find_command_start:
+	lodsb
+	cmp	al,20h
+	je	find_command_start
+	cmp	al,22h
+	je	skip_quoted_name
+    skip_name:
+	lodsb
+	cmp	al,20h
+	je	find_param
+	or	al,al
+	jz	all_params
+	jmp	skip_name
+    skip_quoted_name:
+	lodsb
+	cmp	al,22h
+	je	find_param
+	or	al,al
+	jz	all_params
+	jmp	skip_quoted_name
+    find_param:
+	lodsb
+	cmp	al,20h
+	je	find_param
+	cmp	al,'-'
+	je	option_param
+	cmp	al,0Dh
+	je	all_params
+	or	al,al
+	jz	all_params
+	cmp	[input_file],0
+	jne	get_output_file
+	mov	[input_file],edi
+	jmp	process_param
+      get_output_file:
+	cmp	[output_file],0
+	jne	bad_params
+	mov	[output_file],edi
+    process_param:
+	cmp	al,22h
+	je	string_param
+    copy_param:
+	stosb
+	lodsb
+	cmp	al,20h
+	je	param_end
+	cmp	al,0Dh
+	je	param_end
+	or	al,al
+	jz	param_end
+	jmp	copy_param
+    string_param:
+	lodsb
+	cmp	al,22h
+	je	string_param_end
+	cmp	al,0Dh
+	je	param_end
+	or	al,al
+	jz	param_end
+	stosb
+	jmp	string_param
+    option_param:
+	lodsb
+	cmp	al,'m'
+	je	memory_option
+	cmp	al,'M'
+	je	memory_option
+	cmp	al,'p'
+	je	passes_option
+	cmp	al,'P'
+	je	passes_option
+	cmp	al,'s'
+	je	symbols_option
+	cmp	al,'S'
+	je	symbols_option
+    bad_params:
+	stc
+	ret
+    get_option_value:
+	xor	eax,eax
+	mov	edx,eax
+    get_option_digit:
+	lodsb
+	cmp	al,20h
+	je	option_value_ok
+	cmp	al,0Dh
+	je	option_value_ok
+	or	al,al
+	jz	option_value_ok
+	sub	al,30h
+	jc	invalid_option_value
+	cmp	al,9
+	ja	invalid_option_value
+	imul	edx,10
+	jo	invalid_option_value
+	add	edx,eax
+	jc	invalid_option_value
+	jmp	get_option_digit
+    option_value_ok:
+	dec	esi
+	clc
+	ret
+    invalid_option_value:
+	stc
+	ret
+    memory_option:
+	lodsb
+	cmp	al,20h
+	je	memory_option
+	cmp	al,0Dh
+	je	bad_params
+	or	al,al
+	jz	bad_params
+	dec	esi
+	call	get_option_value
+	or	edx,edx
+	jz	bad_params
+	cmp	edx,1 shl (32-10)
+	jae	bad_params
+	mov	[memory_setting],edx
+	jmp	find_param
+    passes_option:
+	lodsb
+	cmp	al,20h
+	je	passes_option
+	cmp	al,0Dh
+	je	bad_params
+	or	al,al
+	jz	bad_params
+	dec	esi
+	call	get_option_value
+	or	edx,edx
+	jz	bad_params
+	cmp	edx,10000h
+	ja	bad_params
+	mov	[passes_limit],dx
+	jmp	find_param
+    symbols_option:
+	mov	[symbols_file],edi
+      find_symbols_file_name:
+	lodsb
+	cmp	al,20h
+	jne	process_param
+	jmp	find_symbols_file_name
+    param_end:
+	dec	esi
+    string_param_end:
+	xor	al,al
+	stosb
+	jmp	find_param
+    all_params:
+	cmp	[input_file],0
+	je	bad_params
+	clc
+	ret
+
+include 'system.inc'
+
+include '..\errors.inc'
+include '..\symbdump.inc'
+include '..\preproce.inc'
+include '..\parser.inc'
+include '..\exprpars.inc'
+include '..\assemble.inc'
+include '..\exprcalc.inc'
+include '..\formats.inc'
+include '..\x86_64.inc'
+include '..\avx.inc'
+
+include '..\tables.inc'
+include '..\messages.inc'
+
+section '.data' data readable writeable
+
+include '..\version.inc'
+
+_copyright db 'Copyright (c) 1999-2014, Tomasz Grysztar',0Dh,0Ah,0
+
+_logo db 'flat assembler  version ',VERSION_STRING,0
+_usage db 0Dh,0Ah
+       db 'usage: fasm <source> [output]',0Dh,0Ah
+       db 'optional settings:',0Dh,0Ah
+       db ' -m <limit>    set the limit in kilobytes for the available memory',0Dh,0Ah
+       db ' -p <limit>    set the maximum allowed number of passes',0Dh,0Ah
+       db ' -s <file>     dump symbolic information for debugging',0Dh,0Ah
+       db 0
+_memory_prefix db '  (',0
+_memory_suffix db ' kilobytes memory)',0Dh,0Ah,0
+_passes_suffix db ' passes, ',0
+_seconds_suffix db ' seconds, ',0
+_bytes_suffix db ' bytes.',0Dh,0Ah,0
+
+align 4
+
+include '..\variable.inc'
+
+con_handle dd ?
+memory_setting dd ?
+start_time dd ?
+bytes_count dd ?
+displayed_count dd ?
+character db ?
+last_displayed rb 2
+
+params rb 1000h
+options rb 1000h
+buffer rb 4000h
+
+stack 10000h
+
+section '.idata' import data readable writeable
+
+  dd 0,0,0,rva kernel_name,rva kernel_table
+  dd 0,0,0,0,0
+
+  kernel_table:
+    ExitProcess dd rva _ExitProcess
+    CreateFile dd rva _CreateFileA
+    ReadFile dd rva _ReadFile
+    WriteFile dd rva _WriteFile
+    CloseHandle dd rva _CloseHandle
+    SetFilePointer dd rva _SetFilePointer
+    GetCommandLine dd rva _GetCommandLineA
+    GetEnvironmentVariable dd rva _GetEnvironmentVariable
+    GetStdHandle dd rva _GetStdHandle
+    VirtualAlloc dd rva _VirtualAlloc
+    VirtualFree dd rva _VirtualFree
+    GetTickCount dd rva _GetTickCount
+    GetSystemTime dd rva _GetSystemTime
+    GlobalMemoryStatus dd rva _GlobalMemoryStatus
+    dd 0
+
+  kernel_name db 'KERNEL32.DLL',0
+
+  _ExitProcess dw 0
+    db 'ExitProcess',0
+  _CreateFileA dw 0
+    db 'CreateFileA',0
+  _ReadFile dw 0
+    db 'ReadFile',0
+  _WriteFile dw 0
+    db 'WriteFile',0
+  _CloseHandle dw 0
+    db 'CloseHandle',0
+  _SetFilePointer dw 0
+    db 'SetFilePointer',0
+  _GetCommandLineA dw 0
+    db 'GetCommandLineA',0
+  _GetEnvironmentVariable dw 0
+    db 'GetEnvironmentVariableA',0
+  _GetStdHandle dw 0
+    db 'GetStdHandle',0
+  _VirtualAlloc dw 0
+    db 'VirtualAlloc',0
+  _VirtualFree dw 0
+    db 'VirtualFree',0
+  _GetTickCount dw 0
+    db 'GetTickCount',0
+  _GetSystemTime dw 0
+    db 'GetSystemTime',0
+  _GlobalMemoryStatus dw 0
+    db 'GlobalMemoryStatus',0
+
+section '.reloc' fixups data readable discardable

samples/BlitzMax/sample.bmx

@@ -0,0 +1,25 @@
+SuperStrict
+
+Framework Brl.StandardIO
+
+Type TMyType
+	Field property:int
+
+	Function A:int(param:int)
+		'do nothing
+	End Function
+
+	Method B:int(param:int)
+		'do nothing
+	End Method
+End Type
+
+
+Global my:TMyType = new TMyType
+?Win32
+	my.A()
+	my.B()
+?Linux
+	my.B()
+	my.A()
+?

samples/C++/Math.inl

@@ -0,0 +1,530 @@
+/*
+===========================================================================
+The Open Game Libraries.
+Copyright (C) 2007-2010 Lusito Software
+
+Author:  Santo Pfingsten (TTK-Bandit)
+Purpose: Math namespace
+-----------------------------------------
+
+This software is provided 'as-is', without any express or implied
+warranty. In no event will the authors be held liable for any damages
+arising from the use of this software.
+
+Permission is granted to anyone to use this software for any purpose,
+including commercial applications, and to alter it and redistribute it
+freely, subject to the following restrictions:
+
+1. The origin of this software must not be misrepresented; you must not
+   claim that you wrote the original software. If you use this software
+   in a product, an acknowledgment in the product documentation would be
+   appreciated but is not required.
+
+2. Altered source versions must be plainly marked as such, and must not be
+   misrepresented as being the original software.
+
+3. This notice may not be removed or altered from any source distribution.
+===========================================================================
+*/
+
+#ifndef __OG_MATH_INL__
+#define __OG_MATH_INL__
+
+namespace og {
+
+/*
+==============================================================================
+
+  Math
+
+==============================================================================
+*/
+
+/*
+================
+Math::Abs
+================
+*/
+OG_INLINE int Math::Abs( int i ) {
+#if 1
+	if ( i & 0x80000000 )
+		return 0x80000000 - (i & MASK_SIGNED);
+	return i;
+#else
+   int y = x >> 31;
+   return ( ( x ^ y ) - y );
+#endif
+}
+
+/*
+================
+Math::Fabs
+================
+*/
+OG_INLINE float Math::Fabs( float f ) {
+#if 1
+	uInt *pf = reinterpret_cast<uInt*>(&f);
+	*(pf) &= MASK_SIGNED;
+	return f;
+#else
+	return fabsf( f );
+#endif
+}
+
+/*
+================
+Math::Round
+================
+*/
+OG_INLINE float Math::Round( float f ) {
+	return floorf( f + 0.5f );
+}
+
+/*
+================
+Math::Floor
+================
+*/
+OG_INLINE float Math::Floor( float f ) {
+	return floorf( f );
+}
+
+/*
+================
+Math::Ceil
+================
+*/
+OG_INLINE float Math::Ceil( float f ) {
+	return ceilf( f );
+}
+
+/*
+================
+Math::Ftoi
+
+ok since this is SSE, why should the other ftoi be the faster one ?
+and: we might need to add a check for SSE extensions..
+because sse isn't *really* faster (I actually read that GCC does not handle
+SSE extensions perfectly. I'll find the link and send it to you when you're online)
+================
+*/
+OG_INLINE int Math::Ftoi( float f ) {
+	//! @todo	needs testing
+	// note: sse function cvttss2si
+#if OG_ASM_MSVC
+	int i;
+#if defined(OG_FTOI_USE_SSE)
+	if( SysInfo::cpu.general.SSE ) {
+		__asm cvttss2si	eax, f
+		__asm mov		i, eax
+		return i;
+	} else
+#endif
+	{
+		__asm fld		f
+		__asm fistp		i
+		//__asm mov eax, i // do we need this ? O_o
+	}
+	return i;
+#elif OG_ASM_GNU
+	int i;
+#if defined(OG_FTOI_USE_SSE)
+	if( SysInfo::cpu.general.SSE ) {
+		__asm__ __volatile__( "cvttss2si %1    \n\t"
+			: "=m" (i)
+			: "m" (f)
+		);
+	} else
+#endif
+	{
+		__asm__ __volatile__( "flds %1    \n\t"
+							  "fistpl %0  \n\t"
+			: "=m" (i)
+			: "m" (f)
+		);
+	}
+	return i;
+#else
+	// we use c++ cast instead of c cast (not sure why id did that)
+	return static_cast<int>(f);
+#endif
+}
+
+/*
+================
+Math::FtoiFast
+================
+*/
+OG_INLINE int Math::FtoiFast( float f ) {
+#if OG_ASM_MSVC
+	int i;
+	__asm fld		f
+	__asm fistp		i
+	//__asm mov eax, i // do we need this ? O_o
+	return i;
+#elif OG_ASM_GNU
+	int i;
+	__asm__ __volatile__( "flds %1    \n\t"
+						  "fistpl %0  \n\t"
+		: "=m" (i)
+		: "m" (f)
+	);
+	return i;
+#else
+	// we use c++ cast instead of c cast (not sure why id did that)
+	return static_cast<int>(f);
+#endif
+}
+
+/*
+================
+Math::Ftol
+================
+*/
+OG_INLINE long Math::Ftol( float f ) {
+#if OG_ASM_MSVC
+	long i;
+	__asm fld		f
+	__asm fistp		i
+	//__asm mov eax, i // do we need this ? O_o
+	return i;
+#elif OG_ASM_GNU
+	long i;
+	__asm__ __volatile__( "flds %1    \n\t"
+						  "fistpl %0  \n\t"
+		: "=m" (i)
+		: "m" (f)
+	);
+	return i;
+#else
+	// we use c++ cast instead of c cast (not sure why id did that)
+	return static_cast<long>(f);
+#endif
+}
+
+/*
+================
+Math::Sign
+================
+*/
+OG_INLINE float Math::Sign( float f )	{
+	if ( f > 0.0f )
+		return 1.0f;
+	if ( f < 0.0f )
+		return -1.0f;
+	return 0.0f;
+}
+
+/*
+================
+Math::Fmod
+================
+*/
+OG_INLINE float Math::Fmod( float numerator, float denominator ) {
+	return fmodf( numerator, denominator );
+}
+
+/*
+================
+Math::Modf
+================
+*/
+OG_INLINE float Math::Modf( float f, float& i ) {
+	return modff( f, &i );
+}
+OG_INLINE float Math::Modf( float f ) {
+	float i;
+	return modff( f, &i );
+}
+
+/*
+================
+Math::Sqrt
+================
+*/
+OG_INLINE float Math::Sqrt( float f ) {
+	return sqrtf( f );
+}
+
+/*
+================
+Math::InvSqrt
+
+Cannot be 0.0f
+================
+*/
+OG_INLINE float Math::InvSqrt( float f ) {
+	OG_ASSERT( f != 0.0f );
+	return 1.0f / sqrtf( f );
+}
+
+/*
+================
+Math::RSqrt
+
+Can be 0.0f
+================
+*/
+OG_INLINE float Math::RSqrt( float f ) {
+	float g = 0.5f * f;
+	int i = *reinterpret_cast<int *>(&f);
+
+	// do a guess
+	i = 0x5f375a86 - ( i>>1 );
+	f = *reinterpret_cast<float *>(&i);
+
+	// Newtons calculation
+	f = f * ( 1.5f - g * f * f );
+	return f;
+}
+
+/*
+================
+Math::Log/Log2/Log10
+
+Log of 0 is bad.
+I've also heard you're not really
+supposed to do log of negatives, yet
+they work fine.
+================
+*/
+OG_INLINE float Math::Log( float f ) {
+	OG_ASSERT( f != 0.0f );
+	return logf( f );
+}
+OG_INLINE float Math::Log2( float f ) {
+	OG_ASSERT( f != 0.0f );
+	return INV_LN_2 * logf( f );
+}
+OG_INLINE float Math::Log10( float f ) {
+	OG_ASSERT( f != 0.0f );
+	return INV_LN_10 * logf( f );
+}
+
+/*
+================
+Math::Pow
+================
+*/
+OG_INLINE float Math::Pow( float base, float exp ) {
+	return powf( base, exp );
+}
+
+/*
+================
+Math::Exp
+================
+*/
+OG_INLINE float Math::Exp( float f ) {
+	return expf( f );
+}
+
+/*
+================
+Math::IsPowerOfTwo
+================
+*/
+OG_INLINE bool Math::IsPowerOfTwo( int x ) {
+	// This is the faster of the two known methods
+	// with the x > 0 check moved to the beginning
+	return x > 0 && ( x & ( x - 1 ) ) == 0;
+}
+
+/*
+================
+Math::HigherPowerOfTwo
+================
+*/
+OG_INLINE int Math::HigherPowerOfTwo( int x ) {
+	x--;
+	x |= x >> 1;
+	x |= x >> 2;
+	x |= x >> 4;
+	x |= x >> 8;
+	x |= x >> 16;
+	return x + 1;
+}
+
+/*
+================
+Math::LowerPowerOfTwo
+================
+*/
+OG_INLINE int Math::LowerPowerOfTwo( int x ) {
+	return HigherPowerOfTwo( x ) >> 1;
+}
+
+/*
+================
+Math::FloorPowerOfTwo
+================
+*/
+OG_INLINE int Math::FloorPowerOfTwo( int x ) {
+	return IsPowerOfTwo( x ) ? x : LowerPowerOfTwo( x );
+}
+
+/*
+================
+Math::CeilPowerOfTwo
+================
+*/
+OG_INLINE int Math::CeilPowerOfTwo( int x ) {
+	return IsPowerOfTwo( x ) ? x : HigherPowerOfTwo( x );
+}
+
+/*
+================
+Math::ClosestPowerOfTwo
+================
+*/
+OG_INLINE int Math::ClosestPowerOfTwo( int x ) {
+	if ( IsPowerOfTwo( x ) )
+		return x;
+	int high = HigherPowerOfTwo( x );
+	int low = high >> 1;
+	return ((high-x) < (x-low)) ? high : low;
+}
+
+/*
+================
+Math::Digits
+================
+*/
+OG_INLINE int Math::Digits( int x ) {
+	int digits = 1;
+	int step = 10;
+	while (step <= x) {
+		digits++;
+		step *= 10;
+	}
+	return digits;
+}
+
+/*
+================
+Math::Sin/ASin
+================
+*/
+OG_INLINE float Math::Sin( float f ) {
+	return sinf( f );
+}
+OG_INLINE float Math::ASin( float f ) {
+	if ( f <= -1.0f )
+		return -HALF_PI;
+	if ( f >= 1.0f )
+		return HALF_PI;
+	return asinf( f );
+}
+
+/*
+================
+Math::Cos/ACos
+================
+*/
+OG_INLINE float Math::Cos( float f ) {
+	return cosf( f );
+}
+OG_INLINE float Math::ACos( float f ) {
+	if ( f <= -1.0f )
+		return PI;
+	if ( f >= 1.0f )
+		return 0.0f;
+	return acosf( f );
+}
+
+/*
+================
+Math::Tan/ATan
+================
+*/
+OG_INLINE float Math::Tan( float f ) {
+	return tanf( f );
+}
+OG_INLINE float Math::ATan( float f ) {
+	return atanf( f );
+}
+OG_INLINE float Math::ATan( float f1, float f2 ) {
+	return atan2f( f1, f2 );
+}
+
+/*
+================
+Math::SinCos
+================
+*/
+OG_INLINE void Math::SinCos( float f, float &s, float &c ) {
+#if OG_ASM_MSVC
+	// sometimes assembler is just waaayy faster
+	_asm {
+		fld		f
+		fsincos
+		mov		ecx, c
+		mov		edx, s
+		fstp	dword ptr [ecx]
+		fstp	dword ptr [edx]
+	}
+#elif OG_ASM_GNU
+	asm ("fsincos" : "=t" (c), "=u" (s) : "0" (f));
+#else
+	s = Sin(f);
+	c = Sqrt( 1.0f - s * s ); // faster than calling Cos(f)
+#endif
+}
+
+/*
+================
+Math::Deg2Rad
+================
+*/
+OG_INLINE float Math::Deg2Rad( float f ) {
+	return f * DEG_TO_RAD;
+}
+
+/*
+================
+Math::Rad2Deg
+================
+*/
+OG_INLINE float Math::Rad2Deg( float f ) {
+	return f * RAD_TO_DEG;
+}
+
+/*
+================
+Math::Square
+================
+*/
+OG_INLINE float Math::Square( float v ) {
+	return v * v;
+}
+
+/*
+================
+Math::Cube
+================
+*/
+OG_INLINE float Math::Cube( float v ) {
+	return v * v * v;
+}
+
+/*
+================
+Math::Sec2Ms
+================
+*/
+OG_INLINE int Math::Sec2Ms( int sec ) {
+	return sec * 1000;
+}
+
+/*
+================
+Math::Ms2Sec
+================
+*/
+OG_INLINE int Math::Ms2Sec( int ms ) {
+	return FtoiFast( ms * 0.001f );
+}
+
+}
+
+#endif

samples/C++/epoll_reactor.ipp

@@ -0,0 +1,664 @@
+//
+// detail/impl/epoll_reactor.ipp
+// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+//
+// Copyright (c) 2003-2013 Christopher M. Kohlhoff (chris at kohlhoff dot com)
+//
+// Distributed under the Boost Software License, Version 1.0. (See accompanying
+// file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
+//
+
+#ifndef BOOST_ASIO_DETAIL_IMPL_EPOLL_REACTOR_IPP
+#define BOOST_ASIO_DETAIL_IMPL_EPOLL_REACTOR_IPP
+
+#if defined(_MSC_VER) && (_MSC_VER >= 1200)
+# pragma once
+#endif // defined(_MSC_VER) && (_MSC_VER >= 1200)
+
+#include <boost/asio/detail/config.hpp>
+
+#if defined(BOOST_ASIO_HAS_EPOLL)
+
+#include <cstddef>
+#include <sys/epoll.h>
+#include <boost/asio/detail/epoll_reactor.hpp>
+#include <boost/asio/detail/throw_error.hpp>
+#include <boost/asio/error.hpp>
+
+#if defined(BOOST_ASIO_HAS_TIMERFD)
+# include <sys/timerfd.h>
+#endif // defined(BOOST_ASIO_HAS_TIMERFD)
+
+#include <boost/asio/detail/push_options.hpp>
+
+namespace boost {
+namespace asio {
+namespace detail {
+
+epoll_reactor::epoll_reactor(boost::asio::io_service& io_service)
+  : boost::asio::detail::service_base<epoll_reactor>(io_service),
+    io_service_(use_service<io_service_impl>(io_service)),
+    mutex_(),
+    interrupter_(),
+    epoll_fd_(do_epoll_create()),
+    timer_fd_(do_timerfd_create()),
+    shutdown_(false)
+{
+  // Add the interrupter's descriptor to epoll.
+  epoll_event ev = { 0, { 0 } };
+  ev.events = EPOLLIN | EPOLLERR | EPOLLET;
+  ev.data.ptr = &interrupter_;
+  epoll_ctl(epoll_fd_, EPOLL_CTL_ADD, interrupter_.read_descriptor(), &ev);
+  interrupter_.interrupt();
+
+  // Add the timer descriptor to epoll.
+  if (timer_fd_ != -1)
+  {
+    ev.events = EPOLLIN | EPOLLERR;
+    ev.data.ptr = &timer_fd_;
+    epoll_ctl(epoll_fd_, EPOLL_CTL_ADD, timer_fd_, &ev);
+  }
+}
+
+epoll_reactor::~epoll_reactor()
+{
+  if (epoll_fd_ != -1)
+    close(epoll_fd_);
+  if (timer_fd_ != -1)
+    close(timer_fd_);
+}
+
+void epoll_reactor::shutdown_service()
+{
+  mutex::scoped_lock lock(mutex_);
+  shutdown_ = true;
+  lock.unlock();
+
+  op_queue<operation> ops;
+
+  while (descriptor_state* state = registered_descriptors_.first())
+  {
+    for (int i = 0; i < max_ops; ++i)
+      ops.push(state->op_queue_[i]);
+    state->shutdown_ = true;
+    registered_descriptors_.free(state);
+  }
+
+  timer_queues_.get_all_timers(ops);
+
+  io_service_.abandon_operations(ops);
+}
+
+void epoll_reactor::fork_service(boost::asio::io_service::fork_event fork_ev)
+{
+  if (fork_ev == boost::asio::io_service::fork_child)
+  {
+    if (epoll_fd_ != -1)
+      ::close(epoll_fd_);
+    epoll_fd_ = -1;
+    epoll_fd_ = do_epoll_create();
+
+    if (timer_fd_ != -1)
+      ::close(timer_fd_);
+    timer_fd_ = -1;
+    timer_fd_ = do_timerfd_create();
+
+    interrupter_.recreate();
+
+    // Add the interrupter's descriptor to epoll.
+    epoll_event ev = { 0, { 0 } };
+    ev.events = EPOLLIN | EPOLLERR | EPOLLET;
+    ev.data.ptr = &interrupter_;
+    epoll_ctl(epoll_fd_, EPOLL_CTL_ADD, interrupter_.read_descriptor(), &ev);
+    interrupter_.interrupt();
+
+    // Add the timer descriptor to epoll.
+    if (timer_fd_ != -1)
+    {
+      ev.events = EPOLLIN | EPOLLERR;
+      ev.data.ptr = &timer_fd_;
+      epoll_ctl(epoll_fd_, EPOLL_CTL_ADD, timer_fd_, &ev);
+    }
+
+    update_timeout();
+
+    // Re-register all descriptors with epoll.
+    mutex::scoped_lock descriptors_lock(registered_descriptors_mutex_);
+    for (descriptor_state* state = registered_descriptors_.first();
+        state != 0; state = state->next_)
+    {
+      ev.events = state->registered_events_;
+      ev.data.ptr = state;
+      int result = epoll_ctl(epoll_fd_, EPOLL_CTL_ADD, state->descriptor_, &ev);
+      if (result != 0)
+      {
+        boost::system::error_code ec(errno,
+            boost::asio::error::get_system_category());
+        boost::asio::detail::throw_error(ec, "epoll re-registration");
+      }
+    }
+  }
+}
+
+void epoll_reactor::init_task()
+{
+  io_service_.init_task();
+}
+
+int epoll_reactor::register_descriptor(socket_type descriptor,
+    epoll_reactor::per_descriptor_data& descriptor_data)
+{
+  descriptor_data = allocate_descriptor_state();
+
+  {
+    mutex::scoped_lock descriptor_lock(descriptor_data->mutex_);
+
+    descriptor_data->reactor_ = this;
+    descriptor_data->descriptor_ = descriptor;
+    descriptor_data->shutdown_ = false;
+  }
+
+  epoll_event ev = { 0, { 0 } };
+  ev.events = EPOLLIN | EPOLLERR | EPOLLHUP | EPOLLPRI | EPOLLET;
+  descriptor_data->registered_events_ = ev.events;
+  ev.data.ptr = descriptor_data;
+  int result = epoll_ctl(epoll_fd_, EPOLL_CTL_ADD, descriptor, &ev);
+  if (result != 0)
+    return errno;
+
+  return 0;
+}
+
+int epoll_reactor::register_internal_descriptor(
+    int op_type, socket_type descriptor,
+    epoll_reactor::per_descriptor_data& descriptor_data, reactor_op* op)
+{
+  descriptor_data = allocate_descriptor_state();
+
+  {
+    mutex::scoped_lock descriptor_lock(descriptor_data->mutex_);
+
+    descriptor_data->reactor_ = this;
+    descriptor_data->descriptor_ = descriptor;
+    descriptor_data->shutdown_ = false;
+    descriptor_data->op_queue_[op_type].push(op);
+  }
+
+  epoll_event ev = { 0, { 0 } };
+  ev.events = EPOLLIN | EPOLLERR | EPOLLHUP | EPOLLPRI | EPOLLET;
+  descriptor_data->registered_events_ = ev.events;
+  ev.data.ptr = descriptor_data;
+  int result = epoll_ctl(epoll_fd_, EPOLL_CTL_ADD, descriptor, &ev);
+  if (result != 0)
+    return errno;
+
+  return 0;
+}
+
+void epoll_reactor::move_descriptor(socket_type,
+    epoll_reactor::per_descriptor_data& target_descriptor_data,
+    epoll_reactor::per_descriptor_data& source_descriptor_data)
+{
+  target_descriptor_data = source_descriptor_data;
+  source_descriptor_data = 0;
+}
+
+void epoll_reactor::start_op(int op_type, socket_type descriptor,
+    epoll_reactor::per_descriptor_data& descriptor_data, reactor_op* op,
+    bool is_continuation, bool allow_speculative)
+{
+  if (!descriptor_data)
+  {
+    op->ec_ = boost::asio::error::bad_descriptor;
+    post_immediate_completion(op, is_continuation);
+    return;
+  }
+
+  mutex::scoped_lock descriptor_lock(descriptor_data->mutex_);
+
+  if (descriptor_data->shutdown_)
+  {
+    post_immediate_completion(op, is_continuation);
+    return;
+  }
+
+  if (descriptor_data->op_queue_[op_type].empty())
+  {
+    if (allow_speculative
+        && (op_type != read_op
+          || descriptor_data->op_queue_[except_op].empty()))
+    {
+      if (op->perform())
+      {
+        descriptor_lock.unlock();
+        io_service_.post_immediate_completion(op, is_continuation);
+        return;
+      }
+
+      if (op_type == write_op)
+      {
+        if ((descriptor_data->registered_events_ & EPOLLOUT) == 0)
+        {
+          epoll_event ev = { 0, { 0 } };
+          ev.events = descriptor_data->registered_events_ | EPOLLOUT;
+          ev.data.ptr = descriptor_data;
+          if (epoll_ctl(epoll_fd_, EPOLL_CTL_MOD, descriptor, &ev) == 0)
+          {
+            descriptor_data->registered_events_ |= ev.events;
+          }
+          else
+          {
+            op->ec_ = boost::system::error_code(errno,
+                boost::asio::error::get_system_category());
+            io_service_.post_immediate_completion(op, is_continuation);
+            return;
+          }
+        }
+      }
+    }
+    else
+    {
+      if (op_type == write_op)
+      {
+        descriptor_data->registered_events_ |= EPOLLOUT;
+      }
+
+      epoll_event ev = { 0, { 0 } };
+      ev.events = descriptor_data->registered_events_;
+      ev.data.ptr = descriptor_data;
+      epoll_ctl(epoll_fd_, EPOLL_CTL_MOD, descriptor, &ev);
+    }
+  }
+
+  descriptor_data->op_queue_[op_type].push(op);
+  io_service_.work_started();
+}
+
+void epoll_reactor::cancel_ops(socket_type,
+    epoll_reactor::per_descriptor_data& descriptor_data)
+{
+  if (!descriptor_data)
+    return;
+
+  mutex::scoped_lock descriptor_lock(descriptor_data->mutex_);
+
+  op_queue<operation> ops;
+  for (int i = 0; i < max_ops; ++i)
+  {
+    while (reactor_op* op = descriptor_data->op_queue_[i].front())
+    {
+      op->ec_ = boost::asio::error::operation_aborted;
+      descriptor_data->op_queue_[i].pop();
+      ops.push(op);
+    }
+  }
+
+  descriptor_lock.unlock();
+
+  io_service_.post_deferred_completions(ops);
+}
+
+void epoll_reactor::deregister_descriptor(socket_type descriptor,
+    epoll_reactor::per_descriptor_data& descriptor_data, bool closing)
+{
+  if (!descriptor_data)
+    return;
+
+  mutex::scoped_lock descriptor_lock(descriptor_data->mutex_);
+
+  if (!descriptor_data->shutdown_)
+  {
+    if (closing)
+    {
+      // The descriptor will be automatically removed from the epoll set when
+      // it is closed.
+    }
+    else
+    {
+      epoll_event ev = { 0, { 0 } };
+      epoll_ctl(epoll_fd_, EPOLL_CTL_DEL, descriptor, &ev);
+    }
+
+    op_queue<operation> ops;
+    for (int i = 0; i < max_ops; ++i)
+    {
+      while (reactor_op* op = descriptor_data->op_queue_[i].front())
+      {
+        op->ec_ = boost::asio::error::operation_aborted;
+        descriptor_data->op_queue_[i].pop();
+        ops.push(op);
+      }
+    }
+
+    descriptor_data->descriptor_ = -1;
+    descriptor_data->shutdown_ = true;
+
+    descriptor_lock.unlock();
+
+    free_descriptor_state(descriptor_data);
+    descriptor_data = 0;
+
+    io_service_.post_deferred_completions(ops);
+  }
+}
+
+void epoll_reactor::deregister_internal_descriptor(socket_type descriptor,
+    epoll_reactor::per_descriptor_data& descriptor_data)
+{
+  if (!descriptor_data)
+    return;
+
+  mutex::scoped_lock descriptor_lock(descriptor_data->mutex_);
+
+  if (!descriptor_data->shutdown_)
+  {
+    epoll_event ev = { 0, { 0 } };
+    epoll_ctl(epoll_fd_, EPOLL_CTL_DEL, descriptor, &ev);
+
+    op_queue<operation> ops;
+    for (int i = 0; i < max_ops; ++i)
+      ops.push(descriptor_data->op_queue_[i]);
+
+    descriptor_data->descriptor_ = -1;
+    descriptor_data->shutdown_ = true;
+
+    descriptor_lock.unlock();
+
+    free_descriptor_state(descriptor_data);
+    descriptor_data = 0;
+  }
+}
+
+void epoll_reactor::run(bool block, op_queue<operation>& ops)
+{
+  // This code relies on the fact that the task_io_service queues the reactor
+  // task behind all descriptor operations generated by this function. This
+  // means, that by the time we reach this point, any previously returned
+  // descriptor operations have already been dequeued. Therefore it is now safe
+  // for us to reuse and return them for the task_io_service to queue again.
+
+  // Calculate a timeout only if timerfd is not used.
+  int timeout;
+  if (timer_fd_ != -1)
+    timeout = block ? -1 : 0;
+  else
+  {
+    mutex::scoped_lock lock(mutex_);
+    timeout = block ? get_timeout() : 0;
+  }
+
+  // Block on the epoll descriptor.
+  epoll_event events[128];
+  int num_events = epoll_wait(epoll_fd_, events, 128, timeout);
+
+#if defined(BOOST_ASIO_HAS_TIMERFD)
+  bool check_timers = (timer_fd_ == -1);
+#else // defined(BOOST_ASIO_HAS_TIMERFD)
+  bool check_timers = true;
+#endif // defined(BOOST_ASIO_HAS_TIMERFD)
+
+  // Dispatch the waiting events.
+  for (int i = 0; i < num_events; ++i)
+  {
+    void* ptr = events[i].data.ptr;
+    if (ptr == &interrupter_)
+    {
+      // No need to reset the interrupter since we're leaving the descriptor
+      // in a ready-to-read state and relying on edge-triggered notifications
+      // to make it so that we only get woken up when the descriptor's epoll
+      // registration is updated.
+
+#if defined(BOOST_ASIO_HAS_TIMERFD)
+      if (timer_fd_ == -1)
+        check_timers = true;
+#else // defined(BOOST_ASIO_HAS_TIMERFD)
+      check_timers = true;
+#endif // defined(BOOST_ASIO_HAS_TIMERFD)
+    }
+#if defined(BOOST_ASIO_HAS_TIMERFD)
+    else if (ptr == &timer_fd_)
+    {
+      check_timers = true;
+    }
+#endif // defined(BOOST_ASIO_HAS_TIMERFD)
+    else
+    {
+      // The descriptor operation doesn't count as work in and of itself, so we
+      // don't call work_started() here. This still allows the io_service to
+      // stop if the only remaining operations are descriptor operations.
+      descriptor_state* descriptor_data = static_cast<descriptor_state*>(ptr);
+      descriptor_data->set_ready_events(events[i].events);
+      ops.push(descriptor_data);
+    }
+  }
+
+  if (check_timers)
+  {
+    mutex::scoped_lock common_lock(mutex_);
+    timer_queues_.get_ready_timers(ops);
+
+#if defined(BOOST_ASIO_HAS_TIMERFD)
+    if (timer_fd_ != -1)
+    {
+      itimerspec new_timeout;
+      itimerspec old_timeout;
+      int flags = get_timeout(new_timeout);
+      timerfd_settime(timer_fd_, flags, &new_timeout, &old_timeout);
+    }
+#endif // defined(BOOST_ASIO_HAS_TIMERFD)
+  }
+}
+
+void epoll_reactor::interrupt()
+{
+  epoll_event ev = { 0, { 0 } };
+  ev.events = EPOLLIN | EPOLLERR | EPOLLET;
+  ev.data.ptr = &interrupter_;
+  epoll_ctl(epoll_fd_, EPOLL_CTL_MOD, interrupter_.read_descriptor(), &ev);
+}
+
+int epoll_reactor::do_epoll_create()
+{
+#if defined(EPOLL_CLOEXEC)
+  int fd = epoll_create1(EPOLL_CLOEXEC);
+#else // defined(EPOLL_CLOEXEC)
+  int fd = -1;
+  errno = EINVAL;
+#endif // defined(EPOLL_CLOEXEC)
+
+  if (fd == -1 && (errno == EINVAL || errno == ENOSYS))
+  {
+    fd = epoll_create(epoll_size);
+    if (fd != -1)
+      ::fcntl(fd, F_SETFD, FD_CLOEXEC);
+  }
+
+  if (fd == -1)
+  {
+    boost::system::error_code ec(errno,
+        boost::asio::error::get_system_category());
+    boost::asio::detail::throw_error(ec, "epoll");
+  }
+
+  return fd;
+}
+
+int epoll_reactor::do_timerfd_create()
+{
+#if defined(BOOST_ASIO_HAS_TIMERFD)
+# if defined(TFD_CLOEXEC)
+  int fd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC);
+# else // defined(TFD_CLOEXEC)
+  int fd = -1;
+  errno = EINVAL;
+# endif // defined(TFD_CLOEXEC)
+
+  if (fd == -1 && errno == EINVAL)
+  {
+    fd = timerfd_create(CLOCK_MONOTONIC, 0);
+    if (fd != -1)
+      ::fcntl(fd, F_SETFD, FD_CLOEXEC);
+  }
+
+  return fd;
+#else // defined(BOOST_ASIO_HAS_TIMERFD)
+  return -1;
+#endif // defined(BOOST_ASIO_HAS_TIMERFD)
+}
+
+epoll_reactor::descriptor_state* epoll_reactor::allocate_descriptor_state()
+{
+  mutex::scoped_lock descriptors_lock(registered_descriptors_mutex_);
+  return registered_descriptors_.alloc();
+}
+
+void epoll_reactor::free_descriptor_state(epoll_reactor::descriptor_state* s)
+{
+  mutex::scoped_lock descriptors_lock(registered_descriptors_mutex_);
+  registered_descriptors_.free(s);
+}
+
+void epoll_reactor::do_add_timer_queue(timer_queue_base& queue)
+{
+  mutex::scoped_lock lock(mutex_);
+  timer_queues_.insert(&queue);
+}
+
+void epoll_reactor::do_remove_timer_queue(timer_queue_base& queue)
+{
+  mutex::scoped_lock lock(mutex_);
+  timer_queues_.erase(&queue);
+}
+
+void epoll_reactor::update_timeout()
+{
+#if defined(BOOST_ASIO_HAS_TIMERFD)
+  if (timer_fd_ != -1)
+  {
+    itimerspec new_timeout;
+    itimerspec old_timeout;
+    int flags = get_timeout(new_timeout);
+    timerfd_settime(timer_fd_, flags, &new_timeout, &old_timeout);
+    return;
+  }
+#endif // defined(BOOST_ASIO_HAS_TIMERFD)
+  interrupt();
+}
+
+int epoll_reactor::get_timeout()
+{
+  // By default we will wait no longer than 5 minutes. This will ensure that
+  // any changes to the system clock are detected after no longer than this.
+  return timer_queues_.wait_duration_msec(5 * 60 * 1000);
+}
+
+#if defined(BOOST_ASIO_HAS_TIMERFD)
+int epoll_reactor::get_timeout(itimerspec& ts)
+{
+  ts.it_interval.tv_sec = 0;
+  ts.it_interval.tv_nsec = 0;
+
+  long usec = timer_queues_.wait_duration_usec(5 * 60 * 1000 * 1000);
+  ts.it_value.tv_sec = usec / 1000000;
+  ts.it_value.tv_nsec = usec ? (usec % 1000000) * 1000 : 1;
+
+  return usec ? 0 : TFD_TIMER_ABSTIME;
+}
+#endif // defined(BOOST_ASIO_HAS_TIMERFD)
+
+struct epoll_reactor::perform_io_cleanup_on_block_exit
+{
+  explicit perform_io_cleanup_on_block_exit(epoll_reactor* r)
+    : reactor_(r), first_op_(0)
+  {
+  }
+
+  ~perform_io_cleanup_on_block_exit()
+  {
+    if (first_op_)
+    {
+      // Post the remaining completed operations for invocation.
+      if (!ops_.empty())
+        reactor_->io_service_.post_deferred_completions(ops_);
+
+      // A user-initiated operation has completed, but there's no need to
+      // explicitly call work_finished() here. Instead, we'll take advantage of
+      // the fact that the task_io_service will call work_finished() once we
+      // return.
+    }
+    else
+    {
+      // No user-initiated operations have completed, so we need to compensate
+      // for the work_finished() call that the task_io_service will make once
+      // this operation returns.
+      reactor_->io_service_.work_started();
+    }
+  }
+
+  epoll_reactor* reactor_;
+  op_queue<operation> ops_;
+  operation* first_op_;
+};
+
+epoll_reactor::descriptor_state::descriptor_state()
+  : operation(&epoll_reactor::descriptor_state::do_complete)
+{
+}
+
+operation* epoll_reactor::descriptor_state::perform_io(uint32_t events)
+{
+  mutex_.lock();
+  perform_io_cleanup_on_block_exit io_cleanup(reactor_);
+  mutex::scoped_lock descriptor_lock(mutex_, mutex::scoped_lock::adopt_lock);
+
+  // Exception operations must be processed first to ensure that any
+  // out-of-band data is read before normal data.
+  static const int flag[max_ops] = { EPOLLIN, EPOLLOUT, EPOLLPRI };
+  for (int j = max_ops - 1; j >= 0; --j)
+  {
+    if (events & (flag[j] | EPOLLERR | EPOLLHUP))
+    {
+      while (reactor_op* op = op_queue_[j].front())
+      {
+        if (op->perform())
+        {
+          op_queue_[j].pop();
+          io_cleanup.ops_.push(op);
+        }
+        else
+          break;
+      }
+    }
+  }
+
+  // The first operation will be returned for completion now. The others will
+  // be posted for later by the io_cleanup object's destructor.
+  io_cleanup.first_op_ = io_cleanup.ops_.front();
+  io_cleanup.ops_.pop();
+  return io_cleanup.first_op_;
+}
+
+void epoll_reactor::descriptor_state::do_complete(
+    io_service_impl* owner, operation* base,
+    const boost::system::error_code& ec, std::size_t bytes_transferred)
+{
+  if (owner)
+  {
+    descriptor_state* descriptor_data = static_cast<descriptor_state*>(base);
+    uint32_t events = static_cast<uint32_t>(bytes_transferred);
+    if (operation* op = descriptor_data->perform_io(events))
+    {
+      op->complete(*owner, ec, 0);
+    }
+  }
+}
+
+} // namespace detail
+} // namespace asio
+} // namespace boost
+
+#include <boost/asio/detail/pop_options.hpp>
+
+#endif // defined(BOOST_ASIO_HAS_EPOLL)
+
+#endif // BOOST_ASIO_DETAIL_IMPL_EPOLL_REACTOR_IPP

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/Ceylon/Foo.ceylon

@@ -1,13 +1,13 @@
-doc "Test function for Ceylon"
-by  "Enrique"
+"Test function for Ceylon"
+by ("Enrique")
 shared void test() {
-  print("test");
+    print("test");
 }
 
-doc "Test class for Ceylon"
+"Test class for Ceylon"
 shared class Test(name) satisfies Comparable<Test> {
     shared String name;
-    shared actual String string = "Test " name ".";
+    shared actual String string = "Test ``name``.";
 
     shared actual Comparison compare(Test other) {
         return name<=>other.name;

samples/Chapel/distributions.chpl

@@ -0,0 +1,304 @@
+//
+// Distributions Primer
+//
+// This primer demonstrates uses of some of Chapel's standard
+// distributions.  To use these distributions in a Chapel program,
+// the respective module must be used:
+//
+use BlockDist, CyclicDist, BlockCycDist, ReplicatedDist;
+use DimensionalDist2D, ReplicatedDim, BlockCycDim;
+
+//
+// For each distribution, we'll create a distributed domain and array
+// and then initialize it just to give a brief flavor of how the
+// distribution maps across locales.  Running this example on 6
+// locales does a nice job of illustrating the distribution
+// characteristics.
+//
+// All of these distributions support options to map to a different
+// virtual locale grid than the one used by default (a
+// multidimensional factoring of the built-in Locales array), as well
+// as to control the amount of parallelism used in data parallel
+// loops.  See the Standard Distributions chapter of the language spec
+// for more details.
+//
+
+//
+// Make the program size configurable from the command line.
+//
+config const n = 8;
+
+//
+// Declare a 2-dimensional domain Space that we will later use to
+// initialize the distributed domains.
+//
+const Space = {1..n, 1..n};
+
+//
+// The Block distribution distributes a bounding box from
+// n-dimensional space across the target locale array viewed as an
+// n-dimensional virtual locale grid.  The bounding box is blocked
+// into roughly equal portions across the locales.  Note that domains
+// declared over a Block distribution can also store indices outside
+// of the bounding box; the bounding box is merely used to compute
+// the blocking of space.
+//
+// In this example, we declare a 2-dimensional Block-distributed
+// domain BlockSpace and a Block-distributed array BA declared over
+// the domain.
+//
+const BlockSpace = Space dmapped Block(boundingBox=Space);
+var BA: [BlockSpace] int;
+
+//
+// To illustrate how the index set is distributed across locales,
+// we'll use a forall loop to initialize each array element to the
+// locale ID that stores that index/element/iteration.
+//
+forall ba in BA do
+  ba = here.id;
+
+//
+// Output the Block-distributed array to visually see how the elements
+// are partitioned across the locales.
+//
+writeln("Block Array Index Map");
+writeln(BA);
+writeln();
+
+//
+// Most of Chapel's standard distributions support an optional
+// targetLocales argument that permits you to pass in your own
+// array of locales to be targeted.  In general, the targetLocales
+// argument should match the rank of the distribution.  So for
+// example, to map a Block to a [numLocales x 1] view of the
+// locale set, one could do something like this:
+
+//
+// We start by creating our own array of the locale values.  Here
+// we use the standard array reshape function for convenience,
+// but more generally, this array could be accessed/assigned like any
+// other.
+//
+
+var MyLocaleView = {0..#numLocales, 1..1};
+var MyLocales: [MyLocaleView] locale = reshape(Locales, MyLocaleView);
+
+//
+// Then we'll declare a distributed domain/array that targets
+// this view of the locales:
+// 
+
+const BlockSpace2 = Space dmapped Block(boundingBox=Space,
+                                        targetLocales=MyLocales);
+var BA2: [BlockSpace2] int;
+
+//
+// Then we'll do a similar computation as before to verify where
+// everything ended up:
+//
+forall ba in BA2 do
+  ba = here.id;
+
+writeln("Block Array Index Map");
+writeln(BA2);
+writeln();
+
+
+
+//
+// Next, we'll perform a similar computation for the Cyclic distribution.
+// Cyclic distributions start at a designated n-dimensional index and
+// distribute the n-dimensional space across an n-dimensional array
+// of locales in a round-robin fashion (in each dimension).  As with
+// the Block distribution, domains may be declared using the
+// distribution who have lower indices that the starting index; that
+// value should just be considered a parameterization of how the
+// distribution is defined.
+//
+const CyclicSpace = Space dmapped Cyclic(startIdx=Space.low);
+var CA: [CyclicSpace] int;
+
+forall ca in CA do
+  ca = here.id;
+
+writeln("Cyclic Array Index Map");
+writeln(CA);
+writeln();
+
+
+//
+// Next, we'll declare a Block-Cyclic distribution.  These
+// distributions also deal out indices in a round-robin fashion,
+// but rather than dealing out singleton indices, they deal out blocks
+// of indices.  Thus, the BlockCyclic distribution is parameterized
+// by a starting index (as with Cyclic) and a block size (per
+// dimension) specifying how large the chunks to be dealt out are.
+// 
+const BlkCycSpace = Space dmapped BlockCyclic(startIdx=Space.low, 
+                                              blocksize=(2, 3));
+var BCA: [BlkCycSpace] int;
+
+forall bca in BCA do
+  bca = here.id;
+
+writeln("Block-Cyclic Array Index Map");
+writeln(BCA);
+writeln();
+
+
+//
+// The ReplicatedDist distribution is different: each of the
+// original domain's indices - and the corresponding array elements -
+// is replicated onto each locale. (Note: consistency among these
+// array replicands is NOT maintained automatically.)
+//
+// This replication is observable in some cases but not others,
+// as shown below. Note: this behavior may change in the future.
+//
+const ReplicatedSpace = Space dmapped ReplicatedDist();
+var RA: [ReplicatedSpace] int;
+
+// The replication is observable - this visits each replicand.
+forall ra in RA do
+  ra = here.id;
+
+writeln("Replicated Array Index Map, ", RA.numElements, " elements total");
+writeln(RA);
+writeln();
+
+//
+// The replication is observable when the replicated array is
+// on the left-hand side. If the right-hand side is not replicated,
+// it is copied into each replicand.
+// We illustrate this using a non-distributed array.
+//
+var A: [Space] int = [(i,j) in Space] i*100 + j;
+RA = A;
+writeln("Replicated Array after being array-assigned into");
+writeln(RA);
+writeln();
+
+//
+// Analogously, each replicand will be visited and
+// other participated expressions will be computed on each locale
+// (a) when the replicated array is assigned a scalar:
+//       RA = 5;
+// (b) when it appears first in a zippered forall loop:
+//       forall (ra, a) in zip(RA, A) do ...;
+// (c) when it appears in a for loop:
+//       for ra in RA do ...;
+//
+// Zippering (RA,A) or (A,RA) in a 'for' loop will generate
+// an error due to their different number of elements.
+
+// Let RA store the Index Map again, for the examples below.
+forall ra in RA do
+  ra = here.id;
+
+//
+// Only the local replicand is accessed - replication is NOT observable
+// and consistency is NOT maintained - when:
+// (a) the replicated array is indexed - an individual element is read...
+//
+on Locales(0) do
+  writeln("on ", here, ": ", RA(Space.low));
+on Locales(LocaleSpace.high) do
+  writeln("on ", here, ": ", RA(Space.low));
+writeln();
+
+// ...or an individual element is written;
+on Locales(LocaleSpace.high) do
+  RA(Space.low) = 7777;
+
+writeln("Replicated Array after being indexed into");
+writeln(RA);
+writeln();
+
+//
+// (b) the replicated array is on the right-hand side of an assignment...
+//
+on Locales(LocaleSpace.high) do
+  A = RA + 4;
+writeln("Non-Replicated Array after assignment from Replicated Array + 4");
+writeln(A);
+writeln();
+
+//
+// (c) ...or, generally, the replicated array or domain participates
+//     in a zippered forall loop, but not in the first position.
+//     The loop could look like:
+//
+//       forall (a, (i,j), ra) in (A, ReplicatedSpace, RA) do ...;
+//
+
+
+//
+// The DimensionalDist2D distribution lets us build a 2D distribution
+// as a composition of specifiers for individual dimensions.
+// Under such a "dimensional" distribution each dimension is handled
+// independently of the other.
+//
+// The dimension specifiers are similar to the corresponding multi-dimensional
+// distributions in constructor arguments and index-to-locale mapping rules.
+// However, instead of an array of locales, a specifier constructor
+// accepts just the number of locales that the indices in the corresponding
+// dimension will be distributed across.
+//
+// The DimensionalDist2D constructor requires:
+// * an [0..nl1-1, 0..nl2-1] array of locales, where
+//   nl1 and nl2 are the number of locales in each dimension, and
+// * two dimension specifiers, created for nl1 and nl2 locale counts, resp.
+//
+// Presently, the following dimension specifiers are available
+// (shown here with their constructor arguments):
+//
+// * ReplicatedDim(numLocales)
+// * BlockDim(numLocales, boundingBoxLow, boundingBoxHigh)
+// * BlockCyclicDim(lowIdx, blockSize, numLocales)
+//
+
+//
+// The following example creates a dimensional distribution that
+// replicates over 2 locales (when available) in the first dimemsion
+// and distributes using block-cyclic distribution in the second dimension.
+// The example computes nl1 and nl2 and reshapes MyLocales correspondingly.
+//
+
+var (nl1, nl2) = if numLocales == 1 then (1, 1) else (2, numLocales/2);
+MyLocaleView = {0..#nl1, 0..#nl2};
+MyLocales = reshape(Locales[0..#nl1*nl2], MyLocaleView);
+
+const DimReplicatedBlockcyclicSpace = Space
+  dmapped DimensionalDist2D(MyLocales,
+                            new ReplicatedDim(numLocales = nl1),
+                            new BlockCyclicDim(numLocales = nl2,
+                                               lowIdx = 1, blockSize = 2));
+
+var DRBA: [DimReplicatedBlockcyclicSpace] int;
+
+// The ReplicatedDim specifier always accesses the local replicand.
+// (This differs from how the ReplicatedDist distribution works.)
+//
+// This example visits each replicand. The behavior is the same
+// regardless of the second index into MyLocales below.
+
+for locId1 in 0..#nl1 do on MyLocales[locId1, 0] {
+
+  forall drba in DRBA do
+    drba = here.id;
+
+  writeln("Dimensional2D(Replicated,BlockCyclic) Array Index Map",
+          " from ", here);
+
+  // Technicality: 'writeln(DRBA)' would read DRBA always on Locale 0.
+  // Since we want to see what DRBA contains on the current locale,
+  // we use 'Helper' that is mapped using the default distribution.
+  // 'Helper = DRBA' captures the view of DRBA on the current locale,
+  // which we then print out.
+
+  const Helper: [Space] int = DRBA;
+  writeln(Helper);
+  writeln();
+
+}

samples/Chapel/hello.chpl

@@ -0,0 +1 @@
+writeln("Hello, world!");    // print 'Hello, world!' to the console

samples/Chapel/nbody.chpl

@@ -0,0 +1,147 @@
+/* The Computer Language Benchmarks Game
+   http://benchmarksgame.alioth.debian.org/
+
+   contributed by Albert Sidelnik
+   modified by Brad Chamberlain
+*/
+
+
+//
+// The number of timesteps to simulate; may be set via the command-line
+//
+config const n = 10000;
+
+//
+// Constants representing pi, the solar mass, and the number of days per year
+//
+const pi = 3.141592653589793,
+      solarMass = 4 * pi**2,
+      daysPerYear = 365.24;
+
+//
+// a record representing one of the bodies in the solar system
+//
+record body {
+  var pos: 3*real;
+  var v: 3*real;
+  var mass: real;  // does not change after it is set up
+}
+
+//
+// the array of bodies that we'll be simulating
+//
+var bodies = [/* sun */
+              new body(mass = solarMass),
+
+              /* jupiter */
+              new body(pos = ( 4.84143144246472090e+00,
+                              -1.16032004402742839e+00,
+                              -1.03622044471123109e-01),
+                         v = ( 1.66007664274403694e-03 * daysPerYear,
+                               7.69901118419740425e-03 * daysPerYear,
+                              -6.90460016972063023e-05 * daysPerYear),
+                      mass =   9.54791938424326609e-04 * solarMass),
+  
+              /* saturn */
+              new body(pos = ( 8.34336671824457987e+00,
+                               4.12479856412430479e+00,
+                              -4.03523417114321381e-01),
+                         v = (-2.76742510726862411e-03 * daysPerYear,
+                               4.99852801234917238e-03 * daysPerYear,
+                               2.30417297573763929e-05 * daysPerYear),
+                      mass =   2.85885980666130812e-04 * solarMass),
+
+              /* uranus */
+              new body(pos = ( 1.28943695621391310e+01,
+                              -1.51111514016986312e+01,
+                              -2.23307578892655734e-01),
+                         v = ( 2.96460137564761618e-03 * daysPerYear,
+                               2.37847173959480950e-03 * daysPerYear,
+                              -2.96589568540237556e-05 * daysPerYear),
+                      mass =   4.36624404335156298e-05 * solarMass),
+
+              /* neptune */
+              new body(pos = ( 1.53796971148509165e+01,
+                              -2.59193146099879641e+01,
+                               1.79258772950371181e-01),
+                         v = ( 2.68067772490389322e-03 * daysPerYear,
+                               1.62824170038242295e-03 * daysPerYear,
+                              -9.51592254519715870e-05 * daysPerYear),
+                      mass =   5.15138902046611451e-05 * solarMass)
+              ];
+
+//
+// the number of bodies to be simulated
+//
+const numbodies = bodies.numElements;
+
+//
+// The computation involves initializing the sun's velocity,
+// writing the initial energy, advancing the system through 'n'
+// timesteps, and writing the final energy.
+//
+proc main() {
+  initSun();
+
+  writef("%.9r\n", energy());
+  for 1..n do
+    advance(0.01);
+  writef("%.9r\n", energy());
+}
+
+//
+// compute the sun's initial velocity
+//
+proc initSun() {
+  const p = + reduce (for b in bodies do (b.v * b.mass));
+  bodies[1].v = -p / solarMass;
+}
+
+//
+// advance the positions and velocities of all the bodies
+//
+proc advance(dt) {
+  for i in 1..numbodies {
+    for j in i+1..numbodies {
+      updateVelocities(bodies[i], bodies[j]);
+      
+      inline proc updateVelocities(ref b1, ref b2) {
+        const dpos = b1.pos - b2.pos,
+               mag = dt / sqrt(sumOfSquares(dpos))**3;
+        
+        b1.v -= dpos * b2.mass * mag;
+        b2.v += dpos * b1.mass * mag;
+      }
+    }
+  }
+  
+  for b in bodies do
+    b.pos += dt * b.v;
+}
+
+//
+// compute the energy of the bodies
+//
+proc energy() {
+  var e = 0.0;
+  
+  for i in 1..numbodies {
+    const b1 = bodies[i];
+    
+    e += 0.5 * b1.mass * sumOfSquares(b1.v);
+    
+    for j in i+1..numbodies {
+      const b2 = bodies[j];
+      
+      e -= (b1.mass * b2.mass) / sqrt(sumOfSquares(b1.pos - b2.pos));
+    }
+  }
+  
+  return e;
+}
+
+//
+// a helper routine to compute the sum of squares of a 3-tuple's components
+//
+inline proc sumOfSquares(x)
+  return x(1)**2 + x(2)**2 + x(3)**2;

samples/Chapel/quicksort.chpl

@@ -0,0 +1,145 @@
+//
+// An example of a parallel quick sort implementation that uses
+// "cobegin" to make each recursive call in parallel and "serial" to
+// limit the number of threads.
+//
+
+use Random, Time; // for random number generation and the Timer class
+
+var timer: Timer; // to time the sort
+
+config var n: int = 2**15;      // the size of the array to be sorted
+config var thresh: int = 1;     // the recursive depth to serialize
+config var verbose: int = 0;    // print out this many elements in array
+config var timing: bool = true; // set timing to false to disable timer
+
+var A: [1..n] real; // array of real numbers
+
+//
+// initialize array with random numbers
+//
+fillRandom(A);
+
+//
+// print out front of array if verbose flag is set
+//
+if verbose > 0 then
+  writeln("A[1..", verbose, "] = ", A[1..verbose]);
+
+//
+// start timer, call parallel quick sort routine, stop timer
+//
+if timing then timer.start();
+pqsort(A, thresh);
+if timing then timer.stop();
+
+//
+// report sort time
+//
+if timing then writeln("sorted in ", timer.elapsed(), " seconds");
+
+//
+// print out front of array if verbose flag is set
+//   values should now be in sorted order
+//
+if verbose > 0 then
+  writeln("A[1..", verbose, "] = ", A[1..verbose]);
+
+//
+// verify that array is sorted or halt
+//
+for i in 2..n do
+  if A(i) < A(i-1) then
+    halt("A(", i-1, ") == ", A(i-1), " > A(", i, ") == ", A(i));
+
+writeln("verification success");
+
+//
+// pqsort -- parallel quick sort
+//
+//   arr: generic 1D array of values (real, int, ...)
+//   thresh: number of recursive calls to make before serializing
+//   low: lower bound of array to start sort at, defaults to whole array
+//   high: upper bound of array to stop sort at, defaults to whole array
+//
+proc pqsort(arr: [],
+           thresh: int,
+           low: int = arr.domain.low,
+           high: int = arr.domain.high) where arr.rank == 1 {
+
+  //
+  // base case: arr[low..high] is small enough to bubble sort
+  //
+  if high - low < 8 {
+    bubbleSort(arr, low, high);
+    return;
+  }
+
+  //
+  // determine pivot and partition arr[low..high]
+  //
+  const pivotVal = findPivot();
+  const pivotLoc = partition(pivotVal);
+
+  //
+  // make recursive calls to parallel quick sort each unsorted half of
+  // the array; if thresh is 0 or less, start executing conquer tasks
+  // serially
+  //
+  serial thresh <= 0 do cobegin {
+    pqsort(arr, thresh-1, low, pivotLoc-1);
+    pqsort(arr, thresh-1, pivotLoc+1, high);
+  }
+
+  //
+  // findPivot -- helper routine to find pivot value using simple
+  //              median-of-3 method, returns pivot value
+  //
+  proc findPivot() {
+    const mid = low + (high-low+1) / 2;
+
+    if arr(mid) < arr(low) then arr(mid) <=> arr(low);
+    if arr(high) < arr(low) then arr(high) <=> arr(low);
+    if arr(high) < arr(mid) then arr(high) <=> arr(mid);
+
+    const pivotVal = arr(mid);
+    arr(mid) = arr(high-1);
+    arr(high-1) = pivotVal;
+
+    return pivotVal;
+  }
+
+  //
+  // partition -- helper routine to partition array such that all
+  //              values less than pivot are to its left and all
+  //              values greater than pivot are to its right, returns
+  //              pivot location
+  //
+  proc partition(pivotVal) {
+    var ilo = low, ihi = high-1;
+    while (ilo < ihi) {
+      do { ilo += 1; } while arr(ilo) < pivotVal;
+      do { ihi -= 1; } while pivotVal < arr(ihi);
+      if (ilo < ihi) {
+        arr(ilo) <=> arr(ihi);
+      }
+    }
+    arr(high-1) = arr(ilo);
+    arr(ilo) = pivotVal;
+    return ilo;
+  }
+}
+
+//
+// bubbleSort -- bubble sort for base case of quick sort
+//
+//   arr: generic 1D array of values (real, int, ...)
+//   low: lower bound of array to start sort at
+//   high: upper bound of array to stop sort at
+//
+proc bubbleSort(arr: [], low: int, high: int) where arr.rank == 1 {
+  for i in low..high do
+    for j in low..high-1 do
+      if arr(j) > arr(j+1) then
+        arr(j) <=> arr(j+1);
+}

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/Clean/GenHylo.dcl

@@ -0,0 +1,11 @@
+definition module GenHylo
+
+import StdGeneric, GenMap
+
+:: Fix f = In (f .(Fix f))
+Out :: !u:(Fix v:a) -> v:(a w:(Fix v:a)), [u <= w]
+
+hylo :: ((.f .b) -> .b) (.a -> (.f .a)) -> (.a -> .b) | gMap{|*->*|} f
+cata :: (u:(f .a) -> .a) -> (Fix u:f) -> .a | gMap{|*->*|} f
+ana :: (.a -> u:(f .a)) -> .a -> (Fix u:f) | gMap{|*->*|} f
+

samples/Clean/GenMap.dcl

@@ -0,0 +1,9 @@
+definition module GenMap
+
+import StdGeneric
+
+generic gMap a b :: .a -> .b
+derive gMap c, UNIT, PAIR, EITHER, CONS, FIELD, OBJECT, {}, {!} 
+
+derive gMap [], (,), (,,),  (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
+

samples/Clean/GenMap.icl

@@ -0,0 +1,19 @@
+implementation module GenMap
+
+import StdClass, StdArray, StdInt, StdFunc
+import StdGeneric, _Array
+
+generic gMap a b :: .a -> .b
+gMap{|c|} x 					= x
+gMap{|UNIT|} x 					= x
+gMap{|PAIR|} fx fy (PAIR x y) 	= PAIR (fx x) (fy y) 
+gMap{|EITHER|} fl fr (LEFT x) 	= LEFT (fl x)
+gMap{|EITHER|} fl fr (RIGHT x) 	= RIGHT (fr x)
+gMap{|CONS|} f (CONS x) 		= CONS (f x)
+gMap{|FIELD|} f (FIELD x) 		= FIELD (f x)
+gMap{|OBJECT|} f (OBJECT x) 	= OBJECT (f x)
+gMap{|{}|} f xs 				= mapArray f xs
+gMap{|{!}|} f xs				= mapArray f xs
+
+derive gMap [], (,), (,,),  (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
+

samples/Clean/fsieve.icl

@@ -0,0 +1,54 @@
+module fsieve
+
+/*
+The Fast Sieve of Eratosthenes.
+
+A sequential and optimized version of the sieve of Eratosthenes.
+The program calculates a list of the first NrOfPrime primes.
+The result of the program is the NrOfPrimes'th prime.
+
+Strictness annotations have been added because the strictness analyser
+is not able to deduce all strictness information. Removal of these !'s
+will make the program about 20% slower.
+
+On a machine without a math coprocessor the execution of this
+program might take a (very) long time. Set NrOfPrimes to a smaller value.
+*/
+
+import StdClass; // RWS
+import StdInt, StdReal
+     
+NrOfPrimes :== 3000 
+	
+//	The sieve algorithm: generate an infinite list of all primes.
+
+Primes::[Int]
+Primes = pr where pr = [5 : Sieve 7 4 pr]
+
+Sieve::Int !Int [Int] -> [Int]
+Sieve g i prs
+	| IsPrime prs g (toInt (sqrt (toReal g)))	=  [g : Sieve` g i prs]
+												=  Sieve (g + i) (6 - i) prs
+
+Sieve`::Int Int [Int] -> [Int]
+Sieve` g i prs =  Sieve (g + i) (6 - i) prs
+
+IsPrime::[Int] !Int Int -> Bool
+IsPrime [f:r] pr bd | f>bd 			=  True
+					| pr rem f==0	=  False
+									=  IsPrime r pr bd
+								  
+//	Select is used to get the NrOfPrimes'th prime from the infinite list.
+
+Select::[x] Int -> x
+Select [f:r] 1 =  f
+Select [f:r] n =  Select r (n - 1)
+
+
+/*	The Start rule: Select the NrOfPrimes'th prime from the list of primes
+	generated by Primes.
+*/
+
+Start::Int
+Start = Select [2, 3 : Primes] NrOfPrimes
+

samples/Clean/sem.icl

@@ -0,0 +1,99 @@
+module monadicSemantics
+
+import StdEnv, StdGeneric, GenMap, GenHylo
+
+/* For fun I implemented the recursive datastructre Exp and Stm as fixpoints
+   This helps us define recursive functions on them (only a little bit though)
+   However deriving gMap for Fix did not works out of the box
+   I had to remove some uniqueness typing in GenMap and GenHylo */
+:: Op      = Plus | Minus | Times | Rem | Equal | LessThan
+:: Var     :== String
+
+:: ExpP a  = Int Int | Var Var | Op Op a a
+:: Exp     :== Fix ExpP
+
+:: StmP a  = Assign Var Exp | If Exp a a | While Exp a | Seq a a | Cont
+:: Stm     :== Fix StmP
+
+derive gMap ExpP, StmP, Fix
+
+// Environment. Semantics is basically Env -> Env
+:: Env :== Var -> Int
+:: Sem :== Env -> (Int, Env)
+empty = \v . 0
+
+// return
+rtn :: Int -> Sem
+rtn i = \e. (i, e)
+
+// the usual bind
+(>>=) infixl 1 :: Sem (Int->Sem) -> Sem
+(>>=) x y = \e. (\(i,e2).y i e2) (x e)
+(>>|) infixl 1 :: Sem Sem -> Sem
+(>>|) x y = x >>= \_. y
+
+// read variable from environment
+read :: Var -> Sem
+read v = \e. (e v, e)
+
+// assign value to give variable in environment
+write :: Var Int -> Sem
+write v i = \e. (i, \w. if (w==v) i (e w))
+
+// semantics
+class sem a :: a -> Sem
+
+operator :: Op -> Int -> Int -> Int
+operator Plus     = (+)
+operator Minus    = (-)
+operator Times    = (*)
+operator Rem      = rem
+operator Equal    = \x y . if (x==y) 1 0
+operator LessThan = \x y . if (x< y)  1 0
+
+// semantics of expressions
+instance sem Exp where
+	sem x = cata phi x where
+		phi (Int n)     = rtn n
+		phi (Var v)     = read v
+		phi (Op op x y) = x >>= \v1. y >>= return o (operator op v1)
+
+// semantics of statments
+// NOTE: while will always return 0, as it might not even be executed
+instance sem Stm where
+	sem x = cata phi x where
+		phi (Assign v e)     = sem e >>= write v
+		phi (If e s1 s2)     = sem e >>= \b . if (b<>0) s1 s2
+		phi stm=:(While e s) = sem e >>= \b . if (b<>0) (s >>| phi stm) (phi Cont)
+		phi (Seq s1 s2)      = s1 >>| s2    // Here the cata *finally* pays off :D
+		phi Cont             = rtn 0
+
+// convenience functions
+int    = In o Int
+var    = In o Var
+op o   = In o2 (Op o)
+assign = In o2 Assign
+ifte e = In o2 (If e)
+while  = In o2 While
+seq    = In o2 Seq
+cont   = In Cont
+
+// test case, also testing the new operator <
+pEuclides =
+	while (op LessThan (int 0) (var "b"))(
+		seq (assign "r" (op Rem (var "a") (var "b")))
+		(seq (assign "a" (var "b"))
+		( (assign "b" (var "r")))
+		)
+	)
+
+Start = fst (program start) where
+	program = sem pEuclides >>| read "a"
+	start "a" = 9
+	start "b" = 12
+	start _ = 0
+
+// Helper
+(o2) infixr 9
+(o2) f g x :== f o (g x)
+

samples/Clean/stack.dcl

@@ -0,0 +1,14 @@
+definition module stack
+
+:: Stack a
+
+newStack :: (Stack a)
+push :: a (Stack a) -> Stack a
+pushes :: [a] (Stack a) -> Stack a
+pop :: (Stack a) -> Stack a
+popn :: Int (Stack a) -> Stack a
+top :: (Stack a) -> a
+topn :: Int (Stack a) -> [a]
+elements :: (Stack a) -> [a]
+count :: (Stack a) -> Int
+

samples/Clean/stack.icl

@@ -0,0 +1,33 @@
+implementation module stack
+import StdEnv
+
+:: Stack a :== [a]
+
+newStack :: (Stack a)
+newStack = []
+
+push :: a (Stack a) -> Stack a
+push x s = [x:s]
+
+pushes :: [a] (Stack a) -> Stack a
+pushes x s = x ++ s
+
+pop :: (Stack a) -> Stack a
+pop [] = abort "Cannot use pop on an empty stack"
+pop [e:s] = s
+
+popn :: Int (Stack a) -> Stack a
+popn n s  = drop n s
+
+top :: (Stack a) -> a
+top [] = abort "Cannot use top on an empty stack"
+top [e:s] = e
+
+topn :: Int (Stack a) -> [a]
+topn n s = take n s
+elements :: (Stack a) -> [a]
+elements s = s
+
+count :: (Stack a) -> Int
+count s = length s
+

samples/Clean/streams.dcl

@@ -0,0 +1,16 @@
+definition module streams
+
+import StdEnv
+
+instance zero [Real]
+instance one [Real]
+instance + [Real]        
+instance - [Real]
+instance * [Real]
+instance / [Real]
+
+X :: [Real]
+invert :: [Real] -> [Real]
+pow :: [Real] Int -> [Real]
+(shuffle) infixl 7 :: [Real] [Real] -> [Real]
+

samples/Clean/streams.icl

@@ -0,0 +1,49 @@
+implementation module streams
+
+import StdEnv
+
+instance zero [Real]
+where
+        zero = [] //Infinite row of zeroes represented as empty list to ease computation
+
+instance one [Real]
+where
+        one = [1.0:zero]
+
+instance + [Real]
+where
+        (+) [s:s`] [t:t`] = [s+t:s`+t`]
+        (+) [s:s`] [] = [s:s`]
+        (+) [] [t:t`] = [t:t`]
+        (+) [] [] = []
+        
+instance - [Real]
+where
+        (-) [s:s`] [t:t`] = [s-t:s`-t`]
+        (-) [s:s`] [] = [s:s`]
+        (-) [] [t:t`] = [-1.0] * [t:t`]
+        (-) [] [] = []
+
+instance * [Real]
+where
+        (*) [s:s`] [t:t`] = [s*t:s`*[t:t`]+[s]*t`]
+        (*) _ _ = []
+
+instance / [Real]
+where
+        (/) s t = s * (invert t)
+
+X :: [Real]
+X = [0.0:one]
+
+invert :: [Real] -> [Real]
+invert [s:s`] = [1.0/s:(invert [s:s`]) * s` * [-1.0/s]]
+
+pow :: [Real] Int -> [Real]
+pow s 0 = one
+pow s n = s * pow s (n-1)
+
+(shuffle) infixl 7 :: [Real] [Real] -> [Real]
+(shuffle) [s:s`] [t:t`] = [s*t:s` shuffle [t:t`] + [s:s`] shuffle t`]
+(shuffle) _ _ = []
+

samples/Clojure/index.cljs.hl

@@ -0,0 +1,146 @@
+;; Copyright (c) Alan Dipert and Micha Niskin. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
+(page "index.html"
+  (:refer-clojure :exclude [nth])
+  (:require
+   [tailrecursion.hoplon.reload        :refer [reload-all]]
+   [tailrecursion.hoplon.util          :refer [nth name pluralize]]
+   [tailrecursion.hoplon.storage-atom  :refer [local-storage]]))
+
+;; utility functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare route state editing)
+
+(reload-all)
+
+(def mapvi  (comp vec map-indexed))
+
+(defn dissocv [v i]
+  (let [z (- (dec (count v)) i)]
+    (cond (neg?  z) v
+          (zero? z) (pop v)
+          (pos?  z) (into (subvec v 0 i) (subvec v (inc i))))))
+
+(defn decorate [todo route editing i]
+  (let [{done? :completed text :text} todo]
+    (-> todo (assoc :editing (= editing i)
+                    :visible (and (not (empty? text))
+                                  (or (= "#/" route)
+                                      (and (= "#/active" route) (not done?))
+                                      (and (= "#/completed" route) done?)))))))
+
+;; persisted state cell (AKA: stem cell) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def   state        (-> (cell []) (local-storage ::store)))
+
+;; local state cells ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defc  loaded?      false)
+(defc  editing      nil)
+(def   route        (route-cell "#/"))
+
+;; formula cells (computed state) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defc= completed    (filter :completed state))
+(defc= active       (remove :completed state))
+(defc= plural-item  (pluralize "item" (count active)))
+(defc= todos        (mapvi #(list %1 (decorate %2 route editing %1)) state))
+
+;; state transition functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn  todo        [t]   {:completed false :text t})
+(defn  destroy!    [i]   (swap! state dissocv i))
+(defn  done!       [i v] (swap! state assoc-in [i :completed] v))
+(defn  clear-done! [& _] (swap! state #(vec (remove :completed %))))
+(defn  new!        [t]   (when (not (empty? t)) (swap! state conj (todo t))))
+(defn  all-done!   [v]   (swap! state #(mapv (fn [x] (assoc x :completed v)) %)))
+(defn  editing!    [i v] (reset! editing (if v i nil)))
+(defn  text!       [i v] (if (empty? v) (destroy! i) (swap! state assoc-in [i :text] v)))
+
+;; page ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(html :lang "en"
+  (head
+    (meta :charset "utf-8")
+    (meta :http-equiv "X-UA-Compatible" :content "IE=edge,chrome=1")
+    (link :rel "stylesheet" :href "base.css")
+    (title "Hoplon • TodoMVC"))
+  (body
+    (noscript
+      (div :id "noscript"
+        (p "JavaScript is required to view this page.")))
+    (div
+      (section :id "todoapp"
+        (header :id "header"
+          (h1 "todos")
+          (form :on-submit #(do (new! (val-id :new-todo))
+                                (do! (by-id :new-todo) :value ""))
+            (input
+              :id "new-todo"
+              :type "text"
+              :autofocus true
+              :placeholder "What needs to be done?"
+              :on-blur #(do! (by-id :new-todo) :value ""))))
+        (section
+          :id "main"
+          :do-toggle (cell= (not (and (empty? active) (empty? completed))))
+          (input
+            :id "toggle-all"
+            :type "checkbox"
+            :do-attr (cell= {:checked (empty? active)}) 
+            :on-click #(all-done! (val-id :toggle-all)))
+          (label :for "toggle-all"
+            "Mark all as complete")
+          (ul :id "todo-list"
+            (loop-tpl
+              :reverse true
+              :bind-ids [done# edit#]
+              :bindings [[i {edit? :editing done? :completed todo-text :text show? :visible}] todos] 
+              (li
+                :do-class (cell= {:completed done? :editing edit?}) 
+                :do-toggle show?
+                (div :class "view" :on-dblclick #(editing! @i true)
+                  (input
+                    :id done# 
+                    :type "checkbox"
+                    :class "toggle"
+                    :do-attr (cell= {:checked done?}) 
+                    :on-click #(done! @i (val-id done#)))
+                  (label (text "~{todo-text}"))
+                  (button
+                    :type "submit"
+                    :class "destroy"
+                    :on-click  #(destroy! @i)))
+                (form :on-submit #(editing! @i false)
+                  (input
+                    :id edit#
+                    :type "text"
+                    :class "edit"
+                    :do-value todo-text
+                    :do-focus edit?
+                    :on-blur #(when @edit? (editing! @i false))
+                    :on-change #(when @edit? (text! @i (val-id edit#)))))))))
+        (footer 
+          :id "footer"
+          :do-toggle (cell= (not (and (empty? active) (empty? completed))))
+          (span :id "todo-count"
+            (strong (text "~(count active) "))
+            (span (text "~{plural-item} left")))
+          (ul :id "filters"
+            (li (a :href "#/"          :do-class (cell= {:selected (= "#/" route)})          "All"))
+            (li (a :href "#/active"    :do-class (cell= {:selected (= "#/active" route)})    "Active"))
+            (li (a :href "#/completed" :do-class (cell= {:selected (= "#/completed" route)}) "Completed")))
+          (button
+            :type      "submit"
+            :id        "clear-completed"
+            :on-click  #(clear-done!)
+            (text "Clear completed (~(count completed))"))))
+      (footer :id "info" 
+        (p "Double-click to edit a todo")
+        (p "Part of " (a :href "http://github.com/tailrecursion/hoplon-demos/" "hoplon-demos")))))) 

samples/ColdFusion CFC/exampleScript.cfc

@@ -0,0 +1,239 @@
+/**
+********************************************************************************
+ContentBox - A Modular Content Platform
+Copyright 2012 by Luis Majano and Ortus Solutions, Corp
+www.gocontentbox.org | www.luismajano.com | www.ortussolutions.com
+********************************************************************************
+Apache License, Version 2.0
+
+Copyright Since [2012] [Luis Majano and Ortus Solutions,Corp]
+
+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.
+********************************************************************************
+* A generic content service for content objects
+*/
+component extends="coldbox.system.orm.hibernate.VirtualEntityService" singleton{
+
+	// DI
+	property name="settingService"			inject="id:settingService@cb";
+	property name="cacheBox"				inject="cachebox";
+	property name="log"						inject="logbox:logger:{this}";
+	property name="customFieldService" 	 	inject="customFieldService@cb";
+	property name="categoryService" 	 	inject="categoryService@cb";
+	property name="commentService" 	 		inject="commentService@cb";
+	property name="contentVersionService"	inject="contentVersionService@cb";
+	property name="authorService"			inject="authorService@cb";
+	property name="populator"				inject="wirebox:populator";
+	property name="systemUtil"				inject="SystemUtil@cb";
+	
+	/*
+	* Constructor
+	* @entityName.hint The content entity name to bind this service to.
+	*/
+	ContentService function init(entityName="cbContent"){
+		// init it
+		super.init(entityName=arguments.entityName, useQueryCaching=true);
+
+		// Test scope coloring in pygments
+		this.colorTestVar = "Just for testing pygments!";
+		cookie.colorTestVar = "";
+		client.colorTestVar = ""
+		session.colorTestVar = "";
+		application.colorTestVar = "";
+
+		return this;
+	}
+
+	/**
+	* Clear all content caches
+	* @async.hint Run it asynchronously or not, defaults to false
+	*/
+	function clearAllCaches(boolean async=false){
+		var settings = settingService.getAllSettings(asStruct=true);
+		// Get appropriate cache provider
+		var cache = cacheBox.getCache( settings.cb_content_cacheName );
+		cache.clearByKeySnippet(keySnippet="cb-content",async=arguments.async);
+		return this;
+	}
+
+	/**
+	* Clear all page wrapper caches
+	* @async.hint Run it asynchronously or not, defaults to false
+	*/
+	function clearAllPageWrapperCaches(boolean async=false){
+		var settings = settingService.getAllSettings(asStruct=true);
+		// Get appropriate cache provider
+		var cache = cacheBox.getCache( settings.cb_content_cacheName );
+		cache.clearByKeySnippet(keySnippet="cb-content-pagewrapper",async=arguments.async);
+		return this;
+	}
+
+	/**
+	* Clear all page wrapper caches
+	* @slug.hint The slug partial to clean on
+	* @async.hint Run it asynchronously or not, defaults to false
+	*/
+	function clearPageWrapperCaches(required any slug, boolean async=false){
+		var settings = settingService.getAllSettings(asStruct=true);
+		// Get appropriate cache provider
+		var cache = cacheBox.getCache( settings.cb_content_cacheName );
+		cache.clearByKeySnippet(keySnippet="cb-content-pagewrapper-#arguments.slug#",async=arguments.async);
+		return this;
+	}
+
+	/**
+	* Clear a page wrapper cache
+	* @slug.hint The slug to clean
+	* @async.hint Run it asynchronously or not, defaults to false
+	*/
+	function clearPageWrapper(required any slug, boolean async=false){
+		var settings = settingService.getAllSettings(asStruct=true);
+		// Get appropriate cache provider
+		var cache = cacheBox.getCache( settings.cb_content_cacheName );
+		cache.clear("cb-content-pagewrapper-#arguments.slug#/");
+		return this;
+	}
+
+	/**
+	* Searches published content with cool paramters, remember published content only
+	* @searchTerm.hint The search term to search
+	* @max.hint The maximum number of records to paginate
+	* @offset.hint The offset in the pagination
+	* @asQuery.hint Return as query or array of objects, defaults to array of objects
+	* @sortOrder.hint The sorting of the search results, defaults to publishedDate DESC
+	* @isPublished.hint Search for published, non-published or both content objects [true, false, 'all']
+	* @searchActiveContent.hint Search only content titles or both title and active content. Defaults to both.
+	*/
+	function searchContent(
+		any searchTerm="", 
+		numeric max=0, 
+		numeric offset=0, 
+		boolean asQuery=false, 
+		any sortOrder="publishedDate DESC", 
+		any isPublished=true, 
+		boolean searchActiveContent=true){
+
+		var results = {};
+		var c = newCriteria();
+
+		// only published content
+		if( isBoolean( arguments.isPublished ) ){
+			// Published bit
+			c.isEq( "isPublished", javaCast( "Boolean", arguments.isPublished ) );
+			// Published eq true evaluate other params
+			if( arguments.isPublished ){
+				c.isLt("publishedDate", now() )
+				.$or( c.restrictions.isNull("expireDate"), c.restrictions.isGT("expireDate", now() ) )
+				.isEq("passwordProtection","");
+			}
+		}
+
+		// Search Criteria
+		if( len( arguments.searchTerm ) ){
+			// like disjunctions
+			c.createAlias("activeContent","ac");
+			// Do we search title and active content or just title?
+			if( arguments.searchActiveContent ){
+				c.$or( c.restrictions.like("title","%#arguments.searchTerm#%"),
+				  	  c.restrictions.like("ac.content", "%#arguments.searchTerm#%") );
+			}
+			else{
+				c.like( "title", "%#arguments.searchTerm#%" ); 
+			}
+		}
+
+		// run criteria query and projections count
+		results.count = c.count( "contentID" );
+		results.content = c.resultTransformer( c.DISTINCT_ROOT_ENTITY )
+							.list(offset=arguments.offset, max=arguments.max, sortOrder=arguments.sortOrder, asQuery=arguments.asQuery);
+	
+		return results;
+	}
+
+/********************************************* PRIVATE *********************************************/
+	
+
+	/**
+	* Update the content hits
+	* @contentID.hint The content id to update
+	*/
+	private function syncUpdateHits(required contentID){
+		var q = new Query(sql="UPDATE cb_content SET hits = hits + 1 WHERE contentID = #arguments.contentID#").execute();
+		return this;
+	}
+	
+	
+	private function closureTest(){
+		methodCall(
+			param1,
+			function( arg1, required arg2 ){
+				var settings = settingService.getAllSettings(asStruct=true);
+				// Get appropriate cache provider
+				var cache = cacheBox.getCache( settings.cb_content_cacheName );
+				cache.clear("cb-content-pagewrapper-#arguments.slug#/");
+				return this;
+			},
+			param1
+		);
+	}
+	
+	private function StructliteralTest(){
+		return {
+			foo = bar,
+			brad = 'Wood',
+			func = function( arg1, required arg2 ){
+				var settings = settingService.getAllSettings(asStruct=true);
+				// Get appropriate cache provider
+				var cache = cacheBox.getCache( settings.cb_content_cacheName );
+				cache.clear("cb-content-pagewrapper-#arguments.slug#/");
+				return this;
+			},
+			array = [
+				1,
+				2,
+				3,
+				4,
+				5,
+				'test',
+				'testing',
+				'testerton',
+				{
+					foo = true,
+					brad = false,
+					wood = null
+				}
+			],
+			last = "final"
+		};
+	}
+	
+	private function arrayliteralTest(){
+		return [
+			1,
+			2,
+			3,
+			4,
+			5,
+			'test',
+			'testing',
+			'testerton',
+			{
+				foo = true,
+				brad = false,
+				wood = null
+			},
+			'testy-von-testavich'
+		];
+	}
+	
+}

samples/ColdFusion CFC/exampleTag.cfc

@@ -0,0 +1,18 @@
+<cfcomponent>
+	
+	<cffunction name="init" access="public" returntype="any">
+		<cfargument name="arg1" type="any" required="true">
+		<cfset this.myVariable = arguments.arg1>
+
+		<cfreturn this>
+	</cffunction>
+
+	<cffunction name="testFunc" access="private" returntype="void">
+		<cfargument name="arg1" type="any" required="false">
+		
+		<cfif structKeyExists(arguments, "arg1")>
+			<cfset writeoutput("Argument exists")>
+		</cfif>
+	</cffunction>
+	
+</cfcomponent>

samples/ColdFusion/example.cfm

@@ -0,0 +1,50 @@
+<!--- cfcomment --->
+<!--- nested <!--- cfcomment ---> --->
+<!--- multi-line
+nested
+<!---
+cfcomment
+--->
+--->
+<!-- html comment -->
+<html>
+<head>
+<title>Date Functions</title>
+</head>
+<body>
+<cfset RightNow = Now()>
+<cfoutput>
+ #RightNow#<br />
+ #DateFormat(RightNow)#<br />
+ #DateFormat(RightNow,"mm/dd/yy")#<br />
+ #TimeFormat(RightNow)#<br />
+ #TimeFormat(RightNow,"hh:mm tt")#<br />
+ #IsDate(RightNow)#<br />
+ #IsDate("January 31, 2007")#<br />
+ #IsDate("foo")#<br />
+ #DaysInMonth(RightNow)#
+</cfoutput>
+<cfset x="x">
+<cfset y="y">
+<cfset z="z">
+<cfoutput group="x">
+    #x#
+    <cfoutput>#y#</cfoutput>
+    #z#
+</cfoutput>
+</body>
+</html>
+
+<cfset person = "Paul">
+<cfset greeting = "Hello #person#">
+
+<cfset greeting = "Hello" & " world!">
+<cfset a = 5>
+<cfset b = 10>
+<cfset c = a^b>
+<cfset c = a MOD b>
+<cfset c = a / b>
+<cfset c = a * b>
+<cfset c = a + b>
+<cfset c = a - b>
+<!--- <!-- another <!--- nested --> ---> comment --->

samples/Common Lisp/macros-advanced.cl

@@ -0,0 +1,82 @@
+;; @file macros-advanced.cl
+;;
+;; @breif Advanced macro practices - defining your own macros
+;;
+;; Macro definition skeleton:
+;; (defmacro name (parameter*)
+;;   "Optional documentation string"
+;;   body-form*)
+;;
+;; Note that backquote expression is most often used in the `body-form`
+;;
+
+; `primep` test a number for prime
+(defun primep (n)
+  "test a number for prime"
+  (if (< n 2) (return-from primep))
+  (do ((i 2 (1+ i)) (p t (not (zerop (mod n i)))))
+      ((> i (sqrt n)) p)
+    (when (not p) (return))))
+; `next-prime` return the next prime bigger than the specified number
+(defun next-prime (n)
+  "return the next prime bigger than the speicified number"
+  (do ((i (1+ n) (1+ i)))
+      ((primep i) i)))
+;
+; The recommended procedures to writting a new macro are as follows:
+; 1. Write a sample call to the macro and the code it should expand into
+(do-primes (p 0 19)
+  (format t "~d " p))
+; Expected expanded codes
+(do ((p (next-prime (- 0 1)) (next-prime p)))
+    ((> p 19))
+  (format t "~d " p))
+; 2. Write code that generate the hardwritten expansion from the arguments in
+; the sample call
+(defmacro do-primes (var-and-range &rest body)
+  (let ((var (first var-and-range))
+        (start (second var-and-range))
+        (end (third var-and-range)))
+    `(do ((,var (next-prime (- ,start 1)) (next-prime ,var)))
+         ((> ,var ,end))
+      ,@body)))
+; 2-1. More concise implementations with the 'parameter list destructuring' and
+; '&body' synonym, it also emits more friendly messages on incorrent input.
+(defmacro do-primes ((var start end) &body body)
+  `(do ((,var (next-prime (- ,start 1)) (next-prime ,var)))
+       ((> ,var ,end))
+    ,@body))
+; 2-2. Test the result of macro expansion with the `macroexpand-1` function
+(macroexpand-1 '(do-primes (p 0 19) (format t "~d " p)))
+; 3. Make sure the macro abstraction does not "leak"
+(defmacro do-primes ((var start end) &body body)
+  (let ((end-value-name (gensym)))
+    `(do ((,var (next-prime (- ,start 1)) (next-prime ,var))
+          (,end-value-name ,end))
+         ((> ,var ,end-value-name))
+      ,@body)))
+; 3-1. Rules to observe to avoid common and possible leaks
+;   a. include any subforms in the expansion in positions that will be evaluated
+;      in the same order as the subforms appear in the macro call
+;   b. make sure subforms are evaluated only once by creating a variable in the
+;      expansion to hold the value of evaluating the argument form, and then
+;      using that variable anywhere else the value is needed in the expansion
+;   c. use `gensym` at macro expansion time to create variable names used in the
+;      expansion
+;
+; Appendix I. Macro-writting macros, 'with-gensyms', to guranttee that rule c
+; gets observed.
+; Example usage of `with-gensyms`
+(defmacro do-primes-a ((var start end) &body body)
+  "do-primes implementation with macro-writting macro 'with-gensyms'"
+  (with-gensyms (end-value-name)
+    `(do ((,var (next-prime (- ,start 1)) (next-prime ,var))
+          (,end-value-name ,end))
+         ((> ,var ,end-value-name))
+      ,@body)))
+; Define the macro, note how comma is used to interpolate the value of the loop
+; expression
+(defmacro with-gensyms ((&rest names) &body body)
+  `(let ,(loop for n in names collect `(,n (gensym)))
+    ,@body)
+)

samples/Common Lisp/motor-inferencia.cl

@@ -0,0 +1,475 @@
+#|
+ESCUELA POLITECNICA SUPERIOR - UNIVERSIDAD AUTONOMA DE MADRID
+INTELIGENCIA ARTIFICIAL
+
+Motor de inferencia
+Basado en parte en "Paradigms of AI Programming: Case Studies
+in Common Lisp", de Peter Norvig, 1992
+|#
+
+
+;;;;;;;;;;;;;;;;;;;;;
+;;;; Global variables
+;;;;;;;;;;;;;;;;;;;;;
+
+
+(defvar *hypothesis-list*)
+(defvar *rule-list*)
+(defvar *fact-list*)
+
+;;;;;;;;;;;;;;;;;;;;;
+;;;; Constants
+;;;;;;;;;;;;;;;;;;;;;
+
+(defconstant +fail+ nil "Indicates unification failure")
+
+(defconstant +no-bindings+ '((nil))
+  "Indicates unification success, with no variables.")
+
+(defconstant *mundo-abierto* nil)
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Functions for the user
+;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;; Resets *fact-list* to NIL
+(defun erase-facts () (setq *fact-list* nil))
+
+(defun set-hypothesis-list (h) (setq *hypothesis-list* h))
+
+
+;; Returns a list of solutions, each one satisfying all the hypothesis contained
+;; in *hypothesis-list*
+(defun motor-inferencia ()
+  (consulta *hypothesis-list*))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Auxiliary functions
+;;;;;;;;;;;;;;;;;;;;;;;;
+
+#|____________________________________________________________________________
+FUNCTION: CONSULTA
+
+COMMENTS:
+CONSULTA receives a list of hypothesis (variable <hypotheses>), and returns
+a list of binding lists (each binding list being a solution).
+
+EXAMPLES:
+hypotheses is:
+((brothers ?x ?y) (neighbours juan ?x)).
+
+That is, we are searching the brothers of the possible neighbors of Juan.
+
+The function can return in this case:
+ 
+(((?x . sergio) (?y . javier)) ((?x . julian) (?y . mario)) ((?x . julian) (?y . pedro))).
+That is, the neighbors of Juan (Sergio and Julian) have 3 brothers in total(Javier, Mario, Pedro)
+____________________________________________________________________________|#
+
+(defun consulta (hypotheses)
+  (if (null hypotheses) (list +no-bindings+)
+    (mapcan #'(lambda (b)
+                (mapcar #'(lambda (x) (une-bindings-con-bindings b x))
+                  (consulta (subst-bindings b (rest hypotheses)))))
+      (find-hypothesis-value (first hypotheses)))))
+
+
+
+#|____________________________________________________________________________
+FUNCTION: FIND-HYPOTHESIS-VALUE
+
+COMMENTS:
+This function manages the query a single query (only one hypothesis) given a binding list.
+It tries (in the following order) to:
+- Answer the query from *fact-list*
+- Answer the query from the rules in *rule-list*
+- Ask the user
+
+The function returns a list of solutions (list of binding lists).
+
+EXAMPLES:
+If hypothesis is (brothers ?x ?y)
+and the function returns:
+(((?x . sergio) (?y . javier)) ((?x . julian) (?y . maria)) ((?x . alberto) (?y . pedro))).
+
+Means that Sergio and Javier and brothers, Julian and Mario are brothers, and Alberto and Pedro are brothers.
+____________________________________________________________________________|#
+
+(defun find-hypothesis-value (hypothesis)
+  (let (rules)
+   (cond
+    ((equality? hypothesis) 
+     (value-from-equality hypothesis))
+    ((value-from-facts hypothesis))
+    ((setq good-rules (find-rules hypothesis)) 
+     (value-from-rules hypothesis good-rules))
+    (t (ask-user hypothesis)))))
+
+
+
+; une-bindings-con-bindings takes two binding lists and returns a binding list
+; Assumes that b1 and b2 are not +fail+
+(defun une-bindings-con-bindings (b1 b2)
+  (cond
+   ((equal b1 +no-bindings+) b2)
+   ((equal b2 +no-bindings+) b1)
+   (T (append b1 b2))))
+
+
+
+#|____________________________________________________________________________
+FUNCTION: VALUE-FROM-FACTS
+
+COMMENTS:
+Returns all the solutions of <hypothesis> obtained directly from *fact-list*
+
+EXAMPLES:
+> (setf *fact-list* '((man luis) (man pedro)(woman mart)(man daniel)(woman laura)))
+
+> (value-from-facts '(man ?x))
+returns:
+
+(((?X . LUIS)) ((?X . PEDRO)) ((?X . DANIEL)))
+____________________________________________________________________________|#
+
+(defun value-from-facts (hypothesis)
+  (mapcan #'(lambda(x) (let ((aux (unify hypothesis x)))
+                         (when aux (list aux)))) *fact-list*))
+
+
+
+
+#|____________________________________________________________________________
+FUNCTION: FIND-RULES
+
+COMMENTS:
+Returns the rules in *rule-list* whose THENs unify with the term given in <hypothesis>
+The variables in the rules that satisfy this requirement are renamed.
+
+EXAMPLES:
+> (setq *rule-list*
+      '((R1 (pertenece ?E (?E . ?_)))
+        (R2 (pertenece ?E (?_ . ?Xs)) :- ((pertenece ?E ?Xs)))))
+
+Then:
+> (FIND-RULES (PERTENECE 1 (2 5)))
+returns:
+((R2 (PERTENECE ?E.1 (?_ . ?XS.2)) :- ((PERTENECE ?E.1 ?XS.2))))
+That is, only the THEN of rule R2 unify with <hypothesis>
+
+However,
+> (FIND-RULES (PERTENECE 1 (1 6 7)))
+
+returns:
+((R1 (PERTENECE ?E.6 (?E.6 . ?_)))
+ (R2 (PERTENECE ?E.7 (?_ . ?XS.8)) :- ((PERTENECE ?E.7 ?XS.8))))
+So the THEN of both rules unify with <hypothesis>
+____________________________________________________________________________|#
+
+(defun find-rules (hypothesis)
+  (mapcan #'(lambda(b) (let ((renamed-rule (rename-variables b)))
+                         (when (in-then? hypothesis renamed-rule)
+                           (list renamed-rule)))) *rule-list*))
+
+(defun in-then? (hypothesis rule)
+  (unless (null (rule-then rule))
+    (not (equal +fail+ (unify hypothesis (rule-then rule))))))
+
+
+
+#|____________________________________________________________________________
+FUNCTION: VALUE-FROM-RULES
+
+COMMENTS:
+Returns all the solutions to <hypothesis> found using all the rules given in
+the list <rules>. Note that a single rule can have multiple solutions.
+____________________________________________________________________________|#
+(defun value-from-rules (hypothesis rules)
+  (mapcan #'(lambda (r) (eval-rule hypothesis r)) rules))
+
+(defun limpia-vinculos (termino bindings)
+  (unify termino (subst-bindings bindings termino)))
+
+
+#|____________________________________________________________________________
+FUNCTION: EVAL-RULE
+
+COMMENTS:
+Returns all the solutions found using the rule given as input argument.
+
+EXAMPLES:
+> (setq *rule-list*
+      '((R1 (pertenece ?E (?E . ?_)))
+        (R2 (pertenece ?E (?_ . ?Xs)) :- ((pertenece ?E ?Xs)))))
+Then:
+> (EVAL-RULE 
+   (PERTENECE 1 (1 6 7)) 
+   (R1 (PERTENECE ?E.42 (?E.42 . ?_))))
+returns:
+(((NIL)))
+That is, the query (PERTENECE 1 (1 6 7)) can be proven from the given rule, and
+no binding in the variables in the query is necessary (in fact, the query has no variables).
+On the other hand:
+> (EVAL-RULE 
+   (PERTENECE 1 (7)) 
+   (R2 (PERTENECE ?E.49 (?_ . ?XS.50)) :- ((PERTENECE ?E.49 ?XS.50))))
+returns:
+NIL
+That is, the query can not be proven from the rule R2.
+____________________________________________________________________________|#
+
+(defun eval-rule (hypothesis rule)
+  (let ((bindings-then 
+          (unify (rule-then rule) hypothesis)))
+    (unless (equal +fail+ bindings-then)
+      (if (rule-ifs rule)
+          (mapcar #'(lambda(b) (limpia-vinculos hypothesis (append bindings-then b)))
+            (consulta (subst-bindings bindings-then (rule-ifs rule))))
+        (list (limpia-vinculos hypothesis bindings-then))))))
+
+
+(defun ask-user (hypothesis)
+  (let ((question hypothesis))
+    (cond
+     ((variables-in question) +fail+)
+     ((not-in-fact-list? question) +fail+)
+     (*mundo-abierto*
+      (format t "~%Es cierto el hecho ~S? (T/nil)" question)
+      (cond
+       ((read) (add-fact question) +no-bindings+)
+       (T (add-fact (list 'NOT question)) +fail+)))
+     (T +fail+))))
+
+
+; value-from-equality:
+(defun value-from-equality (hypothesis)
+  (let ((new-bindings (unify (second hypothesis) (third hypothesis))))
+    (if (not (equal +fail+ new-bindings)) 
+	(list new-bindings))))
+
+
+
+#|____________________________________________________________________________
+FUNCTION: UNIFY
+
+COMMENTS:
+Finds the most general unifier of two input expressions, taking into account the
+bindings specified in the input <bingings>
+In case the two expressions can unify, the function returns the total bindings necessary
+for that unification. Otherwise, returns +fail+
+
+EXAMPLES:
+> (unify '1 '1)
+((NIL)) ;; which is the constant +no-bindings+
+> (unify 1 '2)
+nil     ;; which is the constant +fail+
+> (unify '?x 1)
+((?x . 1))
+> (unify '(1 1) ?x)
+((? x 1 1))
+> (unify '?_ '?x)
+((NIL))
+> (unify '(p ?x 1 2) '(p ?y ?_ ?_))
+((?x . ?y))
+> (unify '(?a . ?_) '(1 2 3)) 
+((?a . 1)) 
+> (unify '(?_ ?_) '(1 2))
+((nil))
+> (unify '(?a . ?b) '(1 2 3)) 
+((?b 2 3) (?a . 1)) 
+> (unify '(?a . ?b) '(?v . ?d)) 
+((?b . ?d) (?a . ?v)) 
+> (unify '(?eval (+ 1 1)) '1) 
+nil
+> (unify '(?eval (+ 1 1)) '2) 
+(nil)) 
+____________________________________________________________________________|#
+
+(defun unify (x y &optional (bindings +no-bindings+))
+  "See if x and y match with given bindings.  If they do,
+  return a binding list that would make them equal [p 303]."
+  (cond ((eq bindings +fail+) +fail+)
+        ((eql x y) bindings)
+        ((eval? x) (unify-eval x y bindings))
+        ((eval? y) (unify-eval y x bindings))
+        ((variable? x) (unify-var x y bindings))
+        ((variable? y) (unify-var y x bindings))
+        ((and (consp x) (consp y))
+         (unify (rest x) (rest y) 
+                (unify (first x) (first y) bindings)))
+        (t +fail+)))
+
+
+;; rename-variables: renombra ?X por ?X.1, ?Y por ?Y.2 etc. salvo ?_ que no se renombra
+(defun rename-variables (x)
+  "Replace all variables in x with new ones. Excepto ?_"
+  (sublis (mapcar #'(lambda (var) 
+		      (if (anonymous-var? var)
+			  (make-binding var var)
+			(make-binding var (new-variable var))))
+		  (variables-in x))
+	  x))
+
+
+
+;;;; Auxiliary Functions
+
+(defun unify-var (var x bindings)
+  "Unify var with x, using (and maybe extending) bindings [p 303]."
+  (cond ((or (anonymous-var? var)(anonymous-var? x)) bindings)
+	((get-binding var bindings)
+	 (unify (lookup var bindings) x bindings))
+	((and (variable? x) (get-binding x bindings))
+	 (unify var (lookup x bindings) bindings))
+	((occurs-in? var x bindings)
+	 +fail+)
+	(t (extend-bindings var x bindings))))
+
+(defun variable? (x)
+  "Is x a variable (a symbol starting with ?)?"
+  (and (symbolp x) (eql (char (symbol-name x) 0) #\?)))
+
+(defun get-binding (var bindings)
+  "Find a (variable . value) pair in a binding list."
+  (assoc var bindings))
+
+(defun binding-var (binding)
+  "Get the variable part of a single binding."
+  (car binding))
+
+(defun binding-val (binding)
+  "Get the value part of a single binding."
+  (cdr binding))
+
+(defun make-binding (var val) (cons var val))
+
+(defun lookup (var bindings)
+  "Get the value part (for var) from a binding list."
+  (binding-val (get-binding var bindings)))
+
+(defun extend-bindings (var val bindings)
+  "Add a (var . value) pair to a binding list."
+  (append 
+   (unless (eq bindings +no-bindings+) bindings)
+   (list (make-binding var val))))
+
+(defun occurs-in? (var x bindings)
+  "Does var occur anywhere inside x?"
+  (cond ((eq var x) t)
+        ((and (variable? x) (get-binding x bindings))
+         (occurs-in? var (lookup x bindings) bindings))
+        ((consp x) (or (occurs-in? var (first x) bindings)
+                       (occurs-in? var (rest x) bindings)))
+        (t nil)))
+
+(defun subst-bindings (bindings x)
+  "Substitute the value of variables in bindings into x,
+  taking recursively bound variables into account."
+  (cond ((eq bindings +fail+) +fail+)
+        ((eq bindings +no-bindings+) x)
+        ((and (listp x) (eq '?eval (car x)))
+         (subst-bindings-quote bindings x))
+        ((and (variable? x) (get-binding x bindings))
+         (subst-bindings bindings (lookup x bindings)))
+        ((atom x) x)
+        (t (cons (subst-bindings bindings (car x)) ;; s/reuse-cons/cons
+		 (subst-bindings bindings (cdr x))))))
+
+(defun unifier (x y)
+ "Return something that unifies with both x and y (or fail)."
+ (subst-bindings (unify x y) x))
+
+(defun variables-in (exp)
+  "Return a list of all the variables in EXP."
+  (unique-find-anywhere-if #'variable? exp))
+
+(defun unique-find-anywhere-if (predicate tree &optional found-so-far)
+  "Return a list of leaves of tree satisfying predicate,
+  with duplicates removed."
+  (if (atom tree)
+      (if (funcall predicate tree)
+          (pushnew tree found-so-far)
+          found-so-far)
+    (unique-find-anywhere-if
+        predicate
+        (first tree)
+        (unique-find-anywhere-if predicate (rest tree)
+                                 found-so-far))))
+
+(defun find-anywhere-if (predicate tree)
+  "Does predicate apply to any atom in the tree?"  
+  (if (atom tree)
+      (funcall predicate tree)
+      (or (find-anywhere-if predicate (first tree))
+          (find-anywhere-if predicate (rest tree)))))
+
+(defun new-variable (var)
+  "Create a new variable.  Assumes user never types variables of form ?X.9"
+  (gentemp (format nil "~S." var)))
+;  (gentemp "?") )
+;;;
+
+(defun anonymous-var? (x)
+  (eq x '?_))
+
+(defun subst-bindings-quote (bindings x)
+  "Substitute the value of variables in bindings into x,
+  taking recursively bound variables into account."
+  (cond ((eq bindings +fail+) +fail+)
+        ((eq bindings +no-bindings+) x)
+        ((and (variable? x) (get-binding x bindings))
+         (if (variable? (lookup x bindings))
+             (subst-bindings-quote bindings (lookup x bindings))
+             (subst-bindings-quote bindings (list 'quote (lookup x bindings)))
+         )
+        )     
+        ((atom x) x)
+        (t (cons (subst-bindings-quote bindings (car x)) ;; s/reuse-cons/cons
+		 (subst-bindings-quote bindings (cdr x))))))
+
+(defun eval? (x)
+  (and (consp x) (eq (first x) '?eval)))
+
+(defun unify-eval (x y bindings)
+  (let ((exp (subst-bindings-quote bindings (second x))))
+    (if (variables-in exp)
+	+fail+
+      (unify (eval exp) y bindings))))
+
+
+
+(defun rule-ifs (rule) (fourth rule))
+(defun rule-then (rule) (second rule))
+
+
+(defun equality? (term)
+  (and (consp term) (eql (first term) '?=)))
+
+
+(defun in-fact-list? (expresion)
+  (some #'(lambda(x) (equal x expresion)) *fact-list*))
+                     
+(defun not-in-fact-list? (expresion)
+  (if (eq (car expresion) 'NOT)
+      (in-fact-list? (second expresion))
+    (in-fact-list? (list 'NOT expresion))))
+
+
+;; add-fact:
+
+(defun add-fact (fact)
+  (setq *fact-list* (cons fact *fact-list*)))
+
+
+(defun variable? (x)
+  "Is x a variable (a symbol starting with ?) except ?eval and ?="
+  (and (not (equal x '?eval)) (not (equal x '?=)) 
+       (symbolp x) (eql (char (symbol-name x) 0) #\?)))
+
+
+;; EOF

samples/Component Pascal/Example.cp

@@ -0,0 +1,130 @@
+MODULE ObxControls;
+(**
+    project         = "BlackBox"
+    organization    = "www.oberon.ch"
+    contributors    = "Oberon microsystems"
+    version         = "System/Rsrc/About"
+    copyright       = "System/Rsrc/About"
+    license         = "Docu/BB-License"
+    changes         = ""
+    issues          = ""
+
+**)
+
+IMPORT Dialog, Ports, Properties, Views;
+
+CONST beginner = 0; advanced = 1; expert = 2; guru = 3;    (* user classes *)
+
+TYPE
+    View = POINTER TO RECORD (Views.View)
+        size: INTEGER    (* border size in mm *)
+    END;
+
+VAR
+    data*: RECORD
+        class*: INTEGER;    (* current user class *)
+        list*: Dialog.List;    (* list of currently available sizes, derived from class *)
+        width*: INTEGER    (* width of next view to be opened. Derived from
+                                    class, or entered through a text entry field *)
+    END;
+
+    predef: ARRAY 6 OF INTEGER;    (* table of predefined sizes *)
+
+
+PROCEDURE SetList;
+BEGIN
+    IF data.class = beginner THEN
+        data.list.SetLen(1);
+        data.list.SetItem(0, "default")
+    ELSIF data.class = advanced THEN
+        data.list.SetLen(4);
+        data.list.SetItem(0, "default");
+        data.list.SetItem(1, "small");
+        data.list.SetItem(2, "medium");
+        data.list.SetItem(3, "large");
+    ELSE
+        data.list.SetLen(6);
+        data.list.SetItem(0, "default");
+        data.list.SetItem(1, "small");
+        data.list.SetItem(2, "medium");
+        data.list.SetItem(3, "large");
+        data.list.SetItem(4, "tiny");
+        data.list.SetItem(5, "huge");
+    END
+END SetList;
+
+(* View *)
+
+PROCEDURE (v: View) CopyFromSimpleView (source: Views.View);
+BEGIN
+    v.size := source(View).size
+END CopyFromSimpleView;
+
+PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);
+BEGIN    (* fill view with a red square of size v.size *)
+    IF v.size = 0 THEN v.size := predef[0] END;    (* lazy initialization of size *)
+    f.DrawRect(0, 0, v.size, v.size, Ports.fill, Ports.red)
+END Restore;
+
+PROCEDURE (v: View) HandlePropMsg (VAR msg: Views.PropMessage);
+BEGIN
+    WITH msg: Properties.SizePref DO
+        IF v.size = 0 THEN v.size := predef[0] END;    (* lazy initialization of size *)
+        msg.w := v.size; msg.h := v.size    (* tell environment about desired width and height *)
+    ELSE    (* ignore other messages *)
+    END
+END HandlePropMsg;
+
+(* notifiers *)
+
+PROCEDURE ClassNotify* (op, from, to: INTEGER);
+BEGIN    (* react to change in data.class *)
+    IF op = Dialog.changed THEN
+        IF (to = beginner) OR (to = advanced) & (data.list.index > 3) THEN
+            (* if class is reduced, make sure that selection contains legal elements *)
+            data.list.index := 0; data.width := predef[0];    (* modify interactor *)
+            Dialog.Update(data)    (* redraw controls where necessary *)
+        END;
+        SetList;
+        Dialog.UpdateList(data.list)    (* reconstruct list box contents *)
+    END
+END ClassNotify;
+
+PROCEDURE ListNotify* (op, from, to: INTEGER);
+BEGIN    (* reacto to change in data.list (index to was selected) *)
+    IF op = Dialog.changed THEN
+        data.width := predef[to];    (* modify interactor *)
+        Dialog.Update(data)    (* redraw controls where necessary *)
+    END
+END ListNotify;
+
+(* guards *)
+
+PROCEDURE ListGuard* (VAR par: Dialog.Par);
+BEGIN    (* disable list box for a beginner *)
+    par.disabled := data.class = beginner
+END ListGuard;
+
+PROCEDURE WidthGuard* (VAR par: Dialog.Par);
+BEGIN    (* make text entry field read-only if user is not guru *)
+    par.readOnly := data.class # guru
+END WidthGuard;
+
+(* commands *)
+
+PROCEDURE Open*;
+    VAR v: View;
+BEGIN
+    NEW(v);    (* create and initialize a new view *)
+    v.size := data.width * Ports.mm;    (* define view's size in function of class *)
+    Views.OpenAux(v, "Example")    (* open the view in a window *)
+END Open;
+
+BEGIN    (* initialization of global variables *)
+    predef[0] := 40; predef[1] := 30; predef[2] := 50;    (* predefined sizes *)
+    predef[3] := 70; predef[4] := 20; predef[5] := 100;
+    data.class := beginner;    (* default values *)
+    data.list.index := 0;
+    data.width := predef[0];
+    SetList
+END ObxControls.

samples/Component Pascal/Example2.cps

@@ -0,0 +1,71 @@
+MODULE ObxFact;
+(**
+    project         = "BlackBox"
+    organization    = "www.oberon.ch"
+    contributors    = "Oberon microsystems"
+    version         = "System/Rsrc/About"
+    copyright       = "System/Rsrc/About"
+    license         = "Docu/BB-License"
+    changes         = ""
+    issues          = ""
+
+**)
+
+IMPORT
+    Stores, Models, TextModels, TextControllers, Integers;
+
+PROCEDURE Read(r: TextModels.Reader; VAR x: Integers.Integer);
+    VAR i, len, beg: INTEGER; ch: CHAR; buf: POINTER TO ARRAY OF CHAR;
+BEGIN
+    r.ReadChar(ch);
+    WHILE ~r.eot & (ch <= " ") DO r.ReadChar(ch) END;
+    ASSERT(~r.eot & (((ch >= "0") & (ch <= "9")) OR (ch = "-")));
+    beg := r.Pos() - 1; len := 0;
+    REPEAT INC(len); r.ReadChar(ch) UNTIL r.eot OR (ch < "0") OR (ch > "9");
+    NEW(buf, len + 1);
+    i := 0; r.SetPos(beg);
+    REPEAT r.ReadChar(buf[i]); INC(i) UNTIL i = len;
+    buf[i] := 0X;
+    Integers.ConvertFromString(buf^, x)
+END Read;
+
+PROCEDURE Write(w: TextModels.Writer; x: Integers.Integer);
+    VAR i: INTEGER;
+BEGIN
+    IF Integers.Sign(x) < 0 THEN w.WriteChar("-") END;
+    i := Integers.Digits10Of(x);
+    IF i # 0 THEN
+        REPEAT DEC(i); w.WriteChar(Integers.ThisDigit10(x, i)) UNTIL i = 0
+    ELSE w.WriteChar("0")
+    END
+END Write;
+
+PROCEDURE Compute*;
+    VAR beg, end, i, n: INTEGER; ch: CHAR;
+        s: Stores.Operation;
+        r: TextModels.Reader; w: TextModels.Writer; attr: TextModels.Attributes;
+        c: TextControllers.Controller;
+        x: Integers.Integer;
+BEGIN
+    c := TextControllers.Focus();
+    IF (c # NIL) & c.HasSelection() THEN
+        c.GetSelection(beg, end);
+        r := c.text.NewReader(NIL); r.SetPos(beg); r.ReadChar(ch);
+        WHILE ~r.eot & (beg < end) & (ch <= " ") DO r.ReadChar(ch); INC(beg) END;
+        IF ~r.eot & (beg < end) THEN
+            r.ReadPrev; Read(r, x);
+            end := r.Pos(); r.ReadPrev; attr :=r.attr;
+            IF (Integers.Sign(x) > 0) & (Integers.Compare(x, Integers.Long(MAX(LONGINT))) <= 0) THEN
+                n := SHORT(Integers.Short(x)); i := 2; x := Integers.Long(1);
+                WHILE i <= n DO x := Integers.Product(x, Integers.Long(i)); INC(i) END;
+                Models.BeginScript(c.text, "computation", s);
+                c.text.Delete(beg, end);
+                w := c.text.NewWriter(NIL); w.SetPos(beg); w.SetAttr(attr);
+                Write(w, x);
+                Models.EndScript(c.text, s)
+            END
+        END
+    END
+END Compute;
+
+END ObxFact.

samples/Crystal/const_spec.cr

@@ -0,0 +1,169 @@
+#!/usr/bin/env bin/crystal --run
+require "../../spec_helper"
+
+describe "Codegen: const" do
+  it "define a constant" do
+    run("A = 1; A").to_i.should eq(1)
+  end
+
+  it "support nested constant" do
+    run("class B; A = 1; end; B::A").to_i.should eq(1)
+  end
+
+  it "support constant inside a def" do
+    run("
+      class Foo
+        A = 1
+
+        def foo
+          A
+        end
+      end
+
+      Foo.new.foo
+    ").to_i.should eq(1)
+  end
+
+  it "finds nearest constant first" do
+    run("
+      A = 1
+
+      class Foo
+        A = 2.5_f32
+
+        def foo
+          A
+        end
+      end
+
+      Foo.new.foo
+    ").to_f32.should eq(2.5)
+  end
+
+  it "allows constants with same name" do
+    run("
+      A = 1
+
+      class Foo
+        A = 2.5_f32
+
+        def foo
+          A
+        end
+      end
+
+      A
+      Foo.new.foo
+    ").to_f32.should eq(2.5)
+  end
+
+  it "constants with expression" do
+    run("
+      A = 1 + 1
+      A
+    ").to_i.should eq(2)
+  end
+
+  it "finds global constant" do
+    run("
+      A = 1
+
+      class Foo
+        def foo
+          A
+        end
+      end
+
+      Foo.new.foo
+    ").to_i.should eq(1)
+  end
+
+  it "define a constant in lib" do
+    run("lib Foo; A = 1; end; Foo::A").to_i.should eq(1)
+  end
+
+  it "invokes block in const" do
+    run("require \"prelude\"; A = [\"1\"].map { |x| x.to_i }; A[0]").to_i.should eq(1)
+  end
+
+  it "declare constants in right order" do
+    run("A = 1 + 1; B = true ? A : 0; B").to_i.should eq(2)
+  end
+
+  it "uses correct types lookup" do
+    run("
+      module A
+        class B
+          def foo
+            1
+          end
+        end
+
+        C = B.new;
+      end
+
+      def foo
+        A::C.foo
+      end
+
+      foo
+      ").to_i.should eq(1)
+  end
+
+  it "codegens variable assignment in const" do
+    run("
+      class Foo
+        def initialize(@x)
+        end
+
+        def x
+          @x
+        end
+      end
+
+      A = begin
+            f = Foo.new(1)
+            f
+          end
+
+      def foo
+        A.x
+      end
+
+      foo
+      ").to_i.should eq(1)
+  end
+
+  it "declaring var" do
+    run("
+      BAR = begin
+        a = 1
+        while 1 == 2
+          b = 2
+        end
+        a
+      end
+      class Foo
+        def compile
+          BAR
+        end
+      end
+
+      Foo.new.compile
+      ").to_i.should eq(1)
+  end
+
+  it "initialize const that might raise an exception" do
+    run("
+      require \"prelude\"
+      CONST = (raise \"OH NO\" if 1 == 2)
+
+      def doit
+        CONST
+      rescue
+      end
+
+      doit.nil?
+    ").to_b.should be_true
+  end
+end

samples/Crystal/declare_var_spec.cr

@@ -0,0 +1,79 @@
+#!/usr/bin/env bin/crystal --run
+require "../../spec_helper"
+
+describe "Type inference: declare var" do
+  it "types declare var" do
+    assert_type("a :: Int32") { int32 }
+  end
+
+  it "types declare var and reads it" do
+    assert_type("a :: Int32; a") { int32 }
+  end
+
+  it "types declare var and changes its type" do
+    assert_type("a :: Int32; while 1 == 2; a = 'a'; end; a") { union_of(int32, char) }
+  end
+
+  it "declares instance var which appears in initialize" do
+    result = assert_type("
+      class Foo
+        @x :: Int32
+      end
+
+      Foo.new") { types["Foo"] }
+
+    mod = result.program
+
+    foo = mod.types["Foo"] as NonGenericClassType
+    foo.instance_vars["@x"].type.should eq(mod.int32)
+  end
+
+  it "declares instance var of generic class" do
+    result = assert_type("
+      class Foo(T)
+        @x :: T
+      end
+
+      Foo(Int32).new") do
+        foo = types["Foo"] as GenericClassType
+        foo_i32 = foo.instantiate([int32] of Type | ASTNode)
+        foo_i32.lookup_instance_var("@x").type.should eq(int32)
+        foo_i32
+    end
+  end
+
+  it "declares instance var of generic class after reopen" do
+    result = assert_type("
+      class Foo(T)
+      end
+
+      f = Foo(Int32).new
+
+      class Foo(T)
+        @x :: T
+      end
+
+      f") do
+        foo = types["Foo"] as GenericClassType
+        foo_i32 = foo.instantiate([int32] of Type | ASTNode)
+        foo_i32.lookup_instance_var("@x").type.should eq(int32)
+        foo_i32
+    end
+  end
+
+  it "declares an instance variable in initialize" do
+    assert_type("
+      class Foo
+        def initialize
+          @x :: Int32
+        end
+
+        def x
+          @x
+        end
+      end
+
+      Foo.new.x
+      ") { int32 }
+  end
+end

samples/Crystal/transformer.cr

@@ -0,0 +1,515 @@
+module Crystal
+  class ASTNode
+    def transform(transformer)
+      transformer.before_transform self
+      node = transformer.transform self
+      transformer.after_transform self
+      node
+    end
+  end
+
+  class Transformer
+    def before_transform(node)
+    end
+
+    def after_transform(node)
+    end
+
+    def transform(node : Expressions)
+      exps = [] of ASTNode
+      node.expressions.each do |exp|
+        new_exp = exp.transform(self)
+        if new_exp
+          if new_exp.is_a?(Expressions)
+            exps.concat new_exp.expressions
+          else
+            exps << new_exp
+          end
+        end
+      end
+
+      if exps.length == 1
+        exps[0]
+      else
+        node.expressions = exps
+        node
+      end
+    end
+
+    def transform(node : Call)
+      if node_obj = node.obj
+        node.obj = node_obj.transform(self)
+      end
+      transform_many node.args
+
+      if node_block = node.block
+        node.block = node_block.transform(self)
+      end
+
+      if node_block_arg = node.block_arg
+        node.block_arg = node_block_arg.transform(self)
+      end
+
+      node
+    end
+
+    def transform(node : And)
+      node.left = node.left.transform(self)
+      node.right = node.right.transform(self)
+      node
+    end
+
+    def transform(node : Or)
+      node.left = node.left.transform(self)
+      node.right = node.right.transform(self)
+      node
+    end
+
+    def transform(node : StringInterpolation)
+      transform_many node.expressions
+      node
+    end
+
+    def transform(node : ArrayLiteral)
+      transform_many node.elements
+
+      if node_of = node.of
+        node.of = node_of.transform(self)
+      end
+
+      node
+    end
+
+    def transform(node : HashLiteral)
+      transform_many node.keys
+      transform_many node.values
+
+      if of_key = node.of_key
+        node.of_key = of_key.transform(self)
+      end
+
+      if of_value = node.of_value
+        node.of_value = of_value.transform(self)
+      end
+
+      node
+    end
+
+    def transform(node : If)
+      node.cond = node.cond.transform(self)
+      node.then = node.then.transform(self)
+      node.else = node.else.transform(self)
+      node
+    end
+
+    def transform(node : Unless)
+      node.cond = node.cond.transform(self)
+      node.then = node.then.transform(self)
+      node.else = node.else.transform(self)
+      node
+    end
+
+    def transform(node : IfDef)
+      node.cond = node.cond.transform(self)
+      node.then = node.then.transform(self)
+      node.else = node.else.transform(self)
+      node
+    end
+
+    def transform(node : MultiAssign)
+      transform_many node.targets
+      transform_many node.values
+      node
+    end
+
+    def transform(node : SimpleOr)
+      node.left = node.left.transform(self)
+      node.right = node.right.transform(self)
+      node
+    end
+
+    def transform(node : Def)
+      transform_many node.args
+      node.body = node.body.transform(self)
+
+      if receiver = node.receiver
+        node.receiver = receiver.transform(self)
+      end
+
+      if block_arg = node.block_arg
+        node.block_arg = block_arg.transform(self)
+      end
+
+      node
+    end
+
+    def transform(node : Macro)
+      transform_many node.args
+      node.body = node.body.transform(self)
+
+      if receiver = node.receiver
+        node.receiver = receiver.transform(self)
+      end
+
+      if block_arg = node.block_arg
+        node.block_arg = block_arg.transform(self)
+      end
+
+      node
+    end
+
+    def transform(node : PointerOf)
+      node.exp = node.exp.transform(self)
+      node
+    end
+
+    def transform(node : SizeOf)
+      node.exp = node.exp.transform(self)
+      node
+    end
+
+    def transform(node : InstanceSizeOf)
+      node.exp = node.exp.transform(self)
+      node
+    end
+
+    def transform(node : IsA)
+      node.obj = node.obj.transform(self)
+      node.const = node.const.transform(self)
+      node
+    end
+
+    def transform(node : RespondsTo)
+      node.obj = node.obj.transform(self)
+      node
+    end
+
+    def transform(node : Case)
+      node.cond = node.cond.transform(self)
+      transform_many node.whens
+
+      if node_else = node.else
+        node.else = node_else.transform(self)
+      end
+
+      node
+    end
+
+    def transform(node : When)
+      transform_many node.conds
+      node.body = node.body.transform(self)
+      node
+    end
+
+    def transform(node : ImplicitObj)
+      node
+    end
+
+    def transform(node : ClassDef)
+      node.body = node.body.transform(self)
+
+      if superclass = node.superclass
+        node.superclass = superclass.transform(self)
+      end
+
+      node
+    end
+
+    def transform(node : ModuleDef)
+      node.body = node.body.transform(self)
+      node
+    end
+
+    def transform(node : While)
+      node.cond = node.cond.transform(self)
+      node.body = node.body.transform(self)
+      node
+    end
+
+    def transform(node : Generic)
+      node.name = node.name.transform(self)
+      transform_many node.type_vars
+      node
+    end
+
+    def transform(node : ExceptionHandler)
+      node.body = node.body.transform(self)
+      transform_many node.rescues
+
+      if node_ensure = node.ensure
+        node.ensure = node_ensure.transform(self)
+      end
+
+      node
+    end
+
+    def transform(node : Rescue)
+      node.body = node.body.transform(self)
+      transform_many node.types
+      node
+    end
+
+    def transform(node : Union)
+      transform_many node.types
+      node
+    end
+
+    def transform(node : Hierarchy)
+      node.name = node.name.transform(self)
+      node
+    end
+
+    def transform(node : Metaclass)
+      node.name = node.name.transform(self)
+      node
+    end
+
+    def transform(node : Arg)
+      if default_value = node.default_value
+        node.default_value = default_value.transform(self)
+      end
+
+      if restriction = node.restriction
+        node.restriction = restriction.transform(self)
+      end
+
+      node
+    end
+
+    def transform(node : BlockArg)
+      node.fun = node.fun.transform(self)
+      node
+    end
+
+    def transform(node : Fun)
+      transform_many node.inputs
+
+      if output = node.output
+        node.output = output.transform(self)
+      end
+
+      node
+    end
+
+    def transform(node : Block)
+      node.args.map! { |exp| exp.transform(self) as Var }
+      node.body = node.body.transform(self)
+      node
+    end
+
+    def transform(node : FunLiteral)
+      node.def.body = node.def.body.transform(self)
+      node
+    end
+
+    def transform(node : FunPointer)
+      if obj = node.obj
+        node.obj = obj.transform(self)
+      end
+      node
+    end
+
+    def transform(node : Return)
+      transform_many node.exps
+      node
+    end
+
+    def transform(node : Break)
+      transform_many node.exps
+      node
+    end
+
+    def transform(node : Next)
+      transform_many node.exps
+      node
+    end
+
+    def transform(node : Yield)
+      if scope = node.scope
+        node.scope = scope.transform(self)
+      end
+      transform_many node.exps
+      node
+    end
+
+    def transform(node : Include)
+      node.name = node.name.transform(self)
+      node
+    end
+
+    def transform(node : Extend)
+      node.name = node.name.transform(self)
+      node
+    end
+
+    def transform(node : RangeLiteral)
+      node.from = node.from.transform(self)
+      node.to = node.to.transform(self)
+      node
+    end
+
+    def transform(node : Assign)
+      node.target = node.target.transform(self)
+      node.value = node.value.transform(self)
+      node
+    end
+
+    def transform(node : Nop)
+      node
+    end
+
+    def transform(node : NilLiteral)
+      node
+    end
+
+    def transform(node : BoolLiteral)
+      node
+    end
+
+    def transform(node : NumberLiteral)
+      node
+    end
+
+    def transform(node : CharLiteral)
+      node
+    end
+
+    def transform(node : StringLiteral)
+      node
+    end
+
+    def transform(node : SymbolLiteral)
+      node
+    end
+
+    def transform(node : RegexLiteral)
+      node
+    end
+
+    def transform(node : Var)
+      node
+    end
+
+    def transform(node : MetaVar)
+      node
+    end
+
+    def transform(node : InstanceVar)
+      node
+    end
+
+    def transform(node : ClassVar)
+      node
+    end
+
+    def transform(node : Global)
+      node
+    end
+
+    def transform(node : Require)
+      node
+    end
+
+    def transform(node : Path)
+      node
+    end
+
+    def transform(node : Self)
+      node
+    end
+
+    def transform(node : LibDef)
+      node.body = node.body.transform(self)
+      node
+    end
+
+    def transform(node : FunDef)
+      if body = node.body
+        node.body = body.transform(self)
+      end
+      node
+    end
+
+    def transform(node : TypeDef)
+      node
+    end
+
+    def transform(node : StructDef)
+      node
+    end
+
+    def transform(node : UnionDef)
+      node
+    end
+
+    def transform(node : EnumDef)
+      node
+    end
+
+    def transform(node : ExternalVar)
+      node
+    end
+
+    def transform(node : IndirectRead)
+      node.obj = node.obj.transform(self)
+      node
+    end
+
+    def transform(node : IndirectWrite)
+      node.obj = node.obj.transform(self)
+      node.value = node.value.transform(self)
+      node
+    end
+
+    def transform(node : TypeOf)
+      transform_many node.expressions
+      node
+    end
+
+    def transform(node : Primitive)
+      node
+    end
+
+    def transform(node : Not)
+      node
+    end
+
+    def transform(node : TypeFilteredNode)
+      node
+    end
+
+    def transform(node : TupleLiteral)
+      transform_many node.exps
+      node
+    end
+
+    def transform(node : Cast)
+      node.obj = node.obj.transform(self)
+      node.to = node.to.transform(self)
+      node
+    end
+
+    def transform(node : DeclareVar)
+      node.var = node.var.transform(self)
+      node.declared_type = node.declared_type.transform(self)
+      node
+    end
+
+    def transform(node : Alias)
+      node.value = node.value.transform(self)
+      node
+    end
+
+    def transform(node : TupleIndexer)
+      node
+    end
+
+    def transform(node : Attribute)
+      node
+    end
+
+    def transform_many(exps)
+      exps.map! { |exp| exp.transform(self) } if exps
+    end
+  end
+end

samples/Cycript/utils.cy

@@ -0,0 +1,580 @@
+(function(utils) {
+	// Load C functions declared in utils.loadFuncs
+	var shouldLoadCFuncs = true;
+	// Expose the C functions to cycript's global scope
+	var shouldExposeCFuncs = true;
+	// Expose C constants to cycript's global scope
+	var shouldExposeConsts = true;
+	// Expose functions defined here to cycript's global scope
+	var shouldExposeFuncs = true;
+	// Which functions to expose
+	var funcsToExpose = ["exec", "include", "sizeof", "logify", "apply", "str2voidPtr", "voidPtr2str", "double2voidPtr", "voidPtr2double", "isMemoryReadable", "isObject", "makeStruct"];
+	
+	// C functions that utils.loadFuncs loads
+	var CFuncsDeclarations = [
+		// <stdlib.h>
+		"void *calloc(size_t num, size_t size)",
+		// <string.h>
+		"char *strcpy(char *restrict dst, const char *restrict src)",
+		"char *strdup(const char *s1)",
+		"void* memset(void* dest, int ch, size_t count)",
+		// <stdio.h>
+		"FILE *fopen(const char *, const char *)",
+		"int fclose(FILE *)",
+		"size_t fread(void *restrict, size_t, size_t, FILE *restrict)",
+		"size_t fwrite(const void *restrict, size_t, size_t, FILE *restrict)",
+		// <mach.h>
+		"mach_port_t mach_task_self()",
+		"kern_return_t task_for_pid(mach_port_name_t target_tport, int pid, mach_port_name_t *tn)",
+		"kern_return_t mach_vm_protect(vm_map_t target_task, mach_vm_address_t address, mach_vm_size_t size, boolean_t set_maximum, vm_prot_t new_protection)",
+		"kern_return_t mach_vm_write(vm_map_t target_task, mach_vm_address_t address, vm_offset_t data, mach_msg_type_number_t dataCnt)",
+		"kern_return_t mach_vm_read(vm_map_t target_task, mach_vm_address_t address, mach_vm_size_t size, vm_offset_t *data, mach_msg_type_number_t *dataCnt)",
+	];
+	
+	/*
+		Replacement for eval that can handle @encode etc.
+		
+		Usage:
+			cy# utils.exec("@encode(void *(int, char))")
+			@encode(void*(int,char))
+	*/
+	utils.exec = function(str) {
+		var mkdir = @encode(int (const char *, int))(dlsym(RTLD_DEFAULT, "mkdir"));
+		var tempnam = @encode(char *(const char *, const char *))(dlsym(RTLD_DEFAULT, "tempnam"));
+		var fopen = @encode(void *(const char *, const char *))(dlsym(RTLD_DEFAULT, "fopen"));
+		var fclose = @encode(int (void *))(dlsym(RTLD_DEFAULT, "fclose"));
+		var fwrite = @encode(int (const char *, int, int, void *))(dlsym(RTLD_DEFAULT, "fwrite"));
+		var symlink = @encode(int (const char *, const char *))(dlsym(RTLD_DEFAULT, "symlink"));
+		var unlink = @encode(int (const char *))(dlsym(RTLD_DEFAULT, "unlink"));
+		var getenv = @encode(const char *(const char *))(dlsym(RTLD_DEFAULT, "getenv"));
+		var setenv = @encode(int (const char *, const char *, int))(dlsym(RTLD_DEFAULT, "setenv"));
+		
+		var libdir = "/usr/lib/cycript0.9";
+		var dir = libdir + "/tmp";
+
+		mkdir(dir, 0777);
+		
+		// This is needed because tempnam seems to ignore the first argument on i386
+		var old_tmpdir = getenv("TMPDIR");
+		setenv("TMPDIR", dir, 1);
+
+		// No freeing :(
+		var f = tempnam(dir, "exec-");
+		setenv("TMPDIR", old_tmpdir, 1);
+		if(!f) {
+			return false;
+		}
+
+		symlink(f, f + ".cy");
+		
+		str = "exports.result = " + str;
+
+		var handle = fopen(f, "w");
+		fwrite(str, str.length, 1, handle);
+		fclose(handle);
+		
+		var r;
+		var except = null;
+		try {
+			r = require(f.replace(libdir + "/", ""));
+		} catch(e) {
+			except = e;
+		}
+
+		unlink(f + ".cy");
+		unlink(f);
+		
+		if(except !== null) {
+			throw except;
+		}
+
+		return r.result;
+	};
+	
+	/*
+		Applies known typedefs
+		Used in utils.include and utils.makeStruct
+		
+		Usage:
+			cy# utils.applyTypedefs("mach_vm_address_t")
+			"uint64_t"
+	*/
+	utils.applyTypedefs = function(str) {
+		var typedefs = {
+			"struct": "",
+			"restrict": "",
+			"FILE": "void",
+			"size_t": "uint64_t",
+			"uintptr_t": "unsigned long",
+			"kern_return_t": "int",
+			"mach_port_t": "unsigned int",
+			"mach_port_name_t": "unsigned int",
+			"vm_offset_t": "unsigned long",
+			"vm_size_t": "unsigned long",
+			"mach_vm_address_t": "uint64_t",
+			"mach_vm_offset_t": "uint64_t",
+			"mach_vm_size_t": "uint64_t",
+			"vm_map_offset_t": "uint64_t",
+			"vm_map_address_t": "uint64_t",
+			"vm_map_size_t": "uint64_t",
+			"mach_port_context_t": "uint64_t",
+			"vm_map_t": "unsigned int",
+			"boolean_t": "unsigned int",
+			"vm_prot_t": "int",
+			"mach_msg_type_number_t": "unsigned int",
+			"cpu_type_t": "int",
+			"cpu_subtype_t": "int",
+			"cpu_threadtype_t": "int",
+		};
+		
+		for(var k in typedefs) {
+			str = str.replace(new RegExp("(\\s|\\*|,|\\(|^)" + k + "(\\s|\\*|,|\\)|$)", "g"), "$1" + typedefs[k] + "$2");
+		}
+		
+		return str;
+	};
+	
+	/*
+		Parses a C function declaration and returns the function name and cycript type
+		If load is true, tries to load it into cycript using utils.exec
+		
+		Usage:
+			cy# var str = "void *calloc(size_t num, size_t size)";
+			"void *calloc(size_t num, size_t size)"
+			cy# utils.include(str)
+			["calloc","@encode(void *(uint64_t num,  uint64_t size))(140735674376857)"]
+			cy# var ret = utils.include(str, true)
+			["calloc",0x7fff93e0e299]
+			cy# ret[1].type
+			@encode(void*(unsigned long long int,unsigned long long int))
+			cy# ret[1](100, 1)
+			0x100444100
+	*/
+	utils.include = function(str, load) {
+		var re = /^\s*([^(]*(?:\s+|\*))(\w*)\s*\(([^)]*)\)\s*;?\s*$/;
+		var match = re.exec(str);
+		if(!match) {
+			return -1;
+		}
+		var rType = utils.applyTypedefs(match[1]);
+		var name = match[2];
+		var args = match[3];
+
+		var argsRe = /([^,]+)(?:,|$)/g;
+		var argsTypes = [];
+		while((match = argsRe.exec(args)) !== null) {
+			var type = utils.applyTypedefs(match[1]);
+			argsTypes.push(type);
+		}
+		
+		var encodeString = "@encode(";
+		encodeString += rType + "(";
+		encodeString += argsTypes.join(", ") + "))";
+
+		var fun = dlsym(RTLD_DEFAULT, name);
+		if(fun !== null) {
+			encodeString += "(" + fun + ")";
+			if(load) {
+				return [name, utils.exec(encodeString)];
+			}
+		} else if(load) {
+			throw "Function couldn't be found with dlsym!";
+		}
+
+		return [name, encodeString];
+	};
+	
+	/*
+		Loads the function declaration in the defs array using utils.exec and exposes to cycript's global scope
+		Is automatically called if shouldLoadCFuncs is true
+	*/
+	utils.funcs = {};
+	utils.loadfuncs = function(expose) {
+		for(var i = 0; i < CFuncsDeclarations.length; i++) {
+			try {
+				var o = utils.include(CFuncsDeclarations[i], true);
+				utils.funcs[o[0]] = o[1];
+				if(expose) {
+					Cycript.all[o[0]] = o[1];
+				}
+			} catch(e) {
+				system.print("Failed to load function: " + i);
+				try {
+					system.print(utils.include(CFuncsDeclarations[i]));
+				} catch(e2) {
+					
+				}
+			}
+		}
+	};
+	
+	/*
+		Calculates the size of a type like the C operator sizeof
+		
+		Usage:
+			cy# utils.sizeof(int)
+			4
+			cy# utils.sizeof(@encode(void *))
+			8
+			cy# utils.sizeof("mach_vm_address_t")
+			8
+	*/
+	utils.sizeof = function(type) {
+		if(typeof type === "string") {
+			type = utils.applyTypedefs(type);
+			type = utils.exec("@encode(" + type + ")");
+		}
+		
+		// (const) char * has "infinite" preceision
+		if(type.toString().slice(-1) === "*") {
+			return utils.sizeof(@encode(void *));
+		}
+		
+		// float and double
+		if(type.toString() === @encode(float).toString()) {
+			return 4;
+		} else if (type.toString() === @encode(double).toString()) {
+			return 8;
+		}
+
+		var typeInstance = type(0);
+		
+		if(typeInstance instanceof Object) {
+			// Arrays
+			if("length" in typeInstance) {
+				return typeInstance.length * utils.sizeof(typeInstance.type);
+			}
+			
+			// Structs
+			if(typeInstance.toString() === "[object Struct]") {
+				var typeStr = type.toString();
+				var arrayTypeStr = "[2" + typeStr + "]";
+				var arrayType = new Type(arrayTypeStr);
+				
+				var arrayInstance = new arrayType;
+				
+				return @encode(void *)(&(arrayInstance[1])) - @encode(void *)(&(arrayInstance[0]));
+			}
+		}
+		
+		for(var i = 0; i < 5; i++) {
+			var maxSigned = Math.pow(2, 8 * Math.pow(2, i) - 1) - 1;
+			if(i === 3) {
+				// Floating point fix ;^)
+				maxSigned /= 1000;
+			}
+
+			// can't use !== or sizeof(void *) === 0.5
+			if(type(maxSigned) != maxSigned) {
+				return Math.pow(2, i - 1);
+			}
+		}
+	};
+	
+	/*
+		Logs a specific message sent to an instance of a class like logify.pl in theos
+		Requires Cydia Substrate (com.saurik.substrate.MS) and NSLog (org.cycript.NSLog) modules
+		Returns the old message returned by MS.hookMessage (Note: this is not just the old message!)
+		
+		Usage:
+			cy# var oldm = utils.logify(objc_getMetaClass(NSNumber), @selector(numberWithDouble:))
+			...
+			cy# var n = [NSNumber numberWithDouble:1.5]
+			2014-07-28 02:26:39.805 cycript[71213:507] +[<NSNumber: 0x10032d0c4> numberWithDouble:1.5]
+			2014-07-28 02:26:39.806 cycript[71213:507]  = 1.5
+			@1.5
+	*/
+	utils.logify = function(cls, sel) {
+		@import com.saurik.substrate.MS;
+		@import org.cycript.NSLog;
+		
+		var oldm = {};
+		
+		MS.hookMessage(cls, sel, function() {
+			var args = [].slice.call(arguments);
+			
+			var selFormat = sel.toString().replace(/:/g, ":%@ ").trim();
+			var logFormat = "%@[<%@: 0x%@> " + selFormat + "]";
+			
+			var standardArgs = [logFormat, class_isMetaClass(cls)? "+": "-", cls.toString(), (&this).valueOf().toString(16)];
+			var logArgs = standardArgs.concat(args);
+			
+			NSLog.apply(null, logArgs);
+			
+			var r = oldm->apply(this, arguments);
+			
+			if(r !== undefined) {
+				NSLog(" = %@", r);
+			}
+			
+			return r;
+		}, oldm);
+		
+		return oldm;
+	};
+	
+	/*
+		Calls a C function by providing its name and arguments
+		Doesn't support structs
+		Return value is always a void pointer
+		
+		Usage:
+			cy# utils.apply("printf", ["%s %.3s, %d -> %c, float: %f\n", "foo", "barrrr", 97, 97, 1.5])
+			foo bar, 97 -> a, float: 1.500000
+			0x22
+	*/
+	utils.apply = function(fun, args) {
+		if(!(args instanceof Array)) {
+			throw "Args needs to be an array!";
+		}
+		
+		var argc = args.length;
+		var voidPtr = @encode(void *);
+		var argTypes = [];
+		for(var i = 0; i < argc; i++) {
+			var argType = voidPtr;
+			
+			var arg = args[i];
+			if(typeof arg === "string") {
+				argType = @encode(char *);
+			}
+			if(typeof arg === "number" && arg % 1 !== 0) {
+				argType = @encode(double);
+			}
+			
+			argTypes.push(argType);
+		}
+		
+		var type = voidPtr.functionWith.apply(voidPtr, argTypes);
+		
+		if(typeof fun === "string") {
+			fun = dlsym(RTLD_DEFAULT, fun);
+		}
+		
+		if(!fun) {
+			throw "Function not found!";
+		}
+
+		return type(fun).apply(null, args);
+	};
+	
+	/*
+		Converts a string (char *) to a void pointer (void *)
+		You can't cast to strings to void pointers and vice versa in cycript. Blame saurik.
+		
+		Usage:
+			cy# var voidPtr = utils.str2voidPtr("foobar")
+			0x100331590
+			cy# utils.voidPtr2str(voidPtr)
+			"foobar"
+	*/
+	utils.str2voidPtr = function(str) {
+		var strdup = @encode(void *(char *))(dlsym(RTLD_DEFAULT, "strdup"));
+		return strdup(str);
+	};
+	
+	/*
+		The inverse function of str2voidPtr
+	*/
+	utils.voidPtr2str = function(voidPtr) {
+		var strdup = @encode(char *(void *))(dlsym(RTLD_DEFAULT, "strdup"));
+		return strdup(voidPtr);
+	};
+	
+	/*
+		Converts a double into a void pointer
+		This can be used to view the binary representation of a floating point number
+		
+		Usage:
+			cy# var n = utils.double2voidPtr(-1.5)
+			0xbff8000000000000
+			cy# utils.voidPtr2double(n)
+			-1.5
+	*/
+	utils.double2voidPtr = function(n) {
+		var doublePtr = new double;
+		*doublePtr = n;
+		
+		var voidPtrPtr = @encode(void **)(doublePtr);
+		
+		return *voidPtrPtr;
+	};
+	
+	/*
+		The inverse function of double2voidPtr
+	*/
+	utils.voidPtr2double = function(voidPtr) {
+		var voidPtrPtr = new @encode(void **);
+		*voidPtrPtr = voidPtr;
+		
+		var doublePtr = @encode(double *)(voidPtrPtr);
+		
+		return *doublePtr;
+	};
+	
+	/*
+		Determines in a safe way if a memory location is readable
+		
+		Usage:
+			cy# utils.isMemoryReadable(0)
+			false
+			cy# utils.isMemoryReadable(0x1337)
+			false
+			cy# utils.isMemoryReadable(NSObject)
+			true
+			cy# var a = malloc(100); utils.isMemoryReadable(a)
+			true
+	*/
+	utils.isMemoryReadable = function(ptr) {
+		if(typeof ptr === "string") {
+			return true;
+		}
+		
+		var fds = new @encode(int [2]);
+		utils.apply("pipe", [fds]);
+		var result = utils.apply("write", [fds[1], ptr, 1]) == 1;
+		
+		utils.apply("close", [fds[0]]);
+		utils.apply("close", [fds[1]]);
+		
+		return result;
+	};
+	
+	/*
+		Determines in a safe way if the memory location contains an Objective-C object
+
+		Usage:
+			cy# utils.isObject(0)
+			false
+			cy# utils.isObject(0x1337)
+			false
+			cy# utils.isObject(NSObject)
+			true
+			cy# utils.isObject(objc_getMetaClass(NSObject))
+			true
+			cy# utils.isObject([new NSObject init])
+			true
+			cy# var a = malloc(100); utils.isObject(a)
+			false
+			cy# *@encode(void **)(a) = NSObject; utils.isObject(a)
+			true
+	*/
+	utils.isObject = function(obj) {
+		obj = @encode(void *)(obj);
+		var lastObj = -1;
+		
+		function objc_isa_ptr(obj) {
+			// See http://www.sealiesoftware.com/blog/archive/2013/09/24/objc_explain_Non-pointer_isa.html
+			var objc_debug_isa_class_mask = 0x00000001fffffffa;
+			obj = (obj & 1)? (obj & objc_debug_isa_class_mask): obj;
+			
+			if((obj & (utils.sizeof(@encode(void *)) - 1)) != 0) {
+				return null;
+			} else {
+				return obj;
+			}
+		}
+		
+		function ptrValue(obj) {
+			return obj? obj.valueOf(): null;
+		}
+		
+		var foundMetaClass = false;
+		
+		for(obj = objc_isa_ptr(obj); utils.isMemoryReadable(obj); ) {
+			obj = *@encode(void **)(obj);
+			
+			if(ptrValue(obj) == ptrValue(lastObj)) {
+				foundMetaClass = true;
+				break;
+			}
+			
+			lastObj = obj;
+		}
+		
+		if(!foundMetaClass) {
+			return false;
+		}
+		
+		if(lastObj === -1 || lastObj === null) {
+			return false;
+		}
+		
+		var obj_class = objc_isa_ptr(@encode(void **)(obj)[1]);
+		
+		if(!utils.isMemoryReadable(obj_class)) {
+			return false;
+		}
+		
+		var metaclass = objc_isa_ptr(@encode(void **)(obj_class)[0]);
+		var superclass = objc_isa_ptr(@encode(void **)(obj_class)[1]);
+		
+		return ptrValue(obj) == ptrValue(metaclass) && superclass == null;
+	};
+	
+	/*
+		Creates a cycript struct type from a C struct definition
+		
+		Usage:
+			cy# var foo = makeStruct("int a; short b; char c; uint64_t d; double e;", "foo");
+			@encode(foo)
+			cy# var f = new foo
+			&{a:0,b:0,c:0,d:0,e:0}
+			cy# f->a = 100; f
+			&{a:100,b:0,c:0,d:0,e:0}
+			cy# *@encode(int *)(f)
+			100
+	*/
+	utils.makeStruct = function(str, name) {		
+		var fieldRe = /(?:\s|\n)*([^;]+\s*(?:\s|\*))([^;]+)\s*;/g;
+		
+		if(!name) {
+			name = "struct" + Math.floor(Math.random() * 100000);
+		}
+		var typeStr = "{" + name + "=";
+		
+		while((match = fieldRe.exec(str)) !== null) {
+			var fieldType = utils.applyTypedefs(match[1]);
+			var fieldName = match[2];
+			var encodedType = utils.exec("@encode(" + fieldType + ")").toString();
+			
+			typeStr += '"' + fieldName + '"' + encodedType;
+		}
+		
+		typeStr += "}";
+		
+		return new Type(typeStr);
+	};
+	
+	// Various constants
+	utils.constants = {
+		VM_PROT_NONE:       0x0,
+		VM_PROT_READ:       0x1,
+		VM_PROT_WRITE:      0x2,
+		VM_PROT_EXECUTE:    0x4,
+		VM_PROT_NO_CHANGE:  0x8,
+		VM_PROT_COPY:       0x10,
+		VM_PROT_WANTS_COPY: 0x10,
+		VM_PROT_IS_MASK:    0x40,
+	};
+	var c = utils.constants;
+	c.VM_PROT_DEFAULT = c.VM_PROT_READ | c.VM_PROT_WRITE;
+	c.VM_PROT_ALL =     c.VM_PROT_READ | c.VM_PROT_WRITE | c.VM_PROT_EXECUTE;
+	
+	if(shouldExposeConsts) {
+		for(var k in c) {
+			Cycript.all[k] = c[k];
+		}
+	}
+	
+	if(shouldExposeFuncs) {
+		for(var i = 0; i < funcsToExpose.length; i++) {
+			var name = funcsToExpose[i];
+			Cycript.all[name] = utils[name];
+		}
+	}
+	
+	if(shouldLoadCFuncs) {
+		utils.loadfuncs(shouldExposeCFuncs);
+	}
+})(exports);

samples/Dogescript/example.djs

@@ -0,0 +1,16 @@
+quiet
+ wow 
+    such language
+  very syntax
+        github recognized wow
+loud
+
+such language much friendly
+    rly friendly is true
+        plz console.loge with 'such friend, very inclusive'
+    but
+        plz console.loge with 'no love for doge'
+    wow
+wow
+
+module.exports is language

samples/E/Extends.E

@@ -0,0 +1,31 @@
+# from
+# http://wiki.erights.org/wiki/Walnut/Ordinary_Programming/Objects_and_Functions
+def makeVehicle(self) {
+    def vehicle {
+        to milesTillEmpty() {
+            return self.milesPerGallon() * self.getFuelRemaining()
+        }
+    }
+    return vehicle
+}
+
+def makeCar() {
+    var fuelRemaining := 20
+    def car extends makeVehicle(car) {
+        to milesPerGallon() {return 19}
+        to getFuelRemaining() {return fuelRemaining}
+    }
+    return car
+}
+
+def makeJet() {
+    var fuelRemaining := 2000
+    def jet extends makeVehicle(jet) {
+        to milesPerGallon() {return 2}
+        to getFuelRemaining() {return fuelRemaining}
+    }
+    return jet
+}
+
+def car := makeCar()
+println(`The car can go ${car.milesTillEmpty()} miles.`)

samples/E/Functions.E

@@ -0,0 +1,21 @@
+# from
+# http://wiki.erights.org/wiki/Walnut/Ordinary_Programming/Objects_and_Functions
+def makeCar(var name) {
+    var x := 0
+    var y := 0
+    def car {
+        to moveTo(newX,newY) {
+            x := newX
+            y := newY
+        }
+        to getX() {return x}
+        to getY() {return y}
+        to setName(newName) {name := newName}
+        to getName() {return name}
+    } 
+    return car
+}
+# Now use the makeCar function to make a car, which we will move and print
+def sportsCar := makeCar("Ferrari")
+sportsCar.moveTo(10,20)
+println(`The car ${sportsCar.getName()} is at X location ${sportsCar.getX()}`)

samples/E/Guards.E

@@ -0,0 +1,69 @@
+# from
+# http://wiki.erights.org/wiki/Walnut/Advanced_Topics/Build_your_Own_Guards
+def makeVOCPair(brandName :String) :near {
+
+    var myTempContents := def none {}
+
+    def brand {
+        to __printOn(out :TextWriter) :void {
+            out.print(brandName)
+        }
+    }
+
+    def ProveAuth {
+        to __printOn(out :TextWriter) :void {
+            out.print(`<$brandName prover>`)
+        }
+        to getBrand() :near { return brand }
+        to coerce(specimen, optEjector) :near {
+            def sealedBox {
+                to getBrand() :near { return brand }
+                to offerContent() :void {
+                    myTempContents := specimen
+                }
+            }
+            return sealedBox
+        }
+    }
+    def CheckAuth {
+        to __printOn(out :TextWriter) :void {
+            out.print(`<$brandName checker template>`)
+        }
+        to getBrand() :near { return brand }
+        match [`get`, authList :any[]] {
+            def checker {
+                to __printOn(out :TextWriter) :void {
+                    out.print(`<$brandName checker>`)
+                }
+                to getBrand() :near { return brand }
+                to coerce(specimenBox, optEjector) :any {
+                    myTempContents := null
+                    if (specimenBox.__respondsTo("offerContent", 0)) {
+                      # XXX Using __respondsTo/2 here is a kludge
+                        specimenBox.offerContent()
+                    } else {
+                        myTempContents := specimenBox
+                    }
+                    for auth in authList {
+                        if (auth == myTempContents) {
+                            return auth
+                        }
+                    }
+                    myTempContents := none
+                    throw.eject(optEjector,
+                                `Unmatched $brandName authorization`)
+                }
+            }
+        }
+        match [`__respondsTo`, [`get`, _]] {
+            true
+        }
+        match [`__respondsTo`, [_, _]] {
+            false
+        }
+        match [`__getAllegedType`, []] {
+            null.__getAllegedType()
+        }
+    }
+    return [ProveAuth, CheckAuth]
+}

samples/E/IO.E

@@ -0,0 +1,14 @@
+# E sample from
+# http://wiki.erights.org/wiki/Walnut/Ordinary_Programming/InputOutput
+#File objects for hardwired files:
+def file1 := <file:myFile.txt>
+def file2 := <file:/home/marcs/myFile.txt>
+
+#Using a variable for a file name:
+def filePath := "c:\\docs\\myFile.txt"
+def file3 := <file>[filePath]
+
+#Using a single character to specify a Windows drive
+def file4 := <file:c:/docs/myFile.txt>
+def file5 := <c:/docs/myFile.txt>
+def file6 := <c:\docs\myFile.txt>

samples/E/Promises.E

@@ -0,0 +1,9 @@
+# E snippet from
+# http://wiki.erights.org/wiki/Walnut/Distributed_Computing/Promises
+when (tempVow) -> {
+    #...use tempVow
+} catch prob {
+    #.... report problem
+} finally {
+    #....log event
+}

samples/E/minChat.E

@@ -0,0 +1,18 @@
+# from
+# http://wiki.erights.org/wiki/Walnut/Secure_Distributed_Computing/Auditing_minChat
+pragma.syntax("0.9")
+to send(message) {
+    when (friend<-receive(message)) -> {
+        chatUI.showMessage("self", message)
+    } catch prob {chatUI.showMessage("system", "connection lost")}
+}
+to receive(message) {chatUI.showMessage("friend", message)}
+to receiveFriend(friendRcvr) {
+    bind friend := friendRcvr        
+    chatUI.showMessage("system", "friend has arrived")
+}
+to save(file) {file.setText(makeURIFromObject(chatController))}
+to load(file) {
+    bind friend := getObjectFromURI(file.getText())
+    friend <- receiveFriend(chatController)
+}

samples/EmberScript/momentComponent.em

@@ -0,0 +1,23 @@
+class App.FromNowView extends Ember.View
+    tagName: 'time'
+    template: Ember.Handlebars.compile '{{view.output}}'
+    output: ~>
+        return moment(@value).fromNow()
+
+    didInsertElement: ->
+        @tick()
+
+    tick: ->
+        f = ->
+            @notifyPropertyChange 'output'
+            @tick()
+
+        nextTick = Ember.run.later(this, f, 1000)
+        @set 'nextTick', nextTick
+
+    willDestroyElement: ->
+        nextTick = @nextTick
+        Ember.run.cancel nextTick
+
+Ember.Handlebars.helper 'fromNow', App.FromNowView
+

samples/Forth/bitmap.frt

@@ -0,0 +1,8 @@
+\ Bit arrays.
+: bits ( u1 -- u2 ) 7 + 3 rshift ;
+: bitmap ( u "name" -- ) create bits here over erase allot
+   does> ( u -- a x ) over 3 rshift +  1 rot 7 and lshift ;
+: bit@ ( a x -- f ) swap c@ and ;
+: 1bit ( a x -- ) over c@ or swap c! ;
+: 0bit ( a x -- ) invert over c@ and swap c! ;
+: bit! ( f a x -- ) rot if 1bit else 0bit then ;

samples/Forth/enum.frt

@@ -0,0 +1,7 @@
+\ Implements ENUM.
+
+\ Double DOES>!
+: enum   create 0 ,  does> create dup @ 1 rot +! ,  does> @ ;
+
+\ But this is simpler.
+: enum   create 0 ,  does> dup @ constant 1 swap +! ;

samples/Forth/macros.frt

@@ -0,0 +1,8 @@
+\ Simplifies compiling words.
+
+: [[     ; immediate
+: '<>    >in @ ' swap >in ! <> ;
+: (]])   begin dup '<> while postpone postpone repeat drop ;
+: ]]     ['] [[ (]]) ; immediate
+
+( Usage:   : foo ]] dup * [[ ; immediate   : bar 42 foo . ; )

samples/Frege/CommandLineClock.fr

@@ -0,0 +1,44 @@
+{-- 
+    This program displays the
+    current time on stdandard output
+    every other second.
+    -}
+    
+module examples.CommandLineClock where
+
+data Date = native java.util.Date where
+    native new :: () -> IO (MutableIO Date)     -- new Date()
+    native toString :: Mutable s Date -> ST s String    -- d.toString()
+
+--- 'IO' action to give us the current time as 'String'
+current :: IO String
+current = do
+    d <- Date.new ()
+    d.toString
+
+{- 
+    "java.lang.Thread.sleep" takes a "long" and
+    returns nothing, but may throw an InterruptedException.
+    This is without doubt an IO action.
+    
+    public static void sleep(long millis)
+                  throws InterruptedException
+    
+    Encoded in Frege:
+    - argument type  long   Long
+    - result         void   ()
+    - does IO               IO ()
+    - throws ...            throws ....
+     
+-}
+-- .... defined in frege.java.Lang
+-- native sleep java.lang.Thread.sleep :: Long -> IO () throws InterruptedException
+
+      
+main args =  
+    forever do
+        current >>= print
+        print "\r"
+        stdout.flush
+        Thread.sleep 999
+                

samples/Frege/Concurrent.fr

@@ -0,0 +1,147 @@
+module examples.Concurrent where
+
+import System.Random
+import Java.Net (URL)
+import Control.Concurrent as C
+
+main2 args = do
+    m <- newEmptyMVar
+    forkIO do
+        m.put 'x'
+        m.put 'y' 
+        m.put 'z'
+    replicateM_ 3 do
+        c <- m.take
+        print "got: "
+        println c  
+        
+            
+example1 = do
+    forkIO (replicateM_ 100000 (putChar 'a'))
+    replicateM_ 100000 (putChar 'b')
+
+example2 =  do
+    s <- getLine
+    case s.long of
+        Right n -> forkIO (setReminder n) >> example2
+        Left _  -> println ("exiting ...")
+    
+setReminder :: Long -> IO ()
+setReminder n = do
+        println ("Ok, I remind you in " ++ show n ++ " seconds")
+        Thread.sleep (1000L*n)
+        println (show n ++ " seconds is up!")
+
+table = "table"
+            
+mainPhil _ = do
+    [fork1,fork2,fork3,fork4,fork5] <- mapM MVar.new [1..5]
+    forkIO (philosopher "Kant" fork5 fork1)
+    forkIO (philosopher "Locke" fork1 fork2)
+    forkIO (philosopher "Wittgenstein" fork2 fork3)
+    forkIO (philosopher "Nozick" fork3 fork4)
+    forkIO (philosopher "Mises" fork4 fork5)
+    return ()    
+
+philosopher :: String -> MVar Int -> MVar Int -> IO ()
+philosopher me left right = do
+    g <- Random.newStdGen
+    let phil g  = do
+            let (tT,g1) = Random.randomR (60L, 120L) g
+                (eT, g2)  = Random.randomR (80L, 160L) g1
+                thinkTime = 300L * tT
+                eatTime   = 300L * eT
+    
+            println(me ++ " is going to the dining room and takes his seat.") 
+            fl <- left.take            
+            println (me ++ " takes up left fork (" ++ show fl ++ ")")
+            rFork <- right.poll
+            case rFork of
+                Just fr -> do 
+                    println (me ++ " takes up right fork. (" ++ show fr ++ ")") 
+                    println (me ++ " is going to eat for " ++ show eatTime ++ "ms")
+                    Thread.sleep eatTime
+                    println (me ++ " finished eating.")
+                    right.put fr
+                    println (me ++ " took down right fork.")
+                    left.put fl
+                    println (me ++ " took down left fork.")
+                    table.notifyAll 
+                    println(me ++ " is going to think for " ++ show thinkTime ++ "ms.")
+                    Thread.sleep thinkTime
+                    phil g2
+                Nothing -> do
+                    println (me ++ " finds right fork is already in use.")
+                    left.put fl
+                    println (me ++ " took down left fork.")
+                    table.notifyAll
+                    println (me ++ " is going to the bar to await notifications from table.")
+                    table.wait
+                    println (me ++ " got notice that something changed at the table.")
+                    phil g2
+            
+        inter :: InterruptedException -> IO ()
+        inter _ = return ()        
+    
+    phil g `catch` inter
+
+    
+getURL xx = do
+        url <- URL.new xx 
+        con <- url.openConnection
+        con.connect
+        is  <- con.getInputStream
+        typ <- con.getContentType
+        -- stderr.println ("content-type is " ++ show typ) 
+        ir  <- InputStreamReader.new is (fromMaybe "UTF-8" (charset typ))
+            `catch` unsupportedEncoding is 
+        br  <- BufferedReader.new ir
+        br.getLines
+    where
+        unsupportedEncoding :: InputStream -> UnsupportedEncodingException -> IO InputStreamReader
+        unsupportedEncoding is x = do
+            stderr.println x.catched
+            InputStreamReader.new is "UTF-8"
+            
+        charset ctyp = do
+            typ <- ctyp
+            case typ of
+                m~´charset=(\S+)´ -> m.group 1
+                _ -> Nothing
+
+    
+type SomeException = Throwable
+
+main ["dining"] = mainPhil []
+        
+main _ =  do
+    m1 <- MVar.newEmpty
+    m2 <- MVar.newEmpty
+    m3 <- MVar.newEmpty
+    
+    forkIO do
+        r <- (catchAll . getURL) "http://www.wikipedia.org/wiki/Haskell"
+        m1.put r
+    
+    forkIO do
+        r <- (catchAll . getURL) "htto://www.wikipedia.org/wiki/Java"
+        m2.put r
+    
+    forkIO do
+        r <- (catchAll . getURL) "http://www.wikipedia.org/wiki/Frege"
+        m3.put r
+    
+    r1 <- m1.take
+    r2 <- m2.take
+    r3 <- m3.take
+    println (result r1, result r2, result r3)
+    -- case r3 of
+    --     Right ss -> mapM_ putStrLn ss
+    --     Left _   -> return ()
+  where
+    result :: (SomeException|[String]) -> (String|Int)
+    result (Left x)  = Left x.getClass.getName
+    result (Right y) = (Right . sum . map length)  y
+    -- mapM_ putStrLn r2
+
+        

samples/Frege/Sudoku.fr

@@ -0,0 +1,561 @@
+package examples.Sudoku where
+
+import Data.TreeMap (Tree, keys)
+import Data.List as DL hiding (find, union)
+
+
+type Element    = Int           -- 1,2,3,4,5,6,7,8,9
+type Zelle      = [Element]     -- set of candidates
+type Position   = Int           -- 0..80
+type Feld       = (Position, Zelle)
+type Brett      = [Feld]
+
+--- data type for assumptions and conclusions
+data Assumption =
+              !ISNOT Position Element
+            | !IS    Position Element
+
+
+derive Eq Assumption
+derive Ord Assumption
+instance Show Assumption where
+    show (IS p e)    = pname p ++ "=" ++ e.show
+    show (ISNOT p e) = pname p ++ "/" ++ e.show
+
+showcs cs = joined " " (map Assumption.show cs)
+
+elements :: [Element]           -- all possible elements
+elements = [1 .. 9]
+
+{-
+    a  b  c   d  e  f   g  h  i
+     0  1  2 | 3  4  5 | 6  7  8    1
+     9 10 11 |12 13 14 |15 16 17    2
+    18 19 20 |21 22 23 |24 25 26    3
+    ---------|---------|--------
+    27 28 29 |30 31 32 |33 34 35    4
+    36 37 38 |39 40 41 |42 43 44    5
+    45 46 47 |48 49 50 |51 52 53    6
+    ---------|---------|--------
+    54 55 56 |57 58 59 |60 61 62    7
+    63 64 65 |66 67 68 |69 70 71    8
+    72 73 74 |75 76 77 |78 79 80    9
+-}
+
+positions :: [Position]         -- all possible positions
+positions = [0..80]
+rowstarts :: [Position]         -- all positions where a row is starting
+rowstarts =  [0,9,18,27,36,45,54,63,72]
+colstarts :: [Position]         -- all positions where a column is starting
+colstarts =  [0,1,2,3,4,5,6,7,8]
+boxstarts :: [Position]         -- all positions where a box is starting
+boxstarts =  [0,3,6,27,30,33,54,57,60]
+boxmuster :: [Position]         -- pattern for a box, by adding upper left position results in real box
+boxmuster =  [0,1,2,9,10,11,18,19,20]
+
+
+--- extract field for position
+getf :: Brett -> Position  -> Feld
+getf (f:fs) p
+    | fst f == p = f
+    | otherwise  = getf fs p
+getf [] p = (p,[])
+
+
+--- extract cell for position
+getc :: Brett -> Position -> Zelle
+getc b p = snd (getf b p)
+
+--- compute the list of all positions that belong to the same row as a given position
+row :: Position -> [Position]
+row p = [z..(z+8)] where z = (p `quot` 9) * 9
+
+--- compute the list of all positions that belong to the same col as a given position
+col :: Position -> [Position]
+col p = map (c+) rowstarts where c = p `mod` 9
+
+--- compute the list of all positions that belong to the same box as a given position
+box :: Position -> [Position]
+box p  = map (z+) boxmuster where
+    ri = p `div` 27 * 27    -- 0, 27 or 54, depending on row
+    ci = p `mod` 9          -- column index 0..8, 0,1,2 is left, 3,4,5 is middle, 6,7,8 is right
+    cs = ci `div` 3 * 3     -- 0, 3 or 6
+    z  = ri + cs
+
+--- check if candidate set has exactly one member, i.e. field has been solved
+single :: Zelle -> Bool
+single [_] = true
+single _   = false
+
+unsolved :: Zelle -> Bool
+unsolved [_] = false
+unsolved _   = true
+
+-- list of rows, cols, boxes
+allrows = map row rowstarts
+allcols = map col colstarts
+allboxs = map box boxstarts
+allrcb  = zip (repeat "row") allrows
+          ++ zip (repeat "col") allcols
+          ++ zip (repeat "box") allboxs
+
+
+containers :: [(Position -> [Position], String)]
+containers = [(row, "row"), (col, "col"), (box, "box")]
+
+-- ----------------- PRINTING ------------------------------------
+-- printable coordinate of field, upper left is a1, lower right is i9
+pname p = packed [chr (ord 'a' + p `mod` 9), chr (ord '1' + p `div` 9)]
+
+-- print board
+printb b = mapM_ p1line allrows >> println ""
+    where
+        p1line row = do
+                print (joined "" (map pfld line))
+            where line = map (getc b) row
+
+-- print field (brief)
+--   ? = no candidate
+--   5 = field is 5
+--   . = some candidates
+pfld [] = "?"
+pfld [x] = show x
+pfld zs = "0"
+
+-- print initial/final board
+result msg b = do
+        println ("Result: " ++ msg)
+        print   ("Board: ")
+        printb b
+        return b
+
+res012 b = case concatMap (getc b) [0,1,2] of
+    [a,b,c] -> a*100+b*10+c
+    _ -> 9999999
+
+-- -------------------------- BOARD ALTERATION ACTIONS ---------------------------------
+-- print a message about what is done to the board and return the new board
+turnoff1 :: Position -> Zelle -> Brett -> IO Brett
+turnoff1 i off b
+    | single nc = do
+            -- print (pname i)
+            -- print ": set to "
+            -- print (head nc)
+            -- println " (naked single)"
+            return newb
+    | otherwise = return newb
+    where
+        cell   = getc b i
+        nc     = filter (`notElem` off) cell
+        newb   = (i, nc) : [ f | f <- b, fst f != i ]
+
+turnoff :: Int -> Zelle -> String -> Brett -> IO Brett
+turnoff i off msg b = do
+        -- print (pname i)
+        -- print ": set to "
+        -- print nc
+        -- print " by clearing "
+        -- print off
+        -- print " "
+        -- println  msg
+        return newb
+    where
+        cell   = getc b i
+        nc     = filter (`notElem` off) cell
+        newb   = (i, nc) : [ f | f <- b, fst f != i ]
+
+turnoffh ps off msg b = foldM toh b ps
+    where
+        toh b p = turnoff p off msg b
+
+setto :: Position -> Element -> String -> Brett -> IO Brett
+setto i n cname b = do
+        -- print (pname i)
+        -- print ": set to "
+        -- print n
+        -- print " (hidden single in "
+        -- print cname
+        -- println ")"
+        return newb
+    where
+        nf     = [n]
+        newb   = (i, nf) : [ f | f <- b, fst f != i ]
+
+
+-- ----------------------------- SOLVING STRATEGIES ---------------------------------------------
+-- reduce candidate sets that contains numbers already in same row, col or box
+-- This finds (and logs) NAKED SINGLEs in passing.
+reduce b = [  turnoff1 p sss | (p,cell) <- b,               -- for each field
+                unsolved cell,                              --  with more than 1 candidate
+                --       single fields in containers that are candidates of that field
+                sss = [ s | (rcb, _) <- containers, [s] <- map (getc b) (rcb p), s `elem` cell],
+                sss != [] ]                                     -- collect field index, elements to remove from candidate set
+
+-- look for a number that appears in exactly 1 candidate set of a container
+-- this number can go in no other place (HIDDEN SINGLE)
+hiddenSingle b = [ setto i n cname |                     -- select index, number, containername
+            (cname, rcb) <- allrcb,                 -- FOR rcb IN allrcb
+            n <- elements,                          --  FOR n IN elements
+            fs     = filter (unsolved • snd) (map (getf b) rcb),
+            occurs  = filter ((n `elem`) • snd) fs,
+            length occurs == 1,
+            (i, _) <- occurs ]
+
+-- look for NAKED PAIRS, TRIPLES, QUADS
+nakedPair n b = [ turnoff p t ("(naked tuple in " ++ nm ++ ")") |           -- SELECT pos, tuple, name
+            -- n <- [2,3,4],                    //  FOR n IN [2,3,4]
+            (nm, rcb) <- allrcb,             --    FOR rcb IN containers
+            fs = map (getf b) rcb,              --      let fs = fields for rcb positions
+            u  = (fold union [] . filter unsolved . map snd) fs,   -- let u = union of non single candidates
+            t <- n `outof` u,                   --      FOR t IN n-tuples
+            hit = (filter ((`subset` t) . snd) . filter (unsolved . snd)) fs,
+            length hit == n,
+            (p, cell) <- fs,
+            p `notElem` map fst hit,
+            any (`elem` cell) t
+            ]
+
+-- look for HIDDEN PAIRS, TRIPLES or QUADS
+hiddenPair n b = [ turnoff p off ("(hidden " ++ show t ++ " in " ++ nm ++ ")") |           -- SELECT pos, tuple, name
+            -- n <- [2,3,4],                    //  FOR n IN [2,3,4]
+            (nm, rcb) <- allrcb,             --    FOR rcb IN containers
+            fs = map (getf b) rcb,              --      let fs = fields for rcb positions
+            u  = (fold union [] . filter ((>1) . length) . map snd) fs,   -- let u = union of non single candidates
+            t <- n `outof` u,                   --      FOR t IN n-tuples
+            hit = (filter (any ( `elem` t) . snd) . filter (unsolved . snd)) fs,
+            length hit == n,
+            off = (fold union [] . map snd) hit `minus` t,
+            off != [],
+            (p, cell) <- hit,
+            ! (cell `subset` t)
+            ]
+
+a `subset` b = all (`elem` b) a
+a `union`  b = uniq (sort (a ++ b))
+a `minus`  b = filter (`notElem` b) a
+a `common` b = filter (`elem` b) a
+n `outof` as
+    | length as < n = []
+    | [] <- as      = []
+    | 1 >= n        = map (:[]) as
+    | (a:bs) <- as  = map (a:) ((n-1) `outof` bs) ++ (n `outof` bs)
+    | otherwise     = undefined  -- cannot happen because either as is empty or not
+
+same f a b = b `elem` f a
+
+intersectionlist = [(allboxs, row, "box/row intersection"), (allboxs, col, "box/col intersection"),
+                    (allrows ++ allcols, box, "line/box intersection")]
+intersections b = [
+    turnoff pos [c] reason |    -- SELECT position, candidate, reson
+        (from, container, reason) <- intersectionlist,
+        rcb <- from,
+        fs = (filter (unsolved . snd) . map (getf b)) rcb,        -- fs = fields in from with more than 1 candidate
+        c <- (fold union [] • map snd) fs,                          -- FOR c IN union of candidates
+        cpos = (map fst • filter ((c `elem`) • snd)) fs,            -- cpos = positions where c occurs
+        cpos != [],                                                 -- WHERE cpos is not empty
+        all (same container (head cpos)) (tail cpos),               -- WHERE all positions are in the intersection
+        -- we can remove all occurences of c that are in container, but not in from
+        (pos, cell) <- map (getf b) (container (head cpos)),
+        c `elem` cell,
+        pos `notElem` rcb ]
+
+
+-- look for an XY Wing
+--  - there exists a cell A with candidates X and Y
+--  - there exists a cell B with candidates X and Z that shares a container with A
+--  - there exists a cell C with candidates Y and Z that shares a container with A
+-- reasoning
+--  - if A is X, B will be Z
+--  - if A is Y, C will be Z
+--  - since A will indeed be X or Y -> B or C will be Z
+--  - thus, no cell that can see B and C can be Z
+xyWing board = [ turnoff p [z] ("xy wing " ++ pname b ++ " " ++ pname c ++ " because of " ++ pname a) |
+        (a, [x,y]) <- board,                            -- there exists a cell a with candidates x and y
+        rcba = map (getf board) (row a ++ col a ++ box a),  -- rcba = all fields that share a container with a
+        (b, [b1, b2]) <- rcba,
+        b != a,
+        b1 == x && b2 != y || b2 == x && b1 != y,       -- there exists a cell B with candidates x and z
+        z = if b1 == x then b2 else b1,
+        (c, [c1, c2]) <- rcba,
+        c != a, c!= b,
+        c1 == y && c2 == z || c1 == z && c2 == y,       -- there exists a cell C with candidates y and z
+        ps = (uniq . sort) ((row b ++ col b ++ box b) `common` (row c ++ col c ++ box c)),
+        -- remove z in ps
+        (p, cs) <- map (getf board) ps,
+        p != b, p != c,
+        z `elem` cs ]
+
+-- look for a N-Fish (2: X-Wing, 3: Swordfish, 4: Jellyfish)
+-- When all candidates for a particular digit in N rows are located
+-- in only N columns, we can eliminate all candidates from those N columns
+--  which are not located on those N rows
+fish n board = fish "row" allrows row col ++ fish "col" allcols col row where
+    fishname 2 = "X-Wing"
+    fishname 3 = "Swordfish"
+    fishname 4 = "Jellyfish"
+    fishname _ = "unknown fish"
+    fish nm allrows row col = [ turnoff p [x] (fishname n ++ " in " ++ nm ++ " " ++ show (map (pname . head) rset)) |
+        rset <- n `outof` allrows,          -- take n rows (or cols)
+        x <- elements,                      -- look for certain number
+        rflds = map (filter ((>1) . length . snd) . map (getf board)) rset,       -- unsolved fields in the rowset
+        colss  = (map (map (head . col . fst) . filter ((x `elem`) . snd)) rflds),   -- where x occurs in candidates
+        all ((>1) . length) colss,         -- x must appear in at least 2 cols
+        cols = fold union [] colss,
+        length cols == n,
+        cstart <- cols,
+        (p, cell) <- map (getf board) (col cstart),
+        x `elem` cell,
+        all (p `notElem`) rset]
+
+
+-- compute immediate consequences of an assumption of the form (p `IS` e) or (p `ISNOT` e)
+conseq board (IS p e) = uniq (sort ([ p `ISNOT` x | x <- getc board p, x != e ] ++
+    [ a `ISNOT` e |
+        (a,cs) <- map (getf board) (row p ++ col p ++ box p),
+        a != p,
+        e `elem` cs
+    ]))
+conseq board (ISNOT p  e) = uniq (sort ([ p `IS` x | cs = getc board p, length cs == 2, x <- cs, x != e ] ++
+    [ a `IS` e |
+        cp <- [row p, box p, col p],
+        as = (filter ((e `elem`) . getc board) . filter (p!=)) cp,
+        length as == 1,
+        a = head as
+    ]))
+
+-- check if two assumptions contradict each other
+contradicts (IS a x)    (IS b y)    = a==b && x!=y
+contradicts (IS a x)    (ISNOT b y) = a==b && x==y
+contradicts (ISNOT a x) (IS b y)    = a==b && x==y
+contradicts (ISNOT _ _) (ISNOT _ _) = false
+
+-- get the Position of an Assumption
+aPos (IS p _)    = p
+aPos (ISNOT p _) = p
+
+-- get List of elements that must be turned off when assumption is true/false
+toClear board true  (IS p x)    = filter (x!=) (getc board p)
+toClear board false (IS p x)    = [x]
+toClear board true  (ISNOT p x) = [x]
+toClear board false (ISNOT p x) = filter (x!=) (getc board p)
+
+
+-- look for assumptions whose implications contradict themself
+chain board paths = [ solution a (head cs) (reverse cs) |
+        (a, css) <-  paths,
+        cs <- take 1 [ cs | cs <- css, contradicts a (head cs) ]
+        ]
+    where
+        solution a c cs = turnoff (aPos a) (toClear board false a) reason where
+            reason = "Assumption " ++ show a ++ " implies " ++ show c ++ "\n\t"
+                ++ showcs cs ++ "\n\t"
+                ++ "Therefore, " ++ show a ++ " must be false."
+
+-- look for an assumption that yields to contradictory implications
+-- this assumption must be false
+chainContra board paths = [ solution a (reverse pro) (reverse contra) |
+        (a, css) <- paths,          -- FOR ALL assumptions "a" with list of conlusions "css"
+        (pro, contra) <- take 1 [ (pro, contra) |
+            pro <- (uniqBy (using head) . sortBy (comparing head)) css,                 -- FOR ALL conslusion chains "pro"
+            c = head pro,               -- LET "c" BE the final conclusion
+            contra <- take 1 (filter ((contradicts c) . head) css)   -- THE FIRST conclusion that contradicts c
+        ]
+      ]
+    where
+        solution a pro con = turnoff (aPos a) (toClear board false a) reason where
+            reason = ("assumption " ++ show a ++ " leads to contradictory conclusions\n\t"
+                        ++ showcs pro ++ "\n\t" ++ showcs con)
+
+
+
+-- look for a common implication c of some assumptions ai, where at least 1 ai is true
+-- so that (a0 OR a1 OR a2 OR ...) IMPLIES c
+-- For all cells pi in same container that have x as candidate, we can construct (p0==x OR p1==x OR ... OR pi==x)
+-- For a cell p with candidates ci, we can construct (p==c0 OR p==c1)
+cellRegionChain board paths = [ solution b as (map head os) |
+        as <- cellas ++ regionas,           -- one of as must be true
+        iss = filter ((`elem` as) . fst) paths,    -- the implications for as
+        (a, ass) <- take 1 iss,             -- implications for first assumption
+        fs <- (uniqBy (using head) . sortBy (comparing head)) ass,
+        b = head fs,                        -- final conclusions of first assumption
+        os = [fs] : map (take 1 . filter ((b==) . head) . snd) (tail iss), -- look for implications with same conclusion
+        all ([]!=) os]
+    where
+        cellas   = [ map (p `IS`) candidates | (p, candidates@(_:_:_)) <- board ]
+        regionas = [ map (`IS` e) ps |
+            region <- map (map (getf board)) (allrows ++ allcols ++ allboxs),
+            e <- elements,
+            ps = map fst (filter ((e `elem`) . snd) region),
+            length ps > 1 ]
+        solution b as oss = turnoff (aPos b) (toClear board true b) reason where
+            reason = "all of the assumptions " ++ joined ", " (map show as) ++ " imply " ++ show b ++ "\n\t"
+                ++ joined "\n\t" (map (showcs . reverse) oss) ++ "\n\t"
+                ++ "One of them must be true, so " ++ show b ++ " must be true."
+
+
+{-
+    Wir brauchen für einige Funktionen eine Datenstruktur wie
+        [ (Assumption, [[Assumption]]) ]
+    d.i. eine Liste von möglichen Annahmen samt aller Schlußketten.
+    Idealerweise sollte die Schlußkette in umgekehrter Reihenfolge vorliegen,
+    dann kann man einfach finden:
+    - Annahmen, die zum Selbstwiderspruch führen.
+    - alles, was aus einer bestimmten Annahme folgt (map (map head) [[a]])
+    -...
+-}
+--- Liste aller Annahmen für ein bestimmtes Brett
+assumptions :: Brett -> [Assumption]
+assumptions board = [ a |
+                (p, cs) <- board,
+                !(single cs),
+                a <- map (ISNOT p) cs ++ map (IS p) cs ]
+
+consequences :: Brett -> [Assumption] -> [[Assumption]]
+consequences board as = map (conseq board) as
+
+acstree :: Brett -> Tree Assumption [Assumption]
+acstree board = Tree.fromList (zip as cs)
+    where
+        as = assumptions  board
+        cs = consequences board as
+
+-- bypass maybe on tree lookup
+find :: Tree Assumption [Assumption] -> Assumption -> [Assumption]
+find t a
+    | Just cs <- t.lookup a = cs
+    | otherwise = error ("no consequences for " ++ show a)
+
+-- for performance resons, we confine ourselves to implication chains of length 20 per assumption
+mkPaths :: Tree Assumption [Assumption] -> [ (Assumption, [[Assumption]]) ]
+mkPaths acst = map impl  (keys acst)   -- {[a1], [a2], [a3] ]
+    where
+        -- [Assumption] -> [(a, [chains, ordered by length]
+        impl a = (a, impls [[a]])
+        impls ns = (take 1000 • concat • takeUntil null • iterate expandchain) ns
+        -- expandchain :: [[Assumption]] -> [[Assumption]]
+        expandchain css = [ (n:a:as) |
+            (a : as) <- css,               -- list of assumptions
+            n <- find acst a,              -- consequences of a
+            n `notElem` as                 -- avoid loops
+          ]
+        -- uni (a:as) = a : uni (filter ((head a !=) • head) as)
+        -- uni [] = empty
+        -- empty = []
+
+
+-- ------------------ SOLVE A SUDOKU --------------------------
+-- Apply all available strategies until nothing changes anymore
+-- Strategy functions are supposed to return a list of
+-- functions, which, when applied to a board, give a changed board.
+-- When a strategy does not find anything to alter,
+-- it returns [], and the next strategy can be tried.
+solve b
+    | all (single . snd) b       = result "Solved" b
+    | any (([]==) . snd) b       = result "not solvable" b
+    | res@(_:_) <- reduce b       = apply b res >>=solve       -- compute smallest candidate sets
+    -- comment "candidate sets are up to date" = ()
+    | res@(_:_) <- hiddenSingle b  = apply b res >>= solve     -- find HIDDEN SINGLES
+    -- comment "no more hidden singles" = ()
+    | res@(_:_) <- intersections b = apply b res >>= solve     -- find locked candidates
+    -- comment "no more intersections" = ()
+    | res@(_:_) <- nakedPair 2 b     = apply b res >>= solve     -- find NAKED PAIRS, TRIPLES or QUADRUPELS
+    -- comment "no more naked pairs" = ()
+    | res@(_:_) <- hiddenPair  2 b   = apply b res >>= solve      -- find HIDDEN PAIRS, TRIPLES or QUADRUPELS
+    -- comment "no more hidden pairs" = ()
+    -- res@(_:_) <- nakedPair 3 b     = apply b res >>= solve       // find NAKED PAIRS, TRIPLES or QUADRUPELS
+    -- | comment "no more naked triples" = ()
+    -- res@(_:_) <- hiddenPair  3 b    = apply b res >>= solve      // find HIDDEN PAIRS, TRIPLES or QUADRUPELS
+    -- | comment "no more hidden triples" = ()
+    -- res@(_:_) <- nakedPair 4 b     = apply b res >>=solve       // find NAKED PAIRS, TRIPLES or QUADRUPELS
+    -- | comment "no more naked quadruples" = ()
+    -- res@(_:_) <- hiddenPair  4 b    = apply b res >>=solve      // find HIDDEN PAIRS, TRIPLES or QUADRUPELS
+    -- | comment "no more hidden quadruples" = ()
+    | res@(_:_) <- xyWing b            = apply b res >>=solve      -- find XY WINGS
+    -- comment "no more xy wings"       = ()
+    | res@(_:_) <- fish 2 b            = apply b res >>=solve      -- find 2-FISH
+    -- comment "no more x-wings"        = ()
+    -- res@(_:_) <- fish 3 b            = apply b res >>=solve      // find 3-FISH
+    -- | comment "no more swordfish"      = ()
+    -- res@(_:_) <- fish 4 b            = apply b res >>=solve      // find 4-FISH
+    -- | comment "no more jellyfish"      = ()
+    -- | comment pcomment                 = ()
+    | res@(_:_) <- chain b paths             = apply b (take 9 res) >>= solve  -- find forcing chains
+    | res@(_:_) <- cellRegionChain b paths   = apply b (take 9 res) >>= solve  -- find common conclusion for true assumption
+    | res@(_:_) <- chainContra b paths       = apply b (take 9 res) >>= solve  -- find assumptions that allow to infer both a and !a
+    -- comment "consistent conclusions only"       = ()
+
+    | otherwise = result "ambiguous" b
+    where
+        apply brd fs = foldM (\b\f -> f b) brd fs
+        paths = mkPaths (acstree b)
+        -- pcomment = show (length paths) ++ " assumptions with " ++ show (fold (+) 0 (map (length <~ snd) paths))
+        --    ++ " implication chains"
+
+-- comment com = do stderr << com << "\n" for false
+-- log com     = do stderr << com << "\n" for true
+
+--- turn a string into a row
+mkrow :: String -> [Zelle]
+mkrow s = mkrow1 xs
+    where
+        xs = s ++ "---------" -- make sure at least 9 elements
+        mkrow1 xs = (take 9 • filter ([]!=) • map f • unpacked) xs
+        f x | x >= '1' && x <= '9'  =  [ord x - ord '0']
+            | x == ' '  = []    -- ignored
+            | otherwise = elements
+
+main ["-h"]    = main []
+main ["-help"] = main []
+main [] = do
+        mapM_ stderr.println [
+            "usage: java Sudoku file ...",
+            "       java Sudoku position",
+            "where position is a 81 char string consisting of digits",
+            "One can get such a string by going to",
+            "http://www.sudokuoftheday.com/pages/s-o-t-d.php",
+            "Right click on the puzzle and open it in new tab",
+            "Copy the 81 digits from the URL in the address field of your browser.",
+            "",
+            "There is also a file with hard sudokus in examples/top95.txt\n"]
+        return ()
+
+
+main [s@#^[0-9\W]{81}$#] = solve board >> return ()
+    where
+        board = zip positions felder
+        felder = decode s
+
+main files = forM_ files sudoku
+    where
+        sudoku file = do
+            br <- openReader file
+            lines <- BufferedReader.getLines br
+            bs <- process lines
+            ss <- mapM (\b -> print "Puzzle: " >> printb b >> solve b) bs
+            println ("Euler: " ++ show (sum (map res012 ss)))
+            return ()
+
+-- "--3-" => [1..9, 1..9, [3], 1..9]
+decode s = map candi (unpacked s) where
+        candi c | c >= '1' && c <= '9'  = [(ord c - ord '0')]
+                | otherwise = elements
+process [] = return []
+process (s:ss)
+    | length s == 81 = consider b1
+    | length s == 9,
+      length acht == 8,
+      all ((9==) • length) acht = consider b2
+    | otherwise = do
+            stderr.println ("skipped line: " ++ s)
+            process ss
+    where
+        acht = take 8 ss
+        neun = fold (++) "" (s:acht)
+        b1 = zip positions (decode s)
+        b2 = zip positions (decode neun)
+        consider b = do
+            -- print "Puzzle: "
+            -- printb b
+            bs <- process ss
+            return (b:bs)
+

samples/Frege/SwingExamples.fr

@@ -0,0 +1,79 @@
+package examples.SwingExamples where
+
+import Java.Awt  (ActionListener)
+import Java.Swing
+
+
+main _ = do
+    rs <- mapM Runnable.new [helloWorldGUI, buttonDemoGUI, celsiusConverterGUI]
+    mapM_ invokeLater rs
+    println "Hit enter to end ...."
+    s <- getLine
+    return ()
+
+celsiusConverterGUI = do
+    tempTextField   <- JTextField.new()
+    celsiusLabel    <- JLabel.new ()
+    convertButton   <- JButton.new ()
+    fahrenheitLabel <- JLabel.new () 
+    frame           <- JFrame.new ()
+    frame.setDefaultCloseOperation JFrame.dispose_on_close
+    frame.setTitle "Celsius Converter"
+    celsiusLabel.setText  "Celsius"
+    convertButton.setText "Convert"
+    let convertButtonActionPerformed _ = do
+            celsius <- tempTextField.getText
+            case celsius.double of
+                Left _  -> fahrenheitLabel.setText ("not a valid number: " ++ celsius)
+                Right c -> fahrenheitLabel.setText (show (c*1.8 + 32.0).long ++ " Fahrenheit") 
+            return ()
+    ActionListener.new convertButtonActionPerformed >>= convertButton.addActionListener
+    fahrenheitLabel.setText "Fahrenheit"
+    contentPane <- frame.getContentPane
+    layout      <- GroupLayout.new contentPane
+    contentPane.setLayout layout
+    -- TODO continue
+    -- http://docs.oracle.com/javase/tutorial/displayCode.html?code=http://docs.oracle.com/javase/tutorial/uiswing/examples/learn/CelsiusConverterProject/src/learn/CelsiusConverterGUI.java
+    frame.pack
+    frame.setVisible true
+
+helloWorldGUI = do
+    frame <- JFrame.new "Hello World Frege"
+    frame.setDefaultCloseOperation(JFrame.dispose_on_close)
+    label <- JLabel.new "Hello World!"
+    cp <- frame.getContentPane
+    cp.add label
+    frame.pack
+    frame.setVisible true
+
+buttonDemoGUI = do
+    frame <- JFrame.new "Button Demo"
+    frame.setDefaultCloseOperation(JFrame.dispose_on_close)
+    newContentPane <- JPanel.new ()
+    b1::JButton <- JButton.new "Disable middle button"
+    b1.setVerticalTextPosition   SwingConstants.center
+    b1.setHorizontalTextPosition SwingConstants.leading
+    b2::JButton <- JButton.new "Middle button"
+    b2.setVerticalTextPosition   SwingConstants.center
+    b2.setHorizontalTextPosition SwingConstants.leading
+    b3::JButton <- JButton.new "Enable middle button"
+    b3.setVerticalTextPosition   SwingConstants.center
+    b3.setHorizontalTextPosition SwingConstants.leading
+    b3.setEnabled false
+    let action1 _ = do
+            b2.setEnabled false
+            b1.setEnabled false
+            b3.setEnabled true
+        action3 _ = do
+            b2.setEnabled true
+            b1.setEnabled true
+            b3.setEnabled false
+    ActionListener.new action1  >>= b1.addActionListener
+    ActionListener.new action3  >>= b3.addActionListener 
+    newContentPane.add b1
+    newContentPane.add b2
+    newContentPane.add b3
+    newContentPane.setOpaque true
+    frame.setContentPane newContentPane
+    frame.pack
+    frame.setVisible true