Class: Lisp::PrimEnvironment

Inherits:
Object
  • Object
show all
Defined in:
lib/rubylisp/prim_environment.rb

Class Method Summary collapse

Class Method Details

.environment_assign_bang_impl_impl(args, env) ⇒ Object 



119
120
121
122
123
124
125
 
# File 'lib/rubylisp/prim_environment.rb', line 119

def self.environment_assign_bang_impl_impl(args, env)
  return Lisp::Debug.process_error("environment-assign! requires an environment for it's first argument, received: #{args.car}", env) unless args.car.environment?
  return Lisp::Debug.process_error("environment-assign! requires a symbol for it's second argument, received: #{args.cadr}", env) unless args.cadr.symbol?
  local_env = args.car.value
  binding = local_env.binding_for(args.cadr)
  binding.value = args.caddr unless binding.nil?
end

.environment_assignablep_impl(args, env) ⇒ Object 



110
111
112
113
114
115
116
 
# File 'lib/rubylisp/prim_environment.rb', line 110

def self.environment_assignablep_impl(args, env)
  return Lisp::Debug.process_error("environment-assignable? requires an environment for it's first argument, received: #{args.car}", env) unless args.car.environment?
  return Lisp::Debug.process_error("environment-assignable? requires a symbol for it's second argument, received: #{args.cadr}", env) unless args.cadr.symbol?
  local_env = args.car.value
  binding = local_env.binding_for(args.cadr)
  Lisp::Boolean.with_value(!binding.nil?)
end

.environment_assignedp_impl(args, env) ⇒ Object 



78
79
80
81
82
83
84
85
 
# File 'lib/rubylisp/prim_environment.rb', line 78

def self.environment_assignedp_impl(args, env)
  return Lisp::Debug.process_error("environment-assigned? requires an environment for it's first argument, received: #{args.car}", env) unless args.car.environment?
  return Lisp::Debug.process_error("environment-assigned? requires a symbol for it's second argument, received: #{args.cadr}", env) unless args.cadr.symbol?
  return Lisp::Debug.process_error("environment-assigned?: #{args.cadr.to_s} is unbound", env) unless args.car.value.name_bound_locally?(args.cadr.name)
  b = args.car.value.local_binding_for(args.cadr)
  return Lisp::Debug.process_error("environment-assigned?: #{args.cadr.to_s} is bound to a macro", env) if b.value.macro?     
  Lisp::Boolean.with_value(!b.value.nil?) 
end

.environment_bindings_impl(args, env) ⇒ Object 



54
55
56
57
 
# File 'lib/rubylisp/prim_environment.rb', line 54

def self.environment_bindings_impl(args, env)
  return Lisp::Debug.process_error("environment-bindings requires an environment for it's argument, received: #{args.car}", env) unless args.car.environment?
  Lisp::ConsCell.array_to_list(args.car.value.bindings.map { |b| Lisp::ConsCell.array_to_list(b.value.nil? ? [b.symbol] : [b.symbol, b.value]) })
end

.environment_bound_names_impl(args, env) ⇒ Object 



40
41
42
43
44
 
# File 'lib/rubylisp/prim_environment.rb', line 40

def self.environment_bound_names_impl(args, env)
  return Lisp::Debug.process_error("environment-bound-names requires an environment for it's argument, received: #{args.car}", env) unless args.car.environment?
  e = args.car.value
  Lisp::ConsCell.array_to_list(e.bound_names)
end

.environment_boundp_impl(args, env) ⇒ Object 



71
72
73
74
75
 
# File 'lib/rubylisp/prim_environment.rb', line 71

def self.environment_boundp_impl(args, env)
  return Lisp::Debug.process_error("environment-bound? requires an environment for it's first argument, received: #{args.car}", env) unless args.car.environment?
  return Lisp::Debug.process_error("environment-bound? requires a symbol for it's second argument, received: #{args.cadr}", env) unless args.cadr.symbol?
  Lisp::Boolean.with_value(args.car.value.name_bound_locally?(args.cadr.name)) 
end

.environment_definablep_impl(args, env) ⇒ Object 



128
129
130
131
132
 
# File 'lib/rubylisp/prim_environment.rb', line 128

def self.environment_definablep_impl(args, env)
  return Lisp::Debug.process_error("environment-definable?requires an environment for it's first argument, received: #{args.car}", env) unless args.car.environment?
  return Lisp::Debug.process_error("environment-definable? requires a symbol for it's second argument, received: #{args.cadr}", env) unless args.cadr.symbol?
  Lisp::TRUE
end

.environment_define_impl(args, env) ⇒ Object 



135
136
137
138
139
140
 
# File 'lib/rubylisp/prim_environment.rb', line 135

def self.environment_define_impl(args, env)
  return Lisp::Debug.process_error("environment-define requires an environment for it's first argument, received: #{args.car}", env) unless args.car.environment?
  return Lisp::Debug.process_error("environment-define requires a symbol for it's second argument, received: #{args.cadr}", env) unless args.cadr.symbol?
  args.car.value.bind_locally(args.cadr, args.caddr)
  Lisp::TRUE
end

.environment_lookup_impl(args, env) ⇒ Object 



88
89
90
91
92
93
94
95
96
 
# File 'lib/rubylisp/prim_environment.rb', line 88

def self.environment_lookup_impl(args, env)
  return Lisp::Debug.process_error("environment-lookup requires an environment for it's first argument, received: #{args.car}", env) unless args.car.environment?
  return Lisp::Debug.process_error("environment-lookup requires a symbol for it's second argument, received: #{args.cadr}", env) unless args.cadr.symbol?
  return Lisp::Debug.process_error("environment-lookup: #{args.cadr.to_s} is unbound", env) unless args.car.value.name_bound_locally?(args.cadr.name)
  b = args.car.value.local_binding_for(args.cadr)
  return Lisp::Debug.process_error("environment-lookup: #{args.cadr.to_s} is unassigned", env) if b.value.nil?
  return Lisp::Debug.process_error("environment-lookup: #{args.cadr.to_s} is bound to a macro", env) if b.value.macro?
  b.value
end

.environment_lookup_macro_impl(args, env) ⇒ Object 



99
100
101
102
103
104
105
106
107
 
# File 'lib/rubylisp/prim_environment.rb', line 99

def self.environment_lookup_macro_impl(args, env)
  return Lisp::Debug.process_error("environment-lookup-macro requires an environment for it's first argument, received: #{args.car}", env) unless args.car.environment?
  return Lisp::Debug.process_error("environment-lookup-macro requires a symbol for it's second argument, received: #{args.cadr}", env) unless args.cadr.symbol?
  return Lisp::Debug.process_error("environment-lookup-macro: #{args.cadr.to_s} is unbound", env) unless args.car.value.name_bound_locally?(args.cadr)
  b = args.car.value.local_binding_for(args.cadr)
  return Lisp::Debug.process_error("environment-lookup-macro: #{args.cadr.to_s} is unassigned", env) if b.value.nil?
  return Lisp::Debug.process_error("environment-lookup-macro: #{args.cadr.to_s} is bound to a macro", env) if b.value.macro?
  b.value
end

.environment_macro_names_impl(args, env) ⇒ Object 



47
48
49
50
51
 
# File 'lib/rubylisp/prim_environment.rb', line 47

def self.environment_macro_names_impl(args, env)
  return Lisp::Debug.process_error("environment-macro-names requires an environment for it's argument, received: #{args.car}", env) unless args.car.environment?
  e = args.car.value
  Lisp::ConsCell.array_to_list(e.bound_values.select {|v| v.macro?})
end

.environment_parent_impl(args, env) ⇒ Object 



155
156
157
158
159
 
# File 'lib/rubylisp/prim_environment.rb', line 155

def self.environment_parent_impl(args, env)
  return Lisp::Debug.process_error("environment-parent requires an environment for it's argument, received: #{args.car}", env) unless args.car.environment?
  e = args.car.value
  e.parent.nil? ? nil : Lisp::Environment.with_value(e.parent)
end

.environment_parentp_impl(args, env) ⇒ Object 



34
35
36
37
 
# File 'lib/rubylisp/prim_environment.rb', line 34

def self.environment_parentp_impl(args, env)
  return Lisp::Debug.process_error("environment-has-parent? requires an environment for it's argument, received: #{args.car}", env) unless args.car.environment?
  Lisp::Boolean.with_value(!args.car.value.parent.nil?)
end

.environment_reference_type_impl(args, env) ⇒ Object 



60
61
62
63
64
65
66
67
68
 
# File 'lib/rubylisp/prim_environment.rb', line 60

def self.environment_reference_type_impl(args, env)
  return Lisp::Debug.process_error("environment-reference-type requires an environment for it's first argument, received: #{args.car}", env) unless args.car.environment?
  return Lisp::Debug.process_error("environment-reference-type requires a symbol for it's second argument, received: #{args.cadr}", env) unless args.cadr.symbol?
  b = args.car.value.binding_for(args.cadr.value)
  return Lisp::Symbol.named("unbound") if b.nil?
  return Lisp::Symbol.named("unassigned") if b.value.nil?
  return Lisp::Symbol.named("macro") if b.value.binding?
  Lisp::Symbol.named("normal")
end

.environmentp_impl(args, env) ⇒ Object 



29
30
31
 
# File 'lib/rubylisp/prim_environment.rb', line 29

def self.environmentp_impl(args, env)
  Lisp::Boolean.with_value(args.car.environment?)
end

.find_top_level_environment_impl(args, env) ⇒ Object 



195
196
197
198
199
 
# File 'lib/rubylisp/prim_environment.rb', line 195

def self.find_top_level_environment_impl(args, env)
  return Lisp::Debug.process_error("find-top-level-environment requires a symbol or sting environment name, received: #{args.cadr}", env) unless args.cadr.symbol? || args.cadr.string
  e = Lisp::TopLevelEnvironments[args.car.to_s]
  return e.nil? ? nil : Lisp::Environment.with_value(e)
end

.make_top_level_environment_impl(args, env) ⇒ Object 



167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
 
# File 'lib/rubylisp/prim_environment.rb', line 167

def self.make_top_level_environment_impl(args, env)
  if args.car.string?
    name = args.car.value
    args = args.cdr
  else
    name = "anonymous top level"
  end

  new_env = Lisp::EnvironmentFrame.extending(Lisp::EnvironmentFrame.global, name)
  if args.length == 1
    return Lisp::Debug.process_error("make-top-level-environment expects binding names to be a list", env) unless args.car.list?
    args.to_a.map do |a|
      return Lisp::Debug.process_error("make-top-level-environment expects each binding name to be a symbol", env) unless a.car.symbol?
      new_env.bind_locally_to(a.car, nil)
    end
  elsif args.length == 2
    return Lisp::Debug.process_error("make-top-level-environment expects binding names to be a list", env) unless args.car.list?
    return Lisp::Debug.process_error("make-top-level-environment expects binding values to be a list", env) unless args.cadr.list?
    return Lisp::Debug.process_error("make-top-level-environment expects binding name and value lists to be the same length", env) if args.car.length != args.cadr.length
    args.car.zip(args.cadr).map do |name, value|
      return Lisp::Debug.process_error("make-top-level-environment expects each binding name to be a symbol", env) unless name.symbol?
      new_env.bind_locally_to(name, value)
    end
  end
  return Lisp::Environment.with_value(new_env)
end

.procedure_environment_impl(args, env) ⇒ Object 



149
150
151
152
 
# File 'lib/rubylisp/prim_environment.rb', line 149

def self.procedure_environment_impl(args, env)
  Lisp::Debug.process_error("procedure-environment requires a user written function as it's argument", env) unless args.car.function?
  Lisp::Environment.with_value(args.car.env)
end

.register ⇒ Object 



5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
# File 'lib/rubylisp/prim_environment.rb', line 5

def self.register
  Primitive.register("environment?", "1") {|args, env|  Lisp::PrimEnvironment::environmentp_impl(args, env)}
	  Primitive.register("environment-has-parent?", "1") {|args, env|  Lisp::PrimEnvironment::environment_parentp_impl(args, env) }
	  Primitive.register("environment-bound-names", "1") {|args, env|  Lisp::PrimEnvironment::environment_bound_names_impl(args, env) }
	  Primitive.register("environment-macro-names", "1") {|args, env|  Lisp::PrimEnvironment::environment_macro_names_impl(args, env) }
	  Primitive.register("environment-bindings", "1") {|args, env|  Lisp::PrimEnvironment::environment_bindings_impl(args, env) }
	  Primitive.register("environment-reference-type", "2") {|args, env|  Lisp::PrimEnvironment::environment_reference_type_impl(args, env) }
	  Primitive.register("environment-bound?", "2") {|args, env|  Lisp::PrimEnvironment::environment_boundp_impl(args, env) }
	  Primitive.register("environment-assigned?", "2") {|args, env|  Lisp::PrimEnvironment::environment_assignedp_impl(args, env) }
	  Primitive.register("environment-lookup", "2") {|args, env|  Lisp::PrimEnvironment::environment_lookup_impl(args, env) }
	  Primitive.register("environment-lookup-macro", "2") {|args, env|  Lisp::PrimEnvironment::environment_lookup_macro_impl(args, env) }
	  Primitive.register("environment-assignable?", "2") {|args, env|  Lisp::PrimEnvironment::environment_assignablep_impl(args, env) }
	  Primitive.register("environment-assign!", "3") {|args, env|  Lisp::PrimEnvironment::environment_assign_bang_impl(args, env) }
	  Primitive.register("environment-definable?", "2") {|args, env|  Lisp::PrimEnvironment::environment_definablep_impl(args, env) }
	  Primitive.register("environment-define", "3") {|args, env|  Lisp::PrimEnvironment::environment_define_impl(args, env) }
	  Primitive.register("the-environment", "0") {|args, env|  Lisp::PrimEnvironment::the_environment_impl(args, env) }
	  Primitive.register("procedure-environment", "1") {|args, env|  Lisp::PrimEnvironment::procedure_environment_impl(args, env) }
	  Primitive.register("environment-parent", "1") {|args, env|  Lisp::PrimEnvironment::environment_parent_impl(args, env) }
	  Primitive.register("system-global-environment", "0") {|args, env|  Lisp::PrimEnvironment::system_global_environment_impl(args, env) }
	  Primitive.register("make-top-level-environment", "1|2|3") {|args, env|  Lisp::PrimEnvironment::make_top_level_environment_impl(args, env) }
	  Primitive.register("find-top-level-environment", "1") {|args, env|  Lisp::PrimEnvironment::find_top_level_environment_impl(args, env) }
end

.system_global_environment_impl(args, env) ⇒ Object 



162
163
164
 
# File 'lib/rubylisp/prim_environment.rb', line 162

def self.system_global_environment_impl(args, env)
  Lisp::Environment.with_value(Lisp::EnvironmentFrame.global)
end

.the_environment_impl(args, env) ⇒ Object 



143
144
145
146
 
# File 'lib/rubylisp/prim_environment.rb', line 143

def self.the_environment_impl(args, env)
  Lisp::Environment.with_value(env) if env == Lisp.EnvironmentFrame.global || env.parent == Lisp.EnvironmentFrame.global
  Lisp::Debug.process_error("the-environment can only be called from a top-level environment", env)
end