rubymotionlisp 0.1.3

Sign up to get free protection for your applications and to get access to all the features.
@@ -0,0 +1,83 @@
1
+ module Lisp
2
+
3
+ class FfiSend < Atom
4
+
5
+ def initialize(name)
6
+ @value = name.to_sym
7
+ end
8
+
9
+ def apply_to(args, env)
10
+ apply_to_without_evaluating(Lisp::ConsCell.array_to_list(args.to_a.map {|a| a.evaluate(env)}), env)
11
+ end
12
+
13
+ def convert_value(value)
14
+ case value.class.name
15
+ when "Fixnum", "Float"
16
+ Lisp::Number.with_value(value)
17
+ when "TrueClass"
18
+ Lisp::Boolean.TRUE
19
+ when "FalseClass"
20
+ Lisp::Boolean.FALSE
21
+ when "String"
22
+ Lisp::String.with_value(value)
23
+ when "Symbol"
24
+ Lisp::Symbol.named(value)
25
+ when "Array"
26
+ Lisp::ConsCell.array_to_list(value.map {|a| convert_value(a)})
27
+ else
28
+ Lisp::NativeObject.with_value(value)
29
+ end
30
+ end
31
+
32
+
33
+ def process_arg(a, env)
34
+ if a.function?
35
+ proc do |*args|
36
+ arg_list = args.empty? ? nil : Lisp::ConsCell.array_to_list(args.collect {|arg| convert_value(arg) })
37
+ a.apply_to(arg_list, env)
38
+ end
39
+ elsif a.list?
40
+ a.to_a.map {|i| process_arg(i, env)}
41
+ else
42
+ a.value
43
+ end
44
+ end
45
+
46
+
47
+ def apply_to_without_evaluating(args, env)
48
+ target = args.car
49
+ raise "Send target of '#{@value}' evaluated to nil." if target.nil?
50
+ raise "Target of an FFI send of '#{@value}' must be a wrapped ObjC object, was #{target}" unless target.object?
51
+
52
+ arguments = args.cdr.nil? ? [] : args.cdr.to_a.map {|a| process_arg(a, env)}
53
+ result = nil
54
+
55
+ begin
56
+ result = if arguments[-1].instance_of?(Proc)
57
+ target.value.send(@value, *(arguments[0..-2]), &arguments[-1])
58
+ else
59
+ # puts "Sending #{@value} with #{arguments}"
60
+ target.value.send(@value, *arguments)
61
+ end
62
+ rescue Exception => e
63
+ raise "Exception sending #{@value}: #{e}"
64
+ end
65
+
66
+ convert_value(result)
67
+ end
68
+
69
+ def to_s
70
+ ".#{@value}"
71
+ end
72
+
73
+ def primitive?
74
+ true
75
+ end
76
+
77
+ def type
78
+ :primitive
79
+ end
80
+
81
+ end
82
+
83
+ end
@@ -0,0 +1,22 @@
1
+ module Lisp
2
+
3
+ class FfiStatic < FfiSend
4
+
5
+ def initialize(name)
6
+ @class_name, @value = name.split('/')
7
+ @klass = NativeObject.with_value(Object.const_get(@class_name))
8
+ end
9
+
10
+ def apply_to(args, env)
11
+ a = [@klass] + args.to_a
12
+ super(a, env)
13
+ end
14
+
15
+ def to_s
16
+ "#{@class_name}/#{@value}"
17
+ end
18
+
19
+
20
+ end
21
+
22
+ end
@@ -0,0 +1,284 @@
1
+ module Lisp
2
+
3
+ class Frame < Atom
4
+
5
+ def self.register
6
+ Primitive.register("make-frame", "(make-frame slot-name slot-value ... )\n\nFrames can be created using the make-frame function, passing it an alternating sequence of slot names and values:\n\n (make-frame a: 1 b: 2)\n\nThis results in a frame with two slots, named a: and b: with values 1 and 2, respectively.") do |args, env|
7
+ Lisp::Frame::make_frame_impl(args, env)
8
+ end
9
+
10
+ Primitive.register("has-slot?", "(has-slot? frame slot-name)\n\nThe has-slot? function is used to query whether a frame contains (directly or in an ancestor) the particular slot.") do |args, env|
11
+ Lisp::Frame::has_slot_impl(args, env)
12
+ end
13
+
14
+ Primitive.register("get-slot", "(get-slot _frame_ _slot-name_)\n\nThe get-slot function is used to retrieve values from frame slots") do |args, env|
15
+ Lisp::Frame::get_slot_impl(args, env)
16
+ end
17
+
18
+ Primitive.register("get-slot-if", "(get-slot-if frame slot-name)\n\nThe same as above, except that if a matching slot is not found, nil is returned instead of raising an error.") do |args, env|
19
+ Lisp::Frame::get_slot_if_impl(args, env)
20
+ end
21
+
22
+ Primitive.register("remove-slot!", "(remove-slot! frame slot-name)\n\nThe remove-slot! function is used to function is used to remove a slot from a frame. It only removes slots from the frame itself. not any of it's parents. remove-slot! return #t if the slot was removed, #f otherwise.") do |args, env|
23
+ Lisp::Frame::remove_slot_impl(args, env)
24
+ end
25
+
26
+ Primitive.register("set-slot!", "(set-slot! frame slot-name new-value)\n\nThe set-slot! function is used to change values in frame slots") do |args, env|
27
+ Lisp::Frame::set_slot_impl(args, env)
28
+ end
29
+
30
+ Primitive.register("send", "(send frame slot-name arg...)\n\nSend the message slot-name to frame, passing along the arg collection. The result is what is returned by the code in that slot.") do |args, env|
31
+ Lisp::Frame::send_impl(args, env)
32
+ end
33
+
34
+ Primitive.register("send-super", "**(send-super slot-name arg...)\n\nLike send, but sends to the first parent that has the named slot. send-super can only be used from within a frame.") do |args, env|
35
+ Lisp::Frame::send_super_impl(args, env)
36
+ end
37
+
38
+ Primitive.register("clone", "(clone frame)\n\nFrames represent things. For example, you could use a frame that looks like {x: 1 y: 10} to represent a point. A system that would use point frames will typically need many independant points. The approach to this is to create a prototypical point data frame, and use the clone function to create individual, independant frames.") do |args, env|
39
+ Lisp::Frame::clone_impl(args, env)
40
+ end
41
+
42
+ end
43
+
44
+
45
+ def self.make_frame_impl(args, env)
46
+ c = args
47
+ m = {}
48
+ while !c.nil?
49
+ k = c.car
50
+ raise "Slot names must be a symbol, found a {k.type}." unless k.symbol?
51
+ raise "Slot names must end in a colon, found '#{k}'." unless k.naked?
52
+ v = c.cadr.evaluate(env)
53
+ m[k] = v
54
+ c = c.cddr
55
+ end
56
+
57
+ Lisp::Frame.with_map(m)
58
+ end
59
+
60
+
61
+ def self.has_slot_impl(args, env)
62
+ frame = args.car.evaluate(env)
63
+ raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
64
+ key = args.cadr.evaluate(env)
65
+ raise "Frame key must be a symbol but was #{key.type}." unless key.symbol?
66
+ return Lisp::TRUE if frame.has_slot?(key)
67
+ Lisp::FALSE
68
+ end
69
+
70
+
71
+ def self.get_slot_impl(args, env)
72
+ frame = args.car.evaluate(env)
73
+ raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
74
+ key = args.cadr.evaluate(env)
75
+ raise "Frame key (#{key.to_s}) must be a symbol but was #{key.type}." unless key.symbol?
76
+ raise "Frame key (#{key.to_s}) must name an existing slot." unless frame.has_slot?(key)
77
+ frame.get(key)
78
+ end
79
+
80
+
81
+ def self.get_slot_if_impl(args, env)
82
+ frame = args.car.evaluate(env)
83
+ raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
84
+ key = args.cadr.evaluate(env)
85
+ raise "Frame key (#{key.to_s}) must be a symbol but was #{key.type}." unless key.symbol?
86
+ frame.get(key)
87
+ end
88
+
89
+
90
+ def self.remove_slot_impl(args, env)
91
+ frame = args.car.evaluate(env)
92
+ raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
93
+ key = args.cadr.evaluate(env)
94
+ raise "Frame key (#{key.to_s}) must be a symbol but was #{key.type}." unless key.symbol?
95
+ return Lisp::TRUE if frame.remove(key)
96
+ Lisp::FALSE
97
+ end
98
+
99
+
100
+ def self.set_slot_impl(args, env)
101
+ frame = args.car.evaluate(env)
102
+ raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
103
+ key = args.cadr.evaluate(env)
104
+ raise "Frame key (#{key.to_s}) must be a symbol but was #{key.type}." unless key.symbol?
105
+ value = args.caddr.evaluate(env)
106
+ frame.at_put(key, value)
107
+ end
108
+
109
+
110
+ def self.send_impl(args, env)
111
+ frame = args.car.evaluate(env)
112
+ raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
113
+ selector = args.cadr.evaluate(env)
114
+ raise "Selector must be a symbol but was #{selector.type}." unless selector.symbol?
115
+ raise "Message sent must name an existing slot in the receiver." unless frame.has_slot?(selector)
116
+ func = frame.get(selector)
117
+ raise "Message sent must select a function slot but was #{func.type}." unless func.function?
118
+ params = args.cddr
119
+ frame_env = Lisp::EnvironmentFrame.extending(env, frame)
120
+ frame_env.bind_locally(Symbol.named("self"), frame)
121
+ func.apply_to(params, frame_env)
122
+ end
123
+
124
+ def self.get_super_function(selector, env)
125
+ f = env.frame
126
+ return nil if f.nil?
127
+ f.parents.each do |p|
128
+ func = p.get(selector)
129
+ return func unless func.nil?
130
+ end
131
+ nil
132
+ end
133
+
134
+ def self.send_super_impl(args, env)
135
+ raise "super can only be used within the context of a frame." unless env.frame
136
+ selector = args.car.evaluate(env)
137
+ raise "Selector must be a symbol but was #{selector.type}." unless selector.symbol?
138
+ func = get_super_function(selector, env)
139
+ raise "Message sent must select a function slot but was #{func.type}." unless func && func.function?
140
+ params = args.cdr
141
+ frame_env = Lisp::EnvironmentFrame.extending(env, env.frame)
142
+ frame_env.bind_locally(Symbol.named("self"), env.frame)
143
+ func.apply_to(params, frame_env)
144
+ end
145
+
146
+
147
+ def self.clone_impl(args, env)
148
+ frame = args.car.evaluate(env)
149
+ raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
150
+ frame.clone
151
+ end
152
+
153
+
154
+ def self.with_map(m)
155
+ self.new(m)
156
+ end
157
+
158
+ def initialize(m=nil)
159
+ @value = m || {}
160
+ end
161
+
162
+
163
+ def clone
164
+ Lisp::Frame.with_map(@value.clone)
165
+ end
166
+
167
+
168
+ def is_parent_key(k)
169
+ k.to_s[-2] == "*"
170
+ end
171
+
172
+
173
+ def local_slots
174
+ @value.keys
175
+ end
176
+
177
+
178
+ def inherited_value_slots
179
+ parent_frames = parent_slots.collect {|pk| get(pk)}
180
+ parent_slots = parent_frames.collect {|p| p.inherited_value_slots}
181
+ local_value_slots = Set[local_slots.reject {|s| is_parent_key(k)}]
182
+ parent_slots.inject(local_value_slots) {|all, s| all + s}
183
+ end
184
+
185
+
186
+ def has_parent_slots?
187
+ @value.keys.any? {|k| is_parent_key(k)}
188
+ end
189
+
190
+
191
+ def parent_slots
192
+ @value.keys.select {|k| is_parent_key(k)}
193
+ end
194
+
195
+
196
+ def parents
197
+ parent_slots.collect {|pk| @value[pk]}
198
+ end
199
+
200
+
201
+ def has_slot_locally?(n)
202
+ @value.has_key?(n)
203
+ end
204
+
205
+
206
+ def has_slot?(n)
207
+ return true if has_slot_locally?(n)
208
+ return false unless has_parent_slots?
209
+ return parents.any? {|p| p.has_slot?(n)}
210
+ end
211
+
212
+
213
+ def get(key)
214
+ return @value[key] if has_slot_locally?(key)
215
+ parents.each do |p|
216
+ value = p.get(key)
217
+ return value unless value.nil?
218
+ end
219
+ nil
220
+ end
221
+
222
+
223
+ def remove(key)
224
+ return false unless has_slot_locally?(key)
225
+ @value.delete(key)
226
+ true
227
+ end
228
+
229
+
230
+ def at_put(key, value)
231
+ return @value[key] = value if !has_slot?(key) || has_slot_locally?(key)
232
+ parents.each do |p|
233
+ v = p.at_put(key, value)
234
+ return v unless v.nil?
235
+ end
236
+ nil
237
+ end
238
+
239
+
240
+ def lisp_object?
241
+ true
242
+ end
243
+
244
+ def type
245
+ :frame
246
+ end
247
+
248
+ def empty?
249
+ @value.empty?
250
+ end
251
+
252
+ def frame?
253
+ true
254
+ end
255
+
256
+ def length
257
+ return @value.length
258
+ end
259
+
260
+ def car
261
+ nil
262
+ end
263
+
264
+ def cdr
265
+ nil
266
+ end
267
+
268
+ def eq?(other)
269
+ return false unless other.frame?
270
+ return false unless @value.length == other.value.length
271
+ @value.each do |k, v|
272
+ return false unless Lisp::Equivalence.equal_check(other.value[k], v).value
273
+ end
274
+ true
275
+ end
276
+
277
+ def to_s
278
+ pairs = @value.collect {|k, v| "#{k.to_s} #{v.to_s}"}
279
+ "{#{pairs.join(' ')}}"
280
+ end
281
+
282
+ end
283
+
284
+ end
@@ -0,0 +1,92 @@
1
+ module Lisp
2
+
3
+ class Function < Atom
4
+
5
+ attr_reader :doc, :required_argument_count
6
+
7
+ def compute_required_argument_count(args)
8
+ a = args
9
+ @required_argument_count = 0
10
+ @var_args = false
11
+ while a
12
+ if a.symbol?
13
+ @var_args = true
14
+ return
15
+ else
16
+ @required_argument_count += 1
17
+ end
18
+ a = a.cdr
19
+ end
20
+ end
21
+
22
+
23
+ def initialize(name, arguments, doc, body, env)
24
+ sig = ([name] << arguments.to_a).flatten
25
+ @doc = "(#{(sig.collect {|e| e.to_s}).join(" ")})"
26
+ @name = name
27
+ @arguments = arguments
28
+ @doc = [@doc, doc].join("\n\n") unless doc.nil? || doc.to_s.empty?
29
+ @body = body
30
+ @env = env
31
+ @local_env = nil
32
+ compute_required_argument_count(@arguments)
33
+ end
34
+
35
+
36
+ def internal_apply_to(parameters, env, should_eval)
37
+ if @var_args
38
+ raise "#{@name} expected at least #{@required_argument_count} parameters, received #{parameters.length}." if parameters.length < @required_argument_count
39
+ else
40
+ raise "#{@name} expected #{@required_argument_count} parameters, received #{parameters.length}." unless parameters.length == @required_argument_count
41
+ end
42
+
43
+ local_env = EnvironmentFrame.extending(@env, env.frame)
44
+ self_sym = Symbol.named("self")
45
+ if env.frame
46
+ local_env.bind_locally(self_sym, env.frame)
47
+ elsif env.local_binding_for(self_sym)
48
+ local_env.bind_locally(self_sym, env.value_of(self_sym))
49
+ end
50
+ arg = @arguments
51
+ param = parameters
52
+ accumulating_arg = nil
53
+ accumulated_params = []
54
+ while !param.nil?
55
+ param_value = should_eval ? param.car.evaluate(env) : param.car
56
+ if accumulating_arg
57
+ accumulated_params << param_value
58
+ else
59
+ local_env.bind_locally(arg.car, param_value) unless arg.car.nil?
60
+ end
61
+ param = param.cdr
62
+ arg = arg.cdr unless accumulating_arg
63
+ accumulating_arg = arg if arg.symbol?
64
+ end
65
+ local_env.bind_locally(accumulating_arg, Lisp::ConsCell.array_to_list(accumulated_params)) if accumulating_arg
66
+
67
+ @body.evaluate_each(local_env)
68
+ end
69
+
70
+ def apply_to(parameters, env)
71
+ internal_apply_to(parameters, env, true)
72
+ end
73
+
74
+ def apply_to_without_evaluating(parameters, env)
75
+ internal_apply_to(parameters, env, false)
76
+ end
77
+
78
+ def to_s
79
+ "<function: #{@name}>"
80
+ end
81
+
82
+ def function?
83
+ true
84
+ end
85
+
86
+ def type
87
+ :function
88
+ end
89
+
90
+ end
91
+
92
+ end
@@ -0,0 +1,74 @@
1
+ module Lisp
2
+
3
+ class IO
4
+
5
+ def self.register
6
+ Primitive.register("load") {|args, env| Lisp::IO::load_impl(args, env) }
7
+ Primitive.register("load-library") {|args, env| Lisp::IO::load_library_impl(args, env) }
8
+ Primitive.register("load-project") {|args, env| Lisp::IO::load_project_impl(args, env) }
9
+ Primitive.register("trace") {|args, env| puts "Trace: #{(args.to_a.map {|a| a.evaluate(env).value.to_s}).join(' ')}"; nil}
10
+ Primitive.register("error") {|args, env| App.alert((args.to_a.map {|a| a.evaluate(env).value.to_s}).join(' '))}
11
+ Primitive.register("alert") {|args, env| App.alert((args.to_a.map {|a| a.evaluate(env).value.to_s}).join(' '))}
12
+ end
13
+
14
+
15
+ def self.load_impl(args, env)
16
+ raise "'load' requires 1 argument." if args.empty?
17
+ fname = args.car.evaluate(env)
18
+ raise "'load' requires a string argument." unless fname.string?
19
+ filename = fname.value.end_with?(".lsp") ? fname.value : "#{fname.value}.lsp"
20
+ File.open(filename) do |f|
21
+ contents = f.read()
22
+ Lisp::Parser.new.parse_and_eval_all(contents)
23
+ end
24
+ Lisp::String.with_value("OK")
25
+ end
26
+
27
+
28
+ def self.load_library_impl(args, env)
29
+ raise "'load-library' requires 1 argument." if args.empty?
30
+ library_name = args.car.evaluate(env)
31
+ raise "'load-library' requires a string or symbol argument." unless library_name.string? || library_name.symbol?
32
+ Dir.chdir(File.join(App.documents_path, "libraries", "#{library_name}.lib")) do |d|
33
+ if File.exists?("load.lsp")
34
+ File.open("load.lsp") do |f|
35
+ contents = f.read()
36
+ Lisp::Parser.new.parse_and_eval_all(contents)
37
+ end
38
+ else
39
+ Dir.glob("*.lsp") do |filename|
40
+ File.open(filename) do |f|
41
+ contents = f.read()
42
+ Lisp::Parser.new.parse_and_eval_all(contents)
43
+ end
44
+ end
45
+ end
46
+ end
47
+ Lisp::String.with_value("OK")
48
+ end
49
+
50
+
51
+ def self.load_project_impl(args, env)
52
+ raise "'load-project' requires 1 argument." if args.empty?
53
+ project_name = args.car.evaluate(env)
54
+ raise "'load-project' requires a string or symbol argument." unless project_name.string? || project_name.symbol?
55
+ Dir.chdir(File.join(App.documents_path, "projects", "#{project_name}.prj")) do |d|
56
+ if File.exists?("load.lsp")
57
+ File.open("load.lsp") do |f|
58
+ contents = f.read()
59
+ Lisp::Parser.new.parse_and_eval_all(contents)
60
+ end
61
+ else
62
+ Dir.glob("*.lsp") do |filename|
63
+ File.open(filename) do |f|
64
+ contents = f.read()
65
+ Lisp::Parser.new.parse_and_eval_all(contents)
66
+ end
67
+ end
68
+ end
69
+ end
70
+ Lisp::String.with_value("OK")
71
+ end
72
+
73
+ end
74
+ end