fOOrth 0.6.6 → 0.6.11

data/lib/fOOrth/compiler/context/tags.rb

@@ -1,48 +1,60 @@
-# coding: utf-8
-
-#* compiler/context/tags.rb - Support tags in context.
-module XfOOrth
-
-  #* compiler/context/tags.rb - Support tags in context.
-  class Context
-
-    #Retrieve the data value currently in effect.
-    def [](index)
-      @data[index] || (previous && previous[index])
-    end
-
-    #Set a data value.
-    def []=(index,value)
-      @data[index] = value
-    end
-
-    #Get the compile tags in effect.
-    def tags
-      @data[:tags] || []
-    end
-
-    #Merge in a hash of tag data.
-    def merge(new_data)
-      @data.merge!(new_data)
-    end
-
-    #Validate a current data value.
-    #<br>Parameters:
-    #* symbol - The symbol of the value to be tested.
-    #* expect - An array of valid values.
-    #<br>Note:
-    #* Throws a XfOOrthError if the value is not valid.
-    #* To check for no value, use [nil] for expect.
-    #* Returns true to facilitate testing only.
-    def check_set(symbol, expect)
-      current = self[symbol]
-
-      unless expect.include?(current)
-        error "F10: Found a #{current.inspect}, excpected #{expect}"
-      end
-
-      true
-    end
-
-  end
-end
+# coding: utf-8
+
+#* compiler/context/tags.rb - Support tags in context.
+module XfOOrth
+
+  #* compiler/context/tags.rb - Support tags in context.
+  class Context
+
+    #Retrieve the data value currently in effect.
+    def [](index)
+      @data[index] || (previous && previous[index])
+    end
+
+    #Set a data value.
+    def []=(index,value)
+      @data[index] = value
+    end
+
+    #Get the compile tags in effect.
+    def tags
+      @data[:tags] || []
+    end
+
+    #Merge in a hash of tag data.
+    def merge(new_data)
+      @data.merge!(new_data)
+    end
+
+    #Get the context with the specified type.
+    def get_context_by_ctrl(ctrl_type)
+      result = self
+
+      while result
+        return result if result[:ctrl] == ctrl_type
+        result = result.previous
+      end
+
+      error "F92: Unable to locate a context for #{ctrl_type.inspect}"
+    end
+
+    #Validate a current data value.
+    #<br>Parameters:
+    #* symbol - The symbol of the value to be tested.
+    #* expect - An array of valid values.
+    #<br>Note:
+    #* Throws a XfOOrthError if the value is not valid.
+    #* To check for no value, use [nil] for expect.
+    #* Returns true to facilitate testing only.
+    def check_set(symbol, expect)
+      current = self[symbol]
+
+      unless expect.include?(current)
+        error "F10: Found a #{current.inspect}, expected #{expect}"
+      end
+
+      true
+    end
+
+  end
+end

data/lib/fOOrth/compiler/process/generate.rb

@@ -11,7 +11,7 @@ module XfOOrth
     #* token - The token to receive the generated code.
     #* word  - The text of the word.
     def generate_code(token, word)
-      if (spec = @context.map(word))
+      if (spec = @context.map_with_defaults(word))
         token.add(spec.builds, spec.tags)
       elsif (value = word.to_foorth_n)
         token.add("vm.push(#{value.foorth_embed}); ", [:numeric])

data/lib/fOOrth/compiler/process/procedure.rb

@@ -32,6 +32,42 @@ module XfOOrth
       (_, @buffer = @buffer, save)[0]
     end
 
+    #The procedure used for procedure instance values
+    PROC_VAL = lambda {|vm|
+      context = vm.context.get_context_by_ctrl(:procedure)
+      val_name = vm.parser.get_word()
+
+      unless /^@[a-z][a-z0-9_]*$/ =~ val_name
+        error "F10: Invalid val name #{val_name}"
+      end
+
+      val_symbol = XfOOrth::SymbolMap.add_entry(val_name)
+      vm << "#{'@'+(val_symbol.to_s)} = vm.pop; "
+      vm << "self.create_exclusive_method(#{val_name.inspect}, InstanceVarSpec, []); "
+
+      context.create_local_method(val_name, LocalSpec, [:immediate], &lambda {|nvm|
+        nvm << "vm.push(#{'@'+(val_symbol.to_s)}); "
+      })
+    }
+
+    #The procedure used for procedure instance variables
+    PROC_VAR = lambda {|vm|
+      context = vm.context.get_context_by_ctrl(:procedure)
+      var_name = vm.parser.get_word()
+
+      unless /^@[a-z][a-z0-9_]*$/ =~ var_name
+        error "F10: Invalid val name #{var_name}"
+      end
+
+      var_symbol = XfOOrth::SymbolMap.add_entry(var_name)
+      vm << "#{'@'+(var_symbol.to_s)} = [vm.pop]; "
+      vm << "self.create_exclusive_method(#{var_name.inspect}, InstanceVarSpec, []); "
+
+      context.create_local_method(var_name, LocalSpec, [:immediate], &lambda {|nvm|
+        nvm << "vm.push(#{'@'+(var_symbol.to_s)}); "
+      })
+    }
+
     #Handle the opening of a procedure literal.
     def open_procedure_literal
       suspend_execute_mode("vm.push(lambda {|vm, val=nil, idx=nil| ", :procedure)
@@ -44,6 +80,10 @@ module XfOOrth
       context.create_local_method('var:', LocalSpec, [:immediate], &Local_Var_Action)
       context.create_local_method('val:', LocalSpec, [:immediate], &Local_Val_Action)
 
+      #Support for procedure instance data.
+      context.create_local_method('var@:', LocalSpec, [:immediate], &PROC_VAR)
+      context.create_local_method('val@:', LocalSpec, [:immediate], &PROC_VAL)
+
       context.create_local_method('}}', MacroSpec, [:macro, :end,     "}); "])
     end
 

data/lib/fOOrth/compiler/word_specs.rb

@@ -39,7 +39,7 @@ module XfOOrth
     #Get the default action if none is specified.
     def get_stub_action(name, symbol)
       lambda do |*_any|
-        error "F20: A #{self.foorth_name} does not understand #{name} (#{symbol.inspect})."
+        f20_error(self, name, symbol)
       end
     end
 
@@ -100,7 +100,7 @@ module XfOOrth
         #be removed at this time.
         vm.data_stack.pop
 
-        error "F20: A #{self.foorth_name} does not understand #{name} (#{symbol.inspect})."
+        f20_error(self, name, symbol)
       end
     end
 
@@ -175,7 +175,7 @@ module XfOOrth
     #* The last entry in the tags array is expected to be a string
     #  with the text of the command macro.
     def build_builds_string(_name, _symbol)
-      @builds = @tags.pop
+      @builds = @tags[-1]
     end
   end
 end

data/lib/fOOrth/core/object.rb

@@ -68,7 +68,7 @@ class Object
       if (stub_spec = Object.foorth_shared[symbol])
         self.instance_exec(*args, &stub_spec.does)
       else
-        error "F20: A #{self.foorth_name} does not understand #{name} (#{symbol})."
+        f20_error(self, name, symbol)
       end
     else
       super

data/lib/fOOrth/library.rb

@@ -7,10 +7,13 @@ require_relative 'library/vm_library'
 require_relative 'library/data_ref_library'
 require_relative 'library/clone_library'
 require_relative 'library/compile_library'
+require_relative 'library/alias_library'
+require_relative 'library/stubs_library'
 require_relative 'library/ctrl_struct_library'
 require_relative 'library/stdio_library'
 require_relative 'library/numeric_library'
 require_relative 'library/integer_library'
+require_relative 'library/float_library'
 require_relative 'library/rational_library'
 require_relative 'library/complex_library'
 require_relative 'library/string_library'

data/lib/fOOrth/library/alias_library.rb

@@ -0,0 +1,126 @@
+# coding: utf-8
+
+#* library/alias_library.rb - Support for method aliasing in fOOrth.
+module XfOOrth
+
+  VirtualMachine.create_shared_method('alias:', VmSpec, [:immediate],
+  &lambda {|vm|
+    new_name = parser.get_word().inspect
+    process_text("vm.create_word_alias(#{new_name}); ")
+  })
+
+  VirtualMachine.create_shared_method('.alias:', VmSpec, [:immediate],
+  &lambda {|vm|
+    new_name = parser.get_word().inspect
+    process_text("vm.create_shared_alias(#{new_name}); ")
+  })
+
+  VirtualMachine.create_shared_method('.alias::', VmSpec, [:immediate],
+  &lambda {|vm|
+    new_name = parser.get_word().inspect
+    process_text("vm.create_exclusive_alias(#{new_name}); ")
+  })
+
+  # Alias support methods in the VirtualMachine class.
+  class VirtualMachine
+    ALLOWED_ALIAS_TYPES = {
+      TosSpec  => [TosSpec, SelfSpec],
+      SelfSpec => [TosSpec, SelfSpec],
+      NosSpec  => [NosSpec]
+    }
+
+    #Create a virtual machine word method alias.
+    def create_word_alias(new_name)
+      old_name, target = pop, self.class
+
+      old_spec = get_old_shared_spec(target, old_name)
+
+      target.create_shared_method(new_name,
+                                  old_spec.class,
+                                  old_spec.tags,
+                                  &old_spec.does)
+    end
+
+    #Create a shared method alias
+    def create_shared_alias(new_name)
+      old_name, target = popm(2)
+
+      unless target.is_a?(Class)
+        error "F13: The target of .alias: must be a class"
+      end
+
+      old_spec = get_old_shared_spec(target, old_name)
+
+      target.create_shared_method(new_name,
+                                  get_alias_type(old_spec, new_name),
+                                  old_spec.tags,
+                                  &old_spec.does)
+      clear_cast
+    end
+
+    #Create an exclusive method alias
+    def create_exclusive_alias(new_name)
+      old_name, target = popm(2)
+
+      old_spec = get_old_exclusive_spec(target, old_name)
+
+      target.create_exclusive_method(new_name,
+                                     get_alias_type(old_spec, new_name),
+                                     old_spec.tags,
+                                     &old_spec.does)
+      clear_cast
+    end
+
+    private
+
+    #Get the shared specification of the original method.
+    def get_old_shared_spec(target, old_name)
+      old_symbol = get_old_symbol(old_name)
+
+      unless (old_spec = target.map_foorth_shared(old_symbol))
+        f20_error(target, old_name, old_symbol)
+      end
+
+      old_spec
+    end
+
+    #Get the exclusive specification of the original method.
+    def get_old_exclusive_spec(target, old_name)
+      old_symbol = get_old_symbol(old_name)
+
+      unless (old_spec = target.map_foorth_exclusive(old_symbol))
+        f20_error(target, old_name, old_symbol)
+      end
+
+      old_spec
+    end
+
+    #Get the symbol of the old method.
+    def get_old_symbol(old_name)
+      old_symbol = XfOOrth::SymbolMap.map(old_name)
+      error "F10: ?#{old_name}?" unless old_symbol
+      old_symbol
+    end
+
+    #Get the type of the aliased method.
+    def get_alias_type(old_spec, new_name)
+      old_type = old_spec.class
+      new_type = XfOOrth.name_to_type(new_name, self)
+      old_desc, new_desc = old_type.foorth_name, new_type.foorth_name
+
+      unless (allowed = ALLOWED_ALIAS_TYPES[old_type])
+        error "F13: A #{old_desc} method may not be aliased."
+      end
+
+      unless allowed.include?(new_type)
+        error "F13: A #{old_desc} method may not be aliased as a #{new_desc}"
+      end
+
+      XfOOrth.validate_type(self, new_type, new_name)
+
+      new_type
+    end
+
+  end
+
+end

data/lib/fOOrth/library/array_library.rb

@@ -45,7 +45,7 @@ module XfOOrth
   # [array] .map{{ ... }} [mapped_array]
   Array.create_shared_method('.map{{', NosSpec, [], &lambda { |vm|
     idx, block = 0, vm.pop
-    vm.push(self.map { |val| block.call(vm, val, idx); idx += 1; vm.pop})
+    vm.push(self.map{|val| block.call(vm, val, idx); idx += 1; vm.pop})
   })
 
   # [array] .select{{ ... }} [selected_array]
@@ -92,40 +92,60 @@ module XfOOrth
   # [ v i a ] .[]! []; a[i]=v
   Array.create_shared_method('.[]!', TosSpec, [], &lambda {|vm|
     value, index = vm.popm(2)
-    self[Integer.foorth_coerce(index)] = value;
+    self[Integer.foorth_coerce(index)] = value
   })
 
   # [ [ 1 2 3 ] ] .reverse [ [ 3 2 1 ] ]
   Array.create_shared_method('.reverse', TosSpec, [],
-    &lambda {|vm| vm.push(self.reverse); })
+    &lambda {|vm| vm.push(self.reverse) })
 
   # [ [ 3 1 2 ] ] .sort [ [ 1 2 3 ] ]
   Array.create_shared_method('.sort', TosSpec, [],
-    &lambda {|vm| vm.push(self.sort {|va,vb| va <=> va.foorth_coerce(vb)}); })
+    &lambda {|vm| vm.push(self.sort {|va,vb| va <=> va.foorth_coerce(vb)}) })
 
   # [ [ 1 2 3 ] ] .shuffle  [ [ x y z ] ]
   Array.create_shared_method('.shuffle', TosSpec, [],
-    &lambda {|vm| vm.push(self.shuffle); })
+    &lambda {|vm| vm.push(self.shuffle) })
 
   # [ [ 3 1 2 ] ] .length [ 3 ]
   Array.create_shared_method('.length', TosSpec, [],
-    &lambda {|vm| vm.push(self.length); })
+    &lambda {|vm| vm.push(self.length) })
 
   # [ an_array ] .empty? [ a_boolean ]
   Array.create_shared_method('.empty?', TosSpec, [],
-    &lambda {|vm| vm.push(self.empty?); })
+    &lambda {|vm| vm.push(self.empty?) })
+
+  # [ an_array ] .present? [ a_boolean ]
+  Array.create_shared_method('.present?', TosSpec, [],
+    &lambda {|vm| vm.push(!self.empty?) })
+
+  # [ an_array ] .clear! [ ]; The array contents are removed.
+  Array.create_shared_method('.clear!', TosSpec, [],
+    &lambda {|vm| self.clear})
 
   # [ [ 3 1 2 ] n ] << [ [ 3 1 2 n ] ]
-  Array.create_shared_method('<<', NosSpec, [],
-    &lambda {|vm| vm.poke(self << vm.peek); })
+  Array.create_shared_method('<<', NosSpec, [], &lambda {|vm|
+    begin
+      vm.poke(self << vm.peek)
+    rescue
+      vm.data_stack.pop
+      raise
+    end
+  })
 
   # [ [ 3 1 2 ] n ] >> [ [ n 3 1 2 ] ]
-  Array.create_shared_method('>>', NosSpec, [],
-    &lambda {|vm| vm.poke(self.insert(0, vm.peek)); })
+  Array.create_shared_method('>>', NosSpec, [], &lambda {|vm|
+    begin
+      vm.poke(self.insert(0, vm.peek))
+    rescue
+      vm.data_stack.pop
+      raise
+    end
+  })
 
   # [[3 1 2] n] + [[3 1 2 n]]
   Array.create_shared_method('+', NosSpec, [],
-    &lambda {|vm| vm.poke(self + vm.peek.in_array); })
+    &lambda {|vm| vm.poke(self + vm.peek.in_array) })
 
 
   # The LEFT group
@@ -134,7 +154,7 @@ module XfOOrth
     begin
       width = Integer.foorth_coerce(vm.peek)
       error "F41: Invalid width: #{width} in .left" if width < 0
-      vm.poke(self.first(width));
+      vm.poke(self.first(width))
     rescue
       vm.data_stack.pop
       raise
@@ -146,7 +166,7 @@ module XfOOrth
     begin
       width = Integer.foorth_coerce(vm.peek)
       error "F41: Invalid width: #{width} in .-left" if width < 0
-      vm.poke(self[width..-1]);
+      vm.poke(self[width..-1])
     rescue
       vm.data_stack.pop
       raise
@@ -173,7 +193,7 @@ module XfOOrth
       error "F41: Invalid width: #{width} in .^left" if width < 0
 
       vm.poke(self[width..-1])
-      vm.push(self.first(width));
+      vm.push(self.first(width))
     rescue
       vm.data_stack.pop
       raise
@@ -199,7 +219,7 @@ module XfOOrth
     begin
       width = Integer.foorth_coerce(vm.peek)
       error "F41: Invalid width: #{width} in .-right" if width < 0
-      vm.poke(self[0...(0-width)]);
+      vm.poke(self[0...(0-width)])
     rescue
       vm.data_stack.pop
       raise
@@ -226,7 +246,7 @@ module XfOOrth
       error "F41: Invalid width: #{width} in .^right" if width < 0
 
       vm.poke(self[0...(0-width)])
-      vm.push(self.last(width));
+      vm.push(self.last(width))
     rescue
       vm.data_stack.pop
       raise
@@ -358,7 +378,7 @@ module XfOOrth
   #[ [ 1 2 3 ] ] .pop_left [ [ 2 3 ] 1 ]
   Array.create_shared_method('.pop_left', TosSpec, [], &lambda{|vm|
     error "F31: Array underflow error on .pop_left" if self.empty?
-    vm.push(self[1..-1]);
+    vm.push(self[1..-1])
     vm.push(self.first)
   })
 
@@ -381,7 +401,7 @@ module XfOOrth
   #[ [ 1 2 3 ] ] .peek_left [ [ 1 2 3 ] 1 ]
   Array.create_shared_method('.peek_left', TosSpec, [], &lambda{|vm|
     error "F31: Array underflow error on .peek_left" if self.empty?
-    vm.push(self);
+    vm.push(self)
     vm.push(self.first)
   })
 
@@ -396,7 +416,7 @@ module XfOOrth
   #[ [ 1 2 3 ] ] .pop_right [ [ 1 2 ] 3 ]
   Array.create_shared_method('.pop_right', TosSpec, [], &lambda{|vm|
     error "F31: Array underflow error on .pop_right" if self.empty?
-    vm.push(self[0...-1]);
+    vm.push(self[0...-1])
     vm.push(self.last)
   })
 
@@ -419,7 +439,7 @@ module XfOOrth
   #[ [ 1 2 3 ] ] .peek_right [ [ 1 2 3 ] 3 ]
   Array.create_shared_method('.peek_right', TosSpec, [], &lambda{|vm|
     error "F31: Array underflow error on .peek_right" if self.empty?
-    vm.push(self);
+    vm.push(self)
     vm.push(self.last)
   })