~tim/scheme-vm

ref: 9584a02ae8b83940275762c5c6f4df4948bc80d4 scheme-vm/compiler/libraries.rb -rw-r--r-- 4.0 KiB
9584a02aTim Morgan Implement equivalence semantics for empty lists and pairs 4 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
require_relative '../vm'

class Compiler
  module Libraries
    def do_define_native((name, method_name), options)
      options[:syntax][name] = {
        locals: options[:locals].keys + options[:syntax].keys + [name],
        native_transformer: method_name
      }
      []
    end

    def do_include(paths, relative_to, options)
      paths.map do |path|
        fail "include expects a string, but got #{path.inspect}" unless path =~ /\A"(.+)?"\z/
        filename = "#{$1}.scm"
        sexps = parse_file(filename, relative_to: relative_to)
        compile_sexps(sexps, options: options)
      end
    end

    def do_import((*sets), relative_to, options)
      sets.map do |set|
        import_set(set, relative_to, options)
      end
    end

    def import_set(set, relative_to, options)
      (include, bindings) = import_set_bindings(set, relative_to, options)
      [
        include,
        bindings.map do |(library_name, internal_name, external_name, syntax)|
          if syntax
            options[:syntax][external_name] = syntax
            []
          else
            options[:locals][external_name] = true
            [VM::IMPORT_LIB, library_name, internal_name, external_name]
          end
        end
      ]
    end

    # This method and import_set_all below return an array [include, bindings];
    # bindings is an array that looks like this:
    #
    #     [library_name, internal_binding_name, external_binding_name, syntax]
    #
    # which is shortened as:
    #
    #     [n, i, e, s]
    #
    def import_set_bindings(set, relative_to, options)
      return import_set_all(set, relative_to, options) unless set[1].is_a?(Array)
      (directive, source, *identifiers) = set
      (include, bindings) = import_set_bindings(source, relative_to, options)
      available = bindings.each_with_object({}) { |(n, i, e, s), h| h[e] = [n, i, e, s] }
      case directive
      when 'only'
        bindings = available.values_at(*identifiers)
      when 'except'
        bindings = available.values_at(*(available.keys - identifiers))
      when 'prefix'
        prefix = identifiers.first
        bindings = bindings.map { |(n, i, e, s)| [n, i, prefix + e, s] }
      when 'rename'
        renamed = Hash[identifiers]
        bindings = bindings.map do |name, internal_name, external_name, syntax|
          [name, internal_name, renamed[external_name] || external_name, syntax]
        end
      else
        fail "unknown import directive #{directive}"
      end
      [include, bindings]
    end

    def import_set_all(set, relative_to, _options)
      name = set.join('/')
      isolated_options = { locals: {}, syntax: {} }
      include = include_library_if_needed(name, relative_to, isolated_options)
      [
        include,
        @libs[name][:bindings].map do |external_name, internal_name|
          [
            name,
            internal_name,
            external_name,
            @libs[name][:syntax][internal_name]
          ]
        end
      ]
    end

    def include_library_if_needed(name, relative_to, options)
      return [] if @libs.key?(name)
      do_include(["\"#{name}\""], relative_to, options)
    end

    def do_define_library((name, *declarations), options)
      exports = @libs[name.join('/')] = {
        syntax: {},
        bindings: {}
      }
      begins = []
      declarations.each do |(type, *args)|
        case type
        when 'export'
          exports[:bindings].merge!(library_exports_as_hash(args))
        when 'begin'
          begins += args
        end
      end
      lib_opts = options.merge(use: true, locals: options[:locals].dup, syntax: options[:syntax].dup)
      sexp = [
        VM::SET_LIB, name.join('/'),
        begins.map { |s| compile_sexp(s, lib_opts) },
        VM::ENDL
      ]
      exports[:syntax] = lib_opts[:syntax]
      sexp
    end

    def library_exports_as_hash(exports)
      exports.each_with_object({}) do |export, hash|
        if export.is_a?(Array)
          (_, old_name, new_name) = export
          hash[new_name] = old_name
        else
          hash[export] = export
        end
      end
    end
  end
end