rubymotionlisp 0.1.4 → 0.2.0

Sign up to get free protection for your applications and to get access to all the features.
@@ -2,7 +2,7 @@ module Lisp
2
2
 
3
3
  class EnvironmentFrame
4
4
 
5
- attr_accessor :frame
5
+ attr_accessor :frame, :current_code, :previous
6
6
 
7
7
  def self.global
8
8
  @@global_frame ||= EnvironmentFrame.new(nil)
@@ -18,6 +18,7 @@ module Lisp
18
18
  @bindings = []
19
19
  @parent = parent
20
20
  @frame = f
21
+ @current_code = []
21
22
  end
22
23
 
23
24
  def has_frame?
@@ -103,14 +104,56 @@ module Lisp
103
104
  b = binding_for(Symbol.new(symbol_name))
104
105
  b.nil? ? nil : b.value
105
106
  end
106
-
107
107
 
108
- def dump
108
+
109
+ def dump_bindings
109
110
  @bindings.each do |b|
110
- puts b.to_s
111
+ puts b.to_s if b.value.nil? || !b.value.primitive?
111
112
  end
113
+ puts
114
+ end
115
+
116
+
117
+ def dump(frame_number=0)
118
+ puts "Frame #{frame_number}: #{@current_code[0]}"
119
+ dump_bindings
120
+ @previous.dump(frame_number + 1) unless @previous.nil?
121
+ end
122
+
123
+
124
+ def dump_single_frame(frame_number)
125
+ if frame_number == 0
126
+ puts "Evaling: #{@current_code[0]}"
127
+ dump_bindings
128
+ elsif !@previous.nil?
129
+ @previous.dump_single_frame(frame_number - 1)
130
+ else
131
+ puts "Invalid frame selected."
132
+ end
133
+ end
134
+
135
+ def internal_dump_headers(frame_number)
136
+ puts "Frame #{frame_number}: #{@current_code[0]}"
137
+ @previous.internal_dump_headers(frame_number + 1) unless @previous.nil?
138
+ end
139
+
140
+
141
+
142
+ def dump_headers
143
+ puts
144
+ internal_dump_headers(0)
112
145
  end
113
146
 
147
+
148
+ def depth
149
+ if @previous.nil?
150
+ 1
151
+ else
152
+ 1 + @previous.depth
153
+ end
154
+ end
155
+
114
156
  end
115
157
 
158
+
116
159
  end
@@ -37,20 +37,20 @@ module Lisp
37
37
  frame = frame.parent
38
38
  if frame.nil?
39
39
  exception_message = message.empty? ? "" : ": #{message}"
40
- raise "Unhandled Exception: #{exception_name}#{exception_message}"
40
+ return Lisp::Debug.process_error("Unhandled Exception: #{exception_name}#{exception_message}", env)
41
41
  end
42
42
  end
43
43
  end
44
44
 
45
45
  def self.raise_impl(args, env)
46
- raise "'raise' requires at least one argument." unless args.length > 0
46
+ return Lisp::Debug.process_error("'raise' requires at least one argument.", env) unless args.length > 0
47
47
  exception_name = args.car.evaluate(env)
48
- raise "'raise' requires an exception name as it's first argument." unless exception_name.string? || class_name.symbol?
48
+ return Lisp::Debug.process_error("'raise' requires an exception name as it's first argument.", env) unless exception_name.string? || class_name.symbol?
49
49
 
50
50
  message = ""
51
51
  if args.length > 1
52
52
  message = args.cadr.evaluate(env)
53
- raise "The message parameter to 'raise' must be a string." unless message.string?
53
+ return Lisp::Debug.process_error("The message parameter to 'raise' must be a string.", env) unless message.string?
54
54
  end
55
55
 
56
56
  handler_args = args.length > 2 ? Lisp::ConsCell.array_to_list(args.cdr.to_a.collect {|a| a.evaluate(env)}) : Lisp::ConsCell.new
@@ -61,9 +61,9 @@ module Lisp
61
61
  raw_handlers = args.car
62
62
  body = args.cdr
63
63
 
64
- raise "Exception handlers must be a list." unless raw_handlers.list?
65
- raise "Exception handlers must be a list of pairs." unless raw_handlers.all? {|h| h.list?}
66
- raise "Exception clause must be a symbol/string or a list of symbol/string." unless raw_handlers.all? do |h|
64
+ return Lisp::Debug.process_error("Exception handlers must be a list.", env) unless raw_handlers.list?
65
+ return Lisp::Debug.process_error("Exception handlers must be a list of pairs.", env) unless raw_handlers.all? {|h| h.list?}
66
+ return Lisp::Debug.process_error("Exception clause must be a symbol/string or a list of symbol/string.", env) unless raw_handlers.all? do |h|
67
67
  ex = h.car
68
68
  ex.symbol? || ex.string? || (ex.list? && ex.all? {|h2| h2.symbol? || h2.string?})
69
69
  end
@@ -71,7 +71,7 @@ module Lisp
71
71
  array_of_handlers = raw_handlers.to_a.collect do |h|
72
72
  ex = h.car
73
73
  f = h.cadr.evaluate(env)
74
- raise "Exception handler has to be a function." unless f.function?
74
+ return Lisp::Debug.process_error("Exception handler has to be a function.", env) unless f.function?
75
75
  Lisp::ConsCell.cons(ex, f)
76
76
  end
77
77
  handlers = Lisp::ConsCell.array_to_list(array_of_handlers)
data/lib/rubylisp/ext.rb CHANGED
@@ -20,6 +20,10 @@ class NilClass
20
20
  self.to_s
21
21
  end
22
22
 
23
+ def print_string_helper
24
+ ""
25
+ end
26
+
23
27
  def evaluate(env)
24
28
  nil
25
29
  end
@@ -24,17 +24,17 @@ module Lisp
24
24
 
25
25
 
26
26
  def self.extend_impl(args, env)
27
- raise "'extend' requires 2 arguments." if args.length != 2
27
+ return Lisp::Debug.process_error("'extend' requires 2 arguments.", env) if args.length != 2
28
28
 
29
29
  class_name = args.car.evaluate(env)
30
- raise "'extend' requires a name as it's first argument." unless class_name.string? || class_name.symbol?
30
+ return Lisp::Debug.process_error("'extend' requires a name as it's first argument.", env) unless class_name.string? || class_name.symbol?
31
31
  super_class = Object.const_get(class_name.to_s)
32
- raise "'extend' requires the name of an existing class as it's first argument." if super_class.nil?
32
+ return Lisp::Debug.process_error("'extend' requires the name of an existing class as it's first argument.", env) if super_class.nil?
33
33
 
34
34
  new_class_name = args.cadr.evaluate(env)
35
- raise "'extend' requires a name as it's second argument." unless new_class_name.string? || new_class_name.symbol?
35
+ return Lisp::Debug.process_error("'extend' requires a name as it's second argument.", env) unless new_class_name.string? || new_class_name.symbol?
36
36
  new_class = Class.new(super_class)
37
- raise "'extend' requires the name of a new (i.e. nonexistant) class as it's second argument." if Object.const_defined?(new_class_name.to_s)
37
+ return Lisp::Debug.process_error("'extend' requires the name of a new (i.e. nonexistant) class as it's second argument.", env) if Object.const_defined?(new_class_name.to_s)
38
38
 
39
39
  Object.const_set(new_class_name.to_s, new_class)
40
40
  ClassObject.with_class(new_class)
@@ -77,17 +77,17 @@ module Lisp
77
77
 
78
78
 
79
79
  def self.add_method_impl(args, env)
80
- raise "'add-method' requires 3 arguments." if args.length != 3
80
+ return Lisp::Debug.process_error("'add-method' requires 3 arguments.", env) if args.length != 3
81
81
  class_name = args.car.evaluate(env)
82
- raise "'add-method' requires a class name as it's first argument." unless class_name.string? || class_name.symbol?
82
+ return Lisp::Debug.process_error("'add-method' requires a class name as it's first argument.", env) unless class_name.string? || class_name.symbol?
83
83
  target_class = Object.const_get(class_name.to_s)
84
- raise "'add-method' requires the name of an existing class." if target_class.nil?
84
+ return Lisp::Debug.process_error("'add-method' requires the name of an existing class.", env) if target_class.nil?
85
85
 
86
86
  method_name = args.cadr.evaluate(env)
87
- raise "'add-method' requires a method name as it's second argument." unless class_name.string? || class_name.symbol?
87
+ return Lisp::Debug.process_error("'add-method' requires a method name as it's second argument.", env) unless class_name.string? || class_name.symbol?
88
88
 
89
89
  body = args.caddr.evaluate(env)
90
- raise "'add-method' requires a function as it's third argument." unless body.function?
90
+ return Lisp::Debug.process_error("'add-method' requires a function as it's third argument.", env) unless body.function?
91
91
 
92
92
  target_class.send(:define_method, method_name.to_s) do |*args|
93
93
  local_env = Lisp::EnvironmentFrame.extending(env)
@@ -46,8 +46,8 @@ module Lisp
46
46
 
47
47
  def apply_to_without_evaluating(args, env)
48
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?
49
+ return Lisp::Debug.process_error("Send target of '#{@value}' evaluated to nil.", env) if target.nil?
50
+ return Lisp::Debug.process_error("Target of an FFI send of '#{@value}' must be a wrapped ObjC object, was #{target}", env) unless target.object?
51
51
 
52
52
  arguments = args.cdr.nil? ? [] : args.cdr.to_a.map {|a| process_arg(a, env)}
53
53
  result = nil
@@ -60,7 +60,7 @@ module Lisp
60
60
  target.value.send(@value, *arguments)
61
61
  end
62
62
  rescue Exception => e
63
- raise "Exception sending #{@value}: #{e}"
63
+ return Lisp::Debug.process_error("Exception sending #{@value}: #{e}", env)
64
64
  end
65
65
 
66
66
  convert_value(result)
@@ -39,6 +39,10 @@ module Lisp
39
39
  Lisp::Frame::clone_impl(args, env)
40
40
  end
41
41
 
42
+ Primitive.register("keys", "(keys frame)\n\nReturn a list of the keys in the frame.") do |args, env|
43
+ Lisp::Frame::keys_impl(args, env)
44
+ end
45
+
42
46
  end
43
47
 
44
48
 
@@ -47,8 +51,8 @@ module Lisp
47
51
  m = {}
48
52
  while !c.nil?
49
53
  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?
54
+ return Lisp::Debug.process_error("Slot names must be a symbol, found a {k.type}.", env) unless k.symbol?
55
+ return Lisp::Debug.process_error("Slot names must end in a colon, found '#{k}'.", env) unless k.naked?
52
56
  v = c.cadr.evaluate(env)
53
57
  m[k] = v
54
58
  c = c.cddr
@@ -60,9 +64,9 @@ module Lisp
60
64
 
61
65
  def self.has_slot_impl(args, env)
62
66
  frame = args.car.evaluate(env)
63
- raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
67
+ return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
64
68
  key = args.cadr.evaluate(env)
65
- raise "Frame key must be a symbol but was #{key.type}." unless key.symbol?
69
+ return Lisp::Debug.process_error("Frame key must be a symbol but was #{key.type}.", env) unless key.symbol?
66
70
  return Lisp::TRUE if frame.has_slot?(key)
67
71
  Lisp::FALSE
68
72
  end
@@ -70,28 +74,28 @@ module Lisp
70
74
 
71
75
  def self.get_slot_impl(args, env)
72
76
  frame = args.car.evaluate(env)
73
- raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
77
+ return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
74
78
  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)
79
+ return Lisp::Debug.process_error("Frame key (#{key.to_s}) must be a symbol but was #{key.type}.", env) unless key.symbol?
80
+ return Lisp::Debug.process_error("Frame key (#{key.to_s}) must name an existing slot.", env) unless frame.has_slot?(key)
77
81
  frame.get(key)
78
82
  end
79
83
 
80
84
 
81
85
  def self.get_slot_if_impl(args, env)
82
86
  frame = args.car.evaluate(env)
83
- raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
87
+ return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
84
88
  key = args.cadr.evaluate(env)
85
- raise "Frame key (#{key.to_s}) must be a symbol but was #{key.type}." unless key.symbol?
89
+ return Lisp::Debug.process_error("Frame key (#{key.to_s}) must be a symbol but was #{key.type}.", env) unless key.symbol?
86
90
  frame.get(key)
87
91
  end
88
92
 
89
93
 
90
94
  def self.remove_slot_impl(args, env)
91
95
  frame = args.car.evaluate(env)
92
- raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
96
+ return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
93
97
  key = args.cadr.evaluate(env)
94
- raise "Frame key (#{key.to_s}) must be a symbol but was #{key.type}." unless key.symbol?
98
+ return Lisp::Debug.process_error("Frame key (#{key.to_s}) must be a symbol but was #{key.type}.", env) unless key.symbol?
95
99
  return Lisp::TRUE if frame.remove(key)
96
100
  Lisp::FALSE
97
101
  end
@@ -99,9 +103,9 @@ module Lisp
99
103
 
100
104
  def self.set_slot_impl(args, env)
101
105
  frame = args.car.evaluate(env)
102
- raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
106
+ return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
103
107
  key = args.cadr.evaluate(env)
104
- raise "Frame key (#{key.to_s}) must be a symbol but was #{key.type}." unless key.symbol?
108
+ return Lisp::Debug.process_error("Frame key (#{key.to_s}) must be a symbol but was #{key.type}.", env) unless key.symbol?
105
109
  value = args.caddr.evaluate(env)
106
110
  frame.at_put(key, value)
107
111
  end
@@ -109,12 +113,12 @@ module Lisp
109
113
 
110
114
  def self.send_impl(args, env)
111
115
  frame = args.car.evaluate(env)
112
- raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
116
+ return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
113
117
  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)
118
+ return Lisp::Debug.process_error("Selector must be a symbol but was #{selector.type}.", env) unless selector.symbol?
119
+ return Lisp::Debug.process_error("Message sent must name an existing slot in the receiver.", env) unless frame.has_slot?(selector)
116
120
  func = frame.get(selector)
117
- raise "Message sent must select a function slot but was #{func.type}." unless func.function?
121
+ return Lisp::Debug.process_error("Message sent must select a function slot but was #{func.type}.", env) unless func.function?
118
122
  params = args.cddr
119
123
  frame_env = Lisp::EnvironmentFrame.extending(env, frame)
120
124
  frame_env.bind_locally(Symbol.named("self"), frame)
@@ -132,11 +136,11 @@ module Lisp
132
136
  end
133
137
 
134
138
  def self.send_super_impl(args, env)
135
- raise "super can only be used within the context of a frame." unless env.frame
139
+ return Lisp::Debug.process_error("super can only be used within the context of a frame.", env) unless env.frame
136
140
  selector = args.car.evaluate(env)
137
- raise "Selector must be a symbol but was #{selector.type}." unless selector.symbol?
141
+ return Lisp::Debug.process_error("Selector must be a symbol but was #{selector.type}.", env) unless selector.symbol?
138
142
  func = get_super_function(selector, env)
139
- raise "Message sent must select a function slot but was #{func.type}." unless func && func.function?
143
+ return Lisp::Debug.process_error("Message sent must select a function slot but was #{func.type}.", env) unless func && func.function?
140
144
  params = args.cdr
141
145
  frame_env = Lisp::EnvironmentFrame.extending(env, env.frame)
142
146
  frame_env.bind_locally(Symbol.named("self"), env.frame)
@@ -146,11 +150,18 @@ module Lisp
146
150
 
147
151
  def self.clone_impl(args, env)
148
152
  frame = args.car.evaluate(env)
149
- raise "Frame data must be a frame but was #{frame.type}." unless frame.frame?
153
+ return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
150
154
  frame.clone
151
155
  end
152
156
 
153
157
 
158
+ def self.keys_impl(args, env)
159
+ frame = args.car.evaluate(env)
160
+ return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
161
+ ConsCell.array_to_list(frame.value.keys)
162
+ end
163
+
164
+
154
165
  def self.with_map(m)
155
166
  self.new(m)
156
167
  end
@@ -203,23 +214,37 @@ module Lisp
203
214
  end
204
215
 
205
216
 
206
- def has_slot?(n)
217
+ def has_slot_helper(n, v)
218
+ return false if v.include?(self)
219
+ v << self
207
220
  return true if has_slot_locally?(n)
208
221
  return false unless has_parent_slots?
209
- return parents.any? {|p| p.has_slot?(n)}
222
+ return parents.any? {|p| p.has_slot_helper(n, v)}
210
223
  end
211
224
 
212
225
 
213
- def get(key)
226
+ def has_slot?(n)
227
+ has_slot_helper(n, Set.new)
228
+ end
229
+
230
+
231
+ def get_helper(key, v)
232
+ return nil if v.include?(self)
233
+ v << self
214
234
  return @value[key] if has_slot_locally?(key)
215
235
  parents.each do |p|
216
- value = p.get(key)
236
+ value = p.get_helper(key, v)
217
237
  return value unless value.nil?
218
238
  end
219
239
  nil
220
240
  end
221
241
 
222
242
 
243
+ def get(key)
244
+ get_helper(key, Set.new)
245
+ end
246
+
247
+
223
248
  def remove(key)
224
249
  return false unless has_slot_locally?(key)
225
250
  @value.delete(key)
@@ -228,12 +253,7 @@ module Lisp
228
253
 
229
254
 
230
255
  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
256
+ return @value[key] = value
237
257
  end
238
258
 
239
259
 
@@ -2,7 +2,7 @@ module Lisp
2
2
 
3
3
  class Function < Atom
4
4
 
5
- attr_reader :doc, :arity
5
+ attr_reader :doc, :arity, :name
6
6
 
7
7
  def compute_required_argument_count(args)
8
8
  a = args
@@ -35,12 +35,13 @@ module Lisp
35
35
 
36
36
  def internal_apply_to(parameters, env, should_eval)
37
37
  if @var_args
38
- raise "#{@name} expected at least #{@arity} parameters, received #{parameters.length}." if parameters.length < @arity
38
+ return Lisp::Debug.process_error("#{@name} expected at least #{@arity} parameters, received #{parameters.length}.", env) if parameters.length < @arity
39
39
  else
40
- raise "#{@name} expected #{@arity} parameters, received #{parameters.length}." unless parameters.length == @arity
40
+ return Lisp::Debug.process_error("#{@name} expected #{@arity} parameters, received #{parameters.length}.", env) unless parameters.length == @arity
41
41
  end
42
42
 
43
43
  local_env = EnvironmentFrame.extending(@env, env.frame)
44
+ local_env.previous = env
44
45
  self_sym = Symbol.named("self")
45
46
  if env.frame
46
47
  local_env.bind_locally(self_sym, env.frame)
data/lib/rubylisp/io.rb CHANGED
@@ -13,9 +13,9 @@ module Lisp
13
13
 
14
14
 
15
15
  def self.load_impl(args, env)
16
- raise "'load' requires 1 argument." if args.empty?
16
+ return Lisp::Debug.process_error("'load' requires 1 argument.", env) if args.empty?
17
17
  fname = args.car.evaluate(env)
18
- raise "'load' requires a string argument." unless fname.string?
18
+ return Lisp::Debug.process_error("'load' requires a string argument.", env) unless fname.string?
19
19
  filename = fname.value.end_with?(".lsp") ? fname.value : "#{fname.value}.lsp"
20
20
  File.open(filename) do |f|
21
21
  contents = f.read()
@@ -26,9 +26,9 @@ module Lisp
26
26
 
27
27
 
28
28
  def self.load_library_impl(args, env)
29
- raise "'load-library' requires 1 argument." if args.empty?
29
+ return Lisp::Debug.process_error("'load-library' requires 1 argument.", env) if args.empty?
30
30
  library_name = args.car.evaluate(env)
31
- raise "'load-library' requires a string or symbol argument." unless library_name.string? || library_name.symbol?
31
+ return Lisp::Debug.process_error("'load-library' requires a string or symbol argument.", env) unless library_name.string? || library_name.symbol?
32
32
  Dir.chdir(File.join(App.documents_path, "libraries", "#{library_name}.lib")) do |d|
33
33
  if File.exists?("load.lsp")
34
34
  File.open("load.lsp") do |f|
@@ -49,9 +49,9 @@ module Lisp
49
49
 
50
50
 
51
51
  def self.load_project_impl(args, env)
52
- raise "'load-project' requires 1 argument." if args.empty?
52
+ return Lisp::Debug.process_error("'load-project' requires 1 argument.", env) if args.empty?
53
53
  project_name = args.car.evaluate(env)
54
- raise "'load-project' requires a string or symbol argument." unless project_name.string? || project_name.symbol?
54
+ return Lisp::Debug.process_error("'load-project' requires a string or symbol argument.", env) unless project_name.string? || project_name.symbol?
55
55
  Dir.chdir(File.join(App.documents_path, "projects", "#{project_name}.prj")) do |d|
56
56
  if File.exists?("load.lsp")
57
57
  File.open("load.lsp") do |f|