Pass the correct symbol table to variable traverser

This reverts commit 18602d00a1.

.gitignore

@@ -1 +1,2 @@
 /build/
+a.out

.ruby-version

@@ -1 +0,0 @@
-3.3.6

Rakefile

@@ -1,182 +1,43 @@
 # This Source Code Form is subject to the terms of the Mozilla Public License,
 # v. 2.0. If a copy of the MPL was not distributed with this file, You can
-# obtain one at https://mozilla.org/MPL/2.0/. -}
+# obtain one at https://mozilla.org/MPL/2.0/.
 
 require 'pathname'
-require 'open3'
 require 'rake/clean'
-require_relative 'tools/support'
 
-# Dependencies.
-GCC_VERSION = "14.2.0"
-GCC_PATCH = 'https://raw.githubusercontent.com/Homebrew/formula-patches/f30c309442a60cfb926e780eae5d70571f8ab2cb/gcc/gcc-14.2.0-r2.diff'
-
-# Paths.
-HOST_GCC = TMP + 'host/gcc'
+TMP = Pathname.new('./build')
 HOST_INSTALL = TMP + 'host/install'
 
 CLOBBER.include TMP
+CLEAN.include(TMP + 'boot')
 
-directory(TMP + 'tools')
-directory HOST_GCC
 directory HOST_INSTALL
 
-task default: [TMP + 'elna'] do
-  sh (TMP + 'elna').to_path, '--tokenize', 'source.elna'
+task default: ['source/main.elna', TMP + 'boot/elna'] do |t|
+  sources, compiler  = t.prerequisites.partition { |f| f.end_with? '.elna' }
+
+  sh *compiler, '--parse', *sources
 end
 
-namespace :boot do
-  desc 'Download and configure the bootstrap compiler'
-  task configure: [TMP + 'tools', HOST_GCC, HOST_INSTALL] do
-    url = URI.parse "https://gcc.gnu.org/pub/gcc/releases/gcc-#{GCC_VERSION}/gcc-#{GCC_VERSION}.tar.xz"
-    options = find_build_target GCC_VERSION
-    source_directory = TMP + "tools/gcc-#{GCC_VERSION}"
-    frontend_link = source_directory + 'gcc'
+rule(/boot\/.+\.o$/ => ->(file) {
+  source = Pathname.new('source') +
+    Pathname.new(file).relative_path_from(TMP + 'boot').sub_ext('.elna')
 
-    download_and_pipe url, source_directory.dirname, ['tar', '-Jxv']
-    download_and_pipe URI.parse(GCC_PATCH), source_directory, ['patch', '-p1']
+  [HOST_INSTALL + 'bin/gelna', source]
+}) do |t|
+  Pathname.new(t.name).dirname.mkpath
+  sources, compiler = t.prerequisites.partition { |source| source.end_with? '.elna' }
 
-    sh 'contrib/download_prerequisites', chdir: source_directory.to_path
-    File.symlink Pathname.new('.').relative_path_from(frontend_link), (frontend_link + 'elna')
-
-    configure_options = [
-      "--prefix=#{HOST_INSTALL.realpath}",
-      "--with-sysroot=#{options.sysroot.realpath}",
-      '--enable-languages=c,c++,elna',
-      '--disable-bootstrap',
-      '--disable-multilib',
-      "--target=#{options.build}",
-      "--build=#{options.build}",
-      "--host=#{options.build}"
-    ]
-    flags = '-O2 -fPIC -I/opt/homebrew/Cellar/flex/2.6.4_2/include'
-    env = {
-      'CC' => options.gcc,
-      'CXX' => options.gxx,
-      'CFLAGS' => flags,
-      'CXXFLAGS' => flags,
-    }
-    configure = source_directory.relative_path_from(HOST_GCC) + 'configure'
-    sh env, configure.to_path, *configure_options, chdir: HOST_GCC.to_path
+  sh *compiler, '-c', '-O0', '-g', '-o', t.name, *sources
 end
 
-  desc 'Make and install the bootstrap compiler'
-  task :make do
-    cwd = HOST_GCC.to_path
+file TMP + 'boot/elna' => FileList['source/**/*.elna'].reject { |file|
+  file != file.downcase
+}.map { |file|
+  TMP + 'boot' +
+    Pathname.new(file).relative_path_from('source').sub_ext('.o')
+} do |t|
+  compiler = HOST_INSTALL + 'bin/gcc'
 
-    sh 'make', '-j', Etc.nprocessors.to_s, chdir: cwd
-    sh 'make', 'install', chdir: cwd
-  end
-end
-
-desc 'Build the bootstrap compiler'
-task boot: %w[boot:configure boot:make]
-
-file (TMP + 'elna').to_path => ['source.elna']
-file (TMP + 'elna').to_path => [(HOST_INSTALL + 'bin/gelna').to_path] do |task|
-  sh (HOST_INSTALL + 'bin/gelna').to_path, '-o', task.name, task.prerequisites.first
-end
-
-namespace :cross do
-  desc 'Build cross toolchain'
-  task :init, [:target] do |_, args|
-    args.with_defaults target: 'riscv32-unknown-linux-gnu'
-
-    options = find_build_target GCC_VERSION, args[:target]
-    env = {
-      'PATH' => "#{options.rootfs.realpath + 'bin'}:#{ENV['PATH']}"
-    }
-    sh env, 'riscv32-unknown-linux-gnu-gcc',
-      '-ffreestanding', '-static',
-      '-o', (options.tools + 'init').to_path,
-      'tools/init.c'
-  end
-end
-
-namespace :test do
-  test_sources = FileList['tests/vm/*.elna', 'tests/vm/*.s']
-  compiler = TMP + 'bin/elna'
-  object_directory = TMP + 'riscv/tests'
-  root_directory = TMP + 'riscv/root'
-  executable_directory = root_directory + 'tests'
-  expectation_directory = root_directory + 'expectations'
-  init = TMP + 'riscv/root/init'
-  builtin = TMP + 'riscv/builtin.o'
-
-  directory root_directory
-  directory object_directory
-  directory executable_directory
-  directory expectation_directory
-
-  file builtin => ['tools/builtin.s', object_directory] do |task|
-    sh AS, '-o', task.name, task.prerequisites.first
-  end
-
-  test_files = test_sources.flat_map do |test_source|
-    test_basename = File.basename(test_source, '.*')
-    test_object = object_directory + test_basename.ext('.o')
-
-    file test_object => [test_source, object_directory] do |task|
-      case File.extname(task.prerequisites.first)
-      when '.s'
-        sh AS, '-mno-relax', '-o', task.name, task.prerequisites.first
-      when '.elna'
-        sh compiler, '--output', task.name, task.prerequisites.first
-      else
-        raise "Unknown source file extension #{task.prerequisites.first}"
-      end
-    end
-    test_executable = executable_directory + test_basename
-
-    file test_executable => [test_object, executable_directory, builtin] do |task|
-      objects = task.prerequisites.filter { |prerequisite| File.file? prerequisite }
-
-      sh LINKER, '-o', test_executable.to_path, *objects
-    end
-    expectation_name = test_basename.ext '.txt'
-    source_expectation = "tests/expectations/#{expectation_name}"
-    target_expectation = expectation_directory + expectation_name
-
-    file target_expectation => [source_expectation, expectation_directory] do
-      cp source_expectation, target_expectation
-    end
-
-    [test_executable, target_expectation]
-  end
-
-  file init => [root_directory] do |task|
-    cp (TMP + 'tools/init'), task.name
-  end
-  # Directories should come first.
-  test_files.unshift executable_directory, expectation_directory, init
-
-  file (TMP + 'riscv/root.cpio') => test_files do |task|
-    root_files = task.prerequisites
-      .map { |prerequisite| Pathname.new(prerequisite).relative_path_from(root_directory).to_path }
-
-    File.open task.name, 'wb' do |cpio_file|
-      cpio_options = {
-        chdir: root_directory.to_path
-      }
-      cpio_stream = Open3.popen2 'cpio', '-o', '--format=newc', cpio_options do |stdin, stdout, wait_thread|
-        stdin.write root_files.join("\n")
-        stdin.close
-        stdout.each { |chunk| cpio_file.write chunk }
-        wait_thread.value
-      end
-    end
-  end
-
-  task :vm => (TMP + 'riscv/root.cpio') do |task|
-    kernels = FileList.glob(TMP + 'tools/linux-*/arch/riscv/boot/Image')
-
-    sh 'qemu-system-riscv32',
-      '-nographic',
-      '-M', 'virt',
-      '-bios', 'default',
-      '-kernel', kernels.first,
-      '-append', 'quiet panic=1',
-      '-initrd', task.prerequisites.first,
-      '-no-reboot'
-  end
+  sh compiler.to_path, '-o', t.name, *t.prerequisites
 end

boot/dependency.cc

@@ -0,0 +1,62 @@
+/* Dependency graph analysis.
+   Copyright (C) 2025 Free Software Foundation, Inc.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "elna/boot/dependency.h"
+
+#include "elna/boot/driver.h"
+#include "parser.hh"
+
+namespace elna::boot
+{
+    dependency_graph::dependency_graph()
+    {
+    }
+
+    dependency_graph::dependency_graph(error_list&& errors)
+        : m_errors(std::move(errors))
+    {
+    }
+
+    bool dependency_graph::has_errors() const
+    {
+        return !errors().empty();
+    }
+
+    const error_list& dependency_graph::errors() const
+    {
+        return m_errors;
+    }
+
+    dependency_graph read_sources(std::istream& entry_point, const char *entry_path)
+    {
+        driver parse_driver{ entry_path };
+        lexer tokenizer(entry_point);
+        yy::parser parser(tokenizer, parse_driver);
+
+        if (parser())
+        {
+            return dependency_graph(std::move(parse_driver.errors()));
+        }
+        else
+        {
+            dependency_graph outcome;
+            outcome.modules.emplace_back(std::move(parse_driver.tree));
+
+            return outcome;
+        }
+    }
+}

boot/driver.cc

@@ -17,9 +17,7 @@ along with GCC; see the file COPYING3.  If not see
 
 #include "elna/boot/driver.h"
 
-namespace elna
-{
-namespace boot
+namespace elna::boot
 {
     position make_position(const yy::location& location)
     {
@@ -42,20 +40,10 @@ namespace boot
     }
 
     driver::driver(const char *input_file)
-        : input_file(input_file)
+        : error_container(input_file)
     {
     }
 
-    void driver::error(const yy::location& loc, const std::string& message)
-    {
-        m_errors.emplace_back(new boot::syntax_error(message, input_file, loc));
-    }
-
-    const std::list<std::unique_ptr<struct error>>& driver::errors() const noexcept
-    {
-        return m_errors;
-    }
-
     char escape_char(char escape)
     {
         switch (escape)
@@ -88,5 +76,49 @@ namespace boot
             return escape_invalid_char;
         }
     }
+
+    std::optional<std::string> escape_string(const char *escape)
+    {
+        std::string result;
+        const char *current_position = escape + 1;
+
+        while (*current_position != '\0')
+        {
+            if (*current_position == '\\' && *(current_position + 1) == 'x')
+            {
+                current_position += 2;
+
+                std::size_t processed;
+                char character = static_cast<char>(std::stoi(current_position, &processed, 16));
+                if (processed == 0)
+                {
+                    return std::nullopt;
+                }
+                else
+                {
+                    current_position += processed - 1;
+                    result.push_back(character);
+                }
+            }
+            else if (*current_position == '\\')
+            {
+                ++current_position;
+
+                char escape = escape_char(*current_position);
+                if (escape == escape_invalid_char)
+                {
+                    return std::nullopt;
+                }
+                result.push_back(escape);
+            }
+            else
+            {
+                result.push_back(*current_position);
+            }
+            ++current_position;
+        }
+        result.pop_back();
+
+        return result;
     }
 }

boot/lexer.ll

@@ -23,12 +23,12 @@ along with GCC; see the file COPYING3.  If not see
 #include "parser.hh"
 
 #undef YY_DECL
-#define YY_DECL yy::parser::symbol_type elna::boot::lexer::lex(elna::boot::driver& driver)
+#define YY_DECL yy::parser::symbol_type elna::boot::lexer::lex(driver& driver)
 #define yyterminate() return yy::parser::make_YYEOF(this->location)
 %}
 
 %option c++ noyywrap never-interactive
-%option yyclass="elna::boot::lexer"
+%option yyclass="lexer"
 
 %x IN_COMMENT
 
@@ -89,12 +89,6 @@ const                   {
 var                     {
                             return yy::parser::make_VAR(this->location);
                         }
-array                   {
-                            return yy::parser::make_ARRAY(this->location);
-                        }
-of                      {
-                            return yy::parser::make_OF(this->location);
-                        }
 type                    {
                             return yy::parser::make_TYPE(this->location);
                         }
@@ -104,12 +98,6 @@ record                  {
 union                   {
                             return yy::parser::make_UNION(this->location);
                         }
-pointer                 {
-                            return yy::parser::make_POINTER(this->location);
-                        }
-to                      {
-                            return yy::parser::make_TO(this->location);
-                        }
 true                    {
                             return yy::parser::make_BOOLEAN(true, this->location);
                         }
@@ -119,7 +107,7 @@ false                   {
 nil                     {
                             return yy::parser::make_NIL(this->location);
                         }
-and                     {
+\&                      {
                             return yy::parser::make_AND(this->location);
                         }
 xor                     {
@@ -128,21 +116,42 @@ xor                     {
 or                     {
                             return yy::parser::make_OR(this->location);
                         }
-not                     {
+\|                      {
+                            return yy::parser::make_PIPE(this->location);
+                        }
+\~                      {
                             return yy::parser::make_NOT(this->location);
                         }
 return                  {
                             return yy::parser::make_RETURN(this->location);
                         }
+module                  {
+                            return yy::parser::make_MODULE(this->location);
+                        }
+program                 {
+                            return yy::parser::make_PROGRAM(this->location);
+                        }
+import                  {
+                            return yy::parser::make_IMPORT(this->location);
+                        }
 cast                    {
                             return yy::parser::make_CAST(this->location);
                         }
 defer                   {
                             return yy::parser::make_DEFER(this->location);
                         }
+case                    {
+                            return yy::parser::make_CASE(this->location);
+                        }
+of                      {
+                            return yy::parser::make_OF(this->location);
+                        }
 [A-Za-z_][A-Za-z0-9_]*  {
                             return yy::parser::make_IDENTIFIER(yytext, this->location);
                         }
+#[A-Za-z_][A-Za-z0-9_]* {
+                            return yy::parser::make_TRAIT(yytext + 1, this->location);
+                        }
 [0-9]+u                 {
                             return yy::parser::make_WORD(strtoul(yytext, NULL, 10), this->location);
                         }
@@ -168,7 +177,7 @@ defer                   {
                             return yy::parser::make_CHARACTER(std::string(&character, 1), this->location);
                         }
 '\\[0nabtfrv\\'"?]'     {
-                            char escape = elna::boot::escape_char(yytext[2]);
+                            char escape = escape_char(yytext[2]);
                             if (escape == escape_invalid_char)
                             {
                                 REJECT;
@@ -176,46 +185,12 @@ defer                   {
                             return yy::parser::make_CHARACTER(std::string(&escape, 1), this->location);
                         }
 \"[[:print:]]*\"        {
-                            std::string result;
-                            const char *current_position = yytext + 1;
-
-                            while (*current_position != '\0')
-                            {
-                                if (*current_position == '\\' && *(current_position + 1) == 'x')
-                                {
-                                    current_position += 2;
-
-                                    std::size_t processed;
-                                    char character = static_cast<char>(std::stoi(current_position, &processed, 16));
-                                    if (processed == 0)
+                            std::optional<std::string> result = escape_string(yytext);
+                            if (!result.has_value())
                             {
                                 REJECT;
                             }
-                                    else
-                                    {
-                                        current_position += processed - 1;
-                                        result.push_back(character);
-                                    }
-                                }
-                                else if (*current_position == '\\')
-                                {
-                                    ++current_position;
-
-                                    char escape = elna::boot::escape_char(*current_position);
-                                    if (escape == elna::boot::escape_invalid_char)
-                                    {
-                                        REJECT;
-                                    }
-                                    result.push_back(escape);
-                                }
-                                else
-                                {
-                                    result.push_back(*current_position);
-                                }
-                                ++current_position;
-                            }
-                            result.pop_back();
-                            return yy::parser::make_STRING(result, this->location);
+                            return yy::parser::make_STRING(result.value(), this->location);
                         }
 \(                      {
                             return yy::parser::make_LEFT_PAREN(this->location);
@@ -292,10 +267,13 @@ defer                   {
 @                       {
                             return yy::parser::make_AT(this->location);
                         }
+!                       {
+                            return yy::parser::make_EXCLAMATION(this->location);
+                        }
 .                       {
                             std::stringstream ss;
 
                             ss << "Illegal character 0x" << std::hex << static_cast<unsigned int>(yytext[0]);
-                            driver.error(this->location, ss.str());
+                            driver.add_error<syntax_error>(ss.str(), driver.input_file, this->location);
                         }
 %%

boot/parser.yy

@@ -18,6 +18,10 @@ along with GCC; see the file COPYING3.  If not see
 %require "3.4"
 %language "c++"
 
+%code {
+    using namespace elna;
+}
+
 %code requires {
     #include <cstdint>
     #include <iostream>
@@ -52,7 +56,7 @@ along with GCC; see the file COPYING3.  If not see
         {
         }
 
-        yy::parser::symbol_type lex(elna::boot::driver& driver);
+        yy::parser::symbol_type lex(driver& driver);
     };
 
     }
@@ -74,430 +78,517 @@ along with GCC; see the file COPYING3.  If not see
 }
 %start program;
 
-%token <std::string> IDENTIFIER "identifier"
-%token <std::int32_t> INTEGER "integer"
-%token <std::uint32_t> WORD "word"
-%token <float> FLOAT "float"
-%token <std::string> CHARACTER "character"
-%token <std::string> STRING "string"
+%token <std::string> IDENTIFIER
+%token <std::string> TRAIT
+%token <std::int32_t> INTEGER
+%token <std::uint32_t> WORD
+%token <float> FLOAT
+%token <std::string> CHARACTER
+%token <std::string> STRING
 %token <bool> BOOLEAN
-%token IF WHILE DO THEN ELSE ELSIF RETURN
-%token CONST VAR PROCEDURE ARRAY OF TYPE RECORD POINTER TO UNION
-%token BEGIN_BLOCK END_BLOCK EXTERN DEFER
-%token LEFT_PAREN RIGHT_PAREN LEFT_SQUARE RIGHT_SQUARE SEMICOLON DOT COMMA
-%token AND OR NOT CAST SHIFT_LEFT SHIFT_RIGHT
-%token GREATER_EQUAL LESS_EQUAL LESS_THAN GREATER_THAN NOT_EQUAL EQUALS
-%token PLUS MINUS MULTIPLICATION DIVISION REMAINDER
-%token ASSIGNMENT COLON HAT AT NIL ARROW
+%token LEFT_PAREN "(" RIGHT_PAREN ")" LEFT_SQUARE "[" RIGHT_SQUARE "]"
+%token ASSIGNMENT ":="
+    ARROW "->" EXCLAMATION "!"
+    AT "@" HAT "^"
+    COLON ":" SEMICOLON ";" DOT "." COMMA ","
+%token NOT "~"
+    CAST "cast"
+    NIL "nil"
+    CONST "const"
+    VAR "var"
+    PROCEDURE "proc"
+    TYPE "type"
+    RECORD "record"
+    UNION "union"
+    EXTERN "extern"
+    IF "if"
+    WHILE "while"
+    DO "do"
+    THEN "then"
+    ELSE "else"
+    ELSIF "elsif"
+    RETURN "return"
+    PROGRAM "program"
+    MODULE "module"
+    IMPORT "import"
+    BEGIN_BLOCK "begin"
+    END_BLOCK "end"
+    DEFER "defer"
+    CASE "case"
+    OF "of"
+    PIPE "|"
+%token OR "or" AND "&" XOR "xor"
+    EQUALS "=" NOT_EQUAL "<>" LESS_THAN "<" GREATER_THAN ">" LESS_EQUAL "<=" GREATER_EQUAL ">="
+    SHIFT_LEFT "<<" SHIFT_RIGHT ">>"
+    PLUS "+" MINUS "-"
+    MULTIPLICATION "*" DIVISION "/" REMAINDER "%"
 
-%left OR AND XOR
-%left EQUALS NOT_EQUAL LESS_THAN GREATER_THAN LESS_EQUAL GREATER_EQUAL
-%left PLUS MINUS
-%left MULTIPLICATION DIVISION REMAINDER
+%left "or" "&" "xor"
+%left "=" "<>" "<" ">" "<=" ">="
+%left "<<" ">>"
+%left "+" "-"
+%left "*" "/" "%"
 
-%type <elna::boot::literal *> literal;
-%type <elna::boot::constant_definition *> constant_definition;
-%type <std::vector<elna::boot::constant_definition *>> constant_part constant_definitions;
-%type <elna::boot::variable_declaration *> variable_declaration;
-%type <std::vector<elna::boot::variable_declaration *>> variable_declarations variable_part
-    formal_parameter_list;
-%type <elna::boot::top_type *> type_expression;
-%type <elna::boot::expression *> expression operand unary;
+%type <elna::boot::literal_expression *> literal;
+%type <std::vector<elna::boot::expression *>> case_labels;
+%type <elna::boot::switch_case> switch_case;
+%type <std::vector<elna::boot::switch_case>> switch_cases;
+%type <elna::boot::constant_declaration *> constant_declaration;
+%type <std::vector<elna::boot::constant_declaration *>> constant_part constant_declarations;
+%type <std::vector<elna::boot::variable_declaration *>> variable_declarations variable_part variable_declaration;
+%type <elna::boot::type_expression *> type_expression;
+%type <std::vector<elna::boot::type_expression *>> type_expressions;
+%type <elna::boot::traits_expression *> traits_expression;
+%type <elna::boot::expression *> expression operand simple_expression;
+%type <elna::boot::unary_expression *> unary_expression;
+%type <elna::boot::binary_expression *> binary_expression;
 %type <std::vector<elna::boot::expression *>> expressions actual_parameter_list;
 %type <elna::boot::designator_expression *> designator_expression;
-%type <elna::boot::assign_statement *> assign_statement;
-%type <elna::boot::call_expression *> call_expression;
-%type <elna::boot::while_statement *> while_statement;
-%type <elna::boot::if_statement *> if_statement;
+%type <elna::boot::procedure_call*> call_expression;
 %type <elna::boot::return_statement *> return_statement;
 %type <elna::boot::statement *> statement;
-%type <std::vector<elna::boot::statement *>> statements optional_statements;
-%type <elna::boot::procedure_definition *> procedure_definition procedure_heading;
-%type <std::vector<elna::boot::procedure_definition *>> procedure_definitions procedure_part;
-%type <elna::boot::type_definition *> type_definition;
-%type <std::vector<elna::boot::type_definition *>> type_definitions type_part;
-%type <elna::boot::block *> block;
-%type <std::pair<std::string, elna::boot::top_type *>> field_declaration;
-%type <std::vector<std::pair<std::string, elna::boot::top_type *>>> field_list;
-%type <std::vector<elna::boot::conditional_statements *>> elsif_statement_list;
+%type <std::vector<elna::boot::statement *>> required_statements optional_statements statement_part;
+%type <elna::boot::procedure_declaration *> procedure_declaration;
+%type <std::pair<std::vector<std::string>, elna::boot::procedure_type_expression *>> procedure_heading;
+%type <elna::boot::procedure_type_expression::return_t> return_declaration;
+%type <std::vector<elna::boot::procedure_declaration *>> procedure_declarations procedure_part;
+%type <elna::boot::type_declaration *> type_declaration;
+%type <std::vector<elna::boot::type_declaration *>> type_declarations type_part;
+%type <std::unique_ptr<elna::boot::block>> block;
+%type <elna::boot::field_declaration> field_declaration formal_parameter;
+%type <std::vector<std::pair<std::string, elna::boot::type_expression *>>>
+    optional_fields required_fields formal_parameters formal_parameter_list;
+%type <std::vector<elna::boot::conditional_statements *>> elsif_then_statements elsif_do_statements;
+%type <std::vector<elna::boot::statement *> *> else_statements;
 %type <elna::boot::cast_expression *> cast_expression;
-%type <elna::boot::defer_statement *> defer_statement;
-%type <std::pair<std::string, bool>> identifier_definition;
+%type <elna::boot::identifier_definition> identifier_definition;
+%type <std::vector<elna::boot::identifier_definition>> identifier_definitions;
+%type <std::vector<std::string>> identifiers import_declaration;
+%type <std::vector<elna::boot::import_declaration *>> import_declarations import_part;
 %%
 program:
-    constant_part type_part variable_part procedure_part BEGIN_BLOCK optional_statements END_BLOCK DOT
+    "program" ";" import_part constant_part type_part variable_part procedure_part statement_part "end" "."
         {
-            auto tree = new elna::boot::program(elna::boot::make_position(@5));
+            auto tree = new boot::program(boot::make_position(@1));
 
-            std::swap(tree->constants, $1);
-            std::swap(tree->types , $2);
-            std::swap(tree->variables, $3);
-            std::swap(tree->procedures, $4);
-            std::swap(tree->body, $6);
+            std::swap(tree->imports, $3);
+            std::swap(tree->constants, $4);
+            std::swap(tree->types , $5);
+            std::swap(tree->variables, $6);
+            std::swap(tree->procedures, $7);
+            std::swap(tree->body, $8);
 
             driver.tree.reset(tree);
         }
-block: constant_part variable_part BEGIN_BLOCK optional_statements END_BLOCK
+    | "module" ";" import_part constant_part type_part variable_part procedure_part "end" "."
         {
-            $$ = new elna::boot::block(elna::boot::make_position(@3));
+            auto tree = new boot::program(boot::make_position(@1));
 
-            std::swap($$->constants, $1);
-            std::swap($$->variables, $2);
-            std::swap($$->body, $4);
+            std::swap(tree->imports, $3);
+            std::swap(tree->constants, $4);
+            std::swap(tree->types , $5);
+            std::swap(tree->variables, $6);
+            std::swap(tree->procedures, $7);
+
+            driver.tree.reset(tree);
+        }
+block: constant_part variable_part statement_part "end"
+        {
+            $$ = std::make_unique<boot::block>(std::move($1), std::move($2), std::move($3));
+        }
+statement_part:
+    /* no statements */ {}
+    | "begin" required_statements { std::swap($$, $2); }
+    | return_statement { $$.push_back($1); }
+    | "begin" required_statements ";" return_statement
+        {
+            std::swap($$, $2);
+            $$.push_back($4);
         }
 identifier_definition:
-    IDENTIFIER MULTIPLICATION
+    IDENTIFIER "*" { $$ = boot::identifier_definition{ $1, true }; }
+    | IDENTIFIER { $$ = boot::identifier_definition{ $1, false }; }
+identifier_definitions:
+    identifier_definition "," identifier_definitions
         {
-            $$ = std::make_pair($1, true);
+            std::swap($$, $3);
+            $$.emplace($$.cbegin(), $1);
         }
-    | IDENTIFIER
+    | identifier_definition { $$.emplace_back(std::move($1)); }
+return_declaration:
+    /* proper procedure */ {}
+    | "->" "!" { $$ = boot::procedure_type_expression::return_t(std::monostate{}); }
+    | "->" type_expression { $$ = boot::procedure_type_expression::return_t($2); }
+procedure_heading: formal_parameter_list return_declaration
         {
-            $$ = std::make_pair($1, false);
-        }
-procedure_heading:
-    PROCEDURE identifier_definition formal_parameter_list SEMICOLON
+            $$.second = new boot::procedure_type_expression(boot::make_position(@1), std::move($2));
+            for (auto& [name, type] : $1)
             {
-            $$ = new elna::boot::procedure_definition(elna::boot::make_position(@1),
-                 $2.first, $2.second);
-            std::swap($3, $$->parameters);
+                $$.first.emplace_back(std::move(name));
+                $$.second->parameters.push_back(type);
             }
-    | PROCEDURE identifier_definition formal_parameter_list ARROW type_expression SEMICOLON
+        }
+procedure_declaration:
+    "proc" identifier_definition procedure_heading ";" block ";"
         {
-            $$ = new elna::boot::procedure_definition(elna::boot::make_position(@1),
-                 $2.first, $2.second, $5);
-            std::swap($3, $$->parameters);
+            $$ = new boot::procedure_declaration(boot::make_position(@1), std::move($2), $3.second, std::move(*$5));
+            std::swap($3.first, $$->parameter_names);
         }
-procedure_definition:
-    procedure_heading block { $$ = $1->add_body($2); }
-    | procedure_heading EXTERN { $$ = $1; }
-procedure_definitions:
-    procedure_definition procedure_definitions
+    | "proc" identifier_definition procedure_heading ";" "extern" ";"
+        {
+            $$ = new boot::procedure_declaration(boot::make_position(@1), std::move($2), $3.second);
+            std::swap($3.first, $$->parameter_names);
+        }
+procedure_declarations:
+    procedure_declaration procedure_declarations
         {
             std::swap($$, $2);
             $$.emplace($$.cbegin(), std::move($1));
         }
-    | procedure_definition { $$.emplace_back(std::move($1)); }
+    | procedure_declaration { $$.emplace_back(std::move($1)); }
 procedure_part:
     /* no procedure definitions */ {}
-    | procedure_definitions { std::swap($$, $1); }
-assign_statement: designator_expression ASSIGNMENT expression
+    | procedure_declarations { std::swap($$, $1); }
+call_expression: designator_expression actual_parameter_list
         {
-            $$ = new elna::boot::assign_statement(elna::boot::make_position(@1), $1, $3);
+            $$ = new boot::procedure_call(boot::make_position(@1), $1);
+            std::swap($$->arguments, $2);
         }
-call_expression: IDENTIFIER actual_parameter_list
+cast_expression: "cast" "(" expression ":" type_expression ")"
+        { $$ = new boot::cast_expression(boot::make_position(@1), $5, $3); }
+elsif_do_statements:
+    "elsif" expression "do" optional_statements elsif_do_statements
         {
-            $$ = new elna::boot::call_expression(elna::boot::make_position(@1), $1);
-            std::swap($$->arguments(), $2);
-        }
-cast_expression: CAST LEFT_PAREN expression COLON type_expression RIGHT_PAREN
-        {
-            $$ = new elna::boot::cast_expression(elna::boot::make_position(@1), $5, $3);
-        }
-while_statement: WHILE expression DO optional_statements END_BLOCK
-        {
-            auto body = new elna::boot::conditional_statements($2);
-            std::swap($4, body->statements);
-            $$ = new elna::boot::while_statement(elna::boot::make_position(@1), body);
-        }
-elsif_statement_list:
-    ELSIF expression THEN optional_statements elsif_statement_list
-        {
-            elna::boot::conditional_statements *branch = new elna::boot::conditional_statements($2);
-            std::swap(branch->statements, $4);
+            boot::conditional_statements *branch = new boot::conditional_statements($2, std::move($4));
             std::swap($5, $$);
             $$.emplace($$.begin(), branch);
         }
     | {}
-if_statement:
-    IF expression THEN optional_statements elsif_statement_list END_BLOCK
+else_statements:
+    "else" optional_statements { $$ = new std::vector<boot::statement *>(std::move($2)); }
+    | { $$ = nullptr; }
+elsif_then_statements:
+    "elsif" expression "then" optional_statements elsif_then_statements
         {
-            auto then = new elna::boot::conditional_statements($2);
-            std::swap($4, then->statements);
-            $$ = new elna::boot::if_statement(elna::boot::make_position(@1), then);
-            std::swap($5, $$->branches);
-        }
-    | IF expression THEN optional_statements elsif_statement_list ELSE optional_statements END_BLOCK
-        {
-            auto then = new elna::boot::conditional_statements($2);
-            std::swap($4, then->statements);
-            auto _else = new std::vector<elna::boot::statement *>(std::move($7));
-            $$ = new elna::boot::if_statement(elna::boot::make_position(@1), then, _else);
-            std::swap($5, $$->branches);
-        }
-return_statement: RETURN expression
-        {
-            $$ = new elna::boot::return_statement(elna::boot::make_position(@1), $2);
-        }
-defer_statement: DEFER optional_statements END_BLOCK
-        {
-            $$ = new elna::boot::defer_statement(elna::boot::make_position(@1));
-            std::swap($2, $$->statements);
+            boot::conditional_statements *branch = new boot::conditional_statements($2, std::move($4));
+            std::swap($5, $$);
+            $$.emplace($$.begin(), branch);
         }
+    | {}
+return_statement: "return" expression
+        { $$ = new boot::return_statement(boot::make_position(@1), $2); }
 literal:
-    INTEGER
+    INTEGER { $$ = new boot::literal<std::int32_t>(boot::make_position(@1), $1); }
+    | WORD { $$ = new boot::literal<std::uint32_t>(boot::make_position(@1), $1); }
+    | FLOAT { $$ = new boot::literal<double>(boot::make_position(@1), $1); }
+    | BOOLEAN { $$ = new boot::literal<bool>(boot::make_position(@1), $1); }
+    | CHARACTER { $$ = new boot::literal<unsigned char>(boot::make_position(@1), $1.at(0)); }
+    | "nil" { $$ = new boot::literal<std::nullptr_t>(boot::make_position(@1), nullptr); }
+    | STRING { $$ = new boot::literal<std::string>(boot::make_position(@1), $1); }
+traits_expression:
+    TRAIT "(" type_expressions ")"
         {
-            $$ = new elna::boot::number_literal<std::int32_t>(elna::boot::make_position(@1), $1);
+            $$ = new boot::traits_expression(boot::make_position(@1), $1);
+            std::swap($3, $$->parameters);
         }
-    | WORD
-        {
-            $$ = new elna::boot::number_literal<std::uint32_t>(elna::boot::make_position(@1), $1);
-        }
-    | FLOAT
-        {
-            $$ = new elna::boot::number_literal<double>(elna::boot::make_position(@1), $1);
-        }
-    | BOOLEAN
-        {
-            $$ = new elna::boot::number_literal<bool>(elna::boot::make_position(@1), $1);
-        }
-    | CHARACTER
-        {
-            $$ = new elna::boot::number_literal<unsigned char>(elna::boot::make_position(@1), $1.at(0));
-        }
-    | NIL
-        {
-            $$ = new elna::boot::number_literal<std::nullptr_t>(elna::boot::make_position(@1), nullptr);
-        }
-    | STRING
-        {
-            $$ = new elna::boot::number_literal<std::string>(elna::boot::make_position(@1), $1);
-        }
-operand:
+simple_expression:
     literal { $$ = $1; }
     | designator_expression { $$ = $1; }
-    | LEFT_PAREN type_expression RIGHT_PAREN
-        {
-            $$ = new elna::boot::type_expression(elna::boot::make_position(@1), $2);
-        }
+    | traits_expression { $$ = $1; }
     | cast_expression { $$ = $1; }
     | call_expression { $$ = $1; }
-    | LEFT_PAREN expression RIGHT_PAREN { $$ = $2; }
+    | "(" expression ")" { $$ = $2; }
+operand:
+    unary_expression { $$ = $1; }
+    | simple_expression { $$ = $1; }
 expression:
-    unary { $$ = $1; }
-    | expression MULTIPLICATION expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::multiplication);
-        }
-    | expression DIVISION expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::division);
-        }
-    | expression REMAINDER expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::remainder);
-        }
-    | expression PLUS expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::sum);
-        }
-    | expression MINUS expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::subtraction);
-        }
-    | expression EQUALS expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::equals);
-        }
-    | expression NOT_EQUAL expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::not_equals);
-        }
-    | expression LESS_THAN expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::less);
-        }
-    | expression GREATER_THAN expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::greater);
-        }
-    | expression LESS_EQUAL expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::less_equal);
-        }
-    | expression GREATER_EQUAL expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::greater_equal);
-        }
-    | expression AND expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::conjunction);
-        }
-    | expression OR expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::disjunction);
-        }
-    | expression XOR expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::exclusive_disjunction);
-        }
-    | expression SHIFT_LEFT expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::shift_left);
-        }
-    | expression SHIFT_RIGHT expression
-        {
-            $$ = new elna::boot::binary_expression(elna::boot::make_position(@2), $1, $3,
-                elna::boot::binary_operator::shift_right);
-        }
-unary:
-    AT operand
-        {
-            $$ = new elna::boot::unary_expression(elna::boot::make_position(@1), $2,
-                elna::boot::unary_operator::reference);
-        }
-    | NOT operand
-        {
-            $$ = new elna::boot::unary_expression(elna::boot::make_position(@1), $2,
-                elna::boot::unary_operator::negation);
-        }
-    | MINUS operand
-        {
-            $$ = new elna::boot::unary_expression(elna::boot::make_position(@1), $2,
-                elna::boot::unary_operator::minus);
-        }
+    binary_expression { $$ = $1; }
     | operand { $$ = $1; }
+binary_expression:
+    expression "*" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3, boot::binary_operator::multiplication);
+        }
+    | expression "/" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3, boot::binary_operator::division);
+        }
+    | expression "%" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3, boot::binary_operator::remainder);
+        }
+    | expression "+" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3, boot::binary_operator::sum);
+        }
+    | expression "-" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3, boot::binary_operator::subtraction);
+        }
+    | expression "=" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3, boot::binary_operator::equals);
+        }
+    | expression "<>" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3, boot::binary_operator::not_equals);
+        }
+    | expression "<" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3, boot::binary_operator::less);
+        }
+    | expression ">" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3, boot::binary_operator::greater);
+        }
+    | expression "<=" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3,
+                boot::binary_operator::less_equal);
+        }
+    | expression ">=" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3, boot::binary_operator::greater_equal);
+        }
+    | expression "&" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3, boot::binary_operator::conjunction);
+        }
+    | expression "or" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3, boot::binary_operator::disjunction);
+        }
+    | expression "xor" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3,
+                    boot::binary_operator::exclusive_disjunction);
+        }
+    | expression "<<" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3, boot::binary_operator::shift_left);
+        }
+    | expression ">>" expression
+        {
+            $$ = new boot::binary_expression(boot::make_position(@2), $1, $3, boot::binary_operator::shift_right);
+        }
+unary_expression:
+    "@" operand
+        {
+            $$ = new boot::unary_expression(boot::make_position(@1), $2, boot::unary_operator::reference);
+        }
+    | "~" operand
+        {
+            $$ = new boot::unary_expression(boot::make_position(@1), $2, boot::unary_operator::negation);
+        }
+    | "-" operand
+        {
+            $$ = new boot::unary_expression(boot::make_position(@1), $2, boot::unary_operator::minus);
+        }
 expressions:
-    expression COMMA expressions
+    expression "," expressions
         {
             std::swap($$, $3);
             $$.emplace($$.cbegin(), $1);
         }
-    | expression { $$.emplace_back(std::move($1)); }
+    | expression { $$.push_back($1); }
+type_expressions:
+    type_expression "," type_expressions
+        {
+            std::swap($$, $3);
+            $$.emplace($$.cbegin(), $1);
+        }
+    | type_expression { $$.push_back($1); }
 designator_expression:
-    operand LEFT_SQUARE expression RIGHT_SQUARE
-        {
-            $$ = new elna::boot::array_access_expression(elna::boot::make_position(@2), $1, $3);
-        }
-    | operand DOT IDENTIFIER
-        {
-            $$ = new elna::boot::field_access_expression(elna::boot::make_position(@2), $1, $3);
-        }
-    | operand HAT
-        {
-            $$ = new elna::boot::dereference_expression(elna::boot::make_position(@1), $1);
-        }
+    simple_expression "[" expression "]"
+        { $$ = new boot::array_access_expression(boot::make_position(@2), $1, $3); }
+    | simple_expression "." IDENTIFIER
+        { $$ = new boot::field_access_expression(boot::make_position(@2), $1, $3); }
+    | simple_expression "^"
+        { $$ = new boot::dereference_expression(boot::make_position(@1), $1); }
     | IDENTIFIER
-        {
-            $$ = new elna::boot::variable_expression(elna::boot::make_position(@1), $1);
-        }
+        { $$ = new boot::variable_expression(boot::make_position(@1), $1); }
 statement:
-    assign_statement { $$ = $1; }
-    | while_statement { $$ = $1; }
-    | if_statement { $$ = $1; }
-    | return_statement { $$ = $1; }
-    | call_expression
+    designator_expression ":=" expression
+        { $$ = new boot::assign_statement(boot::make_position(@1), $1, $3); }
+    | "while" expression "do" optional_statements elsif_do_statements "end"
         {
-            $$ = new elna::boot::call_statement(elna::boot::make_position(@1), $1);
+            boot::conditional_statements *body = new boot::conditional_statements($2, std::move($4));
+            $$ = new boot::while_statement(boot::make_position(@1), body, std::move($5));
         }
-    | defer_statement { $$ = $1; }
-statements:
-    statement SEMICOLON statements
+    | "if" expression "then" optional_statements elsif_then_statements else_statements "end"
+        {
+            boot::conditional_statements *then = new boot::conditional_statements($2, std::move($4));
+            $$ = new boot::if_statement(boot::make_position(@1), then, std::move($5), $6);
+        }
+    | call_expression { $$ = $1; }
+    | "defer" optional_statements "end"
+        { $$ = new boot::defer_statement(boot::make_position(@1), std::move($2)); }
+    | "case" expression "of" switch_cases else_statements "end"
+        { $$ = new boot::case_statement(boot::make_position(@1), $2, std::move($4), $5); }
+switch_case: case_labels ":" optional_statements
+        { $$ = { .labels = std::move($1), .statements = std::move($3) }; }
+switch_cases:
+    switch_case "|" switch_cases
         {
             std::swap($$, $3);
             $$.emplace($$.cbegin(), $1);
         }
+    | switch_case { $$.push_back($1); }
+case_labels:
+    expression "," case_labels
+        {
+            std::swap($$, $3);
+            $$.emplace($$.cbegin(), $1);
+        }
+    | expression { $$.push_back($1); }
+required_statements:
+    required_statements ";" statement
+        {
+            std::swap($$, $1);
+            $$.insert($$.cend(), $3);
+        }
     | statement { $$.push_back($1); }
 optional_statements:
-    statements { std::swap($$, $1); }
+    required_statements { std::swap($$, $1); }
     | /* no statements */ {}
 field_declaration:
-    IDENTIFIER COLON type_expression { $$ = std::make_pair($1, $3); }
-field_list:
-    field_declaration field_list
-        {
-            std::swap($$, $2);
-            $$.emplace($$.cbegin(), $1);
-        }
-    | field_declaration { $$.emplace_back($1); }
-type_expression:
-    ARRAY INTEGER OF type_expression
-        {
-            $$ = new elna::boot::array_type(elna::boot::make_position(@1), $4, $2);
-        }
-    | POINTER TO type_expression
-        {
-            $$ = new elna::boot::pointer_type(elna::boot::make_position(@1), $3);
-        }
-    | RECORD field_list END_BLOCK
-        {
-            $$ = new elna::boot::record_type(elna::boot::make_position(@1), std::move($2));
-        }
-    | UNION field_list END_BLOCK
-        {
-            $$ = new elna::boot::union_type(elna::boot::make_position(@1), std::move($2));
-        }
-    | IDENTIFIER
-        {
-            $$ = new elna::boot::basic_type(elna::boot::make_position(@1), $1);
-        }
-variable_declaration: identifier_definition COLON type_expression
-        {
-            $$ = new elna::boot::variable_declaration(elna::boot::make_position(@2), $1.first, $1.second, $3);
-        }
-variable_declarations:
-    variable_declaration COMMA variable_declarations
+    IDENTIFIER ":" type_expression { $$ = std::make_pair($1, $3); }
+required_fields:
+    field_declaration ";" required_fields
         {
             std::swap($$, $3);
             $$.emplace($$.cbegin(), $1);
         }
-    | variable_declaration { $$.emplace_back(std::move($1)); }
+    | field_declaration { $$.emplace_back($1); }
+optional_fields:
+    required_fields { std::swap($$, $1); }
+    | /* no fields */ {}
+type_expression:
+    "[" INTEGER "]" type_expression
+        {
+            $$ = new boot::array_type_expression(boot::make_position(@1), $4, $2);
+        }
+    | "^" type_expression
+        {
+            $$ = new boot::pointer_type_expression(boot::make_position(@1), $2);
+        }
+    | "record" optional_fields "end"
+        {
+            $$ = new boot::record_type_expression(boot::make_position(@1), std::move($2));
+        }
+    | "union" required_fields "end"
+        {
+            $$ = new boot::union_type_expression(boot::make_position(@1), std::move($2));
+        }
+    | "proc" "(" type_expressions ")" return_declaration
+        {
+            auto result = new boot::procedure_type_expression(boot::make_position(@1), std::move($5));
+            std::swap(result->parameters, $3);
+            $$ = result;
+        }
+    | "(" identifiers ")"
+        {
+            $$ = new boot::enumeration_type_expression(boot::make_position(@1), std::move($2));
+        }
+    | IDENTIFIER
+        {
+            $$ = new boot::named_type_expression(boot::make_position(@1), $1);
+        }
+identifiers:
+    IDENTIFIER "," identifiers
+        {
+            std::swap($$, $3);
+            $$.emplace($$.cbegin(), std::move($1));
+        }
+    | IDENTIFIER { $$.emplace_back(std::move($1)); }
+variable_declaration: identifier_definitions ":" type_expression ";"
+        {
+            std::shared_ptr<boot::type_expression> shared_type{ $3 };
+
+            for (boot::identifier_definition& identifier : $1)
+            {
+                boot::variable_declaration *declaration = new boot::variable_declaration(
+                        boot::make_position(@2), std::move(identifier), shared_type);
+                $$.push_back(declaration);
+            }
+        }
+variable_declarations:
+    /* no variable declarations */ {}
+    | variable_declaration variable_declarations
+        {
+            std::swap($$, $1);
+            $$.reserve($$.size() + $2.size());
+            $$.insert(std::end($$), std::begin($2), std::end($2));
+        }
 variable_part:
     /* no variable declarations */ {}
-    | VAR variable_declarations { std::swap($$, $2); }
-constant_definition: identifier_definition EQUALS literal
+    | "var" variable_declarations { std::swap($$, $2); }
+constant_declaration: identifier_definition ":=" expression ";"
         {
-            $$ = new elna::boot::constant_definition(elna::boot::make_position(@1), $1.first, $1.second, $3);
+            $$ = new boot::constant_declaration(boot::make_position(@1), std::move($1), $3);
         }
-constant_definitions:
-    constant_definition constant_definitions
+constant_declarations:
+    constant_declaration constant_declarations
         {
             std::swap($$, $2);
-            $$.emplace($$.cbegin(), std::move($1));
+            $$.insert($$.cbegin(), $1);
         }
-    | constant_definition { $$.emplace_back(std::move($1)); }
+    | /* no constant definitions */ {}
 constant_part:
     /* no constant definitions */ {}
-    | CONST {}
-    | CONST constant_definitions { std::swap($$, $2); }
-type_definition: identifier_definition EQUALS type_expression
+    | "const" constant_declarations { std::swap($$, $2); }
+import_declaration:
+    IDENTIFIER "." import_declaration
         {
-            $$ = new elna::boot::type_definition(elna::boot::make_position(@1), $1.first, $1.second, $3);
-        }
-type_definitions:
-    type_definition type_definitions
-        {
-            std::swap($$, $2);
+            std::swap($$, $3);
             $$.emplace($$.cbegin(), std::move($1));
         }
-    | type_definition { $$.emplace_back(std::move($1)); }
+    | IDENTIFIER { $$.emplace_back(std::move($1)); }
+import_declarations:
+    import_declaration "," import_declarations
+        {
+            std::swap($$, $3);
+            $$.emplace($$.cbegin(), new boot::import_declaration(boot::make_position(@1), std::move($1)));
+        }
+	| import_declaration
+        {
+            $$.emplace_back(new boot::import_declaration(boot::make_position(@1), std::move($1)));
+        }
+import_part:
+    /* no import declarations */ {}
+    | "import" import_declarations ";" { std::swap($$, $2); }
+type_declaration: identifier_definition "=" type_expression ";"
+        {
+            $$ = new boot::type_declaration(boot::make_position(@1), std::move($1), $3);
+        }
+type_declarations:
+    type_declaration type_declarations
+        {
+            std::swap($$, $2);
+            $$.insert($$.cbegin(), $1);
+        }
+    | /* no type definitions */ {}
 type_part:
     /* no type definitions */ {}
-    | TYPE {}
-    | TYPE type_definitions { std::swap($$, $2); }
+    | "type" type_declarations { std::swap($$, $2); }
+formal_parameter:
+    IDENTIFIER ":" type_expression { $$ = std::make_pair($1, $3); }
 formal_parameter_list:
-    LEFT_PAREN RIGHT_PAREN {}
-    | LEFT_PAREN variable_declarations RIGHT_PAREN { std::swap($$, $2); }
+    "(" ")" {}
+    | "(" formal_parameters ")" { std::swap($$, $2); }
+formal_parameters:
+    formal_parameter "," formal_parameters
+        {
+            std::swap($$, $3);
+            $$.emplace($$.cbegin(), std::move($1));
+        }
+    | formal_parameter { $$.emplace_back(std::move($1)); }
 actual_parameter_list:
-    LEFT_PAREN RIGHT_PAREN {}
-    | LEFT_PAREN expressions RIGHT_PAREN { std::swap($$, $2); }
+    "(" ")" {}
+    | "(" expressions ")" { std::swap($$, $2); }
 %%
 
 void yy::parser::error(const location_type& loc, const std::string& message)
 {
-    driver.error(loc, message);
+    driver.add_error<boot::syntax_error>(message, driver.input_file, loc);
 }

boot/result.cc

@@ -17,9 +17,7 @@ along with GCC; see the file COPYING3.  If not see
 
 #include "elna/boot/result.h"
 
-namespace elna
-{
-namespace boot
+namespace elna::boot
 {
     error::error(const char *path, const struct position position)
         : position(position), path(path)
@@ -35,5 +33,14 @@ namespace boot
     {
         return this->position.column;
     }
+
+    error_container::error_container(const char *input_file)
+        : input_file(input_file)
+    {
+    }
+
+    std::deque<std::unique_ptr<error>>& error_container::errors()
+    {
+        return m_errors;
     }
 }

boot/semantic.cc

@@ -0,0 +1,650 @@
+/* Name analysis.
+   Copyright (C) 2025 Free Software Foundation, Inc.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "elna/boot/semantic.h"
+
+#include <algorithm>
+#include <set>
+
+namespace elna::boot
+{
+    undeclared_error::undeclared_error(const std::string& identifier, const char *path, const struct position position)
+        : error(path, position), identifier(identifier)
+    {
+    }
+
+    std::string undeclared_error::what() const
+    {
+        return "Type '" + identifier + "' not declared";
+    }
+
+
+    already_declared_error::already_declared_error(const std::string& identifier,
+            const char *path, const struct position position)
+        : error(path, position), identifier(identifier)
+    {
+    }
+
+    std::string already_declared_error::what() const
+    {
+        return "Symbol '" + identifier + "' has been already declared";
+    }
+
+    field_duplication_error::field_duplication_error(const std::string& field_name,
+            const char *path, const struct position position)
+        : error(path, position), field_name(field_name)
+    {
+    }
+
+    std::string field_duplication_error::what() const
+    {
+        return "Repeated field name '" + field_name + "'";
+    }
+
+    cyclic_declaration_error::cyclic_declaration_error(const std::vector<std::string>& cycle,
+            const char *path, const struct position position)
+        : error(path, position), cycle(cycle)
+    {
+    }
+
+    std::string cyclic_declaration_error::what() const
+    {
+        auto segment = std::cbegin(this->cycle);
+        std::string message = "Type declaration forms a cycle: " + *segment;
+
+        ++segment;
+        for (; segment != std::cend(this->cycle); ++segment)
+        {
+            message += " -> " + *segment;
+        }
+        return message;
+    }
+
+    name_analysis_visitor::name_analysis_visitor(const char *path, std::shared_ptr<symbol_table> symbols,
+                std::unordered_map<std::string, std::shared_ptr<alias_type>>&& unresolved)
+        : error_container(path), symbols(symbols), unresolved(std::move(unresolved))
+    {
+    }
+
+    procedure_type name_analysis_visitor::build_procedure(procedure_type_expression& type_expression)
+    {
+        procedure_type::return_t result_return;
+
+        if (type_expression.return_type.no_return)
+        {
+            result_return = procedure_type::return_t(std::monostate{});
+        }
+        else if (type_expression.return_type.proper_type != nullptr)
+        {
+            type_expression.return_type.proper_type->accept(this);
+            result_return = procedure_type::return_t(this->current_type);
+        }
+        else
+        {
+            result_return = procedure_type::return_t();
+        }
+        procedure_type result_type = procedure_type(result_return);
+
+        for (struct type_expression *parameter : type_expression.parameters)
+        {
+            parameter->accept(this);
+            result_type.parameters.push_back(this->current_type);
+        }
+        return result_type;
+    }
+
+    void name_analysis_visitor::visit(program *program)
+    {
+        visit(static_cast<unit *>(program));
+
+        for (statement *const statement : program->body)
+        {
+            statement->accept(this);
+        }
+    }
+
+    void name_analysis_visitor::visit(type_declaration *definition)
+    {
+        definition->body().accept(this);
+        auto unresolved_declaration = this->unresolved.at(definition->identifier.identifier);
+
+        unresolved_declaration->reference = this->current_type;
+    }
+
+    void name_analysis_visitor::visit(named_type_expression *type_expression)
+    {
+        auto unresolved_alias = this->unresolved.find(type_expression->name);
+
+        if (unresolved_alias != this->unresolved.end())
+        {
+            this->current_type = type(unresolved_alias->second);
+        }
+        else if (auto from_symbol_table = this->symbols->lookup(type_expression->name))
+        {
+            this->current_type = from_symbol_table->is_type()->symbol;
+        }
+        else
+        {
+            add_error<undeclared_error>(type_expression->name, this->input_file, type_expression->position());
+            this->current_type = type();
+        }
+    }
+
+    void name_analysis_visitor::visit(pointer_type_expression *type_expression)
+    {
+        type_expression->base().accept(this);
+        this->current_type = type(std::make_shared<pointer_type>(this->current_type));
+    }
+
+    void name_analysis_visitor::visit(array_type_expression *type_expression)
+    {
+        type_expression->base().accept(this);
+        this->current_type = type(std::make_shared<array_type>(this->current_type, type_expression->size));
+    }
+
+    std::vector<type_field> name_analysis_visitor::build_composite_type(const std::vector<field_declaration>& fields)
+    {
+        std::vector<type_field> result;
+        std::set<std::string> field_names;
+
+        for (auto& field : fields)
+        {
+            if (field_names.find(field.first) != field_names.cend())
+            {
+                add_error<field_duplication_error>(field.first, this->input_file, field.second->position());
+            }
+            else
+            {
+                field_names.insert(field.first);
+                field.second->accept(this);
+                result.push_back(std::make_pair(field.first, this->current_type));
+            }
+        }
+        return result;
+    }
+
+    void name_analysis_visitor::visit(record_type_expression *type_expression)
+    {
+        auto result_type = std::make_shared<record_type>();
+
+        result_type->fields = build_composite_type(type_expression->fields);
+
+        this->current_type = type(result_type);
+    }
+
+    void name_analysis_visitor::visit(union_type_expression *type_expression)
+    {
+        auto result_type = std::make_shared<union_type>();
+
+        result_type->fields = build_composite_type(type_expression->fields);
+
+        this->current_type = type(result_type);
+    }
+
+    void name_analysis_visitor::visit(procedure_type_expression *type_expression)
+    {
+        std::shared_ptr<procedure_type> result_type =
+            std::make_shared<procedure_type>(std::move(build_procedure(*type_expression)));
+
+        this->current_type = type(result_type);
+    }
+
+    void name_analysis_visitor::visit(enumeration_type_expression *type_expression)
+    {
+        std::shared_ptr<enumeration_type> result_type = std::make_shared<enumeration_type>(type_expression->members);
+
+        this->current_type = type(result_type);
+    }
+
+    void name_analysis_visitor::visit(variable_declaration *declaration)
+    {
+        declaration->variable_type().accept(this);
+
+        this->symbols->enter(declaration->identifier.identifier,
+                std::make_shared<variable_info>(this->current_type));
+    }
+
+    void name_analysis_visitor::visit(constant_declaration *definition)
+    {
+        definition->body().accept(this);
+
+        this->symbols->enter(definition->identifier.identifier,
+                std::make_shared<constant_info>(this->current_literal));
+    }
+
+    void name_analysis_visitor::visit(procedure_declaration *definition)
+    {
+        std::shared_ptr<procedure_info> info;
+
+        if (definition->body.has_value())
+        {
+            info = std::make_shared<procedure_info>(build_procedure(definition->heading()),
+                    definition->parameter_names, this->symbols);
+
+            this->symbols = info->symbols;
+
+            for (constant_declaration *const constant : definition->body.value().constants())
+            {
+                constant->accept(this);
+            }
+            for (variable_declaration *const variable : definition->body.value().variables())
+            {
+                variable->accept(this);
+            }
+            for (statement *const statement : definition->body.value().body())
+            {
+                statement->accept(this);
+            }
+            this->symbols = this->symbols->scope();
+        }
+        else
+        {
+            info = std::make_shared<procedure_info>(build_procedure(definition->heading()),
+                    definition->parameter_names);
+        }
+        this->symbols->enter(definition->identifier.identifier, info);
+    }
+
+    void name_analysis_visitor::visit(assign_statement *statement)
+    {
+        statement->lvalue().accept(this);
+        statement->rvalue().accept(this);
+    }
+
+    void name_analysis_visitor::visit(if_statement *statement)
+    {
+        statement->body().prerequisite().accept(this);
+        for (struct statement *const statement : statement->body().statements)
+        {
+            statement->accept(this);
+        }
+        for (const auto branch : statement->branches)
+        {
+            branch->prerequisite().accept(this);
+
+            for (struct statement *const statement : branch->statements)
+            {
+                statement->accept(this);
+            }
+        }
+        if (statement->alternative != nullptr)
+        {
+            for (struct statement *const statement : *statement->alternative)
+            {
+                statement->accept(this);
+            }
+        }
+    }
+
+    void name_analysis_visitor::visit(import_declaration *)
+    {
+    }
+
+    void name_analysis_visitor::visit(while_statement *statement)
+    {
+        statement->body().prerequisite().accept(this);
+        for (struct statement *const statement : statement->body().statements)
+        {
+            statement->accept(this);
+        }
+        for (const auto branch : statement->branches)
+        {
+            branch->prerequisite().accept(this);
+
+            for (struct statement *const statement : branch->statements)
+            {
+                statement->accept(this);
+            }
+        }
+    }
+
+    void name_analysis_visitor::visit(return_statement *statement)
+    {
+        statement->return_expression().accept(this);
+    }
+
+    void name_analysis_visitor::visit(defer_statement *statement)
+    {
+        for (struct statement *const statement : statement->statements)
+        {
+            statement->accept(this);
+        }
+    }
+
+    void name_analysis_visitor::visit(case_statement *statement)
+    {
+        statement->condition().accept(this);
+        for (const switch_case& case_block : statement->cases)
+        {
+            for (expression *const case_label : case_block.labels)
+            {
+                case_label->accept(this);
+            }
+            for (struct statement *const statement : case_block.statements)
+            {
+                statement->accept(this);
+            }
+        }
+        if (statement->alternative != nullptr)
+        {
+            for (struct statement *const statement : *statement->alternative)
+            {
+                statement->accept(this);
+            }
+        }
+    }
+
+    void name_analysis_visitor::visit(procedure_call *call)
+    {
+        call->callable().accept(this);
+        for (expression *const argument: call->arguments)
+        {
+            argument->accept(this);
+        }
+    }
+
+    bool name_analysis_visitor::check_unresolved_symbol(std::shared_ptr<alias_type> alias,
+            std::vector<std::string>& path)
+    {
+        if (std::find(std::cbegin(path), std::cend(path), alias->name) != std::cend(path))
+        {
+            return false;
+        }
+        path.push_back(alias->name);
+
+        if (auto another_alias = alias->reference.get<alias_type>())
+        {
+            return check_unresolved_symbol(another_alias, path);
+        }
+        return true;
+    }
+
+    void name_analysis_visitor::visit(unit *unit)
+    {
+        for (type_declaration *const type : unit->types)
+        {
+            type->accept(this);
+        }
+        for (auto& unresolved : this->unresolved)
+        {
+            std::vector<std::string> path;
+
+            if (check_unresolved_symbol(unresolved.second, path))
+            {
+                auto info = std::make_shared<type_info>(type_info(type(unresolved.second)));
+                this->symbols->enter(std::move(unresolved.first), info);
+            }
+            else
+            {
+                add_error<cyclic_declaration_error>(path, this->input_file, position{ 0, 0 });
+            }
+        }
+        for (variable_declaration *const variable : unit->variables)
+        {
+            variable->accept(this);
+        }
+        for (procedure_declaration *const procedure : unit->procedures)
+        {
+            procedure->accept(this);
+        }
+    }
+
+    void name_analysis_visitor::visit(traits_expression *trait)
+    {
+        if (!trait->parameters.empty())
+        {
+            trait->parameters.front()->accept(this);
+            trait->types.push_back(this->current_type);
+        }
+    }
+
+    void name_analysis_visitor::visit(cast_expression *expression)
+    {
+        expression->value().accept(this);
+        expression->target().accept(this);
+        expression->expression_type = this->current_type;
+    }
+
+    void name_analysis_visitor::visit(binary_expression *expression)
+    {
+        expression->lhs().accept(this);
+        expression->rhs().accept(this);
+    }
+
+    void name_analysis_visitor::visit(unary_expression *expression)
+    {
+        expression->operand().accept(this);
+    }
+
+    void name_analysis_visitor::visit(variable_expression *)
+    {
+    }
+
+    void name_analysis_visitor::visit(array_access_expression *expression)
+    {
+        expression->base().accept(this);
+        expression->index().accept(this);
+    }
+
+    void name_analysis_visitor::visit(field_access_expression *expression)
+    {
+        expression->base().accept(this);
+    }
+
+    void name_analysis_visitor::visit(dereference_expression *expression)
+    {
+        expression->base().accept(this);
+    }
+
+    void name_analysis_visitor::visit(literal<std::int32_t> *literal)
+    {
+        this->current_literal = literal->value;
+    }
+
+    void name_analysis_visitor::visit(literal<std::uint32_t> *literal)
+    {
+        this->current_literal = literal->value;
+    }
+
+    void name_analysis_visitor::visit(literal<double> *literal)
+    {
+        this->current_literal = literal->value;
+    }
+
+    void name_analysis_visitor::visit(literal<bool> *literal)
+    {
+        this->current_literal = literal->value;
+    }
+
+    void name_analysis_visitor::visit(literal<unsigned char> *literal)
+    {
+        this->current_literal = literal->value;
+    }
+
+    void name_analysis_visitor::visit(literal<std::nullptr_t> *literal)
+    {
+        this->current_literal = literal->value;
+    }
+
+    void name_analysis_visitor::visit(literal<std::string> *literal)
+    {
+        this->current_literal = literal->value;
+    }
+
+    declaration_visitor::declaration_visitor(const char *path)
+        : error_container(path)
+    {
+    }
+
+    void declaration_visitor::visit(named_type_expression *)
+    {
+    }
+
+    void declaration_visitor::visit(array_type_expression *)
+    {
+    }
+
+    void declaration_visitor::visit(pointer_type_expression *)
+    {
+    }
+
+    void declaration_visitor::visit(program *program)
+    {
+        visit(static_cast<unit *>(program));
+    }
+
+    void declaration_visitor::visit(type_declaration *)
+    {
+    }
+
+    void declaration_visitor::visit(record_type_expression *)
+    {
+    }
+
+    void declaration_visitor::visit(union_type_expression *)
+    {
+    }
+
+    void declaration_visitor::visit(procedure_type_expression *)
+    {
+    }
+
+    void declaration_visitor::visit(enumeration_type_expression *)
+    {
+    }
+
+    void declaration_visitor::visit(variable_declaration *)
+    {
+    }
+
+    void declaration_visitor::visit(constant_declaration *)
+    {
+    }
+
+    void declaration_visitor::visit(procedure_declaration *)
+    {
+    }
+
+    void declaration_visitor::visit(assign_statement *)
+    {
+    }
+
+    void declaration_visitor::visit(if_statement *)
+    {
+    }
+
+    void declaration_visitor::visit(import_declaration *)
+    {
+    }
+
+    void declaration_visitor::visit(while_statement *)
+    {
+    }
+
+    void declaration_visitor::visit(return_statement *)
+    {
+    }
+
+    void declaration_visitor::visit(defer_statement *)
+    {
+    }
+
+    void declaration_visitor::visit(case_statement *)
+    {
+    }
+
+    void declaration_visitor::visit(procedure_call *)
+    {
+    }
+
+    void declaration_visitor::visit(unit *unit)
+    {
+        for (import_declaration *const _import : unit->imports)
+        {
+            _import->accept(this);
+        }
+        for (type_declaration *const type : unit->types)
+        {
+            const std::string& type_identifier = type->identifier.identifier;
+
+            if (!this->unresolved.insert({ type_identifier, std::make_shared<alias_type>(type_identifier) }).second)
+            {
+                add_error<already_declared_error>(type->identifier.identifier, this->input_file, type->position());
+            }
+        }
+    }
+
+    void declaration_visitor::visit(cast_expression *)
+    {
+    }
+
+    void declaration_visitor::visit(traits_expression *)
+    {
+    }
+
+    void declaration_visitor::visit(binary_expression *)
+    {
+    }
+
+    void declaration_visitor::visit(unary_expression *)
+    {
+    }
+
+    void declaration_visitor::visit(variable_expression *)
+    {
+    }
+
+    void declaration_visitor::visit(array_access_expression *)
+    {
+    }
+
+    void declaration_visitor::visit(field_access_expression *)
+    {
+    }
+
+    void declaration_visitor::visit(dereference_expression *)
+    {
+    }
+
+    void declaration_visitor::visit(literal<std::int32_t> *)
+    {
+    }
+
+    void declaration_visitor::visit(literal<std::uint32_t> *)
+    {
+    }
+
+    void declaration_visitor::visit(literal<double> *)
+    {
+    }
+
+    void declaration_visitor::visit(literal<bool> *)
+    {
+    }
+
+    void declaration_visitor::visit(literal<unsigned char> *)
+    {
+    }
+
+    void declaration_visitor::visit(literal<std::nullptr_t> *)
+    {
+    }
+
+    void declaration_visitor::visit(literal<std::string> *)
+    {
+    }
+}

boot/symbol.cc

@@ -0,0 +1,364 @@
+/* Symbol definitions.
+   Copyright (C) 2025 Free Software Foundation, Inc.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "elna/boot/symbol.h"
+
+namespace elna::boot
+{
+    type::type()
+    {
+    }
+
+    type::type(std::shared_ptr<alias_type> alias)
+        : tag(type_tag::alias), alias(alias)
+    {
+    }
+
+    type::type(std::shared_ptr<primitive_type> primitive)
+        : tag(type_tag::primitive), primitive(primitive)
+    {
+    }
+
+    type::type(std::shared_ptr<record_type> record)
+        : tag(type_tag::record), record(record)
+    {
+    }
+
+    type::type(std::shared_ptr<union_type> _union)
+        : tag(type_tag::_union), _union(_union)
+    {
+    }
+
+    type::type(std::shared_ptr<pointer_type> pointer)
+        : tag(type_tag::pointer), pointer(pointer)
+    {
+    }
+
+    type::type(std::shared_ptr<array_type> array)
+        : tag(type_tag::array), array(array)
+    {
+    }
+
+    type::type(std::shared_ptr<procedure_type> procedure)
+        : tag(type_tag::procedure), procedure(procedure)
+    {
+    }
+
+    type::type(std::shared_ptr<enumeration_type> enumeration)
+        : tag(type_tag::enumeration), enumeration(enumeration)
+    {
+    }
+
+    void type::copy(const type& other)
+    {
+        switch (other.tag)
+        {
+        case type_tag::empty:
+            break;
+        case type_tag::alias:
+            new (&alias) std::weak_ptr<alias_type>(other.alias);
+            break;
+        case type_tag::primitive:
+            new (&primitive) std::shared_ptr<primitive_type>(other.primitive);
+            break;
+        case type_tag::record:
+            new (&record) std::shared_ptr<record_type>(other.record);
+            break;
+        case type_tag::_union:
+            new (&_union) std::shared_ptr<union_type>(other._union);
+            break;
+        case type_tag::pointer:
+            new (&pointer) std::shared_ptr<pointer_type>(other.pointer);
+            break;
+        case type_tag::array:
+            new (&array) std::shared_ptr<array_type>(other.array);
+            break;
+        case type_tag::procedure:
+            new (&procedure) std::shared_ptr<procedure_type>(other.procedure);
+            break;
+        case type_tag::enumeration:
+            new (&enumeration) std::shared_ptr<enumeration_type>(other.enumeration);
+            break;
+        }
+    }
+
+    type::type(const type& other)
+        : tag(other.tag)
+    {
+        copy(other);
+    }
+
+    void type::move(type&& other)
+    {
+        switch (other.tag)
+        {
+        case type_tag::empty:
+            break;
+        case type_tag::alias:
+            new (&alias) std::weak_ptr<alias_type>(std::move(other.alias));
+            break;
+        case type_tag::primitive:
+            new (&primitive) std::shared_ptr<primitive_type>(std::move(other.primitive));
+            break;
+        case type_tag::record:
+            new (&record) std::shared_ptr<record_type>(std::move(other.record));
+            break;
+        case type_tag::_union:
+            new (&_union) std::shared_ptr<union_type>(std::move(other._union));
+            break;
+        case type_tag::pointer:
+            new (&pointer) std::shared_ptr<pointer_type>(std::move(other.pointer));
+            break;
+        case type_tag::array:
+            new (&array) std::shared_ptr<array_type>(std::move(other.array));
+            break;
+        case type_tag::procedure:
+            new (&procedure) std::shared_ptr<procedure_type>(std::move(other.procedure));
+            break;
+        case type_tag::enumeration:
+            new (&enumeration) std::shared_ptr<enumeration_type>(std::move(other.enumeration));
+            break;
+        }
+    }
+
+    type& type::operator=(const type& other)
+    {
+        this->~type();
+        this->tag = other.tag;
+        copy(other);
+        return *this;
+    }
+
+    type::type(type&& other)
+        : tag(other.tag)
+    {
+        move(std::move(other));
+    }
+
+    type& type::operator=(type&& other)
+    {
+        this->~type();
+        this->tag = other.tag;
+        move(std::move(other));
+        return *this;
+    }
+
+    bool type::operator==(const std::nullptr_t&)
+    {
+        return empty();
+    }
+
+    type::~type()
+    {
+        switch (tag)
+        {
+        case type_tag::empty:
+            break;
+        case type_tag::alias:
+            this->alias.~weak_ptr<alias_type>();
+            break;
+        case type_tag::primitive:
+            this->primitive.~shared_ptr<primitive_type>();
+            break;
+        case type_tag::record:
+            this->record.~shared_ptr<record_type>();
+            break;
+        case type_tag::_union:
+            this->_union.~shared_ptr<union_type>();
+            break;
+        case type_tag::pointer:
+            this->pointer.~shared_ptr<pointer_type>();
+            break;
+        case type_tag::array:
+            this->array.~shared_ptr<array_type>();
+            break;
+        case type_tag::procedure:
+            this->procedure.~shared_ptr<procedure_type>();
+            break;
+        case type_tag::enumeration:
+            this->enumeration.~shared_ptr<enumeration_type>();
+            break;
+        }
+    }
+
+    template<>
+    std::shared_ptr<alias_type> type::get<alias_type>() const
+    {
+        return tag == type_tag::alias ? this->alias.lock() : nullptr;
+    }
+
+    template<>
+    std::shared_ptr<primitive_type> type::get<primitive_type>() const
+    {
+        return tag == type_tag::primitive ? this->primitive : nullptr;
+    }
+
+    template<>
+    std::shared_ptr<record_type> type::get<record_type>() const
+    {
+        return tag == type_tag::record ? this->record : nullptr;
+    }
+
+    template<>
+    std::shared_ptr<union_type> type::get<union_type>() const
+    {
+        return tag == type_tag::_union ? this->_union : nullptr;
+    }
+
+    template<>
+    std::shared_ptr<pointer_type> type::get<pointer_type>() const
+    {
+        return tag == type_tag::pointer ? this->pointer : nullptr;
+    }
+
+    template<>
+    std::shared_ptr<array_type> type::get<array_type>() const
+    {
+        return tag == type_tag::array ? this->array : nullptr;
+    }
+
+    template<>
+    std::shared_ptr<procedure_type> type::get<procedure_type>() const
+    {
+        return tag == type_tag::procedure ? this->procedure : nullptr;
+    }
+
+    template<>
+    std::shared_ptr<enumeration_type> type::get<enumeration_type>() const
+    {
+        return tag == type_tag::enumeration ? this->enumeration : nullptr;
+    }
+
+    bool type::empty() const
+    {
+        return tag == type_tag::empty;
+    }
+
+    alias_type::alias_type(const std::string& name)
+        : name(name), reference()
+    {
+    }
+
+    pointer_type::pointer_type(type base)
+        : base(base)
+    {
+    }
+
+    array_type::array_type(type base, std::uint64_t size)
+        : base(base), size(size)
+    {
+    }
+
+    primitive_type::primitive_type(const std::string& identifier)
+        : identifier(identifier)
+    {
+    }
+
+    procedure_type::procedure_type(return_t return_type)
+        : return_type(return_type)
+    {
+    }
+
+    enumeration_type::enumeration_type(const std::vector<std::string>& members)
+        : members(members)
+    {
+    }
+
+    info::~info()
+    {
+    }
+
+    std::shared_ptr<type_info> info::is_type()
+    {
+        return nullptr;
+    }
+
+    std::shared_ptr<procedure_info> info::is_procedure()
+    {
+        return nullptr;
+    }
+
+    std::shared_ptr<constant_info> info::is_constant()
+    {
+        return nullptr;
+    }
+
+    std::shared_ptr<variable_info> info::is_variable()
+    {
+        return nullptr;
+    }
+
+    type_info::type_info(const type symbol)
+        : symbol(symbol)
+    {
+    }
+
+    std::shared_ptr<type_info> type_info::is_type()
+    {
+        return std::static_pointer_cast<type_info>(shared_from_this());
+    }
+
+    procedure_info::procedure_info(const procedure_type symbol, const std::vector<std::string> names,
+            std::shared_ptr<symbol_table> parent_table)
+        : symbol(symbol), names(names)
+    {
+        if (parent_table != nullptr)
+        {
+            this->symbols = std::make_shared<symbol_table>(parent_table);
+        }
+    }
+
+    std::shared_ptr<procedure_info> procedure_info::is_procedure()
+    {
+        return std::static_pointer_cast<procedure_info>(shared_from_this());
+    }
+
+    constant_info::constant_info(const variant& symbol)
+        : symbol(symbol)
+    {
+    }
+
+    std::shared_ptr<constant_info> constant_info::is_constant()
+    {
+        return std::static_pointer_cast<constant_info>(shared_from_this());
+    }
+
+    variable_info::variable_info(const type symbol)
+        : symbol(symbol)
+    {
+    }
+
+    std::shared_ptr<variable_info> variable_info::is_variable()
+    {
+        return std::static_pointer_cast<variable_info>(shared_from_this());
+    }
+
+    std::shared_ptr<symbol_table> builtin_symbol_table()
+    {
+        auto result = std::make_shared<symbol_table>();
+
+        result->enter("Int", std::make_shared<type_info>(type(std::make_shared<primitive_type>("Int"))));
+        result->enter("Word", std::make_shared<type_info>(type(std::make_shared<primitive_type>("Word"))));
+        result->enter("Char", std::make_shared<type_info>(type(std::make_shared<primitive_type>("Char"))));
+        result->enter("Bool", std::make_shared<type_info>(type(std::make_shared<primitive_type>("Bool"))));
+        result->enter("Pointer", std::make_shared<type_info>(type(std::make_shared<primitive_type>("Pointer"))));
+        result->enter("Float", std::make_shared<type_info>(type(std::make_shared<primitive_type>("Float"))));
+        result->enter("String", std::make_shared<type_info>(type(std::make_shared<primitive_type>("String"))));
+
+        return result;
+    }
+}

gcc/Make-lang.in

@@ -34,6 +34,11 @@ gelna$(exeext): $(ELNA_OBJS) $(EXTRA_GCC_OBJS) libcommon-target.a $(LIBDEPS)
 	  $(ELNA_OBJS) $(EXTRA_GCC_OBJS) libcommon-target.a \
 	  $(EXTRA_GCC_LIBS) $(LIBS)
 
+# Create a version of the gelna driver which calls the cross-compiler.
+gelna-cross$(exeext): gelna$(exeext)
+	-rm -f gelna-cross$(exeext)
+	cp gelna$(exeext) gelna-cross$(exeext)
+
 # The compiler proper
 
 elna_OBJS = \
@@ -43,9 +48,12 @@ elna_OBJS = \
 	elna/elna-tree.o \
 	elna/elna-builtins.o \
 	elna/ast.o \
+	elna/dependency.o \
 	elna/driver.o \
 	elna/lexer.o \
 	elna/parser.o \
+	elna/semantic.o \
+	elna/symbol.o \
 	elna/result.o \
 	$(END)
 
@@ -53,7 +61,7 @@ elna1$(exeext): attribs.o $(elna_OBJS) $(BACKEND) $(LIBDEPS)
 	+$(LLINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ \
 	      attribs.o $(elna_OBJS) $(BACKEND) $(LIBS) $(BACKENDLIBS)
 
-elna.all.cross:
+elna.all.cross: gelna-cross$(exeext)
 
 elna.start.encap: gelna$(exeext)
 elna.rest.encap:
@@ -61,23 +69,59 @@ elna.rest.encap:
 # No elna-specific selftests.
 selftest-elna:
 
+ELNA_TEXI_FILES = \
+  elna/gcc/gelna.texi \
+  $(srcdir)/doc/include/fdl.texi \
+  $(srcdir)/doc/include/gpl_v3.texi \
+  $(srcdir)/doc/include/funding.texi \
+  $(srcdir)/doc/include/gcc-common.texi \
+  gcc-vers.texi
+
 elna.install-common: installdirs
 	-rm -f $(DESTDIR)$(bindir)/$(ELNA_INSTALL_NAME)$(exeext)
 	$(INSTALL_PROGRAM) gelna$(exeext) $(DESTDIR)$(bindir)/$(ELNA_INSTALL_NAME)$(exeext)
+	-if test -f elna1$(exeext); then \
+	  if test -f gelna-cross$(exeext); then \
+	    :; \
+	  else \
 	    rm -f $(DESTDIR)$(bindir)/$(ELNA_TARGET_INSTALL_NAME)$(exeext); \
 	    ( cd $(DESTDIR)$(bindir) && \
           $(LN) $(ELNA_INSTALL_NAME)$(exeext) $(ELNA_TARGET_INSTALL_NAME)$(exeext) ); \
+	  fi; \
+	fi
+
+$(build_htmldir)/gelna/index.html: $(ELNA_TEXI_FILES)
+	$(mkinstalldirs) $(@D)
+	rm -f $(@D)/*
+	$(TEXI2HTML) -I $(gcc_docdir)/include -I $(srcdir)/elna -o $(@D) $<
 
 # Required goals, they still do nothing
 elna.install-man:
 elna.install-info:
 elna.install-pdf:
 elna.install-plugin:
-elna.install-html:
+
+elna.install-html: $(build_htmldir)/gelna
+	@$(NORMAL_INSTALL)
+	test -z "$(htmldir)" || $(mkinstalldirs) "$(DESTDIR)$(htmldir)"
+	@for p in $(build_htmldir)/gelna; do \
+	  if test -f "$$p" || test -d "$$p"; then d=""; else d="$(srcdir)/"; fi; \
+	  f=$(html__strip_dir) \
+	  if test -d "$$d$$p"; then \
+	    echo " $(mkinstalldirs) '$(DESTDIR)$(htmldir)/$$f'"; \
+	    $(mkinstalldirs) "$(DESTDIR)$(htmldir)/$$f" || exit 1; \
+	    echo " $(INSTALL_DATA) '$$d$$p'/* '$(DESTDIR)$(htmldir)/$$f'"; \
+	    $(INSTALL_DATA) "$$d$$p"/* "$(DESTDIR)$(htmldir)/$$f"; \
+	  else \
+	    echo " $(INSTALL_DATA) '$$d$$p' '$(DESTDIR)$(htmldir)/$$f'"; \
+	    $(INSTALL_DATA) "$$d$$p" "$(DESTDIR)$(htmldir)/$$f"; \
+	  fi; \
+	done
+
 elna.info:
 elna.dvi:
 elna.pdf:
-elna.html:
+elna.html: $(build_htmldir)/gelna/index.html
 elna.man:
 elna.mostlyclean:
 elna.clean:
@@ -104,7 +148,7 @@ elna.stagefeedback: stagefeedback-start
 	-mv elna/*$(objext) stagefeedback/elna
 
 ELNA_INCLUDES = -I $(srcdir)/elna/include -I elna/generated
-ELNA_CXXFLAGS = -std=c++11
+ELNA_CXXFLAGS = -std=c++17
 
 elna/%.o: elna/boot/%.cc elna/generated/parser.hh elna/generated/location.hh
 	$(COMPILE) $(ELNA_CXXFLAGS) $(ELNA_INCLUDES) $<

gcc/elna-builtins.cc

@@ -15,22 +15,22 @@ You should have received a copy of the GNU General Public License
 along with GCC; see the file COPYING3.  If not see
 <http://www.gnu.org/licenses/>.  */
 
+#include <algorithm>
+
 #include "elna/gcc/elna-builtins.h"
 #include "elna/gcc/elna1.h"
 #include "stor-layout.h"
 #include "stringpool.h"
 #include "elna/gcc/elna-tree.h"
 
-namespace elna
-{
-namespace gcc
+namespace elna::gcc
 {
     void init_ttree()
     {
         elna_int_type_node = long_integer_type_node;
         elna_word_type_node = size_type_node;
         elna_char_type_node = unsigned_char_type_node;
-        elna_byte_type_node = make_unsigned_type(8);
+        elna_pointer_type_node = ptr_type_node;
         elna_float_type_node = double_type_node;
 
         elna_bool_type_node = boolean_type_node;
@@ -43,12 +43,217 @@ namespace gcc
         tree string_ptr_type = build_pointer_type_for_mode(elna_char_type_node, VOIDmode, true);
 
         elna_string_length_field_node = build_field(UNKNOWN_LOCATION,
-                elna_string_type_node, "length", elna_word_type_node);
+                elna_string_type_node, "length", build_qualified_type(elna_word_type_node, TYPE_QUAL_CONST));
         elna_string_ptr_field_node = build_field(UNKNOWN_LOCATION,
-                elna_string_type_node, "ptr", string_ptr_type);
+                elna_string_type_node, "ptr", build_qualified_type(string_ptr_type, TYPE_QUAL_CONST));
 
         TYPE_FIELDS(elna_string_type_node) = chainon(elna_string_ptr_field_node, elna_string_length_field_node);
         layout_type(elna_string_type_node);
     }
+
+    static
+    tree declare_builtin_type(std::shared_ptr<symbol_table> symbol_table, const char *name, tree type)
+    {
+        tree identifier = get_identifier(name);
+        tree type_declaration = build_decl(UNKNOWN_LOCATION, TYPE_DECL, identifier, type);
+
+        TREE_PUBLIC(type_declaration) = 1;
+
+        symbol_table->enter(name, type_declaration);
+
+        return type_declaration;
+    }
+
+    std::shared_ptr<symbol_table> builtin_symbol_table()
+    {
+        std::shared_ptr<elna::gcc::symbol_table> symbol_table = std::make_shared<elna::gcc::symbol_table>();
+
+        declare_builtin_type(symbol_table, "Int", elna_int_type_node);
+        declare_builtin_type(symbol_table, "Word", elna_word_type_node);
+        declare_builtin_type(symbol_table, "Char", elna_char_type_node);
+        declare_builtin_type(symbol_table, "Bool", elna_bool_type_node);
+        declare_builtin_type(symbol_table, "Pointer", elna_pointer_type_node);
+        declare_builtin_type(symbol_table, "Float", elna_float_type_node);
+
+        tree string_declaration = declare_builtin_type(symbol_table, "String", elna_string_type_node);
+        TYPE_NAME(elna_string_type_node) = DECL_NAME(string_declaration);
+        TYPE_STUB_DECL(elna_string_type_node) = string_declaration;
+
+        return symbol_table;
+    }
+
+    tree build_type_declaration(const std::string& identifier, tree type)
+    {
+        tree definition_tree = build_decl(UNKNOWN_LOCATION, TYPE_DECL,
+                get_identifier(identifier.c_str()), type);
+
+        TREE_PUBLIC(definition_tree) = true;
+        if (is_unique_type(type))
+        {
+            TYPE_NAME(type) = DECL_NAME(definition_tree);
+            TYPE_STUB_DECL(type) = definition_tree;
+        }
+        else
+        {
+            TYPE_NAME(type) = definition_tree;
+        }
+        return definition_tree;
+    }
+
+    tree build_composite_type(const std::vector<boot::type_field>& fields, tree composite_type_node,
+            std::shared_ptr<symbol_table> symbols)
+    {
+        for (auto& field : fields)
+        {
+            tree rewritten_field = get_inner_alias(field.second, symbols);
+            tree field_declaration = build_field(UNKNOWN_LOCATION,
+                    composite_type_node, field.first, rewritten_field);
+            TYPE_FIELDS(composite_type_node) = chainon(TYPE_FIELDS(composite_type_node), field_declaration);
+        }
+        layout_type(composite_type_node);
+        return composite_type_node;
+    }
+
+    tree build_procedure_type(const boot::procedure_type& procedure, std::shared_ptr<symbol_table> symbols)
+    {
+        std::vector<tree> parameter_types(procedure.parameters.size());
+
+        for (std::size_t i = 0; i < procedure.parameters.size(); ++i)
+        {
+            parameter_types[i] = get_inner_alias(procedure.parameters.at(i), symbols);
+        }
+        tree return_type = void_type_node;
+
+        if (!procedure.return_type.proper_type.empty())
+        {
+            return_type = get_inner_alias(procedure.return_type.proper_type, symbols);
+        }
+        return build_function_type_array(return_type, procedure.parameters.size(), parameter_types.data());
+    }
+
+    tree get_inner_alias(const boot::type& type, std::shared_ptr<symbol_table> symbols)
+    {
+        if (auto reference = type.get<boot::primitive_type>())
+        {
+            auto looked_up = symbols->lookup(reference->identifier);
+            gcc_assert(looked_up != NULL_TREE);
+
+            return TREE_TYPE(looked_up);
+        }
+        else if (auto reference = type.get<boot::record_type>())
+        {
+            tree composite_type_node = make_node(RECORD_TYPE);
+
+            build_composite_type(reference->fields, composite_type_node, symbols);
+
+            return composite_type_node;
+        }
+        else if (auto reference = type.get<boot::union_type>())
+        {
+            tree composite_type_node = make_node(UNION_TYPE);
+
+            build_composite_type(reference->fields, composite_type_node, symbols);
+
+            return composite_type_node;
+        }
+        else if (auto reference = type.get<boot::enumeration_type>())
+        {
+            return build_enumeration_type(reference->members);
+        }
+        else if (auto reference = type.get<boot::pointer_type>())
+        {
+            return build_global_pointer_type(get_inner_alias(reference->base, symbols));
+        }
+        else if (auto reference = type.get<boot::array_type>())
+        {
+            tree base = get_inner_alias(reference->base, symbols);
+
+            return build_static_array_type(base, reference->size);
+        }
+        else if (auto reference = type.get<boot::procedure_type>())
+        {
+            auto procedure = build_procedure_type(*reference, symbols);
+
+            return build_global_pointer_type(procedure);
+        }
+        else if (auto reference = type.get<boot::alias_type>())
+        {
+            return handle_symbol(reference->name, reference, symbols);
+        }
+        return error_mark_node;
+    }
+
+    tree handle_symbol(const std::string& symbol_name, std::shared_ptr<boot::alias_type> reference,
+            std::shared_ptr<symbol_table> symbols)
+    {
+        tree looked_up = symbols->lookup(symbol_name);
+
+        if (looked_up == NULL_TREE)
+        {
+            looked_up = get_inner_alias(reference->reference, symbols);
+
+            symbols->enter(symbol_name, build_type_declaration(symbol_name, looked_up));
+        }
+        else
+        {
+            looked_up = TREE_TYPE(looked_up);
+        }
+        return looked_up;
+    }
+
+    void declare_procedure(const std::string& name, const boot::procedure_info& info,
+            std::shared_ptr<symbol_table> symbols)
+    {
+        tree declaration_type = gcc::build_procedure_type(info.symbol, symbols);
+        tree fndecl = build_fn_decl(name.c_str(), declaration_type);
+        symbols->enter(name, fndecl);
+
+        if (info.symbol.return_type.no_return)
+        {
+            TREE_THIS_VOLATILE(fndecl) = 1;
+        }
+        tree resdecl = build_decl(UNKNOWN_LOCATION, RESULT_DECL, NULL_TREE, TREE_TYPE(declaration_type));
+        DECL_CONTEXT(resdecl) = fndecl;
+        DECL_RESULT(fndecl) = resdecl;
+
+        tree argument_chain = NULL_TREE;
+        function_args_iterator parameter_type;
+        function_args_iter_init(&parameter_type, declaration_type);
+
+        std::vector<std::string>::const_iterator parameter_name = info.names.cbegin();
+
+        for (boot::type parameter : info.symbol.parameters)
+        {
+            tree declaration_tree = build_decl(UNKNOWN_LOCATION, PARM_DECL,
+                get_identifier(parameter_name->c_str()), function_args_iter_cond(&parameter_type));
+            DECL_CONTEXT(declaration_tree) = fndecl;
+            DECL_ARG_TYPE(declaration_tree) = function_args_iter_cond(&parameter_type);
+
+            argument_chain = chainon(argument_chain, declaration_tree);
+            function_args_iter_next(&parameter_type);
+            ++parameter_name;
+        }
+        DECL_ARGUMENTS(fndecl) = argument_chain;
+        TREE_ADDRESSABLE(fndecl) = 1;
+        DECL_EXTERNAL(fndecl) = info.symbols == nullptr;
+    }
+
+    void rewrite_symbol_table(std::shared_ptr<boot::symbol_table> info_table, std::shared_ptr<symbol_table> symbols)
+    {
+        for (auto& [symbol_name, symbol_info] : *info_table)
+        {
+            if (auto type_info = symbol_info->is_type())
+            {
+                // The top level symbol table has basic (builtin) types in it which are not aliases.
+                if (auto alias_type = type_info->symbol.get<boot::alias_type>())
+                {
+                    handle_symbol(symbol_name, alias_type, symbols);
+                }
+            }
+            else if (auto procedure_info = symbol_info->is_procedure())
+            {
+                declare_procedure(symbol_name, *procedure_info, symbols);
+            }
+        }
     }
 }

gcc/elna-diagnostic.cc

@@ -19,9 +19,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "elna/gcc/elna-tree.h"
 #include "elna/gcc/elna1.h"
 
-namespace elna
-{
-namespace gcc
+namespace elna::gcc
 {
     location_t get_location(const boot::position *position)
     {
@@ -30,51 +28,75 @@ namespace gcc
         return linemap_position_for_column(line_table, position->column);
     }
 
+    std::string print_aggregate_name(tree type, const std::string& kind_name)
+    {
+        if (TYPE_IDENTIFIER(type) == NULL_TREE)
+        {
+            return kind_name;
+        }
+        else
+        {
+            return std::string(IDENTIFIER_POINTER(TYPE_IDENTIFIER(type)));
+        }
+    }
+
     std::string print_type(tree type)
     {
         gcc_assert(TYPE_P(type));
 
-        if (type == elna_int_type_node)
+        tree unqualified_type = get_qualified_type(type, TYPE_UNQUALIFIED);
+        tree_code code = TREE_CODE(type);
+
+        if (unqualified_type == elna_int_type_node)
         {
             return "Int";
         }
-        else if (type == elna_word_type_node)
+        else if (unqualified_type == elna_word_type_node)
         {
             return "Word";
         }
-        else if (type == elna_bool_type_node)
+        else if (unqualified_type == elna_bool_type_node)
         {
             return "Bool";
         }
-        else if (type == elna_byte_type_node)
+        else if (unqualified_type == elna_pointer_type_node)
         {
-            return "Byte";
+            return "Pointer";
         }
-        else if (type == elna_float_type_node)
+        else if (unqualified_type == elna_float_type_node)
         {
             return "Float";
         }
-        else if (type == elna_char_type_node)
+        else if (unqualified_type == elna_char_type_node)
         {
             return "Char";
         }
-        else if (type == elna_string_type_node)
+        else if (unqualified_type == elna_string_type_node)
         {
             return "String";
         }
-        else if (is_void_type(type)) // For procedures without a return type.
+        else if (is_void_type(unqualified_type)) // For procedures without a return type.
         {
             return "()";
         }
-        else if (is_pointer_type(type))
+        else if (POINTER_TYPE_P(unqualified_type))
         {
-            return std::string("pointer to " + print_type(TREE_TYPE(type)));
+            tree pointer_target_type = TREE_TYPE(type);
+
+            if (TREE_CODE(pointer_target_type) == FUNCTION_TYPE)
+            {
+                return print_type(pointer_target_type);
             }
-        else if (is_procedure_type(type))
+            else
+            {
+                return std::string("^" + print_type(pointer_target_type));
+            }
+        }
+        else if (code == FUNCTION_TYPE)
         {
             std::string output = "proc(";
             tree parameter_type = TYPE_ARG_TYPES(type);
-            while (parameter_type != NULL_TREE)
+            while (TREE_VALUE(parameter_type) != void_type_node)
             {
                 output += print_type(TREE_VALUE(parameter_type));
                 parameter_type = TREE_CHAIN(parameter_type);
@@ -88,23 +110,29 @@ namespace gcc
                 }
             }
             output += ')';
-            if (!is_void_type(TREE_TYPE(type)))
+            tree return_type = TREE_TYPE(type);
+
+            if (!is_void_type(return_type))
             {
-                output += " -> " + print_type(TREE_TYPE(type));
+                output += " -> " + print_type(return_type);
             }
             return output;
         }
-        else if (is_array_type(type))
+        else if (code == ARRAY_TYPE)
         {
             return "array";
         }
-        else if (TREE_CODE(type) == RECORD_TYPE)
+        else if (code == RECORD_TYPE)
         {
-            return "record";
+            return print_aggregate_name(unqualified_type, "record");
         }
-        else if (TREE_CODE(type) == UNION_TYPE)
+        else if (code == UNION_TYPE)
         {
-            return "union";
+            return print_aggregate_name(unqualified_type, "union");
+        }
+        else if (code == ENUMERAL_TYPE)
+        {
+            return print_aggregate_name(unqualified_type, "enumeration");
         }
         else
         {
@@ -112,5 +140,18 @@ namespace gcc
         }
         gcc_unreachable();
     }
+
+    void report_errors(const std::deque<std::unique_ptr<boot::error>>& errors)
+    {
+        for (const auto& error : errors)
+        {
+            location_t gcc_location{ UNKNOWN_LOCATION };
+
+            if (error->position.line != 0 || error->position.column != 0)
+            {
+                gcc_location = elna::gcc::get_location(&error->position);
+            }
+            error_at(gcc_location, error->what().c_str());
+        }
     }
 }

gcc/elna-tree.cc

@@ -24,20 +24,12 @@ along with GCC; see the file COPYING3.  If not see
 #include "fold-const.h"
 #include "diagnostic-core.h"
 
-namespace elna
+namespace elna::gcc
 {
-namespace gcc
-{
-    bool is_pointer_type(tree type)
-    {
-        gcc_assert(TYPE_P(type));
-        return TREE_CODE(type) == POINTER_TYPE;
-    }
-
     bool is_integral_type(tree type)
     {
         gcc_assert(TYPE_P(type));
-        return TREE_CODE(type) == INTEGER_TYPE;
+        return TREE_CODE(type) == INTEGER_TYPE && type != elna_char_type_node;
     }
 
     bool is_numeric_type(tree type)
@@ -45,16 +37,10 @@ namespace gcc
         return is_integral_type(type) || type == elna_float_type_node;
     }
 
-    bool is_array_type(tree type)
+    bool is_unique_type(tree type)
     {
         gcc_assert(TYPE_P(type));
-        return TREE_CODE(type) == ARRAY_TYPE;
-    }
-
-    bool is_procedure_type(tree type)
-    {
-        gcc_assert(TYPE_P(type));
-        return TREE_CODE(type) == FUNCTION_TYPE;
+        return RECORD_OR_UNION_TYPE_P(type) || TREE_CODE(type) == ENUMERAL_TYPE;
     }
 
     bool is_void_type(tree type)
@@ -62,10 +48,10 @@ namespace gcc
         return type == NULL_TREE || type == void_type_node;
     }
 
-    bool is_aggregate_type(tree type)
+    bool is_castable_type(tree type)
     {
         gcc_assert(TYPE_P(type));
-        return TREE_CODE(type) == RECORD_TYPE || TREE_CODE(type) == UNION_TYPE;
+        return INTEGRAL_TYPE_P(type) || POINTER_TYPE_P(type) || TREE_CODE(type) == REAL_TYPE;
     }
 
     bool are_compatible_pointers(tree lhs_type, tree rhs)
@@ -73,13 +59,25 @@ namespace gcc
         gcc_assert(TYPE_P(lhs_type));
         tree rhs_type = TREE_TYPE(rhs);
 
-        return (is_pointer_type(lhs_type) && rhs == elna_pointer_nil_node)
-            || (is_pointer_type(lhs_type) && lhs_type == rhs_type);
+        return (POINTER_TYPE_P(lhs_type) && rhs == elna_pointer_nil_node)
+            || (POINTER_TYPE_P(lhs_type) && lhs_type == rhs_type);
+    }
+
+    tree prepare_rvalue(tree rvalue)
+    {
+        if (DECL_P(rvalue) && TREE_CODE(TREE_TYPE(rvalue)) == FUNCTION_TYPE)
+        {
+            return build1(ADDR_EXPR, build_pointer_type_for_mode(TREE_TYPE(rvalue), VOIDmode, true), rvalue);
+        }
+        else
+        {
+            return rvalue;
+        }
     }
 
     bool is_assignable_from(tree assignee, tree assignment)
     {
-        return TREE_TYPE(assignment) == assignee
+        return get_qualified_type(TREE_TYPE(assignment), TYPE_UNQUALIFIED) == assignee
             || are_compatible_pointers(assignee, assignment);
     }
 
@@ -131,51 +129,59 @@ namespace gcc
         return field_declaration;
     }
 
-    tree do_pointer_arithmetic(boot::binary_operator binary_operator, tree left, tree right)
+    tree do_pointer_arithmetic(boot::binary_operator binary_operator,
+            tree left, tree right, location_t operation_location)
     {
+        tree left_type = get_qualified_type(TREE_TYPE(left), TYPE_UNQUALIFIED);
+        tree right_type = get_qualified_type(TREE_TYPE(right), TYPE_UNQUALIFIED);
         if (binary_operator == boot::binary_operator::sum)
         {
             tree pointer{ NULL_TREE };
             tree offset{ NULL_TREE };
+            tree pointer_type{ NULL_TREE };
 
-            if (is_pointer_type(TREE_TYPE(left)) && is_integral_type(TREE_TYPE(right)))
+            if (POINTER_TYPE_P(left_type) && is_integral_type(right_type))
             {
                 pointer = left;
                 offset = right;
+                pointer_type = left_type;
             }
-            else if (is_integral_type(TREE_TYPE(left)) && is_pointer_type(TREE_TYPE(right)))
+            else if (is_integral_type(left_type) && POINTER_TYPE_P(right_type))
             {
                 pointer = right;
                 offset = left;
+                pointer_type = right_type;
             }
             else
             {
                 return error_mark_node;
             }
-            tree size_exp = fold_convert(TREE_TYPE(offset), size_in_bytes(TREE_TYPE(TREE_TYPE(pointer))));
+            tree size_exp = pointer_type == elna_pointer_type_node
+                ? size_one_node
+                : fold_convert(TREE_TYPE(offset), size_in_bytes(TREE_TYPE(TREE_TYPE(pointer))));
 
             offset = fold_build2(MULT_EXPR, TREE_TYPE(offset), offset, size_exp);
             offset = fold_convert(sizetype, offset);
 
-            return fold_build2(POINTER_PLUS_EXPR, TREE_TYPE(pointer), pointer, offset);
+            return fold_build2_loc(operation_location, POINTER_PLUS_EXPR, TREE_TYPE(pointer), pointer, offset);
         }
         else if (binary_operator == boot::binary_operator::subtraction)
         {
-            if (is_pointer_type(TREE_TYPE(left)) && is_integral_type(TREE_TYPE(right)))
+            if (POINTER_TYPE_P(left_type) && is_integral_type(right_type))
             {
-                tree pointer_type = TREE_TYPE(left);
-                tree offset_type = TREE_TYPE(right);
+                tree pointer_type = left_type;
+                tree offset_type = right_type;
                 tree size_exp = fold_convert(offset_type, size_in_bytes(TREE_TYPE(pointer_type)));
 
                 tree convert_expression = fold_build2(MULT_EXPR, offset_type, right, size_exp);
                 convert_expression = fold_convert(sizetype, convert_expression);
 
                 convert_expression = fold_build1(NEGATE_EXPR, sizetype, convert_expression);
-                return fold_build2(POINTER_PLUS_EXPR, pointer_type, left, convert_expression);
-            } else if (is_pointer_type(TREE_TYPE(left)) && is_pointer_type(TREE_TYPE(right))
-                    && TREE_TYPE(left) == TREE_TYPE(right))
+                return fold_build2_loc(operation_location, POINTER_PLUS_EXPR, pointer_type, left, convert_expression);
+            }
+            else if (POINTER_TYPE_P(left_type) && POINTER_TYPE_P(right_type) && left_type == right_type)
             {
-                return fold_build2(POINTER_DIFF_EXPR, ssizetype, left, right);
+                return fold_build2_loc(operation_location, POINTER_DIFF_EXPR, ssizetype, left, right);
             }
         }
         gcc_unreachable();
@@ -185,12 +191,12 @@ namespace gcc
             tree_code operator_code, tree left, tree right, tree target_type)
     {
         location_t expression_location = get_location(&expression->position());
-        tree left_type = TREE_TYPE(left);
-        tree right_type = TREE_TYPE(right);
+        tree left_type = get_qualified_type(TREE_TYPE(left), TYPE_UNQUALIFIED);
+        tree right_type = get_qualified_type(TREE_TYPE(right), TYPE_UNQUALIFIED);
 
         if (condition)
         {
-            return build2_loc(expression_location, operator_code, target_type, left, right);
+            return fold_build2_loc(expression_location, operator_code, target_type, left, right);
         }
         else
         {
@@ -201,5 +207,111 @@ namespace gcc
             return error_mark_node;
         }
     }
+
+    tree find_field_by_name(location_t expression_location, tree type, const std::string& field_name)
+    {
+        if (type == error_mark_node)
+        {
+            return type;
+        }
+        tree field_declaration = TYPE_FIELDS(type);
+
+        if (!RECORD_OR_UNION_TYPE_P(type))
+        {
+            error_at(expression_location, "Type '%s' does not have a field named '%s'",
+                    print_type(type).c_str(), field_name.c_str());
+            return error_mark_node;
+        }
+        while (field_declaration != NULL_TREE)
+        {
+            tree declaration_name = DECL_NAME(field_declaration);
+            const char *identifier_pointer = IDENTIFIER_POINTER(declaration_name);
+
+            if (field_name == identifier_pointer)
+            {
+                break;
+            }
+            field_declaration = TREE_CHAIN(field_declaration);
+        }
+        if (field_declaration == NULL_TREE)
+        {
+            error_at(expression_location, "Aggregate type does not have a field '%s'", field_name.c_str());
+            return error_mark_node;
+        }
+        return field_declaration;
+    }
+
+    tree build_global_pointer_type(tree type)
+    {
+        return build_pointer_type_for_mode(type, VOIDmode, true);
+    }
+
+    tree build_static_array_type(tree type, const std::uint64_t size)
+    {
+        tree lower_bound = build_int_cst_type(integer_type_node, 0);
+        tree upper_bound = build_int_cst_type(integer_type_node, size);
+        tree range_type = build_range_type(integer_type_node, lower_bound, upper_bound);
+
+        return build_array_type(type, range_type);
+    }
+
+    tree build_enumeration_type(const std::vector<std::string>& members)
+    {
+        tree composite_type_node = make_node(ENUMERAL_TYPE);
+        const tree base_type = integer_type_node;
+
+        TREE_TYPE(composite_type_node) = base_type;
+        ENUM_IS_SCOPED(composite_type_node) = 1;
+
+        tree *pp = &TYPE_VALUES(composite_type_node);
+        std::size_t order{ 1 };
+
+        for (const std::string& member : members)
+        {
+            tree member_name = get_identifier(member.c_str());
+            tree member_declaration = build_decl(UNKNOWN_LOCATION, CONST_DECL, member_name, composite_type_node);
+
+            DECL_CONTEXT(member_declaration) = composite_type_node;
+            DECL_INITIAL(member_declaration) = build_int_cst_type(composite_type_node, order++);
+            TREE_CONSTANT(member_declaration) = 1;
+            TREE_READONLY(member_declaration) = 1;
+
+            TYPE_MAX_VALUE(composite_type_node) = DECL_INITIAL(member_declaration);
+
+            *pp = build_tree_list(member_name, member_declaration);
+            pp = &TREE_CHAIN(*pp);
+        }
+        TYPE_MIN_VALUE(composite_type_node) = DECL_INITIAL(TREE_VALUE(TYPE_VALUES(composite_type_node)));
+        TYPE_UNSIGNED(composite_type_node) = TYPE_UNSIGNED(base_type);
+        SET_TYPE_ALIGN(composite_type_node, TYPE_ALIGN(base_type));
+        TYPE_SIZE(composite_type_node) = NULL_TREE;
+        TYPE_PRECISION(composite_type_node) = TYPE_PRECISION(base_type);
+
+        layout_type(composite_type_node);
+        return composite_type_node;
+    }
+
+    tree build_label_decl(const char *name, location_t loc)
+    {
+        auto label_decl = build_decl(loc, LABEL_DECL, get_identifier(name), void_type_node);
+
+        DECL_CONTEXT(label_decl) = current_function_decl;
+
+        return label_decl;
+    }
+
+    tree extract_constant(tree expression)
+    {
+        int code = TREE_CODE(expression);
+
+        if (code == CONST_DECL)
+        {
+            return DECL_INITIAL(expression);
+        }
+        else if (TREE_CODE_CLASS(code) == tcc_constant)
+        {
+            return expression;
+        }
+        return NULL_TREE;
     }
 }

gcc/elna1.cc

@@ -29,12 +29,11 @@ along with GCC; see the file COPYING3.  If not see
 #include "langhooks-def.h"
 
 #include <fstream>
-#include "elna/boot/driver.h"
+#include "elna/boot/dependency.h"
 #include "elna/gcc/elna-tree.h"
 #include "elna/gcc/elna-generic.h"
 #include "elna/gcc/elna-diagnostic.h"
 #include "elna/gcc/elna-builtins.h"
-#include "parser.hh"
 
 tree elna_global_trees[ELNA_TI_MAX];
 hash_map<nofree_string_hash, tree> *elna_global_decls = nullptr;
@@ -71,26 +70,46 @@ static void elna_parse_file(const char *filename)
     {
         fatal_error(UNKNOWN_LOCATION, "cannot open filename %s: %m", filename);
     }
+    elna::boot::dependency_graph outcome = elna::boot::read_sources(file, filename);
 
-    elna::boot::driver driver{ filename };
-    elna::boot::lexer lexer(file);
-    yy::parser parser(lexer, driver);
+    std::shared_ptr<elna::boot::symbol_table> info_table = elna::boot::builtin_symbol_table();
+    std::shared_ptr<elna::gcc::symbol_table> symbol_table = elna::gcc::builtin_symbol_table();
 
     linemap_add(line_table, LC_ENTER, 0, filename, 1);
-    if (parser())
+    if (outcome.has_errors())
     {
-        for (const auto& error : driver.errors())
+        elna::gcc::report_errors(outcome.errors());
+    }
+    else
     {
-            auto gcc_location = elna::gcc::get_location(&error->position);
+        for (const std::unique_ptr<elna::boot::program>& module_tree : outcome.modules)
+        {
+            elna::boot::declaration_visitor declaration_visitor(filename);
+            declaration_visitor.visit(module_tree.get());
 
-            error_at(gcc_location, error->what().c_str());
+            if (declaration_visitor.errors().empty())
+            {
+                elna::boot::name_analysis_visitor name_analysis_visitor(filename, info_table,
+                        std::move(declaration_visitor.unresolved));
+                name_analysis_visitor.visit(module_tree.get());
+
+                if (name_analysis_visitor.errors().empty())
+                {
+                    elna::gcc::rewrite_symbol_table(info_table, symbol_table);
+
+                    elna::gcc::generic_visitor generic_visitor{ symbol_table, info_table };
+                    generic_visitor.visit(module_tree.get());
+                }
+                else
+                {
+                    elna::gcc::report_errors(name_analysis_visitor.errors());
                 }
             }
             else
             {
-        elna::gcc::generic_visitor generic_visitor{ std::make_shared<elna::boot::symbol_table<tree>>() };
-
-        generic_visitor.visit(driver.tree.get());
+                elna::gcc::report_errors(declaration_visitor.errors());
+            }
+        }
     }
     linemap_add(line_table, LC_LEAVE, 0, NULL, 0);
 }
@@ -186,6 +205,11 @@ static tree elna_langhook_builtin_function(tree decl)
     return decl;
 }
 
+static unsigned int elna_langhook_option_lang_mask(void)
+{
+    return CL_Elna;
+}
+
 /* Creates an expression whose value is that of EXPR, converted to type TYPE.
    This function implements all reasonable scalar conversions.  */
 tree convert(tree type, tree expr)
@@ -222,6 +246,9 @@ tree convert(tree type, tree expr)
 #undef LANG_HOOKS_IDENTIFIER_SIZE
 #define LANG_HOOKS_IDENTIFIER_SIZE sizeof(struct tree_identifier)
 
+#undef LANG_HOOKS_OPTION_LANG_MASK
+#define LANG_HOOKS_OPTION_LANG_MASK elna_langhook_option_lang_mask
+
 struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 
 #include "gt-elna-elna1.h"

gcc/gelna.texi

@@ -0,0 +1,135 @@
+\input texinfo @c -*-texinfo-*-
+@setfilename gelna.info
+@settitle The GNU Elna Compiler
+
+@c Create a separate index for command line options
+@defcodeindex op
+@c Merge the standard indexes into a single one.
+@syncodeindex fn cp
+@syncodeindex vr cp
+@syncodeindex ky cp
+@syncodeindex pg cp
+@syncodeindex tp cp
+
+@include gcc-common.texi
+
+@c Copyright years for this manual.
+@set copyrights-elna 2025
+
+@copying
+@c man begin COPYRIGHT
+Copyright @copyright{} @value{copyrights-elna} Free Software Foundation, Inc.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.
+A copy of the license is included in the
+@c man end
+section entitled ``GNU Free Documentation License''.
+@ignore
+@c man begin COPYRIGHT
+man page gfdl(7).
+@c man end
+@end ignore
+@end copying
+
+@ifinfo
+@format
+@dircategory Software development
+@direntry
+* Gelna: (gelna).           A GCC-based compiler for the Elna language
+@end direntry
+@end format
+
+@insertcopying
+@end ifinfo
+
+@titlepage
+@title The GNU Elna Compiler
+@versionsubtitle
+@author Eugen Wissner
+
+@page
+@vskip 0pt plus 1filll
+Published by the Free Software Foundation @*
+51 Franklin Street, Fifth Floor@*
+Boston, MA 02110-1301, USA@*
+@sp 1
+@insertcopying
+@end titlepage
+@contents
+@page
+
+@node Top
+@top Introduction
+
+This manual describes how to use @command{gelna}, the GNU compiler for
+the Elna programming language.  This manual is specifically about how to
+invoke @command{gelna}.
+
+@menu
+* Copying::                     The GNU General Public License.
+* GNU Free Documentation License::
+                                How you can share and copy this manual.
+* Invoking gelna::              How to run gelna.
+* Option Index::                Index of command line options.
+* Keyword Index::               Index of concepts.
+@end menu
+
+
+@include gpl_v3.texi
+
+@include fdl.texi
+
+
+@node Invoking gelna
+@chapter Invoking gelna
+
+@c man title gelna A GCC-based compiler for the Elna language
+
+@ignore
+@c man begin SYNOPSIS gelna
+gelna [@option{-c}|@option{-S}]
+      [@option{-g}] [@option{-pg}]
+      [@option{-o} @var{outfile}] @var{infile}@dots{}
+
+Only the most useful options are listed here; see below for the
+remainder.
+@c man end
+@c man begin SEEALSO
+gpl(7), gfdl(7), fsf-funding(7), gcc(1)
+and the Info entries for @file{gelna} and @file{gcc}.
+@c man end
+@end ignore
+
+@c man begin DESCRIPTION gelna
+
+The @command{gelna} command is a frontend to @command{gcc} and
+supports many of the same options.  @xref{Option Summary, , Option
+Summary, gcc, Using the GNU Compiler Collection (GCC)}.  This manual
+only documents the options specific to @command{gelna}.
+
+@c man end
+
+@c man begin OPTIONS gelna
+
+@c man end
+
+@node Option Index
+@unnumbered Option Index
+
+@command{gelna}'s command line options are indexed here without any
+initial @samp{-} or @samp{--}.  Where an option has both positive and
+negative forms (such as -foption and -fno-option), relevant entries in
+the manual are indexed under the most appropriate form; it may sometimes
+be useful to look up both forms.
+
+@printindex op
+
+@node Keyword Index
+@unnumbered Keyword Index
+
+@printindex cp
+
+@bye

gcc/lang-specs.h

@@ -19,7 +19,9 @@ along with GCC; see the file COPYING3.  If not see
 {".elna",  "@elna", nullptr, 0, 0},
 {"@elna",
     "elna1 %i \
-    %{!Q:-quiet} \
+    %{!Q:-quiet} " DUMPS_OPTIONS("") " %{m*} %{aux-info*} \
+    %{g*} %{O*} %{W*&pedantic*} %{w} %{std*&ansi&trigraphs} \
+    %{pg:-p} %{p} %{f*} %{undef} \
     %{!fsyntax-only:%{S:%W{o*}%{!o*:-o %w%b.s}}} \
     %{fsyntax-only:-o %j} %{-param*} \
     %{!fsyntax-only:%(invoke_as)}",

gcc/lang.opt

@@ -0,0 +1,23 @@
+; lang.opt -- Options for the Elna front end.
+; Copyright (C) 2025 Free Software Foundation, Inc.
+;
+; GCC is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free
+; Software Foundation; either version 3, or (at your option) any later
+; version.
+;
+; GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+; for more details.
+;
+; You should have received a copy of the GNU General Public License
+; along with GCC; see the file COPYING3.  If not see
+; <http://www.gnu.org/licenses/>.
+
+; See the GCC internals manual for a description of this file's format.
+
+; Please try to keep this file in ASCII collating order.
+
+Language
+Elna

gcc/lang.opt.urls

@@ -0,0 +1,2 @@
+; Autogenerated by regenerate-opt-urls.py from gcc/lang.opt and generated HTML
+

include/elna/boot/ast.h

@@ -21,11 +21,11 @@ along with GCC; see the file COPYING3.  If not see
 #include <memory>
 #include <string>
 #include <vector>
+#include <optional>
+#include "elna/boot/symbol.h"
 #include "elna/boot/result.h"
 
-namespace elna
-{
-namespace boot
+namespace elna::boot
 {
     enum class binary_operator
     {
@@ -55,32 +55,37 @@ namespace boot
     };
 
     class variable_declaration;
-    class constant_definition;
-    class procedure_definition;
-    class type_definition;
-    class call_expression;
+    class constant_declaration;
+    class procedure_declaration;
+    class type_declaration;
+    class procedure_call;
     class cast_expression;
-    class type_expression;
     class assign_statement;
     class if_statement;
+    class import_declaration;
     class while_statement;
     class return_statement;
-    class call_statement;
-    class block;
+    class case_statement;
+    class traits_expression;
+    class unit;
     class program;
     class binary_expression;
     class unary_expression;
-    class basic_type;
-    class array_type;
-    class pointer_type;
-    class record_type;
-    class union_type;
+    class named_type_expression;
+    class array_type_expression;
+    class pointer_type_expression;
+    class record_type_expression;
+    class union_type_expression;
+    class procedure_type_expression;
+    class enumeration_type_expression;
     class variable_expression;
     class array_access_expression;
     class field_access_expression;
     class dereference_expression;
+    class designator_expression;
+    class literal_expression;
     template<typename T>
-    class number_literal;
+    class literal;
     class defer_statement;
 
     /**
@@ -89,78 +94,41 @@ namespace boot
     struct parser_visitor
     {
         virtual void visit(variable_declaration *) = 0;
-        virtual void visit(constant_definition *) = 0;
-        virtual void visit(procedure_definition *) = 0;
-        virtual void visit(type_definition *) = 0;
-        virtual void visit(call_expression *) = 0;
+        virtual void visit(constant_declaration *) = 0;
+        virtual void visit(procedure_declaration *) = 0;
+        virtual void visit(type_declaration *) = 0;
+        virtual void visit(procedure_call *) = 0;
         virtual void visit(cast_expression *) = 0;
-        virtual void visit(type_expression *) = 0;
-        virtual void visit(call_statement *) = 0;
+        virtual void visit(traits_expression *) = 0;
         virtual void visit(assign_statement *) = 0;
         virtual void visit(if_statement *) = 0;
+        virtual void visit(import_declaration *) = 0;
         virtual void visit(while_statement *) = 0;
         virtual void visit(return_statement *) = 0;
         virtual void visit(defer_statement *) = 0;
-        virtual void visit(block *) = 0;
+        virtual void visit(case_statement *) = 0;
+        virtual void visit(unit *) = 0;
         virtual void visit(program *) = 0;
         virtual void visit(binary_expression *) = 0;
         virtual void visit(unary_expression *) = 0;
-        virtual void visit(basic_type *) = 0;
-        virtual void visit(array_type *) = 0;
-        virtual void visit(pointer_type *) = 0;
-        virtual void visit(record_type *) = 0;
-        virtual void visit(union_type *) = 0;
+        virtual void visit(named_type_expression *) = 0;
+        virtual void visit(array_type_expression *) = 0;
+        virtual void visit(pointer_type_expression *) = 0;
+        virtual void visit(record_type_expression *) = 0;
+        virtual void visit(union_type_expression *) = 0;
+        virtual void visit(procedure_type_expression *) = 0;
+        virtual void visit(enumeration_type_expression *) = 0;
         virtual void visit(variable_expression *) = 0;
         virtual void visit(array_access_expression *) = 0;
-        virtual void visit(field_access_expression *is_field_access) = 0;
-        virtual void visit(dereference_expression *is_dereference) = 0;
-        virtual void visit(number_literal<std::int32_t> *) = 0;
-        virtual void visit(number_literal<std::uint32_t> *) = 0;
-        virtual void visit(number_literal<double> *) = 0;
-        virtual void visit(number_literal<bool> *) = 0;
-        virtual void visit(number_literal<unsigned char> *) = 0;
-        virtual void visit(number_literal<std::nullptr_t> *) = 0;
-        virtual void visit(number_literal<std::string> *) = 0;
-    };
-
-    /**
-     * A visitor which visits all nodes but does nothing.
-     */
-    struct empty_visitor : parser_visitor
-    {
-        virtual void visit(variable_declaration *) override;
-        virtual void visit(constant_definition *definition) override;
-        virtual void visit(procedure_definition *definition) override;
-        virtual void visit(type_definition *definition) override;
-        virtual void visit(call_expression *expression) override;
-        virtual void visit(cast_expression *expression) override;
-        virtual void visit(type_expression *expression) override;
-        virtual void visit(call_statement *statement) override;
-        virtual void visit(assign_statement *statement) override;
-        virtual void visit(if_statement *) override;
-        virtual void visit(while_statement *) override;
-        virtual void visit(return_statement *) override;
-        virtual void visit(defer_statement *defer) override;
-        virtual void visit(block *block) override;
-        virtual void visit(program *program) override;
-        virtual void visit(binary_expression *expression) override;
-        virtual void visit(unary_expression *expression) override;
-        virtual void visit(basic_type *) override;
-        virtual void visit(array_type *expression) override;
-        virtual void visit(pointer_type *) override;
-        virtual void visit(record_type *expression) override;
-        virtual void visit(union_type *expression) override;
-        virtual void visit(variable_expression *) override;
-        virtual void visit(array_access_expression *expression) override;
-        virtual void visit(field_access_expression *expression) override;
-        virtual void visit(dereference_expression *expression) override;
-        virtual void visit(number_literal<std::int32_t> *) override;
-        virtual void visit(number_literal<std::uint32_t> *) override;
-        virtual void visit(number_literal<double> *) override;
-        virtual void visit(number_literal<bool> *) override;
-        virtual void visit(number_literal<unsigned char> *) override;
-        virtual void visit(number_literal<std::nullptr_t> *) override;
-        virtual void visit(number_literal<std::string> *) override;
+        virtual void visit(field_access_expression *) = 0;
+        virtual void visit(dereference_expression *) = 0;
+        virtual void visit(literal<std::int32_t> *) = 0;
+        virtual void visit(literal<std::uint32_t> *) = 0;
+        virtual void visit(literal<double> *) = 0;
+        virtual void visit(literal<bool> *) = 0;
+        virtual void visit(literal<unsigned char> *) = 0;
+        virtual void visit(literal<std::nullptr_t> *) = 0;
+        virtual void visit(literal<std::string> *) = 0;
     };
 
     /**
@@ -177,8 +145,8 @@ namespace boot
         explicit node(const position position);
 
     public:
-        virtual ~node() = default;
-        virtual void accept(parser_visitor *) = 0;
+        virtual void accept(parser_visitor *visitor) = 0;
+        virtual ~node() = 0;
 
         /**
          * \return Node position in the source code.
@@ -186,245 +154,265 @@ namespace boot
         const struct position& position() const;
     };
 
-    class statement : public node
+    class statement : public virtual node
     {
-    protected:
-        /**
-         * \param position Source code position.
-         */
-        explicit statement(const struct position position);
     };
 
-    class expression : public node
+    class expression : public virtual node
     {
-    protected:
-        /**
-         * \param position Source code position.
-         */
-        explicit expression(const struct position position);
+    public:
+        virtual cast_expression *is_cast();
+        virtual traits_expression *is_traits();
+        virtual binary_expression *is_binary();
+        virtual unary_expression *is_unary();
+        virtual designator_expression *is_designator();
+        virtual procedure_call *is_call_expression();
+        virtual literal_expression *is_literal();
+    };
+
+    struct identifier_definition
+    {
+        std::string identifier;
+        bool exported;
     };
 
     /**
      * Symbol definition.
      */
-    class definition : public node
+    class declaration : public node
     {
     protected:
-        definition(const struct position position, const std::string& identifier, const bool exported);
+        declaration(const struct position position, identifier_definition identifier);
 
     public:
-        const std::string identifier;
-        const bool exported;
+        const identifier_definition identifier;
     };
 
     /**
      * Some type expression.
      */
-    class top_type : public node
+    class type_expression : public node
     {
     public:
-        virtual basic_type *is_basic();
-        virtual array_type *is_array();
-        virtual pointer_type *is_pointer();
-        virtual record_type *is_record();
-        virtual union_type *is_union();
+        virtual named_type_expression *is_named();
+        virtual array_type_expression *is_array();
+        virtual pointer_type_expression *is_pointer();
+        virtual record_type_expression *is_record();
+        virtual union_type_expression *is_union();
+        virtual procedure_type_expression *is_procedure();
+        virtual enumeration_type_expression *is_enumeration();
 
     protected:
-        top_type(const struct position position);
+        type_expression(const struct position position);
     };
 
     /**
-     * Expression defining a basic type.
+     * Expression refering to a type by its name.
      */
-    class basic_type : public top_type
+    class named_type_expression : public type_expression
     {
-        const std::string m_name;
-
     public:
-        /**
-         * \param position Source code position.
-         * \param name Type name.
-         */
-        basic_type(const struct position position, const std::string& name);
-        virtual void accept(parser_visitor *visitor) override;
+        const std::string name;
 
-        const std::string& base_name();
-
-        basic_type *is_basic() override;
+        named_type_expression(const struct position position, const std::string& name);
+        void accept(parser_visitor *visitor) override;
+        named_type_expression *is_named() override;
     };
 
-    class array_type : public top_type
+    class array_type_expression : public type_expression
     {
-        top_type *m_base;
+        type_expression *m_base;
 
     public:
         const std::uint32_t size;
 
-        array_type(const struct position position, top_type*base, const std::uint32_t size);
-        virtual void accept(parser_visitor *visitor) override;
+        array_type_expression(const struct position position,
+                type_expression *base, const std::uint32_t size);
+        ~array_type_expression();
 
-        top_type& base();
+        void accept(parser_visitor *visitor) override;
+        array_type_expression *is_array() override;
 
-        array_type *is_array() override;
-
-        virtual ~array_type() override;
+        type_expression& base();
     };
 
-    class pointer_type : public top_type
+    class pointer_type_expression : public type_expression
     {
-        top_type *m_base;
+        type_expression *m_base;
 
     public:
-        pointer_type(const struct position position, top_type *base);
-        virtual void accept(parser_visitor *visitor) override;
+        pointer_type_expression(const struct position position, type_expression *base);
+        ~pointer_type_expression();
 
-        top_type& base();
+        void accept(parser_visitor *visitor) override;
+        pointer_type_expression *is_pointer() override;
 
-        pointer_type *is_pointer() override;
-
-        virtual ~pointer_type() override;
+        type_expression& base();
     };
 
-    using field_t = std::pair<std::string, top_type *>;
-    using fields_t = std::vector<field_t>;
+    using field_declaration = std::pair<std::string, type_expression *>;
 
-    class composite_type : public top_type
+    class record_type_expression : public type_expression
     {
-    protected:
-        composite_type(const struct position position, fields_t&& fields);
-
     public:
-        fields_t fields;
+        const std::vector<field_declaration> fields;
 
-        virtual ~composite_type() override;
+        record_type_expression(const struct position position, std::vector<field_declaration>&& fields);
+        ~record_type_expression();
+
+        void accept(parser_visitor *visitor) override;
+        record_type_expression *is_record() override;
     };
 
-    class record_type : public composite_type
+    class union_type_expression : public type_expression
     {
     public:
-        record_type(const struct position position, fields_t&& fields);
+        std::vector<field_declaration> fields;
 
-        virtual void accept(parser_visitor *visitor) override;
-        record_type *is_record() override;
+        union_type_expression(const struct position position, std::vector<field_declaration>&& fields);
+        ~union_type_expression();
+
+        void accept(parser_visitor *visitor) override;
+        union_type_expression *is_union() override;
     };
 
-    class union_type : public composite_type
+    /**
+     * Enumeration type.
+     */
+    class enumeration_type_expression : public type_expression
     {
     public:
-        union_type(const struct position position, fields_t&& fields);
+        const std::vector<std::string> members;
 
-        virtual void accept(parser_visitor *visitor) override;
-        union_type *is_union() override;
+        enumeration_type_expression(const struct position, std::vector<std::string>&& members);
+
+        void accept(parser_visitor *visitor) override;
+        enumeration_type_expression *is_enumeration() override;
     };
 
     /**
      * Variable declaration.
      */
-    class variable_declaration : public definition
+    class variable_declaration : public declaration
     {
-        top_type *m_type;
+        std::shared_ptr<type_expression> m_variable_type;
 
     public:
-        variable_declaration(const struct position position, const std::string& identifier,
-                const bool exported, top_type *type);
-        virtual void accept(parser_visitor *visitor) override;
+        variable_declaration(const struct position position, identifier_definition identifier,
+                std::shared_ptr<type_expression> variable_type);
 
-        top_type& variable_type();
+        void accept(parser_visitor *visitor) override;
 
-        virtual ~variable_declaration() override;
+        type_expression& variable_type();
     };
 
     /**
      * Literal expression.
      */
-    class literal : public expression
+    class literal_expression : public expression
     {
+    public:
+        literal_expression *is_literal() override;
+
     protected:
-        explicit literal(const struct position position);
+        literal_expression();
     };
 
     /**
      * Constant definition.
      */
-    class constant_definition : public definition
+    class constant_declaration : public declaration
     {
-        literal *m_body;
+        expression *m_body;
 
     public:
+        constant_declaration(const struct position position, identifier_definition identifier,
+                expression *body);
+        void accept(parser_visitor *visitor) override;
+
+        expression& body();
+
+        virtual ~constant_declaration() override;
+    };
+
     /**
-         * \param position Source code position.
-         * \param identifier Constant name.
-         * \param body Constant value.
+     * Procedure type.
      */
-        constant_definition(const struct position position, const std::string& identifier,
-                const bool exported, literal *body);
-        virtual void accept(parser_visitor *visitor) override;
+    class procedure_type_expression : public type_expression
+    {
+    public:
+        using return_t = return_declaration<type_expression *>;
 
-        literal& body();
+        const return_t return_type;
+        std::vector<type_expression *> parameters;
+
+        procedure_type_expression(const struct position position, return_t return_type = return_t());
+        ~procedure_type_expression();
+
+        void accept(parser_visitor *visitor) override;
+        procedure_type_expression *is_procedure() override;
+    };
+
+    struct block
+    {
+        block(std::vector<constant_declaration*>&& constants, std::vector<variable_declaration *>&& variables,
+                std::vector<statement *>&& body);
+        block(const block&) = delete;
+        block(block&& that);
+
+        block& operator=(const block&) = delete;
+        block& operator=(block&& that);
+
+        const std::vector<variable_declaration *>& variables();
+        const std::vector<constant_declaration *>& constants();
+        const std::vector<statement *>& body();
+
+        virtual ~block();
+
+    private:
+        std::vector<variable_declaration *> m_variables;
+        std::vector<constant_declaration *> m_constants;
+        std::vector<statement *> m_body;
 
-        virtual ~constant_definition() override;
     };
 
     /**
      * Procedure definition.
      */
-    class procedure_definition : public definition
+    class procedure_declaration : public declaration
     {
-        top_type *m_return_type{ nullptr };
-        block *m_body{ nullptr };
+        procedure_type_expression *m_heading;
 
     public:
-        std::vector<variable_declaration *> parameters;
+        std::optional<block> body;
+        std::vector<std::string> parameter_names;
 
-        procedure_definition(const struct position position, const std::string& identifier,
-                const bool exported, top_type *return_type = nullptr);
-        virtual void accept(parser_visitor *visitor) override;
+        procedure_declaration(const struct position position, identifier_definition identifier,
+                procedure_type_expression *heading, block&& body);
+        procedure_declaration(const struct position position, identifier_definition identifier,
+                procedure_type_expression *heading);
+        void accept(parser_visitor *visitor) override;
 
-        top_type *return_type();
+        procedure_type_expression& heading();
 
-        block *body();
-        procedure_definition *add_body(block *procedure_body);
-
-        virtual ~procedure_definition() override;
+        virtual ~procedure_declaration() override;
     };
 
     /**
      * Type definition.
      */
-    class type_definition : public definition
+    class type_declaration : public declaration
     {
-        top_type *m_body;
+        type_expression *m_body;
 
     public:
-        type_definition(const struct position position, const std::string& identifier,
-                const bool exported, top_type *expression);
-        virtual void accept(parser_visitor *visitor) override;
+        type_declaration(const struct position position, identifier_definition identifier,
+                type_expression *expression);
+        ~type_declaration();
 
-        top_type& body();
+        void accept(parser_visitor *visitor) override;
 
-        virtual ~type_definition() override;
-    };
-
-    /**
-     * Procedure call expression.
-     */
-    class call_expression : public expression
-    {
-        std::string m_name;
-        std::vector<expression *> m_arguments;
-
-    public:
-        /**
-         * \param position Source code position.
-         * \param name Callable's name.
-         */
-        call_expression(const struct position position, const std::string& name);
-        virtual void accept(parser_visitor *visitor) override;
-
-        std::string& name();
-        std::vector<expression *>& arguments();
-
-        virtual ~call_expression() override;
+        type_expression& body();
     };
 
     /**
@@ -432,46 +420,34 @@ namespace boot
      */
     class cast_expression : public expression
     {
-        top_type *m_target;
+        type_expression *m_target;
         expression *m_value;
 
     public:
-        cast_expression(const struct position position, top_type *target, expression *value);
-        virtual void accept(parser_visitor *visitor) override;
+        type expression_type;
 
-        top_type& target();
+        cast_expression(const struct position position, type_expression *target, expression *value);
+        void accept(parser_visitor *visitor) override;
+        cast_expression *is_cast() override;
+
+        type_expression& target();
         expression& value();
 
         virtual ~cast_expression() override;
     };
 
-    /**
-     * Type inside an expression.
-     */
-    class type_expression : public expression
+    class traits_expression : public expression
     {
-        top_type *m_body;
-
     public:
-        type_expression(const struct position position, top_type *body);
-        virtual void accept(parser_visitor *visitor) override;
+        std::vector<type_expression *> parameters;
+        const std::string name;
+        std::vector<type> types;
 
-        top_type& body();
+        traits_expression(const struct position position, const std::string& name);
+        ~traits_expression();
 
-        virtual ~type_expression() override;
-    };
-
-    class call_statement : public statement
-    {
-        call_expression *m_body;
-
-    public:
-        call_statement(const struct position position, call_expression *body);
-        virtual void accept(parser_visitor *visitor) override;
-
-        call_expression& body();
-
-        virtual ~call_statement() override;
+        void accept(parser_visitor *visitor) override;
+        traits_expression *is_traits() override;
     };
 
     /**
@@ -482,9 +458,9 @@ namespace boot
         expression *m_prerequisite;
 
     public:
-        std::vector<statement *> statements;
+        const std::vector<statement *> statements;
 
-        conditional_statements(expression *prerequisite);
+        conditional_statements(expression *prerequisite, std::vector<statement *>&& statements);
 
         expression& prerequisite();
 
@@ -493,17 +469,37 @@ namespace boot
 
     class return_statement : public statement
     {
-        expression *m_return_expression{ nullptr };
-
     public:
-        return_statement(const struct position position, expression *return_expression);
-        virtual void accept(parser_visitor *visitor) override;
+        expression *m_return_expression;
 
-        expression *return_expression();
+        return_statement(const struct position position, expression *return_expression);
+        void accept(parser_visitor *visitor) override;
+
+        expression& return_expression();
 
         virtual ~return_statement() override;
     };
 
+    struct switch_case
+    {
+        std::vector<expression *> labels;
+        std::vector<statement *> statements;
+    };
+
+    class case_statement : public statement
+    {
+        expression *m_condition;
+
+    public:
+        const std::vector<switch_case> cases;
+        const std::vector<statement *> *alternative;
+
+        case_statement(const struct position position, expression *condition,
+                std::vector<switch_case>&& cases, std::vector<statement *> *alternative = nullptr);
+        void accept(parser_visitor *visitor) override;
+        expression& condition();
+    };
+
     class designator_expression : public expression
     {
     public:
@@ -512,19 +508,21 @@ namespace boot
         virtual field_access_expression *is_field_access();
         virtual dereference_expression *is_dereference();
 
+        designator_expression *is_designator() override;
+        void accept(parser_visitor *visitor);
+        ~designator_expression() = 0;
+
     protected:
-        designator_expression(const struct position position);
+        designator_expression();
     };
 
-    class variable_expression : public designator_expression
+    class variable_expression : public designator_expression, public literal_expression
     {
-        std::string m_name;
-
     public:
-        variable_expression(const struct position position, const std::string& name);
-        virtual void accept(parser_visitor *visitor) override;
+        const std::string name;
 
-        const std::string& name() const;
+        variable_expression(const struct position position, const std::string& name);
+        void accept(parser_visitor *visitor) override;
 
         variable_expression *is_variable() override;
     };
@@ -536,7 +534,7 @@ namespace boot
 
     public:
         array_access_expression(const struct position position, expression *base, expression *index);
-        virtual void accept(parser_visitor *visitor) override;
+        void accept(parser_visitor *visitor) override;
 
         expression& base();
         expression& index();
@@ -554,7 +552,7 @@ namespace boot
     public:
         field_access_expression(const struct position position, expression *base,
                 const std::string& field);
-        virtual void accept(parser_visitor *visitor) override;
+        void accept(parser_visitor *visitor) override;
 
         expression& base();
         std::string& field();
@@ -570,7 +568,7 @@ namespace boot
 
     public:
         dereference_expression(const struct position position, expression *base);
-        virtual void accept(parser_visitor *visitor) override;
+        void accept(parser_visitor *visitor) override;
 
         expression& base();
 
@@ -579,6 +577,25 @@ namespace boot
         ~dereference_expression() override;
     };
 
+    /**
+     * Procedure call expression.
+     */
+    class procedure_call : public expression, public statement
+    {
+        designator_expression *m_callable;
+
+    public:
+        std::vector<expression *> arguments;
+
+        procedure_call(const struct position position, designator_expression *callable);
+        void accept(parser_visitor *visitor) override;
+        virtual procedure_call *is_call_expression() override;
+
+        designator_expression& callable();
+
+        virtual ~procedure_call() override;
+    };
+
     class assign_statement : public statement
     {
         designator_expression *m_lvalue;
@@ -592,7 +609,7 @@ namespace boot
          */
         assign_statement(const struct position position, designator_expression *lvalue,
                 expression *rvalue);
-        virtual void accept(parser_visitor *visitor) override;
+        void accept(parser_visitor *visitor) override;
 
         designator_expression& lvalue();
         expression& rvalue();
@@ -606,21 +623,33 @@ namespace boot
     class if_statement : public statement
     {
         conditional_statements *m_body;
-        std::vector<statement *> *m_alternative;
 
     public:
-        std::vector<conditional_statements *> branches;
+        const std::vector<conditional_statements *> branches;
+        const std::vector<statement *> *alternative;
 
         if_statement(const struct position position, conditional_statements *body,
+                std::vector<conditional_statements *>&& branches,
                 std::vector<statement *> *alternative = nullptr);
-        virtual void accept(parser_visitor *visitor) override;
+        void accept(parser_visitor *visitor) override;
 
         conditional_statements& body();
-        std::vector<statement *> *alternative();
 
         virtual ~if_statement() override;
     };
 
+    /**
+     * Import statement.
+     */
+    class import_declaration : public node
+    {
+    public:
+        const std::vector<std::string> segments;
+
+        import_declaration(const struct position position, std::vector<std::string>&& segments);
+        void accept(parser_visitor *visitor) override;
+    };
+
     /**
      * While-statement.
      */
@@ -629,51 +658,55 @@ namespace boot
         conditional_statements *m_body;
 
     public:
-        while_statement(const struct position position, conditional_statements *body);
-        virtual void accept(parser_visitor *visitor) override;
+        const std::vector<conditional_statements *> branches;
+
+        while_statement(const struct position position, conditional_statements *body,
+                std::vector<conditional_statements *>&& branches);
+        void accept(parser_visitor *visitor) override;
 
         conditional_statements& body();
 
         virtual ~while_statement() override;
     };
 
-    class block : public node
+    class unit : public node
     {
     public:
+        std::vector<import_declaration *> imports;
+        std::vector<constant_declaration *> constants;
+        std::vector<type_declaration *> types;
         std::vector<variable_declaration *> variables;
-        std::vector<constant_definition *> constants;
-        std::vector<statement *> body;
+        std::vector<procedure_declaration *> procedures;
 
-        block(const struct position position);
+        unit(const struct position position);
         virtual void accept(parser_visitor *visitor) override;
 
-        virtual ~block() override;
+        virtual ~unit() override;
     };
 
-    class program : public block
+    class program : public unit
     {
     public:
-        std::vector<type_definition *> types;
-        std::vector<procedure_definition *> procedures;
+        std::vector<statement *> body;
 
         program(const struct position position);
-        virtual void accept(parser_visitor *visitor) override;
+        void accept(parser_visitor *visitor) override;
 
         virtual ~program() override;
     };
 
     template<typename T>
-    class number_literal : public literal
+    class literal : public literal_expression
     {
     public:
         T value;
 
-        number_literal(const struct position position, const T& value)
-            : literal(position), value(value)
+        literal(const struct position position, const T& value)
+            : node(position), value(value)
         {
         }
 
-        virtual void accept(parser_visitor *visitor) override
+        void accept(parser_visitor *visitor) override
         {
             visitor->visit(this);
         }
@@ -682,10 +715,10 @@ namespace boot
     class defer_statement : public statement
     {
     public:
-        std::vector<statement *> statements;
+        const std::vector<statement *> statements;
 
-        defer_statement(const struct position position);
-        virtual void accept(parser_visitor *visitor) override;
+        defer_statement(const struct position position, std::vector<statement *>&& statements);
+        void accept(parser_visitor *visitor) override;
 
         virtual ~defer_statement() override;
     };
@@ -700,7 +733,9 @@ namespace boot
         binary_expression(const struct position position, expression *lhs,
                 expression *rhs, const binary_operator operation);
 
-        virtual void accept(parser_visitor *visitor) override;
+        void accept(parser_visitor *visitor) override;
+        binary_expression *is_binary() override;
+
         expression& lhs();
         expression& rhs();
         binary_operator operation() const;
@@ -717,7 +752,9 @@ namespace boot
         unary_expression(const struct position position, expression *operand,
                 const unary_operator operation);
 
-        virtual void accept(parser_visitor *visitor) override;
+        void accept(parser_visitor *visitor) override;
+        unary_expression *is_unary() override;
+
         expression& operand();
         unary_operator operation() const;
 
@@ -726,4 +763,3 @@ namespace boot
 
     const char *print_binary_operator(const binary_operator operation);
 }
-}

include/elna/boot/dependency.h

@@ -0,0 +1,41 @@
+/* Dependency graph analysis.
+   Copyright (C) 2025 Free Software Foundation, Inc.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#pragma once
+
+#include <fstream>
+#include "elna/boot/result.h"
+#include "elna/boot/ast.h"
+
+namespace elna::boot
+{
+    class dependency_graph
+    {
+        error_list m_errors;
+
+    public:
+        std::vector<std::unique_ptr<program>> modules;
+
+        bool has_errors() const;
+        const error_list& errors() const;
+
+        dependency_graph();
+        explicit dependency_graph(error_list&& errors);
+    };
+
+    dependency_graph read_sources(std::istream& entry_point, const char *entry_path);
+}

include/elna/boot/driver.h

@@ -17,14 +17,11 @@ along with GCC; see the file COPYING3.  If not see
 
 #pragma once
 
-#include <list>
 #include <optional>
 #include "elna/boot/ast.h"
 #include "location.hh"
 
-namespace elna
-{
-namespace boot
+namespace elna::boot
 {
     position make_position(const yy::location& location);
 
@@ -39,22 +36,16 @@ namespace boot
         virtual std::string what() const override;
     };
 
-    class driver
+    class driver : public error_container
     {
-        std::list<std::unique_ptr<struct error>> m_errors;
-        const char *input_file;
-
     public:
         std::unique_ptr<program> tree;
 
         driver(const char *input_file);
-
-        void error(const yy::location& loc, const std::string& message);
-        const std::list<std::unique_ptr<struct error>>& errors() const noexcept;
     };
 
     constexpr char escape_invalid_char = '\xff';
 
     char escape_char(char escape);
-}
+    std::optional<std::string> escape_string(const char *escape);
 }

include/elna/boot/result.h

@@ -19,10 +19,11 @@ along with GCC; see the file COPYING3.  If not see
 
 #include <cstddef>
 #include <string>
+#include <deque>
+#include <memory>
+#include <variant>
 
-namespace elna
-{
-namespace boot
+namespace elna::boot
 {
     /**
      * Position in the source text.
@@ -42,28 +43,65 @@ namespace boot
     class error
     {
     protected:
-        /**
-         * Constructs an error.
-         *
-         * \param path Source file name.
-         * \param position Error position in the source text.
-         */
         error(const char *path, const struct position position);
 
     public:
         const struct position position;
         const char *path;
 
-        virtual ~error() noexcept = default;
+        virtual ~error() = default;
 
         /// Error text.
         virtual std::string what() const = 0;
 
         /// Error line in the source text.
-        std::size_t line() const noexcept;
+        std::size_t line() const;
 
         /// Error column in the source text.
-        std::size_t column() const noexcept;
+        std::size_t column() const;
+    };
+
+    using error_list = typename std::deque<std::unique_ptr<error>>;
+
+    class error_container
+    {
+    protected:
+        error_list m_errors;
+
+        error_container(const char *input_file);
+
+    public:
+        const char *input_file;
+
+        error_list& errors();
+
+        template<typename T, typename... Args>
+        void add_error(Args... arguments)
+        {
+            auto new_error = std::make_unique<T>(arguments...);
+            m_errors.emplace_back(std::move(new_error));
+        }
+    };
+
+    /**
+     * Tags a procedure type as never returning.
+     */
+    template<typename T>
+    struct return_declaration
+    {
+        return_declaration() = default;
+
+        explicit return_declaration(T type)
+            : proper_type(type)
+        {
+        }
+
+        explicit return_declaration(std::monostate)
+            : no_return(true)
+        {
+        }
+
+        T proper_type{};
+        bool no_return{ false };
     };
 }
-}

include/elna/boot/semantic.h

@@ -0,0 +1,180 @@
+/* Name analysis.
+   Copyright (C) 2025 Free Software Foundation, Inc.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#pragma once
+
+#include <string>
+#include <unordered_map>
+#include <memory>
+#include <deque>
+
+#include "elna/boot/ast.h"
+#include "elna/boot/result.h"
+#include "elna/boot/symbol.h"
+
+namespace elna::boot
+{
+    class undeclared_error : public error
+    {
+        const std::string identifier;
+
+    public:
+        undeclared_error(const std::string& identifier, const char *path, const struct position position);
+
+        std::string what() const override;
+    };
+
+    class already_declared_error : public error
+    {
+        const std::string identifier;
+
+    public:
+        already_declared_error(const std::string& identifier, const char *path, const struct position position);
+
+        std::string what() const override;
+    };
+
+    class field_duplication_error : public error
+    {
+        const std::string field_name;
+
+    public:
+        field_duplication_error(const std::string& field_name, const char *path, const struct position position);
+
+        std::string what() const override;
+    };
+
+    class cyclic_declaration_error : public error
+    {
+        const std::vector<std::string> cycle;
+
+    public:
+        cyclic_declaration_error(const std::vector<std::string>& cycle,
+                const char *path, const struct position position);
+
+        std::string what() const override;
+    };
+
+    /**
+     * Performs name analysis.
+     */
+    class name_analysis_visitor final : public parser_visitor, public error_container
+    {
+        type current_type;
+        constant_info::variant current_literal;
+
+        std::shared_ptr<symbol_table> symbols;
+        std::unordered_map<std::string, std::shared_ptr<alias_type>> unresolved;
+
+        procedure_type build_procedure(procedure_type_expression& type_expression);
+        std::vector<type_field> build_composite_type(const std::vector<field_declaration>& fields);
+
+        bool check_unresolved_symbol(std::shared_ptr<alias_type> alias,
+                std::vector<std::string>& path);
+
+    public:
+        explicit name_analysis_visitor(const char *path, std::shared_ptr<symbol_table> symbols,
+                std::unordered_map<std::string, std::shared_ptr<alias_type>>&& unresolved);
+
+        void visit(named_type_expression *type_expression) override;
+        void visit(array_type_expression *type_expression) override;
+        void visit(pointer_type_expression *type_expression) override;
+        void visit(program *program) override;
+        void visit(type_declaration *definition) override;
+        void visit(record_type_expression *type_expression) override;
+        void visit(union_type_expression *type_expression) override;
+        void visit(procedure_type_expression *type_expression) override;
+        void visit(enumeration_type_expression *type_expression) override;
+
+        void visit(variable_declaration *declaration) override;
+        void visit(constant_declaration *definition) override;
+        void visit(procedure_declaration *definition) override;
+        void visit(assign_statement *statement) override;
+        void visit(if_statement *statement) override;
+        void visit(import_declaration *) override;
+        void visit(while_statement *statement) override;
+        void visit(return_statement *statement) override;
+        void visit(defer_statement *statement) override;
+        void visit(case_statement *statement) override;
+        void visit(procedure_call *call) override;
+        void visit(unit *unit) override;
+        void visit(cast_expression *expression) override;
+        void visit(traits_expression *trait) override;
+        void visit(binary_expression *expression) override;
+        void visit(unary_expression *expression) override;
+        void visit(variable_expression *) override;
+        void visit(array_access_expression *expression) override;
+        void visit(field_access_expression *expression) override;
+        void visit(dereference_expression *expression) override;
+        void visit(literal<std::int32_t> *literal) override;
+        void visit(literal<std::uint32_t> *literal) override;
+        void visit(literal<double> *literal) override;
+        void visit(literal<bool> *literal) override;
+        void visit(literal<unsigned char> *literal) override;
+        void visit(literal<std::nullptr_t> *literal) override;
+        void visit(literal<std::string> *literal) override;
+    };
+
+    /**
+     * Collects global declarations.
+     */
+    class declaration_visitor final : public parser_visitor, public error_container
+    {
+    public:
+        std::unordered_map<std::string, std::shared_ptr<alias_type>> unresolved;
+
+        explicit declaration_visitor(const char *path);
+
+        void visit(named_type_expression *) override;
+        void visit(array_type_expression *) override;
+        void visit(pointer_type_expression *) override;
+        void visit(program *program) override;
+        void visit(type_declaration *) override;
+        void visit(record_type_expression *) override;
+        void visit(union_type_expression *) override;
+        void visit(procedure_type_expression *) override;
+        void visit(enumeration_type_expression *) override;
+
+        void visit(variable_declaration *) override;
+        void visit(constant_declaration *) override;
+        void visit(procedure_declaration *) override;
+        void visit(assign_statement *) override;
+        void visit(if_statement *) override;
+        void visit(import_declaration *) override;
+        void visit(while_statement *) override;
+        void visit(return_statement *) override;
+        void visit(defer_statement *) override;
+        void visit(case_statement *) override;
+        void visit(procedure_call *) override;
+        void visit(unit *unit) override;
+        void visit(cast_expression *) override;
+        void visit(traits_expression *) override;
+        void visit(binary_expression *) override;
+        void visit(unary_expression *) override;
+        void visit(variable_expression *) override;
+        void visit(array_access_expression *) override;
+        void visit(field_access_expression *) override;
+        void visit(dereference_expression *) override;
+        void visit(literal<std::int32_t> *) override;
+        void visit(literal<std::uint32_t> *) override;
+        void visit(literal<double> *) override;
+        void visit(literal<bool> *) override;
+        void visit(literal<unsigned char> *) override;
+        void visit(literal<std::nullptr_t> *) override;
+        void visit(literal<std::string> *) override;
+    };
+}

include/elna/boot/symbol.h

@@ -21,25 +21,170 @@ along with GCC; see the file COPYING3.  If not see
 #include <unordered_map>
 #include <string>
 #include <memory>
+#include <vector>
 
-namespace elna
+#include "elna/boot/result.h"
+
+namespace elna::boot
 {
-namespace boot
+    class alias_type;
+    class primitive_type;
+    class record_type;
+    class union_type;
+    class pointer_type;
+    class array_type;
+    class procedure_type;
+    class enumeration_type;
+
+    class type
     {
+        enum class type_tag
+        {
+            empty,
+            alias,
+            primitive,
+            record,
+            _union,
+            pointer,
+            array,
+            procedure,
+            enumeration
+        };
+        type_tag tag{ type_tag::empty };
+        union
+        {
+            std::weak_ptr<alias_type> alias;
+            std::shared_ptr<primitive_type> primitive;
+            std::shared_ptr<record_type> record;
+            std::shared_ptr<union_type> _union;
+            std::shared_ptr<pointer_type> pointer;
+            std::shared_ptr<array_type> array;
+            std::shared_ptr<procedure_type> procedure;
+            std::shared_ptr<enumeration_type> enumeration;
+        };
+
+        void copy(const type& other);
+        void move(type&& other);
+
+    public:
+        type();
+        explicit type(std::shared_ptr<alias_type> alias);
+        explicit type(std::shared_ptr<primitive_type> primitive);
+        explicit type(std::shared_ptr<record_type> record);
+        explicit type(std::shared_ptr<union_type> _union);
+        explicit type(std::shared_ptr<pointer_type> pointer);
+        explicit type(std::shared_ptr<array_type> array);
+        explicit type(std::shared_ptr<procedure_type> procedure);
+        explicit type(std::shared_ptr<enumeration_type> enumeration);
+
+        type(const type& other);
+        type& operator=(const type& other);
+
+        type(type&& other);
+        type& operator=(type&& other);
+
+        bool operator==(const std::nullptr_t&);
+
+        ~type();
+
+        template<typename T>
+        std::shared_ptr<T> get() const;
+
+        bool empty() const;
+    };
+
+    struct alias_type
+    {
+        const std::string name;
+        type reference;
+
+        explicit alias_type(const std::string& name);
+    };
+
+    struct pointer_type
+    {
+        const type base;
+
+        explicit pointer_type(type base);
+    };
+
+    struct array_type
+    {
+        const type base;
+        const std::uint64_t size;
+
+        array_type(type base, std::uint64_t size);
+    };
+
+    struct primitive_type
+    {
+        const std::string identifier;
+
+        explicit primitive_type(const std::string& identifier);
+    };
+
+    using type_field = std::pair<std::string, type>;
+
+    struct record_type
+    {
+        std::vector<type_field> fields;
+    };
+
+    struct union_type
+    {
+        std::vector<type_field> fields;
+    };
+
+    struct procedure_type
+    {
+        using return_t = return_declaration<type>;
+
+        std::vector<type> parameters;
+        const return_t return_type;
+
+        procedure_type(return_t return_type = return_t());
+    };
+
+    struct enumeration_type
+    {
+        std::vector<std::string> members;
+
+        explicit enumeration_type(const std::vector<std::string>& members);
+    };
+
+    class type_info;
+    class procedure_info;
+    class constant_info;
+    class variable_info;
+
+    class info : public std::enable_shared_from_this<info>
+    {
+    public:
+        virtual ~info() = 0;
+
+        virtual std::shared_ptr<type_info> is_type();
+        virtual std::shared_ptr<procedure_info> is_procedure();
+        virtual std::shared_ptr<constant_info> is_constant();
+        virtual std::shared_ptr<variable_info> is_variable();
+    };
+
     /**
      * Symbol table.
      */
-    template<typename T>
-    class symbol_table
+    template<typename T, typename U, U nothing>
+    class symbol_map
     {
     public:
-        using symbol_ptr = T;
+        using symbol_ptr = typename std::enable_if<
+            std::is_convertible<U, T>::value || std::is_assignable<T, U>::value,
+            T
+        >::type;
         using iterator = typename std::unordered_map<std::string, symbol_ptr>::iterator;
         using const_iterator = typename std::unordered_map<std::string, symbol_ptr>::const_iterator;
 
     private:
         std::unordered_map<std::string, symbol_ptr> entries;
-        std::shared_ptr<symbol_table> outer_scope;
+        std::shared_ptr<symbol_map> outer_scope;
 
     public:
         /**
@@ -47,33 +192,41 @@ namespace boot
          *
          * \param scope Outer scope.
          */
-        explicit symbol_table(std::shared_ptr<symbol_table> scope = nullptr)
+        explicit symbol_map(std::shared_ptr<symbol_map> scope = nullptr)
             : outer_scope(scope)
         {
         }
 
         iterator begin()
         {
-            return entries.begin();
+            return this->entries.begin();
         }
 
         iterator end()
         {
-            return entries.end();
+            return this->entries.end();
         }
 
         const_iterator cbegin() const
         {
-            return entries.cbegin();
+            return this->entries.cbegin();
         }
 
         const_iterator cend() const
         {
-            return entries.cend();
+            return this->entries.cend();
         }
 
         /**
-         * Looks for symbol in the table by name. Returns nullptr if the symbol
+         * \return Symbol count in the current scope.
+         */
+        std::size_t size() const
+        {
+            return this->entries.size();
+        }
+
+        /**
+         * Looks for symbol in the table by name. Returns nothing if the symbol
          * can not be found.
          *
          * \param name Symbol name.
@@ -91,7 +244,16 @@ namespace boot
             {
                 return this->outer_scope->lookup(name);
             }
-            return nullptr;
+            return nothing;
+        }
+
+        /**
+         * \param name Symbol name.
+         * \return Whether the table contains a symbol with the given name.
+         */
+        bool contains(const std::string& name)
+        {
+            return lookup(name) != nothing;
         }
 
         /**
@@ -104,7 +266,7 @@ namespace boot
          */
         bool enter(const std::string& name, symbol_ptr entry)
         {
-            return entries.insert({ name, entry }).second;
+            return lookup(name) == nothing && entries.insert({ name, entry }).second;
         }
 
         /**
@@ -112,10 +274,55 @@ namespace boot
          *
          * \return Outer scope.
          */
-        std::shared_ptr<symbol_table> scope()
+        std::shared_ptr<symbol_map> scope()
         {
             return this->outer_scope;
         }
     };
-}
+
+    using symbol_table = symbol_map<std::shared_ptr<info>, std::nullptr_t, nullptr>;
+
+    class type_info : public info
+    {
+    public:
+        const type symbol;
+
+        explicit type_info(const type symbol);
+        std::shared_ptr<type_info> is_type() override;
+    };
+
+    class procedure_info : public info
+    {
+    public:
+        const procedure_type symbol;
+        const std::vector<std::string> names;
+        std::shared_ptr<symbol_table> symbols;
+
+        procedure_info(const procedure_type symbol, const std::vector<std::string> names,
+                std::shared_ptr<symbol_table> parent_table = nullptr);
+        std::shared_ptr<procedure_info> is_procedure() override;
+    };
+
+    class constant_info : public info
+    {
+    public:
+        using variant = typename
+            std::variant<std::int32_t, std::uint32_t, double, bool, unsigned char, std::nullptr_t, std::string>;
+
+        const variant symbol;
+
+        explicit constant_info(const variant& symbol);
+        std::shared_ptr<constant_info> is_constant() override;
+    };
+
+    class variable_info : public info
+    {
+    public:
+        const type symbol;
+
+        variable_info(const type symbol);
+        std::shared_ptr<variable_info> is_variable() override;
+    };
+
+    std::shared_ptr<symbol_table> builtin_symbol_table();
 }

include/elna/gcc/elna-builtins.h

@@ -15,16 +15,25 @@ You should have received a copy of the GNU General Public License
 along with GCC; see the file COPYING3.  If not see
 <http://www.gnu.org/licenses/>.  */
 
+#include <memory>
+
 #include "config.h"
 #include "system.h"
 #include "coretypes.h"
 #include "tree.h"
 #include "tree-iterator.h"
 
-namespace elna
-{
-namespace gcc
+#include "elna/gcc/elna-tree.h"
+
+namespace elna::gcc
 {
     void init_ttree();
-}
+    std::shared_ptr<symbol_table> builtin_symbol_table();
+
+    void rewrite_symbol_table(std::shared_ptr<boot::symbol_table> info_table, std::shared_ptr<symbol_table> symbols);
+    tree handle_symbol(const std::string& symbol_name, std::shared_ptr<boot::alias_type> reference,
+            std::shared_ptr<symbol_table> symbols);
+    tree get_inner_alias(const boot::type& type, std::shared_ptr<symbol_table> symbols);
+    void declare_procedure(const std::string& name, const boot::procedure_info& info,
+            std::shared_ptr<symbol_table> symbols);
 }

include/elna/gcc/elna-diagnostic.h

@@ -22,15 +22,16 @@ along with GCC; see the file COPYING3.  If not see
 #include "coretypes.h"
 #include "input.h"
 #include "tree.h"
+#include "diagnostic.h"
+
+#include <deque>
+#include <memory>
 
 #include "elna/boot/result.h"
 
-namespace elna
-{
-namespace gcc
+namespace elna::gcc
 {
     location_t get_location(const boot::position *position);
-
     std::string print_type(tree type);
-}
+    void report_errors(const std::deque<std::unique_ptr<boot::error>>& errors);
 }

include/elna/gcc/elna-generic.h

@@ -19,6 +19,7 @@ along with GCC; see the file COPYING3.  If not see
 
 #include "elna/boot/ast.h"
 #include "elna/boot/symbol.h"
+#include "elna/boot/semantic.h"
 #include "elna/gcc/elna-tree.h"
 
 #include "config.h"
@@ -27,26 +28,20 @@ along with GCC; see the file COPYING3.  If not see
 #include "tree.h"
 #include "tree-iterator.h"
 
-#include <forward_list>
 #include <string>
+#include <forward_list>
 
-namespace elna
+namespace elna::gcc
 {
-namespace gcc
-{
-    class generic_visitor final : public boot::empty_visitor
+    class generic_visitor final : public boot::parser_visitor
     {
         tree current_expression{ NULL_TREE };
-        std::shared_ptr<boot::symbol_table<tree>> symbol_map;
-
-        tree build_label_decl(const char *name, location_t loc);
-        tree build_type(boot::top_type& type);
+        std::shared_ptr<symbol_table> symbols;
+        std::shared_ptr<boot::symbol_table> info_table;
 
         void enter_scope();
         tree leave_scope();
 
-        tree lookup(const std::string& name);
-
         void make_if_branch(boot::conditional_statements& branch, tree goto_endif);
 
         tree build_arithmetic_operation(boot::binary_expression *expression,
@@ -56,40 +51,55 @@ namespace gcc
         tree build_bit_logic_operation(boot::binary_expression *expression, tree left, tree right);
         tree build_equality_operation(boot::binary_expression *expression, tree left, tree right);
         void build_procedure_call(location_t call_location,
-                tree symbol, const std::vector<boot::expression *>& arguments);
+                tree procedure_address, const std::vector<boot::expression *>& arguments);
         void build_record_call(location_t call_location,
                 tree symbol, const std::vector<boot::expression *>& arguments);
+        bool build_builtin_procedures(boot::procedure_call *call);
+        void build_assert_builtin(location_t call_location, const std::vector<boot::expression *>& arguments);
+
+        bool expect_trait_type_only(boot::traits_expression *trait);
+        bool expect_trait_for_integral_type(boot::traits_expression *trait);
+        void visit_statements(const std::vector<boot::statement *>& statements);
+        bool assert_constant(location_t expression_location);
 
     public:
-        generic_visitor(std::shared_ptr<boot::symbol_table<tree>> symbol_table);
+        generic_visitor(std::shared_ptr<symbol_table> symbol_table, std::shared_ptr<boot::symbol_table> info_table);
 
         void visit(boot::program *program) override;
-        void visit(boot::procedure_definition *definition) override;
-        void visit(boot::call_expression *expression) override;
+        void visit(boot::procedure_declaration *definition) override;
+        void visit(boot::procedure_call *call) override;
         void visit(boot::cast_expression *expression) override;
-        void visit(boot::type_expression *expression) override;
-        void visit(boot::number_literal<std::int32_t> *literal) override;
-        void visit(boot::number_literal<std::uint32_t> *literal) override;
-        void visit(boot::number_literal<double> *literal) override;
-        void visit(boot::number_literal<bool> *boolean) override;
-        void visit(boot::number_literal<unsigned char> *character) override;
-        void visit(boot::number_literal<std::nullptr_t> *) override;
-        void visit(boot::number_literal<std::string> *string) override;
+        void visit(boot::traits_expression *trait) override;
+        void visit(boot::literal<std::int32_t> *literal) override;
+        void visit(boot::literal<std::uint32_t> *literal) override;
+        void visit(boot::literal<double> *literal) override;
+        void visit(boot::literal<bool> *boolean) override;
+        void visit(boot::literal<unsigned char> *character) override;
+        void visit(boot::literal<std::nullptr_t> *) override;
+        void visit(boot::literal<std::string> *string) override;
         void visit(boot::binary_expression *expression) override;
         void visit(boot::unary_expression *expression) override;
-        void visit(boot::constant_definition *definition) override;
-        void visit(boot::type_definition *definition) override;
+        void visit(boot::constant_declaration *definition) override;
+        void visit(boot::type_declaration *declaration) override;
         void visit(boot::variable_declaration *declaration) override;
         void visit(boot::variable_expression *expression) override;
         void visit(boot::array_access_expression *expression) override;
         void visit(boot::field_access_expression *expression) override;
         void visit(boot::dereference_expression *expression) override;
+        void visit(boot::unit *unit) override;
         void visit(boot::assign_statement *statement) override;
         void visit(boot::if_statement *statement) override;
+        void visit(boot::import_declaration *) override;
         void visit(boot::while_statement *statement) override;
-        void visit(boot::call_statement *statement) override;
+        void visit(boot::named_type_expression *type) override;
+        void visit(boot::array_type_expression *) override;
+        void visit(boot::pointer_type_expression *type) override;
+        void visit(boot::record_type_expression *) override;
+        void visit(boot::union_type_expression *) override;
+        void visit(boot::procedure_type_expression *) override;
+        void visit(boot::enumeration_type_expression *) override;
         void visit(boot::return_statement *statement) override;
         void visit(boot::defer_statement *statement) override;
+        void visit(boot::case_statement *statement) override;
     };
 }
-}

include/elna/gcc/elna-tree.h

@@ -28,23 +28,22 @@ along with GCC; see the file COPYING3.  If not see
 
 #include "elna/boot/ast.h"
 #include "elna/boot/symbol.h"
+#include "elna/gcc/elna1.h"
 
-namespace elna
+namespace elna::gcc
 {
-namespace gcc
-{
-    bool is_pointer_type(tree type);
+    using symbol_table = boot::symbol_map<tree, tree, NULL_TREE>;
+
     bool is_integral_type(tree type);
     bool is_numeric_type(tree type);
-    bool is_array_type(tree type);
-    bool is_procedure_type(tree type);
+    bool is_unique_type(tree type);
     bool is_void_type(tree type);
 
     /**
      * \param type The type to evaluate.
-     * \return Whether the given type is record or union.
+     * \return Whether this type can be converted to another type.
      */
-    bool is_aggregate_type(tree type);
+    bool is_castable_type(tree type);
 
     /**
      * \param lhs Left hand value.
@@ -53,6 +52,16 @@ namespace gcc
      */
     bool are_compatible_pointers(tree lhs_type, tree rhs);
 
+    /**
+     * Prepares a value to be bound to a variable or parameter.
+     *
+     * If rvalue is a procedure declaration, builds a procedure pointer.
+     *
+     * \param rvalue Value to be assigned.
+     * \return Processed value.
+     */
+    tree prepare_rvalue(tree rvalue);
+
     /**
      * \param assignee Assignee.
      * \param assignee Assignment.
@@ -64,11 +73,30 @@ namespace gcc
     void defer(tree statement_tree);
     tree chain_defer();
 
-    tree do_pointer_arithmetic(boot::binary_operator binary_operator, tree left, tree right);
+    tree do_pointer_arithmetic(boot::binary_operator binary_operator,
+            tree left, tree right, location_t expression_location);
     tree build_binary_operation(bool condition, boot::binary_expression *expression,
             tree_code operator_code, tree left, tree right, tree target_type);
     tree build_arithmetic_operation(boot::binary_expression *expression,
             tree_code operator_code, tree left, tree right);
     tree build_field(location_t location, tree record_type, const std::string name, tree type);
+    tree find_field_by_name(location_t expression_location, tree type, const std::string& field_name);
+    tree build_global_pointer_type(tree type);
+    tree build_static_array_type(tree type, const std::uint64_t size);
+    tree build_enumeration_type(const std::vector<std::string>& members);
+    tree build_label_decl(const char *name, location_t loc);
+
+    tree extract_constant(tree expression);
+
+    template<typename... Args>
+    tree call_built_in(location_t call_location, const char *name, tree return_type, Args... arguments)
+    {
+        tree *builtin = elna_global_decls->get(name);
+        gcc_assert(builtin != nullptr);
+
+        tree fndecl_type = build_function_type(return_type, TYPE_ARG_TYPES(*builtin));
+        tree builtin_addr = build1_loc(call_location, ADDR_EXPR, build_pointer_type(fndecl_type), *builtin);
+
+        return build_call_nary(return_type, builtin_addr, sizeof...(Args), arguments...);
     }
 }

include/elna/gcc/elna1.h

@@ -15,13 +15,15 @@ You should have received a copy of the GNU General Public License
 along with GCC; see the file COPYING3.  If not see
 <http://www.gnu.org/licenses/>.  */
 
+#pragma once
+
 enum elna_tree_index
 {
     ELNA_TI_INT_TYPE,
     ELNA_TI_WORD_TYPE,
     ELNA_TI_CHAR_TYPE,
     ELNA_TI_BOOL_TYPE,
-    ELNA_TI_BYTE_TYPE,
+    ELNA_TI_POINTER_TYPE,
     ELNA_TI_FLOAT_TYPE,
     ELNA_TI_STRING_TYPE,
     ELNA_TI_BOOL_TRUE,
@@ -39,7 +41,7 @@ extern GTY(()) hash_map<nofree_string_hash, tree> *elna_global_decls;
 #define elna_word_type_node elna_global_trees[ELNA_TI_WORD_TYPE]
 #define elna_char_type_node elna_global_trees[ELNA_TI_CHAR_TYPE]
 #define elna_bool_type_node elna_global_trees[ELNA_TI_BOOL_TYPE]
-#define elna_byte_type_node elna_global_trees[ELNA_TI_BYTE_TYPE]
+#define elna_pointer_type_node elna_global_trees[ELNA_TI_POINTER_TYPE]
 #define elna_float_type_node elna_global_trees[ELNA_TI_FLOAT_TYPE]
 #define elna_string_type_node elna_global_trees[ELNA_TI_STRING_TYPE]
 #define elna_bool_true_node elna_global_trees[ELNA_TI_BOOL_TRUE]

rakelib/boot.rake

@@ -0,0 +1,107 @@
+# This Source Code Form is subject to the terms of the Mozilla Public License,
+# v. 2.0. If a copy of the MPL was not distributed with this file, You can
+# obtain one at https://mozilla.org/MPL/2.0/. -}
+# frozen_string_literal: true
+
+require 'uri'
+require 'net/http'
+require 'open3'
+
+def gcc_verbose(gcc_binary)
+  read, write = IO.pipe
+  sh({'LANG' => 'C'}, gcc_binary, '--verbose', err: write)
+  write.close
+  output = read.read
+  read.close
+  output
+end
+
+def find_build_target(gcc_version)
+  gcc_verbose('gcc')
+    .lines
+    .find { |line| line.start_with? 'Target: ' }
+    .split(' ')
+    .last
+    .strip
+end
+
+def download_and_pipe(url, target, command)
+  target.mkpath
+
+  Net::HTTP.start(url.host, url.port, use_ssl: url.scheme == 'https') do |http|
+    request = Net::HTTP::Get.new url.request_uri
+
+    http.request request do |response|
+      case response
+      when Net::HTTPRedirection
+        download_and_pipe URI.parse(response['location']), target, command
+      when Net::HTTPSuccess
+        Dir.chdir target.to_path do
+          Open3.popen2(*command) do |stdin, stdout, wait_thread|
+            Thread.new do
+              stdout.each { |line| puts line }
+            end
+
+            response.read_body do |chunk|
+              stdin.write chunk
+            end
+            stdin.close
+
+            wait_thread.value
+          end
+        end
+      else
+        response.error!
+      end
+    end
+  end
+end
+
+namespace :boot do
+  # Dependencies.
+  GCC_VERSION = "15.1.0"
+  HOST_GCC = TMP + 'host/gcc'
+
+  directory HOST_GCC
+  directory(TMP + 'tools')
+
+  desc 'Download and configure the bootstrap compiler'
+  task configure: [TMP + 'tools', HOST_GCC, HOST_INSTALL] do
+    url = URI.parse "https://gcc.gnu.org/pub/gcc/releases/gcc-#{GCC_VERSION}/gcc-#{GCC_VERSION}.tar.xz"
+    build_target = find_build_target GCC_VERSION
+    source_directory = TMP + "tools/gcc-#{GCC_VERSION}"
+    frontend_link = source_directory + 'gcc'
+
+    download_and_pipe url, source_directory.dirname, ['tar', '-Jxv']
+
+    sh 'contrib/download_prerequisites', chdir: source_directory.to_path
+    File.symlink Pathname.new('.').relative_path_from(frontend_link), (frontend_link + 'elna')
+
+    configure_options = [
+      "--prefix=#{HOST_INSTALL.realpath}",
+      '--with-sysroot=/',
+      '--enable-languages=c,c++,m2,elna',
+      '--disable-bootstrap',
+      '--disable-multilib',
+      "--target=#{build_target}",
+      "--build=#{build_target}",
+      "--host=#{build_target}"
+    ]
+    flags = '-O0 -g -fPIC'
+    env = {
+      'CFLAGS' => flags,
+      'CXXFLAGS' => flags,
+    }
+    configure = source_directory.relative_path_from(HOST_GCC) + 'configure'
+    sh env, configure.to_path, *configure_options, chdir: HOST_GCC
+  end
+
+  desc 'Make and install the bootstrap compiler'
+  task :make do
+    sh 'make', '-j', Etc.nprocessors.to_s, chdir: HOST_GCC
+    sh 'make', 'install', chdir: HOST_GCC
+  end
+end
+
+desc 'Build the bootstrap compiler'
+task boot: %w[boot:configure boot:make]

source.elna

@@ -1,955 +0,0 @@
-const
-  SEEK_SET* = 0
-  SEEK_CUR* = 1
-  SEEK_END* = 2
-
-  TOKEN_IDENTIFIER* = 1
-  TOKEN_IF* = 2
-  TOKEN_THEN* = 3
-  TOKEN_ELSE* = 4
-  TOKEN_ELSIF* = 5
-  TOKEN_WHILE* = 6
-  TOKEN_DO* = 7
-  TOKEN_PROC* = 8
-  TOKEN_BEGIN* = 9
-  TOKEN_END* = 10
-  TOKEN_EXTERN* = 11
-  TOKEN_CONST* = 12
-  TOKEN_VAR* = 13
-  TOKEN_ARRAY* = 14
-  TOKEN_OF* = 15
-  TOKEN_TYPE* = 16
-  TOKEN_RECORD* = 17
-  TOKEN_UNION* = 18
-  TOKEN_POINTER* = 19
-  TOKEN_TO* = 20
-  TOKEN_BOOLEAN* = 21
-  TOKEN_NIL* = 22
-  TOKEN_AND* = 23
-  TOKEN_OR* = 24
-  TOKEN_NOT* = 25
-  TOKEN_RETURN* = 26
-  TOKEN_CAST* = 27
-  TOKEN_AS* = 28
-  TOKEN_SIZEOF* = 29
-  TOKEN_LEFT_PAREN* = 30
-  TOKEN_RIGHT_PAREN* = 31
-  TOKEN_LEFT_SQUARE* = 32
-  TOKEN_RIGHT_SQUARE* = 33
-  TOKEN_GREATER_EQUAL* = 34
-  TOKEN_LESS_EQUAL* = 35
-  TOKEN_GREATER_THAN* = 36
-  TOKEN_LESS_THAN* = 37
-  TOKEN_NOT_EQUAL* = 38
-  TOKEN_EQUAL* = 39
-  TOKEN_SEMICOLON* = 40
-  TOKEN_DOT* = 41
-  TOKEN_COMMA* = 42
-  TOKEN_PLUS* = 43
-  TOKEN_MINUS* = 44
-  TOKEN_MULTIPLICATION* = 45
-  TOKEN_DIVISION* = 46
-  TOKEN_REMAINDER* = 47
-  TOKEN_ASSIGNMENT* = 48
-  TOKEN_COLON* = 49
-  TOKEN_HAT* = 50
-  TOKEN_AT* = 51
-  TOKEN_COMMENT* = 52
-  TOKEN_INTEGER* = 53
-  TOKEN_WORD* = 54
-  TOKEN_CHARACTER* = 55
-  TOKEN_STRING* = 56
-  TOKEN_DEFER* = 57
-
-type
-  Position* = record
-    line: Word
-	column: Word
-  end
-  Location* = record
-    first: Position
-	last: Position
-  end
-  SourceCode = record
-    position: Position
-	text: String
-  end
-  TokenValue* = union
-    int_value: Int
-    string_value: pointer to Char
-    string: String
-	boolean_value: Bool
-	char_value: Char
-  end
-  Token* = record
-    kind: Int
-    value: TokenValue
-	location: Location
-  end
-  FILE* = record
-    dummy: Int
-  end
-  CommandLine* = record
-    input: pointer to Char
-	tokenize: Bool
-	syntax_tree: Bool
-  end
-  Literal* = record
-    value: Int
-  end
-  ConstantDefinition* = record
-    name: pointer to Char
-    body: pointer to Literal
-  end
-  ConstantPart* = record
-    elements: pointer to pointer to ConstantDefinition
-	count: Word
-  end
-  Program* = record
-    constants: ConstantPart
-  end
-
-(*
-  External procedures.
-*)
-proc fopen(pathname: pointer to Char, mode: pointer to Char) -> pointer to FILE; extern
-proc fclose(stream: pointer to FILE) -> Int; extern
-proc fseek(stream: pointer to FILE, off: Int, whence: Int) -> Int; extern
-proc rewind(stream: pointer to FILE); extern
-proc ftell(stream: pointer to FILE) -> Int; extern
-proc fread(ptr: pointer to Byte, size: Word, nmemb: Word, stream: pointer to FILE) -> Word; extern
-proc write(fd: Int, buf: pointer to Byte, Word: Int) -> Int; extern
-
-proc malloc(size: Word) -> pointer to Byte; extern
-proc free(ptr: pointer to Byte); extern
-proc calloc(nmemb: Word, size: Word) -> pointer to Byte; extern
-proc realloc(ptr: pointer to Byte, size: Word) -> pointer to Byte; extern
-
-proc memset(ptr: pointer to Char, c: Int, n: Int) -> pointer to Char; extern
-
-proc strcmp(s1: pointer to Char, s2: pointer to Char) -> Int; extern
-proc strncmp(s1: pointer to Char, s2: pointer to Char, n: Word) -> Int; extern
-proc strncpy(dst: pointer to Char, src: pointer to Char, dsize: Word) -> pointer to Char; extern
-proc strcpy(dst: pointer to Char, src: pointer to Char) -> pointer to Char; extern
-proc strlen(ptr: pointer to Char) -> Word; extern
-
-proc strtol(nptr: pointer to Char, endptr: pointer to pointer to Char, base: Int) -> Int; extern
-
-proc perror(s: pointer to Char); extern
-proc exit(code: Int); extern
-
-(*
-  Standard procedures.
-*)
-proc reallocarray(ptr: pointer to Byte, n: Word, size: Word) -> pointer to Byte;
-begin
-  return realloc(ptr, n * size)
-end
-
-proc write_s(value: String);
-begin
-  write(0, cast(value.ptr: pointer to Byte), cast(value.length: Int))
-end
-
-proc write_z(value: pointer to Char);
-begin
-  write(0, cast(value: pointer to Byte), cast(strlen(value): Int))
-end
-
-proc write_b(value: Bool);
-begin
-  if value then
-    write_s("true")
-  else
-    write_s("false")
-  end
-end
-
-proc write_c(value: Char);
-begin
-  write(0, cast(@value: pointer to Byte), 1)
-end
-
-proc write_i(value: Int);
-var
-  digit: Int, n: Word,
-  buffer: array 10 of Char
-begin
-  n := 10u;
-
-  if value = 0 then
-    write_c('0')
-  end;
-  while value <> 0 do
-    digit := value % 10;
-	value := value / 10;
-
-	buffer[n] := cast(cast('0': Int) + digit: Char);
-	n := n - 1u
-  end;
-  while n < 10u do
-    n := n + 1u;
-    write_c(buffer[n])
-  end
-end
-
-proc write_u(value: Word);
-begin
-  write_i(cast(value: Int))
-end
-
-proc is_digit(c: Char) -> Bool;
-begin
-  return cast(c: Int) >= cast('0': Int) and cast(c: Int) <= cast('9': Int)
-end
-
-proc is_alpha(c: Char) -> Bool;
-begin
-  return cast(c: Int) >= cast('A': Int) and cast(c: Int) <= cast('z': Int)
-end
-
-proc is_alnum(c: Char) -> Bool;
-begin
-  return is_digit(c) or is_alpha(c)
-end
-
-proc is_space(c: Char) -> Bool;
-begin
-  return c = ' ' or c = '\n' or c = '\t'
-end
-
-proc substring(string: String, start: Word, count: Word) -> String;
-begin
-  return String(string.ptr + start, count)
-end
-
-proc open_substring(string: String, start: Word) -> String;
-begin
-  return substring(string, start, string.length - start)
-end
-
-proc string_dup(origin: String) -> String;
-var
-  copy: pointer to Char
-begin
-  copy := cast(malloc(origin.length): pointer to Char);
-  strncpy(copy, origin.ptr, origin.length);
-
-  return String(copy, origin.length)
-end
-
-(*
-  End of standard procedures.
-*)
-
-proc make_position() -> Position;
-var
-  result: Position
-begin
-  return Position(1u, 1u)
-end
-
-proc read_source(filename: pointer to Char, result: pointer to String) -> Bool;
-var
-  input_file: pointer to FILE,
-  source_size: Int,
-  input: pointer to Byte
-begin
-  input_file := fopen(filename, "rb\0".ptr);
-
-  if input_file = nil then
-    return false
-  end;
-  defer
-    fclose(input_file)
-  end;
-  if fseek(input_file, 0, SEEK_END) <> 0 then
-    return false
-  end;
-  source_size := ftell(input_file);
-  if source_size < 0 then
-    return false
-  end;
-  rewind(input_file);
-
-  input := malloc(cast(source_size: Word));
-  if fread(input, cast(source_size: Word), 1u, input_file) <> 1u then
-    return false
-  end;
-  result^.length := cast(source_size: Word);
-  result^.ptr := cast(input: pointer to Char);
-
-  return true
-end
-
-proc escape_char(escape: Char, result: pointer to Char) -> Bool;
-begin
-  if escape = 'n' then
-	result^ := '\n';
-	return true
-  elsif escape = 'a' then
-	result^ := '\a';
-	return true
-  elsif escape = 'b' then
-	result^ := '\b';
-	return true
-  elsif escape = 't' then
-	result^ := '\t';
-	return true
-  elsif escape = 'f' then
-	result^ := '\f';
-	return true
-  elsif escape = 'r' then
-	result^ := '\r';
-	return true
-  elsif escape = 'v' then
-	result^ := '\v';
-	return true
-  elsif escape = '\\' then
-	result^ := '\\';
-	return true
-  elsif escape = '\'' then
-	result^ := '\'';
-	return true
-  elsif escape = '"' then
-	result^ := '"';
-	return true
-  elsif escape = '?' then
-	result^ := '\?';
-	return true
-  elsif escape = '0' then
-	result^ := '\0';
-	return true
-  else
-	return false
-  end
-end
-
-proc advance_source(source_code: SourceCode, length: Word) -> SourceCode;
-begin
-  source_code.text := open_substring(source_code.text, length);
-  source_code.position.column := source_code.position.column + length;
-
-  return source_code
-end
-
-proc skip_spaces(source_code: SourceCode) -> SourceCode;
-begin
-  while source_code.text.length > 0u and is_space(source_code.text[1u]) do
-    if source_code.text[1u] = '\n' then
-      source_code.position.line := source_code.position.line + 1u;
-      source_code.position.column := 1u
-	else
-	  source_code.position.column := source_code.position.column + 1u
-	end;
-    source_code.text := open_substring(source_code.text, 1u)
-  end;
-  return source_code
-end
-
-proc lex_identifier(source_code: pointer to SourceCode, token_content: pointer to String);
-var
-  content_length: Word
-begin
-  content_length := 0u;
-  token_content^ := source_code^.text;
-
-  while is_alnum(source_code^.text[1u]) or source_code^.text[1u] = '_' do
-    content_length := content_length + 1u;
-	source_code^ := advance_source(source_code^, 1u)
-  end;
-  token_content^ := substring(token_content^, 0u, content_length)
-end
-
-proc lex_comment(source_code: pointer to SourceCode, token_content: pointer to String) -> Bool;
-var
-  content_length: Word
-begin
-  content_length := 0u;
-  token_content^ := source_code^.text;
-
-  while source_code^.text.length > 1u do
-    if source_code^.text[1u] = '*' and source_code^.text[2u] = ')' then
-	  source_code^ := advance_source(source_code^, 2u);
-	  token_content^ := substring(token_content^, 0u, content_length);
-
-	  return true
-	end;
-    content_length := content_length + 1u;
-	source_code^ := advance_source(source_code^, 1u)
-  end;
-
-  return false
-end
-
-proc lex_character(input: pointer to Char, current_token: pointer to Token) -> pointer to Char;
-begin
-  if input^ = '\\' then
-    input := input + 1;
-	if escape_char(input^, @current_token^.value.char_value) then
-	  input := input + 1
-	end
-  elsif input^ <> '\0' then
-    current_token^.value.char_value := input^;
-	input := input + 1
-  end;
-  return input
-end
-
-proc lex_string(input: pointer to Char, current_token: pointer to Token) -> pointer to Char;
-var
-  token_end: pointer to Char,
-  constructed_string: pointer to Char,
-  token_length: Word,
-  is_valid: Bool
-begin
-  token_end := input;
-
-  while token_end^ <> '\0' and not ((token_end - 1)^ <> '\\' and token_end^ = '"') do
-    token_end := token_end + 1
-  end;
-  if token_end^ <> '\"' then
-    return input
-  end;
-  token_length := cast(token_end - input: Word);
-  current_token^.value.string_value := cast(calloc(token_length, 1u): pointer to Char);
-
-  is_valid := true;
-  constructed_string := current_token^.value.string_value;
-  while input < token_end and is_valid do
-
-    if input^ = '\\' then
-      input := input + 1;
-      if escape_char(input^, constructed_string) then
-        input := input + 1
-	  else
-	    is_valid := false
-      end
-    elsif input^ <> '\0' then
-      constructed_string^ := input^;
-      input := input + 1
-    end;
-
-    constructed_string := constructed_string + 1
-  end;
-
-  return token_end
-end
-
-proc print_tokens(tokens: pointer to Token, tokens_size: Word);
-var
-  current_token: pointer to Token,
-  i: Word
-begin
-  i := 0u;
-  while i < tokens_size do
-    current_token := tokens + i;
-
-    if current_token^.kind = TOKEN_IF then
-	  write_s("IF")
-    elsif current_token^.kind = TOKEN_THEN then
-	  write_s("THEN")
-    elsif current_token^.kind = TOKEN_ELSE then
-	  write_s("ELSE")
-    elsif current_token^.kind = TOKEN_ELSIF then
-	  write_s("ELSIF")
-    elsif current_token^.kind = TOKEN_WHILE then
-	  write_s("WHILE")
-    elsif current_token^.kind = TOKEN_DO then
-	  write_s("DO")
-	elsif current_token^.kind = TOKEN_PROC then
-	  write_s("PROC")
-	elsif current_token^.kind = TOKEN_BEGIN then
-	  write_s("BEGIN")
-	elsif current_token^.kind = TOKEN_END then
-	  write_s("END")
-   	elsif current_token^.kind = TOKEN_EXTERN then
-	  write_s("EXTERN")
-	elsif current_token^.kind = TOKEN_CONST then
-	  write_s("CONST")
-	elsif current_token^.kind = TOKEN_VAR then
-	  write_s("VAR")
-   	elsif current_token^.kind = TOKEN_ARRAY then
-	  write_s("ARRAY")
-	elsif current_token^.kind = TOKEN_OF then
-	  write_s("OF")
-	elsif current_token^.kind = TOKEN_TYPE then
-	  write_s("TYPE")
-	elsif current_token^.kind = TOKEN_RECORD then
-	  write_s("RECORD")
-	elsif current_token^.kind = TOKEN_UNION then
-	  write_s("UNION")
-	elsif current_token^.kind = TOKEN_POINTER then
-	  write_s("POINTER")
-	elsif current_token^.kind = TOKEN_TO then
-	  write_s("TO")
-	elsif current_token^.kind = TOKEN_BOOLEAN then
-	  write_s("BOOLEAN<");
-	  write_b(current_token^.value.boolean_value);
-	  write_c('>')
-	elsif current_token^.kind = TOKEN_NIL then
-	  write_s("NIL")
-	elsif current_token^.kind = TOKEN_AND then
-	  write_s("AND")
-	elsif current_token^.kind = TOKEN_OR then
-	  write_s("OR")
-	elsif current_token^.kind = TOKEN_NOT then
-	  write_s("NOT")
-	elsif current_token^.kind = TOKEN_RETURN then
-	  write_s("RETURN")
-	elsif current_token^.kind = TOKEN_CAST then
-	  write_s("CAST")
-	elsif current_token^.kind = TOKEN_AS then
-	  write_s("AS")
-	elsif current_token^.kind = TOKEN_SIZEOF then
-	  write_s("SIZEOF")
-	elsif current_token^.kind = TOKEN_IDENTIFIER then
-	  write_c('<');
-      write_s(current_token^.value.string);
-	  write_c('>')
-	elsif current_token^.kind = TOKEN_LEFT_PAREN then
-	  write_s("(")
-	elsif current_token^.kind = TOKEN_RIGHT_PAREN then
-	  write_s(")")
-	elsif current_token^.kind = TOKEN_LEFT_SQUARE then
-	  write_s("[")
-	elsif current_token^.kind = TOKEN_RIGHT_SQUARE then
-	  write_s("]")
-	elsif current_token^.kind = TOKEN_GREATER_EQUAL then
-	  write_s(">=")
-	elsif current_token^.kind = TOKEN_LESS_EQUAL then
-	  write_s("<=")
-	elsif current_token^.kind = TOKEN_GREATER_THAN then
-	  write_s(">")
-	elsif current_token^.kind = TOKEN_LESS_THAN then
-	  write_s("<")
-	elsif current_token^.kind = TOKEN_EQUAL then
-	  write_s("=")
-	elsif current_token^.kind = TOKEN_NOT_EQUAL then
-	  write_s("<>")
-	elsif current_token^.kind = TOKEN_SEMICOLON then
-	  write_c(';')
-	elsif current_token^.kind = TOKEN_DOT then
-	  write_c('.')
-	elsif current_token^.kind = TOKEN_COMMA then
-	  write_c(',')
-	elsif current_token^.kind = TOKEN_PLUS then
-	  write_c('+')
-	elsif current_token^.kind = TOKEN_MINUS then
-	  write_c('-')
-	elsif current_token^.kind = TOKEN_MULTIPLICATION then
-	  write_c('*')
-	elsif current_token^.kind = TOKEN_DIVISION then
-	  write_c('/')
-	elsif current_token^.kind = TOKEN_REMAINDER then
-	  write_c('%')
-	elsif current_token^.kind = TOKEN_ASSIGNMENT then
-	  write_s(":=")
-	elsif current_token^.kind = TOKEN_COLON then
-	  write_c(':')
-	elsif current_token^.kind = TOKEN_HAT then
-	  write_c('^')
-	elsif current_token^.kind = TOKEN_AT then
-	  write_c('@')
-	elsif current_token^.kind = TOKEN_COMMENT then
-	  write_s("(* COMMENT *)")
-	elsif current_token^.kind = TOKEN_INTEGER then
-	  write_c('<');
-      write_i(current_token^.value.int_value);
-	  write_c('>')
-	elsif current_token^.kind = TOKEN_WORD then
-	  write_c('<');
-      write_i(current_token^.value.int_value);
-	  write_s("u>")
-	elsif current_token^.kind = TOKEN_CHARACTER then
-	  write_c('<');
-      write_i(cast(current_token^.value.char_value: Int));
-	  write_s("c>")
-	elsif current_token^.kind = TOKEN_STRING then
-	  write_s("\"...\"")
-	elsif current_token^.kind = TOKEN_DEFER then
-	  write_s("DEFER")
-	else
-	  write_s("UNKNOWN<");
-	  write_i(current_token^.kind);
-	  write_c('>')
-	end;
-	write_c(' ');
-
-	i := i + 1u
-  end;
-  write_c('\n')
-end
-
-proc categorize_identifier(token_content: String) -> Token;
-var
-  current_token: Token
-begin
-  if "if" = token_content then
-	current_token.kind := TOKEN_IF
-  elsif "then" = token_content then
-	current_token.kind := TOKEN_THEN
-  elsif "else" = token_content then
-	current_token.kind := TOKEN_ELSE
-  elsif "elsif" = token_content then
-	current_token.kind := TOKEN_ELSIF
-  elsif "while" = token_content then
-	current_token.kind := TOKEN_WHILE
-  elsif "do" = token_content then
-	current_token.kind := TOKEN_DO
-  elsif "proc" = token_content then
-	current_token.kind := TOKEN_PROC
-  elsif "begin" = token_content then
-	current_token.kind := TOKEN_BEGIN
-  elsif "end" = token_content then
-	current_token.kind := TOKEN_END
-  elsif "extern" = token_content then
-	current_token.kind := TOKEN_EXTERN
-  elsif "const" = token_content then
-	current_token.kind := TOKEN_CONST
-  elsif "var" = token_content then
-	current_token.kind := TOKEN_VAR
-  elsif "array" = token_content then
-	current_token.kind := TOKEN_ARRAY
-  elsif "of" = token_content then
-	current_token.kind := TOKEN_OF
-  elsif "type" = token_content then
-	current_token.kind := TOKEN_TYPE
-  elsif "record" = token_content then
-	current_token.kind := TOKEN_RECORD
-  elsif "union" = token_content then
-	current_token.kind := TOKEN_UNION
-  elsif "pointer" = token_content then
-	current_token.kind := TOKEN_POINTER
-  elsif "to" = token_content then
-	current_token.kind := TOKEN_TO
-  elsif "true" = token_content then
-	current_token.kind := TOKEN_BOOLEAN;
-	current_token.value.boolean_value := true
-  elsif "false" = token_content then
-	current_token.kind := TOKEN_BOOLEAN;
-	current_token.value.boolean_value := false
-  elsif "nil" = token_content then
-	current_token.kind := TOKEN_NIL
-  elsif "and" = token_content then
-	current_token.kind := TOKEN_AND
-  elsif "or" = token_content then
-	current_token.kind := TOKEN_OR
-  elsif "not" = token_content then
-	current_token.kind := TOKEN_NOT
-  elsif "return" = token_content then
-	current_token.kind := TOKEN_RETURN
-  elsif "cast" = token_content then
-	current_token.kind := TOKEN_CAST
-  elsif "as" = token_content then
-	current_token.kind := TOKEN_AS
-  elsif "sizeof" = token_content then
-	current_token.kind := TOKEN_SIZEOF
-  elsif "defer" = token_content then
-	current_token.kind := TOKEN_DEFER
-  else
-	current_token.kind := TOKEN_IDENTIFIER;
-	current_token.value.string := string_dup(token_content)
-  end;
-
-  return current_token
-end
-
-proc tokenize(source_code: SourceCode, tokens_size: pointer to Word) -> pointer to Token;
-var
-  token_end: pointer to Char,
-  tokens: pointer to Token,
-  current_token: pointer to Token,
-  token_length: Word,
-  first_char: Char,
-  token_content: String
-begin
-  tokens_size^ := 0u;
-  tokens := nil;
-  source_code := skip_spaces(source_code);
-
-  while source_code.text.length <> 0u do
-	tokens := cast(reallocarray(cast(tokens: pointer to Byte), tokens_size^ + 1u, Token.size): pointer to Token);
-    current_token := tokens + tokens_size^;
-	first_char := source_code.text[1u];
-
-    if is_alpha(first_char) or first_char = '_' then
-      lex_identifier(@source_code, @token_content);
-      current_token^ := categorize_identifier(token_content)
-	elsif is_digit(first_char) then
-	  token_end := nil;
-	  current_token^.value.int_value := strtol(source_code.text.ptr, @token_end, 10);
-	  token_length := cast(token_end - source_code.text.ptr: Word);
-
-	  if token_end^ = 'u' then
-	    current_token^.kind := TOKEN_WORD;
-        source_code := advance_source(source_code, token_length + 1u)
-	  else
-	    current_token^.kind := TOKEN_INTEGER;
-        source_code := advance_source(source_code, token_length)
-	  end
-	elsif first_char = '(' then
-	  source_code := advance_source(source_code, 1u);
-
-	  if source_code.text.length = 0u then
-	    current_token^.kind := TOKEN_LEFT_PAREN
-	  elsif source_code.text[1u] = '*' then
-	    source_code := advance_source(source_code, 1u);
-
-		if lex_comment(@source_code, @token_content) then
-	      current_token^.value.string := string_dup(token_content);
-		  current_token^.kind := TOKEN_COMMENT
-		else
-	      current_token^.kind := 0
-		end
-	  else
-	    current_token^.kind := TOKEN_LEFT_PAREN
-	  end
-	elsif first_char = ')' then
-	  current_token^.kind := TOKEN_RIGHT_PAREN;
-	  source_code := advance_source(source_code, 1u)
-	elsif first_char = '\'' then
-	  token_end := lex_character(source_code.text.ptr + 1, current_token);
-	  token_length := cast(token_end - source_code.text.ptr: Word);
-
-	  if token_end^ = '\'' then
-	  	current_token^.kind := TOKEN_CHARACTER;
-	    source_code := advance_source(source_code, token_length + 1u)
-	  else
-	    source_code := advance_source(source_code, 1u)
-	  end
-	elsif first_char = '"' then
-	  token_end := lex_string(source_code.text.ptr + 1, current_token);
-
-      if token_end^ = '"' then
-		current_token^.kind := TOKEN_STRING;
-	    token_length := cast(token_end - source_code.text.ptr: Word);
-	    source_code := advance_source(source_code, token_length + 1u)
-	  end
-	elsif first_char = '[' then
-	  current_token^.kind := TOKEN_LEFT_SQUARE;
-	  source_code := advance_source(source_code, 1u)
-	elsif first_char = ']' then
-	  current_token^.kind := TOKEN_RIGHT_SQUARE;
-	  source_code := advance_source(source_code, 1u)
-	elsif first_char = '>' then
-	  source_code := advance_source(source_code, 1u);
-
-      if source_code.text.length = 0u then
-	    current_token^.kind := TOKEN_GREATER_THAN
-	  elsif source_code.text[1u] = '=' then
-	    current_token^.kind := TOKEN_GREATER_EQUAL;
-	    source_code := advance_source(source_code, 1u)
-	  else
-	    current_token^.kind := TOKEN_GREATER_THAN
-	  end
-	elsif first_char = '<' then
-	  source_code := advance_source(source_code, 1u);
-
-	  if source_code.text.length = 0u then
-	    current_token^.kind := TOKEN_LESS_THAN
-	  elsif source_code.text[1u] = '=' then
-	    current_token^.kind := TOKEN_LESS_EQUAL;
-	    source_code := advance_source(source_code, 1u)
-	  elsif source_code.text[1u] = '>' then
-	    current_token^.kind := TOKEN_NOT_EQUAL;
-	    source_code := advance_source(source_code, 1u)
-	  else
-	    current_token^.kind := TOKEN_LESS_THAN
-	  end
-	elsif first_char = '=' then
-	  current_token^.kind := TOKEN_EQUAL;
-	  source_code := advance_source(source_code, 1u)
-	elsif first_char = ';' then
-	  current_token^.kind := TOKEN_SEMICOLON;
-	  source_code := advance_source(source_code, 1u)
-	elsif first_char = '.' then
-	  current_token^.kind := TOKEN_DOT;
-	  source_code := advance_source(source_code, 1u)
-	elsif first_char = ',' then
-	  current_token^.kind := TOKEN_COMMA;
-	  source_code := advance_source(source_code, 1u)
-	elsif first_char = '+' then
-	  current_token^.kind := TOKEN_PLUS;
-	  source_code := advance_source(source_code, 1u)
-	elsif first_char = '-' then
-	  current_token^.kind := TOKEN_MINUS;
-	  source_code := advance_source(source_code, 1u)
-	elsif first_char = '*' then
-	  current_token^.kind := TOKEN_MULTIPLICATION;
-	  source_code := advance_source(source_code, 1u)
-	elsif first_char = '/' then
-	  current_token^.kind := TOKEN_DIVISION;
-	  source_code := advance_source(source_code, 1u)
-	elsif first_char = '%' then
-	  current_token^.kind := TOKEN_REMAINDER;
-	  source_code := advance_source(source_code, 1u)
-	elsif first_char = ':' then
-	  source_code := advance_source(source_code, 1u);
-
-	  if source_code.text.length = 0u then
-	    current_token^.kind := TOKEN_COLON
-	  elsif source_code.text[1u] = '=' then
-	    current_token^.kind := TOKEN_ASSIGNMENT;
-	    source_code := advance_source(source_code, 1u)
-	  else
-	    current_token^.kind := TOKEN_COLON
-	  end
-	elsif first_char = '^' then
-	  current_token^.kind := TOKEN_HAT;
-	  source_code := advance_source(source_code, 1u)
-	elsif first_char = '@' then
-	  current_token^.kind := TOKEN_AT;
-	  source_code := advance_source(source_code, 1u)
-	else
-	  current_token^.kind := 0;
-	  source_code := advance_source(source_code, 1u)
-	end;
-
-	if current_token^.kind <> 0 then
-      tokens_size^ := tokens_size^ + 1u;
-      source_code := skip_spaces(source_code)
-	else
-	  write_s("Lexical analysis error on \"");
-	  write_c(first_char);
-	  write_s("\".\n")
-	end
-  end;
-
-  return tokens
-end
-
-proc parse_literal(tokens: pointer to pointer to Token, tokens_size: pointer to Word) -> pointer to Literal;
-begin
-  return cast(calloc(1u, Literal.size): pointer to Literal)
-end
-
-proc parse_constant_definition(tokens: pointer to pointer to Token,
-    tokens_size: pointer to Word) -> pointer to ConstantDefinition;
-var
-  result: pointer to ConstantDefinition
-begin
-  result := cast(calloc(1u, ConstantDefinition.size): pointer to ConstantDefinition);
-
-  result^.name := cast(malloc(strlen(tokens^^.value.string_value)): pointer to Char);
-  strcpy(result^.name, tokens^^.value.string_value);
-
-  tokens^ := tokens^ + 2u;
-  tokens_size := tokens_size - 2u;
-
-  write_z(result^.name);
-  write_c('\n');
-
-  result^.body := parse_literal(tokens, tokens_size);
-
-  tokens^ := tokens^ + 2u;
-  tokens_size := tokens_size - 2u;
-
-  return result
-end
-
-proc parse_program(tokens: pointer to pointer to Token, tokens_size: pointer to Word) -> pointer to Program;
-var
-  result: pointer to Program,
-  current_constant: pointer to pointer to ConstantDefinition
-begin
-  result := cast(calloc(1u, Program.size): pointer to Program);
-
-  result^.constants.elements := nil;
-  result^.constants.count := 0u;
-
-  if tokens^^.kind = TOKEN_CONST then
-    tokens^ := tokens^ + 1;
-	tokens_size^ := tokens_size^ - 1u;
-
-	while tokens_size^ > 0u and tokens^^.kind = TOKEN_IDENTIFIER do
-	  result^.constants.elements := cast(
-	      reallocarray(
-		  	cast(result^.constants.elements: pointer to Byte),
-			result^.constants.count + 1u,
-			(pointer to ConstantDefinition).size
-		  ) : pointer to pointer to ConstantDefinition);
-      current_constant := result^.constants.elements + result^.constants.count;
-
-	  result^.constants.count := result^.constants.count + 1u;
-
-	  current_constant^ := parse_constant_definition(tokens, tokens_size);
-	  if current_constant^ = nil then
-	    return nil
-	  end
-	end
-  end
-end
-
-proc parse_command_line*(argc: Int, argv: pointer to pointer to Char) -> pointer to CommandLine;
-var
-  parameter: pointer to pointer to Char,
-  i: Int,
-  result: pointer to CommandLine
-begin
-  i := 1;
-  result := cast(malloc(CommandLine.size): pointer to CommandLine);
-  result^.tokenize := false;
-  result^.syntax_tree := false;
-  result^.input := nil;
-
-  while i < argc do
-    parameter := argv + i;
-
-    if strcmp(parameter^, "--tokenize\0".ptr) = 0 then
-      result^.tokenize := true
-    elsif strcmp(parameter^, "--syntax-tree\0".ptr) = 0 then
-      result^.syntax_tree := true
-    elsif parameter^^ <> '-' then
-      result^.input := parameter^
-    else
-      write_s("Fatal error: Unknown command line options:");
-
-      write_c(' ');
-      write_z(parameter^);
-      write_s(".\n");
-
-      return nil
-    end;
-
-    i := i + 1
-  end;
-  if result^.input = nil then
-    write_s("Fatal error: no input files.\n");
-	return nil
-  end;
-
-  return result
-end
-
-proc process(argc: Int, argv: pointer to pointer to Char) -> Int;
-var
-  tokens: pointer to Token,
-  tokens_size: Word,
-  source_code: SourceCode,
-  command_line: pointer to CommandLine
-begin
-  command_line := parse_command_line(argc, argv);
-  if command_line = nil then
-    return 2
-  end;
-
-  source_code.position := make_position();
-  if not read_source(command_line^.input, @source_code.text) then
-    perror(command_line^.input);
-	return 3
-  end;
-  tokens := tokenize(source_code, @tokens_size);
-
-  if command_line^.tokenize then
-    print_tokens(tokens, tokens_size)
-  end;
-  if command_line^.syntax_tree then
-    parse_program(@tokens, @tokens_size)
-  end;
-  return 0
-end
-
-begin
-  exit(process(cast(count: Int), cast(parameters: pointer to pointer to Char)))
-end.

source/CommandLineInterface.def

@@ -0,0 +1,16 @@
+DEFINITION MODULE CommandLineInterface;
+
+FROM Common IMPORT ShortString;
+
+TYPE
+  CommandLine = RECORD
+    input: ShortString;
+    output: ShortString;
+    lex: BOOLEAN;
+    parse: BOOLEAN
+  END;
+  PCommandLine = POINTER TO CommandLine;
+
+PROCEDURE parse_command_line(): PCommandLine;
+
+END CommandLineInterface.

source/CommandLineInterface.elna

@@ -0,0 +1,89 @@
+module;
+
+from SYSTEM import ADR, TSIZE;
+
+from Args import GetArg, Narg;
+from FIO import WriteString, WriteChar, WriteLine, StdErr;
+from Storage import ALLOCATE;
+from Strings import CompareStr, Length;
+from MemUtils import MemZero;
+
+from Common import ShortString;
+
+proc parse_command_line() -> PCommandLine;
+var
+  parameter: ShortString;
+  i: CARDINAL;
+  result: PCommandLine;
+  parsed: BOOLEAN;
+begin
+  i := 1;
+  NEW(result);
+  result^.lex := false;
+  result^.parse := false;
+  MemZero(ADR(result^.input), 256);
+  result^.output[1] := CHAR(0);
+
+  while (i < Narg()) & (result <> nil) do
+    parsed := GetArg(parameter, i);
+    parsed := false;
+
+    if CompareStr(parameter, '--lex') = 0 then
+      parsed := true;
+      result^.lex := true
+    end;
+    if CompareStr(parameter, '--parse') = 0 then
+      parsed := true;
+      result^.parse := true
+    end;
+    if CompareStr(parameter, '-o') = 0 then
+      INC(i);
+
+      if i = Narg() then
+        WriteString(StdErr, 'Fatal error: expecting a file name following -o.');
+        result := nil
+      end;
+      if i < Narg() then
+        parsed := GetArg(parameter, i);
+        result^.output := parameter
+      end;
+      parsed := true
+    end;
+    if (parameter[1] <> '-') & (parsed = false) then
+      parsed := true;
+
+      if Length(result^.input) > 0 then
+        WriteString(StdErr, 'Fatal error: only one source file can be compiled at once. First given "');
+        WriteString(StdErr, result^.input);
+        WriteString(StdErr, '", then "');
+        WriteString(StdErr, parameter);
+        WriteString(StdErr, '".');
+        WriteLine(StdErr);
+        result := nil
+      end;
+      if result <> nil then
+        result^.input := parameter
+      end
+    end;
+    if parsed = false then
+      WriteString(StdErr, 'Fatal error: unknown command line options: ');
+
+      WriteString(StdErr, parameter);
+      WriteChar(StdErr, '.');
+      WriteLine(StdErr);
+
+      result := nil
+    end;
+
+    i := i + 1
+  end;
+  if (result <> nil) & (Length(result^.input) = 0) then
+    WriteString(StdErr, 'Fatal error: no input files.');
+    WriteLine(StdErr);
+    result := nil
+  end;
+
+  return result
+end;
+
+end.

source/Common.def

@@ -0,0 +1,12 @@
+DEFINITION MODULE Common;
+
+TYPE
+  ShortString = ARRAY[1..256] OF CHAR;
+  Identifier = ARRAY[1..256] OF CHAR;
+  PIdentifier = POINTER TO Identifier;
+  TextLocation = RECORD
+    line: CARDINAL;
+    column: CARDINAL
+  END;
+
+END Common.

source/Common.elna

@@ -0,0 +1,3 @@
+module;
+
+end.

source/Compiler.elna

@@ -0,0 +1,73 @@
+program;
+
+from FIO import Close, IsNoError, File, OpenToRead, OpenToWrite, StdErr, StdOut, WriteLine, WriteString;
+from SYSTEM import ADR;
+from M2RTS import HALT, ExitOnHalt;
+
+from Lexer import Lexer, lexer_destroy, lexer_initialize;
+from Parser import Parser;
+from Transpiler import transpile;
+from CommandLineInterface import PCommandLine, parse_command_line;
+from Parser import PAstModule, parse;
+from Strings import Length;
+
+var
+  command_line: PCommandLine;
+
+proc compile_from_stream();
+var
+  lexer: Lexer;
+  source_input: File;
+  source_output: File;
+  ast_module: PAstModule;
+begin
+  source_input := OpenToRead(command_line^.input);
+
+  if IsNoError(source_input) = false then
+    WriteString(StdErr, 'Fatal error: failed to read the input file "');
+    WriteString(StdErr, command_line^.input);
+    WriteString(StdErr, '".');
+    WriteLine(StdErr);
+
+    ExitOnHalt(2)
+  end;
+  source_output := nil;
+
+  if Length(command_line^.output) > 0 then
+    source_output := OpenToWrite(command_line^.output);
+
+    if IsNoError(source_output) = false then
+      WriteString(StdErr, 'Fatal error: failed to create the output file "');
+      WriteString(StdErr, command_line^.output);
+      WriteString(StdErr, '".');
+      WriteLine(StdErr);
+     
+      ExitOnHalt(2)
+    end
+  end;
+
+  if IsNoError(source_input) then
+    lexer_initialize(ADR(lexer), source_input);
+
+    ast_module := parse(ADR(lexer));
+    transpile(ast_module, StdOut, source_output, command_line^.input);
+
+    lexer_destroy(ADR(lexer));
+
+    Close(source_output);
+    Close(source_input)
+  end
+end;
+
+begin
+  ExitOnHalt(0);
+  command_line := parse_command_line();
+
+  if command_line <> nil then
+    compile_from_stream()
+  end;
+  if command_line = nil then
+    ExitOnHalt(1)
+  end;
+  HALT()
+end.

source/Lexer.def

@@ -0,0 +1,107 @@
+DEFINITION MODULE Lexer;
+
+FROM FIO IMPORT File;
+
+FROM Common IMPORT Identifier, ShortString, TextLocation;
+
+TYPE
+  PLexerBuffer = POINTER TO CHAR;
+  BufferPosition = RECORD
+    iterator: PLexerBuffer;
+    location: TextLocation
+  END;
+  PBufferPosition = POINTER TO BufferPosition;
+  Lexer = RECORD
+    input: File;
+    buffer: PLexerBuffer;
+    size: CARDINAL;
+    length: CARDINAL;
+    start: BufferPosition;
+    current: BufferPosition
+  END;
+  PLexer = POINTER TO Lexer;
+  LexerKind = (
+    lexerKindEof,
+    lexerKindIdentifier,
+    lexerKindIf,
+    lexerKindThen,
+    lexerKindElse,
+    lexerKindElsif,
+    lexerKindWhile,
+    lexerKindDo,
+    lexerKindProc,
+    lexerKindBegin,
+    lexerKindEnd,
+    lexerKindXor,
+    lexerKindConst,
+    lexerKindVar,
+    lexerKindCase,
+    lexerKindOf,
+    lexerKindType,
+    lexerKindRecord,
+    lexerKindUnion,
+    lexerKindPipe,
+    lexerKindTo,
+    lexerKindBoolean,
+    lexerKindNull,
+    lexerKindAnd,
+    lexerKindOr,
+    lexerKindTilde,
+    lexerKindReturn,
+    lexerKindDefer,
+    lexerKindRange,
+    lexerKindLeftParen,
+    lexerKindRightParen,
+    lexerKindLeftSquare,
+    lexerKindRightSquare,
+    lexerKindGreaterEqual,
+    lexerKindLessEqual,
+    lexerKindGreaterThan,
+    lexerKindLessThan,
+    lexerKindNotEqual,
+    lexerKindEqual,
+    lexerKindSemicolon,
+    lexerKindDot,
+    lexerKindComma,
+    lexerKindPlus,
+    lexerKindMinus,
+    lexerKindAsterisk,
+    lexerKindDivision,
+    lexerKindRemainder,
+    lexerKindAssignment,
+    lexerKindColon,
+    lexerKindHat,
+    lexerKindAt,
+    lexerKindComment,
+    lexerKindInteger,
+    lexerKindWord,
+    lexerKindCharacter,
+    lexerKindString,
+    lexerKindFrom,
+    lexerKindPointer,
+    lexerKindArray,
+    lexerKindArrow,
+    lexerKindProgram,
+    lexerKindModule,
+    lexerKindImport
+  );
+  LexerToken = RECORD
+    CASE kind: LexerKind OF
+      lexerKindBoolean: booleanKind: BOOLEAN |
+      lexerKindIdentifier: identifierKind: Identifier |
+      lexerKindInteger: integerKind: INTEGER |
+      lexerKindString: stringKind: ShortString
+    END;
+    start_location: TextLocation;
+    end_location: TextLocation
+  END;
+  PLexerToken = POINTER TO LexerToken;
+
+PROCEDURE lexer_initialize(lexer: PLexer; input: File);
+PROCEDURE lexer_destroy(lexer: PLexer);
+(* Returns the last read token. *)
+PROCEDURE lexer_current(lexer: PLexer): LexerToken;
+(* Read and return the next token. *)
+PROCEDURE lexer_lex(lexer: PLexer): LexerToken;
+
+END Lexer.

source/Lexer.elna

@@ -0,0 +1,876 @@
+module;
+
+from FIO import ReadNBytes;
+from SYSTEM import ADR, TSIZE;
+
+from DynamicStrings import String, InitStringCharStar, KillString;
+from StringConvert import StringToInteger;
+from Storage import DEALLOCATE, ALLOCATE;
+from Strings import Length;
+from MemUtils import MemCopy, MemZero;
+from StrCase import Lower;
+
+const
+  CHUNK_SIZE = 85536;
+
+type
+  (*
+   * Classification table assigns each possible character to a group (class). All
+  * characters of the same group a handled equivalently.
+  *
+  * Classification:
+  *)
+  TransitionClass = (
+    transitionClassInvalid,
+    transitionClassDigit,
+    transitionClassAlpha,
+    transitionClassSpace,
+    transitionClassColon,
+    transitionClassEquals,
+    transitionClassLeftParen,
+    transitionClassRightParen,
+    transitionClassAsterisk,
+    transitionClassUnderscore,
+    transitionClassSingle,
+    transitionClassHex,
+    transitionClassZero,
+    transitionClassX,
+    transitionClassEof,
+    transitionClassDot,
+    transitionClassMinus,
+    transitionClassSingleQuote,
+    transitionClassDoubleQuote,
+    transitionClassGreater,
+    transitionClassLess,
+    transitionClassOther
+  );
+  TransitionState = (
+    transitionStateStart,
+    transitionStateColon,
+    transitionStateIdentifier,
+    transitionStateDecimal,
+    transitionStateGreater,
+    transitionStateMinus,
+    transitionStateLeftParen,
+    transitionStateLess,
+    transitionStateDot,
+    transitionStateComment,
+    transitionStateClosingComment,
+    transitionStateCharacter,
+    transitionStateString,
+    transitionStateLeadingZero,
+    transitionStateDecimalSuffix,
+    transitionStateEnd
+  );
+  TransitionAction = proc(PLexer, PLexerToken);
+  Transition = record
+    action: TransitionAction;
+    next_state: TransitionState
+  end;
+  TransitionClasses = [22]Transition;
+
+var
+  classification: [128]TransitionClass;
+  transitions: [16]TransitionClasses;
+
+proc initialize_classification();
+var
+  i: CARDINAL;
+begin
+  classification[1] := transitionClassEof; (* NUL *)
+  classification[2] := transitionClassInvalid; (* SOH *)
+  classification[3] := transitionClassInvalid; (* STX *)
+  classification[4] := transitionClassInvalid; (* ETX *)
+  classification[5] := transitionClassInvalid; (* EOT *)
+  classification[6] := transitionClassInvalid; (* EMQ *)
+  classification[7] := transitionClassInvalid; (* ACK *)
+  classification[8] := transitionClassInvalid; (* BEL *)
+  classification[9] := transitionClassInvalid; (* BS *)
+  classification[10] := transitionClassSpace; (* HT *)
+  classification[11] := transitionClassSpace; (* LF *)
+  classification[12] := transitionClassInvalid; (* VT *)
+  classification[13] := transitionClassInvalid; (* FF *)
+  classification[14] := transitionClassSpace; (* CR *)
+  classification[15] := transitionClassInvalid; (* SO *)
+  classification[16] := transitionClassInvalid; (* SI *)
+  classification[17] := transitionClassInvalid; (* DLE *)
+  classification[18] := transitionClassInvalid; (* DC1 *)
+  classification[19] := transitionClassInvalid; (* DC2 *)
+  classification[20] := transitionClassInvalid; (* DC3 *)
+  classification[21] := transitionClassInvalid; (* DC4 *)
+  classification[22] := transitionClassInvalid; (* NAK *)
+  classification[23] := transitionClassInvalid; (* SYN *)
+  classification[24] := transitionClassInvalid; (* ETB *)
+  classification[25] := transitionClassInvalid; (* CAN *)
+  classification[26] := transitionClassInvalid; (* EM *)
+  classification[27] := transitionClassInvalid; (* SUB *)
+  classification[28] := transitionClassInvalid; (* ESC *)
+  classification[29] := transitionClassInvalid; (* FS *)
+  classification[30] := transitionClassInvalid; (* GS *)
+  classification[31] := transitionClassInvalid; (* RS *)
+  classification[32] := transitionClassInvalid; (* US *)
+  classification[33] := transitionClassSpace; (* Space *)
+  classification[34] := transitionClassSingle; (* ! *)
+  classification[35] := transitionClassDoubleQuote; (* " *)
+  classification[36] := transitionClassOther; (* # *)
+  classification[37] := transitionClassOther; (* $ *)
+  classification[38] := transitionClassSingle; (* % *)
+  classification[39] := transitionClassSingle; (* & *)
+  classification[40] := transitionClassSingleQuote; (* ' *)
+  classification[41] := transitionClassLeftParen; (* ( *)
+  classification[42] := transitionClassRightParen; (* ) *)
+  classification[43] := transitionClassAsterisk; (* * *)
+  classification[44] := transitionClassSingle; (* + *)
+  classification[45] := transitionClassSingle; (* , *)
+  classification[46] := transitionClassMinus; (* - *)
+  classification[47] := transitionClassDot; (* . *)
+  classification[48] := transitionClassSingle; (* / *)
+  classification[49] := transitionClassZero; (* 0 *)
+  classification[50] := transitionClassDigit; (* 1 *)
+  classification[51] := transitionClassDigit; (* 2 *)
+  classification[52] := transitionClassDigit; (* 3 *)
+  classification[53] := transitionClassDigit; (* 4 *)
+  classification[54] := transitionClassDigit; (* 5 *)
+  classification[55] := transitionClassDigit; (* 6 *)
+  classification[56] := transitionClassDigit; (* 7 *)
+  classification[57] := transitionClassDigit; (* 8 *)
+  classification[58] := transitionClassDigit; (* 9 *)
+  classification[59] := transitionClassColon; (* : *)
+  classification[60] := transitionClassSingle; (* ; *)
+  classification[61] := transitionClassLess; (* < *)
+  classification[62] := transitionClassEquals; (* = *)
+  classification[63] := transitionClassGreater; (* > *)
+  classification[64] := transitionClassOther; (* ? *)
+  classification[65] := transitionClassSingle; (* @ *)
+  classification[66] := transitionClassAlpha; (* A *)
+  classification[67] := transitionClassAlpha; (* B *)
+  classification[68] := transitionClassAlpha; (* C *)
+  classification[69] := transitionClassAlpha; (* D *)
+  classification[70] := transitionClassAlpha; (* E *)
+  classification[71] := transitionClassAlpha; (* F *)
+  classification[72] := transitionClassAlpha; (* G *)
+  classification[73] := transitionClassAlpha; (* H *)
+  classification[74] := transitionClassAlpha; (* I *)
+  classification[75] := transitionClassAlpha; (* J *)
+  classification[76] := transitionClassAlpha; (* K *)
+  classification[77] := transitionClassAlpha; (* L *)
+  classification[78] := transitionClassAlpha; (* M *)
+  classification[79] := transitionClassAlpha; (* N *)
+  classification[80] := transitionClassAlpha; (* O *)
+  classification[81] := transitionClassAlpha; (* P *)
+  classification[82] := transitionClassAlpha; (* Q *)
+  classification[83] := transitionClassAlpha; (* R *)
+  classification[84] := transitionClassAlpha; (* S *)
+  classification[85] := transitionClassAlpha; (* T *)
+  classification[86] := transitionClassAlpha; (* U *)
+  classification[87] := transitionClassAlpha; (* V *)
+  classification[88] := transitionClassAlpha; (* W *)
+  classification[89] := transitionClassAlpha; (* X *)
+  classification[90] := transitionClassAlpha; (* Y *)
+  classification[91] := transitionClassAlpha; (* Z *)
+  classification[92] := transitionClassSingle; (* [ *)
+  classification[93] := transitionClassOther; (* \ *)
+  classification[94] := transitionClassSingle; (* ] *)
+  classification[95] := transitionClassSingle; (* ^ *)
+  classification[96] := transitionClassUnderscore; (* _ *)
+  classification[97] := transitionClassOther; (* ` *)
+  classification[98] := transitionClassHex; (* a *)
+  classification[99] := transitionClassHex; (* b *)
+  classification[100] := transitionClassHex; (* c *)
+  classification[101] := transitionClassHex; (* d *)
+  classification[102] := transitionClassHex; (* e *)
+  classification[103] := transitionClassHex; (* f *)
+  classification[104] := transitionClassAlpha; (* g *)
+  classification[105] := transitionClassAlpha; (* h *)
+  classification[106] := transitionClassAlpha; (* i *)
+  classification[107] := transitionClassAlpha; (* j *)
+  classification[108] := transitionClassAlpha; (* k *)
+  classification[109] := transitionClassAlpha; (* l *)
+  classification[110] := transitionClassAlpha; (* m *)
+  classification[111] := transitionClassAlpha; (* n *)
+  classification[112] := transitionClassAlpha; (* o *)
+  classification[113] := transitionClassAlpha; (* p *)
+  classification[114] := transitionClassAlpha; (* q *)
+  classification[115] := transitionClassAlpha; (* r *)
+  classification[116] := transitionClassAlpha; (* s *)
+  classification[117] := transitionClassAlpha; (* t *)
+  classification[118] := transitionClassAlpha; (* u *)
+  classification[119] := transitionClassAlpha; (* v *)
+  classification[120] := transitionClassAlpha; (* w *)
+  classification[121] := transitionClassX; (* x *)
+  classification[122] := transitionClassAlpha; (* y *)
+  classification[123] := transitionClassAlpha; (* z *)
+  classification[124] := transitionClassOther; (* { *)
+  classification[125] := transitionClassSingle; (* | *)
+  classification[126] := transitionClassOther; (* } *)
+  classification[127] := transitionClassSingle; (* ~ *)
+  classification[128] := transitionClassInvalid; (* DEL *)
+
+  i := 129;
+  while i <= 256 do
+    classification[i] := transitionClassOther;
+    INC(i)
+  end
+end;
+
+proc compare_keyword(keyword: ARRAY OF CHAR, token_start: BufferPosition, token_end: PLexerBuffer) -> BOOLEAN;
+var
+  result: BOOLEAN;
+  index: CARDINAL;
+  keyword_length: CARDINAL;
+  continue: BOOLEAN;
+begin
+  index := 0;
+  result := true;
+  keyword_length := Length(keyword);
+  continue := (index < keyword_length) & (token_start.iterator <> token_end);
+
+  while continue & result do
+    result := (keyword[index] = token_start.iterator^) or (Lower(keyword[index]) = token_start.iterator^);
+    INC(token_start.iterator);
+    INC(index);
+    continue := (index < keyword_length) & (token_start.iterator <> token_end)
+  end;
+  result := result & (index = Length(keyword));
+
+  return result & (token_start.iterator = token_end)
+end;
+
+(* Reached the end of file. *)
+proc transition_action_eof(lexer: PLexer, token: PLexerToken);
+begin
+  token^.kind := lexerKindEof
+end;
+
+proc increment(position: PBufferPosition);
+begin
+  INC(position^.iterator)
+end;
+
+(* Add the character to the token currently read and advance to the next character. *)
+proc transition_action_accumulate(lexer: PLexer, token: PLexerToken);
+begin
+  increment(ADR(lexer^.current))
+end;
+
+(* The current character is not a part of the token. Finish the token already
+ * read. Don't advance to the next character. *)
+proc transition_action_finalize(lexer: PLexer, token: PLexerToken);
+begin
+  if lexer^.start.iterator^ = ':' then
+    token^.kind := lexerKindColon
+  end;
+  if lexer^.start.iterator^ = '>' then
+    token^.kind := lexerKindGreaterThan
+  end;
+  if lexer^.start.iterator^ = '<' then
+    token^.kind := lexerKindLessThan
+  end;
+  if lexer^.start.iterator^ = '(' then
+    token^.kind := lexerKindLeftParen
+  end;
+  if lexer^.start.iterator^ = '-' then
+    token^.kind := lexerKindMinus
+  end;
+  if lexer^.start.iterator^ = '.' then
+    token^.kind := lexerKindDot
+  end
+end;
+
+(* An action for tokens containing multiple characters. *)
+proc transition_action_composite(lexer: PLexer, token: PLexerToken);
+begin
+  if lexer^.start.iterator^ = '<' then
+    if lexer^.current.iterator^ = '>' then
+      token^.kind := lexerKindNotEqual
+    end;
+    if lexer^.current.iterator^ = '=' then
+      token^.kind := lexerKindLessEqual
+    end
+  end;
+  if (lexer^.start.iterator^ = '>') & (lexer^.current.iterator^ = '=') then
+    token^.kind := lexerKindGreaterEqual
+  end;
+  if (lexer^.start.iterator^ = '.') & (lexer^.current.iterator^ = '.') then
+    token^.kind := lexerKindRange
+  end;
+  if (lexer^.start.iterator^ = ':') & (lexer^.current.iterator^ = '=') then
+    token^.kind := lexerKindAssignment
+  end;
+  if (lexer^.start.iterator^ = '-') & (lexer^.current.iterator^ = '>') then
+    token^.kind := lexerKindArrow
+  end;
+  increment(ADR(lexer^.current))
+end;
+
+(* Skip a space. *)
+proc transition_action_skip(lexer: PLexer, token: PLexerToken);
+begin
+  increment(ADR(lexer^.start));
+
+  if ORD(lexer^.start.iterator^) = 10 then
+    INC(lexer^.start.location.line);
+    lexer^.start.location.column := 1
+  end;
+  lexer^.current := lexer^.start
+end;
+
+(* Delimited string action. *)
+proc transition_action_delimited(lexer: PLexer, token: PLexerToken);
+var
+  text_length: CARDINAL;
+begin
+  if lexer^.start.iterator^ = '(' then
+    token^.kind := lexerKindComment
+  end;
+  if lexer^.start.iterator^ = '"' then
+    text_length := lexer^.current.iterator;
+    DEC(text_length, lexer^.start.iterator);
+    INC(text_length);
+
+    MemZero(ADR(token^.stringKind), TSIZE(ShortString));
+    MemCopy(lexer^.start.iterator, text_length, ADR(token^.stringKind));
+
+    token^.kind := lexerKindCharacter
+  end;
+  if lexer^.start.iterator^ = "'" then
+    text_length := lexer^.current.iterator;
+    DEC(text_length, lexer^.start.iterator);
+    INC(text_length);
+
+    MemZero(ADR(token^.stringKind), TSIZE(ShortString));
+    MemCopy(lexer^.start.iterator, text_length, ADR(token^.stringKind));
+
+    token^.kind := lexerKindString
+  end;
+  increment(ADR(lexer^.current))
+end;
+
+(* Finalize keyword or identifier. *)
+proc transition_action_key_id(lexer: PLexer, token: PLexerToken);
+begin
+  token^.kind := lexerKindIdentifier;
+
+  token^.identifierKind[1] := lexer^.current.iterator;
+  DEC(token^.identifierKind[1], lexer^.start.iterator);
+  MemCopy(lexer^.start.iterator, ORD(token^.identifierKind[1]), ADR(token^.identifierKind[2]));
+
+  if compare_keyword('program', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindProgram
+  end;
+  if compare_keyword('import', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindImport
+  end;
+  if compare_keyword('const', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindConst
+  end;
+  if compare_keyword('var', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindVar
+  end;
+  if compare_keyword('if', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindIf
+  end;
+  if compare_keyword('then', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindThen
+  end;
+  if compare_keyword('elsif', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindElsif
+  end;
+  if compare_keyword('else', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindElse
+  end;
+  if compare_keyword('while', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindWhile
+  end;
+  if compare_keyword('do', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindDo
+  end;
+  if compare_keyword('proc', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindProc
+  end;
+  if compare_keyword('begin', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindBegin
+  end;
+  if compare_keyword('end', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindEnd
+  end;
+  if compare_keyword('type', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindType
+  end;
+  if compare_keyword('record', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindRecord
+  end;
+  if compare_keyword('union', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindUnion
+  end;
+  if compare_keyword('NIL', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindNull
+  end;
+  if compare_keyword('or', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindOr
+  end;
+  if compare_keyword('return', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindReturn
+  end;
+  if compare_keyword('defer', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindDefer
+  end;
+  if compare_keyword('TO', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindTo
+  end;
+  if compare_keyword('CASE', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindCase
+  end;
+  if compare_keyword('OF', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindOf
+  end;
+  if compare_keyword('FROM', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindFrom
+  end;
+  if compare_keyword('module', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindModule
+  end;
+  if compare_keyword('xor', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindXor
+  end;
+  if compare_keyword('POINTER', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindPointer
+  end;
+  if compare_keyword('ARRAY', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindArray
+  end;
+  if compare_keyword('TRUE', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindBoolean;
+    token^.booleanKind := true
+  end;
+  if compare_keyword('FALSE', lexer^.start, lexer^.current.iterator) then
+    token^.kind := lexerKindBoolean;
+    token^.booleanKind := false
+  end
+end;
+
+(* Action for tokens containing only one character. The character cannot be
+ * followed by other characters forming a composite token. *)
+proc transition_action_single(lexer: PLexer, token: PLexerToken);
+begin
+  if lexer^.current.iterator^ = '&' then
+    token^.kind := lexerKindAnd
+  end;
+  if lexer^.current.iterator^ = ';' then
+    token^.kind := lexerKindSemicolon
+  end;
+  if lexer^.current.iterator^ = ',' then
+    token^.kind := lexerKindComma
+  end;
+  if lexer^.current.iterator^ = '~' then
+    token^.kind := lexerKindTilde
+  end;
+  if lexer^.current.iterator^ = ')' then
+    token^.kind := lexerKindRightParen
+  end;
+  if lexer^.current.iterator^ = '[' then
+    token^.kind := lexerKindLeftSquare
+  end;
+  if lexer^.current.iterator^ = ']' then
+    token^.kind := lexerKindRightSquare
+  end;
+  if lexer^.current.iterator^ = '^' then
+    token^.kind := lexerKindHat
+  end;
+  if lexer^.current.iterator^ = '=' then
+    token^.kind := lexerKindEqual
+  end;
+  if lexer^.current.iterator^ = '+' then
+    token^.kind := lexerKindPlus
+  end;
+  if lexer^.current.iterator^ = '*' then
+    token^.kind := lexerKindAsterisk
+  end;
+  if lexer^.current.iterator^ = '/' then
+    token^.kind := lexerKindDivision
+  end;
+  if lexer^.current.iterator^ = '%' then
+    token^.kind := lexerKindRemainder
+  end;
+  if lexer^.current.iterator^ = '@' then
+    token^.kind := lexerKindAt
+  end;
+  if lexer^.current.iterator^ = '|' then
+    token^.kind := lexerKindPipe
+  end;
+  increment(ADR(lexer^.current.iterator))
+end;
+
+(* Handle an integer literal. *)
+proc transition_action_integer(lexer: PLexer, token: PLexerToken);
+var
+  buffer: String;
+  integer_length: CARDINAL;
+  found: BOOLEAN;
+begin
+  token^.kind := lexerKindInteger;
+
+  integer_length := lexer^.current.iterator;
+  DEC(integer_length, lexer^.start.iterator);
+  MemZero(ADR(token^.identifierKind), TSIZE(Identifier));
+  MemCopy(lexer^.start.iterator, integer_length, ADR(token^.identifierKind[1]));
+
+  buffer := InitStringCharStar(ADR(token^.identifierKind[1]));
+  token^.integerKind := StringToInteger(buffer, 10, found);
+  buffer := KillString(buffer)
+end;
+
+proc set_default_transition(current_state: TransitionState, default_action: TransitionAction, next_state: TransitionState);
+var
+  default_transition: Transition;
+begin
+  default_transition.action := default_action;
+  default_transition.next_state := next_state;
+
+  transitions[ORD(current_state) + 1][ORD(transitionClassInvalid) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassDigit) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassAlpha) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassSpace) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassColon) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassEquals) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassLeftParen) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassRightParen) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassAsterisk) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassUnderscore) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassSingle) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassHex) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassZero) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassX) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassEof) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassDot) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassMinus) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassSingleQuote) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassDoubleQuote) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassGreater) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassLess) + 1] := default_transition;
+  transitions[ORD(current_state) + 1][ORD(transitionClassOther) + 1] := default_transition
+end;
+
+(*
+ * The transition table describes transitions from one state to another, given
+ * a symbol (character class).
+ *
+ * The table has m rows and n columns, where m is the amount of states and n is
+ * the amount of classes. So given the current state and a classified character
+ * the table can be used to look up the next state.
+ *
+ * Each cell is a word long.
+ * - The least significant byte of the word is a row number (beginning with 0).
+ *   It specifies the target state. "ff" means that this is an end state and no
+ *   transition is possible.
+ * - The next byte is the action that should be performed when transitioning.
+ *   For the meaning of actions see labels in the lex_next function, which
+ *   handles each action.
+ *)
+proc initialize_transitions();
+begin
+  (* Start state. *)
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassInvalid) + 1].action := nil;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassInvalid) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDigit) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDigit) + 1].next_state := transitionStateDecimal;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassAlpha) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassAlpha) + 1].next_state := transitionStateIdentifier;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSpace) + 1].action := transition_action_skip;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSpace) + 1].next_state := transitionStateStart;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassColon) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassColon) + 1].next_state := transitionStateColon;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassEquals) + 1].action := transition_action_single;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassEquals) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassLeftParen) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassLeftParen) + 1].next_state := transitionStateLeftParen;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassRightParen) + 1].action := transition_action_single;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassRightParen) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassAsterisk) + 1].action := transition_action_single;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassAsterisk) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassUnderscore) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassUnderscore) + 1].next_state := transitionStateIdentifier;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSingle) + 1].action := transition_action_single;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSingle) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassHex) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassHex) + 1].next_state := transitionStateIdentifier;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassZero) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassZero) + 1].next_state := transitionStateLeadingZero;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassX) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassX) + 1].next_state := transitionStateIdentifier;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassEof) + 1].action := transition_action_eof;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassEof) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDot) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDot) + 1].next_state := transitionStateDot;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassMinus) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassMinus) + 1].next_state := transitionStateMinus;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSingleQuote) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassSingleQuote) + 1].next_state := transitionStateCharacter;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDoubleQuote) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDoubleQuote) + 1].next_state := transitionStateString;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassGreater) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassGreater) + 1].next_state := transitionStateGreater;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassLess) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassLess) + 1].next_state := transitionStateLess;
+
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassOther) + 1].action := nil;
+  transitions[ORD(transitionStateStart) + 1][ORD(transitionClassOther) + 1].next_state := transitionStateEnd;
+
+  (* Colon state. *)
+  set_default_transition(transitionStateColon, transition_action_finalize, transitionStateEnd);
+
+  transitions[ORD(transitionStateColon) + 1][ORD(transitionClassEquals) + 1].action := transition_action_composite;
+  transitions[ORD(transitionStateColon) + 1][ORD(transitionClassEquals) + 1].next_state := transitionStateEnd;
+
+  (* Identifier state. *)
+  set_default_transition(transitionStateIdentifier, transition_action_key_id, transitionStateEnd);
+
+  transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassDigit) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassDigit) + 1].next_state := transitionStateIdentifier;
+
+  transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassAlpha) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassAlpha) + 1].next_state := transitionStateIdentifier;
+
+  transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassUnderscore) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassUnderscore) + 1].next_state := transitionStateIdentifier;
+
+  transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassHex) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassHex) + 1].next_state := transitionStateIdentifier;
+
+  transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassZero) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassZero) + 1].next_state := transitionStateIdentifier;
+
+  transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassX) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateIdentifier) + 1][ORD(transitionClassX) + 1].next_state := transitionStateIdentifier;
+
+  (* Decimal state. *)
+  set_default_transition(transitionStateDecimal, transition_action_integer, transitionStateEnd);
+
+  transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassDigit) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassDigit) + 1].next_state := transitionStateDecimal;
+
+  transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassAlpha) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassAlpha) + 1].next_state := transitionStateDecimalSuffix;
+
+  transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassUnderscore) + 1].action := nil;
+  transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassUnderscore) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassHex) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassHex) + 1].next_state := transitionStateDecimalSuffix;
+
+  transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassZero) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassZero) + 1].next_state := transitionStateDecimal;
+
+  transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassX) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassX) + 1].next_state := transitionStateDecimalSuffix;
+
+  (* Greater state. *)
+  set_default_transition(transitionStateGreater, transition_action_finalize, transitionStateEnd);
+
+  transitions[ORD(transitionStateGreater) + 1][ORD(transitionClassEquals) + 1].action := transition_action_composite;
+  transitions[ORD(transitionStateGreater) + 1][ORD(transitionClassEquals) + 1].next_state := transitionStateEnd;
+
+  (* Minus state. *)
+  set_default_transition(transitionStateMinus, transition_action_finalize, transitionStateEnd);
+
+  transitions[ORD(transitionStateMinus) + 1][ORD(transitionClassGreater) + 1].action := transition_action_composite;
+  transitions[ORD(transitionStateMinus) + 1][ORD(transitionClassGreater) + 1].next_state := transitionStateEnd;
+
+  (* Left paren state. *)
+  set_default_transition(transitionStateLeftParen, transition_action_finalize, transitionStateEnd);
+
+  transitions[ORD(transitionStateLeftParen) + 1][ORD(transitionClassAsterisk) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateLeftParen) + 1][ORD(transitionClassAsterisk) + 1].next_state := transitionStateComment;
+
+  (* Less state. *)
+  set_default_transition(transitionStateLess, transition_action_finalize, transitionStateEnd);
+
+  transitions[ORD(transitionStateLess) + 1][ORD(transitionClassEquals) + 1].action := transition_action_composite;
+  transitions[ORD(transitionStateLess) + 1][ORD(transitionClassEquals) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateLess) + 1][ORD(transitionClassGreater) + 1].action := transition_action_composite;
+  transitions[ORD(transitionStateLess) + 1][ORD(transitionClassGreater) + 1].next_state := transitionStateEnd;
+
+  (* Hexadecimal after 0x. *)
+  set_default_transition(transitionStateDot, transition_action_finalize, transitionStateEnd);
+
+  transitions[ORD(transitionStateDot) + 1][ORD(transitionClassDot) + 1].action := transition_action_composite;
+  transitions[ORD(transitionStateDot) + 1][ORD(transitionClassDot) + 1].next_state := transitionStateEnd;
+
+  (* Comment. *)
+  set_default_transition(transitionStateComment, transition_action_accumulate, transitionStateComment);
+
+  transitions[ORD(transitionStateComment) + 1][ORD(transitionClassAsterisk) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateComment) + 1][ORD(transitionClassAsterisk) + 1].next_state := transitionStateClosingComment;
+
+  transitions[ORD(transitionStateComment) + 1][ORD(transitionClassEof) + 1].action := nil;
+  transitions[ORD(transitionStateComment) + 1][ORD(transitionClassEof) + 1].next_state := transitionStateEnd;
+
+  (* Closing comment. *)
+  set_default_transition(transitionStateClosingComment, transition_action_accumulate, transitionStateComment);
+
+  transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassInvalid) + 1].action := nil;
+  transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassInvalid) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassRightParen) + 1].action := transition_action_delimited;
+  transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassRightParen) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassAsterisk) + 1].action := transition_action_accumulate;
+  transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassAsterisk) + 1].next_state := transitionStateClosingComment;
+
+  transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassEof) + 1].action := nil;
+  transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassEof) + 1].next_state := transitionStateEnd;
+
+  (* Character. *)
+  set_default_transition(transitionStateCharacter, transition_action_accumulate, transitionStateCharacter);
+
+  transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassInvalid) + 1].action := nil;
+  transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassInvalid) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassEof) + 1].action := nil;
+  transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassEof) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassSingleQuote) + 1].action := transition_action_delimited;
+  transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassSingleQuote) + 1].next_state := transitionStateEnd;
+
+  (* String. *)
+  set_default_transition(transitionStateString, transition_action_accumulate, transitionStateString);
+
+  transitions[ORD(transitionStateString) + 1][ORD(transitionClassInvalid) + 1].action := nil;
+  transitions[ORD(transitionStateString) + 1][ORD(transitionClassInvalid) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateString) + 1][ORD(transitionClassEof) + 1].action := nil;
+  transitions[ORD(transitionStateString) + 1][ORD(transitionClassEof) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateString) + 1][ORD(transitionClassDoubleQuote) + 1].action := transition_action_delimited;
+  transitions[ORD(transitionStateString) + 1][ORD(transitionClassDoubleQuote) + 1].next_state := transitionStateEnd;
+
+  (* Leading zero. *)
+  set_default_transition(transitionStateLeadingZero, transition_action_integer, transitionStateEnd);
+
+  transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassDigit) + 1].action := nil;
+  transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassDigit) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassAlpha) + 1].action := nil;
+  transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassAlpha) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassUnderscore) + 1].action := nil;
+  transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassUnderscore) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassHex) + 1].action := nil;
+  transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassHex) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassZero) + 1].action := nil;
+  transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassZero) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassX) + 1].action := nil;
+  transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassX) + 1].next_state := transitionStateEnd;
+
+  (* Digit with a character suffix. *)
+  set_default_transition(transitionStateDecimalSuffix, transition_action_integer, transitionStateEnd);
+
+  transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassAlpha) + 1].action := nil;
+  transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassAlpha) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassDigit) + 1].action := nil;
+  transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassDigit) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassHex) + 1].action := nil;
+  transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassHex) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassZero) + 1].action := nil;
+  transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassZero) + 1].next_state := transitionStateEnd;
+
+  transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassX) + 1].action := nil;
+  transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassX) + 1].next_state := transitionStateEnd
+end;
+
+proc lexer_initialize(lexer: PLexer, input: File);
+begin
+  lexer^.input := input;
+  lexer^.length := 0;
+
+  ALLOCATE(lexer^.buffer, CHUNK_SIZE);
+  MemZero(lexer^.buffer, CHUNK_SIZE);
+  lexer^.size := CHUNK_SIZE
+end;
+
+proc lexer_current(lexer: PLexer) -> LexerToken;
+var
+  current_class: TransitionClass;
+  current_state: TransitionState;
+  current_transition: Transition;
+  result: LexerToken;
+  index1: CARDINAL;
+  index2: CARDINAL;
+begin
+  lexer^.current := lexer^.start;
+  current_state := transitionStateStart;
+
+  while current_state <> transitionStateEnd DO
+    index1 := ORD(lexer^.current.iterator^);
+    INC(index1);
+    current_class := classification[index1];
+
+    index1 := ORD(current_state);
+    INC(index1);
+    index2 := ORD(current_class);
+    INC(index2);
+
+    current_transition := transitions[index1][index2];
+    if current_transition.action <> nil then
+      current_transition.action(lexer, ADR(result))
+    end;
+    current_state := current_transition.next_state
+  end;
+  result.start_location := lexer^.start.location;
+  result.end_location := lexer^.current.location;
+
+  return result
+end;
+
+proc lexer_lex(lexer: PLexer) -> LexerToken;
+var
+  result: LexerToken;
+begin
+  if lexer^.length = 0 then
+    lexer^.length := ReadNBytes(lexer^.input, CHUNK_SIZE, lexer^.buffer);
+    lexer^.current.location.column := 1;
+    lexer^.current.location.line := 1;
+    lexer^.current.iterator := lexer^.buffer
+  end;
+  lexer^.start := lexer^.current;
+
+  result := lexer_current(lexer);
+  return result
+end;
+
+proc lexer_destroy(lexer: PLexer);
+begin
+  DEALLOCATE(lexer^.buffer, lexer^.size)
+end;
+
+begin
+  initialize_classification();
+  initialize_transitions()
+end.

source/Parser.def

@@ -0,0 +1,200 @@
+DEFINITION MODULE Parser;
+
+FROM Common IMPORT Identifier, PIdentifier, ShortString;
+FROM Lexer IMPORT PLexer;
+
+TYPE
+  Parser = RECORD
+    lexer: PLexer
+  END;
+  PParser = POINTER TO Parser;
+
+  AstLiteralKind = (
+    astLiteralKindInteger,
+    astLiteralKindString,
+    astLiteralKindNull,
+    astLiteralKindBoolean
+  );
+  AstLiteral = RECORD
+    CASE kind: AstLiteralKind OF
+      astLiteralKindInteger: integer: INTEGER |
+      astLiteralKindString: string: ShortString |
+      astLiteralKindNull: |
+      astLiteralKindBoolean: boolean: BOOLEAN
+    END
+  END;
+  PAstLiteral = POINTER TO AstLiteral;
+
+  AstUnaryOperator = (
+    astUnaryOperatorReference,
+    astUnaryOperatorNot,
+    astUnaryOperatorMinus
+  );
+  AstBinaryOperator = (
+    astBinaryOperatorSum,
+    astBinaryOperatorSubtraction,
+    astBinaryOperatorMultiplication,
+    astBinaryOperatorDivision,
+    astBinaryOperatorRemainder,
+    astBinaryOperatorEquals,
+    astBinaryOperatorNotEquals,
+    astBinaryOperatorLess,
+    astBinaryOperatorGreater,
+    astBinaryOperatorLessEqual,
+    astBinaryOperatorGreaterEqual,
+    astBinaryOperatorDisjunction,
+    astBinaryOperatorConjunction,
+    astBinaryOperatorExclusiveDisjunction,
+    astBinaryOperatorShiftLeft,
+    astBinaryOperatorShiftRight
+  );
+
+  AstExpressionKind = (
+    astExpressionKindLiteral,
+    astExpressionKindIdentifier,
+    astExpressionKindArrayAccess,
+    astExpressionKindDereference,
+    astExpressionKindFieldAccess,
+    astExpressionKindUnary,
+    astExpressionKindBinary,
+    astExpressionKindCall
+  );
+  AstExpression = RECORD 
+    CASE kind: AstExpressionKind OF
+      astExpressionKindLiteral: literal: PAstLiteral |
+      astExpressionKindIdentifier: identifier: Identifier |
+      astExpressionKindDereference: reference: PAstExpression |
+      astExpressionKindArrayAccess:
+        array: PAstExpression;
+        index: PAstExpression |
+      astExpressionKindFieldAccess:
+        aggregate: PAstExpression;
+        field: Identifier |
+      astExpressionKindUnary:
+        unary_operator: AstUnaryOperator;
+        unary_operand: PAstExpression |
+      astExpressionKindBinary:
+        binary_operator: AstBinaryOperator;
+        lhs: PAstExpression;
+        rhs: PAstExpression |
+      astExpressionKindCall:
+        callable: PAstExpression;
+        argument_count: CARDINAL;
+        arguments: PPAstExpression
+    END
+  END;
+  PAstExpression = POINTER TO AstExpression;
+  PPAstExpression = POINTER TO PAstExpression;
+
+  AstStatementKind = (
+    astStatementKindIf,
+    astStatementKindWhile,
+    astStatementKindAssignment,
+    astStatementKindReturn,
+    astStatementKindCall
+  );
+  AstStatement = RECORD
+    CASE kind: AstStatementKind OF
+      astStatementKindIf:
+        if_condition: PAstExpression;
+        if_branch: AstCompoundStatement |
+      astStatementKindWhile:
+        while_condition: PAstExpression;
+        while_body: AstCompoundStatement |
+      astStatementKindAssignment:
+        assignee: PAstExpression;
+        assignment: PAstExpression |
+      astStatementKindReturn: returned: PAstExpression |
+      astStatementKindCall: call: PAstExpression
+    END
+  END;
+  PAstStatement = POINTER TO AstStatement;
+  PPAstStatement = POINTER TO PAstStatement;
+  AstCompoundStatement = RECORD
+    count: CARDINAL;
+    statements: PPAstStatement
+  END;
+
+  AstImportStatement = RECORD
+    package: Identifier;
+    symbols: PIdentifier
+  END;
+  PAstImportStatement = POINTER TO AstImportStatement;
+  PPAstImportStatement = POINTER TO PAstImportStatement;
+
+  AstConstantDeclaration = RECORD
+    constant_name: Identifier;
+    constant_value: INTEGER
+  END;
+  PAstConstantDeclaration = POINTER TO AstConstantDeclaration;
+  PPAstConstantDeclaration = POINTER TO PAstConstantDeclaration;
+
+  AstFieldDeclaration = RECORD
+    field_name: Identifier;
+    field_type: PAstTypeExpression
+  END;
+  PAstFieldDeclaration = POINTER TO AstFieldDeclaration;
+
+  AstTypeExpressionKind = (
+    astTypeExpressionKindNamed,
+    astTypeExpressionKindRecord,
+    astTypeExpressionKindEnumeration,
+    astTypeExpressionKindArray,
+    astTypeExpressionKindPointer,
+    astTypeExpressionKindProcedure
+  );
+  AstTypeExpression = RECORD
+    CASE kind: AstTypeExpressionKind OF
+      astTypeExpressionKindNamed: name: Identifier |
+      astTypeExpressionKindEnumeration: cases: PIdentifier |
+      astTypeExpressionKindPointer: target: PAstTypeExpression |
+      astTypeExpressionKindRecord: fields: PAstFieldDeclaration |
+      astTypeExpressionKindArray:
+        base: PAstTypeExpression;
+        length: CARDINAL |
+      astTypeExpressionKindProcedure: parameters: PPAstTypeExpression
+    END
+  END;
+  PAstTypeExpression = POINTER TO AstTypeExpression;
+  PPAstTypeExpression = POINTER TO PAstTypeExpression;
+
+  AstTypedDeclaration = RECORD
+    identifier: Identifier;
+    type_expression: PAstTypeExpression
+  END;
+  PAstTypedDeclaration = POINTER TO AstTypedDeclaration;
+  PPAstTypedDeclaration = POINTER TO PAstTypedDeclaration;
+
+  AstVariableDeclaration = RECORD
+    variable_name: Identifier;
+    variable_type: PAstTypeExpression
+  END;
+  PAstVariableDeclaration = POINTER TO AstVariableDeclaration;
+  PPAstVariableDeclaration = POINTER TO PAstVariableDeclaration;
+
+  AstProcedureDeclaration = RECORD
+    name: Identifier;
+    parameter_count: CARDINAL;
+    parameters: PAstTypedDeclaration;
+    return_type: PAstTypeExpression;
+    constants: PPAstConstantDeclaration;
+    variables: PPAstVariableDeclaration;
+    statements: AstCompoundStatement
+  END;
+  PAstProcedureDeclaration = POINTER TO AstProcedureDeclaration;
+  PPAstProcedureDeclaration = POINTER TO PAstProcedureDeclaration;
+
+  AstModule = RECORD
+    main: BOOLEAN;
+    imports: PPAstImportStatement;
+    constants: PPAstConstantDeclaration;
+    types: PPAstTypedDeclaration;
+    variables: PPAstVariableDeclaration;
+    procedures: PPAstProcedureDeclaration;
+    statements: AstCompoundStatement
+  END;
+  PAstModule = POINTER TO AstModule;
+
+PROCEDURE parse(lexer: PLexer): PAstModule;
+
+END Parser.

source/Transpiler.def

@@ -0,0 +1,20 @@
+DEFINITION MODULE Transpiler;
+
+FROM FIO IMPORT File;
+
+FROM Common IMPORT ShortString;
+FROM Lexer IMPORT PLexer, Lexer;
+FROM Parser IMPORT PAstModule;
+
+TYPE
+  TranspilerContext = RECORD
+    input_name: ShortString;
+    output: File;
+    definition: File;
+    indentation: CARDINAL
+  END;
+  PTranspilerContext = POINTER TO TranspilerContext;
+
+PROCEDURE transpile(ast_module: PAstModule; output: File; definition: File; input_name: ShortString);
+
+END Transpiler.

source/Transpiler.elna

@@ -0,0 +1,658 @@
+module;
+
+from FIO import WriteNBytes, WriteLine, WriteChar, WriteString;
+from SYSTEM import ADR, TSIZE;
+
+from NumberIO import IntToStr;
+
+from Common import Identifier, PIdentifier, ShortString;
+from Parser import AstTypeExpressionKind, AstExpressionKind, AstLiteralKind, AstUnaryOperator, AstBinaryOperator,
+  PAstModule, PPAstExpression, PAstExpression, PAstLiteral, PPAstProcedureDeclaration,
+  PAstConstantDeclaration, PPAstConstantDeclaration, PPAstStatement, PAstStatement, AstStatementKind,
+  AstTypedDeclaration, PAstTypedDeclaration, PPAstTypedDeclaration, AstCompoundStatement, PAstProcedureDeclaration,
+  PAstVariableDeclaration, PPAstVariableDeclaration, PAstImportStatement, PPAstImportStatement,
+  PAstTypeExpression, PPAstTypeExpression, AstFieldDeclaration, PAstFieldDeclaration;
+
+proc indent(context: PTranspilerContext);
+var
+  count: CARDINAL;
+begin
+  count := 0;
+
+  while count < context^.indentation do
+    WriteString(context^.output, '  ');
+    INC(count)
+  end
+end;
+
+(* Write a semicolon followed by a newline. *)
+proc write_semicolon(output: File);
+begin
+  WriteChar(output, ';');
+  WriteLine(output)
+end;
+
+proc transpile_import_statement(context: PTranspilerContext, import_statement: PAstImportStatement);
+var
+  written_bytes: CARDINAL;
+  current_symbol: PIdentifier;
+begin
+  WriteString(context^.output, 'FROM ');
+  written_bytes := WriteNBytes(context^.output, ORD(import_statement^.package[1]), ADR(import_statement^.package[2]));
+
+  WriteString(context^.output, ' IMPORT ');
+
+  current_symbol := import_statement^.symbols;
+  written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), ADR(current_symbol^[2]));
+  INC(current_symbol, TSIZE(Identifier));
+
+  while ORD(current_symbol^[1]) <> 0 do
+    WriteString(context^.output, ', ');
+    written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), ADR(current_symbol^[2]));
+    INC(current_symbol, TSIZE(Identifier))
+  end;
+  write_semicolon(context^.output)
+end;
+
+proc transpile_import_part(context: PTranspilerContext, imports: PPAstImportStatement);
+var
+  import_statement: PAstImportStatement;
+begin
+  while imports^ <> nil do
+    transpile_import_statement(context, imports^);
+    INC(imports, TSIZE(PAstImportStatement))
+  end;
+  WriteLine(context^.output)
+end;
+
+proc transpile_constant_declaration(context: PTranspilerContext, declaration: PAstConstantDeclaration);
+var
+  buffer: [20]CHAR;
+  written_bytes: CARDINAL;
+begin
+  WriteString(context^.output, '  ');
+  written_bytes := WriteNBytes(context^.output, ORD(declaration^.constant_name[1]), ADR(declaration^.constant_name[2]));
+
+  WriteString(context^.output, ' = ');
+
+  IntToStr(declaration^.constant_value, 0, buffer);
+  WriteString(context^.output, buffer);
+
+  write_semicolon(context^.output)
+end;
+
+proc transpile_constant_part(context: PTranspilerContext, declarations: PPAstConstantDeclaration, extra_newline: BOOLEAN);
+var
+  current_declaration: PPAstConstantDeclaration;
+begin
+  if declarations^ <> nil then
+    WriteString(context^.output, 'CONST');
+    WriteLine(context^.output);
+
+    current_declaration := declarations;
+    while current_declaration^ <> nil do
+      transpile_constant_declaration(context, current_declaration^);
+
+      INC(current_declaration, TSIZE(PAstConstantDeclaration))
+    end;
+    if extra_newline then
+      WriteLine(context^.output)
+    end
+  end
+end;
+
+proc transpile_module(context: PTranspilerContext, result: PAstModule);
+begin
+  if result^.main = false then
+    WriteString(context^.output, 'IMPLEMENTATION ')
+  end;
+  WriteString(context^.output, 'MODULE ');
+
+  (* Write the module name and end the line with a semicolon and newline. *)
+  transpile_module_name(context);
+
+  write_semicolon(context^.output);
+  WriteLine(context^.output);
+
+  (* Write the module body. *)
+
+  transpile_import_part(context, result^.imports);
+  transpile_constant_part(context, result^.constants, true);
+  transpile_type_part(context, result^.types);
+  transpile_variable_part(context, result^.variables, true);
+  transpile_procedure_part(context, result^.procedures);
+  transpile_statement_part(context, result^.statements);
+
+  WriteString(context^.output, 'END ');
+  transpile_module_name(context);
+
+  WriteChar(context^.output, '.');
+  WriteLine(context^.output)
+end;
+
+proc transpile_type_fields(context: PTranspilerContext, fields: PAstFieldDeclaration);
+var
+  written_bytes: CARDINAL;
+  current_field: PAstFieldDeclaration;
+begin
+  current_field := fields;
+
+  while ORD(current_field^.field_name[1]) <> 0 do
+    WriteString(context^.output, '    ');
+    written_bytes := WriteNBytes(context^.output, ORD(current_field^.field_name[1]), ADR(current_field^.field_name[2]));
+
+    WriteString(context^.output, ': ');
+    transpile_type_expression(context, current_field^.field_type);
+
+    INC(current_field , TSIZE(AstFieldDeclaration));
+
+    if ORD(current_field^.field_name[1]) <> 0 then
+      WriteChar(context^.output, ';')
+    end;
+    WriteLine(context^.output)
+  end
+end;
+
+proc transpile_record_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
+begin
+  WriteString(context^.output, 'RECORD');
+  WriteLine(context^.output);
+  transpile_type_fields(context, type_expression^.fields);
+  WriteString(context^.output, '  END')
+end;
+
+proc transpile_pointer_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
+begin
+  WriteString(context^.output, 'POINTER TO ');
+
+  transpile_type_expression(context, type_expression^.target)
+end;
+
+proc transpile_array_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
+var
+  buffer: [20]CHAR;
+begin
+  WriteString(context^.output, 'ARRAY');
+
+  if type_expression^.length <> 0 then
+    WriteString(context^.output, '[1..');
+
+    IntToStr(type_expression^.length, 0, buffer);
+    WriteString(context^.output, buffer);
+
+    WriteChar(context^.output, ']')
+  end;
+  WriteString(context^.output, ' OF ');
+
+  transpile_type_expression(context, type_expression^.base)
+end;
+
+proc transpile_enumeration_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
+var
+  current_case: PIdentifier;
+  written_bytes: CARDINAL;
+begin
+  current_case := type_expression^.cases;
+
+  WriteString(context^.output, '(');
+  WriteLine(context^.output);
+  WriteString(context^.output, '    ');
+  written_bytes := WriteNBytes(context^.output, ORD(current_case^[1]), ADR(current_case^[2]));
+  INC(current_case, TSIZE(Identifier));
+
+  while ORD(current_case^[1]) <> 0 do
+    WriteChar(context^.output, ',');
+    WriteLine(context^.output);
+    WriteString(context^.output, '    ');
+    written_bytes := WriteNBytes(context^.output, ORD(current_case^[1]), ADR(current_case^[2]));
+
+    INC(current_case, TSIZE(Identifier))
+  end;
+  WriteLine(context^.output);
+  WriteString(context^.output, '  )')
+end;
+
+proc transpile_named_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
+var
+  written_bytes: CARDINAL;
+begin
+  written_bytes := WriteNBytes(context^.output, ORD(type_expression^.name[1]), ADR(type_expression^.name[2]))
+end;
+
+proc transpile_procedure_type(context: PTranspilerContext, type_expression: PAstTypeExpression);
+var
+  result: PAstTypeExpression;
+  current_parameter: PPAstTypeExpression;
+  parameter_count: CARDINAL;
+begin
+  WriteString(context^.output, 'PROCEDURE(');
+  current_parameter := type_expression^.parameters;
+
+  while current_parameter^ <> nil do
+    transpile_type_expression(context, current_parameter^);
+
+    INC(current_parameter, TSIZE(PAstTypeExpression));
+
+    if current_parameter^ <> nil then
+      WriteString(context^.output, ', ')
+    end
+  end;
+  WriteChar(context^.output, ')')
+end;
+
+proc transpile_type_expression(context: PTranspilerContext, type_expression: PAstTypeExpression);
+begin
+  if type_expression^.kind = astTypeExpressionKindRecord then
+    transpile_record_type(context, type_expression)
+  end;
+  if type_expression^.kind = astTypeExpressionKindEnumeration then
+    transpile_enumeration_type(context, type_expression)
+  end;
+  if type_expression^.kind = astTypeExpressionKindArray then
+    transpile_array_type(context, type_expression)
+  end;
+  if type_expression^.kind = astTypeExpressionKindPointer then
+    transpile_pointer_type(context, type_expression)
+  end;
+  if type_expression^.kind = astTypeExpressionKindProcedure then
+    transpile_procedure_type(context, type_expression)
+  end;
+  if type_expression^.kind = astTypeExpressionKindNamed then
+    transpile_named_type(context, type_expression)
+  end
+end;
+
+proc transpile_type_declaration(context: PTranspilerContext, declaration: PAstTypedDeclaration);
+var
+  written_bytes: CARDINAL;
+begin
+  WriteString(context^.output, '  ');
+
+  written_bytes := WriteNBytes(context^.output, ORD(declaration^.identifier[1]), ADR(declaration^.identifier[2]));
+  WriteString(context^.output, ' = ');
+
+  transpile_type_expression(context, declaration^.type_expression);
+  write_semicolon(context^.output)
+end;
+
+proc transpile_type_part(context: PTranspilerContext, declarations: PPAstTypedDeclaration);
+var
+  current_declaration: PPAstTypedDeclaration;
+begin
+  if declarations^ <> nil then
+    WriteString(context^.output, 'TYPE');
+    WriteLine(context^.output);
+
+    current_declaration := declarations;
+    while current_declaration^ <> nil do
+      transpile_type_declaration(context, current_declaration^);
+
+      INC(current_declaration, TSIZE(PAstTypedDeclaration))
+    end;
+    WriteLine(context^.output)
+  end
+end;
+
+proc transpile_variable_declaration(context: PTranspilerContext, declaration: PAstVariableDeclaration);
+var
+  written_bytes: CARDINAL;
+begin
+  WriteString(context^.output, '  ');
+  written_bytes := WriteNBytes(context^.output, ORD(declaration^.variable_name[1]), ADR(declaration^.variable_name[2]));
+
+  WriteString(context^.output, ': ');
+
+  transpile_type_expression(context, declaration^.variable_type);
+  write_semicolon(context^.output)
+end;
+
+proc transpile_variable_part(context: PTranspilerContext, declarations: PPAstVariableDeclaration, extra_newline: BOOLEAN);
+var
+  current_declaration: PPAstVariableDeclaration;
+begin
+  if declarations^ <> nil then
+    WriteString(context^.output, 'VAR');
+    WriteLine(context^.output);
+
+    current_declaration := declarations;
+    while current_declaration^ <> nil do
+      transpile_variable_declaration(context, current_declaration^);
+
+      INC(current_declaration, TSIZE(PAstVariableDeclaration))
+    end;
+    if extra_newline then
+      WriteLine(context^.output)
+    end
+  end
+end;
+
+proc transpile_procedure_heading(context: PTranspilerContext, declaration: PAstProcedureDeclaration);
+var
+  written_bytes: CARDINAL;
+  parameter_index: CARDINAL;
+  current_parameter: PAstTypedDeclaration;
+begin
+  WriteString(context^.output, 'PROCEDURE ');
+  written_bytes := WriteNBytes(context^.output, ORD(declaration^.name[1]), ADR(declaration^.name[2]));
+  WriteChar(context^.output, '(');
+
+  parameter_index := 0;
+  current_parameter := declaration^.parameters;
+
+  while parameter_index < declaration^.parameter_count do
+    written_bytes := WriteNBytes(context^.output, ORD(current_parameter^.identifier[1]), ADR(current_parameter^.identifier[2]));
+    WriteString(context^.output, ': ');
+    transpile_type_expression(context, current_parameter^.type_expression);
+
+    INC(parameter_index);
+    INC(current_parameter, TSIZE(AstTypedDeclaration));
+
+    if parameter_index <> declaration^.parameter_count then
+      WriteString(context^.output, '; ')
+    end
+  end;
+
+  WriteString(context^.output, ')');
+
+  (* Check for the return type and write it. *)
+  if declaration^.return_type <> nil then
+    WriteString(context^.output, ': ');
+    transpile_type_expression(context, declaration^.return_type)
+  end;
+  write_semicolon(context^.output)
+end;
+
+proc transpile_unary_operator(context: PTranspilerContext, operator: AstUnaryOperator);
+begin
+  if operator = astUnaryOperatorMinus then
+    WriteChar(context^.output, '-')
+  end;
+  if operator = astUnaryOperatorNot then
+    WriteChar(context^.output, '~')
+  end
+end;
+
+proc transpile_binary_operator(context: PTranspilerContext, operator: AstBinaryOperator);
+begin
+  if operator = astBinaryOperatorSum then
+    WriteChar(context^.output, '+')
+  end;
+  if operator = astBinaryOperatorSubtraction then
+    WriteChar(context^.output, '-')
+  end;
+  if operator = astBinaryOperatorMultiplication then
+    WriteChar(context^.output, '*')
+  end;
+  if operator = astBinaryOperatorEquals then
+    WriteChar(context^.output, '=')
+  end;
+  if operator = astBinaryOperatorNotEquals then
+    WriteChar(context^.output, '#')
+  end;
+  if operator = astBinaryOperatorLess then
+    WriteChar(context^.output, '<')
+  end;
+  if operator = astBinaryOperatorGreater then
+    WriteChar(context^.output, '>')
+  end;
+  if operator = astBinaryOperatorLessEqual then
+    WriteString(context^.output, '<=')
+  end;
+  if operator = astBinaryOperatorGreaterEqual then
+    WriteString(context^.output, '>=')
+  end;
+  if operator = astBinaryOperatorDisjunction then
+    WriteString(context^.output, 'OR')
+  end;
+  if operator = astBinaryOperatorConjunction then
+    WriteString(context^.output, 'AND')
+  end
+end;
+
+proc transpile_expression(context: PTranspilerContext, expression: PAstExpression);
+var
+  literal: PAstLiteral;
+  buffer: [20]CHAR;
+  written_bytes: CARDINAL;
+  argument_index: CARDINAL;
+  current_argument: PPAstExpression;
+begin
+  if expression^.kind = astExpressionKindLiteral then
+    literal := expression^.literal;
+
+    if literal^.kind = astLiteralKindInteger then
+      IntToStr(literal^.integer, 0, buffer);
+      WriteString(context^.output, buffer)
+    end;
+    if literal^.kind = astLiteralKindString then
+      WriteString(context^.output, literal^.string)
+    end;
+    if literal^.kind = astLiteralKindNull then
+      WriteString(context^.output, 'NIL')
+    end;
+    if (literal^.kind = astLiteralKindBoolean) & literal^.boolean then
+      WriteString(context^.output, 'TRUE')
+    end;
+    if (literal^.kind = astLiteralKindBoolean) & (literal^.boolean = false) then
+      WriteString(context^.output, 'FALSE')
+    end
+  end;
+  if expression^.kind = astExpressionKindIdentifier then
+    written_bytes := WriteNBytes(context^.output, ORD(expression^.identifier[1]), ADR(expression^.identifier[2]))
+  end;
+  if expression^.kind = astExpressionKindDereference then
+    transpile_expression(context, expression^.reference);
+    WriteChar(context^.output, '^')
+  end;
+  if expression^.kind = astExpressionKindArrayAccess then
+    transpile_expression(context, expression^.array);
+    WriteChar(context^.output, '[');
+    transpile_expression(context, expression^.index);
+    WriteChar(context^.output, ']')
+  end;
+  if expression^.kind = astExpressionKindFieldAccess then
+    transpile_expression(context, expression^.aggregate);
+    WriteChar(context^.output, '.');
+    written_bytes := WriteNBytes(context^.output, ORD(expression^.field[1]), ADR(expression^.field[2]))
+  end;
+  if expression^.kind = astExpressionKindUnary then
+    transpile_unary_operator(context, expression^.unary_operator);
+    transpile_expression(context, expression^.unary_operand)
+  end;
+  if expression^.kind = astExpressionKindBinary then
+    WriteChar(context^.output, '(');
+    transpile_expression(context, expression^.lhs);
+    WriteChar(context^.output, ' ');
+    transpile_binary_operator(context, expression^.binary_operator);
+    WriteChar(context^.output, ' ');
+    transpile_expression(context, expression^.rhs);
+    WriteChar(context^.output, ')')
+  end;
+  if expression^.kind = astExpressionKindCall then
+    transpile_expression(context, expression^.callable);
+    WriteChar(context^.output, '(');
+
+    current_argument := expression^.arguments;
+    if expression^.argument_count > 0 then
+      transpile_expression(context, current_argument^);
+
+      argument_index := 1;
+      INC(current_argument, TSIZE(PAstExpression));
+
+      while argument_index < expression^.argument_count do
+        WriteString(context^.output, ', ');
+
+        transpile_expression(context, current_argument^);
+
+        INC(current_argument, TSIZE(PAstExpression));
+        INC(argument_index)
+      end
+    end;
+    WriteChar(context^.output, ')')
+  end
+end;
+
+proc transpile_if_statement(context: PTranspilerContext, statement: PAstStatement);
+begin
+  WriteString(context^.output, 'IF ');
+  transpile_expression(context, statement^.if_condition);
+
+  WriteString(context^.output, ' THEN');
+  WriteLine(context^.output);
+  INC(context^.indentation);
+
+  transpile_compound_statement(context, statement^.if_branch);
+  DEC(context^.indentation);
+  indent(context);
+  WriteString(context^.output, 'END')
+end;
+
+proc transpile_while_statement(context: PTranspilerContext, statement: PAstStatement);
+begin
+  WriteString(context^.output, 'WHILE ');
+  transpile_expression(context, statement^.while_condition);
+
+  WriteString(context^.output, ' DO');
+  WriteLine(context^.output);
+  INC(context^.indentation);
+
+  transpile_compound_statement(context, statement^.while_body);
+  DEC(context^.indentation);
+  indent(context);
+  WriteString(context^.output, 'END')
+end;
+
+proc transpile_assignment_statement(context: PTranspilerContext, statement: PAstStatement);
+begin
+  transpile_expression(context, statement^.assignee);
+  WriteString(context^.output, ' := ');
+  transpile_expression(context, statement^.assignment)
+end;
+
+proc transpile_return_statement(context: PTranspilerContext, statement: PAstStatement);
+begin
+  WriteString(context^.output, 'RETURN ');
+
+  transpile_expression(context, statement^.returned)
+end;
+
+proc transpile_compound_statement(context: PTranspilerContext, statement: AstCompoundStatement);
+var
+  current_statement: PPAstStatement;
+  index: CARDINAL;
+begin
+  index := 0;
+  current_statement := statement.statements;
+
+  while index < statement.count do
+    transpile_statement(context, current_statement^);
+
+    INC(current_statement, TSIZE(PAstStatement));
+    INC(index);
+
+    if index <> statement.count then
+      WriteChar(context^.output, ';')
+    end;
+    WriteLine(context^.output)
+  end
+end;
+
+proc transpile_statement(context: PTranspilerContext, statement: PAstStatement);
+begin
+  indent(context);
+
+  if statement^.kind = astStatementKindIf then
+    transpile_if_statement(context, statement)
+  end;
+  if statement^.kind = astStatementKindWhile then
+    transpile_while_statement(context, statement)
+  end;
+  if statement^.kind = astStatementKindReturn then
+    transpile_return_statement(context, statement)
+  end;
+  if statement^.kind = astStatementKindAssignment then
+    transpile_assignment_statement(context, statement)
+  end;
+  if statement^.kind = astStatementKindCall then
+    transpile_expression(context, statement^.call)
+  end
+end;
+
+proc transpile_statement_part(context: PTranspilerContext, compound: AstCompoundStatement);
+begin
+  if compound.count > 0 then
+    WriteString(context^.output, 'BEGIN');
+    WriteLine(context^.output);
+
+    INC(context^.indentation);
+    transpile_compound_statement(context, compound);
+    DEC(context^.indentation)
+  end
+end;
+
+proc transpile_procedure_declaration(context: PTranspilerContext, declaration: PAstProcedureDeclaration);
+var
+  written_bytes: CARDINAL;
+begin
+  transpile_procedure_heading(context, declaration);
+
+  transpile_constant_part(context, declaration^.constants, false);
+  transpile_variable_part(context, declaration^.variables, false);
+  transpile_statement_part(context, declaration^.statements);
+
+  WriteString(context^.output, 'END ');
+  written_bytes := WriteNBytes(context^.output, ORD(declaration^.name[1]), ADR(declaration^.name[2]));
+
+  write_semicolon(context^.output)
+end;
+
+proc transpile_procedure_part(context: PTranspilerContext, declaration: PPAstProcedureDeclaration);
+begin
+  while declaration^ <> nil do
+    transpile_procedure_declaration(context, declaration^);
+    WriteLine(context^.output);
+
+    INC(declaration, TSIZE(PAstProcedureDeclaration))
+  end
+end;
+
+proc transpile_module_name(context: PTranspilerContext);
+var
+  counter: CARDINAL;
+  last_slash: CARDINAL;
+begin
+  counter := 1;
+  last_slash := 0;
+
+  while (context^.input_name[counter] <> '.') & (ORD(context^.input_name[counter]) <> 0) do
+    if context^.input_name[counter] = '/' then
+      last_slash := counter
+    end;
+    INC(counter)
+  end;
+
+  if last_slash = 0 then
+    counter := 1
+  end;
+  if last_slash <> 0 then
+    counter := last_slash + 1
+  end;
+  while (context^.input_name[counter] <> '.') & (ORD(context^.input_name[counter]) <> 0) do
+    WriteChar(context^.output, context^.input_name[counter]);
+    INC(counter)
+  end
+end;
+
+proc transpile(ast_module: PAstModule, output: File, definition: File, input_name: ShortString);
+var
+  context: TranspilerContext;
+begin
+  context.input_name := input_name;
+  context.output := output;
+  context.definition := definition;
+  context.indentation := 0;
+
+  transpile_module(ADR(context), ast_module)
+end;
+
+end.

tools/init.c

@@ -1,204 +0,0 @@
-#include <stdio.h>
-#include <dirent.h>
-#include <fcntl.h>
-#include <unistd.h>
-#include <sys/stat.h>
-#include <sys/wait.h>
-#include <sys/reboot.h>
-
-#define FILENAME_BUFFER_SIZE 256
-
-size_t read_command(int descriptor, char *command_buffer)
-{
-    ssize_t bytes_read = 0;
-    size_t read_so_far = 0;
-
-    while ((bytes_read = read(descriptor, command_buffer + read_so_far, FILENAME_BUFFER_SIZE - read_so_far - 1)) > 0)
-    {
-        read_so_far += bytes_read;
-        if (read_so_far >= FILENAME_BUFFER_SIZE - 1)
-        {
-            break;
-        }
-    }
-    command_buffer[read_so_far] = 0;
-    return read_so_far;
-}
-
-enum status
-{
-    status_success,
-    status_failure,
-    status_warning,
-    status_fatal
-};
-
-unsigned int make_path(char *destination, const char *directory, const char *filename, const char *extension)
-{
-    unsigned int i = 0;
-
-    for (; i < FILENAME_BUFFER_SIZE; i++)
-    {
-        if (directory[i] == 0)
-        {
-            break;
-        }
-        destination[i] = directory[i];
-    }
-    for (int j = 0; i < FILENAME_BUFFER_SIZE; i++, j++)
-    {
-        if (filename[j] == 0)
-        {
-            break;
-        }
-        destination[i] = filename[j];
-    }
-    if (extension == NULL)
-    {
-        goto done;
-    }
-    for (int j = 0; i < FILENAME_BUFFER_SIZE; i++, j++)
-    {
-        if (extension[j] == 0)
-        {
-            break;
-        }
-        destination[i] = extension[j];
-    }
-done:
-    destination[i] = 0;
-
-    return i;
-}
-
-enum status run_test(const char *file_entry_name)
-{
-    printf("Running %s. ", file_entry_name);
-
-    char filename[FILENAME_BUFFER_SIZE];
-    char command_buffer[FILENAME_BUFFER_SIZE];
-    char file_buffer[256];
-    int pipe_ends[2];
-
-    if (pipe(pipe_ends) == -1)
-    {
-        perror("pipe");
-        return status_fatal;
-    }
-    make_path(filename, "./tests/", file_entry_name, NULL);
-
-    int child_pid = fork();
-    if (child_pid == -1)
-    {
-        return status_fatal;
-    }
-    else if (child_pid == 0)
-    {
-        close(STDIN_FILENO);
-        close(STDERR_FILENO);
-        close(pipe_ends[0]); // Close the read end.
-
-        if (dup2(pipe_ends[1], STDOUT_FILENO) == -1)
-        {
-            perror("dup2");
-        }
-        else
-        {
-            execl(filename, filename);
-            perror("execl");
-        }
-        close(STDOUT_FILENO);
-        close(pipe_ends[1]);
-        _exit(1);
-    }
-    else
-    {
-        close(pipe_ends[1]); // Close the write end.
-        read_command(pipe_ends[0], command_buffer);
-        close(pipe_ends[0]);
-
-        int wait_status = 0;
-
-        make_path(filename, "./expectations/", file_entry_name, ".txt");
-
-        FILE *expectation_descriptor = fopen(filename, "r");
-
-        if (expectation_descriptor == NULL)
-        {
-            return status_warning;
-        }
-        size_t read_from_file = fread(file_buffer, 1, sizeof(file_buffer) - 1, expectation_descriptor);
-        fclose(expectation_descriptor);
-
-        file_buffer[read_from_file] = 0;
-        for (unsigned int i = 0; ; ++i)
-        {
-            if (command_buffer[i] == 0 && file_buffer[i] == 0)
-            {
-                fwrite("\n", 1, 1, stdout);
-                return status_success;
-            }
-            else if (command_buffer[i] != file_buffer[i])
-            {
-                printf("Failed. Got:\n%s", command_buffer);
-                return status_failure;
-            }
-        }
-    }
-}
-
-struct summary
-{
-    size_t total;
-    size_t failure;
-    size_t success;
-};
-
-void walk()
-{
-    DIR *directory_stream = opendir("./tests");
-    struct dirent *file_entry;
-
-    struct summary test_summary = { .total = 0, .failure = 0, .success = 0 };
-
-    while ((file_entry = readdir(directory_stream)) != NULL)
-    {
-        if (file_entry->d_name[0] == '.')
-        {
-            continue;
-        }
-        ++test_summary.total;
-        switch (run_test(file_entry->d_name))
-        {
-            case status_failure:
-                ++test_summary.failure;
-                break;
-            case status_success:
-                ++test_summary.success;
-                break;
-            case status_warning:
-                break;
-            case status_fatal:
-                goto end_walk;
-        }
-    }
-    printf("Successful: %lu, Failed: %lu, Total: %lu.\n",
-            test_summary.success, test_summary.failure, test_summary.total);
-end_walk:
-    closedir(directory_stream);
-}
-
-int main()
-{
-    int dev_console = open("/dev/console", O_WRONLY);
-    if (dev_console != -1)
-    {
-        dup2(dev_console, STDOUT_FILENO);
-        walk();
-        close(dev_console);
-    }
-    sync();
-    reboot(RB_POWER_OFF);
-
-    return 1;
-}

tools/support.rb

@@ -1,92 +0,0 @@
-# This Source Code Form is subject to the terms of the Mozilla Public License,
-# v. 2.0. If a copy of the MPL was not distributed with this file, You can
-# obtain one at https://mozilla.org/MPL/2.0/. -}
-
-require 'uri'
-require 'net/http'
-require 'open3'
-
-LINKER = 'build/rootfs/riscv32-unknown-linux-gnu/bin/ld'
-AS = 'build/rootfs/riscv32-unknown-linux-gnu/bin/as'
-
-TMP = Pathname.new('./build')
-
-class BuildTarget
-  attr_accessor(:build, :gcc, :sysroot, :tmp)
-
-  def initialize
-    @sysroot = Pathname.new '/'
-  end
-
-  def gxx
-    @gcc.gsub 'c', '+'
-  end
-
-  def rootfs
-    tmp + 'rootfs'
-  end
-end
-
-def gcc_verbose(gcc_binary)
-  read, write = IO.pipe
-  sh({'LANG' => 'C'}, gcc_binary, '--verbose', err: write)
-  write.close
-  output = read.read
-  read.close
-  output
-end
-
-def find_build_target(gcc_version)
-  gcc_binary = 'gcc'
-  output = gcc_verbose gcc_binary
-
-  if output.start_with? 'Apple clang'
-    gcc_binary = "gcc-#{gcc_version.split('.').first}"
-    output = gcc_verbose gcc_binary
-    sdk = Pathname.new '/Library/Developer/CommandLineTools/SDKs/MacOSX15.sdk'
-  end
-  result = output
-    .lines
-    .each_with_object(BuildTarget.new) do |line, accumulator|
-      if line.start_with? 'Target: '
-        accumulator.build = line.split(' ').last.strip
-      elsif line.start_with? 'COLLECT_GCC'
-        accumulator.gcc = line.split('=').last.strip
-      end
-    end
-  result.tmp = TMP
-  result.sysroot = sdk unless sdk.nil?
-  result
-end
-
-def download_and_pipe(url, target, command)
-  target.mkpath
-
-  Net::HTTP.start(url.host, url.port, use_ssl: url.scheme == 'https') do |http|
-    request = Net::HTTP::Get.new url.request_uri
-
-    http.request request do |response|
-      case response
-      when Net::HTTPRedirection
-        download_and_pipe URI.parse(response['location']), target, command
-      when Net::HTTPSuccess
-        Dir.chdir target.to_path do
-          Open3.popen2(*command) do |stdin, stdout, wait_thread|
-            Thread.new do
-              stdout.each { |line| puts line }
-            end
-
-            response.read_body do |chunk|
-              stdin.write chunk
-            end
-            stdin.close
-
-            wait_thread.value
-          end
-        end
-      else
-        response.error!
-      end
-    end
-  end
-end