rubylisp 0.2.1 → 1.0.2
Sign up to get free protection for your applications and to get access to all the features.
- checksums.yaml +4 -4
- data/README.md +129 -2
- data/bin/rubylisp +87 -12
- data/lib/rubylisp/atom.rb +25 -6
- data/lib/rubylisp/boolean.rb +9 -6
- data/lib/rubylisp/builtins.rb +19 -18
- data/lib/rubylisp/character.rb +14 -275
- data/lib/rubylisp/class_object.rb +56 -0
- data/lib/rubylisp/cons_cell.rb +56 -25
- data/lib/rubylisp/debug.rb +15 -19
- data/lib/rubylisp/environment.rb +27 -0
- data/lib/rubylisp/environment_frame.rb +31 -6
- data/lib/rubylisp/eof_object.rb +26 -0
- data/lib/rubylisp/exception.rb +61 -61
- data/lib/rubylisp/ext.rb +32 -6
- data/lib/rubylisp/ffi_new.rb +2 -1
- data/lib/rubylisp/ffi_send.rb +15 -5
- data/lib/rubylisp/frame.rb +5 -164
- data/lib/rubylisp/function.rb +4 -3
- data/lib/rubylisp/macro.rb +13 -8
- data/lib/rubylisp/{object.rb → native_object.rb} +0 -15
- data/lib/rubylisp/number.rb +5 -0
- data/lib/rubylisp/parser.rb +81 -52
- data/lib/rubylisp/port.rb +27 -0
- data/lib/rubylisp/prim_alist.rb +115 -0
- data/lib/rubylisp/prim_assignment.rb +61 -0
- data/lib/rubylisp/prim_character.rb +273 -0
- data/lib/rubylisp/{ffi_class.rb → prim_class_object.rb} +16 -69
- data/lib/rubylisp/prim_environment.rb +203 -0
- data/lib/rubylisp/prim_equivalence.rb +93 -0
- data/lib/rubylisp/prim_frame.rb +166 -0
- data/lib/rubylisp/prim_io.rb +266 -0
- data/lib/rubylisp/prim_list_support.rb +496 -0
- data/lib/rubylisp/{logical.rb → prim_logical.rb} +9 -14
- data/lib/rubylisp/prim_math.rb +397 -0
- data/lib/rubylisp/prim_native_object.rb +21 -0
- data/lib/rubylisp/prim_relational.rb +42 -0
- data/lib/rubylisp/{special_forms.rb → prim_special_forms.rb} +98 -85
- data/lib/rubylisp/prim_string.rb +792 -0
- data/lib/rubylisp/prim_system.rb +55 -0
- data/lib/rubylisp/prim_type_checks.rb +58 -0
- data/lib/rubylisp/prim_vector.rb +497 -0
- data/lib/rubylisp/primitive.rb +51 -6
- data/lib/rubylisp/string.rb +4 -803
- data/lib/rubylisp/symbol.rb +0 -1
- data/lib/rubylisp/tokenizer.rb +161 -137
- data/lib/rubylisp/vector.rb +10 -31
- data/lib/rubylisp.rb +1 -0
- metadata +46 -17
- data/lib/rubylisp/alist.rb +0 -230
- data/lib/rubylisp/assignment.rb +0 -65
- data/lib/rubylisp/equivalence.rb +0 -118
- data/lib/rubylisp/io.rb +0 -74
- data/lib/rubylisp/list_support.rb +0 -526
- data/lib/rubylisp/math.rb +0 -405
- data/lib/rubylisp/relational.rb +0 -46
- data/lib/rubylisp/system.rb +0 -20
- data/lib/rubylisp/testing.rb +0 -136
- data/lib/rubylisp/type_checks.rb +0 -60
@@ -2,31 +2,50 @@ module Lisp
|
|
2
2
|
|
3
3
|
class EnvironmentFrame
|
4
4
|
|
5
|
-
attr_accessor :frame, :current_code, :previous
|
5
|
+
attr_accessor :frame, :current_code, :previous, :name
|
6
|
+
attr_reader :parent, :project_environment
|
6
7
|
|
7
8
|
def self.global
|
8
|
-
@@global_frame ||= EnvironmentFrame.new(nil)
|
9
|
+
@@global_frame ||= EnvironmentFrame.new(nil, "GLOBAL")
|
9
10
|
@@global_frame
|
10
11
|
end
|
11
12
|
|
12
|
-
def self.extending(parent, f=nil)
|
13
|
+
def self.extending(parent, name, f=nil)
|
13
14
|
f ||= parent.frame if parent && parent.has_frame?
|
14
|
-
self.new(parent, f)
|
15
|
+
e = self.new(parent, name, f)
|
16
|
+
TopLevelEnvironments[name] = e if parent.nil? || parent == self.global
|
17
|
+
e
|
15
18
|
end
|
16
19
|
|
17
|
-
def initialize(parent, f=nil)
|
20
|
+
def initialize(parent, name, f=nil)
|
18
21
|
@bindings = []
|
19
22
|
@parent = parent
|
23
|
+
@name = name
|
20
24
|
@frame = f
|
21
25
|
@current_code = []
|
22
26
|
end
|
23
27
|
|
28
|
+
|
29
|
+
def clear
|
30
|
+
TopLevelEnvironments[@name] = nil if TopLevelEnvironments.has_key?(@name)
|
31
|
+
@bindings.each {|b| b.value = nil}
|
32
|
+
end
|
33
|
+
|
34
|
+
|
24
35
|
def has_frame?
|
25
36
|
!@frame.nil?
|
26
37
|
end
|
27
38
|
|
28
39
|
# Bindings following parent env frame pointer
|
29
40
|
|
41
|
+
def bound_names
|
42
|
+
@bindings.map {|b| b.symbol}
|
43
|
+
end
|
44
|
+
|
45
|
+
def bound_values
|
46
|
+
@bindings.map {|b| b.value}
|
47
|
+
end
|
48
|
+
|
30
49
|
def is_name_bound?(str)
|
31
50
|
if !@frame && @frame.has_slot?(Lisp:Symbol.named("#{str}:", true))
|
32
51
|
return true
|
@@ -38,6 +57,11 @@ module Lisp
|
|
38
57
|
return @parent.is_name_bound?(str)
|
39
58
|
end
|
40
59
|
|
60
|
+
def name_bound_locally?(str)
|
61
|
+
binding = @bindings.detect {|b| b.symbol.name == str}
|
62
|
+
!binding.nil?
|
63
|
+
end
|
64
|
+
|
41
65
|
def binding_for(symbol)
|
42
66
|
binding = @bindings.detect {|b| b.symbol.name == symbol.name}
|
43
67
|
return binding unless binding.nil?
|
@@ -152,8 +176,9 @@ module Lisp
|
|
152
176
|
1 + @previous.depth
|
153
177
|
end
|
154
178
|
end
|
155
|
-
|
179
|
+
|
156
180
|
end
|
157
181
|
|
182
|
+
TopLevelEnvironments = {}
|
158
183
|
|
159
184
|
end
|
@@ -0,0 +1,26 @@
|
|
1
|
+
module Lisp
|
2
|
+
|
3
|
+
class EofObject < Atom
|
4
|
+
|
5
|
+
def self.instance
|
6
|
+
@instance ||= self.new()
|
7
|
+
end
|
8
|
+
|
9
|
+
def initialize()
|
10
|
+
end
|
11
|
+
|
12
|
+
def type
|
13
|
+
:eof_object
|
14
|
+
end
|
15
|
+
|
16
|
+
def eof_object?
|
17
|
+
true
|
18
|
+
end
|
19
|
+
|
20
|
+
def to_s
|
21
|
+
"<EOF>"
|
22
|
+
end
|
23
|
+
|
24
|
+
end
|
25
|
+
|
26
|
+
end
|
data/lib/rubylisp/exception.rb
CHANGED
@@ -3,81 +3,81 @@ module Lisp
|
|
3
3
|
class Exception
|
4
4
|
|
5
5
|
def self.register
|
6
|
-
Primitive.register("raise") {|args, env| Lisp::Exception::raise_impl(args, env) }
|
7
|
-
Primitive.register("reraise") {|args, env| Lisp::Exception::reraise_impl(args, env) }
|
8
|
-
Primitive.register("try") {|args, env| Lisp::Exception::try_impl(args, env) }
|
9
|
-
Primitive.register("reraise") {|args, env| Lisp::Exception::reraise_impl(args, env) }
|
10
|
-
Primitive.register("resume") {|args, env| Lisp::Exception::resume_impl(args, env) }
|
11
|
-
Primitive.register("restart") {|args, env| Lisp::Exception::restart_impl(args, env) }
|
6
|
+
# Primitive.register("raise") {|args, env| Lisp::Exception::raise_impl(args, env) }
|
7
|
+
# Primitive.register("reraise") {|args, env| Lisp::Exception::reraise_impl(args, env) }
|
8
|
+
# Primitive.register("try") {|args, env| Lisp::Exception::try_impl(args, env) }
|
9
|
+
# Primitive.register("reraise") {|args, env| Lisp::Exception::reraise_impl(args, env) }
|
10
|
+
# Primitive.register("resume") {|args, env| Lisp::Exception::resume_impl(args, env) }
|
11
|
+
# Primitive.register("restart") {|args, env| Lisp::Exception::restart_impl(args, env) }
|
12
12
|
end
|
13
13
|
|
14
14
|
|
15
|
-
def handler_or_nil(handlers, exception_name)
|
16
|
-
|
17
|
-
|
18
|
-
|
19
|
-
|
20
|
-
|
21
|
-
|
22
|
-
|
23
|
-
|
24
|
-
end
|
25
|
-
|
26
|
-
def self.do_exception(name, with_message, args, env)
|
27
|
-
|
28
|
-
|
29
|
-
|
30
|
-
|
31
|
-
|
32
|
-
|
33
|
-
|
34
|
-
|
35
|
-
|
36
|
-
|
37
|
-
|
38
|
-
|
39
|
-
|
40
|
-
|
41
|
-
|
42
|
-
|
43
|
-
end
|
15
|
+
# def handler_or_nil(handlers, exception_name)
|
16
|
+
# handlers.each do |handler_pair|
|
17
|
+
# exceptions = handler_pair.car
|
18
|
+
# if exceptions.eq(exception_name) || (exceptions.pair? && exceptions.include?(exception_name))
|
19
|
+
# handler_pair.cdr
|
20
|
+
# else
|
21
|
+
# nil
|
22
|
+
# end
|
23
|
+
# end
|
24
|
+
# end
|
25
|
+
|
26
|
+
# def self.do_exception(name, with_message, args, env)
|
27
|
+
# frame = env
|
28
|
+
# while !frame.nil?
|
29
|
+
# handlers = frame.value_of(Symbol.named("__handlers__"))
|
30
|
+
# unless handlers.nil?
|
31
|
+
# handler = handler_or_nil(handlers, for: name)
|
32
|
+
# unless handler.nil?
|
33
|
+
# handler.apply_to_without_evaluating(args, frame)
|
34
|
+
# break
|
35
|
+
# end
|
36
|
+
# end
|
37
|
+
# frame = frame.parent
|
38
|
+
# if frame.nil?
|
39
|
+
# exception_message = message.empty? ? "" : ": #{message}"
|
40
|
+
# return Lisp::Debug.process_error("Unhandled Exception: #{exception_name}#{exception_message}", env)
|
41
|
+
# end
|
42
|
+
# end
|
43
|
+
# end
|
44
44
|
|
45
45
|
def self.raise_impl(args, env)
|
46
|
-
return Lisp::Debug.process_error("'raise' requires at least one argument.", env) unless args.length > 0
|
47
|
-
exception_name = args.car.evaluate(env)
|
48
|
-
return Lisp::Debug.process_error("'raise' requires an exception name as it's first argument.", env) unless exception_name.string? || class_name.symbol?
|
46
|
+
# return Lisp::Debug.process_error("'raise' requires at least one argument.", env) unless args.length > 0
|
47
|
+
# exception_name = args.car.evaluate(env)
|
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
|
-
message = ""
|
51
|
-
if args.length > 1
|
52
|
-
|
53
|
-
|
54
|
-
end
|
50
|
+
# message = ""
|
51
|
+
# if args.length > 1
|
52
|
+
# message = args.cadr.evaluate(env)
|
53
|
+
# return Lisp::Debug.process_error("The message parameter to 'raise' must be a string.", env) unless message.string?
|
54
|
+
# end
|
55
55
|
|
56
|
-
handler_args = args.length > 2 ? Lisp::ConsCell.array_to_list(args.cdr.to_a.collect {|a| a.evaluate(env)}) : Lisp::ConsCell.new
|
56
|
+
# handler_args = args.length > 2 ? Lisp::ConsCell.array_to_list(args.cdr.to_a.collect {|a| a.evaluate(env)}) : Lisp::ConsCell.new
|
57
57
|
end
|
58
58
|
|
59
59
|
|
60
60
|
def self.try_impl(args, env)
|
61
|
-
raw_handlers = args.car
|
62
|
-
body = args.cdr
|
61
|
+
# raw_handlers = args.car
|
62
|
+
# body = args.cdr
|
63
63
|
|
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
|
-
|
68
|
-
|
69
|
-
end
|
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
|
+
# ex = h.car
|
68
|
+
# ex.symbol? || ex.string? || (ex.list? && ex.all? {|h2| h2.symbol? || h2.string?})
|
69
|
+
# end
|
70
70
|
|
71
|
-
array_of_handlers = raw_handlers.to_a.collect do |h|
|
72
|
-
|
73
|
-
|
74
|
-
return Lisp::Debug.process_error("Exception handler has to be a function.", env) unless f.function?
|
75
|
-
|
76
|
-
end
|
77
|
-
handlers = Lisp::ConsCell.array_to_list(array_of_handlers)
|
78
|
-
env.bind_locally(Symbol.named("__handlers__"), handlers)
|
71
|
+
# array_of_handlers = raw_handlers.to_a.collect do |h|
|
72
|
+
# ex = h.car
|
73
|
+
# f = h.cadr.evaluate(env)
|
74
|
+
# return Lisp::Debug.process_error("Exception handler has to be a function.", env) unless f.function?
|
75
|
+
# Lisp::ConsCell.cons(ex, f)
|
76
|
+
# end
|
77
|
+
# handlers = Lisp::ConsCell.array_to_list(array_of_handlers)
|
78
|
+
# env.bind_locally(Symbol.named("__handlers__"), handlers)
|
79
79
|
|
80
|
-
body.evaluate_each(env)
|
80
|
+
# body.evaluate_each(env)
|
81
81
|
end
|
82
82
|
|
83
83
|
|
data/lib/rubylisp/ext.rb
CHANGED
@@ -5,15 +5,29 @@ class NilClass
|
|
5
5
|
end
|
6
6
|
|
7
7
|
def false?
|
8
|
-
|
8
|
+
false
|
9
9
|
end
|
10
10
|
|
11
11
|
def to_s
|
12
12
|
"()"
|
13
13
|
end
|
14
14
|
|
15
|
+
|
16
|
+
def to_ary
|
17
|
+
[]
|
18
|
+
end
|
19
|
+
|
20
|
+
|
21
|
+
def eqv?(other)
|
22
|
+
other.nil? || (other.pair? && other.empty?)
|
23
|
+
end
|
24
|
+
|
15
25
|
def eq?(other)
|
16
|
-
other.nil?
|
26
|
+
other.nil? || (other.pair? && other.empty?)
|
27
|
+
end
|
28
|
+
|
29
|
+
def equal?(other)
|
30
|
+
other.nil? || (other.pair? && other.empty?)
|
17
31
|
end
|
18
32
|
|
19
33
|
def print_string
|
@@ -84,14 +98,25 @@ class NilClass
|
|
84
98
|
true
|
85
99
|
end
|
86
100
|
|
101
|
+
def vector?
|
102
|
+
false
|
103
|
+
end
|
104
|
+
|
105
|
+
def environment?
|
106
|
+
false
|
107
|
+
end
|
108
|
+
|
87
109
|
def method_missing(name, *args, &block)
|
88
|
-
|
110
|
+
is_list_walk = name[0] == ?c && name[-1] == ?r && (name[1..-2].chars.all? {|e| "ad".include?(e)})
|
111
|
+
if is_list_walk
|
89
112
|
nil
|
90
113
|
else
|
114
|
+
#puts "nil#method_missing name: #{name} args #{args}"
|
115
|
+
#puts caller
|
91
116
|
super
|
92
117
|
end
|
93
118
|
end
|
94
|
-
|
119
|
+
|
95
120
|
def primitive?
|
96
121
|
false
|
97
122
|
end
|
@@ -112,8 +137,9 @@ class NilClass
|
|
112
137
|
true
|
113
138
|
end
|
114
139
|
|
115
|
-
|
116
|
-
|
140
|
+
def flatten
|
141
|
+
nil
|
142
|
+
end
|
117
143
|
end
|
118
144
|
|
119
145
|
|
data/lib/rubylisp/ffi_new.rb
CHANGED
@@ -4,14 +4,15 @@ module Lisp
|
|
4
4
|
|
5
5
|
def initialize(name)
|
6
6
|
@value = name
|
7
|
-
@klass = Object.const_get(name)
|
8
7
|
end
|
9
8
|
|
10
9
|
def apply_to(args, env)
|
10
|
+
@klass = Object.const_get(@value)
|
11
11
|
NativeObject.with_value(@klass.new)
|
12
12
|
end
|
13
13
|
|
14
14
|
def apply_to_without_evaluating(args, env)
|
15
|
+
@klass = Object.const_get(@value)
|
15
16
|
NativeObject.with_value(@klass.new)
|
16
17
|
end
|
17
18
|
|
data/lib/rubylisp/ffi_send.rb
CHANGED
@@ -10,7 +10,9 @@ module Lisp
|
|
10
10
|
apply_to_without_evaluating(Lisp::ConsCell.array_to_list(args.to_a.map {|a| a.evaluate(env)}), env)
|
11
11
|
end
|
12
12
|
|
13
|
+
# convert a rubymotion arg to a lisp arg
|
13
14
|
def convert_value(value)
|
15
|
+
#puts "convert_value(#{value.to_s})\n"
|
14
16
|
case value.class.name
|
15
17
|
when "Fixnum", "Float"
|
16
18
|
Lisp::Number.with_value(value)
|
@@ -30,11 +32,17 @@ module Lisp
|
|
30
32
|
end
|
31
33
|
|
32
34
|
|
35
|
+
# convert a lisp arg to a rubymotion arg
|
33
36
|
def process_arg(a, env)
|
37
|
+
#puts "process_arg(#{a.to_s})"
|
34
38
|
if a.function?
|
35
|
-
|
36
|
-
|
37
|
-
|
39
|
+
#puts "function arg"
|
40
|
+
proc do #|*args|
|
41
|
+
#puts "Proc argument invoked"
|
42
|
+
# arg_list = args.empty? ? nil : Lisp::ConsCell.array_to_list(args.collect {|arg| convert_value(arg) })
|
43
|
+
# puts "Applying #{@a.to_s} to #{arg_list}"
|
44
|
+
|
45
|
+
a.apply_to(nil, env)
|
38
46
|
end
|
39
47
|
elsif a.list?
|
40
48
|
a.to_a.map {|i| process_arg(i, env)}
|
@@ -49,6 +57,8 @@ module Lisp
|
|
49
57
|
return Lisp::Debug.process_error("Send target of '#{@value}' evaluated to nil.", env) if target.nil?
|
50
58
|
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
59
|
|
60
|
+
# puts "Sending #{@value} to #{target.to_s} with raw args #{args}"
|
61
|
+
|
52
62
|
arguments = args.cdr.nil? ? [] : args.cdr.to_a.map {|a| process_arg(a, env)}
|
53
63
|
result = nil
|
54
64
|
|
@@ -56,11 +66,11 @@ module Lisp
|
|
56
66
|
result = if arguments[-1].instance_of?(Proc)
|
57
67
|
target.value.send(@value, *(arguments[0..-2]), &arguments[-1])
|
58
68
|
else
|
59
|
-
#
|
69
|
+
# puts "Sending #{@value} to #{target} with processed args #{arguments}"
|
60
70
|
target.value.send(@value, *arguments)
|
61
71
|
end
|
62
72
|
rescue Exception => e
|
63
|
-
return Lisp::Debug.process_error("Exception sending #{@value}
|
73
|
+
return Lisp::Debug.process_error("Exception sending #{@value} - #{e.name}", env)
|
64
74
|
end
|
65
75
|
|
66
76
|
convert_value(result)
|
data/lib/rubylisp/frame.rb
CHANGED
@@ -2,172 +2,13 @@ module Lisp
|
|
2
2
|
|
3
3
|
class Frame < Atom
|
4
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
|
-
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
|
-
|
46
|
-
end
|
47
|
-
|
48
|
-
|
49
|
-
def self.make_frame_impl(args, env)
|
50
|
-
c = args
|
51
|
-
m = {}
|
52
|
-
while !c.nil?
|
53
|
-
k = c.car
|
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?
|
56
|
-
v = c.cadr.evaluate(env)
|
57
|
-
m[k] = v
|
58
|
-
c = c.cddr
|
59
|
-
end
|
60
|
-
|
61
|
-
Lisp::Frame.with_map(m)
|
62
|
-
end
|
63
|
-
|
64
|
-
|
65
|
-
def self.has_slot_impl(args, env)
|
66
|
-
frame = args.car.evaluate(env)
|
67
|
-
return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
|
68
|
-
key = args.cadr.evaluate(env)
|
69
|
-
return Lisp::Debug.process_error("Frame key must be a symbol but was #{key.type}.", env) unless key.symbol?
|
70
|
-
return Lisp::TRUE if frame.has_slot?(key)
|
71
|
-
Lisp::FALSE
|
72
|
-
end
|
73
|
-
|
74
|
-
|
75
|
-
def self.get_slot_impl(args, env)
|
76
|
-
frame = args.car.evaluate(env)
|
77
|
-
return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
|
78
|
-
key = args.cadr.evaluate(env)
|
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)
|
81
|
-
frame.get(key)
|
82
|
-
end
|
83
|
-
|
84
|
-
|
85
|
-
def self.get_slot_if_impl(args, env)
|
86
|
-
frame = args.car.evaluate(env)
|
87
|
-
return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
|
88
|
-
key = args.cadr.evaluate(env)
|
89
|
-
return Lisp::Debug.process_error("Frame key (#{key.to_s}) must be a symbol but was #{key.type}.", env) unless key.symbol?
|
90
|
-
frame.get(key)
|
91
|
-
end
|
92
|
-
|
93
|
-
|
94
|
-
def self.remove_slot_impl(args, env)
|
95
|
-
frame = args.car.evaluate(env)
|
96
|
-
return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
|
97
|
-
key = args.cadr.evaluate(env)
|
98
|
-
return Lisp::Debug.process_error("Frame key (#{key.to_s}) must be a symbol but was #{key.type}.", env) unless key.symbol?
|
99
|
-
return Lisp::TRUE if frame.remove(key)
|
100
|
-
Lisp::FALSE
|
101
|
-
end
|
102
|
-
|
103
|
-
|
104
|
-
def self.set_slot_impl(args, env)
|
105
|
-
frame = args.car.evaluate(env)
|
106
|
-
return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
|
107
|
-
key = args.cadr.evaluate(env)
|
108
|
-
return Lisp::Debug.process_error("Frame key (#{key.to_s}) must be a symbol but was #{key.type}.", env) unless key.symbol?
|
109
|
-
value = args.caddr.evaluate(env)
|
110
|
-
frame.at_put(key, value)
|
111
|
-
end
|
112
|
-
|
113
|
-
|
114
|
-
def self.send_impl(args, env)
|
115
|
-
frame = args.car.evaluate(env)
|
116
|
-
return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
|
117
|
-
selector = args.cadr.evaluate(env)
|
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)
|
120
|
-
func = frame.get(selector)
|
121
|
-
return Lisp::Debug.process_error("Message sent must select a function slot but was #{func.type}.", env) unless func.function?
|
122
|
-
params = args.cddr
|
123
|
-
frame_env = Lisp::EnvironmentFrame.extending(env, frame)
|
124
|
-
frame_env.bind_locally(Symbol.named("self"), frame)
|
125
|
-
func.apply_to(params, frame_env)
|
126
|
-
end
|
127
|
-
|
128
|
-
def self.get_super_function(selector, env)
|
129
|
-
f = env.frame
|
130
|
-
return nil if f.nil?
|
131
|
-
f.parents.each do |p|
|
132
|
-
func = p.get(selector)
|
133
|
-
return func unless func.nil?
|
134
|
-
end
|
135
|
-
nil
|
136
|
-
end
|
137
|
-
|
138
|
-
def self.send_super_impl(args, env)
|
139
|
-
return Lisp::Debug.process_error("super can only be used within the context of a frame.", env) unless env.frame
|
140
|
-
selector = args.car.evaluate(env)
|
141
|
-
return Lisp::Debug.process_error("Selector must be a symbol but was #{selector.type}.", env) unless selector.symbol?
|
142
|
-
func = get_super_function(selector, env)
|
143
|
-
return Lisp::Debug.process_error("Message sent must select a function slot but was #{func.type}.", env) unless func && func.function?
|
144
|
-
params = args.cdr
|
145
|
-
frame_env = Lisp::EnvironmentFrame.extending(env, env.frame)
|
146
|
-
frame_env.bind_locally(Symbol.named("self"), env.frame)
|
147
|
-
func.apply_to(params, frame_env)
|
148
|
-
end
|
149
|
-
|
150
|
-
|
151
|
-
def self.clone_impl(args, env)
|
152
|
-
frame = args.car.evaluate(env)
|
153
|
-
return Lisp::Debug.process_error("Frame data must be a frame but was #{frame.type}.", env) unless frame.frame?
|
154
|
-
frame.clone
|
155
|
-
end
|
156
|
-
|
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
|
-
|
165
5
|
def self.with_map(m)
|
166
6
|
self.new(m)
|
167
7
|
end
|
168
8
|
|
169
|
-
def initialize(m=
|
170
|
-
@value = m
|
9
|
+
def initialize(m = {})
|
10
|
+
@value = m
|
11
|
+
self
|
171
12
|
end
|
172
13
|
|
173
14
|
|
@@ -285,11 +126,11 @@ module Lisp
|
|
285
126
|
nil
|
286
127
|
end
|
287
128
|
|
288
|
-
def
|
129
|
+
def equal?(other)
|
289
130
|
return false unless other.frame?
|
290
131
|
return false unless @value.length == other.value.length
|
291
132
|
@value.each do |k, v|
|
292
|
-
return false unless
|
133
|
+
return false unless other.value[k].equal?(v)
|
293
134
|
end
|
294
135
|
true
|
295
136
|
end
|
data/lib/rubylisp/function.rb
CHANGED
@@ -2,7 +2,7 @@ module Lisp
|
|
2
2
|
|
3
3
|
class Function < Atom
|
4
4
|
|
5
|
-
attr_reader :doc, :arity, :name
|
5
|
+
attr_reader :doc, :arity, :name, :env, :body
|
6
6
|
|
7
7
|
def compute_required_argument_count(args)
|
8
8
|
a = args
|
@@ -37,10 +37,11 @@ module Lisp
|
|
37
37
|
if @var_args
|
38
38
|
return Lisp::Debug.process_error("#{@name} expected at least #{@arity} parameters, received #{parameters.length}.", env) if parameters.length < @arity
|
39
39
|
else
|
40
|
+
puts "#{@name} #{@arguments.print_string} #{@body.print_string}" unless parameters.length == @arity
|
41
|
+
puts caller unless parameters.length == @arity
|
40
42
|
return Lisp::Debug.process_error("#{@name} expected #{@arity} parameters, received #{parameters.length}.", env) unless parameters.length == @arity
|
41
43
|
end
|
42
|
-
|
43
|
-
local_env = EnvironmentFrame.extending(@env, env.frame)
|
44
|
+
local_env = EnvironmentFrame.extending(@env, @name, env.frame)
|
44
45
|
local_env.previous = env
|
45
46
|
self_sym = Symbol.named("self")
|
46
47
|
if env.frame
|
data/lib/rubylisp/macro.rb
CHANGED
@@ -2,7 +2,7 @@ module Lisp
|
|
2
2
|
|
3
3
|
class Macro < Atom
|
4
4
|
|
5
|
-
attr_reader :doc
|
5
|
+
attr_reader :name, :doc, :body
|
6
6
|
|
7
7
|
def compute_required_argument_count(args)
|
8
8
|
a = args
|
@@ -20,6 +20,7 @@ module Lisp
|
|
20
20
|
end
|
21
21
|
|
22
22
|
def initialize(name, arguments, doc, body, env)
|
23
|
+
#puts "Macro#initialize #{name} #{arguments.to_a}"
|
23
24
|
sig = ([name] << arguments.to_a).flatten
|
24
25
|
@doc = "(#{(sig.collect {|e| e.to_s}).join(" ")})"
|
25
26
|
@name = name
|
@@ -33,14 +34,12 @@ module Lisp
|
|
33
34
|
|
34
35
|
def expand(parameters, env, should_eval)
|
35
36
|
if @var_args
|
36
|
-
return Lisp::Debug.process_error("#{@name} expected at least
|
37
|
-
##{@required_argument_count} parameters, received #{parameters.length}.", env) if parameters.length < @required_argument_count
|
37
|
+
return Lisp::Debug.process_error("#{@name} expected at least #{@required_argument_count} parameters, received #{parameters.length}.", env) if parameters.length < @required_argument_count
|
38
38
|
else
|
39
|
-
return Lisp::Debug.process_error("#{@name} expected
|
40
|
-
##{@required_argument_count} parameters, received #{parameters.length}.", env) unless parameters.length == @required_argument_count
|
39
|
+
return Lisp::Debug.process_error("#{@name} expected #{@required_argument_count} parameters, received #{parameters.length}.", env) unless parameters.length == @required_argument_count
|
41
40
|
end
|
42
41
|
|
43
|
-
local_env = EnvironmentFrame.extending(@env, env.frame)
|
42
|
+
local_env = EnvironmentFrame.extending(@env, @name, env.frame)
|
44
43
|
self_sym = Symbol.named("self")
|
45
44
|
if env.frame
|
46
45
|
local_env.bind_locally(self_sym, env.frame)
|
@@ -63,8 +62,14 @@ module Lisp
|
|
63
62
|
accumulating_arg = arg if arg.symbol?
|
64
63
|
end
|
65
64
|
local_env.bind_locally(accumulating_arg, Lisp::ConsCell.array_to_list(accumulated_params)) if accumulating_arg
|
65
|
+
|
66
|
+
#puts "expanding #{@name}"
|
67
|
+
#puts " #{@body.print_string}"
|
66
68
|
|
67
|
-
@body.evaluate(local_env)
|
69
|
+
result = @body.evaluate(local_env)
|
70
|
+
|
71
|
+
#puts " #{result.print_string}"
|
72
|
+
result
|
68
73
|
end
|
69
74
|
|
70
75
|
def internal_apply_to(parameters, env, should_eval)
|
@@ -91,7 +96,7 @@ module Lisp
|
|
91
96
|
def type
|
92
97
|
:macro
|
93
98
|
end
|
94
|
-
|
99
|
+
|
95
100
|
end
|
96
101
|
|
97
102
|
end
|