fOOrth 0.6.10 → 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/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/library.rb

@@ -13,6 +13,7 @@ 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/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)
   })
 

data/lib/fOOrth/library/command_library.rb

@@ -9,7 +9,7 @@ module XfOOrth
 
   #Execute a command to the shell.
   VirtualMachine.create_shared_method(')"', MacroSpec,
-    [:macro, "system(vm.pop()); "])
+    [:macro, "system(vm.pop().to_s.chomp + \"\n\"); "])
 
   #Enter debug mode. Warning! This is really verbose!
   VirtualMachine.create_shared_method(')debug', MacroSpec,

data/lib/fOOrth/library/compile_library.rb

@@ -1,266 +1,266 @@
-# coding: utf-8
-
-#* library/compile_library.rb - The compile support fOOrth library.
-module XfOOrth
-
-  # METHOD CASTING ==============================
-
-  #TosSpec method cast.
-  VirtualMachine.create_shared_method("'.", VmSpec, [],
-    &lambda {|vm| vm.set_cast(TosSpec) })
-
-  #NosSpec method cast.
-  VirtualMachine.create_shared_method("'*", VmSpec, [],
-    &lambda {|vm| vm.set_cast(NosSpec) })
-
-  #SelfSpec method cast.
-  VirtualMachine.create_shared_method("'~", VmSpec, [],
-    &lambda {|vm| vm.set_cast(SelfSpec) })
-
-  # COLON =======================================
-
-  #The classic colon definition that creates a word in the Virtual Machine class.
-  # [] : <name> <stuff omitted> ; []; creates <name> on the VirtualMachine
-  VirtualMachine.create_shared_method(':', VmSpec, [:immediate],  &lambda {|vm|
-    if execute_mode?
-      verify_cast([VmSpec])
-      target = VirtualMachine
-      name   = vm.parser.get_word()
-      type   = VmSpec
-      XfOOrth.validate_type(vm, type, name)
-
-      begin_compile_mode(':', vm: vm, &lambda {|vm, src, tags|
-        vm.dbg_puts "#{name} => #{src}"
-        target.create_shared_method(name, type, tags, &eval(src))
-      })
-
-      XfOOrth.add_common_compiler_locals(vm, ':')
-    else
-      delayed_compile_mode(':')
-    end
-  })
-
-  # BANG COLON ==================================
-
-  #A special colon definition that creates an immediate word in the
-  #Virtual Machine class.
-  # [] !: <name> <stuff omitted> ; []; creates <name> on the VirtualMachine
-  VirtualMachine.create_shared_method('!:', VmSpec, [:immediate],  &lambda {|vm|
-    if execute_mode?
-      verify_cast([VmSpec])
-      target = VirtualMachine
-      name   = vm.parser.get_word()
-      type   = VmSpec
-      XfOOrth.validate_type(vm, type, name)
-
-      begin_compile_mode('!:', vm: vm, tags: [:immediate], &lambda {|vm, src, tags|
-        vm.dbg_puts "(!) #{name} => #{src}"
-        target.create_shared_method(name, type, tags, &eval(src))
-      })
-
-      XfOOrth.add_common_compiler_locals(vm, '!:')
-    else
-      delayed_compile_mode('!:')
-    end
-  })
-
-
-  # DOT COLON ===================================
-
-  # [a_class] .: <name> <stuff omitted> ; []; creates <name> on a_class
-  VirtualMachine.create_shared_method('.:', VmSpec, [:immediate],  &lambda {|vm|
-    if execute_mode?
-      target = vm.pop
-      error "F13: The target of .: must be a class" unless target.is_a?(Class)
-
-      name   = vm.parser.get_word()
-      type   = XfOOrth.name_to_type(name, self)
-      XfOOrth.validate_type(vm, type, name)
-      XfOOrth.validate_string_method(type, target, name)
-
-      begin_compile_mode('.:', cls: target, &lambda {|vm, src, tags|
-        vm.dbg_puts "#{target.foorth_name} #{name} => #{src}"
-        target.create_shared_method(name, type, tags, &eval(src))
-      })
-
-      XfOOrth.add_common_compiler_locals(vm, '.:')
-      XfOOrth.add_dot_colon_locals(vm.context)
-    else
-      delayed_compile_mode('.:')
-    end
-  })
-
-  #The procedure used for dot colon instance vars
-  DC_VAR = lambda {|vm|
-    var_name = vm.parser.get_word()
-
-    unless /^@[a-z][a-z0-9_]*$/ =~ var_name
-      error "F10: Invalid var name #{var_name}"
-    end
-
-    var_symbol = XfOOrth::SymbolMap.add_entry(var_name)
-    vm << "#{'@'+(var_symbol.to_s)} = [vm.pop]; "
-
-    vm.context.target_class.create_shared_method(var_name, InstanceVarSpec, [])
-  }
-
-  #The procedure used for dot colon instance vals
-  DC_VAL = lambda {|vm|
-    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.context.target_class.create_shared_method(val_name, InstanceVarSpec, [])
-  }
-
-  # Add locals specific to a dot colon methods.
-  def self.add_dot_colon_locals(context)
-    context.create_local_method('var@:', LocalSpec, [:immediate], &DC_VAR)
-    context.create_local_method('val@:', LocalSpec, [:immediate], &DC_VAL)
-  end
-
-
-  # DOT COLON COLON =============================
-
-  # [an_object] .:: <name> <stuff omitted> ; []; creates <name> on an_object
-  VirtualMachine.create_shared_method('.::', VmSpec, [:immediate],  &lambda {|vm|
-    if execute_mode?
-      target = vm.pop
-      name   = vm.parser.get_word()
-      type   = XfOOrth.name_to_type(name, self)
-      XfOOrth.validate_type(vm, type, name)
-      XfOOrth.validate_string_method(type, target.class, name)
-
-      begin_compile_mode('.::', obj: target, &lambda {|vm, src, tags|
-        vm.dbg_puts "#{target.foorth_name} #{name} => #{src}"
-        target.create_exclusive_method(name, type, tags, &eval(src))
-      })
-
-      XfOOrth.add_common_compiler_locals(vm, '.::')
-      XfOOrth.add_dot_colon_colon_locals(vm.context)
-    else
-      delayed_compile_mode('.::')
-    end
-  })
-
-  #The procedure used for dot colon colon instance vars
-  DCC_VAR = lambda { |vm|
-    var_name = vm.parser.get_word()
-
-    unless /^@[a-z][a-z0-9_]*$/ =~ var_name
-      error "F10: Invalid var name #{var_name}"
-    end
-
-    var_symbol = XfOOrth::SymbolMap.add_entry(var_name)
-    vm << "#{'@'+(var_symbol.to_s)} = [vm.pop]; "
-
-    vm.context.target_object.create_exclusive_method(var_name, InstanceVarSpec, [])
-  }
-
-  #The procedure used for dot colon colon instance vals
-  DCC_VAL = lambda {|vm|
-    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.context.target_object.create_exclusive_method(val_name, InstanceVarSpec, [])
-  }
-
-  # Add locals specific to a dot colon colon methods.
-  def self.add_dot_colon_colon_locals(context)
-    context.create_local_method('var@:', LocalSpec, [:immediate], &DCC_VAR)
-    context.create_local_method('val@:', LocalSpec, [:immediate], &DCC_VAL)
-  end
-
-  # COMMON LOCAL DEFNS ==========================
-
-  #Set up the common local defns.
-  #<br>Parameters:
-  #* vm - The current virtual machine instance.
-  #* ctrl - A list of valid start controls.
-  #<br>Endemic Code Smells
-  #* :reek:TooManyStatements
-  def self.add_common_compiler_locals(vm, ctrl)
-    context = vm.context
-
-    #Support for local data.
-    context.create_local_method('var:', LocalSpec, [:immediate], &Local_Var_Action)
-    context.create_local_method('val:', LocalSpec, [:immediate], &Local_Val_Action)
-
-    #Support for super methods.
-    context.create_local_method('super', LocalSpec, [:immediate],
-      &lambda {|vm| vm << 'super(vm); ' })
-
-    #The standard end-compile adapter word: ';' semi-colon.
-    context.create_local_method(';', LocalSpec, [:immediate], &lambda {|vm|
-      vm.clear_cast
-      vm.end_compile_mode([ctrl])
-    })
-  end
-
-  #Determine the type of method being created. This only applies to non-vm
-  #methods as vm methods are all of type VmSpec.
-  #<br>Parameters
-  #*name - The name of the method to be created.
-  #<Returns>
-  #* The class of the spec to be used for this method.
-  def self.name_to_type(name, vm)
-    normal_spec = case name[0]
-    when '.'
-      TosSpec
-
-    when '~'
-      SelfSpec
-
-    when /[0-9A-Z$@#]/
-      error "F10: Invalid name for a method: #{name}"
-
-    else
-      NosSpec
-    end
-
-    vm.get_cast || normal_spec
-  end
-
-  #Compare the new method's spec against the specs of other methods of the
-  #same name. If no specs exist, create one on Object if the new spec is not
-  #a virtual machine spec.
-  #<br>Parameters
-  #*vm - The current virtual machine.
-  #*type - The class of the method to be created.
-  #*name - The name of the method to be created.
-  def self.validate_type(vm, type, name)
-    if (spec = vm.context.map_without_defaults(name))
-      if spec.class != type
-        error "F90: Spec type mismatch #{spec.foorth_name} vs #{type.foorth_name}"
-      end
-    else
-      Object.create_shared_method(name, type, [:stub]) unless type == VmSpec
-    end
-
-  end
-
-  #Check for the case where a string method is created on another class.
-  #<br>Parameters
-  #*type - The class of the method to be created.
-  #*target - The object that is to receive this method.
-  #*name - The name of the method to be created.
-  #<br>Endemic Code Smells
-  #* :reek:ControlParameter -- false positive
-  def self.validate_string_method(type, target, name)
-    if type == TosSpec && name[-1] == '"' && target != String
-      error "F13: Creating a string method #{name} on a #{target.foorth_name}"
-    end
-  end
-
-end
+# coding: utf-8
+
+#* library/compile_library.rb - The compile support fOOrth library.
+module XfOOrth
+
+  # METHOD CASTING ==============================
+
+  #TosSpec method cast.
+  VirtualMachine.create_shared_method("'.", VmSpec, [],
+    &lambda {|vm| vm.set_cast(TosSpec) })
+
+  #NosSpec method cast.
+  VirtualMachine.create_shared_method("'*", VmSpec, [],
+    &lambda {|vm| vm.set_cast(NosSpec) })
+
+  #SelfSpec method cast.
+  VirtualMachine.create_shared_method("'~", VmSpec, [],
+    &lambda {|vm| vm.set_cast(SelfSpec) })
+
+  # COLON =======================================
+
+  #The classic colon definition that creates a word in the Virtual Machine class.
+  # [] : <name> <stuff omitted> ; []; creates <name> on the VirtualMachine
+  VirtualMachine.create_shared_method(':', VmSpec, [:immediate],  &lambda {|vm|
+    if execute_mode?
+      verify_cast([VmSpec])
+      target = VirtualMachine
+      name   = vm.parser.get_word()
+      type   = VmSpec
+      XfOOrth.validate_type(vm, type, name)
+
+      begin_compile_mode(':', vm: vm, &lambda {|vm, src, tags|
+        vm.dbg_puts "#{name} => #{src}"
+        target.create_shared_method(name, type, tags, &eval(src))
+      })
+
+      XfOOrth.add_common_compiler_locals(vm, ':')
+    else
+      delayed_compile_mode(':')
+    end
+  })
+
+  # BANG COLON ==================================
+
+  #A special colon definition that creates an immediate word in the
+  #Virtual Machine class.
+  # [] !: <name> <stuff omitted> ; []; creates <name> on the VirtualMachine
+  VirtualMachine.create_shared_method('!:', VmSpec, [:immediate],  &lambda {|vm|
+    if execute_mode?
+      verify_cast([VmSpec])
+      target = VirtualMachine
+      name   = vm.parser.get_word()
+      type   = VmSpec
+      XfOOrth.validate_type(vm, type, name)
+
+      begin_compile_mode('!:', vm: vm, tags: [:immediate], &lambda {|vm, src, tags|
+        vm.dbg_puts "(!) #{name} => #{src}"
+        target.create_shared_method(name, type, tags, &eval(src))
+      })
+
+      XfOOrth.add_common_compiler_locals(vm, '!:')
+    else
+      delayed_compile_mode('!:')
+    end
+  })
+
+
+  # DOT COLON ===================================
+
+  # [a_class] .: <name> <stuff omitted> ; []; creates <name> on a_class
+  VirtualMachine.create_shared_method('.:', VmSpec, [:immediate],  &lambda {|vm|
+    if execute_mode?
+      target = vm.pop
+      error "F13: The target of .: must be a class" unless target.is_a?(Class)
+
+      name   = vm.parser.get_word()
+      type   = XfOOrth.name_to_type(name, self)
+      XfOOrth.validate_type(vm, type, name)
+      XfOOrth.validate_string_method(type, target, name)
+
+      begin_compile_mode('.:', cls: target, &lambda {|vm, src, tags|
+        vm.dbg_puts "#{target.foorth_name} #{name} => #{src}"
+        target.create_shared_method(name, type, tags, &eval(src))
+      })
+
+      XfOOrth.add_common_compiler_locals(vm, '.:')
+      XfOOrth.add_dot_colon_locals(vm.context)
+    else
+      delayed_compile_mode('.:')
+    end
+  })
+
+  #The procedure used for dot colon instance vars
+  DC_VAR = lambda {|vm|
+    var_name = vm.parser.get_word()
+
+    unless /^@[a-z][a-z0-9_]*$/ =~ var_name
+      error "F10: Invalid var name #{var_name}"
+    end
+
+    var_symbol = XfOOrth::SymbolMap.add_entry(var_name)
+    vm << "#{'@'+(var_symbol.to_s)} = [vm.pop]; "
+
+    vm.context.target_class.create_shared_method(var_name, InstanceVarSpec, [])
+  }
+
+  #The procedure used for dot colon instance vals
+  DC_VAL = lambda {|vm|
+    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.context.target_class.create_shared_method(val_name, InstanceVarSpec, [])
+  }
+
+  # Add locals specific to a dot colon methods.
+  def self.add_dot_colon_locals(context)
+    context.create_local_method('var@:', LocalSpec, [:immediate], &DC_VAR)
+    context.create_local_method('val@:', LocalSpec, [:immediate], &DC_VAL)
+  end
+
+
+  # DOT COLON COLON =============================
+
+  # [an_object] .:: <name> <stuff omitted> ; []; creates <name> on an_object
+  VirtualMachine.create_shared_method('.::', VmSpec, [:immediate],  &lambda {|vm|
+    if execute_mode?
+      target = vm.pop
+      name   = vm.parser.get_word()
+      type   = XfOOrth.name_to_type(name, self)
+      XfOOrth.validate_type(vm, type, name)
+      XfOOrth.validate_string_method(type, target.class, name)
+
+      begin_compile_mode('.::', obj: target, &lambda {|vm, src, tags|
+        vm.dbg_puts "#{target.foorth_name} #{name} => #{src}"
+        target.create_exclusive_method(name, type, tags, &eval(src))
+      })
+
+      XfOOrth.add_common_compiler_locals(vm, '.::')
+      XfOOrth.add_dot_colon_colon_locals(vm.context)
+    else
+      delayed_compile_mode('.::')
+    end
+  })
+
+  #The procedure used for dot colon colon instance vars
+  DCC_VAR = lambda { |vm|
+    var_name = vm.parser.get_word()
+
+    unless /^@[a-z][a-z0-9_]*$/ =~ var_name
+      error "F10: Invalid var name #{var_name}"
+    end
+
+    var_symbol = XfOOrth::SymbolMap.add_entry(var_name)
+    vm << "#{'@'+(var_symbol.to_s)} = [vm.pop]; "
+
+    vm.context.target_object.create_exclusive_method(var_name, InstanceVarSpec, [])
+  }
+
+  #The procedure used for dot colon colon instance vals
+  DCC_VAL = lambda {|vm|
+    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.context.target_object.create_exclusive_method(val_name, InstanceVarSpec, [])
+  }
+
+  # Add locals specific to a dot colon colon methods.
+  def self.add_dot_colon_colon_locals(context)
+    context.create_local_method('var@:', LocalSpec, [:immediate], &DCC_VAR)
+    context.create_local_method('val@:', LocalSpec, [:immediate], &DCC_VAL)
+  end
+
+  # COMMON LOCAL DEFNS ==========================
+
+  #Set up the common local defns.
+  #<br>Parameters:
+  #* vm - The current virtual machine instance.
+  #* ctrl - A list of valid start controls.
+  #<br>Endemic Code Smells
+  #* :reek:TooManyStatements
+  def self.add_common_compiler_locals(vm, ctrl)
+    context = vm.context
+
+    #Support for local data.
+    context.create_local_method('var:', LocalSpec, [:immediate], &Local_Var_Action)
+    context.create_local_method('val:', LocalSpec, [:immediate], &Local_Val_Action)
+
+    #Support for super methods.
+    context.create_local_method('super', LocalSpec, [:immediate],
+      &lambda {|vm| vm << 'super(vm); ' })
+
+    #The standard end-compile adapter word: ';' semi-colon.
+    context.create_local_method(';', LocalSpec, [:immediate], &lambda {|vm|
+      vm.clear_cast
+      vm.end_compile_mode([ctrl])
+    })
+  end
+
+  #Determine the type of method being created. This only applies to non-vm
+  #methods as vm methods are all of type VmSpec.
+  #<br>Parameters
+  #*name - The name of the method to be created.
+  #<Returns>
+  #* The class of the spec to be used for this method.
+  def self.name_to_type(name, vm)
+    normal_spec = case name[0]
+    when '.'
+      TosSpec
+
+    when '~'
+      SelfSpec
+
+    when /[0-9A-Z$@#]/
+      error "F10: Invalid name for a method: #{name}"
+
+    else
+      NosSpec
+    end
+
+    vm.get_cast || normal_spec
+  end
+
+  #Compare the new method's spec against the specs of other methods of the
+  #same name. If no specs exist, create one on Object if the new spec is not
+  #a virtual machine spec.
+  #<br>Parameters
+  #*vm - The current virtual machine.
+  #*type - The class of the method to be created.
+  #*name - The name of the method to be created.
+  def self.validate_type(vm, type, name)
+    if (spec = vm.context.map_without_defaults(name))
+      if spec.class != type
+        error "F90: Spec type mismatch #{spec.foorth_name} vs #{type.foorth_name}"
+      end
+    else
+      Object.create_shared_method(name, type, [:stub]) unless type == VmSpec
+    end
+
+  end
+
+  #Check for the case where a string method is created on another class.
+  #<br>Parameters
+  #*type - The class of the method to be created.
+  #*target - The object that is to receive this method.
+  #*name - The name of the method to be created.
+  #<br>Endemic Code Smells
+  #* :reek:ControlParameter -- false positive
+  def self.validate_string_method(type, target, name)
+    if type == TosSpec && name[-1] == '"' && target != String
+      error "F13: Creating a string method #{name} on a #{target.foorth_name}"
+    end
+  end
+
+end