shen-ruby 0.5.0 → 0.6.0
Sign up to get free protection for your applications and to get access to all the features.
- data/HISTORY.md +8 -0
- data/README.md +7 -7
- data/k_lambda_spec/primitives/boolean_operations_spec.rb +1 -1
- data/lib/kl/compiler.rb +10 -5
- data/lib/kl/primitives/booleans.rb +4 -0
- data/lib/shen_ruby/version.rb +1 -1
- data/shen-ruby.gemspec +1 -1
- data/shen/release/k_lambda/declarations.kl +3 -3
- data/shen/release/k_lambda/macros.kl +43 -37
- data/shen/release/k_lambda/prolog.kl +97 -97
- data/shen/release/k_lambda/reader.kl +67 -67
- data/shen/release/k_lambda/sequent.kl +53 -53
- data/shen/release/k_lambda/sys.kl +106 -104
- data/shen/release/k_lambda/t-star.kl +50 -50
- data/shen/release/k_lambda/toplevel.kl +23 -23
- data/shen/release/k_lambda/track.kl +25 -25
- data/shen/release/k_lambda/types.kl +9 -7
- data/shen/release/k_lambda/writer.kl +22 -22
- data/shen/release/k_lambda/yacc.kl +32 -28
- metadata +3 -3
data/HISTORY.md
CHANGED
|
@@ -1,5 +1,13 @@
|
|
|
1
1
|
# ShenRuby Release History
|
|
2
2
|
|
|
3
|
+
## 0.6.0 - June 11, 2013
|
|
4
|
+
### Features
|
|
5
|
+
- Upgrade to Shen 12
|
|
6
|
+
|
|
7
|
+
### Bug Fixes
|
|
8
|
+
- [KLaSC](https://github.com/gregspurrier/klasc) compliance fixes:
|
|
9
|
+
- if now supports partial application
|
|
10
|
+
|
|
3
11
|
## 0.5.0 - May 12, 2013
|
|
4
12
|
### Features
|
|
5
13
|
- Upgrade to Shen 11
|
data/README.md
CHANGED
|
@@ -1,7 +1,7 @@
|
|
|
1
1
|
# ShenRuby
|
|
2
2
|
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.
|
|
3
3
|
|
|
4
|
-
ShenRuby supports Shen version
|
|
4
|
+
ShenRuby supports Shen version 12, which was released in June, 2013.
|
|
5
5
|
|
|
6
6
|
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, a Shen REPL is only a gem install away.
|
|
7
7
|
|
|
@@ -14,7 +14,7 @@ ShenRuby 0.1.0 began to satisfy the first goal by providing a Shen REPL accessib
|
|
|
14
14
|
## Installation
|
|
15
15
|
NOTE: ShenRuby requires Ruby 1.9 language features. It has been tested with Ruby 1.9.3-p392. It has been lightly tested with Rubinius 2.0.0-head running in 1.9 mode. It is not yet working under JRuby.
|
|
16
16
|
|
|
17
|
-
ShenRuby 0.
|
|
17
|
+
ShenRuby 0.6.0 is the current release. To install it as gem, use the following command:
|
|
18
18
|
|
|
19
19
|
gem install shen-ruby
|
|
20
20
|
|
|
@@ -23,17 +23,17 @@ ShenRuby 0.4.1 is the current release. To install it as gem, use the following c
|
|
|
23
23
|
Once the gem has been installed, the Shen REPL can be launched via the `srrepl` (short for ShenRuby REPL) command. For example:
|
|
24
24
|
|
|
25
25
|
% srrepl
|
|
26
|
-
Loading.... Completed in 8.
|
|
27
|
-
|
|
26
|
+
Loading.... Completed in 8.76 seconds.
|
|
27
|
+
|
|
28
28
|
Shen 2010, copyright (C) 2010 Mark Tarver
|
|
29
29
|
released under the Shen license
|
|
30
|
-
www.shenlanguage.org, version
|
|
30
|
+
www.shenlanguage.org, version 12
|
|
31
31
|
running under Ruby, implementation: ruby 1.9.3
|
|
32
|
-
port 0.
|
|
32
|
+
port 0.6.0 ported by Greg Spurrier
|
|
33
33
|
|
|
34
34
|
|
|
35
35
|
(0-)
|
|
36
|
-
|
|
36
|
+
|
|
37
37
|
Please be patient: the Shen REPL takes a while to load (about 9 seconds on a 2.66 GHz MacBook Pro). This will be addressed in future releases.
|
|
38
38
|
|
|
39
39
|
The `(0-)` seen above is the Shen REPL prompt. The number in the prompt increases after each expression that is entered.
|
|
@@ -2,7 +2,7 @@ require 'spec_helper'
|
|
|
2
2
|
|
|
3
3
|
describe 'Primitives for Boolean Operations' do
|
|
4
4
|
describe 'if special form' do
|
|
5
|
-
include_examples "
|
|
5
|
+
include_examples "partially-applicable function", %w(if true a b)
|
|
6
6
|
|
|
7
7
|
it 'evaluates its first argument' do
|
|
8
8
|
define_kl_do
|
data/lib/kl/compiler.rb
CHANGED
|
@@ -165,13 +165,18 @@ module Kl
|
|
|
165
165
|
|
|
166
166
|
# (if TEST_EXPR TRUE_EXPR FALSE_EXPR)
|
|
167
167
|
def compile_if(form, lexical_vars, in_tail_pos)
|
|
168
|
-
|
|
168
|
+
if form.count == 4
|
|
169
|
+
test_expr, on_true_expr, on_false_expr = destructure_form(form, 3)
|
|
169
170
|
|
|
170
|
-
|
|
171
|
-
|
|
172
|
-
|
|
171
|
+
test_clause = compile(test_expr, lexical_vars, false)
|
|
172
|
+
true_clause = compile(on_true_expr, lexical_vars, in_tail_pos)
|
|
173
|
+
false_clause = compile(on_false_expr, lexical_vars, in_tail_pos)
|
|
173
174
|
|
|
174
|
-
|
|
175
|
+
"(#{test_clause} ? #{true_clause} : #{false_clause})"
|
|
176
|
+
else
|
|
177
|
+
# Partial application falls back to normal application
|
|
178
|
+
compile_application(form, lexical_vars, in_tail_pos)
|
|
179
|
+
end
|
|
175
180
|
end
|
|
176
181
|
|
|
177
182
|
# (and EXPR1 EXPR2)
|
data/lib/shen_ruby/version.rb
CHANGED
data/shen-ruby.gemspec
CHANGED
|
@@ -12,7 +12,7 @@ Gem::Specification.new do |s|
|
|
|
12
12
|
s.email = ["greg@sourcematters.org"]
|
|
13
13
|
s.homepage = "https://github.com/gregspurrier/shen-ruby"
|
|
14
14
|
s.summary = %q{ShenRuby is a Ruby port of the Shen programming language}
|
|
15
|
-
s.description = %q{ShenRuby is a port of the Shen programming language to Ruby. It currently supports Shen version
|
|
15
|
+
s.description = %q{ShenRuby is a port of the Shen programming language to Ruby. It currently supports Shen version 12.}
|
|
16
16
|
|
|
17
17
|
s.required_ruby_version = ">= 1.9.3"
|
|
18
18
|
|
|
@@ -75,7 +75,7 @@
|
|
|
75
75
|
|
|
76
76
|
(set shen.*special* (cons @p (cons @s (cons @v (cons cons (cons lambda (cons let (cons type (cons where (cons set (cons open ())))))))))))
|
|
77
77
|
|
|
78
|
-
(set shen.*extraspecial* (cons define (cons shen.process-datatype (cons input+ (cons defcc (cons read+ ()))))))
|
|
78
|
+
(set shen.*extraspecial* (cons define (cons shen.process-datatype (cons input+ (cons defcc (cons read+ (cons defmacro ())))))))
|
|
79
79
|
|
|
80
80
|
(set shen.*spy* false)
|
|
81
81
|
|
|
@@ -113,13 +113,13 @@
|
|
|
113
113
|
|
|
114
114
|
(defun arity (V823) (trap-error (get V823 arity (value *property-vector*)) (lambda E -1)))
|
|
115
115
|
|
|
116
|
-
(shen.initialise_arity_table (cons absvector (cons 1 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons boolean? (cons 1 (cons cd (cons 1 (cons compile (cons 3 (cons concat (cons 2 (cons cons (cons 2 (cons cons? (cons 1 (cons cn (cons 2 (cons declare (cons 2 (cons destroy (cons 1 (cons difference (cons 2 (cons do (cons 2 (cons element? (cons 2 (cons empty? (cons 1 (cons enable-type-theory (cons 1 (cons interror (cons 2 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 5 (cons freeze (cons 1 (cons fst (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons if (cons 3 (cons integer? (cons 1 (cons intern (cons 1 (cons identical (cons 4 (cons inferences (cons 0 (cons intersection (cons 2 (cons length (cons 1 (cons lineread (cons 0 (cons load (cons 1 (cons < (cons 2 (cons <= (cons 2 (cons vector (cons 1 (cons macroexpand (cons 1 (cons map (cons 2 (cons mapcan (cons 2 (cons maxinferences (cons 1 (cons not (cons 1 (cons nth (cons 2 (cons n->string (cons 1 (cons number? (cons 1 (cons occurs-check (cons 1 (cons occurrences (cons 2 (cons occurs-check (cons 1 (cons optimise (cons 1 (cons or (cons 2 (cons package (cons 3 (cons pos (cons 2 (cons print (cons 1 (cons profile (cons 1 (cons profile-results (cons 0 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons address-> (cons 3 (cons put (cons 4 (cons shen.reassemble (cons 2 (cons read-file-as-string (cons 1 (cons read-file (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons remove (cons 2 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 1 (cons spy (cons 1 (cons step (cons 1 (cons stinput (cons 0 (cons stoutput (cons 0 (cons string->n (cons 1 (cons string->symbol (cons 1 (cons string? (cons 1 (cons shen.strong-warning (cons 1 (cons subst (cons 3 (cons shen.sum (cons 1 (cons symbol? (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 1 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons 1 (cons return (cons 3 (cons undefmacro (cons 1 (cons unprofile (cons 1 (cons unify (cons 4 (cons unify! (cons 4 (cons union (cons 2 (cons untrack (cons 1 (cons unspecialise (cons 1 (cons undefmacro (cons 1 (cons vector (cons 1 (cons vector-> (cons 3 (cons value (cons 1 (cons variable? (cons 1 (cons version (cons 1 (cons warn (cons 1 (cons write-to-file (cons 2 (cons y-or-n? (cons 1 (cons + (cons 2 (cons * (cons 2 (cons / (cons 2 (cons - (cons 2 (cons == (cons 2 (cons <e> (cons 1 (cons @p (cons 2 (cons @v (cons 2 (cons @s (cons 2 (cons preclude (cons 1 (cons include (cons 1 (cons preclude-all-but (cons 1 (cons include-all-but (cons 1 (cons where (cons 2 ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
|
|
116
|
+
(shen.initialise_arity_table (cons absvector (cons 1 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons boolean? (cons 1 (cons cd (cons 1 (cons compile (cons 3 (cons concat (cons 2 (cons cons (cons 2 (cons cons? (cons 1 (cons cn (cons 2 (cons declare (cons 2 (cons destroy (cons 1 (cons difference (cons 2 (cons do (cons 2 (cons element? (cons 2 (cons empty? (cons 1 (cons enable-type-theory (cons 1 (cons interror (cons 2 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 5 (cons freeze (cons 1 (cons fst (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons if (cons 3 (cons integer? (cons 1 (cons intern (cons 1 (cons identical (cons 4 (cons inferences (cons 0 (cons intersection (cons 2 (cons kill (cons 0 (cons length (cons 1 (cons lineread (cons 0 (cons load (cons 1 (cons < (cons 2 (cons <= (cons 2 (cons vector (cons 1 (cons macroexpand (cons 1 (cons map (cons 2 (cons mapcan (cons 2 (cons maxinferences (cons 1 (cons not (cons 1 (cons nth (cons 2 (cons n->string (cons 1 (cons number? (cons 1 (cons occurs-check (cons 1 (cons occurrences (cons 2 (cons occurs-check (cons 1 (cons optimise (cons 1 (cons or (cons 2 (cons package (cons 3 (cons pos (cons 2 (cons print (cons 1 (cons profile (cons 1 (cons profile-results (cons 0 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons address-> (cons 3 (cons put (cons 4 (cons shen.reassemble (cons 2 (cons read-file-as-string (cons 1 (cons read-file (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons remove (cons 2 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 1 (cons spy (cons 1 (cons step (cons 1 (cons stinput (cons 0 (cons stoutput (cons 0 (cons string->n (cons 1 (cons string->symbol (cons 1 (cons string? (cons 1 (cons shen.strong-warning (cons 1 (cons subst (cons 3 (cons shen.sum (cons 1 (cons symbol? (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 1 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons 1 (cons return (cons 3 (cons undefmacro (cons 1 (cons unprofile (cons 1 (cons unify (cons 4 (cons unify! (cons 4 (cons union (cons 2 (cons untrack (cons 1 (cons unspecialise (cons 1 (cons undefmacro (cons 1 (cons vector (cons 1 (cons vector-> (cons 3 (cons value (cons 1 (cons variable? (cons 1 (cons version (cons 1 (cons warn (cons 1 (cons write-to-file (cons 2 (cons y-or-n? (cons 1 (cons + (cons 2 (cons * (cons 2 (cons / (cons 2 (cons - (cons 2 (cons == (cons 2 (cons <e> (cons 1 (cons @p (cons 2 (cons @v (cons 2 (cons @s (cons 2 (cons preclude (cons 1 (cons include (cons 1 (cons preclude-all-but (cons 1 (cons include-all-but (cons 1 (cons where (cons 2 ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
|
|
117
117
|
|
|
118
118
|
(defun systemf (V824) (let Shen (intern "shen") (let External (get Shen shen.external-symbols (value *property-vector*)) (put Shen shen.external-symbols (adjoin V824 External) (value *property-vector*)))))
|
|
119
119
|
|
|
120
120
|
(defun adjoin (V825 V826) (if (element? V825 V826) V826 (cons V825 V826)))
|
|
121
121
|
|
|
122
|
-
(put (intern "shen") shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons : (cons ; (cons :- (cons := (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons @v (cons @p (cons @s (cons *port* (cons *porters* (cons *hush* (cons <- (cons -> (cons <e> (cons == (cons = (cons >= (cons > (cons /. (cons =! (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons (vector 0) (cons ==> (cons y-or-n? (cons write-to-file (cons where (cons when (cons warn (cons version (cons verified (cons variable? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons unspecialise (cons untrack (cons unit (cons shen.unix (cons union (cons unify (cons unify! (cons unprofile (cons undefmacro (cons return (cons type (cons tuple? (cons true (cons trap-error (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons symbol (cons symbol? (cons string->symbol (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons stoutput (cons step (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons remove (cons read (cons read+ (cons read-file (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons quit (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons print (cons pr (cons pos (cons package (cons output (cons out (cons or (cons open (cons occurrences (cons occurs-check (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macro (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons include (cons include-all-but (cons in (cons if (cons identical (cons head (cons hd (cons hdv (cons hdstr (cons hash (cons get (cons get-time (cons gensym (cons function (cons fst (cons freeze (cons fix (cons file (cons fail (cons fail-if (cons fwhen (cons findall (cons false (cons enable-type-theory (cons explode (cons external (cons exception (cons eval-kl (cons eval (cons error-to-string (cons error (cons empty? (cons element? (cons do (cons difference (cons destroy (cons defun (cons define (cons defmacro (cons defcc (cons defprolog (cons declare (cons datatype (cons cut (cons cn (cons cons? (cons cons (cons cond (cons concat (cons compile (cons cd (cons cases (cons call (cons close (cons bind (cons bound? (cons boolean? (cons boolean (cons bar! (cons assoc (cons arity (cons append (cons and (cons adjoin (cons <-address (cons address-> (cons absvector? (cons absvector (cons abort ())))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*))
|
|
122
|
+
(put (intern "shen") shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons : (cons ; (cons :- (cons := (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons @v (cons @p (cons @s (cons *port* (cons *porters* (cons *hush* (cons <- (cons -> (cons <e> (cons == (cons = (cons >= (cons > (cons /. (cons =! (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons (vector 0) (cons ==> (cons y-or-n? (cons write-to-file (cons where (cons when (cons warn (cons version (cons verified (cons variable? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons unspecialise (cons untrack (cons unit (cons shen.unix (cons union (cons unify (cons unify! (cons unprofile (cons undefmacro (cons return (cons type (cons tuple? (cons true (cons trap-error (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons symbol (cons symbol? (cons string->symbol (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons stoutput (cons step (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons remove (cons read (cons read+ (cons read-file (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons quit (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons print (cons pr (cons pos (cons package (cons output (cons out (cons or (cons open (cons occurrences (cons occurs-check (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macro (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons kill (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons include (cons include-all-but (cons in (cons if (cons identical (cons head (cons hd (cons hdv (cons hdstr (cons hash (cons get (cons get-time (cons gensym (cons function (cons fst (cons freeze (cons fix (cons file (cons fail (cons fail-if (cons fwhen (cons findall (cons false (cons enable-type-theory (cons explode (cons external (cons exception (cons eval-kl (cons eval (cons error-to-string (cons error (cons empty? (cons element? (cons do (cons difference (cons destroy (cons defun (cons define (cons defmacro (cons defcc (cons defprolog (cons declare (cons datatype (cons cut (cons cn (cons cons? (cons cons (cons cond (cons concat (cons compile (cons cd (cons cases (cons call (cons close (cons bind (cons bound? (cons boolean? (cons boolean (cons bar! (cons assoc (cons arity (cons append (cons and (cons adjoin (cons <-address (cons address-> (cons absvector? (cons absvector (cons abort ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*))
|
|
123
123
|
|
|
124
124
|
(defun specialise (V827) (do (set shen.*special* (cons V827 (value shen.*special*))) V827))
|
|
125
125
|
|
|
@@ -47,70 +47,76 @@
|
|
|
47
47
|
* explains this license in full. *
|
|
48
48
|
* *
|
|
49
49
|
*****************************************************************************************
|
|
50
|
-
"(defun macroexpand (
|
|
50
|
+
"(defun macroexpand (V870) (let Y (shen.compose (value *macros*) V870) (if (= V870 Y) V870 (shen.walk (lambda V869 (macroexpand V869)) Y))))
|
|
51
51
|
|
|
52
|
-
(set *macros* (cons shen.timer-macro (cons shen.cases-macro (cons shen.abs-macro (cons shen.put/get-macro (cons shen.compile-macro (cons shen.datatype-macro (cons shen.let-macro (cons shen.assoc-macro (cons shen.make-string-macro (cons shen.output-macro (cons shen.error-macro (cons shen.prolog-macro (cons shen.synonyms-macro (cons shen.nl-macro (cons shen.@s-macro (cons shen.
|
|
52
|
+
(set *macros* (cons shen.timer-macro (cons shen.cases-macro (cons shen.abs-macro (cons shen.put/get-macro (cons shen.compile-macro (cons shen.datatype-macro (cons shen.let-macro (cons shen.assoc-macro (cons shen.make-string-macro (cons shen.output-macro (cons shen.error-macro (cons shen.prolog-macro (cons shen.synonyms-macro (cons shen.nl-macro (cons shen.@s-macro (cons shen.defprolog-macro (cons shen.function-macro ()))))))))))))))))))
|
|
53
53
|
|
|
54
|
-
(defun shen.error-macro (
|
|
54
|
+
(defun shen.error-macro (V871) (cond ((and (cons? V871) (and (= error (hd V871)) (cons? (tl V871)))) (cons simple-error (cons (shen.mkstr (hd (tl V871)) (tl (tl V871))) ()))) (true V871)))
|
|
55
55
|
|
|
56
|
-
(defun shen.output-macro (
|
|
56
|
+
(defun shen.output-macro (V872) (cond ((and (cons? V872) (and (= output (hd V872)) (cons? (tl V872)))) (cons shen.prhush (cons (shen.mkstr (hd (tl V872)) (tl (tl V872))) (cons (cons stoutput ()) ())))) (true V872)))
|
|
57
57
|
|
|
58
|
-
(defun shen.make-string-macro (
|
|
58
|
+
(defun shen.make-string-macro (V873) (cond ((and (cons? V873) (and (= make-string (hd V873)) (cons? (tl V873)))) (shen.mkstr (hd (tl V873)) (tl (tl V873)))) (true V873)))
|
|
59
59
|
|
|
60
|
-
(defun shen.compose (
|
|
60
|
+
(defun shen.compose (V874 V875) (cond ((= () V874) V875) ((cons? V874) (shen.compose (tl V874) ((hd V874) V875))) (true (shen.sys-error shen.compose))))
|
|
61
61
|
|
|
62
|
-
(defun shen.compile-macro (
|
|
62
|
+
(defun shen.compile-macro (V876) (cond ((and (cons? V876) (and (= compile (hd V876)) (and (cons? (tl V876)) (and (cons? (tl (tl V876))) (= () (tl (tl (tl V876)))))))) (cons compile (cons (hd (tl V876)) (cons (hd (tl (tl V876))) (cons (cons lambda (cons E (cons (cons if (cons (cons cons? (cons E ())) (cons (cons error (cons "parse error here: ~S~%" (cons E ()))) (cons (cons error (cons "parse error~%" ())) ())))) ()))) ()))))) (true V876)))
|
|
63
63
|
|
|
64
|
-
(defun shen.prolog-macro (
|
|
64
|
+
(defun shen.prolog-macro (V877) (cond ((and (cons? V877) (= prolog? (hd V877))) (cons shen.intprolog (cons (shen.prolog-form (tl V877)) ()))) (true V877)))
|
|
65
65
|
|
|
66
|
-
(defun shen.defprolog-macro (
|
|
66
|
+
(defun shen.defprolog-macro (V878) (cond ((and (cons? V878) (and (= defprolog (hd V878)) (cons? (tl V878)))) (compile shen.<defprolog> (tl V878) (lambda Y (shen.prolog-error (hd (tl V878)) Y)))) (true V878)))
|
|
67
67
|
|
|
68
|
-
(defun shen.prolog-form (
|
|
68
|
+
(defun shen.prolog-form (V879) (shen.cons_form (map shen.cons_form V879)))
|
|
69
69
|
|
|
70
|
-
(defun shen.datatype-macro (
|
|
70
|
+
(defun shen.datatype-macro (V880) (cond ((and (cons? V880) (and (= datatype (hd V880)) (cons? (tl V880)))) (cons shen.process-datatype (cons (shen.intern-type (hd (tl V880))) (cons (cons compile (cons (cons function (cons shen.<datatype-rules> ())) (cons (shen.rcons_form (tl (tl V880))) (cons (cons function (cons shen.datatype-error ())) ())))) ())))) (true V880)))
|
|
71
71
|
|
|
72
|
-
(defun shen.intern-type (
|
|
72
|
+
(defun shen.intern-type (V881) (intern (cn "type#" (str V881))))
|
|
73
73
|
|
|
74
|
-
(
|
|
74
|
+
"(defcc <defmacro>
|
|
75
|
+
<name> <macrorules> := [define <name> | <macrorules>];)
|
|
76
|
+
|
|
77
|
+
(defcc <macrorules>
|
|
78
|
+
<macrorule> <macrorules>;
|
|
79
|
+
<macrorule> := (append <macrorule> [(protect X) -> (protect X)]);)
|
|
80
|
+
|
|
81
|
+
(defcc <macrorule>
|
|
82
|
+
<patterns> -> <macroaction> where <guard>;
|
|
83
|
+
<patterns> -> <macroaction>;
|
|
84
|
+
<patterns> <- <macroaction> where <guard>;
|
|
85
|
+
<patterns> <- <macroaction>;)
|
|
86
|
+
|
|
87
|
+
(defcc <macroaction>
|
|
88
|
+
<action> := [[walk [function macroexpand] <action>]];)"
|
|
75
89
|
|
|
76
|
-
(defun shen
|
|
90
|
+
(defun shen.@s-macro (V882) (cond ((and (cons? V882) (and (= @s (hd V882)) (and (cons? (tl V882)) (and (cons? (tl (tl V882))) (cons? (tl (tl (tl V882)))))))) (cons @s (cons (hd (tl V882)) (cons (shen.@s-macro (cons @s (tl (tl V882)))) ())))) ((and (cons? V882) (and (= @s (hd V882)) (and (cons? (tl V882)) (and (cons? (tl (tl V882))) (and (= () (tl (tl (tl V882)))) (string? (hd (tl V882)))))))) (let E (explode (hd (tl V882))) (if (> (length E) 1) (shen.@s-macro (cons @s (append E (tl (tl V882))))) V882))) (true V882)))
|
|
77
91
|
|
|
78
|
-
(defun shen
|
|
92
|
+
(defun shen.synonyms-macro (V883) (cond ((and (cons? V883) (= synonyms (hd V883))) (cons shen.synonyms-help (cons (shen.rcons_form (tl V883)) ()))) (true V883)))
|
|
79
93
|
|
|
80
|
-
(defun shen
|
|
94
|
+
(defun shen.nl-macro (V884) (cond ((and (cons? V884) (and (= nl (hd V884)) (= () (tl V884)))) (cons nl (cons 1 ()))) (true V884)))
|
|
81
95
|
|
|
82
|
-
(defun shen
|
|
96
|
+
(defun shen.assoc-macro (V885) (cond ((and (cons? V885) (and (cons? (tl V885)) (and (cons? (tl (tl V885))) (and (cons? (tl (tl (tl V885)))) (element? (hd V885) (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ()))))))))))))) (cons (hd V885) (cons (hd (tl V885)) (cons (shen.assoc-macro (cons (hd V885) (tl (tl V885)))) ())))) (true V885)))
|
|
83
97
|
|
|
84
|
-
(defun shen
|
|
98
|
+
(defun shen.let-macro (V886) (cond ((and (cons? V886) (and (= let (hd V886)) (and (cons? (tl V886)) (and (cons? (tl (tl V886))) (and (cons? (tl (tl (tl V886)))) (cons? (tl (tl (tl (tl V886)))))))))) (cons let (cons (hd (tl V886)) (cons (hd (tl (tl V886))) (cons (shen.let-macro (cons let (tl (tl (tl V886))))) ()))))) (true V886)))
|
|
85
99
|
|
|
86
|
-
(defun shen.
|
|
100
|
+
(defun shen.abs-macro (V887) (cond ((and (cons? V887) (and (= /. (hd V887)) (and (cons? (tl V887)) (and (cons? (tl (tl V887))) (cons? (tl (tl (tl V887)))))))) (cons lambda (cons (hd (tl V887)) (cons (shen.abs-macro (cons /. (tl (tl V887)))) ())))) ((and (cons? V887) (and (= /. (hd V887)) (and (cons? (tl V887)) (and (cons? (tl (tl V887))) (= () (tl (tl (tl V887)))))))) (cons lambda (tl V887))) (true V887)))
|
|
87
101
|
|
|
88
|
-
(defun shen.
|
|
102
|
+
(defun shen.cases-macro (V890) (cond ((and (cons? V890) (and (= cases (hd V890)) (and (cons? (tl V890)) (and (= true (hd (tl V890))) (cons? (tl (tl V890))))))) (hd (tl (tl V890)))) ((and (cons? V890) (and (= cases (hd V890)) (and (cons? (tl V890)) (and (cons? (tl (tl V890))) (= () (tl (tl (tl V890)))))))) (cons if (cons (hd (tl V890)) (cons (hd (tl (tl V890))) (cons (cons simple-error (cons "error: cases exhausted" ())) ()))))) ((and (cons? V890) (and (= cases (hd V890)) (and (cons? (tl V890)) (cons? (tl (tl V890)))))) (cons if (cons (hd (tl V890)) (cons (hd (tl (tl V890))) (cons (shen.cases-macro (cons cases (tl (tl (tl V890))))) ()))))) ((and (cons? V890) (and (= cases (hd V890)) (and (cons? (tl V890)) (= () (tl (tl V890)))))) (simple-error "error: odd number of case elements
|
|
103
|
+
")) (true V890)))
|
|
89
104
|
|
|
90
|
-
(defun shen.
|
|
91
|
-
|
|
92
|
-
(defun shen.let-macro (V906) (cond ((and (cons? V906) (and (= let (hd V906)) (and (cons? (tl V906)) (and (cons? (tl (tl V906))) (and (cons? (tl (tl (tl V906)))) (cons? (tl (tl (tl (tl V906)))))))))) (cons let (cons (hd (tl V906)) (cons (hd (tl (tl V906))) (cons (shen.let-macro (cons let (tl (tl (tl V906))))) ()))))) (true V906)))
|
|
93
|
-
|
|
94
|
-
(defun shen.abs-macro (V907) (cond ((and (cons? V907) (and (= /. (hd V907)) (and (cons? (tl V907)) (and (cons? (tl (tl V907))) (cons? (tl (tl (tl V907)))))))) (cons lambda (cons (hd (tl V907)) (cons (shen.abs-macro (cons /. (tl (tl V907)))) ())))) ((and (cons? V907) (and (= /. (hd V907)) (and (cons? (tl V907)) (and (cons? (tl (tl V907))) (= () (tl (tl (tl V907)))))))) (cons lambda (tl V907))) (true V907)))
|
|
95
|
-
|
|
96
|
-
(defun shen.cases-macro (V910) (cond ((and (cons? V910) (and (= cases (hd V910)) (and (cons? (tl V910)) (and (= true (hd (tl V910))) (cons? (tl (tl V910))))))) (hd (tl (tl V910)))) ((and (cons? V910) (and (= cases (hd V910)) (and (cons? (tl V910)) (and (cons? (tl (tl V910))) (= () (tl (tl (tl V910)))))))) (cons if (cons (hd (tl V910)) (cons (hd (tl (tl V910))) (cons (cons simple-error (cons "error: cases exhausted" ())) ()))))) ((and (cons? V910) (and (= cases (hd V910)) (and (cons? (tl V910)) (cons? (tl (tl V910)))))) (cons if (cons (hd (tl V910)) (cons (hd (tl (tl V910))) (cons (shen.cases-macro (cons cases (tl (tl (tl V910))))) ()))))) ((and (cons? V910) (and (= cases (hd V910)) (and (cons? (tl V910)) (= () (tl (tl V910)))))) (simple-error "error: odd number of case elements
|
|
97
|
-
")) (true V910)))
|
|
98
|
-
|
|
99
|
-
(defun shen.timer-macro (V911) (cond ((and (cons? V911) (and (= time (hd V911)) (and (cons? (tl V911)) (= () (tl (tl V911)))))) (shen.let-macro (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons (hd (tl V911)) (cons Finish (cons (cons get-time (cons run ())) (cons Time (cons (cons - (cons Finish (cons Start ()))) (cons Message (cons (cons shen.prhush (cons (cons cn (cons "
|
|
105
|
+
(defun shen.timer-macro (V891) (cond ((and (cons? V891) (and (= time (hd V891)) (and (cons? (tl V891)) (= () (tl (tl V891)))))) (shen.let-macro (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons (hd (tl V891)) (cons Finish (cons (cons get-time (cons run ())) (cons Time (cons (cons - (cons Finish (cons Start ()))) (cons Message (cons (cons shen.prhush (cons (cons cn (cons "
|
|
100
106
|
run time: " (cons (cons cn (cons (cons str (cons Time ())) (cons " secs
|
|
101
|
-
" ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ())))))))))))))) (true
|
|
107
|
+
" ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ())))))))))))))) (true V891)))
|
|
102
108
|
|
|
103
|
-
(defun shen.tuple-up (
|
|
109
|
+
(defun shen.tuple-up (V892) (cond ((cons? V892) (cons @p (cons (hd V892) (cons (shen.tuple-up (tl V892)) ())))) (true V892)))
|
|
104
110
|
|
|
105
|
-
(defun shen.put/get-macro (
|
|
111
|
+
(defun shen.put/get-macro (V893) (cond ((and (cons? V893) (and (= put (hd V893)) (and (cons? (tl V893)) (and (cons? (tl (tl V893))) (and (cons? (tl (tl (tl V893)))) (= () (tl (tl (tl (tl V893)))))))))) (cons put (cons (hd (tl V893)) (cons (hd (tl (tl V893))) (cons (hd (tl (tl (tl V893)))) (cons (cons value (cons *property-vector* ())) ())))))) ((and (cons? V893) (and (= get (hd V893)) (and (cons? (tl V893)) (and (cons? (tl (tl V893))) (= () (tl (tl (tl V893)))))))) (cons get (cons (hd (tl V893)) (cons (hd (tl (tl V893))) (cons (cons value (cons *property-vector* ())) ()))))) (true V893)))
|
|
106
112
|
|
|
107
|
-
(defun shen.function-macro (
|
|
113
|
+
(defun shen.function-macro (V894) (cond ((and (cons? V894) (and (= function (hd V894)) (and (cons? (tl V894)) (= () (tl (tl V894)))))) (shen.function-abstraction (hd (tl V894)) (arity (hd (tl V894))))) (true V894)))
|
|
108
114
|
|
|
109
|
-
(defun shen.function-abstraction (
|
|
115
|
+
(defun shen.function-abstraction (V895 V896) (cond ((= 0 V896) (cons freeze (cons V895 ()))) ((= -1 V896) V895) (true (shen.function-abstraction-help V895 V896 ()))))
|
|
110
116
|
|
|
111
|
-
(defun shen.function-abstraction-help (
|
|
117
|
+
(defun shen.function-abstraction-help (V897 V898 V899) (cond ((= 0 V898) (cons V897 V899)) (true (let X (gensym V) (cons /. (cons X (cons (shen.function-abstraction-help V897 (- V898 1) (append V899 (cons X ()))) ())))))))
|
|
112
118
|
|
|
113
|
-
(defun undefmacro (
|
|
119
|
+
(defun undefmacro (V900) (do (set *macros* (remove V900 (value *macros*))) V900))
|
|
114
120
|
|
|
115
121
|
|
|
116
122
|
|
|
@@ -47,206 +47,206 @@
|
|
|
47
47
|
* explains this license in full. *
|
|
48
48
|
* *
|
|
49
49
|
*****************************************************************************************
|
|
50
|
-
"(defun shen.<defprolog> (
|
|
50
|
+
"(defun shen.<defprolog> (V907) (let Result (let Parse_shen.<predicate*> (shen.<predicate*> V907) (if (not (= (fail) Parse_shen.<predicate*>)) (let Parse_shen.<clauses*> (shen.<clauses*> Parse_shen.<predicate*>) (if (not (= (fail) Parse_shen.<clauses*>)) (shen.pair (hd Parse_shen.<clauses*>) (hd (shen.prolog->shen (map (lambda Parse_X (shen.insert-predicate (shen.hdtl Parse_shen.<predicate*>) Parse_X)) (shen.hdtl Parse_shen.<clauses*>))))) (fail))) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
51
51
|
|
|
52
|
-
(defun shen.prolog-error (
|
|
52
|
+
(defun shen.prolog-error (V914 V915) (cond ((and (cons? V915) (and (cons? (tl V915)) (= () (tl (tl V915))))) (simple-error (cn "prolog syntax error in " (shen.app V914 (cn " here:
|
|
53
53
|
|
|
54
|
-
" (shen.app (shen.next-50 50 (hd
|
|
55
|
-
" shen.a)) shen.a)))) (true (simple-error (cn "prolog syntax error in " (shen.app
|
|
54
|
+
" (shen.app (shen.next-50 50 (hd V915)) "
|
|
55
|
+
" shen.a)) shen.a)))) (true (simple-error (cn "prolog syntax error in " (shen.app V914 "
|
|
56
56
|
" shen.a))))))
|
|
57
57
|
|
|
58
|
-
(defun shen.next-50 (
|
|
58
|
+
(defun shen.next-50 (V920 V921) (cond ((= () V921) "") ((= 0 V920) "") ((cons? V921) (cn (shen.decons-string (hd V921)) (shen.next-50 (- V920 1) (tl V921)))) (true (shen.sys-error shen.next-50))))
|
|
59
59
|
|
|
60
|
-
(defun shen.decons-string (
|
|
60
|
+
(defun shen.decons-string (V922) (cond ((and (cons? V922) (and (= cons (hd V922)) (and (cons? (tl V922)) (and (cons? (tl (tl V922))) (= () (tl (tl (tl V922)))))))) (shen.app (shen.eval-cons V922) " " shen.s)) (true (shen.app V922 " " shen.r))))
|
|
61
61
|
|
|
62
|
-
(defun shen.insert-predicate (
|
|
62
|
+
(defun shen.insert-predicate (V923 V924) (cond ((and (cons? V924) (and (cons? (tl V924)) (= () (tl (tl V924))))) (cons (cons V923 (hd V924)) (cons :- (tl V924)))) (true (shen.sys-error shen.insert-predicate))))
|
|
63
63
|
|
|
64
|
-
(defun shen.<predicate*> (
|
|
64
|
+
(defun shen.<predicate*> (V929) (let Result (if (cons? (hd V929)) (let Parse_X (hd (hd V929)) (shen.pair (hd (shen.pair (tl (hd V929)) (shen.hdtl V929))) Parse_X)) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
65
65
|
|
|
66
|
-
(defun shen.<clauses*> (
|
|
66
|
+
(defun shen.<clauses*> (V934) (let Result (let Parse_shen.<clause*> (shen.<clause*> V934) (if (not (= (fail) Parse_shen.<clause*>)) (let Parse_shen.<clauses*> (shen.<clauses*> Parse_shen.<clause*>) (if (not (= (fail) Parse_shen.<clauses*>)) (shen.pair (hd Parse_shen.<clauses*>) (cons (shen.hdtl Parse_shen.<clause*>) (shen.hdtl Parse_shen.<clauses*>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V934) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) (append (shen.hdtl Parse_<e>) ())) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
67
67
|
|
|
68
|
-
(defun shen.<clause*> (
|
|
68
|
+
(defun shen.<clause*> (V939) (let Result (let Parse_shen.<head*> (shen.<head*> V939) (if (not (= (fail) Parse_shen.<head*>)) (if (and (cons? (hd Parse_shen.<head*>)) (= <-- (hd (hd Parse_shen.<head*>)))) (let Parse_shen.<body*> (shen.<body*> (shen.pair (tl (hd Parse_shen.<head*>)) (shen.hdtl Parse_shen.<head*>))) (if (not (= (fail) Parse_shen.<body*>)) (let Parse_shen.<end*> (shen.<end*> Parse_shen.<body*>) (if (not (= (fail) Parse_shen.<end*>)) (shen.pair (hd Parse_shen.<end*>) (cons (shen.hdtl Parse_shen.<head*>) (cons (shen.hdtl Parse_shen.<body*>) ()))) (fail))) (fail))) (fail)) (fail))) (if (= Result (fail)) (fail) Result)))
|
|
69
69
|
|
|
70
|
-
(defun shen.<head*> (
|
|
70
|
+
(defun shen.<head*> (V944) (let Result (let Parse_shen.<term*> (shen.<term*> V944) (if (not (= (fail) Parse_shen.<term*>)) (let Parse_shen.<head*> (shen.<head*> Parse_shen.<term*>) (if (not (= (fail) Parse_shen.<head*>)) (shen.pair (hd Parse_shen.<head*>) (cons (shen.hdtl Parse_shen.<term*>) (shen.hdtl Parse_shen.<head*>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V944) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) (append (shen.hdtl Parse_<e>) ())) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
71
71
|
|
|
72
|
-
(defun shen.<term*> (
|
|
72
|
+
(defun shen.<term*> (V949) (let Result (if (cons? (hd V949)) (let Parse_X (hd (hd V949)) (if (and (not (= <-- Parse_X)) (shen.legitimate-term? Parse_X)) (shen.pair (hd (shen.pair (tl (hd V949)) (shen.hdtl V949))) (shen.eval-cons Parse_X)) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
73
73
|
|
|
74
|
-
(defun shen.legitimate-term? (
|
|
74
|
+
(defun shen.legitimate-term? (V954) (cond ((and (cons? V954) (and (= cons (hd V954)) (and (cons? (tl V954)) (and (cons? (tl (tl V954))) (= () (tl (tl (tl V954)))))))) (and (shen.legitimate-term? (hd (tl V954))) (shen.legitimate-term? (hd (tl (tl V954)))))) ((and (cons? V954) (and (= mode (hd V954)) (and (cons? (tl V954)) (and (cons? (tl (tl V954))) (and (= + (hd (tl (tl V954)))) (= () (tl (tl (tl V954))))))))) (shen.legitimate-term? (hd (tl V954)))) ((and (cons? V954) (and (= mode (hd V954)) (and (cons? (tl V954)) (and (cons? (tl (tl V954))) (and (= - (hd (tl (tl V954)))) (= () (tl (tl (tl V954))))))))) (shen.legitimate-term? (hd (tl V954)))) ((cons? V954) false) (true true)))
|
|
75
75
|
|
|
76
|
-
(defun shen.eval-cons (
|
|
76
|
+
(defun shen.eval-cons (V955) (cond ((and (cons? V955) (and (= cons (hd V955)) (and (cons? (tl V955)) (and (cons? (tl (tl V955))) (= () (tl (tl (tl V955)))))))) (cons (shen.eval-cons (hd (tl V955))) (shen.eval-cons (hd (tl (tl V955)))))) ((and (cons? V955) (and (= mode (hd V955)) (and (cons? (tl V955)) (and (cons? (tl (tl V955))) (= () (tl (tl (tl V955)))))))) (cons mode (cons (shen.eval-cons (hd (tl V955))) (tl (tl V955))))) (true V955)))
|
|
77
77
|
|
|
78
|
-
(defun shen.<body*> (
|
|
78
|
+
(defun shen.<body*> (V960) (let Result (let Parse_shen.<literal*> (shen.<literal*> V960) (if (not (= (fail) Parse_shen.<literal*>)) (let Parse_shen.<body*> (shen.<body*> Parse_shen.<literal*>) (if (not (= (fail) Parse_shen.<body*>)) (shen.pair (hd Parse_shen.<body*>) (cons (shen.hdtl Parse_shen.<literal*>) (shen.hdtl Parse_shen.<body*>))) (fail))) (fail))) (if (= Result (fail)) (let Result (let Parse_<e> (<e> V960) (if (not (= (fail) Parse_<e>)) (shen.pair (hd Parse_<e>) (append (shen.hdtl Parse_<e>) ())) (fail))) (if (= Result (fail)) (fail) Result)) Result)))
|
|
79
79
|
|
|
80
|
-
(defun shen.<literal*> (
|
|
80
|
+
(defun shen.<literal*> (V965) (let Result (if (and (cons? (hd V965)) (= ! (hd (hd V965)))) (shen.pair (hd (shen.pair (tl (hd V965)) (shen.hdtl V965))) (cons cut (cons (intern "Throwcontrol") ()))) (fail)) (if (= Result (fail)) (let Result (if (cons? (hd V965)) (let Parse_X (hd (hd V965)) (if (cons? Parse_X) (shen.pair (hd (shen.pair (tl (hd V965)) (shen.hdtl V965))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)) Result)))
|
|
81
81
|
|
|
82
|
-
(defun shen.<end*> (
|
|
82
|
+
(defun shen.<end*> (V970) (let Result (if (cons? (hd V970)) (let Parse_X (hd (hd V970)) (if (= Parse_X ;) (shen.pair (hd (shen.pair (tl (hd V970)) (shen.hdtl V970))) Parse_X) (fail))) (fail)) (if (= Result (fail)) (fail) Result)))
|
|
83
83
|
|
|
84
|
-
(defun cut (
|
|
84
|
+
(defun cut (V971 V972 V973) (let Result (thaw V973) (if (= Result false) V971 Result)))
|
|
85
85
|
|
|
86
|
-
(defun shen.insert_modes (
|
|
86
|
+
(defun shen.insert_modes (V974) (cond ((and (cons? V974) (and (= mode (hd V974)) (and (cons? (tl V974)) (and (cons? (tl (tl V974))) (= () (tl (tl (tl V974)))))))) V974) ((= () V974) ()) ((cons? V974) (cons (cons mode (cons (hd V974) (cons + ()))) (cons mode (cons (shen.insert_modes (tl V974)) (cons - ()))))) (true V974)))
|
|
87
87
|
|
|
88
|
-
(defun shen.s-prolog (
|
|
88
|
+
(defun shen.s-prolog (V975) (map (lambda V901 (eval V901)) (shen.prolog->shen V975)))
|
|
89
89
|
|
|
90
|
-
(defun shen.prolog->shen (
|
|
90
|
+
(defun shen.prolog->shen (V976) (map shen.compile_prolog_procedure (shen.group_clauses (map shen.s-prolog_clause (mapcan shen.head_abstraction V976)))))
|
|
91
91
|
|
|
92
|
-
(defun shen.s-prolog_clause (
|
|
92
|
+
(defun shen.s-prolog_clause (V977) (cond ((and (cons? V977) (and (cons? (tl V977)) (and (= :- (hd (tl V977))) (and (cons? (tl (tl V977))) (= () (tl (tl (tl V977)))))))) (cons (hd V977) (cons :- (cons (map shen.s-prolog_literal (hd (tl (tl V977)))) ())))) (true (shen.sys-error shen.s-prolog_clause))))
|
|
93
93
|
|
|
94
|
-
(defun shen.head_abstraction (
|
|
94
|
+
(defun shen.head_abstraction (V978) (cond ((and (cons? V978) (and (cons? (tl V978)) (and (= :- (hd (tl V978))) (and (cons? (tl (tl V978))) (and (= () (tl (tl (tl V978)))) (< (shen.complexity_head (hd V978)) (value shen.*maxcomplexity*))))))) (cons V978 ())) ((and (cons? V978) (and (cons? (hd V978)) (and (cons? (tl V978)) (and (= :- (hd (tl V978))) (and (cons? (tl (tl V978))) (= () (tl (tl (tl V978))))))))) (let Terms (map (lambda Y (gensym V)) (tl (hd V978))) (let XTerms (shen.rcons_form (shen.remove_modes (tl (hd V978)))) (let Literal (cons unify (cons (shen.cons_form Terms) (cons XTerms ()))) (let Clause (cons (cons (hd (hd V978)) Terms) (cons :- (cons (cons Literal (hd (tl (tl V978)))) ()))) (cons Clause ())))))) (true (shen.sys-error shen.head_abstraction))))
|
|
95
95
|
|
|
96
|
-
(defun shen.complexity_head (
|
|
96
|
+
(defun shen.complexity_head (V983) (cond ((cons? V983) (shen.product (map shen.complexity (tl V983)))) (true (shen.sys-error shen.complexity_head))))
|
|
97
97
|
|
|
98
|
-
(defun shen.complexity (
|
|
98
|
+
(defun shen.complexity (V991) (cond ((and (cons? V991) (and (= mode (hd V991)) (and (cons? (tl V991)) (and (cons? (hd (tl V991))) (and (= mode (hd (hd (tl V991)))) (and (cons? (tl (hd (tl V991)))) (and (cons? (tl (tl (hd (tl V991))))) (and (= () (tl (tl (tl (hd (tl V991)))))) (and (cons? (tl (tl V991))) (= () (tl (tl (tl V991))))))))))))) (shen.complexity (hd (tl V991)))) ((and (cons? V991) (and (= mode (hd V991)) (and (cons? (tl V991)) (and (cons? (hd (tl V991))) (and (cons? (tl (tl V991))) (and (= + (hd (tl (tl V991)))) (= () (tl (tl (tl V991)))))))))) (* 2 (* (shen.complexity (cons mode (cons (hd (hd (tl V991))) (tl (tl V991))))) (shen.complexity (cons mode (cons (tl (hd (tl V991))) (tl (tl V991)))))))) ((and (cons? V991) (and (= mode (hd V991)) (and (cons? (tl V991)) (and (cons? (hd (tl V991))) (and (cons? (tl (tl V991))) (and (= - (hd (tl (tl V991)))) (= () (tl (tl (tl V991)))))))))) (* (shen.complexity (cons mode (cons (hd (hd (tl V991))) (tl (tl V991))))) (shen.complexity (cons mode (cons (tl (hd (tl V991))) (tl (tl V991))))))) ((and (cons? V991) (and (= mode (hd V991)) (and (cons? (tl V991)) (and (cons? (tl (tl V991))) (and (= () (tl (tl (tl V991)))) (variable? (hd (tl V991)))))))) 1) ((and (cons? V991) (and (= mode (hd V991)) (and (cons? (tl V991)) (and (cons? (tl (tl V991))) (and (= + (hd (tl (tl V991)))) (= () (tl (tl (tl V991))))))))) 2) ((and (cons? V991) (and (= mode (hd V991)) (and (cons? (tl V991)) (and (cons? (tl (tl V991))) (and (= - (hd (tl (tl V991)))) (= () (tl (tl (tl V991))))))))) 1) (true (shen.complexity (cons mode (cons V991 (cons + ())))))))
|
|
99
99
|
|
|
100
|
-
(defun shen.product (
|
|
100
|
+
(defun shen.product (V992) (cond ((= () V992) 1) ((cons? V992) (* (hd V992) (shen.product (tl V992)))) (true (shen.sys-error shen.product))))
|
|
101
101
|
|
|
102
|
-
(defun shen.s-prolog_literal (
|
|
102
|
+
(defun shen.s-prolog_literal (V993) (cond ((and (cons? V993) (and (= is (hd V993)) (and (cons? (tl V993)) (and (cons? (tl (tl V993))) (= () (tl (tl (tl V993)))))))) (cons bind (cons (hd (tl V993)) (cons (shen.insert_deref (hd (tl (tl V993)))) ())))) ((and (cons? V993) (and (= when (hd V993)) (and (cons? (tl V993)) (= () (tl (tl V993)))))) (cons fwhen (cons (shen.insert_deref (hd (tl V993))) ()))) ((and (cons? V993) (and (= bind (hd V993)) (and (cons? (tl V993)) (and (cons? (tl (tl V993))) (= () (tl (tl (tl V993)))))))) (cons bind (cons (hd (tl V993)) (cons (shen.insert_lazyderef (hd (tl (tl V993)))) ())))) ((and (cons? V993) (and (= fwhen (hd V993)) (and (cons? (tl V993)) (= () (tl (tl V993)))))) (cons fwhen (cons (shen.insert_lazyderef (hd (tl V993))) ()))) ((cons? V993) (cons (shen.m_prolog_to_s-prolog_predicate (hd V993)) (tl V993))) (true (shen.sys-error shen.s-prolog_literal))))
|
|
103
103
|
|
|
104
|
-
(defun shen.insert_deref (
|
|
104
|
+
(defun shen.insert_deref (V994) (cond ((variable? V994) (cons shen.deref (cons V994 (cons ProcessN ())))) ((cons? V994) (cons (shen.insert_deref (hd V994)) (shen.insert_deref (tl V994)))) (true V994)))
|
|
105
105
|
|
|
106
|
-
(defun shen.insert_lazyderef (
|
|
106
|
+
(defun shen.insert_lazyderef (V995) (cond ((variable? V995) (cons shen.lazyderef (cons V995 (cons ProcessN ())))) ((cons? V995) (cons (shen.insert_lazyderef (hd V995)) (shen.insert_lazyderef (tl V995)))) (true V995)))
|
|
107
107
|
|
|
108
|
-
(defun shen.m_prolog_to_s-prolog_predicate (
|
|
108
|
+
(defun shen.m_prolog_to_s-prolog_predicate (V996) (cond ((= = V996) unify) ((= =! V996) unify!) ((= == V996) identical) (true V996)))
|
|
109
109
|
|
|
110
|
-
(defun shen.group_clauses (
|
|
110
|
+
(defun shen.group_clauses (V997) (cond ((= () V997) ()) ((cons? V997) (let Group (shen.collect (lambda X (shen.same_predicate? (hd V997) X)) V997) (let Rest (difference V997 Group) (cons Group (shen.group_clauses Rest))))) (true (shen.sys-error shen.group_clauses))))
|
|
111
111
|
|
|
112
|
-
(defun shen.collect (
|
|
112
|
+
(defun shen.collect (V1000 V1001) (cond ((= () V1001) ()) ((cons? V1001) (if (V1000 (hd V1001)) (cons (hd V1001) (shen.collect V1000 (tl V1001))) (shen.collect V1000 (tl V1001)))) (true (shen.sys-error shen.collect))))
|
|
113
113
|
|
|
114
|
-
(defun shen.same_predicate? (
|
|
114
|
+
(defun shen.same_predicate? (V1018 V1019) (cond ((and (cons? V1018) (and (cons? (hd V1018)) (and (cons? V1019) (cons? (hd V1019))))) (= (hd (hd V1018)) (hd (hd V1019)))) (true (shen.sys-error shen.same_predicate?))))
|
|
115
115
|
|
|
116
|
-
(defun shen.compile_prolog_procedure (
|
|
116
|
+
(defun shen.compile_prolog_procedure (V1020) (let F (shen.procedure_name V1020) (let Shen (shen.clauses-to-shen F V1020) Shen)))
|
|
117
117
|
|
|
118
|
-
(defun shen.procedure_name (
|
|
118
|
+
(defun shen.procedure_name (V1033) (cond ((and (cons? V1033) (and (cons? (hd V1033)) (cons? (hd (hd V1033))))) (hd (hd (hd V1033)))) (true (shen.sys-error shen.procedure_name))))
|
|
119
119
|
|
|
120
|
-
(defun shen.clauses-to-shen (
|
|
120
|
+
(defun shen.clauses-to-shen (V1034 V1035) (let Linear (map shen.linearise-clause V1035) (let Arity (shen.prolog-aritycheck V1034 (map (lambda V902 (head V902)) V1035)) (let Parameters (shen.parameters Arity) (let AUM_instructions (map (lambda X (shen.aum X Parameters)) Linear) (let Code (shen.catch-cut (shen.nest-disjunct (map shen.aum_to_shen AUM_instructions))) (let ShenDef (cons define (cons V1034 (append Parameters (append (cons ProcessN (cons Continuation ())) (cons -> (cons Code ())))))) ShenDef)))))))
|
|
121
121
|
|
|
122
|
-
(defun shen.catch-cut (
|
|
122
|
+
(defun shen.catch-cut (V1036) (cond ((not (shen.occurs? cut V1036)) V1036) (true (cons let (cons Throwcontrol (cons (cons shen.catchpoint ()) (cons (cons shen.cutpoint (cons Throwcontrol (cons V1036 ()))) ())))))))
|
|
123
123
|
|
|
124
124
|
(defun shen.catchpoint () (set shen.*catch* (+ 1 (value shen.*catch*))))
|
|
125
125
|
|
|
126
|
-
(defun shen.cutpoint (
|
|
126
|
+
(defun shen.cutpoint (V1041 V1042) (cond ((= V1042 V1041) false) (true V1042)))
|
|
127
127
|
|
|
128
|
-
(defun shen.nest-disjunct (
|
|
128
|
+
(defun shen.nest-disjunct (V1044) (cond ((and (cons? V1044) (= () (tl V1044))) (hd V1044)) ((cons? V1044) (shen.lisp-or (hd V1044) (shen.nest-disjunct (tl V1044)))) (true (shen.sys-error shen.nest-disjunct))))
|
|
129
129
|
|
|
130
|
-
(defun shen.lisp-or (
|
|
130
|
+
(defun shen.lisp-or (V1045 V1046) (cons let (cons Case (cons V1045 (cons (cons if (cons (cons = (cons Case (cons false ()))) (cons V1046 (cons Case ())))) ())))))
|
|
131
131
|
|
|
132
|
-
(defun shen.prolog-aritycheck (
|
|
132
|
+
(defun shen.prolog-aritycheck (V1049 V1050) (cond ((and (cons? V1050) (= () (tl V1050))) (- (length (hd V1050)) 1)) ((and (cons? V1050) (cons? (tl V1050))) (if (= (length (hd V1050)) (length (hd (tl V1050)))) (shen.prolog-aritycheck V1049 (tl V1050)) (simple-error (cn "arity error in prolog procedure " (shen.app (cons V1049 ()) "
|
|
133
133
|
" shen.a))))) (true (shen.sys-error shen.prolog-aritycheck))))
|
|
134
134
|
|
|
135
|
-
(defun shen.linearise-clause (
|
|
135
|
+
(defun shen.linearise-clause (V1051) (cond ((and (cons? V1051) (and (cons? (tl V1051)) (and (= :- (hd (tl V1051))) (and (cons? (tl (tl V1051))) (= () (tl (tl (tl V1051)))))))) (let Linear (shen.linearise (cons (hd V1051) (tl (tl V1051)))) (shen.clause_form Linear))) (true (shen.sys-error shen.linearise-clause))))
|
|
136
136
|
|
|
137
|
-
(defun shen.clause_form (
|
|
137
|
+
(defun shen.clause_form (V1052) (cond ((and (cons? V1052) (and (cons? (tl V1052)) (= () (tl (tl V1052))))) (cons (shen.explicit_modes (hd V1052)) (cons :- (cons (shen.cf_help (hd (tl V1052))) ())))) (true (shen.sys-error shen.clause_form))))
|
|
138
138
|
|
|
139
|
-
(defun shen.explicit_modes (
|
|
139
|
+
(defun shen.explicit_modes (V1053) (cond ((cons? V1053) (cons (hd V1053) (map shen.em_help (tl V1053)))) (true (shen.sys-error shen.explicit_modes))))
|
|
140
140
|
|
|
141
|
-
(defun shen.em_help (
|
|
141
|
+
(defun shen.em_help (V1054) (cond ((and (cons? V1054) (and (= mode (hd V1054)) (and (cons? (tl V1054)) (and (cons? (tl (tl V1054))) (= () (tl (tl (tl V1054)))))))) V1054) (true (cons mode (cons V1054 (cons + ()))))))
|
|
142
142
|
|
|
143
|
-
(defun shen.cf_help (
|
|
143
|
+
(defun shen.cf_help (V1055) (cond ((and (cons? V1055) (and (= where (hd V1055)) (and (cons? (tl V1055)) (and (cons? (hd (tl V1055))) (and (= = (hd (hd (tl V1055)))) (and (cons? (tl (hd (tl V1055)))) (and (cons? (tl (tl (hd (tl V1055))))) (and (= () (tl (tl (tl (hd (tl V1055)))))) (and (cons? (tl (tl V1055))) (= () (tl (tl (tl V1055))))))))))))) (cons (cons (if (value shen.*occurs*) unify! unify) (tl (hd (tl V1055)))) (shen.cf_help (hd (tl (tl V1055)))))) (true V1055)))
|
|
144
144
|
|
|
145
|
-
(defun occurs-check (
|
|
145
|
+
(defun occurs-check (V1060) (cond ((= + V1060) (set shen.*occurs* true)) ((= - V1060) (set shen.*occurs* false)) (true (simple-error "occurs-check expects + or -
|
|
146
146
|
"))))
|
|
147
147
|
|
|
148
|
-
(defun shen.aum (
|
|
148
|
+
(defun shen.aum (V1061 V1062) (cond ((and (cons? V1061) (and (cons? (hd V1061)) (and (cons? (tl V1061)) (and (= :- (hd (tl V1061))) (and (cons? (tl (tl V1061))) (= () (tl (tl (tl V1061))))))))) (let MuApplication (shen.make_mu_application (cons shen.mu (cons (tl (hd V1061)) (cons (shen.continuation_call (tl (hd V1061)) (hd (tl (tl V1061)))) ()))) V1062) (shen.mu_reduction MuApplication +))) (true (shen.sys-error shen.aum))))
|
|
149
149
|
|
|
150
|
-
(defun shen.continuation_call (
|
|
150
|
+
(defun shen.continuation_call (V1063 V1064) (let VTerms (cons ProcessN (shen.extract_vars V1063)) (let VBody (shen.extract_vars V1064) (let Free (remove Throwcontrol (difference VBody VTerms)) (shen.cc_help Free V1064)))))
|
|
151
151
|
|
|
152
|
-
(defun remove (
|
|
152
|
+
(defun remove (V1065 V1066) (shen.remove-h V1065 V1066 ()))
|
|
153
153
|
|
|
154
|
-
(defun shen.remove-h (
|
|
154
|
+
(defun shen.remove-h (V1069 V1070 V1071) (cond ((= () V1070) (reverse V1071)) ((and (cons? V1070) (= (hd V1070) V1069)) (shen.remove-h (hd V1070) (tl V1070) V1071)) ((cons? V1070) (shen.remove-h V1069 (tl V1070) (cons (hd V1070) V1071))) (true (shen.sys-error shen.remove-h))))
|
|
155
155
|
|
|
156
|
-
(defun shen.cc_help (
|
|
156
|
+
(defun shen.cc_help (V1073 V1074) (cond ((and (= () V1073) (= () V1074)) (cons shen.pop (cons shen.the (cons shen.stack ())))) ((= () V1074) (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V1073 (cons and (cons shen.then (cons (cons shen.pop (cons shen.the (cons shen.stack ()))) ()))))))))) ((= () V1073) (cons call (cons shen.the (cons shen.continuation (cons V1074 ()))))) (true (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons V1073 (cons and (cons shen.then (cons (cons call (cons shen.the (cons shen.continuation (cons V1074 ())))) ())))))))))))
|
|
157
157
|
|
|
158
|
-
(defun shen.make_mu_application (
|
|
158
|
+
(defun shen.make_mu_application (V1075 V1076) (cond ((and (cons? V1075) (and (= shen.mu (hd V1075)) (and (cons? (tl V1075)) (and (= () (hd (tl V1075))) (and (cons? (tl (tl V1075))) (and (= () (tl (tl (tl V1075)))) (= () V1076))))))) (hd (tl (tl V1075)))) ((and (cons? V1075) (and (= shen.mu (hd V1075)) (and (cons? (tl V1075)) (and (cons? (hd (tl V1075))) (and (cons? (tl (tl V1075))) (and (= () (tl (tl (tl V1075)))) (cons? V1076))))))) (cons (cons shen.mu (cons (hd (hd (tl V1075))) (cons (shen.make_mu_application (cons shen.mu (cons (tl (hd (tl V1075))) (tl (tl V1075)))) (tl V1076)) ()))) (cons (hd V1076) ()))) (true (shen.sys-error shen.make_mu_application))))
|
|
159
159
|
|
|
160
|
-
(defun shen.mu_reduction (
|
|
160
|
+
(defun shen.mu_reduction (V1083 V1084) (cond ((and (cons? V1083) (and (cons? (hd V1083)) (and (= shen.mu (hd (hd V1083))) (and (cons? (tl (hd V1083))) (and (cons? (hd (tl (hd V1083)))) (and (= mode (hd (hd (tl (hd V1083))))) (and (cons? (tl (hd (tl (hd V1083))))) (and (cons? (tl (tl (hd (tl (hd V1083)))))) (and (= () (tl (tl (tl (hd (tl (hd V1083))))))) (and (cons? (tl (tl (hd V1083)))) (and (= () (tl (tl (tl (hd V1083))))) (and (cons? (tl V1083)) (= () (tl (tl V1083))))))))))))))) (shen.mu_reduction (cons (cons shen.mu (cons (hd (tl (hd (tl (hd V1083))))) (tl (tl (hd V1083))))) (tl V1083)) (hd (tl (tl (hd (tl (hd V1083)))))))) ((and (cons? V1083) (and (cons? (hd V1083)) (and (= shen.mu (hd (hd V1083))) (and (cons? (tl (hd V1083))) (and (cons? (tl (tl (hd V1083)))) (and (= () (tl (tl (tl (hd V1083))))) (and (cons? (tl V1083)) (and (= () (tl (tl V1083))) (= _ (hd (tl (hd V1083)))))))))))) (shen.mu_reduction (hd (tl (tl (hd V1083)))) V1084)) ((and (cons? V1083) (and (cons? (hd V1083)) (and (= shen.mu (hd (hd V1083))) (and (cons? (tl (hd V1083))) (and (cons? (tl (tl (hd V1083)))) (and (= () (tl (tl (tl (hd V1083))))) (and (cons? (tl V1083)) (and (= () (tl (tl V1083))) (shen.ephemeral_variable? (hd (tl (hd V1083))) (hd (tl V1083))))))))))) (subst (hd (tl V1083)) (hd (tl (hd V1083))) (shen.mu_reduction (hd (tl (tl (hd V1083)))) V1084))) ((and (cons? V1083) (and (cons? (hd V1083)) (and (= shen.mu (hd (hd V1083))) (and (cons? (tl (hd V1083))) (and (cons? (tl (tl (hd V1083)))) (and (= () (tl (tl (tl (hd V1083))))) (and (cons? (tl V1083)) (and (= () (tl (tl V1083))) (variable? (hd (tl (hd V1083)))))))))))) (cons let (cons (hd (tl (hd V1083))) (cons shen.be (cons (hd (tl V1083)) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1083)))) V1084) ()))))))) ((and (cons? V1083) (and (cons? (hd V1083)) (and (= shen.mu (hd (hd V1083))) (and (cons? (tl (hd V1083))) (and (cons? (tl (tl (hd V1083)))) (and (= () (tl (tl (tl (hd V1083))))) (and (cons? (tl V1083)) (and (= () (tl (tl V1083))) (and (= - V1084) (shen.prolog_constant? (hd (tl (hd V1083))))))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1083))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V1083))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V1083)))) -) (cons shen.else (cons shen.failed! ())))))) ())))))))) ((and (cons? V1083) (and (cons? (hd V1083)) (and (= shen.mu (hd (hd V1083))) (and (cons? (tl (hd V1083))) (and (cons? (tl (tl (hd V1083)))) (and (= () (tl (tl (tl (hd V1083))))) (and (cons? (tl V1083)) (and (= () (tl (tl V1083))) (and (= + V1084) (shen.prolog_constant? (hd (tl (hd V1083))))))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1083))))) (cons in (cons (cons if (cons (cons Z (cons is (cons identical (cons shen.to (cons (hd (tl (hd V1083))) ()))))) (cons shen.then (cons (shen.mu_reduction (hd (tl (tl (hd V1083)))) +) (cons shen.else (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.variable ())))) (cons shen.then (cons (cons bind (cons Z (cons shen.to (cons (hd (tl (hd V1083))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1083)))) +) ())))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) ((and (cons? V1083) (and (cons? (hd V1083)) (and (= shen.mu (hd (hd V1083))) (and (cons? (tl (hd V1083))) (and (cons? (hd (tl (hd V1083)))) (and (cons? (tl (tl (hd V1083)))) (and (= () (tl (tl (tl (hd V1083))))) (and (cons? (tl V1083)) (and (= () (tl (tl V1083))) (= - V1084)))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1083))))) (cons in (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.non-empty (cons list ()))))) (cons shen.then (cons (shen.mu_reduction (cons (cons shen.mu (cons (hd (hd (tl (hd V1083)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V1083)))) (tl (tl (hd V1083))))) (cons (cons shen.the (cons tail (cons shen.of (cons Z ())))) ())) ()))) (cons (cons shen.the (cons head (cons shen.of (cons Z ())))) ())) -) (cons shen.else (cons shen.failed! ())))))) ())))))))) ((and (cons? V1083) (and (cons? (hd V1083)) (and (= shen.mu (hd (hd V1083))) (and (cons? (tl (hd V1083))) (and (cons? (hd (tl (hd V1083)))) (and (cons? (tl (tl (hd V1083)))) (and (= () (tl (tl (tl (hd V1083))))) (and (cons? (tl V1083)) (and (= () (tl (tl V1083))) (= + V1084)))))))))) (let Z (gensym V) (cons let (cons Z (cons shen.be (cons (cons shen.the (cons shen.result (cons shen.of (cons shen.dereferencing (tl V1083))))) (cons in (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.non-empty (cons list ()))))) (cons shen.then (cons (shen.mu_reduction (cons (cons shen.mu (cons (hd (hd (tl (hd V1083)))) (cons (cons (cons shen.mu (cons (tl (hd (tl (hd V1083)))) (tl (tl (hd V1083))))) (cons (cons shen.the (cons tail (cons shen.of (cons Z ())))) ())) ()))) (cons (cons shen.the (cons head (cons shen.of (cons Z ())))) ())) +) (cons shen.else (cons (cons if (cons (cons Z (cons is (cons shen.a (cons shen.variable ())))) (cons shen.then (cons (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons (shen.extract_vars (hd (tl (hd V1083)))) (cons and (cons shen.then (cons (cons bind (cons Z (cons shen.to (cons (shen.rcons_form (shen.remove_modes (hd (tl (hd V1083))))) (cons in (cons (shen.mu_reduction (hd (tl (tl (hd V1083)))) +) ())))))) ())))))))) (cons shen.else (cons shen.failed! ())))))) ())))))) ())))))))) (true V1083)))
|
|
161
161
|
|
|
162
|
-
(defun shen.rcons_form (
|
|
162
|
+
(defun shen.rcons_form (V1085) (cond ((cons? V1085) (cons cons (cons (shen.rcons_form (hd V1085)) (cons (shen.rcons_form (tl V1085)) ())))) (true V1085)))
|
|
163
163
|
|
|
164
|
-
(defun shen.remove_modes (
|
|
164
|
+
(defun shen.remove_modes (V1086) (cond ((and (cons? V1086) (and (= mode (hd V1086)) (and (cons? (tl V1086)) (and (cons? (tl (tl V1086))) (and (= + (hd (tl (tl V1086)))) (= () (tl (tl (tl V1086))))))))) (shen.remove_modes (hd (tl V1086)))) ((and (cons? V1086) (and (= mode (hd V1086)) (and (cons? (tl V1086)) (and (cons? (tl (tl V1086))) (and (= - (hd (tl (tl V1086)))) (= () (tl (tl (tl V1086))))))))) (shen.remove_modes (hd (tl V1086)))) ((cons? V1086) (cons (shen.remove_modes (hd V1086)) (shen.remove_modes (tl V1086)))) (true V1086)))
|
|
165
165
|
|
|
166
|
-
(defun shen.ephemeral_variable? (
|
|
166
|
+
(defun shen.ephemeral_variable? (V1087 V1088) (and (variable? V1087) (variable? V1088)))
|
|
167
167
|
|
|
168
|
-
(defun shen.prolog_constant? (
|
|
168
|
+
(defun shen.prolog_constant? (V1097) (cond ((cons? V1097) false) (true true)))
|
|
169
169
|
|
|
170
|
-
(defun shen.aum_to_shen (
|
|
170
|
+
(defun shen.aum_to_shen (V1098) (cond ((and (cons? V1098) (and (= let (hd V1098)) (and (cons? (tl V1098)) (and (cons? (tl (tl V1098))) (and (= shen.be (hd (tl (tl V1098)))) (and (cons? (tl (tl (tl V1098)))) (and (cons? (tl (tl (tl (tl V1098))))) (and (= in (hd (tl (tl (tl (tl V1098)))))) (and (cons? (tl (tl (tl (tl (tl V1098)))))) (= () (tl (tl (tl (tl (tl (tl V1098)))))))))))))))) (cons let (cons (hd (tl V1098)) (cons (shen.aum_to_shen (hd (tl (tl (tl V1098))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1098))))))) ()))))) ((and (cons? V1098) (and (= shen.the (hd V1098)) (and (cons? (tl V1098)) (and (= shen.result (hd (tl V1098))) (and (cons? (tl (tl V1098))) (and (= shen.of (hd (tl (tl V1098)))) (and (cons? (tl (tl (tl V1098)))) (and (= shen.dereferencing (hd (tl (tl (tl V1098))))) (and (cons? (tl (tl (tl (tl V1098))))) (= () (tl (tl (tl (tl (tl V1098))))))))))))))) (cons shen.lazyderef (cons (shen.aum_to_shen (hd (tl (tl (tl (tl V1098)))))) (cons ProcessN ())))) ((and (cons? V1098) (and (= if (hd V1098)) (and (cons? (tl V1098)) (and (cons? (tl (tl V1098))) (and (= shen.then (hd (tl (tl V1098)))) (and (cons? (tl (tl (tl V1098)))) (and (cons? (tl (tl (tl (tl V1098))))) (and (= shen.else (hd (tl (tl (tl (tl V1098)))))) (and (cons? (tl (tl (tl (tl (tl V1098)))))) (= () (tl (tl (tl (tl (tl (tl V1098)))))))))))))))) (cons if (cons (shen.aum_to_shen (hd (tl V1098))) (cons (shen.aum_to_shen (hd (tl (tl (tl V1098))))) (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1098))))))) ()))))) ((and (cons? V1098) (and (cons? (tl V1098)) (and (= is (hd (tl V1098))) (and (cons? (tl (tl V1098))) (and (= shen.a (hd (tl (tl V1098)))) (and (cons? (tl (tl (tl V1098)))) (and (= shen.variable (hd (tl (tl (tl V1098))))) (= () (tl (tl (tl (tl V1098)))))))))))) (cons shen.pvar? (cons (hd V1098) ()))) ((and (cons? V1098) (and (cons? (tl V1098)) (and (= is (hd (tl V1098))) (and (cons? (tl (tl V1098))) (and (= shen.a (hd (tl (tl V1098)))) (and (cons? (tl (tl (tl V1098)))) (and (= shen.non-empty (hd (tl (tl (tl V1098))))) (and (cons? (tl (tl (tl (tl V1098))))) (and (= list (hd (tl (tl (tl (tl V1098)))))) (= () (tl (tl (tl (tl (tl V1098))))))))))))))) (cons cons? (cons (hd V1098) ()))) ((and (cons? V1098) (and (= shen.rename (hd V1098)) (and (cons? (tl V1098)) (and (= shen.the (hd (tl V1098))) (and (cons? (tl (tl V1098))) (and (= shen.variables (hd (tl (tl V1098)))) (and (cons? (tl (tl (tl V1098)))) (and (= in (hd (tl (tl (tl V1098))))) (and (cons? (tl (tl (tl (tl V1098))))) (and (= () (hd (tl (tl (tl (tl V1098)))))) (and (cons? (tl (tl (tl (tl (tl V1098)))))) (and (= and (hd (tl (tl (tl (tl (tl V1098))))))) (and (cons? (tl (tl (tl (tl (tl (tl V1098))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V1098)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V1098)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V1098)))))))))))))))))))))))) (shen.aum_to_shen (hd (tl (tl (tl (tl (tl (tl (tl V1098)))))))))) ((and (cons? V1098) (and (= shen.rename (hd V1098)) (and (cons? (tl V1098)) (and (= shen.the (hd (tl V1098))) (and (cons? (tl (tl V1098))) (and (= shen.variables (hd (tl (tl V1098)))) (and (cons? (tl (tl (tl V1098)))) (and (= in (hd (tl (tl (tl V1098))))) (and (cons? (tl (tl (tl (tl V1098))))) (and (cons? (hd (tl (tl (tl (tl V1098)))))) (and (cons? (tl (tl (tl (tl (tl V1098)))))) (and (= and (hd (tl (tl (tl (tl (tl V1098))))))) (and (cons? (tl (tl (tl (tl (tl (tl V1098))))))) (and (= shen.then (hd (tl (tl (tl (tl (tl (tl V1098)))))))) (and (cons? (tl (tl (tl (tl (tl (tl (tl V1098)))))))) (= () (tl (tl (tl (tl (tl (tl (tl (tl V1098)))))))))))))))))))))))) (cons let (cons (hd (hd (tl (tl (tl (tl V1098)))))) (cons (cons shen.newpv (cons ProcessN ())) (cons (shen.aum_to_shen (cons shen.rename (cons shen.the (cons shen.variables (cons in (cons (tl (hd (tl (tl (tl (tl V1098)))))) (tl (tl (tl (tl (tl V1098))))))))))) ()))))) ((and (cons? V1098) (and (= bind (hd V1098)) (and (cons? (tl V1098)) (and (cons? (tl (tl V1098))) (and (= shen.to (hd (tl (tl V1098)))) (and (cons? (tl (tl (tl V1098)))) (and (cons? (tl (tl (tl (tl V1098))))) (and (= in (hd (tl (tl (tl (tl V1098)))))) (and (cons? (tl (tl (tl (tl (tl V1098)))))) (= () (tl (tl (tl (tl (tl (tl V1098)))))))))))))))) (cons do (cons (cons shen.bindv (cons (hd (tl V1098)) (cons (shen.chwild (hd (tl (tl (tl V1098))))) (cons ProcessN ())))) (cons (cons let (cons Result (cons (shen.aum_to_shen (hd (tl (tl (tl (tl (tl V1098))))))) (cons (cons do (cons (cons shen.unbindv (cons (hd (tl V1098)) (cons ProcessN ()))) (cons Result ()))) ())))) ())))) ((and (cons? V1098) (and (cons? (tl V1098)) (and (= is (hd (tl V1098))) (and (cons? (tl (tl V1098))) (and (= identical (hd (tl (tl V1098)))) (and (cons? (tl (tl (tl V1098)))) (and (= shen.to (hd (tl (tl (tl V1098))))) (and (cons? (tl (tl (tl (tl V1098))))) (= () (tl (tl (tl (tl (tl V1098)))))))))))))) (cons = (cons (hd (tl (tl (tl (tl V1098))))) (cons (hd V1098) ())))) ((= shen.failed! V1098) false) ((and (cons? V1098) (and (= shen.the (hd V1098)) (and (cons? (tl V1098)) (and (= head (hd (tl V1098))) (and (cons? (tl (tl V1098))) (and (= shen.of (hd (tl (tl V1098)))) (and (cons? (tl (tl (tl V1098)))) (= () (tl (tl (tl (tl V1098)))))))))))) (cons hd (tl (tl (tl V1098))))) ((and (cons? V1098) (and (= shen.the (hd V1098)) (and (cons? (tl V1098)) (and (= tail (hd (tl V1098))) (and (cons? (tl (tl V1098))) (and (= shen.of (hd (tl (tl V1098)))) (and (cons? (tl (tl (tl V1098)))) (= () (tl (tl (tl (tl V1098)))))))))))) (cons tl (tl (tl (tl V1098))))) ((and (cons? V1098) (and (= shen.pop (hd V1098)) (and (cons? (tl V1098)) (and (= shen.the (hd (tl V1098))) (and (cons? (tl (tl V1098))) (and (= shen.stack (hd (tl (tl V1098)))) (= () (tl (tl (tl V1098)))))))))) (cons do (cons (cons shen.incinfs ()) (cons (cons thaw (cons Continuation ())) ())))) ((and (cons? V1098) (and (= call (hd V1098)) (and (cons? (tl V1098)) (and (= shen.the (hd (tl V1098))) (and (cons? (tl (tl V1098))) (and (= shen.continuation (hd (tl (tl V1098)))) (and (cons? (tl (tl (tl V1098)))) (= () (tl (tl (tl (tl V1098)))))))))))) (cons do (cons (cons shen.incinfs ()) (cons (shen.call_the_continuation (shen.chwild (hd (tl (tl (tl V1098))))) ProcessN Continuation) ())))) (true V1098)))
|
|
171
171
|
|
|
172
|
-
(defun shen.chwild (
|
|
172
|
+
(defun shen.chwild (V1099) (cond ((= V1099 _) (cons shen.newpv (cons ProcessN ()))) ((cons? V1099) (map shen.chwild V1099)) (true V1099)))
|
|
173
173
|
|
|
174
|
-
(defun shen.newpv (
|
|
174
|
+
(defun shen.newpv (V1100) (let Count+1 (+ (<-address (value shen.*varcounter*) V1100) 1) (let IncVar (address-> (value shen.*varcounter*) V1100 Count+1) (let Vector (<-address (value shen.*prologvectors*) V1100) (let ResizeVectorIfNeeded (if (= Count+1 (limit Vector)) (shen.resizeprocessvector V1100 Count+1) shen.skip) (shen.mk-pvar Count+1))))))
|
|
175
175
|
|
|
176
|
-
(defun shen.resizeprocessvector (
|
|
176
|
+
(defun shen.resizeprocessvector (V1101 V1102) (let Vector (<-address (value shen.*prologvectors*) V1101) (let BigVector (shen.resize-vector Vector (+ V1102 V1102) shen.-null-) (address-> (value shen.*prologvectors*) V1101 BigVector))))
|
|
177
177
|
|
|
178
|
-
(defun shen.resize-vector (
|
|
178
|
+
(defun shen.resize-vector (V1103 V1104 V1105) (let BigVector (address-> (absvector (+ 1 V1104)) 0 V1104) (shen.copy-vector V1103 BigVector (limit V1103) V1104 V1105)))
|
|
179
179
|
|
|
180
|
-
(defun shen.copy-vector (
|
|
180
|
+
(defun shen.copy-vector (V1106 V1107 V1108 V1109 V1110) (shen.copy-vector-stage-2 (+ 1 V1108) (+ V1109 1) V1110 (shen.copy-vector-stage-1 1 V1106 V1107 (+ 1 V1108))))
|
|
181
181
|
|
|
182
|
-
(defun shen.copy-vector-stage-1 (
|
|
182
|
+
(defun shen.copy-vector-stage-1 (V1113 V1114 V1115 V1116) (cond ((= V1116 V1113) V1115) (true (shen.copy-vector-stage-1 (+ 1 V1113) V1114 (address-> V1115 V1113 (<-address V1114 V1113)) V1116))))
|
|
183
183
|
|
|
184
|
-
(defun shen.copy-vector-stage-2 (
|
|
184
|
+
(defun shen.copy-vector-stage-2 (V1120 V1121 V1122 V1123) (cond ((= V1121 V1120) V1123) (true (shen.copy-vector-stage-2 (+ V1120 1) V1121 V1122 (address-> V1123 V1120 V1122)))))
|
|
185
185
|
|
|
186
|
-
(defun shen.mk-pvar (
|
|
186
|
+
(defun shen.mk-pvar (V1125) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V1125))
|
|
187
187
|
|
|
188
|
-
(defun shen.pvar? (
|
|
188
|
+
(defun shen.pvar? (V1126) (and (absvector? V1126) (= (<-address V1126 0) shen.pvar)))
|
|
189
189
|
|
|
190
|
-
(defun shen.bindv (
|
|
190
|
+
(defun shen.bindv (V1127 V1128 V1129) (let Vector (<-address (value shen.*prologvectors*) V1129) (address-> Vector (<-address V1127 1) V1128)))
|
|
191
191
|
|
|
192
|
-
(defun shen.unbindv (
|
|
192
|
+
(defun shen.unbindv (V1130 V1131) (let Vector (<-address (value shen.*prologvectors*) V1131) (address-> Vector (<-address V1130 1) shen.-null-)))
|
|
193
193
|
|
|
194
194
|
(defun shen.incinfs () (set shen.*infs* (+ 1 (value shen.*infs*))))
|
|
195
195
|
|
|
196
|
-
(defun shen.call_the_continuation (
|
|
196
|
+
(defun shen.call_the_continuation (V1132 V1133 V1134) (cond ((and (cons? V1132) (and (cons? (hd V1132)) (= () (tl V1132)))) (cons (hd (hd V1132)) (append (tl (hd V1132)) (cons V1133 (cons V1134 ()))))) ((and (cons? V1132) (cons? (hd V1132))) (let NewContinuation (shen.newcontinuation (tl V1132) V1133 V1134) (cons (hd (hd V1132)) (append (tl (hd V1132)) (cons V1133 (cons NewContinuation ())))))) (true (shen.sys-error shen.call_the_continuation))))
|
|
197
197
|
|
|
198
|
-
(defun shen.newcontinuation (
|
|
198
|
+
(defun shen.newcontinuation (V1135 V1136 V1137) (cond ((= () V1135) V1137) ((and (cons? V1135) (cons? (hd V1135))) (cons freeze (cons (cons (hd (hd V1135)) (append (tl (hd V1135)) (cons V1136 (cons (shen.newcontinuation (tl V1135) V1136 V1137) ())))) ()))) (true (shen.sys-error shen.newcontinuation))))
|
|
199
199
|
|
|
200
|
-
(defun return (
|
|
200
|
+
(defun return (V1142 V1143 V1144) (shen.deref V1142 V1143))
|
|
201
201
|
|
|
202
|
-
(defun shen.measure&return (
|
|
203
|
-
" shen.a) (stoutput)) (shen.deref
|
|
202
|
+
(defun shen.measure&return (V1149 V1150 V1151) (do (shen.prhush (shen.app (value shen.*infs*) " inferences
|
|
203
|
+
" shen.a) (stoutput)) (shen.deref V1149 V1150)))
|
|
204
204
|
|
|
205
|
-
(defun unify (
|
|
205
|
+
(defun unify (V1152 V1153 V1154 V1155) (shen.lzy= (shen.lazyderef V1152 V1154) (shen.lazyderef V1153 V1154) V1154 V1155))
|
|
206
206
|
|
|
207
|
-
(defun shen.lzy= (
|
|
207
|
+
(defun shen.lzy= (V1172 V1173 V1174 V1175) (cond ((= V1173 V1172) (thaw V1175)) ((shen.pvar? V1172) (bind V1172 V1173 V1174 V1175)) ((shen.pvar? V1173) (bind V1173 V1172 V1174 V1175)) ((and (cons? V1172) (cons? V1173)) (shen.lzy= (shen.lazyderef (hd V1172) V1174) (shen.lazyderef (hd V1173) V1174) V1174 (freeze (shen.lzy= (shen.lazyderef (tl V1172) V1174) (shen.lazyderef (tl V1173) V1174) V1174 V1175)))) (true false)))
|
|
208
208
|
|
|
209
|
-
(defun shen.deref (
|
|
209
|
+
(defun shen.deref (V1177 V1178) (cond ((cons? V1177) (cons (shen.deref (hd V1177) V1178) (shen.deref (tl V1177) V1178))) (true (if (shen.pvar? V1177) (let Value (shen.valvector V1177 V1178) (if (= Value shen.-null-) V1177 (shen.deref Value V1178))) V1177))))
|
|
210
210
|
|
|
211
|
-
(defun shen.lazyderef (
|
|
211
|
+
(defun shen.lazyderef (V1179 V1180) (if (shen.pvar? V1179) (let Value (shen.valvector V1179 V1180) (if (= Value shen.-null-) V1179 (shen.lazyderef Value V1180))) V1179))
|
|
212
212
|
|
|
213
|
-
(defun shen.valvector (
|
|
213
|
+
(defun shen.valvector (V1181 V1182) (<-address (<-address (value shen.*prologvectors*) V1182) (<-address V1181 1)))
|
|
214
214
|
|
|
215
|
-
(defun unify! (
|
|
215
|
+
(defun unify! (V1183 V1184 V1185 V1186) (shen.lzy=! (shen.lazyderef V1183 V1185) (shen.lazyderef V1184 V1185) V1185 V1186))
|
|
216
216
|
|
|
217
|
-
(defun shen.lzy=! (
|
|
217
|
+
(defun shen.lzy=! (V1203 V1204 V1205 V1206) (cond ((= V1204 V1203) (thaw V1206)) ((and (shen.pvar? V1203) (not (shen.occurs? V1203 (shen.deref V1204 V1205)))) (bind V1203 V1204 V1205 V1206)) ((and (shen.pvar? V1204) (not (shen.occurs? V1204 (shen.deref V1203 V1205)))) (bind V1204 V1203 V1205 V1206)) ((and (cons? V1203) (cons? V1204)) (shen.lzy=! (shen.lazyderef (hd V1203) V1205) (shen.lazyderef (hd V1204) V1205) V1205 (freeze (shen.lzy=! (shen.lazyderef (tl V1203) V1205) (shen.lazyderef (tl V1204) V1205) V1205 V1206)))) (true false)))
|
|
218
218
|
|
|
219
|
-
(defun shen.occurs? (
|
|
219
|
+
(defun shen.occurs? (V1216 V1217) (cond ((= V1217 V1216) true) ((cons? V1217) (or (shen.occurs? V1216 (hd V1217)) (shen.occurs? V1216 (tl V1217)))) (true false)))
|
|
220
220
|
|
|
221
|
-
(defun identical (
|
|
221
|
+
(defun identical (V1219 V1220 V1221 V1222) (shen.lzy== (shen.lazyderef V1219 V1221) (shen.lazyderef V1220 V1221) V1221 V1222))
|
|
222
222
|
|
|
223
|
-
(defun shen.lzy== (
|
|
223
|
+
(defun shen.lzy== (V1239 V1240 V1241 V1242) (cond ((= V1240 V1239) (thaw V1242)) ((and (cons? V1239) (cons? V1240)) (shen.lzy== (shen.lazyderef (hd V1239) V1241) (shen.lazyderef (hd V1240) V1241) V1241 (freeze (shen.lzy== (tl V1239) (tl V1240) V1241 V1242)))) (true false)))
|
|
224
224
|
|
|
225
|
-
(defun shen.pvar (
|
|
225
|
+
(defun shen.pvar (V1244) (cn "Var" (shen.app (<-address V1244 1) "" shen.a)))
|
|
226
226
|
|
|
227
|
-
(defun bind (
|
|
227
|
+
(defun bind (V1245 V1246 V1247 V1248) (do (shen.bindv V1245 V1246 V1247) (let Result (thaw V1248) (do (shen.unbindv V1245 V1247) Result))))
|
|
228
228
|
|
|
229
|
-
(defun fwhen (
|
|
229
|
+
(defun fwhen (V1263 V1264 V1265) (cond ((= true V1263) (thaw V1265)) ((= false V1263) false) (true (simple-error (cn "fwhen expects a boolean: not " (shen.app V1263 "%" shen.s))))))
|
|
230
230
|
|
|
231
|
-
(defun call (
|
|
231
|
+
(defun call (V1278 V1279 V1280) (cond ((cons? V1278) (shen.call-help (shen.m_prolog_to_s-prolog_predicate (shen.lazyderef (hd V1278) V1279)) (tl V1278) V1279 V1280)) (true false)))
|
|
232
232
|
|
|
233
|
-
(defun shen.call-help (
|
|
233
|
+
(defun shen.call-help (V1281 V1282 V1283 V1284) (cond ((= () V1282) (V1281 V1283 V1284)) ((cons? V1282) (shen.call-help (V1281 (hd V1282)) (tl V1282) V1283 V1284)) (true (shen.sys-error shen.call-help))))
|
|
234
234
|
|
|
235
|
-
(defun shen.intprolog (
|
|
235
|
+
(defun shen.intprolog (V1285) (cond ((and (cons? V1285) (cons? (hd V1285))) (let ProcessN (shen.start-new-prolog-process) (shen.intprolog-help (hd (hd V1285)) (shen.insert-prolog-variables (cons (tl (hd V1285)) (cons (tl V1285) ())) ProcessN) ProcessN))) (true (shen.sys-error shen.intprolog))))
|
|
236
236
|
|
|
237
|
-
(defun shen.intprolog-help (
|
|
237
|
+
(defun shen.intprolog-help (V1286 V1287 V1288) (cond ((and (cons? V1287) (and (cons? (tl V1287)) (= () (tl (tl V1287))))) (shen.intprolog-help-help V1286 (hd V1287) (hd (tl V1287)) V1288)) (true (shen.sys-error shen.intprolog-help))))
|
|
238
238
|
|
|
239
|
-
(defun shen.intprolog-help-help (
|
|
239
|
+
(defun shen.intprolog-help-help (V1289 V1290 V1291 V1292) (cond ((= () V1290) (V1289 V1292 (freeze (shen.call-rest V1291 V1292)))) ((cons? V1290) (shen.intprolog-help-help (V1289 (hd V1290)) (tl V1290) V1291 V1292)) (true (shen.sys-error shen.intprolog-help-help))))
|
|
240
240
|
|
|
241
|
-
(defun shen.call-rest (
|
|
241
|
+
(defun shen.call-rest (V1295 V1296) (cond ((= () V1295) true) ((and (cons? V1295) (and (cons? (hd V1295)) (cons? (tl (hd V1295))))) (shen.call-rest (cons (cons ((hd (hd V1295)) (hd (tl (hd V1295)))) (tl (tl (hd V1295)))) (tl V1295)) V1296)) ((and (cons? V1295) (and (cons? (hd V1295)) (= () (tl (hd V1295))))) ((hd (hd V1295)) V1296 (freeze (shen.call-rest (tl V1295) V1296)))) (true (shen.sys-error shen.call-rest))))
|
|
242
242
|
|
|
243
243
|
(defun shen.start-new-prolog-process () (let IncrementProcessCounter (set shen.*process-counter* (+ 1 (value shen.*process-counter*))) (shen.initialise-prolog IncrementProcessCounter)))
|
|
244
244
|
|
|
245
|
-
(defun shen.insert-prolog-variables (
|
|
245
|
+
(defun shen.insert-prolog-variables (V1297 V1298) (shen.insert-prolog-variables-help V1297 (shen.flatten V1297) V1298))
|
|
246
246
|
|
|
247
|
-
(defun shen.insert-prolog-variables-help (
|
|
247
|
+
(defun shen.insert-prolog-variables-help (V1303 V1304 V1305) (cond ((= () V1304) V1303) ((and (cons? V1304) (variable? (hd V1304))) (let V (shen.newpv V1305) (let XV/Y (subst V (hd V1304) V1303) (let Z-Y (remove (hd V1304) (tl V1304)) (shen.insert-prolog-variables-help XV/Y Z-Y V1305))))) ((cons? V1304) (shen.insert-prolog-variables-help V1303 (tl V1304) V1305)) (true (shen.sys-error shen.insert-prolog-variables-help))))
|
|
248
248
|
|
|
249
|
-
(defun shen.initialise-prolog (
|
|
249
|
+
(defun shen.initialise-prolog (V1306) (let Vector (address-> (value shen.*prologvectors*) V1306 (shen.fillvector (vector 10) 1 10 shen.-null-)) (let Counter (address-> (value shen.*varcounter*) V1306 1) V1306)))
|
|
250
250
|
|
|
251
251
|
|
|
252
252
|
|