razyk 0.0.0
Sign up to get free protection for your applications and to get access to all the features.
- data/.document +5 -0
- data/.rspec +1 -0
- data/LICENSE +56 -0
- data/README.rdoc +17 -0
- data/Rakefile +62 -0
- data/VERSION +1 -0
- data/bin/razyk +72 -0
- data/examples/lazier.scm +328 -0
- data/examples/prelude.scm +86 -0
- data/examples/prime.lazy +20 -0
- data/examples/reverse.lazy +4 -0
- data/examples/reverse.scm +12 -0
- data/lib/razyk/graph.rb +66 -0
- data/lib/razyk/node.rb +117 -0
- data/lib/razyk/parser.rb +423 -0
- data/lib/razyk/parser.y +227 -0
- data/lib/razyk/vm.rb +212 -0
- data/lib/razyk/webapp/templates/main.html +69 -0
- data/lib/razyk/webapp.rb +161 -0
- data/lib/razyk.rb +20 -0
- data/spec/node_spec.rb +58 -0
- data/spec/spec_helper.rb +5 -0
- data/spec/vm_spec.rb +128 -0
- metadata +129 -0
data/.document
ADDED
data/.rspec
ADDED
@@ -0,0 +1 @@
|
|
1
|
+
--color
|
data/LICENSE
ADDED
@@ -0,0 +1,56 @@
|
|
1
|
+
RazyK is copyrighted free software by Tomoyuki Chikanaga <nagachika00@gmail.com>.
|
2
|
+
You can redistribute it and/or modify it under either the terms of the
|
3
|
+
2-clause BSDL (see the file BSDL), or the conditions below:
|
4
|
+
|
5
|
+
1. You may make and give away verbatim copies of the source form of the
|
6
|
+
software without restriction, provided that you duplicate all of the
|
7
|
+
original copyright notices and associated disclaimers.
|
8
|
+
|
9
|
+
2. You may modify your copy of the software in any way, provided that
|
10
|
+
you do at least ONE of the following:
|
11
|
+
|
12
|
+
a) place your modifications in the Public Domain or otherwise
|
13
|
+
make them Freely Available, such as by posting said
|
14
|
+
modifications to Usenet or an equivalent medium, or by allowing
|
15
|
+
the author to include your modifications in the software.
|
16
|
+
|
17
|
+
b) use the modified software only within your corporation or
|
18
|
+
organization.
|
19
|
+
|
20
|
+
c) give non-standard binaries non-standard names, with
|
21
|
+
instructions on where to get the original software distribution.
|
22
|
+
|
23
|
+
d) make other distribution arrangements with the author.
|
24
|
+
|
25
|
+
3. You may distribute the software in object code or binary form,
|
26
|
+
provided that you do at least ONE of the following:
|
27
|
+
|
28
|
+
a) distribute the binaries and library files of the software,
|
29
|
+
together with instructions (in the manual page or equivalent)
|
30
|
+
on where to get the original distribution.
|
31
|
+
|
32
|
+
b) accompany the distribution with the machine-readable source of
|
33
|
+
the software.
|
34
|
+
|
35
|
+
c) give non-standard binaries non-standard names, with
|
36
|
+
instructions on where to get the original software distribution.
|
37
|
+
|
38
|
+
d) make other distribution arrangements with the author.
|
39
|
+
|
40
|
+
4. You may modify and include the part of the software into any other
|
41
|
+
software (possibly commercial). But some files in the distribution
|
42
|
+
are not written by the author, so that they are not under these terms.
|
43
|
+
|
44
|
+
For the list of those files and their copying conditions, see the
|
45
|
+
file LEGAL.
|
46
|
+
|
47
|
+
5. The scripts and library files supplied as input to or produced as
|
48
|
+
output from the software do not automatically fall under the
|
49
|
+
copyright of the software, but belong to whomever generated them,
|
50
|
+
and may be sold commercially, and may be aggregated with this
|
51
|
+
software.
|
52
|
+
|
53
|
+
6. THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
|
54
|
+
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
|
55
|
+
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
56
|
+
PURPOSE.
|
data/README.rdoc
ADDED
@@ -0,0 +1,17 @@
|
|
1
|
+
= RazyK
|
2
|
+
|
3
|
+
RazyK is a LazyK implementation by pure ruby.
|
4
|
+
|
5
|
+
== LazyK
|
6
|
+
LazyK is referentially transparent functional programming language.
|
7
|
+
* LazyK programs are expressed by only S, K, I combinators
|
8
|
+
* Lazy evaluation
|
9
|
+
* Stream I/O system
|
10
|
+
|
11
|
+
For details, see website bellow.
|
12
|
+
|
13
|
+
http://homepages.cwi.nl/~tromp/cl/lazy-k.html
|
14
|
+
|
15
|
+
== Copyright
|
16
|
+
|
17
|
+
Copyright (c) 2010 nagachika. See LICENSE for details.
|
data/Rakefile
ADDED
@@ -0,0 +1,62 @@
|
|
1
|
+
require 'rubygems'
|
2
|
+
require 'rake'
|
3
|
+
|
4
|
+
begin
|
5
|
+
require 'jeweler'
|
6
|
+
Jeweler::Tasks.new do |gem|
|
7
|
+
gem.name = "razyk"
|
8
|
+
gem.summary = %Q{pure ruby LazyK implementation}
|
9
|
+
gem.description = %Q{RazyK is a LazyK implementetion by pure ruby}
|
10
|
+
gem.email = "nagachika00@gmail.com"
|
11
|
+
gem.homepage = "http://github.com/nagachika/razyk"
|
12
|
+
gem.authors = ["nagachika"]
|
13
|
+
gem.add_development_dependency "rspec", ">= 1.2.9"
|
14
|
+
gem.add_dependency "rack"
|
15
|
+
gem.add_dependency "ruby-graphviz"
|
16
|
+
# gem is a Gem::Specification... see http://www.rubygems.org/read/chapter/20 for additional settings
|
17
|
+
end
|
18
|
+
Jeweler::GemcutterTasks.new
|
19
|
+
rescue LoadError
|
20
|
+
puts "Jeweler (or a dependency) not available. Install it with: gem install jeweler"
|
21
|
+
end
|
22
|
+
|
23
|
+
begin
|
24
|
+
require 'spec/rake/spectask'
|
25
|
+
Spec::Rake::SpecTask.new(:spec) do |spec|
|
26
|
+
spec.libs << 'lib' << 'spec'
|
27
|
+
spec.spec_files = FileList['spec/**/*_spec.rb']
|
28
|
+
end
|
29
|
+
|
30
|
+
Spec::Rake::SpecTask.new(:rcov) do |spec|
|
31
|
+
spec.libs << 'lib' << 'spec'
|
32
|
+
spec.pattern = 'spec/**/*_spec.rb'
|
33
|
+
spec.rcov = true
|
34
|
+
end
|
35
|
+
|
36
|
+
task :spec => :check_dependencies
|
37
|
+
rescue LoadError
|
38
|
+
require "rspec/core/rake_task"
|
39
|
+
RSpec::Core::RakeTask.new(:spec)
|
40
|
+
|
41
|
+
RSpec::Core::RakeTask.new(:rcov) do |t|
|
42
|
+
t.rcov_opts = %q[--exclude "spec"]
|
43
|
+
end
|
44
|
+
|
45
|
+
task :spec => :check_dependencies
|
46
|
+
end
|
47
|
+
|
48
|
+
task :default => :spec
|
49
|
+
|
50
|
+
require 'rake/rdoctask'
|
51
|
+
Rake::RDocTask.new do |rdoc|
|
52
|
+
version = File.exist?('VERSION') ? File.read('VERSION') : ""
|
53
|
+
|
54
|
+
rdoc.rdoc_dir = 'rdoc'
|
55
|
+
rdoc.title = "razyk #{version}"
|
56
|
+
rdoc.rdoc_files.include('README*')
|
57
|
+
rdoc.rdoc_files.include('lib/**/*.rb')
|
58
|
+
end
|
59
|
+
|
60
|
+
task :racc => [ "lib/razyk/parser.y" ] do
|
61
|
+
sh "racc -o lib/razyk/parser.rb lib/razyk/parser.y"
|
62
|
+
end
|
data/VERSION
ADDED
@@ -0,0 +1 @@
|
|
1
|
+
0.0.0
|
data/bin/razyk
ADDED
@@ -0,0 +1,72 @@
|
|
1
|
+
#!/usr/bin/env ruby
|
2
|
+
|
3
|
+
require "razyk"
|
4
|
+
require "optparse"
|
5
|
+
|
6
|
+
module RazyK
|
7
|
+
class Application
|
8
|
+
def initialize
|
9
|
+
@program = nil
|
10
|
+
@step = false
|
11
|
+
@web_server = false
|
12
|
+
@optparse = option_parser
|
13
|
+
end
|
14
|
+
|
15
|
+
def option_parser
|
16
|
+
OptionParser.new do |opt|
|
17
|
+
opt.on("-e 'program'",
|
18
|
+
"specify LazyK program string. Omit [programfile]") do |prog|
|
19
|
+
@program = prog
|
20
|
+
end
|
21
|
+
opt.on("-s", "--step", "step execution. Dump combinator tree by each step") do
|
22
|
+
@step = true
|
23
|
+
end
|
24
|
+
opt.on("--server [PORT]", "start web server") do |port|
|
25
|
+
@port = Integer(port || 9292)
|
26
|
+
@step = true
|
27
|
+
@web_server = true
|
28
|
+
end
|
29
|
+
end
|
30
|
+
end
|
31
|
+
private :option_parser
|
32
|
+
|
33
|
+
def run(argv)
|
34
|
+
@optparse.parse!(argv)
|
35
|
+
|
36
|
+
if @web_server
|
37
|
+
require "razyk/webapp"
|
38
|
+
app = RazyK::WebApp.new
|
39
|
+
# This should work, but rack-1.2.1 fails. :app don't overwrite config.ru
|
40
|
+
#Rack::Server.start(:app => app, :Port => @port)
|
41
|
+
trap(:INT) do
|
42
|
+
if Rack::Handler::WEBrick.respond_to?(:shutdown)
|
43
|
+
Rack::Handler::WEBrick.shutdown
|
44
|
+
else
|
45
|
+
exit
|
46
|
+
end
|
47
|
+
end
|
48
|
+
Rack::Handler::WEBrick.run(app, :Port => @port)
|
49
|
+
return
|
50
|
+
end
|
51
|
+
|
52
|
+
if @program.nil?
|
53
|
+
if argv.empty?
|
54
|
+
raise "please specify LazyK program file"
|
55
|
+
end
|
56
|
+
filepath = argv.shift
|
57
|
+
@program = IO.read(filepath)
|
58
|
+
end
|
59
|
+
|
60
|
+
if @step
|
61
|
+
RazyK.run(@program) do |vm|
|
62
|
+
$stderr.puts vm.tree.inspect
|
63
|
+
end
|
64
|
+
else
|
65
|
+
RazyK.run(@program)
|
66
|
+
end
|
67
|
+
end
|
68
|
+
end
|
69
|
+
end
|
70
|
+
|
71
|
+
app = RazyK::Application.new
|
72
|
+
app.run(ARGV)
|
data/examples/lazier.scm
ADDED
@@ -0,0 +1,328 @@
|
|
1
|
+
;;
|
2
|
+
;; Lazier, a "compiler" from lambda calculus to Lazy K.
|
3
|
+
;; Copyright 2002 Ben Rudiak-Gould. Distributed under the GPL.
|
4
|
+
;;
|
5
|
+
;; Usage examples:
|
6
|
+
;;
|
7
|
+
;; > (lazy-def '(myprog input) '(cdr (cdr input))) ; drops first two bytes of input
|
8
|
+
;; > (lazy-def 'myprog '(o cdr cdr)) ; equivalent definition
|
9
|
+
;;
|
10
|
+
;; > (laze 'myprog)
|
11
|
+
;; ((s ((s i) (k (k i)))) (k (k i)))
|
12
|
+
;;
|
13
|
+
;; > (print-as-cc (laze 'myprog))
|
14
|
+
;; S(SI(K(KI)))(K(KI))
|
15
|
+
;;
|
16
|
+
;; > (print-as-unlambda (laze 'myprog))
|
17
|
+
;; ``s``si`k`ki`k`ki
|
18
|
+
;;
|
19
|
+
;; > (print-as-iota (laze 'myprog))
|
20
|
+
;; ***i*i*i*ii***i*i*i*ii*ii**i*i*ii**i*i*ii*ii**i*i*ii**i*i*ii*ii
|
21
|
+
;;
|
22
|
+
;; > (print-as-jot (laze 'myprog))
|
23
|
+
;; 111111100011111110001111111110000011110011110011111111100000111100111100
|
24
|
+
;; 11111111100000
|
25
|
+
;;
|
26
|
+
;; > (lazy-def '(f x y z) '(x (y z))) ; \
|
27
|
+
;; > (lazy-def 'f '(lambda (x y z) '(x (y z)))) ; | equivalent
|
28
|
+
;; > (lazy-def 'f '(lambda (x) (lambda (y) ...))) ; /
|
29
|
+
;;
|
30
|
+
;; > (laze '(f arg1 arg2))
|
31
|
+
;; ((s (k arg1)) arg2)
|
32
|
+
;;
|
33
|
+
;; > (print-as-unlambda (laze '(f arg1 arg2)))
|
34
|
+
;; ``s`k[arg1][arg2]
|
35
|
+
;;
|
36
|
+
|
37
|
+
|
38
|
+
; lazy-def.
|
39
|
+
|
40
|
+
(define lazy-defs '())
|
41
|
+
|
42
|
+
(define (lazy-def name body)
|
43
|
+
(set! lazy-defs
|
44
|
+
(cons (if (pair? name)
|
45
|
+
(cons (car name)
|
46
|
+
(curry-lambda (cdr name) (curry body)) )
|
47
|
+
(cons name (curry body)) )
|
48
|
+
lazy-defs )))
|
49
|
+
|
50
|
+
(define (lazy-def-lookup name)
|
51
|
+
(assv name lazy-defs) )
|
52
|
+
|
53
|
+
|
54
|
+
; Currying.
|
55
|
+
|
56
|
+
(define (curry expr)
|
57
|
+
(cond ((not (pair? expr)) expr)
|
58
|
+
((eq? (car expr) 'lambda)
|
59
|
+
(curry-lambda (cadr expr) (curry (caddr expr))) )
|
60
|
+
(else
|
61
|
+
(curry-app (map curry expr)) )))
|
62
|
+
|
63
|
+
(define (curry-lambda vars body)
|
64
|
+
(if (null? vars)
|
65
|
+
body
|
66
|
+
`(lambda (,(car vars)) ,(curry-lambda (cdr vars) body)) ))
|
67
|
+
|
68
|
+
(define (curry-app lst)
|
69
|
+
(let iter ((sofar (car lst))
|
70
|
+
(togo (cdr lst)) )
|
71
|
+
(if (null? togo)
|
72
|
+
sofar
|
73
|
+
(iter (list sofar (car togo)) (cdr togo)) )))
|
74
|
+
|
75
|
+
|
76
|
+
; Macro expansion.
|
77
|
+
|
78
|
+
(define (expr-dispatch expr leaf appl lamb)
|
79
|
+
(if (pair? expr)
|
80
|
+
(if (eq? (car expr) 'lambda)
|
81
|
+
(lamb (caadr expr) (caddr expr))
|
82
|
+
(appl (car expr) (cadr expr)) )
|
83
|
+
(leaf expr) ))
|
84
|
+
|
85
|
+
(define (expand-macros expr)
|
86
|
+
(let helper ((expr expr) (exclude '()) (stack '()))
|
87
|
+
(expr-dispatch expr
|
88
|
+
(lambda (leaf)
|
89
|
+
(cond ((memv leaf exclude) leaf)
|
90
|
+
((memv leaf stack)
|
91
|
+
(display "Recursion within lazy-defs detected: ")
|
92
|
+
(display (cons leaf stack))
|
93
|
+
(newline)
|
94
|
+
(error) )
|
95
|
+
(else
|
96
|
+
(let ((def (lazy-def-lookup leaf)))
|
97
|
+
(if def
|
98
|
+
(helper (cdr def) exclude (cons leaf stack))
|
99
|
+
leaf )))))
|
100
|
+
(lambda (f g)
|
101
|
+
(list (helper f exclude stack) (helper g exclude stack)) )
|
102
|
+
(lambda (var body)
|
103
|
+
`(lambda (,var) ,(helper body (cons var exclude) stack)) ))))
|
104
|
+
|
105
|
+
|
106
|
+
; Replace ((lambda (var) body) value) with body[value/var] if:
|
107
|
+
;
|
108
|
+
; - value is a symbol, or
|
109
|
+
; - var appears only once in body and value contains no
|
110
|
+
; more than one free variable which is not in body.
|
111
|
+
;
|
112
|
+
; I'm not sure if the first of these is ever needed -- it may
|
113
|
+
; always be handled by the other optimizations -- but it's easy
|
114
|
+
; to check for.
|
115
|
+
|
116
|
+
(define (apply-lambdas expr)
|
117
|
+
(let ((top-level-free-vars (free-vars expr)))
|
118
|
+
(let self ((expr expr))
|
119
|
+
(expr-dispatch expr
|
120
|
+
(lambda (leaf) leaf)
|
121
|
+
(lambda (f g)
|
122
|
+
(let ((f: (self f))
|
123
|
+
(g: (self g)) )
|
124
|
+
(expr-dispatch f:
|
125
|
+
(lambda (leaf) (list f: g:))
|
126
|
+
(lambda (f:: g::) (list f: g:))
|
127
|
+
(lambda (var body)
|
128
|
+
(if (or (not (pair? g:))
|
129
|
+
(and (<= (count-occurrences var body) 1)
|
130
|
+
(not (more-than-one-additional
|
131
|
+
(free-vars g:)
|
132
|
+
(append top-level-free-vars (free-vars f:)) ))))
|
133
|
+
(var-subst var g: body)
|
134
|
+
(list f: g:) )))))
|
135
|
+
(lambda (var body)
|
136
|
+
`(lambda (,var) ,(self body)) )))))
|
137
|
+
|
138
|
+
(define (add-prime var)
|
139
|
+
(string->symbol (string-append (symbol->string var) ":")) )
|
140
|
+
|
141
|
+
(define (var-subst var value template)
|
142
|
+
(if (eqv? var value)
|
143
|
+
template
|
144
|
+
(let loop ((template template))
|
145
|
+
(expr-dispatch template
|
146
|
+
(lambda (leaf)
|
147
|
+
(if (eqv? var leaf) value leaf) )
|
148
|
+
(lambda (f g)
|
149
|
+
(list (loop f) (loop g)) )
|
150
|
+
(lambda (v body)
|
151
|
+
(if (eqv? var v)
|
152
|
+
template
|
153
|
+
(do ((template-vars (free-vars template))
|
154
|
+
(value-vars (free-vars value))
|
155
|
+
(v: v (add-prime v:)) )
|
156
|
+
((and (not (memv v: template-vars))
|
157
|
+
(not (memv v: value-vars)) )
|
158
|
+
`(lambda (,v:)
|
159
|
+
,(loop (var-subst v v: body)) )))))))))
|
160
|
+
|
161
|
+
(define (more-than-one-additional a b)
|
162
|
+
(let loop ((a a) (last-sym (cons #f #f)))
|
163
|
+
(cond ((null? a) #f)
|
164
|
+
((memv (car a) b)
|
165
|
+
(loop (cdr a) last-sym) )
|
166
|
+
((or (pair? last-sym) ; no last symbol
|
167
|
+
(eqv? last-sym (car a)) )
|
168
|
+
(loop (cdr a) (car a)) )
|
169
|
+
(else #t) )))
|
170
|
+
|
171
|
+
(define (free-vars expr)
|
172
|
+
(let loop ((expr expr) (bound ()))
|
173
|
+
(expr-dispatch expr
|
174
|
+
(lambda (leaf)
|
175
|
+
(if (memv leaf bound)
|
176
|
+
()
|
177
|
+
(list leaf) ))
|
178
|
+
(lambda (f g)
|
179
|
+
(append (loop f bound) (loop g bound)) )
|
180
|
+
(lambda (var body)
|
181
|
+
(loop body (cons var bound)) ))))
|
182
|
+
|
183
|
+
(define (contains-free-variable param template)
|
184
|
+
(expr-dispatch template
|
185
|
+
(lambda (leaf)
|
186
|
+
(eqv? param leaf) )
|
187
|
+
(lambda (f g)
|
188
|
+
(or (contains-free-variable param f)
|
189
|
+
(contains-free-variable param g) ))
|
190
|
+
(lambda (var body)
|
191
|
+
(and (not (eqv? param var))
|
192
|
+
(contains-free-variable param body) ))))
|
193
|
+
|
194
|
+
(define (count-occurrences param template)
|
195
|
+
(expr-dispatch template
|
196
|
+
(lambda (leaf)
|
197
|
+
(if (eqv? param leaf) 1 0) )
|
198
|
+
(lambda (f g)
|
199
|
+
(+ (count-occurrences param f) (count-occurrences param g)) )
|
200
|
+
(lambda (var body)
|
201
|
+
(if (eqv? var param)
|
202
|
+
0
|
203
|
+
(count-occurrences param body) ))))
|
204
|
+
|
205
|
+
|
206
|
+
; Abstraction elimination.
|
207
|
+
|
208
|
+
(define (unabstract-lambda var body)
|
209
|
+
(if (contains-free-variable var body)
|
210
|
+
(expr-dispatch body
|
211
|
+
(lambda (leaf) 'i)
|
212
|
+
(lambda (f g)
|
213
|
+
(if (and (eqv? var g) (not (contains-free-variable var f)))
|
214
|
+
f
|
215
|
+
`((s ,(unabstract-lambda var f)) ,(unabstract-lambda var g)) ))
|
216
|
+
(lambda (v b)
|
217
|
+
(unabstract-lambda var (unabstract body)) ))
|
218
|
+
(list 'k body) ))
|
219
|
+
|
220
|
+
(define (unabstract code)
|
221
|
+
(expr-dispatch code
|
222
|
+
(lambda (leaf) leaf)
|
223
|
+
(lambda (f g)
|
224
|
+
(list (unabstract f) (unabstract g)) )
|
225
|
+
(lambda (var body)
|
226
|
+
(unabstract-lambda var (unabstract body)) )))
|
227
|
+
|
228
|
+
|
229
|
+
; Reduces expressions involving the S, K, I combinators where this
|
230
|
+
; results in a shorter expression. Usually results in only a small
|
231
|
+
; benefit.
|
232
|
+
|
233
|
+
(define (apply-ski expr)
|
234
|
+
(if (not (pair? expr))
|
235
|
+
expr
|
236
|
+
(let ((lhs (apply-ski (car expr)))
|
237
|
+
(rhs (cadr expr)) )
|
238
|
+
(cond ((eq? lhs 'i) ; Ix -> x
|
239
|
+
(apply-ski rhs) )
|
240
|
+
((and (pair? lhs) ; Kxy -> x
|
241
|
+
(eq? 'k (car lhs)) )
|
242
|
+
(cadr lhs) )
|
243
|
+
((and (pair? lhs) ; Sxyz -> xz(yz) when x or y is K_
|
244
|
+
(pair? (car lhs))
|
245
|
+
(eq? 's (caar lhs)) )
|
246
|
+
(let ((z rhs)
|
247
|
+
(y (cadr lhs))
|
248
|
+
(x (cadar lhs)) )
|
249
|
+
(if (or (and (pair? x) (eq? (car x) 'k))
|
250
|
+
(and (pair? y) (eq? (car y) 'k)) )
|
251
|
+
(apply-ski `((,x ,z) (,y ,z)))
|
252
|
+
(list lhs (apply-ski rhs)) )))
|
253
|
+
(else
|
254
|
+
(list lhs (apply-ski rhs)) )))))
|
255
|
+
|
256
|
+
|
257
|
+
; This converts expressions of the form ((x z) (y z)) to (s x y z).
|
258
|
+
; If z is just a symbol, then this change makes no difference to
|
259
|
+
; Unlambda output, always reduces the size of CC output (I think),
|
260
|
+
; and can either increase or reduce the side of Iota and Jot output.
|
261
|
+
; Currently the change is made only when z is not just a symbol.
|
262
|
+
;
|
263
|
+
; Like apply-ski, this gives only a small benefit in most cases.
|
264
|
+
|
265
|
+
(define (unapply-s expr)
|
266
|
+
(expr-dispatch expr
|
267
|
+
(lambda (leaf) leaf)
|
268
|
+
(lambda (f g)
|
269
|
+
(let ((f: (unapply-s f))
|
270
|
+
(g: (unapply-s g)) )
|
271
|
+
(if (and (pair? f:)
|
272
|
+
(pair? g:)
|
273
|
+
(pair? (cadr f:))
|
274
|
+
(equal? (cadr f:) (cadr g:)) )
|
275
|
+
`(((s ,(car f:)) ,(car g:)) ,(cadr f:))
|
276
|
+
(list f: g:) )))
|
277
|
+
(lambda (var body)
|
278
|
+
`(lambda (,var) ,(unapply-s body)) )))
|
279
|
+
|
280
|
+
|
281
|
+
; Putting it all together.
|
282
|
+
|
283
|
+
(define (laze code)
|
284
|
+
(unapply-s (apply-ski (unabstract (apply-lambdas (expand-macros (curry code)))))) )
|
285
|
+
|
286
|
+
|
287
|
+
; Printing it out.
|
288
|
+
|
289
|
+
(define (print-as-cc lazified-code)
|
290
|
+
(let self ((code lazified-code))
|
291
|
+
(expr-dispatch code
|
292
|
+
(lambda (leaf)
|
293
|
+
(if (memq leaf '(i k s))
|
294
|
+
(display (char-upcase (string-ref (symbol->string leaf) 0)))
|
295
|
+
(begin
|
296
|
+
(display "[")
|
297
|
+
(display leaf)
|
298
|
+
(display "]") )))
|
299
|
+
(lambda (f g)
|
300
|
+
(self f)
|
301
|
+
(if (pair? g) (display "("))
|
302
|
+
(self g)
|
303
|
+
(if (pair? g) (display ")")) )
|
304
|
+
(lambda (var body)
|
305
|
+
(error "Can't print lambdas as CC!") )))
|
306
|
+
(newline) )
|
307
|
+
|
308
|
+
|
309
|
+
(define (print-as-generic aply k s i)
|
310
|
+
(lambda (lazified-code)
|
311
|
+
(let self ((code lazified-code))
|
312
|
+
(expr-dispatch code
|
313
|
+
(lambda (leaf)
|
314
|
+
(cond ((eq? leaf 'i) (display i))
|
315
|
+
((eq? leaf 'k) (display k))
|
316
|
+
((eq? leaf 's) (display s))
|
317
|
+
(else (display "[") (display leaf) (display "]")) ))
|
318
|
+
(lambda (f g)
|
319
|
+
(display aply)
|
320
|
+
(self f)
|
321
|
+
(self g) )
|
322
|
+
(lambda (var body)
|
323
|
+
(error "Can't print lambdas as Lazy code!") )))
|
324
|
+
(newline) ))
|
325
|
+
|
326
|
+
(define print-as-unlambda (print-as-generic "`" "k" "s" "i"))
|
327
|
+
(define print-as-iota (print-as-generic "*" "*i*i*ii" "*i*i*i*ii" "*ii"))
|
328
|
+
(define print-as-jot (print-as-generic "1" "11100" "11111000" "11111111100000"))
|
@@ -0,0 +1,86 @@
|
|
1
|
+
;; Some commonly useful macros for Lazier.
|
2
|
+
;;
|
3
|
+
;; There must not be any circular definitions here
|
4
|
+
;; (e.g. a definition containing its own name). If
|
5
|
+
;; you need recursion, you'll have to roll your own.
|
6
|
+
;;
|
7
|
+
;; Unfortunately, sometimes these functions have
|
8
|
+
;; more than one form, and the one which is best for
|
9
|
+
;; inlining is longer when not inlined. I know that
|
10
|
+
;; this is the case for and, or, and list-of. In all
|
11
|
+
;; three cases I picked the form preferable for
|
12
|
+
;; inlining.
|
13
|
+
|
14
|
+
;;; logic
|
15
|
+
(lazy-def #t '(lambda (x y) x))
|
16
|
+
(lazy-def #f '(lambda (x y) y))
|
17
|
+
(lazy-def '(if p x y) '(p x y))
|
18
|
+
(lazy-def '(not p) '(if p #f #t))
|
19
|
+
(lazy-def '(and p q) '(if p q #f))
|
20
|
+
(lazy-def '(or p q) '(if p #t q))
|
21
|
+
|
22
|
+
;;; lists
|
23
|
+
(lazy-def '(cons x y) '(lambda (f) (f x y)))
|
24
|
+
(lazy-def '(car list) '(list #t))
|
25
|
+
(lazy-def '(cdr list) '(list #f))
|
26
|
+
(lazy-def () '(lambda (f) #t))
|
27
|
+
(lazy-def '(null? list) '(list (lambda (x y) #f)))
|
28
|
+
(lazy-def '(nth n lst) '(car ((n cdr) lst)))
|
29
|
+
(lazy-def '(list-ref lst n) '(nth n lst))
|
30
|
+
|
31
|
+
;;; Church numerals (see also prelude-numbers.scm)
|
32
|
+
(lazy-def '(1+ a) '(lambda (f) (lambda (x) (f ((a f) x)))))
|
33
|
+
(lazy-def 'succ '1+)
|
34
|
+
(lazy-def 0 '(lambda (f) (lambda (x) x)))
|
35
|
+
(lazy-def 1 '(lambda (f) f))
|
36
|
+
(lazy-def 2 '(1+ 1))
|
37
|
+
(lazy-def 4 '((lambda (x) (x x)) 2))
|
38
|
+
(lazy-def 256 '((lambda (x) (x x)) 4))
|
39
|
+
(lazy-def '(+ a) '(a 1+))
|
40
|
+
(lazy-def '(* a b) '(lambda (f) (a (b f))))
|
41
|
+
(lazy-def '(^ a b) '(b a))
|
42
|
+
(lazy-def '(ifnonzero n x y) '((n (k x)) y))
|
43
|
+
|
44
|
+
(lazy-def '(= a b)
|
45
|
+
'(nth b ((a (cons #f))
|
46
|
+
(cons #t (list-of #f)) )))
|
47
|
+
(lazy-def '(!= a b)
|
48
|
+
'(nth b ((a (cons #t))
|
49
|
+
(cons #f (list-of #t)) )))
|
50
|
+
|
51
|
+
; the following neat <= function is stolen from the Unlambda page
|
52
|
+
(lazy-def '(if<= m n x y) '((m ^ (k x)) (n ^ (k y))))
|
53
|
+
(lazy-def '(if> m n x y) '(if<= m n y x))
|
54
|
+
(lazy-def '(if>= m n x y) '(if<= n m x y))
|
55
|
+
(lazy-def '(if< m n x y) '(if<= n m y x))
|
56
|
+
|
57
|
+
|
58
|
+
;;; miscellaneous
|
59
|
+
|
60
|
+
(lazy-def 'end-of-output '(lambda (f) 256))
|
61
|
+
|
62
|
+
(lazy-def 'list-from
|
63
|
+
'((lambda (x) (x x))
|
64
|
+
(lambda (self n)
|
65
|
+
(cons n (self self (1+ n))) )))
|
66
|
+
|
67
|
+
; functional composition (same as *)
|
68
|
+
(lazy-def '(o f g) '(lambda (x) (f (g x))))
|
69
|
+
|
70
|
+
(lazy-def '(list-of elt)
|
71
|
+
'(Y (cons elt)) )
|
72
|
+
|
73
|
+
(lazy-def '(Y f)
|
74
|
+
'((lambda (x) (x x))
|
75
|
+
(lambda (self)
|
76
|
+
(f (self self)) )))
|
77
|
+
|
78
|
+
; The following definition of the Y combinator is taken from
|
79
|
+
; "Kolmogorov Complexity in Combinatory Logic" by John Tromp
|
80
|
+
; (http://www.cwi.nl/~tromp/cl/CL.ps). It is shorter by itself,
|
81
|
+
; but longer when applied. Interestingly, there is no way (that
|
82
|
+
; I found) to produce this from a lambda expression using
|
83
|
+
; Lazier. Specifically, Lazier can't figure out that
|
84
|
+
; (lambda (y) (x (w y x))) is equivalent to SS(Sw)(Kx).
|
85
|
+
|
86
|
+
;(lazy-def 'Y '(S S K (S (K (S S (S (S S K)))) K)))
|
data/examples/prime.lazy
ADDED
@@ -0,0 +1,20 @@
|
|
1
|
+
K
|
2
|
+
(SII(S(K(S(S(K(SII(S(S(KS)(S(K(S(KS)))(S(K(S(S(KS)(SS(S(S(KS)K))(KK)))))
|
3
|
+
(S(S(KS)(S(KK)(S(KS)(S(S(KS)(S(KK)(S(KS)(S(S(KS)(S(KK)(SII)))
|
4
|
+
(K(SI(KK)))))))(K(S(K(S(S(KS)(S(K(SI))(S(KK)(S(K(S(S(KS)K)(S(S(KS)K)I)
|
5
|
+
(S(SII)I(S(S(KS)K)I)(S(S(KS)K)))))(SI(K(KI)))))))))(S(KK)K)))))))(K(S(KK)
|
6
|
+
(S(SI(K(S(S(S(S(SSK(SI(K(KI))))(K(S(S(KS)K)I(S(S(KS)K)(S(S(KS)K)I))
|
7
|
+
(S(K(S(SI(K(KI)))))K)(KK))))(KK))(S(S(KS)(S(K(SI))(S(KK)(S(K(S(S(KS)K)))
|
8
|
+
(SI(KK))))))(K(K(KI)))))(S(S(KS)(S(K(SI))(SS(SI)(KK))))(S(KK)
|
9
|
+
(S(K(S(S(KS)K)))(SI(K(KI)))))))))(K(K(KI))))))))))(K(KI)))))(SI(KK)))))
|
10
|
+
(S(K(S(K(S(K(S(SI(K(S(K(S(S(KS)K)I))(S(SII)I(S(S(KS)K)I)))))))K))))
|
11
|
+
(S(S(KS)(S(KK)(SII)))(K(SI(K(KI)))))))(SII(S(K(S(S(KS)(S(K(S(S(SI(KK))
|
12
|
+
(KI))))(SS(S(S(KS)(S(KK)(S(KS)(S(K(SI))K)))))(KK))))))(S(S(KS)
|
13
|
+
(S(K(S(KS)))(S(K(S(KK)))(S(S(KS)(S(KK)(SII)))(K(S(S(KS)K)))))))(K(S(S(KS)
|
14
|
+
(S(K(S(S(SI(KK))(KI))))(S(KK)(S(K(SII(S(K(S(S(KS)(S(K(S(K(S(S(KS)(S(KK)
|
15
|
+
(S(KS)(S(K(SI))K))))(KK)))))(S(S(KS)(S(KK)(S(K(SI(KK)))(SI(KK)))))
|
16
|
+
(K(SI(KK))))))))(S(S(KS)(S(K(S(KS)))(S(K(S(KK)))(S(S(KS)(S(KK)(SII)))
|
17
|
+
(K(SI(K(KI))))))))(K(K(SI(K(KI)))))))))(S(K(SII))(S(K(S(K(SI(K(KI))))))
|
18
|
+
(S(S(KS)(S(KK)(SI(K(S(K(S(SI(K(KI)))))K)))))(K(S(K(S(SI(KK))))
|
19
|
+
(S(KK)(SII)))))))))))(K(SI(K(KI))))))))(S(S(KS)K)I)
|
20
|
+
(SII(S(K(S(K(S(SI(K(KI)))))K))(SII)))))
|
@@ -0,0 +1,12 @@
|
|
1
|
+
(load "lazier.scm")
|
2
|
+
(load "prelude.scm")
|
3
|
+
|
4
|
+
(lazy-def 'rev
|
5
|
+
'((lambda (f) (f end-of-output))
|
6
|
+
((lambda (x) (x x))
|
7
|
+
(lambda (self dst src)
|
8
|
+
(if>= (car src) 256
|
9
|
+
dst
|
10
|
+
(self self (cons (car src) dst) (cdr src)) )))))
|
11
|
+
|
12
|
+
(print-as-unlambda (laze 'rev))
|