rubymotionlisp 0.1.3

Sign up to get free protection for your applications and to get access to all the features.
@@ -0,0 +1,56 @@
1
+ module Lisp
2
+
3
+ class Symbol < Atom
4
+
5
+ def self.named(n)
6
+ name = n.to_s
7
+ @@symbols ||= {}
8
+ return @@symbols[n] if @@symbols.has_key?(n)
9
+ s = self.new(n)
10
+ @@symbols[n] = s
11
+ s
12
+ end
13
+
14
+ def initialize(n)
15
+ @value = n
16
+ @naked = (n[-1] == ?:)
17
+ end
18
+
19
+ def to_naked
20
+ Lisp::Symbol.named("#{@value}:")
21
+ end
22
+
23
+
24
+ def name
25
+ @value
26
+ end
27
+
28
+ def symbol?
29
+ true
30
+ end
31
+
32
+ def naked?
33
+ @naked
34
+ end
35
+
36
+
37
+ def type
38
+ :symbol
39
+ end
40
+
41
+ def evaluate(env)
42
+ return self if @naked
43
+ env.value_of(self)
44
+ end
45
+
46
+ def to_s
47
+ @value
48
+ end
49
+
50
+ def to_sym
51
+ @value.to_sym
52
+ end
53
+
54
+ end
55
+
56
+ end
@@ -0,0 +1,19 @@
1
+ module Lisp
2
+
3
+ class System
4
+
5
+ def self.register
6
+ Primitive.register("sleep") {|args, env| Lisp::System.sleep_impl(args, env) }
7
+ end
8
+
9
+
10
+ def self.sleep_impl(args, env)
11
+ raise "sleep needs 1 argument" if args.length != 1
12
+ arg = args.car.evaluate(env)
13
+ raise "sleep needs a numeric argument" unless arg.number?
14
+ sleep(arg.value)
15
+ end
16
+
17
+
18
+ end
19
+ end
@@ -0,0 +1,136 @@
1
+ module Lisp
2
+
3
+ class Testing
4
+
5
+
6
+ def self.register
7
+ Primitive.register("describe") {|args, env| Lisp::Testing::describe_impl(args, env) }
8
+ Primitive.register("check") {|args, env| Lisp::Testing::check_impl(args, env) }
9
+ Primitive.register("check!") {|args, env| Lisp::Testing::check_not_impl(args, env) }
10
+ Primitive.register("check*") {|args, env| Lisp::Testing::check_star_impl(args, env) }
11
+ end
12
+
13
+ def self.describe_impl(args, env)
14
+ raise "First arg to describe must be a string or symbol" if !args.car.symbol? && !args.car.string?
15
+ return if args.cdr.nil?
16
+ puts
17
+ puts " #{args.car.to_s}"
18
+ args.cdr.each do |clause|
19
+ clause.evaluate(env)
20
+ end
21
+ end
22
+
23
+ def self.do_comparison(c1, c2)
24
+ return Lisp::TRUE if c1.nil? && c2.nil?
25
+ return Lisp::FALSE if c1.nil? || c2.nil?
26
+ Lisp::Boolean.with_value(c1.eq?(c2))
27
+ end
28
+
29
+ def self.eval_check(code, c1, c2, inverted)
30
+ check_result = self.do_comparison(c1, c2)
31
+ passed = inverted ? check_result.negate : check_result
32
+
33
+ if passed.true?
34
+ @@number_of_passes += 1
35
+ puts "ok"
36
+ else
37
+ @@number_of_fails += 1
38
+ message = "failed: #{code.print_string} is #{c1.print_string}, expected #{inverted ? 'not ' : ''}#{c2.print_string}"
39
+ puts message
40
+ @@failure_messages << message
41
+ end
42
+ end
43
+
44
+
45
+ def self.unary_check(name,sexpr, env, inverted)
46
+ print " (#{name} #{sexpr.print_string}) - "
47
+ c1 = sexpr.evaluate(env)
48
+ self.eval_check(sexpr, c1, inverted ? Lisp::FALSE : Lisp::TRUE, false)
49
+ end
50
+
51
+
52
+ def self.binary_check(name, sexpr_1, sexpr_2, env, inverted)
53
+ print " (#{name} "
54
+ print "#{sexpr_1.print_string} "
55
+ print "#{sexpr_2.print_string}) - "
56
+ c1 = sexpr_1.evaluate(env)
57
+ c2 = sexpr_2.evaluate(env)
58
+ self.eval_check(sexpr_1, c1, c2, inverted)
59
+ end
60
+
61
+
62
+ def self.check_impl(args, env, inverted=false)
63
+ @@number_of_tests += 1
64
+ name = inverted ? "check!" : "check"
65
+ Lisp::Boolean.with_value(case (args.length)
66
+ when 1
67
+ self.unary_check(name, args.car, env, inverted)
68
+ when 2
69
+ self.binary_check(name, args.car, args.cadr, env, inverted)
70
+ else
71
+ raise "check takes 1 or 2 arguments, received #{args.length}"
72
+ end)
73
+ end
74
+
75
+
76
+ def self.check_not_impl(args, env)
77
+ self.check_impl(args, env, true)
78
+ end
79
+
80
+
81
+ def self.check_star_impl(args, env)
82
+ raise "check* needs 2 arguments, received #{args.length}" if args.length != 2
83
+ @@number_of_tests += 1
84
+ print " (check* #{args.car.print_string} #{args.cadr.print_string}) - "
85
+
86
+ c1 = args.car.evaluate(env)
87
+ c2 = args.cadr
88
+ self.eval_check(args.car, c1, c2, false)
89
+ end
90
+
91
+ def self.init
92
+ @@number_of_tests = 0
93
+ @@number_of_fails = 0
94
+ @@number_of_passes = 0
95
+ @@number_of_errors = 0
96
+ @@failure_messages = []
97
+ @@error_messages = []
98
+ end
99
+
100
+ def self.dump_messages(header, messages)
101
+ return if messages.empty?
102
+ puts " #{header}:"
103
+ messages.each do |message|
104
+ puts " #{message}"
105
+ end
106
+ puts ""
107
+ end
108
+
109
+ def self.print_test_results
110
+ puts ""
111
+ puts " Done."
112
+ puts ""
113
+
114
+ dump_messages("Errors", @@error_messages)
115
+ dump_messages("Failures", @@failure_messages)
116
+
117
+ puts " #{@@number_of_tests} Lisp tests"
118
+ puts " #{@@number_of_passes} passes, #{@@number_of_fails} fails, #{@@number_of_errors} errors"
119
+ end
120
+
121
+ def self.run_tests
122
+ register
123
+ init
124
+ Dir[File.dirname(__FILE__) + '/../../lisptest/*_test.lsp'].each do |test_filename|
125
+ puts "\nLoading #{test_filename}"
126
+ File.open(test_filename) do |f|
127
+ code_string = f.read()
128
+ Parser.new.parse_and_eval_all(code_string)
129
+ end
130
+ end
131
+ print_test_results
132
+ @@number_of_errors == 0 && @@number_of_fails == 0
133
+ end
134
+
135
+ end
136
+ end
@@ -0,0 +1,292 @@
1
+ module Lisp
2
+
3
+ class Tokenizer
4
+
5
+ attr_reader :line_number
6
+
7
+ def initialize(src)
8
+ @lookahead_token = 0
9
+ @lookahead_literal = ''
10
+ @source = src
11
+ @position = 0
12
+ end
13
+
14
+ def next_token
15
+ return @lookahead_token, @lookahead_literal
16
+ end
17
+
18
+ def eof?
19
+ @position >= @source.length
20
+ end
21
+
22
+ def almost_eof?
23
+ @position == @source.length - 1
24
+ end
25
+
26
+ def next_char
27
+ almost_eof? ? nil : @source[@position + 1]
28
+ end
29
+
30
+ def letter?(ch)
31
+ ch =~ /[[:alpha:]]/
32
+ end
33
+
34
+ def hex?(ch)
35
+ ch =~ /[abcdefABCDEF]/
36
+ end
37
+
38
+ def digit?(ch)
39
+ ch =~ /[[:digit:]]/
40
+ end
41
+
42
+ def number?(ch)
43
+ digit?(ch) || (ch == '-' && digit?(next_char))
44
+ end
45
+
46
+
47
+ def space?(ch)
48
+ ch =~ /[[:space:]]/
49
+ end
50
+
51
+
52
+ def symbol_character?(ch)
53
+ return true if letter?(ch)
54
+ return true if (?0..?9).include?(ch)
55
+ return "-_?!:*=<>".include?(ch)
56
+ end
57
+
58
+ def read_symbol
59
+ start = @position
60
+ tok = nil
61
+ if @source[@position] == '.'
62
+ @position += 1
63
+ tok = :FFI_SEND_SYMBOL
64
+ end
65
+
66
+ while !eof? && (symbol_character?(@source[@position]) ||
67
+ (@source[@position] == '.' && !symbol_character?(@source[@position+1]) && tok.nil?) ||
68
+ (@source[@position] == '/' && symbol_character?(@source[@position+1])))
69
+ tok ||= :FFI_NEW_SYMBOL if @source[@position] == '.'
70
+ tok = :FFI_STATIC_SYMBOL if @source[@position] == '/'
71
+ @position += 1
72
+ end
73
+
74
+ tok ||= :SYMBOL
75
+ return tok, case tok
76
+ when :SYMBOL, :FFI_STATIC_SYMBOL
77
+ @source[start...@position]
78
+ when :FFI_SEND_SYMBOL
79
+ @source[start+1...@position]
80
+ when :FFI_NEW_SYMBOL
81
+ @source[start...@position-1]
82
+ end
83
+ end
84
+
85
+ def read_number
86
+ start = @position
87
+ @position += 1 if @source[@position] == '-'
88
+ hex = @source[@position, 2] == "#x"
89
+ is_float = false
90
+ @position += 2 if hex
91
+ ch = @source[@position]
92
+ while !eof? && (digit?(ch) || (hex && hex?(ch)) || (!hex && !is_float && ch == ?.))
93
+ is_float ||= (ch == ?.)
94
+ @position += 1
95
+ ch = @source[@position]
96
+ end
97
+
98
+ tok = if hex
99
+ :HEXNUMBER
100
+ elsif is_float
101
+ :FLOAT
102
+ else
103
+ :NUMBER
104
+ end
105
+
106
+ return tok, @source[start...@position]
107
+ end
108
+
109
+
110
+ def process_escapes(str)
111
+ i = 0
112
+ processed_str = ""
113
+ while i < str.length
114
+ if str[i] == ?\\
115
+ processed_str << if i < (str.length - 1)
116
+ i += 1
117
+ case (str[i])
118
+ when ?n
119
+ "\n"
120
+ when ?t
121
+ "\t"
122
+ when ?\\
123
+ "\\"
124
+ else
125
+ "\\#{str[i]}"
126
+ end
127
+ else
128
+ "\\"
129
+ end
130
+ else
131
+ processed_str << str[i]
132
+ end
133
+ i += 1
134
+ end
135
+ processed_str
136
+ end
137
+
138
+
139
+ def read_string
140
+ start = @position
141
+ @position += 1
142
+ while !eof? && @source[@position] != ?"
143
+ @position += 1
144
+ end
145
+
146
+ return :EOF, '' if eof?
147
+ @position += 1
148
+ return :STRING, process_escapes(@source[start...@position])
149
+ end
150
+
151
+
152
+ def divider?(ch)
153
+ ch =~ /[[[:space:]]\(\)\{\}<>\[\]]/
154
+ end
155
+
156
+
157
+ def read_character
158
+ @position += 2
159
+ start = @position
160
+ @position += 1
161
+ while !eof? && !divider?(@source[@position])
162
+ @position += 1
163
+ end
164
+
165
+ return :CHARACTER, @source[start...@position]
166
+ end
167
+
168
+
169
+ def read_next_token
170
+ return :EOF, '' if eof?
171
+
172
+ while space?(@source[@position])
173
+ @line_number += 1 if @source[@position] == ?\n
174
+ @position += 1
175
+ return :EOF, '' if eof?
176
+ end
177
+
178
+ current_ch = @source[@position]
179
+ next_ch = @source[@position + 1] unless almost_eof?
180
+
181
+ if letter?(current_ch) || ('*._'.include?(current_ch) && letter?(next_ch))
182
+ return read_symbol
183
+ elsif number?(current_ch)
184
+ return read_number
185
+ elsif current_ch == ?- && number?(next_ch)
186
+ return read_number
187
+ elsif current_ch == ?# && next_ch == ?x
188
+ return read_number
189
+ elsif current_ch == ?"
190
+ return read_string
191
+ elsif current_ch == ?# && next_ch == ?\\
192
+ return read_character
193
+ elsif current_ch == ?'
194
+ @position += 1
195
+ return :QUOTE, "'"
196
+ elsif current_ch == ?`
197
+ @position += 1
198
+ return :BACKQUOTE, "`"
199
+ elsif current_ch == ?, && next_ch == ?@
200
+ @position += 2
201
+ return :COMMAAT, ",@"
202
+ elsif current_ch == ?,
203
+ @position += 1
204
+ return :COMMA, ","
205
+ elsif current_ch == ?(
206
+ @position += 1
207
+ return :LPAREN, "("
208
+ elsif current_ch == ?)
209
+ @position += 1
210
+ return :RPAREN, ")"
211
+ elsif current_ch == ?{
212
+ @position += 1
213
+ return :LBRACE, "{"
214
+ elsif current_ch == ?}
215
+ @position += 1
216
+ return :RBRACE, "}"
217
+ elsif current_ch == ?[
218
+ @position += 1
219
+ return :LBRACKET, "["
220
+ elsif current_ch == ?]
221
+ @position += 1
222
+ return :RBRACKET, "]"
223
+ elsif current_ch == ?.
224
+ @position += 1
225
+ return :PERIOD, "."
226
+ elsif current_ch == ?/ && next_ch == ?=
227
+ @position += 2
228
+ return :SYMBOL, "!="
229
+ elsif current_ch == ?- && next_ch == ?>
230
+ @position += 2
231
+ return :SYMBOL, "->"
232
+ elsif current_ch == ?= && next_ch == ?>
233
+ @position += 2
234
+ return :SYMBOL, "=>"
235
+ elsif "+-*/%".include?(current_ch)
236
+ @position += 1
237
+ return :SYMBOL, current_ch.to_s
238
+ elsif current_ch == ?< && next_ch == ?=
239
+ @position += 2
240
+ return :SYMBOL, "<="
241
+ elsif current_ch == ?<
242
+ @position += 1
243
+ return :SYMBOL, "<"
244
+ elsif current_ch == ?> && next_ch == ?=
245
+ @position += 2
246
+ return :SYMBOL, ">="
247
+ elsif current_ch == ?>
248
+ @position += 1
249
+ return :SYMBOL, ">"
250
+ elsif current_ch == ?= && next_ch == ?=
251
+ @position += 2
252
+ return :SYMBOL, "="
253
+ elsif current_ch == ?=
254
+ @position += 1
255
+ return :SYMBOL, "="
256
+ elsif current_ch == ?! && next_ch == ?=
257
+ @position += 2
258
+ return :SYMBOL, "!="
259
+ elsif current_ch == ?!
260
+ @position += 1
261
+ return :SYMBOL, "!"
262
+ elsif current_ch == ?# && next_ch == ?t
263
+ @position += 2
264
+ return :TRUE, "#t"
265
+ elsif current_ch == ?# && next_ch == ?f
266
+ @position += 2
267
+ return :FALSE, "#f"
268
+ elsif current_ch == ?;
269
+ start = @position
270
+ while true
271
+ return :COMMENT, @source[start..-1] if eof?
272
+ return :COMMENT, @source[start...@position] if @source[@position] == ?\n
273
+ @position += 1
274
+ end
275
+ else
276
+ return :ILLEGAL, ''
277
+ end
278
+ end
279
+
280
+ def consume_token
281
+ @lookahead_token, @lookahead_literal = read_next_token
282
+ consume_token if @lookahead_token == :COMMENT
283
+ end
284
+
285
+ def init
286
+ @line_number = 0
287
+ consume_token
288
+ end
289
+
290
+ end
291
+
292
+ end
@@ -0,0 +1,58 @@
1
+ module Lisp
2
+
3
+ class TypeChecks
4
+
5
+ def self.register
6
+ Primitive.register("list?") {|args, env| Lisp::TypeChecks::typep_impl("list?", :pair, args, env) }
7
+ Primitive.register("pair?") {|args, env| Lisp::TypeChecks::typep_impl("pair?", :pair, args, env) }
8
+ Primitive.register("symbol?") {|args, env| Lisp::TypeChecks::typep_impl("symbol?", :symbol, args, env) }
9
+ Primitive.register("number?") {|args, env| Lisp::TypeChecks::typep_impl("number?", :number, args, env) }
10
+ Primitive.register("integer?") {|args, env| Lisp::TypeChecks::integerp_impl(args, env) }
11
+ Primitive.register("float?") {|args, env| Lisp::TypeChecks::floatp_impl(args, env) }
12
+ Primitive.register("function?") {|args, env| Lisp::TypeChecks::functionp_impl(args, env) }
13
+
14
+ Primitive.register("nil?") {|args, env| Lisp::TypeChecks::nilp_impl(args, env) }
15
+ Primitive.register("not-nil?") {|args, env| Lisp::TypeChecks::not_nilp_impl(args, env) }
16
+ end
17
+
18
+
19
+ def self.typep_impl(name, sym, args, env)
20
+ raise "#{name} needs 1 argument" unless args.length == 1
21
+ return Lisp::Boolean.with_value(args.car.evaluate(env).type == sym)
22
+ end
23
+
24
+
25
+ def self.integerp_impl(args, env)
26
+ raise "integer? needs 1 argument" unless args.length == 1
27
+ val = args.car.evaluate(env)
28
+ return Lisp::Boolean.with_value(val.type == :number && val.integer?)
29
+ end
30
+
31
+
32
+ def self.floatp_impl(args, env)
33
+ raise "float? needs 1 argument" unless args.length == 1
34
+ val = args.car.evaluate(env)
35
+ return Lisp::Boolean.with_value(val.type == :number && val.float?)
36
+ end
37
+
38
+
39
+ def self.functionp_impl(args, env)
40
+ raise "function? needs 1 argument" unless args.length == 1
41
+ val = args.car.evaluate(env)
42
+ return Lisp::Boolean.with_value(val.type == :function || val.type == :primitive)
43
+ end
44
+
45
+
46
+ def self.nilp_impl(args, env)
47
+ raise "nil? needs 1 argument" unless args.length == 1
48
+ return Lisp::Boolean.with_value(args.car.evaluate(env).nil?)
49
+ end
50
+
51
+
52
+ def self.not_nilp_impl(args, env)
53
+ raise "not-nil? needs 1 argument" unless args.length == 1
54
+ return Lisp::Boolean.with_value(!args.car.evaluate(env).nil?)
55
+ end
56
+
57
+ end
58
+ end
@@ -0,0 +1,114 @@
1
+ module Lisp
2
+
3
+ class Vector < Atom
4
+
5
+ def self.register
6
+ Primitive.register("make-vector") {|args, env| Lisp::Vector::make_vector_impl(args, env) }
7
+ Primitive.register("vector") {|args, env| Lisp::Vector::vector_impl(args, env) }
8
+ end
9
+
10
+ def self.make_vector_impl(args, env)
11
+ c = args
12
+ a = []
13
+ while !c.nil?
14
+ a << c.car.evaluate(env)
15
+ c = c.cdr
16
+ end
17
+
18
+ Lisp::Vector.new(a)
19
+ end
20
+
21
+
22
+ def self.vector_impl(args, env)
23
+ raise "vector requires a single list argument." unless args.length == 1
24
+
25
+ c = args.car.evaluate(env)
26
+ Lisp::Vector.new(c.to_a)
27
+ end
28
+
29
+
30
+ def self.with_array(a)
31
+ self.new(a)
32
+ end
33
+
34
+
35
+ def initialize(a = [])
36
+ @value = a
37
+ self
38
+ end
39
+
40
+
41
+ def type
42
+ :vector
43
+ end
44
+
45
+
46
+ def vector?
47
+ true
48
+ end
49
+
50
+
51
+
52
+ def empty?
53
+ @value.empty?
54
+ end
55
+
56
+
57
+ def length
58
+ @value.size
59
+ end
60
+
61
+
62
+ def add(e)
63
+ @value << e
64
+ end
65
+
66
+
67
+ def to_a
68
+ @value
69
+ end
70
+
71
+
72
+ def to_s
73
+ "[#{@value.join(' ')}]"
74
+ end
75
+
76
+
77
+ def at(n)
78
+ @value[n - 1]
79
+ end
80
+ alias_method :nth, :at
81
+
82
+
83
+ def nth_tail(n)
84
+ return Lisp::Vector.new if n > @value.size
85
+ Lisp::Vector.new(@value[(n - 1)..-1])
86
+ end
87
+
88
+
89
+ def at_put(n, d)
90
+ @value[n - 1] = d
91
+ end
92
+
93
+
94
+ def set_nth!(n, d)
95
+ at_put(n, d)
96
+ end
97
+
98
+
99
+ def eq?(other)
100
+ return false unless other.vector?
101
+ return false unless @value.size == other.value.size
102
+ (0..@value.size).each do |i|
103
+ return false unless Lisp::Equivalence.equal_check(other.value[i], value[i]).value
104
+ end
105
+ true
106
+ end
107
+
108
+ def each &block
109
+ @value.each &block
110
+ end
111
+
112
+ end
113
+
114
+ end
data/lib/rubylisp.rb ADDED
@@ -0,0 +1 @@
1
+ Dir[File.dirname(__FILE__) + '/rubylisp/*.rb'].each {|file| require file }
@@ -0,0 +1,12 @@
1
+ unless defined?(Motion::Project::Config)
2
+ raise "This file must be required within a RubyMotion project Rakefile."
3
+ end
4
+
5
+ Motion::Project::App.setup do |app|
6
+ insert_point = app.files.find_index { |file| file =~ /^(?:\.\/)?app\// } || 0
7
+
8
+ Dir.glob(File.join(File.dirname(__FILE__), 'rubylisp/*.rb')).reverse.each do |file|
9
+ app.files.insert(insert_point, file)
10
+ end
11
+
12
+ end