peruby 0.1.0

data/lib/peruby/runtime/match_state.rb

@@ -0,0 +1,62 @@
+# frozen_string_literal: true
+
+module Peruby
+  # Dynamic values exposed by Perl's most recent successful regexp match.
+  class MatchState
+    attr_reader :md, :subject
+
+    def initialize(match_data = nil, subject = '')
+      @md = match_data
+      @subject = subject
+    end
+
+    def fetch(sigil, name)
+      return nil unless @md
+      return scalar(name) if sigil == :scalar && name.match?(/\A(?:\d+|[&`'+])\z/)
+      return offsets(name) if sigil == :array && %w[- +].include?(name)
+      return named(name) if sigil == :hash && %w[- +].include?(name)
+
+      nil
+    end
+
+    private
+
+    def scalar(name)
+      value = case name
+              when '&' then @md&.[](0)
+              when '`' then @md && @subject[0...@md.begin(0)]
+              when "'" then @md && @subject[@md.end(0)..]
+              when '+' then last_capture
+              else @md&.[](name.to_i)
+              end
+      Scalar.new(value)
+    end
+
+    def last_capture
+      @md && @md.captures.reverse.find { |capture| !capture.nil? }
+    end
+
+    def offsets(name)
+      positions = return_positions(name == '-' ? :begin : :end)
+      PerlArray.new(positions.map { |position| Scalar.new(position) })
+    end
+
+    def return_positions(method)
+      return [] unless @md
+
+      (0...@md.length).map { |index| @md.public_send(method, index) || -1 }
+    end
+
+    def named(name)
+      hash = PerlHash.new
+      return hash unless @md
+
+      @md.names.each do |key|
+        captures = @md.regexp.named_captures.fetch(key).map { |index| @md[index] }
+        values = name == '+' ? [captures.reverse.find { |value| !value.nil? }] : captures.compact
+        hash.slot(key).set(name == '+' ? values.first : PerlArray.new(values.map { |value| Scalar.new(value) }))
+      end
+      hash
+    end
+  end
+end

data/lib/peruby/runtime/module_loader.rb

@@ -0,0 +1,133 @@
+# frozen_string_literal: true
+
+# Interpreter namespace.
+module Peruby
+  # Definition collected by Peruby.define_module's small Ruby DSL.
+  class ModuleDefinition
+    attr_reader :exports, :functions
+
+    def initialize
+      @exports = []
+      @functions = {}
+    end
+
+    def export_ok(*names) = @exports.concat(names.map(&:to_s))
+
+    def sub(name, proto: nil, &implementation)
+      @functions[name.to_s] = [proto, implementation]
+    end
+
+    def install(name, runtime)
+      @functions.each do |sub_name, (prototype, implementation)|
+        code = Code.new("#{name}::#{sub_name}", NativeBody.new(&implementation), runtime.env, name, prototype)
+        runtime.stash.glob(code.name).code = code
+      end
+      runtime.stash.touch
+    end
+  end
+
+  # Reentrant require/use loader with user @INC taking precedence.
+  class ModuleLoader
+    INTERNAL_MODULES = %w[
+      strict warnings utf8 feature integer bytes vars lib parent base Exporter constant Carp Scalar::Util List::Util
+      POSIX Data::Dumper Test::Builder Test::More Test::Simple File::Basename File::Spec File::Path File::Temp Cwd
+      Getopt::Long JSON::PP Encode Time::HiRes Digest::MD5 Digest::SHA Storable Fcntl Errno overload mro
+    ].freeze
+
+    @modules = {}
+    class << self
+      attr_reader :modules
+
+      def define(name, &block)
+        return @modules[name] = block unless block.arity.zero?
+
+        definition = ModuleDefinition.new
+        definition.instance_eval(&block)
+        @modules[name] = definition
+      end
+
+      def prototype(module_name, sub_name)
+        implementation = @modules[module_name]
+        implementation.functions.dig(sub_name, 0) if implementation.is_a?(ModuleDefinition)
+      end
+    end
+
+    def initialize(runtime)
+      @runtime = runtime
+      @loading = []
+    end
+
+    def require_module(name)
+      key = filename(name)
+      return 1 if @runtime.stash.glob('INC').hash.exists?(key)
+      raise PerlError, "Recursive require of #{key}" if @loading.include?(key)
+
+      @loading << key
+      kind, content = find(key)
+      source = if kind == :path
+                 load_file(content, key)
+               elsif kind == :source
+                 load_source(content, key)
+               else
+                 load_internal(name, key)
+               end
+      @runtime.stash.glob('INC').hash.slot(key).set(source)
+      1
+    ensure
+      @loading.delete(key) if key
+    end
+
+    private
+
+    def filename(name)
+      value = Conv.to_str(name)
+      value.end_with?('.pl', '.pm') ? value : "#{value.gsub('::', '/')}.pm"
+    end
+
+    def find(filename)
+      @runtime.stash.glob('INC').array.cells.each do |cell|
+        value = cell.get
+        if value.is_a?(String)
+          path = File.expand_path(filename, value)
+          return [:path, path] if File.file?(path)
+        elsif value.is_a?(Ref) && value.kind == 'CODE'
+          source = @runtime.call(value.target, [cell, Scalar.new(filename)], :scalar)
+          source = source.target.get if source.is_a?(Ref) && source.target.is_a?(Scalar)
+          return [:source, Conv.to_str(source)] if source
+        end
+      end
+      nil
+    end
+
+    def load_file(path, key)
+      value = CompileUnit.new(runtime: @runtime, file: path).run(File.read(path), context: :scalar)
+      raise PerlError, "#{key} did not return a true value" unless Conv.truthy?(value)
+
+      path
+    end
+
+    def load_source(source, key)
+      value = CompileUnit.new(runtime: @runtime, file: key).run(source, context: :scalar)
+      raise PerlError, "#{key} did not return a true value" unless Conv.truthy?(value)
+
+      '(INC hook)'
+    end
+
+    def load_internal(name, key)
+      implementation = self.class.modules[Conv.to_str(name)]
+      return '(peruby internal)' if !implementation && INTERNAL_MODULES.include?(Conv.to_str(name))
+      raise PerlError, "Can't locate #{key} in @INC" unless implementation
+
+      if implementation.is_a?(ModuleDefinition)
+        implementation.install(Conv.to_str(name), @runtime)
+      else
+        implementation.call(@runtime)
+      end
+      '(peruby internal)'
+    end
+  end
+
+  def self.define_module(name, &)
+    ModuleLoader.define(name, &)
+  end
+end

data/lib/peruby/runtime/mro.rb

@@ -0,0 +1,94 @@
+# frozen_string_literal: true
+
+module Peruby
+  # Perl package method lookup over runtime @ISA values.
+  class MRO
+    def initialize(stash)
+      @stash = stash
+      @cache = {}
+      @modes = Hash.new(:dfs)
+    end
+
+    def set(package, mode)
+      raise PerlError, "Invalid MRO #{mode}" unless %i[dfs c3].include?(mode.to_sym)
+
+      @modes[package] = mode.to_sym
+      @cache.clear
+    end
+
+    def resolve(package, method, super_from: nil, autoload: true)
+      start = super_from ? parents(super_from) : [package]
+      order = start.flat_map { |candidate| linearized(candidate) }.uniq
+      order << 'UNIVERSAL' unless order.include?('UNIVERSAL')
+      found = order.filter_map { |candidate| method_entry(candidate, method) }.first
+      return found if found
+      return nil if method == 'DESTROY' || !autoload
+
+      autoload = order.filter_map { |candidate| method_entry(candidate, 'AUTOLOAD') }.first
+      if autoload
+        owner, = autoload
+        @stash.glob("#{owner}::AUTOLOAD").scalar.set("#{package}::#{method}")
+      end
+      autoload
+    end
+
+    def isa?(package, parent)
+      package == parent || linearized(package).include?(parent)
+    end
+
+    def lineage(package) = linearized(package)
+
+    private
+
+    def linearized(package)
+      key = [package, @modes[package], signature(package)]
+      @cache[key] ||= @modes[package] == :c3 ? c3(package) : linearize([package])
+    end
+
+    def signature(package, seen = {})
+      return package if seen[package]
+
+      seen[package] = true
+      [package, parents(package).map { |parent| signature(parent, seen) }]
+    end
+
+    def linearize(packages, seen = {})
+      packages.flat_map do |package|
+        next [] if seen[package]
+
+        seen[package] = true
+        [package, *linearize(parents(package), seen)]
+      end
+    end
+
+    def c3(package)
+      direct = parents(package)
+      [package, *merge(direct.map { |parent| c3(parent) } + [direct])]
+    end
+
+    def merge(sequences)
+      result = []
+      sequences = sequences.map(&:dup).reject(&:empty?)
+      until sequences.empty?
+        candidate = sequences.filter_map(&:first).find do |head|
+          sequences.none? { |sequence| sequence.drop(1).include?(head) }
+        end
+        raise PerlError, 'Inconsistent hierarchy during C3 merge' unless candidate
+
+        result << candidate
+        sequences.each { |sequence| sequence.shift if sequence.first == candidate }
+        sequences.reject!(&:empty?)
+      end
+      result
+    end
+
+    def parents(package)
+      @stash.glob("#{package}::ISA").array.cells.map { |cell| Conv.to_str(cell.get) }
+    end
+
+    def method_entry(package, method)
+      code = @stash.fetch("#{package}::#{method}")&.code
+      code && [package, code]
+    end
+  end
+end

data/lib/peruby/runtime/perl_array.rb

@@ -0,0 +1,81 @@
+# frozen_string_literal: true
+
+module Peruby
+  # Perl AV represented as an array of mutable scalar cells.
+  class PerlArray
+    attr_reader :cells
+
+    def initialize(cells = [])
+      @cells = cells
+    end
+
+    def fetch(index)
+      index = normalize(index)
+      return nil if index.negative?
+
+      @cells[index]&.get
+    end
+
+    def slot(index)
+      index = normalize(index)
+      raise PerlError, 'Modification of non-creatable array value' if index.negative?
+
+      @cells.fill(nil, @cells.length...index)
+      @cells[index] ||= Scalar.new
+    end
+
+    def exists?(index)
+      index = normalize(index.to_i)
+      index >= 0 && index < @cells.length && !@cells[index].nil?
+    end
+
+    def delete(index)
+      index = normalize(index.to_i)
+      return nil if index.negative? || index >= @cells.length
+
+      value = @cells[index]&.get
+      @cells[index] = nil
+      @cells.pop while @cells.last.nil?
+      value
+    end
+
+    def size
+      @cells.size
+    end
+
+    def list
+      @cells.each_index.map do |index|
+        @cells[index] || begin
+          cell = Scalar.new { @cells[index] = cell }
+          cell
+        end
+      end
+    end
+
+    def last_index
+      size - 1
+    end
+
+    def last_index=(index)
+      raise PerlError, 'Modification of non-creatable array value' if index < -1
+
+      target_size = index + 1
+      target_size < size ? @cells.slice!(target_size..) : @cells.fill(nil, size...target_size)
+      index
+    end
+
+    def replace_cell(index, cell)
+      index = normalize(index)
+      raise PerlError, 'Modification of non-creatable array value' if index.negative?
+
+      @cells.fill(nil, size...index)
+      @cells[index] = cell
+    end
+
+    private
+
+    def normalize(index)
+      index.negative? ? index + size : index
+    end
+  end
+end

data/lib/peruby/runtime/perl_hash.rb

@@ -0,0 +1,57 @@
+# frozen_string_literal: true
+
+module Peruby
+  # Perl HV represented as string keys and mutable scalar cells.
+  class PerlHash
+    attr_reader :cells
+
+    def initialize(cells = {}, &on_set)
+      @cells = cells
+      @iterator = 0
+      @on_set = on_set
+    end
+
+    def fetch(key)
+      @cells[key.to_s]&.get
+    end
+
+    def slot(key)
+      key = key.to_s
+      unless @cells.key?(key)
+        @iterator = 0
+        @cells[key] = Scalar.new { |value| @on_set&.call(key, value) }
+      end
+      @cells[key]
+    end
+
+    def exists?(key)
+      @cells.key?(key.to_s)
+    end
+
+    def delete(key)
+      @iterator = 0
+      @cells.delete(key.to_s)&.get
+    end
+
+    def keys
+      @iterator = 0
+      @cells.keys
+    end
+
+    def each_pair
+      pair = @cells.to_a[@iterator]
+      @iterator = pair ? @iterator + 1 : 0
+      pair
+    end
+
+    def list
+      @cells.flat_map { |key, cell| [Scalar.new(key), cell] }
+    end
+
+    def replace_cell(key, cell)
+      @iterator = 0
+      key = key.to_s
+      cell ? @cells[key] = cell : @cells.delete(key)
+    end
+  end
+end

data/lib/peruby/runtime/ref.rb

@@ -0,0 +1,43 @@
+# frozen_string_literal: true
+
+require 'weakref'
+
+module Peruby
+  # Perl reference with an optional blessed package.
+  class Ref
+    attr_accessor :blessed, :runtime
+
+    def initialize(target, blessed = nil)
+      @target = target
+      @blessed = blessed
+      @weak = false
+    end
+
+    def target
+      @weak ? @target.__getobj__ : @target
+    rescue WeakRef::RefError
+      nil
+    end
+
+    def weaken!
+      @target = WeakRef.new(@target)
+      @weak = true
+      self
+    end
+
+    def weak? = @weak
+
+    def kind
+      value = target
+      return 'REF' if value.is_a?(Scalar) && value.get.is_a?(Ref)
+
+      kinds = { Scalar => 'SCALAR', PerlArray => 'ARRAY', PerlHash => 'HASH', Glob => 'GLOB',
+                Regexp => 'Regexp', Code => 'CODE' }
+      kinds.fetch(value.class, nil)
+    end
+
+    def ref_string
+      @blessed || kind
+    end
+  end
+end

data/lib/peruby/runtime/regexp_compiler.rb

@@ -0,0 +1,75 @@
+# frozen_string_literal: true
+
+module Peruby
+  # Converts the Perl regexp differences that Ruby's Onigmo does not share.
+  module RegexpCompiler
+    module_function
+
+    def compile(pattern, modifiers = '')
+      @cache ||= {}
+      @cache[[pattern, modifiers]] ||= Regexp.new(*transform(pattern, modifiers))
+    rescue RegexpError => e
+      raise CompileError, e.message
+    end
+
+    def transform(pattern, modifiers = '')
+      raise CompileError, 'Regexp code execution is not supported' if pattern.match?(/\(\?\??\{/)
+
+      pattern = pattern.gsub(/\(\?\^([isx]*):/) { "(?#{Regexp.last_match(1).tr('s', 'm')}:" }
+      source = rewrite(pattern, multiline: modifiers.include?('m'))
+      source = extended_character_classes(source) if modifiers.include?('xx')
+      source = ascii_classes(source) if modifiers.include?('a')
+      options = 0
+      options |= Regexp::IGNORECASE if modifiers.include?('i')
+      options |= Regexp::EXTENDED if modifiers.include?('x')
+      options |= Regexp::MULTILINE if modifiers.include?('s')
+      [source, options]
+    end
+
+    def rewrite(pattern, multiline:)
+      output = +''
+      character_class = false
+      escaped = false
+      pattern.each_char do |character|
+        if escaped
+          output << character
+          escaped = false
+        elsif character == '\\'
+          output << character
+          escaped = true
+        elsif character == '['
+          character_class = true
+          output << character
+        elsif character == ']' && character_class
+          character_class = false
+          output << character
+        elsif !character_class && !multiline && character == '^'
+          output << '\\A'
+        elsif !character_class && !multiline && character == '$'
+          output << '(?=\\n?\\z)'
+        else
+          output << character
+        end
+      end
+      output.gsub('(?R)', '\\g<0>').gsub(/\(\?(\d+)\)/, '\\\\g<\\1>')
+    end
+    private_class_method :rewrite
+
+    def extended_character_classes(pattern)
+      pattern.gsub(/\[(?:\\.|[^\]])*\]/) do |character_class|
+        character_class.gsub(/(?<!\\)\s+|(?<!\\)#.*?(?=\n|\])/, '')
+      end
+    end
+    private_class_method :extended_character_classes
+
+    def ascii_classes(pattern)
+      pattern.gsub(/(?<!\\)((?:\\\\)*)\\([dDwWsS])/) do
+        prefix = Regexp.last_match(1)
+        replacement = { 'd' => '[0-9]', 'D' => '[^0-9]', 'w' => '[A-Za-z0-9_]', 'W' => '[^A-Za-z0-9_]',
+                        's' => '[\\t\\n\\f\\r ]', 'S' => '[^\\t\\n\\f\\r ]' }.fetch(Regexp.last_match(2))
+        prefix + replacement
+      end
+    end
+    private_class_method :ascii_classes
+  end
+end

data/lib/peruby/runtime/scalar.rb

@@ -0,0 +1,27 @@
+# frozen_string_literal: true
+
+module Peruby
+  # Mutable Perl scalar cell. Sharing a cell represents Perl aliasing.
+  class Scalar
+    attr_accessor :value, :pos
+
+    def initialize(value = nil, &on_set)
+      @value = value
+      @on_set = on_set
+    end
+
+    alias get value
+
+    def set(value)
+      @value = value
+      @on_set&.call(value)
+      self
+    end
+
+    def copy
+      self.class.new(@value)
+    end
+  end
+
+  Dualvar = Data.define(:num, :str)
+end

data/lib/peruby/runtime/sprintf.rb

@@ -0,0 +1,54 @@
+# frozen_string_literal: true
+
+module Peruby
+  # Perl-compatible formatting facade with version-vector support.
+  module Sprintf
+    CONVERSION = /%(?:(\d+)\$)?([-+ 0#]*)(\*|\d+)?(?:\.(\*|\d+))?(v[diuoxXbB]?|[sdiuoxXbBeEfgGc%n])/
+
+    module_function
+
+    # rubocop:disable-next Metrics/AbcSize
+    def format(template, values)
+      index = 0
+      template.gsub(CONVERSION) do |directive|
+        match = Regexp.last_match
+        conversion = match[5]
+        raise PerlError, '%n is not supported' if conversion == 'n'
+        next '%' if conversion == '%'
+
+        resolved = directive.dup
+        if match[3] == '*'
+          resolved.sub!('*', Conv.to_num(values[index]).to_i.to_s)
+          index += 1
+        end
+        if match[4] == '*'
+          resolved.sub!('*', Conv.to_num(values[index]).to_i.to_s)
+          index += 1
+        end
+        position = match[1] ? match[1].to_i - 1 : index
+        index += 1 unless match[1]
+        value = values.fetch(position, nil)
+        conversion.start_with?('v') ? version(value, conversion[1] || 'd') : ruby_format(resolved, value)
+      end
+    end
+
+    def version(value, conversion)
+      Conv.to_str(value).codepoints.map { |point| Kernel.format("%#{conversion}", point) }.join('.')
+    end
+
+    def ruby_format(directive, value)
+      conversion = directive[-1]
+      coerced = if conversion == 's'
+                  Conv.to_str(value)
+                elsif conversion.match?(/[eEfgG]/)
+                  Conv.to_num(value).to_f
+                else
+                  integer = Conv.to_num(value).to_i
+                  conversion.match?(/[uoxXbB]/) ? integer & ((1 << 64) - 1) : integer
+                end
+      Kernel.format(directive.sub(/%\d+\$/, '%'), coerced)
+    rescue ArgumentError, TypeError
+      ''
+    end
+  end
+end

data/lib/peruby/runtime/stash.rb

@@ -0,0 +1,50 @@
+# frozen_string_literal: true
+
+module Peruby
+  # Rooted Perl package symbol table.
+  class Stash
+    attr_reader :generation
+
+    def initialize
+      @packages = Hash.new { |packages, name| packages[name] = {} }
+      @names = {}
+      @generation = 0
+    end
+
+    def glob(name)
+      package, symbol = split(name)
+      @packages[package][symbol] ||= begin
+        @generation += 1
+        Glob.new("#{package}::#{symbol}")
+      end
+    end
+
+    def fetch(name)
+      package, symbol = split(name)
+      @packages[package][symbol]
+    end
+
+    def symbols(package = 'main')
+      @packages[normalize_package(package)].dup
+    end
+
+    def touch
+      @generation += 1
+    end
+
+    private
+
+    def split(name)
+      value = name.to_s
+      return @names[value] if @names.key?(value)
+
+      parts = value.gsub("'", '::').split('::').reject(&:empty?)
+      symbol = parts.pop
+      @names[value] = [normalize_package(parts.join('::')), symbol]
+    end
+
+    def normalize_package(package)
+      package.empty? || package == 'main' ? 'main' : package.delete_suffix('::')
+    end
+  end
+end