shen-ruby 0.12.1 → 0.13.0

checksums.yaml

@@ -1,7 +1,7 @@
 ---
 SHA1:
-  metadata.gz: ef53ec1dece12e1268ad947755b50ac7f0dde4b7
-  data.tar.gz: 1f72b4134912bb154027f240c1ef3fa5f65472ae
+  metadata.gz: c897025e3db275868a66f65e39372e41c57e1d44
+  data.tar.gz: 9c2ea4c35912d387d5ff47752506869ac5683a26
 SHA512:
-  metadata.gz: 5eef86bddefaf28ffa148243ab05c2818bd9fd52365cc7653c5b17d0b7fc5e46acc0e84ce7112bb5333c54584ce4b164db0ac0d42366183e496c4850198d6f3f
-  data.tar.gz: 86e6189fed2c9860123fdf61728bb1b6e0f58a151911f696fad067a5ec16bdf5773ecc84bdb42ca3a6baa6a6cb5168d34426c16297392ca31a562e584488d2bb
+  metadata.gz: ecf05de649b240426c5a5686fe754d1cf2ae358e7e05416f6b90d9843964f48416b568158bc71d6db9ca67b05ee519b4e3b55b8fbb6b15b887c916cb22161b9d
+  data.tar.gz: b5b9ad3469a0093011533d3ba4af73fda621de93762584185ca418379d8e8cef8c9245e8028ee75910fc20ad2e8c6bb35f57ad4d22abf56edd5b6662812147d3

data/HISTORY.md

@@ -1,5 +1,10 @@
 # ShenRuby Release History
 
+## 0.13.0 - February 3, 2013
+### Features
+- Upgrade to Shen 17
+  - Shen is now BSD-licenesed, making ShenRuby BSD/MIT licenesed
+
 ## 0.12.1 - February 1, 2015
 ### Breaking Changes
 - The arity of block arguments to Ruby methods no longer needs to be specified. Now all block arguments are denoted by a `&` followed by the function to pass as the block. Any usages of the old syntax, e.g. `&2`, must be updated to `&`.

data/README.md

@@ -1,7 +1,7 @@
 # ShenRuby
 ShenRuby is a Ruby port of the [Shen](http://shenlanguage.org/) programming language. Shen is a modern, functional Lisp that supports pattern matching, currying, and optional static type checking.
 
-ShenRuby supports Shen version 16, which was released in September, 2014.
+ShenRuby supports Shen version 17, which was released in February, 2015.
 
 The ShenRuby project has two primary goals. The first is to be a low barrier-to-entry means for Rubyists to explore Shen. To someone with a working installation of Ruby 1.9.3 or greater, a Shen REPL is only a gem install away.
 
@@ -14,7 +14,7 @@ ShenRuby 0.1.0 began to satisfy the first goal by providing a Shen REPL accessib
 ## Installation
 NOTE: ShenRuby requires Ruby 1.9 language features. It is tested with Ruby 2.0.0, 2.1.5, and 2.2.0. It has been lightly tested with JRuby 1.7.17. It is functional with Ruby 1.9.3, however its fixed stack size prevents it from passing the Shen Test Suite (see [Setting Stack Size](setting-stack-size) below).
 
-ShenRuby 0.12.1 is the current release. To install it as a gem, use the following command:
+ShenRuby 0.13.0 is the current release. To install it as a gem, use the following command:
 
     gem install shen-ruby
 
@@ -22,14 +22,12 @@ ShenRuby 0.12.1 is the current release. To install it as a gem, use the followin
 
 Once the gem has been installed, the Shen REPL can be launched via the `srrepl` (short for ShenRuby REPL) command. For example:
 
-    % srrepl
-    Loading.... Completed in 2.62 seconds.
+    Loading.... Completed in 2.60 seconds.
 
-    Shen 2010, copyright (C) 2010 Mark Tarver
-    released under the Shen license
-    www.shenlanguage.org, version 16
+    Shen, copyright (C) 2010-2015 Mark Tarver
+    www.shenlanguage.org, Shen 17
     running under Ruby, implementation: ruby 2.2.0
-    port 0.12.1 ported by Greg Spurrier
+    port 0.13.0 ported by Greg Spurrier
 
 
     (0-)
@@ -222,8 +220,6 @@ The following people are gratefully acknowledged for their contributions to Shen
 - Bruno Deferrari
 
 ## License
-Shen and ShenRuby are released under the Shen License. A copy of the Shen License may be found in [shen/license.txt](https://github.com/gregspurrier/shen-ruby/blob/master/shen/license.txt). A detailed description of the license, along with questions and answers, may be found at http://shenlanguage.org/license.html. In particular, please note that any forks or derivatives of ShenRuby must maintain conformance with the Official Shen Specification.
+The implementation of Shen, which is found in the [shen](https://github.com/gregspurrier/shen-ruby/tree/master/shen) directory, is Copyright (c) 2010-2015 Mark Tarver and released under the BSD license. A copy of the license may be found in [shen/release/BSD](https://github.com/gregspurrier/shen-ruby/tree/master/shen/release/BSD).
 
-The implementation of Shen, which is found in the [shen/release](https://github.com/gregspurrier/shen-ruby/tree/master/shen) directory, is Copyright (c) 2010-2014 Mark Tarver and may only be used in accordance with the Shen License.
-
-The remainder of the code for ShenRuby is Copyright(c) 2012-2015 Greg Spurrier. It may be used outside of the context of ShenRuby under the terms of the MIT License. A copy of the MIT License may be found in [MIT_LICENSE.txt](https://github.com/gregspurrier/shen-ruby/blob/master/MIT_LICENSE.txt).
+The remainder of ShenRuby is Copyright(c) 2012-2015 Greg Spurrier and released under the MIT license. A copy of the license may be found in [MIT_LICENSE.txt](https://github.com/gregspurrier/shen-ruby/blob/master/MIT_LICENSE.txt).

data/Rakefile

@@ -14,10 +14,10 @@ SHEN_ZIP = File.join(IMPORT_DIR, 'Shen.zip')
 namespace :shen do
   namespace :import do
     task :release => [:remove_old_release, :import_dirs, :cleanup]
-    task :import_dirs => [:k_lambda, :test_programs, :benchmarks]
+    task :import_dirs => [:k_lambda, :test_programs]
 
     task :remove_old_release do
-      rm_rf IMPORT_DIR
+      #rm_rf IMPORT_DIR
       rm_rf RELEASE_DIR
     end
 
@@ -33,7 +33,7 @@ namespace :shen do
     end
 
     task :unzip => SHEN_ZIP do
-      sh "(cd #{IMPORT_DIR}; unzip Shen.zip)"
+      #sh "(cd #{IMPORT_DIR}; unzip Shen.zip)"
     end
 
     def dst_path(src_root, src_path, dst_root)
@@ -68,17 +68,12 @@ namespace :shen do
     end
 
     task :k_lambda => [:unzip, RELEASE_DIR] do
-      import_dir('K Lambda')
+      import_dir('KLambda')
     end
 
     task :test_programs => [:unzip, RELEASE_DIR] do
       import_dir('Test Programs')
       fix_load_paths(File.join(RELEASE_DIR, 'test_programs/tests.shen'))
     end
-
-    task :benchmarks => [:unzip, RELEASE_DIR] do
-      import_dir('Benchmarks')
-      fix_load_paths(File.join(RELEASE_DIR, 'benchmarks/benchmarks.shen'))
-    end
   end
 end

data/bin/shen_test_suite.rb

@@ -1,6 +1,5 @@
 #!/usr/bin/env ruby
 $LOAD_PATH << File.expand_path('../../lib', __FILE__)
-$LOAD_PATH << File.expand_path('../../shen/lib', __FILE__)
 require 'shen_ruby'
 
 shen = ShenRuby::Shen.new

data/bin/srrepl

@@ -1,9 +1,7 @@
 #!/usr/bin/env ruby
 root = File.expand_path('../..', __FILE__)
-%w(lib shen/lib).each do |path|
-  full_path = File.join(root, path)
-  $LOAD_PATH << full_path unless $LOAD_PATH.include? full_path
-end
+lib_path = File.join(root, 'lib')
+$LOAD_PATH << lib_path unless $LOAD_PATH.include? lib_path
 require 'shen_ruby'
 
 # Leave gracefully if someone hits Control-C during loading

data/lib/shen_ruby/shen.rb

@@ -0,0 +1,98 @@
+module ShenRuby
+  # Instances of the ShenRuby::Shen class provide a Shen environment
+  # running within a Klam environment. This class is essentially a loader
+  # Shen's KLambda sources and the ShenRuby extensions.
+  class Shen < Klam::Environment
+    def initialize
+      super
+
+      # Set the global variables
+      set("*language*".to_sym, "Ruby")
+      set("*implementation*".to_sym, "#{::RUBY_ENGINE} #{::RUBY_VERSION}")
+      set("*release*".to_sym, ::RUBY_VERSION)
+      set("*port*".to_sym, ::ShenRuby::VERSION)
+      set("*porters*".to_sym, "Greg Spurrier")
+      set("*home-directory*".to_sym, ::Dir.pwd)
+      set("*stinput*".to_sym, ::STDIN)
+      set("*stoutput*".to_sym, ::STDOUT)
+
+      # Load the K Lambda files
+      kl_root = ::File.expand_path('../../../shen/release/klambda', __FILE__)
+      %w(toplevel core sys).each do |kl_filename|
+        ::ShenRuby::Shen.load_file(self, ::File.join(kl_root, kl_filename + ".kl"))
+      end
+
+      # Overrides
+      class << self
+        # Give a way to bail out
+        def quit
+          ::Kernel.exit(0)
+        end
+
+        # Add a way to evaluate strings, intended for use with Ruby interop.
+        # Returns the result of the last expression evaluated.
+        def eval_string(s)
+          forms = __send__(:"read-from-string", s)
+          result = nil
+          while forms
+            result = eval(head(forms))
+            forms = tail(forms)
+          end
+          result
+        end
+        alias_method :"eval-string", :eval_string
+
+        # The performance of `element?` is critical
+        def element?(x, l)
+          while l
+            return true if l.hd == x
+            l = l.tl
+          end
+          return false
+        rescue => e
+          __send(:"shen.sys-error", :element?)
+        end
+
+        def vector(n)
+          v = ::Klam::Absvector.new(n + 1, :"shen.fail!")
+          v[0] = n
+          v
+        end
+      end
+
+      # Load the rest of the K Lambda files
+      %w(sequent yacc
+         reader prolog track load writer
+         macros declarations types t-star
+        ).each do |kl_filename|
+        ::ShenRuby::Shen.load_file(self, ::File.join(kl_root, kl_filename + ".kl"))
+      end
+
+      # Give type signatures to the new functions added above
+      declare :quit, cons(:"-->", cons(:unit, nil))
+      declare :eval_string, cons(:string, cons(:"-->", cons(:unit, nil)))
+      declare :"eval-string", cons(:string, cons(:"-->", cons(:unit, nil)))
+
+      systemf :"rb-const"
+      systemf :"rb-send"
+      systemf :"rb-send-block"
+
+      old_hush = value(:"*hush*")
+      set :"*hush*", true
+      load ::File.expand_path('../rb.shen', __FILE__)
+      load ::File.expand_path('../shen_ruby.shen', __FILE__)
+      set :"*hush*", old_hush
+    end
+
+    class << self
+      def load_file(env, path)
+        ::File.open(path, 'r') do |file|
+          reader = ::Klam::Reader.new(file)
+          while form = reader.next
+            env.__send__(:"eval-kl", form)
+          end
+        end
+      end
+    end
+  end
+end

data/lib/shen_ruby/version.rb

@@ -1,3 +1,3 @@
 module ShenRuby
-  VERSION = "0.12.1"
+  VERSION = "0.13.0"
 end

data/shen-ruby.gemspec

@@ -7,12 +7,12 @@ Gem::Specification.new do |s|
   s.name        = "shen-ruby"
   s.version     = ShenRuby::VERSION
   s.platform    = Gem::Platform::RUBY
-  s.license     = "Shen License"
+  s.license     = "BSD/MIT"
   s.authors     = ["Greg Spurrier", "Mark Tarver"]
   s.email       = ["greg@sourcematters.org"]
   s.homepage    = "https://github.com/gregspurrier/shen-ruby"
   s.summary     = %q{ShenRuby is a Ruby port of the Shen programming language}
-  s.description = %q{ShenRuby is a port of the Shen programming language to Ruby. It currently supports Shen version 16.}
+  s.description = %q{ShenRuby is a port of the Shen programming language to Ruby. It currently supports Shen version 17.}
 
   s.required_ruby_version     = ">= 1.9.3"
 
@@ -25,5 +25,5 @@ Gem::Specification.new do |s|
   s.files              = git_files
   s.test_files         = `git ls-files -- {test,spec,features}/*`.split("\n")
   s.executables        = %w(srrepl)
-  s.require_paths      = ["lib", "shen/lib"]
+  s.require_paths      = ["lib"]
 end

data/shen/README.txt

@@ -1,17 +1,13 @@
-The files found in this directory and its subdirectories are part of
-Shen and are subject to the Shen License. A copy of the license may be
-found in license.txt in this directory. A detailed explanation of the
-license may be found at http://shenlanguage.org/license.html.
+The files found under this directory are extracted directly from the
+Shen source code distribution, the most recent version of which is
+available at http://www.shenlanguage.org/Download/Shen.zip.
+
+With the exception of README.txt, all of the files are Copyright (c)
+2010-2015 Mark Tarver and released under the BSD license. Please see
+release/BSD and release/license.pdf for details.
 
 Directory contents:
 
 README.txt  -- this file
-license.txt -- the Shen license
-release/    -- files extracted directly from the Shen 14 Source
-               release. The complete source for the most recent
-               release of Shen may be downloaded from
-               http://www.shenlanguage.org/Download/index.htm
-lib/        -- Ruby code that creates a full Shen environment running
-               under ShenRuby's implementation of K Lambda. This code
-               is considered a derivative work of the original Shen
-               Source release.
+release/    -- files extracted directly from the Shen Source
+               release.

data/shen/release/BSD

@@ -0,0 +1,24 @@
+Copyright (c) 2010-2015, Mark Tarver
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. The name of Mark Tarver may not be used to endorse or promote products
+   derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

data/shen/release/klambda/core.kl

@@ -0,0 +1,157 @@
+"Copyright (c) 2015, Mark Tarver
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. The name of Mark Tarver may not be used to endorse or promote products
+   derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY Mark Tarver ''AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL Mark Tarver BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE."
+
+(defun shen.shen->kl (V551 V552) (compile shen.<define> (cons V551 V552) (lambda X (shen.shen-syntax-error V551 X))))
+
+(defun shen.shen-syntax-error (V553 V554) (simple-error (cn "syntax error in " (shen.app V553 (cn " here:
+
+ " (shen.app (shen.next-50 50 V554) "
+" shen.a)) shen.a))))
+
+(defun shen.<define> (V555) (let YaccParse (let Parse_shen.<name> (shen.<name> V555) (if (not (= (fail) Parse_shen.<name>)) (let Parse_shen.<signature> (shen.<signature> Parse_shen.<name>) (if (not (= (fail) Parse_shen.<signature>)) (let Parse_shen.<rules> (shen.<rules> Parse_shen.<signature>) (if (not (= (fail) Parse_shen.<rules>)) (shen.pair (hd Parse_shen.<rules>) (shen.compile_to_machine_code (shen.hdtl Parse_shen.<name>) (shen.hdtl Parse_shen.<rules>))) (fail))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<name> (shen.<name> V555) (if (not (= (fail) Parse_shen.<name>)) (let Parse_shen.<rules> (shen.<rules> Parse_shen.<name>) (if (not (= (fail) Parse_shen.<rules>)) (shen.pair (hd Parse_shen.<rules>) (shen.compile_to_machine_code (shen.hdtl Parse_shen.<name>) (shen.hdtl Parse_shen.<rules>))) (fail))) (fail))) YaccParse)))
+
+(defun shen.<name> (V556) (if (cons? (hd V556)) (let Parse_X (hd (hd V556)) (shen.pair (hd (shen.pair (tl (hd V556)) (shen.hdtl V556))) (if (and (symbol? Parse_X) (not (shen.sysfunc? Parse_X))) Parse_X (simple-error (shen.app Parse_X " is not a legitimate function name.
+" shen.a))))) (fail)))
+
+(defun shen.sysfunc? (V557) (element? V557 (get (intern "shen") shen.external-symbols (value *property-vector*))))
+
+(defun shen.<signature> (V558) (if (and (cons? (hd V558)) (= { (hd (hd V558)))) (let Parse_shen.<signature-help> (shen.<signature-help> (shen.pair (tl (hd V558)) (shen.hdtl V558))) (if (not (= (fail) Parse_shen.<signature-help>)) (if (and (cons? (hd Parse_shen.<signature-help>)) (= } (hd (hd Parse_shen.<signature-help>)))) (shen.pair (hd (shen.pair (tl (hd Parse_shen.<signature-help>)) (shen.hdtl Parse_shen.<signature-help>))) (shen.demodulate (shen.curry-type (shen.hdtl Parse_shen.<signature-help>)))) (fail)) (fail))) (fail)))
+
+(defun shen.curry-type (V559) (cond ((and (cons? V559) (and (cons? (tl V559)) (and (= --> (hd (tl V559))) (and (cons? (tl (tl V559))) (and (cons? (tl (tl (tl V559)))) (= --> (hd (tl (tl (tl V559)))))))))) (shen.curry-type (cons (hd V559) (cons --> (cons (tl (tl V559)) ()))))) ((and (cons? V559) (and (cons? (tl V559)) (and (= * (hd (tl V559))) (and (cons? (tl (tl V559))) (and (cons? (tl (tl (tl V559)))) (= * (hd (tl (tl (tl V559)))))))))) (shen.curry-type (cons (hd V559) (cons * (cons (tl (tl V559)) ()))))) ((cons? V559) (map shen.curry-type V559)) (true V559)))
+
+(defun shen.<signature-help> (V560) (let YaccParse (if (cons? (hd V560)) (let Parse_X (hd (hd V560)) (let Parse_shen.<signature-help> (shen.<signature-help> (shen.pair (tl (hd V560)) (shen.hdtl V560))) (if (not (= (fail) Parse_shen.<signature-help>)) (if (not (element? Parse_X (cons { (cons } ())))) (shen.pair (hd Parse_shen.<signature-help>) (cons Parse_X (shen.hdtl Parse_shen.<signature-help>))) (fail)) (fail)))) (fail)) (if (= YaccParse (fail)) (let Parse_<e> (<e> V560) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
+
+(defun shen.<rules> (V561) (let YaccParse (let Parse_shen.<rule> (shen.<rule> V561) (if (not (= (fail) Parse_shen.<rule>)) (let Parse_shen.<rules> (shen.<rules> Parse_shen.<rule>) (if (not (= (fail) Parse_shen.<rules>)) (shen.pair (hd Parse_shen.<rules>) (cons (shen.linearise (shen.hdtl Parse_shen.<rule>)) (shen.hdtl Parse_shen.<rules>))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<rule> (shen.<rule> V561) (if (not (= (fail) Parse_shen.<rule>)) (shen.pair (hd Parse_shen.<rule>) (cons (shen.linearise (shen.hdtl Parse_shen.<rule>)) ())) (fail))) YaccParse)))
+
+(defun shen.<rule> (V562) (let YaccParse (let Parse_shen.<patterns> (shen.<patterns> V562) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= -> (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<action> (shen.<action> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<action>)) (if (and (cons? (hd Parse_shen.<action>)) (= where (hd (hd Parse_shen.<action>)))) (let Parse_shen.<guard> (shen.<guard> (shen.pair (tl (hd Parse_shen.<action>)) (shen.hdtl Parse_shen.<action>))) (if (not (= (fail) Parse_shen.<guard>)) (shen.pair (hd Parse_shen.<guard>) (cons (shen.hdtl Parse_shen.<patterns>) (cons (cons where (cons (shen.hdtl Parse_shen.<guard>) (cons (shen.hdtl Parse_shen.<action>) ()))) ()))) (fail))) (fail)) (fail))) (fail)) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<patterns> (shen.<patterns> V562) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= -> (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<action> (shen.<action> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<action>)) (shen.pair (hd Parse_shen.<action>) (cons (shen.hdtl Parse_shen.<patterns>) (cons (shen.hdtl Parse_shen.<action>) ()))) (fail))) (fail)) (fail))) (if (= YaccParse (fail)) (let YaccParse (let Parse_shen.<patterns> (shen.<patterns> V562) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= <- (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<action> (shen.<action> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<action>)) (if (and (cons? (hd Parse_shen.<action>)) (= where (hd (hd Parse_shen.<action>)))) (let Parse_shen.<guard> (shen.<guard> (shen.pair (tl (hd Parse_shen.<action>)) (shen.hdtl Parse_shen.<action>))) (if (not (= (fail) Parse_shen.<guard>)) (shen.pair (hd Parse_shen.<guard>) (cons (shen.hdtl Parse_shen.<patterns>) (cons (cons where (cons (shen.hdtl Parse_shen.<guard>) (cons (cons shen.choicepoint! (cons (shen.hdtl Parse_shen.<action>) ())) ()))) ()))) (fail))) (fail)) (fail))) (fail)) (fail))) (if (= YaccParse (fail)) (let Parse_shen.<patterns> (shen.<patterns> V562) (if (not (= (fail) Parse_shen.<patterns>)) (if (and (cons? (hd Parse_shen.<patterns>)) (= <- (hd (hd Parse_shen.<patterns>)))) (let Parse_shen.<action> (shen.<action> (shen.pair (tl (hd Parse_shen.<patterns>)) (shen.hdtl Parse_shen.<patterns>))) (if (not (= (fail) Parse_shen.<action>)) (shen.pair (hd Parse_shen.<action>) (cons (shen.hdtl Parse_shen.<patterns>) (cons (cons shen.choicepoint! (cons (shen.hdtl Parse_shen.<action>) ())) ()))) (fail))) (fail)) (fail))) YaccParse)) YaccParse)) YaccParse)))
+
+(defun shen.fail_if (V563 V564) (if (V563 V564) (fail) V564))
+
+(defun shen.succeeds? (V569) (cond ((= V569 (fail)) false) (true true)))
+
+(defun shen.<patterns> (V570) (let YaccParse (let Parse_shen.<pattern> (shen.<pattern> V570) (if (not (= (fail) Parse_shen.<pattern>)) (let Parse_shen.<patterns> (shen.<patterns> Parse_shen.<pattern>) (if (not (= (fail) Parse_shen.<patterns>)) (shen.pair (hd Parse_shen.<patterns>) (cons (shen.hdtl Parse_shen.<pattern>) (shen.hdtl Parse_shen.<patterns>))) (fail))) (fail))) (if (= YaccParse (fail)) (let Parse_<e> (<e> V570) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) ()) (fail))) YaccParse)))
+
+(defun shen.<pattern> (V576) (let YaccParse (if (and (cons? (hd V576)) (cons? (hd (hd V576)))) (if (and (cons? (hd (shen.pair (hd (hd V576)) (hd (tl V576))))) (= @p (hd (hd (shen.pair (hd (hd V576)) (hd (tl V576))))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V576)) (hd (tl V576))))) (shen.hdtl (shen.pair (hd (hd V576)) (hd (tl V576)))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd (shen.pair (tl (hd V576)) (hd (tl V576)))) (cons @p (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ())))) (fail))) (fail))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V576)) (cons? (hd (hd V576)))) (if (and (cons? (hd (shen.pair (hd (hd V576)) (hd (tl V576))))) (= cons (hd (hd (shen.pair (hd (hd V576)) (hd (tl V576))))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V576)) (hd (tl V576))))) (shen.hdtl (shen.pair (hd (hd V576)) (hd (tl V576)))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd (shen.pair (tl (hd V576)) (hd (tl V576)))) (cons cons (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ())))) (fail))) (fail))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V576)) (cons? (hd (hd V576)))) (if (and (cons? (hd (shen.pair (hd (hd V576)) (hd (tl V576))))) (= @v (hd (hd (shen.pair (hd (hd V576)) (hd (tl V576))))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V576)) (hd (tl V576))))) (shen.hdtl (shen.pair (hd (hd V576)) (hd (tl V576)))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd (shen.pair (tl (hd V576)) (hd (tl V576)))) (cons @v (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ())))) (fail))) (fail))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V576)) (cons? (hd (hd V576)))) (if (and (cons? (hd (shen.pair (hd (hd V576)) (hd (tl V576))))) (= @s (hd (hd (shen.pair (hd (hd V576)) (hd (tl V576))))))) (let Parse_shen.<pattern1> (shen.<pattern1> (shen.pair (tl (hd (shen.pair (hd (hd V576)) (hd (tl V576))))) (shen.hdtl (shen.pair (hd (hd V576)) (hd (tl V576)))))) (if (not (= (fail) Parse_shen.<pattern1>)) (let Parse_shen.<pattern2> (shen.<pattern2> Parse_shen.<pattern1>) (if (not (= (fail) Parse_shen.<pattern2>)) (shen.pair (hd (shen.pair (tl (hd V576)) (hd (tl V576)))) (cons @s (cons (shen.hdtl Parse_shen.<pattern1>) (cons (shen.hdtl Parse_shen.<pattern2>) ())))) (fail))) (fail))) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (and (cons? (hd V576)) (cons? (hd (hd V576)))) (if (and (cons? (hd (shen.pair (hd (hd V576)) (hd (tl V576))))) (= vector (hd (hd (shen.pair (hd (hd V576)) (hd (tl V576))))))) (if (and (cons? (hd (shen.pair (tl (hd (shen.pair (hd (hd V576)) (hd (tl V576))))) (shen.hdtl (shen.pair (hd (hd V576)) (hd (tl V576))))))) (= 0 (hd (hd (shen.pair (tl (hd (shen.pair (hd (hd V576)) (hd (tl V576))))) (shen.hdtl (shen.pair (hd (hd V576)) (hd (tl V576))))))))) (shen.pair (hd (shen.pair (tl (hd V576)) (hd (tl V576)))) (cons vector (cons 0 ()))) (fail)) (fail)) (fail)) (if (= YaccParse (fail)) (let YaccParse (if (cons? (hd V576)) (let Parse_X (hd (hd V576)) (if (cons? Parse_X) (shen.pair (hd (shen.pair (tl (hd V576)) (shen.hdtl V576))) (shen.constructor-error Parse_X)) (fail))) (fail)) (if (= YaccParse (fail)) (let Parse_shen.<simple_pattern> (shen.<simple_pattern> V576) (if (not (= (fail) Parse_shen.<simple_pattern>)) (shen.pair (hd Parse_shen.<simple_pattern>) (shen.hdtl Parse_shen.<simple_pattern>)) (fail))) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)) YaccParse)))
+
+(defun shen.constructor-error (V577) (simple-error (shen.app V577 " is not a legitimate constructor
+" shen.a)))
+
+(defun shen.<simple_pattern> (V578) (let YaccParse (if (cons? (hd V578)) (let Parse_X (hd (hd V578)) (if (= Parse_X _) (shen.pair (hd (shen.pair (tl (hd V578)) (shen.hdtl V578))) (gensym Parse_Y)) (fail))) (fail)) (if (= YaccParse (fail)) (if (cons? (hd V578)) (let Parse_X (hd (hd V578)) (if (not (element? Parse_X (cons -> (cons <- ())))) (shen.pair (hd (shen.pair (tl (hd V578)) (shen.hdtl V578))) Parse_X) (fail))) (fail)) YaccParse)))
+
+(defun shen.<pattern1> (V579) (let Parse_shen.<pattern> (shen.<pattern> V579) (if (not (= (fail) Parse_shen.<pattern>)) (shen.pair (hd Parse_shen.<pattern>) (shen.hdtl Parse_shen.<pattern>)) (fail))))
+
+(defun shen.<pattern2> (V580) (let Parse_shen.<pattern> (shen.<pattern> V580) (if (not (= (fail) Parse_shen.<pattern>)) (shen.pair (hd Parse_shen.<pattern>) (shen.hdtl Parse_shen.<pattern>)) (fail))))
+
+(defun shen.<action> (V581) (if (cons? (hd V581)) (let Parse_X (hd (hd V581)) (shen.pair (hd (shen.pair (tl (hd V581)) (shen.hdtl V581))) Parse_X)) (fail)))
+
+(defun shen.<guard> (V582) (if (cons? (hd V582)) (let Parse_X (hd (hd V582)) (shen.pair (hd (shen.pair (tl (hd V582)) (shen.hdtl V582))) Parse_X)) (fail)))
+
+(defun shen.compile_to_machine_code (V583 V584) (let Lambda+ (shen.compile_to_lambda+ V583 V584) (let KL (shen.compile_to_kl V583 Lambda+) (let Record (shen.record-source V583 KL) KL))))
+
+(defun shen.record-source (V587 V588) (cond ((value shen.*installing-kl*) shen.skip) (true (put V587 shen.source V588 (value *property-vector*)))))
+
+(defun shen.compile_to_lambda+ (V589 V590) (let Arity (shen.aritycheck V589 V590) (let Free (map (lambda Rule (shen.free_variable_check V589 Rule)) V590) (let Variables (shen.parameters Arity) (let Strip (map shen.strip-protect V590) (let Abstractions (map shen.abstract_rule Strip) (let Applications (map (lambda X (shen.application_build Variables X)) Abstractions) (cons Variables (cons Applications ())))))))))
+
+(defun shen.free_variable_check (V591 V592) (cond ((and (cons? V592) (and (cons? (tl V592)) (= () (tl (tl V592))))) (let Bound (shen.extract_vars (hd V592)) (let Free (shen.extract_free_vars Bound (hd (tl V592))) (shen.free_variable_warnings V591 Free)))) (true (shen.f_error shen.free_variable_check))))
+
+(defun shen.extract_vars (V593) (cond ((variable? V593) (cons V593 ())) ((cons? V593) (union (shen.extract_vars (hd V593)) (shen.extract_vars (tl V593)))) (true ())))
+
+(defun shen.extract_free_vars (V603 V604) (cond ((and (cons? V604) (and (cons? (tl V604)) (and (= () (tl (tl V604))) (= (hd V604) protect)))) ()) ((and (variable? V604) (not (element? V604 V603))) (cons V604 ())) ((and (cons? V604) (and (= lambda (hd V604)) (and (cons? (tl V604)) (and (cons? (tl (tl V604))) (= () (tl (tl (tl V604)))))))) (shen.extract_free_vars (cons (hd (tl V604)) V603) (hd (tl (tl V604))))) ((and (cons? V604) (and (= let (hd V604)) (and (cons? (tl V604)) (and (cons? (tl (tl V604))) (and (cons? (tl (tl (tl V604)))) (= () (tl (tl (tl (tl V604)))))))))) (union (shen.extract_free_vars V603 (hd (tl (tl V604)))) (shen.extract_free_vars (cons (hd (tl V604)) V603) (hd (tl (tl (tl V604))))))) ((cons? V604) (union (shen.extract_free_vars V603 (hd V604)) (shen.extract_free_vars V603 (tl V604)))) (true ())))
+
+(defun shen.free_variable_warnings (V607 V608) (cond ((= () V608) _) (true (simple-error (cn "error: the following variables are free in " (shen.app V607 (cn ": " (shen.app (shen.list_variables V608) "" shen.a)) shen.a))))))
+
+(defun shen.list_variables (V609) (cond ((and (cons? V609) (= () (tl V609))) (cn (str (hd V609)) ".")) ((cons? V609) (cn (str (hd V609)) (cn ", " (shen.list_variables (tl V609))))) (true (shen.f_error shen.list_variables))))
+
+(defun shen.strip-protect (V610) (cond ((and (cons? V610) (and (cons? (tl V610)) (and (= () (tl (tl V610))) (= (hd V610) protect)))) (shen.strip-protect (hd (tl V610)))) ((cons? V610) (map shen.strip-protect V610)) (true V610)))
+
+(defun shen.linearise (V611) (cond ((and (cons? V611) (and (cons? (tl V611)) (= () (tl (tl V611))))) (shen.linearise_help (shen.flatten (hd V611)) (hd V611) (hd (tl V611)))) (true (shen.f_error shen.linearise))))
+
+(defun shen.flatten (V612) (cond ((= () V612) ()) ((cons? V612) (append (shen.flatten (hd V612)) (shen.flatten (tl V612)))) (true (cons V612 ()))))
+
+(defun shen.linearise_help (V613 V614 V615) (cond ((= () V613) (cons V614 (cons V615 ()))) ((cons? V613) (if (and (variable? (hd V613)) (element? (hd V613) (tl V613))) (let Var (gensym (hd V613)) (let NewAction (cons where (cons (cons = (cons (hd V613) (cons Var ()))) (cons V615 ()))) (let NewPatts (shen.linearise_X (hd V613) Var V614) (shen.linearise_help (tl V613) NewPatts NewAction)))) (shen.linearise_help (tl V613) V614 V615))) (true (shen.f_error shen.linearise_help))))
+
+(defun shen.linearise_X (V625 V626 V627) (cond ((= V627 V625) V626) ((cons? V627) (let L (shen.linearise_X V625 V626 (hd V627)) (if (= L (hd V627)) (cons (hd V627) (shen.linearise_X V625 V626 (tl V627))) (cons L (tl V627))))) (true V627)))
+
+(defun shen.aritycheck (V628 V629) (cond ((and (cons? V629) (and (cons? (hd V629)) (and (cons? (tl (hd V629))) (and (= () (tl (tl (hd V629)))) (= () (tl V629)))))) (do (shen.aritycheck-action (hd (tl (hd V629)))) (shen.aritycheck-name V628 (arity V628) (length (hd (hd V629)))))) ((and (cons? V629) (and (cons? (hd V629)) (and (cons? (tl (hd V629))) (and (= () (tl (tl (hd V629)))) (and (cons? (tl V629)) (and (cons? (hd (tl V629))) (and (cons? (tl (hd (tl V629)))) (= () (tl (tl (hd (tl V629)))))))))))) (if (= (length (hd (hd V629))) (length (hd (hd (tl V629))))) (do (shen.aritycheck-action (hd (tl (hd V629)))) (shen.aritycheck V628 (tl V629))) (simple-error (cn "arity error in " (shen.app V628 "
+" shen.a))))) (true (shen.f_error shen.aritycheck))))
+
+(defun shen.aritycheck-name (V639 V640 V641) (cond ((= -1 V640) V641) ((= V641 V640) V641) (true (do (shen.prhush (cn "
+warning: changing the arity of " (shen.app V639 " can cause errors.
+" shen.a)) (stoutput)) V641))))
+
+(defun shen.aritycheck-action (V646) (cond ((cons? V646) (do (shen.aah (hd V646) (tl V646)) (map shen.aritycheck-action V646))) (true shen.skip)))
+
+(defun shen.aah (V647 V648) (let Arity (arity V647) (let Len (length V648) (if (and (> Arity -1) (> Len Arity)) (shen.prhush (cn "warning: " (shen.app V647 (cn " might not like " (shen.app Len (cn " argument" (shen.app (if (> Len 1) "s" "") ".
+" shen.a)) shen.a)) shen.a)) (stoutput)) shen.skip))))
+
+(defun shen.abstract_rule (V649) (cond ((and (cons? V649) (and (cons? (tl V649)) (= () (tl (tl V649))))) (shen.abstraction_build (hd V649) (hd (tl V649)))) (true (shen.f_error shen.abstract_rule))))
+
+(defun shen.abstraction_build (V650 V651) (cond ((= () V650) V651) ((cons? V650) (cons /. (cons (hd V650) (cons (shen.abstraction_build (tl V650) V651) ())))) (true (shen.f_error shen.abstraction_build))))
+
+(defun shen.parameters (V652) (cond ((= 0 V652) ()) (true (cons (gensym V) (shen.parameters (- V652 1))))))
+
+(defun shen.application_build (V653 V654) (cond ((= () V653) V654) ((cons? V653) (shen.application_build (tl V653) (cons V654 (cons (hd V653) ())))) (true (shen.f_error shen.application_build))))
+
+(defun shen.compile_to_kl (V655 V656) (cond ((and (cons? V656) (and (cons? (tl V656)) (= () (tl (tl V656))))) (let Arity (shen.store-arity V655 (length (hd V656))) (let Reduce (map shen.reduce (hd (tl V656))) (let CondExpression (shen.cond-expression V655 (hd V656) Reduce) (let TypeTable (if (value shen.*optimise*) (shen.typextable (shen.get-type V655) (hd V656)) shen.skip) (let TypedCondExpression (if (value shen.*optimise*) (shen.assign-types (hd V656) TypeTable CondExpression) CondExpression) (let KL (cons defun (cons V655 (cons (hd V656) (cons TypedCondExpression ())))) KL))))))) (true (shen.f_error shen.compile_to_kl))))
+
+(defun shen.get-type (V661) (cond ((cons? V661) shen.skip) (true (let FType (assoc V661 (value shen.*signedfuncs*)) (if (empty? FType) shen.skip (tl FType))))))
+
+(defun shen.typextable (V670 V671) (cond ((and (cons? V670) (and (cons? (tl V670)) (and (= --> (hd (tl V670))) (and (cons? (tl (tl V670))) (and (= () (tl (tl (tl V670)))) (cons? V671)))))) (if (variable? (hd V670)) (shen.typextable (hd (tl (tl V670))) (tl V671)) (cons (cons (hd V671) (hd V670)) (shen.typextable (hd (tl (tl V670))) (tl V671))))) (true ())))
+
+(defun shen.assign-types (V672 V673 V674) (cond ((and (cons? V674) (and (= let (hd V674)) (and (cons? (tl V674)) (and (cons? (tl (tl V674))) (and (cons? (tl (tl (tl V674)))) (= () (tl (tl (tl (tl V674)))))))))) (cons let (cons (hd (tl V674)) (cons (shen.assign-types V672 V673 (hd (tl (tl V674)))) (cons (shen.assign-types (cons (hd (tl V674)) V672) V673 (hd (tl (tl (tl V674))))) ()))))) ((and (cons? V674) (and (= lambda (hd V674)) (and (cons? (tl V674)) (and (cons? (tl (tl V674))) (= () (tl (tl (tl V674)))))))) (cons lambda (cons (hd (tl V674)) (cons (shen.assign-types (cons (hd (tl V674)) V672) V673 (hd (tl (tl V674)))) ())))) ((and (cons? V674) (= cond (hd V674))) (cons cond (map (lambda Y (cons (shen.assign-types V672 V673 (hd Y)) (cons (shen.assign-types V672 V673 (hd (tl Y))) ()))) (tl V674)))) ((cons? V674) (let NewTable (shen.typextable (shen.get-type (hd V674)) (tl V674)) (cons (hd V674) (map (lambda Y (shen.assign-types V672 (append V673 NewTable) Y)) (tl V674))))) (true (let AtomType (assoc V674 V673) (if (cons? AtomType) (cons type (cons V674 (cons (tl AtomType) ()))) (if (element? V674 V672) V674 (shen.atom-type V674)))))))
+
+(defun shen.atom-type (V675) (if (string? V675) (cons type (cons V675 (cons string ()))) (if (number? V675) (cons type (cons V675 (cons number ()))) (if (boolean? V675) (cons type (cons V675 (cons boolean ()))) (if (symbol? V675) (cons type (cons V675 (cons symbol ()))) V675)))))
+
+(defun shen.store-arity (V678 V679) (cond ((value shen.*installing-kl*) shen.skip) (true (put V678 arity V679 (value *property-vector*)))))
+
+(defun shen.reduce (V680) (do (set shen.*teststack* ()) (let Result (shen.reduce_help V680) (cons (cons : (cons shen.tests (reverse (value shen.*teststack*)))) (cons Result ())))))
+
+(defun shen.reduce_help (V681) (cond ((and (cons? V681) (and (cons? (hd V681)) (and (= /. (hd (hd V681))) (and (cons? (tl (hd V681))) (and (cons? (hd (tl (hd V681)))) (and (= cons (hd (hd (tl (hd V681))))) (and (cons? (tl (hd (tl (hd V681))))) (and (cons? (tl (tl (hd (tl (hd V681)))))) (and (= () (tl (tl (tl (hd (tl (hd V681))))))) (and (cons? (tl (tl (hd V681)))) (and (= () (tl (tl (tl (hd V681))))) (and (cons? (tl V681)) (= () (tl (tl V681))))))))))))))) (do (shen.add_test (cons cons? (tl V681))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V681))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V681)))))) (cons (shen.ebr (hd (tl V681)) (hd (tl (hd V681))) (hd (tl (tl (hd V681))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hd (tl V681)) ())) (cons (cons tl (tl V681)) ())) (shen.reduce_help Application))))) ((and (cons? V681) (and (cons? (hd V681)) (and (= /. (hd (hd V681))) (and (cons? (tl (hd V681))) (and (cons? (hd (tl (hd V681)))) (and (= @p (hd (hd (tl (hd V681))))) (and (cons? (tl (hd (tl (hd V681))))) (and (cons? (tl (tl (hd (tl (hd V681)))))) (and (= () (tl (tl (tl (hd (tl (hd V681))))))) (and (cons? (tl (tl (hd V681)))) (and (= () (tl (tl (tl (hd V681))))) (and (cons? (tl V681)) (= () (tl (tl V681))))))))))))))) (do (shen.add_test (cons tuple? (tl V681))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V681))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V681)))))) (cons (shen.ebr (hd (tl V681)) (hd (tl (hd V681))) (hd (tl (tl (hd V681))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons fst (tl V681)) ())) (cons (cons snd (tl V681)) ())) (shen.reduce_help Application))))) ((and (cons? V681) (and (cons? (hd V681)) (and (= /. (hd (hd V681))) (and (cons? (tl (hd V681))) (and (cons? (hd (tl (hd V681)))) (and (= @v (hd (hd (tl (hd V681))))) (and (cons? (tl (hd (tl (hd V681))))) (and (cons? (tl (tl (hd (tl (hd V681)))))) (and (= () (tl (tl (tl (hd (tl (hd V681))))))) (and (cons? (tl (tl (hd V681)))) (and (= () (tl (tl (tl (hd V681))))) (and (cons? (tl V681)) (= () (tl (tl V681))))))))))))))) (do (shen.add_test (cons shen.+vector? (tl V681))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V681))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V681)))))) (cons (shen.ebr (hd (tl V681)) (hd (tl (hd V681))) (hd (tl (tl (hd V681))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons hdv (tl V681)) ())) (cons (cons tlv (tl V681)) ())) (shen.reduce_help Application))))) ((and (cons? V681) (and (cons? (hd V681)) (and (= /. (hd (hd V681))) (and (cons? (tl (hd V681))) (and (cons? (hd (tl (hd V681)))) (and (= @s (hd (hd (tl (hd V681))))) (and (cons? (tl (hd (tl (hd V681))))) (and (cons? (tl (tl (hd (tl (hd V681)))))) (and (= () (tl (tl (tl (hd (tl (hd V681))))))) (and (cons? (tl (tl (hd V681)))) (and (= () (tl (tl (tl (hd V681))))) (and (cons? (tl V681)) (= () (tl (tl V681))))))))))))))) (do (shen.add_test (cons shen.+string? (tl V681))) (let Abstraction (cons /. (cons (hd (tl (hd (tl (hd V681))))) (cons (cons /. (cons (hd (tl (tl (hd (tl (hd V681)))))) (cons (shen.ebr (hd (tl V681)) (hd (tl (hd V681))) (hd (tl (tl (hd V681))))) ()))) ()))) (let Application (cons (cons Abstraction (cons (cons pos (cons (hd (tl V681)) (cons 0 ()))) ())) (cons (cons tlstr (tl V681)) ())) (shen.reduce_help Application))))) ((and (cons? V681) (and (cons? (hd V681)) (and (= /. (hd (hd V681))) (and (cons? (tl (hd V681))) (and (cons? (tl (tl (hd V681)))) (and (= () (tl (tl (tl (hd V681))))) (and (cons? (tl V681)) (and (= () (tl (tl V681))) (not (variable? (hd (tl (hd V681))))))))))))) (do (shen.add_test (cons = (cons (hd (tl (hd V681))) (tl V681)))) (shen.reduce_help (hd (tl (tl (hd V681))))))) ((and (cons? V681) (and (cons? (hd V681)) (and (= /. (hd (hd V681))) (and (cons? (tl (hd V681))) (and (cons? (tl (tl (hd V681)))) (and (= () (tl (tl (tl (hd V681))))) (and (cons? (tl V681)) (= () (tl (tl V681)))))))))) (shen.reduce_help (shen.ebr (hd (tl V681)) (hd (tl (hd V681))) (hd (tl (tl (hd V681))))))) ((and (cons? V681) (and (= where (hd V681)) (and (cons? (tl V681)) (and (cons? (tl (tl V681))) (= () (tl (tl (tl V681)))))))) (do (shen.add_test (hd (tl V681))) (shen.reduce_help (hd (tl (tl V681)))))) ((and (cons? V681) (and (cons? (tl V681)) (= () (tl (tl V681))))) (let Z (shen.reduce_help (hd V681)) (if (= (hd V681) Z) V681 (shen.reduce_help (cons Z (tl V681)))))) (true V681)))
+
+(defun shen.+string? (V682) (cond ((= "" V682) false) (true (string? V682))))
+
+(defun shen.+vector (V683) (cond ((= V683 (vector 0)) false) (true (vector? V683))))
+
+(defun shen.ebr (V694 V695 V696) (cond ((= V696 V695) V694) ((and (cons? V696) (and (= /. (hd V696)) (and (cons? (tl V696)) (and (cons? (tl (tl V696))) (and (= () (tl (tl (tl V696)))) (> (occurrences V695 (hd (tl V696))) 0)))))) V696) ((and (cons? V696) (and (= let (hd V696)) (and (cons? (tl V696)) (and (cons? (tl (tl V696))) (and (cons? (tl (tl (tl V696)))) (and (= () (tl (tl (tl (tl V696))))) (= (hd (tl V696)) V695))))))) (cons let (cons (hd (tl V696)) (cons (shen.ebr V694 (hd (tl V696)) (hd (tl (tl V696)))) (tl (tl (tl V696))))))) ((cons? V696) (cons (shen.ebr V694 V695 (hd V696)) (shen.ebr V694 V695 (tl V696)))) (true V696)))
+
+(defun shen.add_test (V697) (set shen.*teststack* (cons V697 (value shen.*teststack*))))
+
+(defun shen.cond-expression (V698 V699 V700) (let Err (shen.err-condition V698) (let Cases (shen.case-form V700 Err) (let EncodeChoices (shen.encode-choices Cases V698) (shen.cond-form EncodeChoices)))))
+
+(defun shen.cond-form (V703) (cond ((and (cons? V703) (and (cons? (hd V703)) (and (= true (hd (hd V703))) (and (cons? (tl (hd V703))) (= () (tl (tl (hd V703)))))))) (hd (tl (hd V703)))) (true (cons cond V703))))
+
+(defun shen.encode-choices (V706 V707) (cond ((= () V706) ()) ((and (cons? V706) (and (cons? (hd V706)) (and (= true (hd (hd V706))) (and (cons? (tl (hd V706))) (and (cons? (hd (tl (hd V706)))) (and (= shen.choicepoint! (hd (hd (tl (hd V706))))) (and (cons? (tl (hd (tl (hd V706))))) (and (= () (tl (tl (hd (tl (hd V706)))))) (and (= () (tl (tl (hd V706)))) (= () (tl V706))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V706))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (if (value shen.*installing-kl*) (cons shen.sys-error (cons V707 ())) (cons shen.f_error (cons V707 ()))) (cons Result ())))) ())))) ())) ())) ((and (cons? V706) (and (cons? (hd V706)) (and (= true (hd (hd V706))) (and (cons? (tl (hd V706))) (and (cons? (hd (tl (hd V706)))) (and (= shen.choicepoint! (hd (hd (tl (hd V706))))) (and (cons? (tl (hd (tl (hd V706))))) (and (= () (tl (tl (hd (tl (hd V706)))))) (= () (tl (tl (hd V706)))))))))))) (cons (cons true (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V706))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (shen.cond-form (shen.encode-choices (tl V706) V707)) (cons Result ())))) ())))) ())) ())) ((and (cons? V706) (and (cons? (hd V706)) (and (cons? (tl (hd V706))) (and (cons? (hd (tl (hd V706)))) (and (= shen.choicepoint! (hd (hd (tl (hd V706))))) (and (cons? (tl (hd (tl (hd V706))))) (and (= () (tl (tl (hd (tl (hd V706)))))) (= () (tl (tl (hd V706))))))))))) (cons (cons true (cons (cons let (cons Freeze (cons (cons freeze (cons (shen.cond-form (shen.encode-choices (tl V706) V707)) ())) (cons (cons if (cons (hd (hd V706)) (cons (cons let (cons Result (cons (hd (tl (hd (tl (hd V706))))) (cons (cons if (cons (cons = (cons Result (cons (cons fail ()) ()))) (cons (cons thaw (cons Freeze ())) (cons Result ())))) ())))) (cons (cons thaw (cons Freeze ())) ())))) ())))) ())) ())) ((and (cons? V706) (and (cons? (hd V706)) (and (cons? (tl (hd V706))) (= () (tl (tl (hd V706))))))) (cons (hd V706) (shen.encode-choices (tl V706) V707))) (true (shen.f_error shen.encode-choices))))
+
+(defun shen.case-form (V712 V713) (cond ((= () V712) (cons V713 ())) ((and (cons? V712) (and (cons? (hd V712)) (and (cons? (hd (hd V712))) (and (= : (hd (hd (hd V712)))) (and (cons? (tl (hd (hd V712)))) (and (= shen.tests (hd (tl (hd (hd V712))))) (and (= () (tl (tl (hd (hd V712))))) (and (cons? (tl (hd V712))) (and (cons? (hd (tl (hd V712)))) (and (= shen.choicepoint! (hd (hd (tl (hd V712))))) (and (cons? (tl (hd (tl (hd V712))))) (and (= () (tl (tl (hd (tl (hd V712)))))) (= () (tl (tl (hd V712)))))))))))))))) (cons (cons true (tl (hd V712))) (shen.case-form (tl V712) V713))) ((and (cons? V712) (and (cons? (hd V712)) (and (cons? (hd (hd V712))) (and (= : (hd (hd (hd V712)))) (and (cons? (tl (hd (hd V712)))) (and (= shen.tests (hd (tl (hd (hd V712))))) (and (= () (tl (tl (hd (hd V712))))) (and (cons? (tl (hd V712))) (= () (tl (tl (hd V712)))))))))))) (cons (cons true (tl (hd V712))) ())) ((and (cons? V712) (and (cons? (hd V712)) (and (cons? (hd (hd V712))) (and (= : (hd (hd (hd V712)))) (and (cons? (tl (hd (hd V712)))) (and (= shen.tests (hd (tl (hd (hd V712))))) (and (cons? (tl (hd V712))) (= () (tl (tl (hd V712))))))))))) (cons (cons (shen.embed-and (tl (tl (hd (hd V712))))) (tl (hd V712))) (shen.case-form (tl V712) V713))) (true (shen.f_error shen.case-form))))
+
+(defun shen.embed-and (V714) (cond ((and (cons? V714) (= () (tl V714))) (hd V714)) ((cons? V714) (cons and (cons (hd V714) (cons (shen.embed-and (tl V714)) ())))) (true (shen.f_error shen.embed-and))))
+
+(defun shen.err-condition (V715) (cons true (cons (cons shen.f_error (cons V715 ())) ())))
+
+(defun shen.sys-error (V716) (simple-error (cn "system function " (shen.app V716 ": unexpected argument
+" shen.a))))
+
+
+