rubymotionlisp 0.2.2 → 1.0.0

Sign up to get free protection for your applications and to get access to all the features.
Files changed (60) hide show
  1. checksums.yaml +4 -4
  2. data/README.md +129 -2
  3. data/lib/rubylisp/atom.rb +25 -6
  4. data/lib/rubylisp/boolean.rb +9 -6
  5. data/lib/rubylisp/builtins.rb +33 -0
  6. data/lib/rubylisp/character.rb +14 -275
  7. data/lib/rubylisp/class_object.rb +56 -0
  8. data/lib/rubylisp/cons_cell.rb +50 -20
  9. data/lib/rubylisp/environment.rb +27 -0
  10. data/lib/rubylisp/environment_frame.rb +24 -6
  11. data/lib/rubylisp/eof_object.rb +26 -0
  12. data/lib/rubylisp/exception.rb +61 -61
  13. data/lib/rubylisp/ext.rb +32 -6
  14. data/lib/rubylisp/ffi_new.rb +2 -1
  15. data/lib/rubylisp/ffi_send.rb +15 -5
  16. data/lib/rubylisp/frame.rb +5 -164
  17. data/lib/rubylisp/function.rb +4 -3
  18. data/lib/rubylisp/macro.rb +13 -8
  19. data/lib/rubylisp/{object.rb → native_object.rb} +0 -15
  20. data/lib/rubylisp/number.rb +5 -0
  21. data/lib/rubylisp/parser.rb +81 -52
  22. data/lib/rubylisp/port.rb +27 -0
  23. data/lib/rubylisp/prim_alist.rb +115 -0
  24. data/lib/rubylisp/prim_assignment.rb +61 -0
  25. data/lib/rubylisp/prim_character.rb +273 -0
  26. data/lib/rubylisp/{ffi_class.rb → prim_class_object.rb} +16 -69
  27. data/lib/rubylisp/prim_environment.rb +203 -0
  28. data/lib/rubylisp/prim_equivalence.rb +93 -0
  29. data/lib/rubylisp/prim_frame.rb +166 -0
  30. data/lib/rubylisp/prim_io.rb +266 -0
  31. data/lib/rubylisp/prim_list_support.rb +496 -0
  32. data/lib/rubylisp/{logical.rb → prim_logical.rb} +9 -14
  33. data/lib/rubylisp/prim_math.rb +397 -0
  34. data/lib/rubylisp/prim_native_object.rb +21 -0
  35. data/lib/rubylisp/prim_relational.rb +42 -0
  36. data/lib/rubylisp/{special_forms.rb → prim_special_forms.rb} +97 -84
  37. data/lib/rubylisp/prim_string.rb +792 -0
  38. data/lib/rubylisp/prim_system.rb +55 -0
  39. data/lib/rubylisp/prim_type_checks.rb +58 -0
  40. data/lib/rubylisp/prim_vector.rb +497 -0
  41. data/lib/rubylisp/primitive.rb +51 -6
  42. data/lib/rubylisp/string.rb +4 -803
  43. data/lib/rubylisp/symbol.rb +0 -1
  44. data/lib/rubylisp/tokenizer.rb +160 -136
  45. data/lib/rubylisp/vector.rb +10 -31
  46. data/lib/rubymotion/debug.rb +40 -0
  47. data/lib/rubymotion/require-fix.rb +1 -0
  48. data/lib/rubymotionlisp.rb +4 -0
  49. metadata +28 -17
  50. data/lib/rubylisp/alist.rb +0 -230
  51. data/lib/rubylisp/assignment.rb +0 -65
  52. data/lib/rubylisp/equivalence.rb +0 -118
  53. data/lib/rubylisp/io.rb +0 -74
  54. data/lib/rubylisp/list_support.rb +0 -526
  55. data/lib/rubylisp/math.rb +0 -405
  56. data/lib/rubylisp/motion_builtins.rb +0 -31
  57. data/lib/rubylisp/relational.rb +0 -46
  58. data/lib/rubylisp/system.rb +0 -20
  59. data/lib/rubylisp/testing.rb +0 -136
  60. data/lib/rubylisp/type_checks.rb +0 -60
@@ -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=nil)
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 eq?(other)
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 Lisp::Equivalence.equal_check(other.value[k], v).value
133
+ return false unless other.value[k].equal?(v)
293
134
  end
294
135
  true
295
136
  end
@@ -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
@@ -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
@@ -1,21 +1,6 @@
1
1
  module Lisp
2
2
 
3
3
  class NativeObject < Atom
4
-
5
- def self.register
6
- Primitive.register("wrap-object") {|args, env| Lisp::NativeObject::wrap_impl(args, env) }
7
- end
8
-
9
- def self.wrap_impl(args, env)
10
- return Lisp::Debug.process_error("wrap-object requires 1 argument", env) unless args.length == 1
11
- raw_val = args.car.evaluate(env)
12
- val = if raw_val.list?
13
- raw_val.to_a
14
- else
15
- raw_val
16
- end
17
- NativeObject.with_value(val)
18
- end
19
4
 
20
5
  def self.new_instance_of(c)
21
6
  self.new(c.alloc.init)
@@ -42,6 +42,11 @@ module Lisp
42
42
  @value < 0
43
43
  end
44
44
 
45
+ def eqv?(sexpr)
46
+ return false unless sexpr.number?
47
+ @value == sexpr.value
48
+ end
49
+
45
50
  def type
46
51
  :number
47
52
  end
@@ -10,7 +10,7 @@ module Lisp
10
10
  end
11
11
 
12
12
  def make_hex_number(str)
13
- Lisp::Number.with_value(str.gsub("#x", "0x").to_i(0))
13
+ Lisp::Number.with_value(["0x", str].join.to_i(0))
14
14
  end
15
15
 
16
16
  def make_float(str)
@@ -18,7 +18,7 @@ module Lisp
18
18
  end
19
19
 
20
20
  def make_string(str)
21
- Lisp::String.with_value(str[1...-1])
21
+ Lisp::String.with_value(str)
22
22
  end
23
23
 
24
24
  def make_symbol(str)
@@ -33,7 +33,7 @@ module Lisp
33
33
  tok, lit = tokens.next_token
34
34
  if tok == :RPAREN
35
35
  tokens.consume_token
36
- return nil
36
+ return Lisp::ConsCell.cons()
37
37
  end
38
38
 
39
39
  car = nil
@@ -45,67 +45,85 @@ module Lisp
45
45
  cdr = self.parse_sexpr(tokens)
46
46
  return nil if tokens.next_token[0] == :EOF
47
47
  tok, lit = tokens.next_token
48
- return Lisp::Debug.process_error("Expected ')' to follow a dotted tail on line #{tokens.line_number}", env) if tok != :RPAREN
48
+ return Lisp::Debug.process_error("Expected ')' to follow a dotted tail on line #{tokens.line_number}", Lisp::EnvironmentFrame.global) if tok != :RPAREN
49
49
  tokens.consume_token
50
50
  return Lisp::ConsCell.array_to_list(cells, cdr)
51
51
  else
52
52
  car = self.parse_sexpr(tokens)
53
- return Lisp::Debug.process_error("Unexpected EOF (expected ')') on line #{tokens.line_number}", env) if tokens.next_token[0] == :EOF
53
+ return Lisp::Debug.process_error("Unexpected EOF (expected ')') on line #{tokens.line_number}", Lisp::EnvironmentFrame.global) if tokens.next_token[0] == :EOF
54
54
  cells << car
55
55
  end
56
56
  tok, lit = tokens.next_token
57
57
  end
58
58
 
59
59
  tokens.consume_token
60
- return Lisp::ConsCell.array_to_list(cells)
60
+ Lisp::ConsCell.array_to_list(cells)
61
61
  end
62
62
 
63
- def parse_map(tokens)
63
+ def parse_frame(tokens, literal)
64
64
  m = {}
65
65
  tok, lit = tokens.next_token
66
66
  if tok == :RBRACE
67
67
  tokens.consume_token
68
- return ConsCell.cons(Symbol.named("make-frame"), nil)
69
- end
70
-
71
- cells = []
72
- while tok != :RBRACE
73
- item = self.parse_sexpr(tokens)
74
- return Lisp::Debug.process_error("Unexpected EOF (expected '}') on line #{tokens.line_number}", env) if tokens.next_token[0] == :EOF
75
- cells << item
76
- tok, lit = tokens.next_token
68
+ if literal
69
+ Lisp::Frame.new
70
+ else
71
+ Lisp::ConsCell.cons(Lisp::Symbol.named("make-frame"), nil)
72
+ end
73
+ else
74
+ cells = []
75
+ while tok != :RBRACE
76
+ item = self.parse_sexpr(tokens)
77
+ return Lisp::Debug.process_error("Unexpected EOF (expected '}') on line #{tokens.line_number}", env) if tokens.next_token[0] == :EOF
78
+ cells << item
79
+ tok, lit = tokens.next_token
80
+ end
81
+
82
+ tokens.consume_token
83
+ keys_and_values = Lisp::ConsCell.array_to_list(cells)
84
+ if literal
85
+ Lisp::PrimFrame.make_frame_impl(keys_and_values, Lisp::EnvironmentFrame.global)
86
+ else
87
+ Lisp::ConsCell.cons(Lisp::Symbol.named("make-frame"), keys_and_values)
88
+ end
77
89
  end
78
-
79
- tokens.consume_token
80
- return ConsCell.cons(Symbol.named("make-frame"), ConsCell.array_to_list(cells))
81
90
  end
82
91
 
83
92
 
84
- def parse_vector(tokens)
93
+ def parse_vector(tokens, literal)
85
94
  v = []
86
95
  tok, lit = tokens.next_token
87
- if tok == :RBRACKET
96
+ if tok == :RPAREN
88
97
  tokens.consume_token
89
- return ConsCell.cons(Symbol.named("make-vector"), nil)
90
- end
91
-
92
- cells = []
93
- while tok != :RBRACKET
94
- item = self.parse_sexpr(tokens)
95
- return Lisp::Debug.process_error("Unexpected EOF (expected ']') on line #{tokens.line_number}", env) if tokens.next_token[0] == :EOF
96
- cells << item
97
- tok, lit = tokens.next_token
98
+ if literal
99
+ Lisp::Vector.new
100
+ else
101
+ Lisp::ConsCell.cons(Lis::Symbol.named("vector"), nil)
102
+ end
103
+ else
104
+ cells = []
105
+ while tok != :RPAREN
106
+ item = self.parse_sexpr(tokens)
107
+ return Lisp::Debug.process_error("Unexpected EOF (expected ')') on line #{tokens.line_number}", env) if tokens.next_token[0] == :EOF
108
+ cells << item
109
+ tok, lit = tokens.next_token
110
+ end
111
+
112
+ tokens.consume_token
113
+
114
+ if literal
115
+ Lisp::Vector.with_array(cells)
116
+ else
117
+ Lisp::ConsCell.cons(Lisp::Symbol.named("vector"), Lisp::ConsCell.array_to_list(cells))
118
+ end
98
119
  end
99
-
100
- tokens.consume_token
101
- return ConsCell.cons(Symbol.named("make-vector"), ConsCell.array_to_list(cells))
102
120
  end
103
121
 
104
122
 
105
123
  def parse_sexpr(tokens)
106
124
  while true
107
125
  tok, lit = tokens.next_token
108
- #puts "token: <#{tok}, #{lit}>"
126
+ # puts "token: <#{tok}, #{lit}>"
109
127
  return nil if tok == :EOF
110
128
  tokens.consume_token
111
129
  case tok
@@ -124,33 +142,37 @@ module Lisp
124
142
  when :LPAREN
125
143
  return parse_cons_cell(tokens)
126
144
  when :LBRACE
127
- return parse_map(tokens)
128
- when :LBRACKET
129
- return parse_vector(tokens)
145
+ return parse_frame(tokens, false)
146
+ when :QUOTE_LBRACE
147
+ return parse_frame(tokens, true)
148
+ when :HASH_LPAREN
149
+ return parse_vector(tokens, false)
150
+ when :QUOTE_HASH_LPAREN
151
+ return parse_vector(tokens, true)
130
152
  when :SYMBOL
131
153
  return make_symbol(lit)
132
154
  when :FFI_NEW_SYMBOL
133
- return FfiNew.new(lit)
155
+ return Lisp::FfiNew.new(lit)
134
156
  when :FFI_SEND_SYMBOL
135
- return FfiSend.new(lit)
157
+ return Lisp::FfiSend.new(lit)
136
158
  when :FFI_STATIC_SYMBOL
137
- return FfiStatic.new(lit)
159
+ return Lisp::FfiStatic.new(lit)
138
160
  when :FALSE
139
161
  return Lisp::FALSE
140
162
  when :TRUE
141
163
  return Lisp::TRUE
142
164
  when :QUOTE
143
165
  expr = parse_sexpr(tokens)
144
- return ConsCell.array_to_list([Symbol.named('quote'), expr])
166
+ return Lisp::ConsCell.array_to_list([Lisp::Symbol.named('quote'), expr])
145
167
  when :BACKQUOTE
146
168
  expr = parse_sexpr(tokens)
147
- return ConsCell.array_to_list([Symbol.named('quasiquote'), expr])
169
+ return Lisp::ConsCell.array_to_list([Lisp::Symbol.named('quasiquote'), expr])
148
170
  when :COMMA
149
171
  expr = parse_sexpr(tokens)
150
- return ConsCell.array_to_list([Symbol.named('unquote'), expr])
172
+ return Lisp::ConsCell.array_to_list([Lisp::Symbol.named('unquote'), expr])
151
173
  when :COMMAAT
152
174
  expr = parse_sexpr(tokens)
153
- return ConsCell.array_to_list([Symbol.named('unquote-splicing'), expr])
175
+ return Lisp::ConsCell.array_to_list([Lisp::Symbol.named('unquote-splicing'), expr])
154
176
  when :ILLEGAL
155
177
  return Lisp::Debug.process_error("Illegal token: #{lit} on line #{tokens.line_number}", Lisp::EnvironmentFrame.global)
156
178
  else
@@ -160,21 +182,23 @@ module Lisp
160
182
  end
161
183
 
162
184
  def parse(src)
163
- tokenizer = Tokenizer.new(src)
164
- tokenizer.init
165
-
166
- sexpr = self.parse_sexpr(tokenizer)
167
- return sexpr
185
+ tokenizer = Tokenizer.from_string(src)
186
+ self.parse_sexpr(tokenizer)
168
187
  end
169
188
 
189
+ def parse_object_from_file(port, env=Lisp::EnvironmentFrame.global)
190
+ tokenizer = Tokenizer.from_file(port)
191
+ result = self.parse_sexpr(tokenizer)
192
+ result.nil? ? Lisp::EofObject.instance : result
193
+ end
194
+
170
195
  def parse_and_eval(src, env=Lisp::EnvironmentFrame.global)
171
196
  sexpr = self.parse(src)
172
197
  return sexpr.evaluate(env)
173
198
  end
174
199
 
175
200
  def parse_and_eval_all(src, env=Lisp::EnvironmentFrame.global)
176
- tokenizer = Tokenizer.new(src)
177
- tokenizer.init
201
+ tokenizer = Tokenizer.from_string(src)
178
202
  result = nil
179
203
  until tokenizer.eof?
180
204
  sexpr = self.parse_sexpr(tokenizer)
@@ -183,7 +207,12 @@ module Lisp
183
207
  result
184
208
  end
185
209
 
186
-
210
+ def process_file(fname)
211
+ File.open(fname) do |f|
212
+ parse_and_eval_all(f.read)
213
+ end
214
+ end
215
+
187
216
  end
188
217
 
189
218
  end
@@ -0,0 +1,27 @@
1
+ module Lisp
2
+
3
+ class Port < Atom
4
+
5
+ def self.with_value(p)
6
+ self.new(p)
7
+ end
8
+
9
+ def initialize(p)
10
+ @value = p
11
+ end
12
+
13
+ def type
14
+ :port
15
+ end
16
+
17
+ def port?
18
+ true
19
+ end
20
+
21
+ def to_s
22
+ "<port: #{@value}>"
23
+ end
24
+
25
+ end
26
+
27
+ end
@@ -0,0 +1,115 @@
1
+ module Lisp
2
+
3
+ class PrimAlist
4
+
5
+
6
+ def self.register
7
+ Primitive.register("acons", "2|3") {|args, env| Lisp::PrimAlist::acons_impl(args, env) }
8
+ Primitive.register("assq", "2") {|args, env| Lisp::PrimAlist::assoc_impl(args, env) {|a, b| a.eq?(b) } }
9
+ Primitive.register("assv", "2") {|args, env| Lisp::PrimAlist::assoc_impl(args, env) {|a, b| a.eqv?(b) } }
10
+ Primitive.register("assoc", "2") {|args, env| Lisp::PrimAlist::assoc_impl(args, env) {|a, b| a.equal?(b) } }
11
+ Primitive.register("rassq", "2") {|args, env| Lisp::PrimAlist::rassoc_impl(args, env) {|a, b| a.eq?(b) } }
12
+ Primitive.register("rassv", "2") {|args, env| Lisp::PrimAlist::rassoc_impl(args, env) {|a, b| a.eqv?(b) } }
13
+ Primitive.register("rassoc", "2") {|args, env| Lisp::PrimAlist::rassoc_impl(args, env) {|a, b| a.equal?(b) } }
14
+ Primitive.register("del-assq", "2") {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.eq?(b) } }
15
+ Primitive.register("dissq", "2") {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.eq?(b) } }
16
+ Primitive.register("del-assv", "2") {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.eqv?(b) } }
17
+ Primitive.register("dissv", "2") {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.eqv?(b) } }
18
+ Primitive.register("del-assoc", "2") {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.equal?(b) } }
19
+ Primitive.register("dissoc", "2") {|args, env| Lisp::PrimAlist::dissoc_impl(args, env) {|a, b| a.equal?(b) } }
20
+ Primitive.register("zip", "2|3") {|args, env| Lisp::PrimAlist::zip_impl(args, env) }
21
+ Primitive.register("pairlis", "2|3") {|args, env| Lisp::PrimAlist::zip_impl(args, env) }
22
+ end
23
+
24
+
25
+ def self.acons_impl(args, env)
26
+ key = args.car
27
+ value = args.cadr
28
+ alist = args.length == 2 ? nil : args.caddr
29
+ return Lisp::Debug.process_error("the last argument to acons has to be a list", env) unless alist.list?
30
+
31
+ pair = ConsCell.cons(key, value)
32
+ if alist.nil?
33
+ ConsCell.cons(pair)
34
+ else
35
+ ConsCell.cons(pair, alist)
36
+ end
37
+ end
38
+
39
+
40
+ def self.assoc_impl(args, env, &equivalence_block)
41
+ key = args.car
42
+ alist = args.cadr
43
+ return Lisp::Debug.process_error("the last argument to assoc has to be a list", env) unless alist.list?
44
+
45
+ alist.each do |pair|
46
+ if equivalence_block.call(pair.car, key)
47
+ return pair
48
+ end
49
+ end
50
+ end
51
+
52
+
53
+ def self.rassoc_impl(args, env, &equivalence_block)
54
+ value = args.car
55
+ alist = args.cadr
56
+ return Lisp::Debug.process_error("the last argument to rassoc has to be a list", env) unless alist.list?
57
+ alist.each do |pair|
58
+ if equivalence_block.call(pair.cdr, value)
59
+ return pair
60
+ end
61
+ end
62
+ end
63
+
64
+
65
+ def self.dissoc_impl(args, env, &equivalence_block)
66
+ key = args.car
67
+ alist = args.cadr
68
+ return Lisp::Debug.process_error("the last argument to dissoc has to be a list", env) unless alist.list?
69
+
70
+ new_prefix = nil
71
+ trailing_end = nil
72
+ crawler = alist
73
+ while !crawler.nil?
74
+ if equivalence_block.call(crawler.caar, key)
75
+ if new_prefix.nil?
76
+ new_prefix = crawler.cdr
77
+ else
78
+ trailing_end.set_cdr!(crawler.cdr)
79
+ end
80
+ return new_prefix
81
+ else
82
+ new_cell = ConsCell.cons(ConsCell.cons(crawler.caar, crawler.cdar))
83
+ if new_prefix.nil?
84
+ new_prefix = new_cell
85
+ trailing_end = new_prefix
86
+ else
87
+ trailing_end.set_cdr!(new_cell)
88
+ end
89
+ end
90
+ crawler = crawler.cdr
91
+ end
92
+ end
93
+
94
+
95
+ def self.zip_impl(args, env)
96
+ key_list = args.car
97
+ return Lisp::Debug.process_error("the keys supplied to zip has to be a list", env) unless key_list.list?
98
+ value_list = args.cadr
99
+ return Lisp::Debug.process_error("the values supplied to zip has to be a list", env) unless value_list.list?
100
+ return Lisp::Debug.process_error("zip requires the same number of keys and values", env) unless key_list.length == value_list.length
101
+
102
+ old_list = if args.length == 3
103
+ alist = args.caddr
104
+ return Lisp::Debug.process_error("the third argument to zip has to be a list", env) unless alist.list?
105
+ alist
106
+ else
107
+ nil
108
+ end
109
+ pairs = key_list.to_a.zip(value_list.to_a)
110
+ pairs.inject(old_list) {|alist, pair| ConsCell.cons(ConsCell.cons(*pair), alist)}
111
+ end
112
+
113
+ end
114
+
115
+ end