belka/elna
1
0
Fork 0
Code Issues 5 Pull Requests Releases Activity

Compare commits

base: belka:modula2
Branches Tags
belka:modula2
belka:stage1
belka:cpp
belka:assembly
belka:haskell
..
compare: belka:stage1
Branches Tags
belka:modula2
belka:stage1
belka:cpp
belka:assembly
belka:haskell

12 Commits
modula2 ... stage1

Author SHA1 Message Date
Eugen Wissner
c9c9b217a2
Parse and transpile unary operations 2025-06-06 18:25:29 +02:00
Eugen Wissner
9bc6b50b94
Shorten the module declaration 2025-06-05 12:33:15 +02:00
Eugen Wissner
92ba0ff871
Parse the variable part to AST 2025-06-04 12:13:40 +02:00
Eugen Wissner
ff547a295d
Don't require the module name after end 2025-06-04 10:21:23 +02:00
Eugen Wissner
23885e5b95
Add A command line parsing procedure 2025-06-02 18:17:47 +02:00
Eugen Wissner
a93d12eb50
Handle ASCII codes > 128 in the tokenizer 2025-05-30 21:48:31 +02:00
Eugen Wissner
15135f14d8
Shorten the array syntax 2025-05-30 14:58:44 +02:00
Eugen Wissner
273e26b119
Make procedure name after the end 2025-05-30 00:25:02 +02:00
Eugen Wissner
4adac0531f
Transpile procedures and statements 2025-05-29 00:24:30 +02:00
Eugen Wissner
04a52d5ad7
Transpile procedure declaration heading 2025-05-28 00:12:33 +02:00
Eugen Wissner
ddc5865c7d
Transpile the global var section 2025-05-27 17:04:15 +02:00
Eugen Wissner
731e9c700a
Transpile type section 2025-05-27 07:52:51 +02:00
13 changed files with 908 additions and 1350 deletions
Show Stats Expand all files Collapse all files

2
.gitignore vendored
View File

@ -1,3 +1,3 @@
a.out
/boot/
/dub.selections.json
/build/

172
Rakefile
View File

@ -3,139 +3,91 @@ require 'rake/clean'
require 'open3'
M2C = 'gm2' # Modula-2 compiler.
BOOT_OBJECTS = FileList['source/*.elna']
.map do |source|
Pathname.new(source).basename.sub_ext('.o')
end
stage_compiler = Pathname.new 'build/stage1/elna'
directory 'build/stage1'
directory 'build/source'
directory 'build/boot'
directory 'build/self'
CLEAN.include 'build'
rule(/build\/stage1\/.+\.o$/ => ->(file) {
path = Pathname.new('boot/stage1/source') + Pathname.new(file).basename
rule(/build\/boot\/.+\.o$/ => ->(file) {
path = Pathname.new('source') + Pathname.new(file).basename
['build/stage1', path.sub_ext('.def'), path.sub_ext('.mod')]
['build/boot', path.sub_ext('.def'), path.sub_ext('.elna')]
}) do |t|
sources = t.prerequisites.filter { |f| f.end_with? '.elna' }
sh M2C, '-fmod=.elna', '-c', '-I', 'source', '-o', t.name, *sources
end
rule(/build\/self\/.+\.o$/ => ->(file) {
path = Pathname.new(file).relative_path_from('build')
result = []
result << File.join('source', path.basename.sub_ext('.def'))
result << File.join('build', path.sub_ext('.mod'))
}) do |t|
sources = t.prerequisites.filter { |f| f.end_with? '.mod' }
sh M2C, '-c', '-I', 'boot/stage1/source', '-o', t.name, *sources
sh M2C, '-c', '-I', 'source', '-o', t.name, *sources
end
file 'build/stage1/elna' => FileList['boot/stage1/source/*'].map { |file|
File.join 'build', 'stage1', Pathname.new(file).basename.sub_ext('.o')
} do |t|
sh M2C, '-o', t.name, *t.prerequisites
end
rule(/build\/self\/.+\.mod$/ => [
'build/self', 'build/boot/Compiler',
->(file) { File.join('source', Pathname.new(file).basename.sub_ext('.elna')) }
]) do |t|
sources, compiler = t.prerequisites
.reject { |f| File.directory? f }
.partition { |f| f.end_with? '.elna' }
file 'build/stage1/Compiler.o' => ['build/stage1', 'boot/stage1/source/Compiler.mod'] do |t|
sources = t.prerequisites.filter { |f| f.end_with? '.mod' }
File.open t.name, 'w' do |output|
puts
puts(compiler * ' ')
sh M2C, '-fscaffold-main', '-c', '-I', 'boot/stage1/source', '-o', t.name, *sources
end
Open3.popen2(*compiler) do |cl_in, cl_out|
cl_in.write File.read(*sources)
cl_in.close
['source', 'self'].each do |sub|
rule(/build\/#{sub}\/.+\.mod$/ => [
"build/#{sub}", stage_compiler.to_path,
->(file) { File.join('source', Pathname.new(file).basename.sub_ext('.elna')) }
]) do |t|
sources, compiler = t.prerequisites
.reject { |f| File.directory? f }
.partition { |f| f.end_with? '.elna' }
File.open t.name, 'w' do |output|
compiler_command = compiler + sources
puts
puts(compiler_command * ' ')
Open3.popen2(*compiler_command) do |cl_in, cl_out|
cl_in.close
IO.copy_stream cl_out, output
cl_out.close
end
IO.copy_stream cl_out, output
cl_out.close
end
end
rule(/build\/#{sub}\/.+\.o$/ => ->(file) {
path = Pathname.new(file).relative_path_from('build')
result = []
result << File.join('source', path.basename.sub_ext('.def'))
result << File.join('build', path.sub_ext('.mod'))
}) do |t|
sources = t.prerequisites.filter { |f| f.end_with? '.mod' }
sh M2C, '-c', '-I', 'source', '-o', t.name, *sources
end
file "build/#{sub}/Compiler.o" => ["build/#{sub}/Compiler.mod"] do |t|
sh M2C, '-fscaffold-main', '-c', '-I', 'source', '-o', t.name, *t.prerequisites
end
stage_compiler = Pathname.new('build') + sub + 'elna'
file stage_compiler => FileList["source/*.elna"].map { |file|
File.join 'build', sub, Pathname.new(file).basename.sub_ext('.o')
} do |t|
sh M2C, '-o', t.name, *t.prerequisites
end
end
task default: 'build/self/elna'
['boot', 'self'].each do |sub|
compiler_binary = Pathname.new('build') + sub + 'Compiler'
file compiler_binary.to_path => BOOT_OBJECTS.map { |file| File.join('build', sub, file) } do |t|
sh M2C, '-o', t.name, *t.prerequisites
end
compiler_object = compiler_binary.sub_ext('.o')
end
file 'build/boot/Compiler.o' => ['build/boot', 'source/Compiler.elna'] do |t|
sources = t.prerequisites.filter { |f| f.end_with? '.elna' }
sh M2C, '-fscaffold-main', '-fmod=.elna', '-c', '-I', 'source', '-o', t.name, *sources
end
file 'build/self/Compiler.o' => ['build/self/Compiler.mod'] do |t|
sources = t.prerequisites.filter { |f| f.end_with? '.mod' }
sh M2C, '-fscaffold-main', '-c', '-I', 'source', '-o', t.name, *sources
end
task default: 'build/self/Compiler'
task default: 'build/self/Compiler.mod'
task default: 'source/Compiler.elna'
task :default do |t|
exe, previous_output, source = t.prerequisites
exe_arguments = [exe, source]
cat_arguments = ['cat', source]
diff_arguments = ['diff', '-Nur', '--text', previous_output, '-']
puts [exe, diff_arguments * ' '].join(' | ')
Open3.pipeline exe_arguments, diff_arguments
end
task :backport do
FileList['source/*.elna'].each do |file|
source_path = Pathname.new file
source = File.read source_path
current_procedure = nil
target = ''
module_name = source_path.basename.sub_ext('')
source
.gsub(/^(var|type|const|begin)/) { |match| match.upcase }
.gsub(/\b(record|nil|or|false|true)\b/) { |match| match.upcase }
.gsub(/proc\(/, 'PROCEDURE(')
.gsub(/ & /, ' AND ')
.gsub(/ -> /, ': ')
.gsub(/program;/, "MODULE #{module_name};")
.gsub(/module;/, "IMPLEMENTATION MODULE #{module_name};")
.gsub(/end\./, "END #{module_name}.")
.gsub(/([[:space:]]*)end(;?)$/, '\1END\2')
.gsub(/^([[:space:]]*)(while|return|if)\b/) { |match| match.upcase }
.gsub(/^from ([[:alnum:]]+) import/, 'FROM \1 IMPORT')
.gsub(/ \^([[:alnum:]])/, ' POINTER TO \1')
.gsub(/(then|do)$/) { |match| match.upcase }
.gsub(/(:|=) \[([[:digit:]]+)\]/, '\1 ARRAY[1..\2] OF ')
.each_line do |line|
if line.start_with? 'proc'
current_procedure = line[5...line.index('(')]
line = 'PROCEDURE ' + line[5..].gsub(',', ';')
elsif line.start_with?('END;') && !current_procedure.nil?
line = "END #{current_procedure};"
current_proceure = nil
elsif line.start_with?('end')
line = 'END ' + line[4..]
end
target += line
end
target_path = Pathname.new('boot/stage1/source') + source_path.basename.sub_ext('.mod')
File.write target_path, target
end
FileList['source/*.def'].each do |file|
cp file, File.join('boot/stage1/source', Pathname.new(file).basename)
end
puts [cat_arguments * ' ', exe, diff_arguments * ' '].join(' | ')
Open3.pipeline(cat_arguments, exe, diff_arguments)
end

323
rakelib/cross.rake
View File

@ -1,323 +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/. -}
# frozen_string_literal: true
require 'pathname'
require 'uri'
require 'net/http'
require 'rake/clean'
require 'open3'
require 'etc'
GCC_VERSION = "15.1.0"
BINUTILS_VERSION = '2.44'
GLIBC_VERSION = '2.41'
KERNEL_VERSION = '5.15.181'
CLOBBER.include 'build'
class BuildTarget
attr_accessor(:build, :gcc, :target, :tmp)
def gxx
@gcc.gsub 'c', '+'
end
def sysroot
tmp + 'sysroot'
end
def rootfs
tmp + 'rootfs'
end
def tools
tmp + 'tools'
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, task)
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
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 = Pathname.new('./build')
task.with_defaults target: 'riscv32-unknown-linux-gnu'
result.target = task[:target]
result
end
def download_and_unarchive(url, target)
case File.extname url.path
when '.bz2'
archive_type = '-j'
root_directory = File.basename url.path, '.tar.bz2'
when '.xz'
archive_type = '-J'
root_directory = File.basename url.path, '.tar.xz'
else
raise "Unsupported archive type #{url.path}."
end
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_unarchive URI.parse(response['location'])
when Net::HTTPSuccess
Open3.popen2 'tar', '-C', target.to_path, archive_type, '-xv' 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
else
response.error!
end
end
end
target + root_directory
end
namespace :cross do
desc 'Build cross binutils'
task :binutils, [:target] do |_, args|
options = find_build_target GCC_VERSION, args
options.tools.mkpath
source_directory = download_and_unarchive(
URI.parse("https://ftp.gnu.org/gnu/binutils/binutils-#{BINUTILS_VERSION}.tar.xz"),
options.tools)
cwd = source_directory.dirname + 'build-binutils'
cwd.mkpath
options.rootfs.mkpath
env = {
'CC' => options.gcc,
'CXX' => options.gxx
}
configure_options = [
"--prefix=#{options.rootfs.realpath}",
"--target=#{options.target}",
'--disable-nls',
'--enable-gprofng=no',
'--disable-werror',
'--enable-default-hash-style=gnu',
'--disable-libquadmath'
]
configure = source_directory.relative_path_from(cwd) + 'configure'
sh env, configure.to_path, *configure_options, chdir: cwd.to_path
sh env, 'make', '-j', Etc.nprocessors.to_s, chdir: cwd.to_path
sh env, 'make', 'install', chdir: cwd.to_path
end
desc 'Build stage 1 GCC'
task :gcc1, [:target] do |_, args|
options = find_build_target GCC_VERSION, args
options.tools.mkpath
source_directory = download_and_unarchive(
URI.parse("https://gcc.gnu.org/pub/gcc/releases/gcc-#{GCC_VERSION}/gcc-#{GCC_VERSION}.tar.xz"),
options.tools)
cwd = source_directory.dirname + 'build-gcc'
cwd.mkpath
options.rootfs.mkpath
options.sysroot.mkpath
sh 'contrib/download_prerequisites', chdir: source_directory.to_path
configure_options = [
"--prefix=#{options.rootfs.realpath}",
"--with-sysroot=#{options.sysroot.realpath}",
'--enable-languages=c,c++',
'--disable-shared',
'--with-arch=rv32imafdc',
'--with-abi=ilp32d',
'--with-tune=rocket',
'--with-isa-spec=20191213',
'--disable-bootstrap',
'--disable-multilib',
'--disable-libmudflap',
'--disable-libssp',
'--disable-libquadmath',
'--disable-libsanitizer',
'--disable-threads',
'--disable-libatomic',
'--disable-libgomp',
'--disable-libvtv',
'--disable-libstdcxx',
'--disable-nls',
'--with-newlib',
'--without-headers',
"--target=#{options.target}",
"--build=#{options.build}",
"--host=#{options.build}"
]
flags = '-O2 -fPIC'
env = {
'CC' => options.gcc,
'CXX' => options.gxx,
'CFLAGS' => flags,
'CXXFLAGS' => flags,
'PATH' => "#{options.rootfs.realpath + 'bin'}:#{ENV['PATH']}"
}
configure = source_directory.relative_path_from(cwd) + 'configure'
sh env, configure.to_path, *configure_options, chdir: cwd.to_path
sh env, 'make', '-j', Etc.nprocessors.to_s, chdir: cwd.to_path
sh env, 'make', 'install', chdir: cwd.to_path
end
desc 'Copy glibc headers'
task :headers, [:target] do |_, args|
options = find_build_target GCC_VERSION, args
options.tools.mkpath
source_directory = download_and_unarchive(
URI.parse("https://ftp.gnu.org/gnu/glibc/glibc-#{GLIBC_VERSION}.tar.xz"),
options.tools)
include_directory = options.tools + 'include'
include_directory.mkpath
cp (source_directory + 'elf/elf.h'), (include_directory + 'elf.h')
end
desc 'Build linux kernel'
task :kernel, [:target] do |_, args|
options = find_build_target GCC_VERSION, args
options.tools.mkpath
cwd = download_and_unarchive(
URI.parse("https://cdn.kernel.org/pub/linux/kernel/v5.x/linux-#{KERNEL_VERSION}.tar.xz"),
options.tools)
env = {
'CROSS_COMPILE' => "#{options.target}-",
'ARCH' => 'riscv',
'PATH' => "#{options.rootfs.realpath + 'bin'}:#{ENV['PATH']}",
'HOSTCFLAGS' => "-D_UUID_T -D__GETHOSTUUID_H -I#{options.tools.realpath + 'include'}"
}
sh env, 'make', 'rv32_defconfig', chdir: cwd.to_path
sh env, 'make', '-j', Etc.nprocessors.to_s, chdir: cwd.to_path
sh env, 'make', 'headers', chdir: cwd.to_path
user_directory = options.sysroot + 'usr'
user_directory.mkpath
cp_r (cwd + 'usr/include'), (user_directory + 'include')
end
desc 'Build glibc'
task :glibc, [:target] do |_, args|
options = find_build_target GCC_VERSION, args
source_directory = options.tools + "glibc-#{GLIBC_VERSION}"
configure_options = [
'--prefix=/usr',
"--host=#{options.target}",
"--target=#{options.target}",
"--build=#{options.build}",
"--enable-kernel=#{KERNEL_VERSION}",
"--with-headers=#{options.sysroot.realpath + 'usr/include'}",
'--disable-nscd',
'--disable-libquadmath',
'--disable-libitm',
'--disable-werror',
'libc_cv_forced_unwind=yes'
]
bin = options.rootfs.realpath + 'bin'
env = {
'PATH' => "#{bin}:#{ENV['PATH']}",
'MAKE' => 'make' # Otherwise it uses gnumake which can be different and too old.
}
cwd = source_directory.dirname + 'build-glibc'
cwd.mkpath
configure = source_directory.relative_path_from(cwd) +'./configure'
sh env, configure.to_path, *configure_options, chdir: cwd.to_path
sh env, 'make', '-j', Etc.nprocessors.to_s, chdir: cwd.to_path
sh env, 'make', "install_root=#{options.sysroot.realpath}", 'install', chdir: cwd.to_path
end
desc 'Build stage 2 GCC'
task :gcc2, [:target] do |_, args|
options = find_build_target GCC_VERSION, args
source_directory = options.tools + "gcc-#{GCC_VERSION}"
cwd = options.tools + 'build-gcc'
rm_rf cwd
cwd.mkpath
configure_options = [
"--prefix=#{options.rootfs.realpath}",
"--with-sysroot=#{options.sysroot.realpath}",
'--enable-languages=c,c++,lto',
'--enable-lto',
'--enable-shared',
'--with-arch=rv32imafdc',
'--with-abi=ilp32d',
'--with-tune=rocket',
'--with-isa-spec=20191213',
'--disable-bootstrap',
'--disable-multilib',
'--enable-checking=release',
'--disable-libssp',
'--disable-libquadmath',
'--enable-threads=posix',
'--with-default-libstdcxx-abi=new',
'--disable-nls',
"--target=#{options.target}",
"--build=#{options.build}",
"--host=#{options.build}"
]
flags = '-O2 -fPIC'
env = {
'CFLAGS' => flags,
'CXXFLAGS' => flags,
'PATH' => "#{options.rootfs.realpath + 'bin'}:#{ENV['PATH']}"
}
configure = source_directory.relative_path_from(cwd) + 'configure'
sh env, configure.to_path, *configure_options, chdir: cwd.to_path
sh env, 'make', '-j', Etc.nprocessors.to_s, chdir: cwd.to_path
sh env, 'make', 'install', chdir: cwd.to_path
end
end
desc 'Build cross toolchain'
task cross: [
'cross:binutils',
'cross:gcc1',
'cross:headers',
'cross:kernel',
'cross:glibc',
'cross:gcc2'
] do
end

3
source/CommandLine.def Normal file
View File

@ -0,0 +1,3 @@
DEFINITION MODULE CommandLine;
END CommandLine.

3
source/CommandLine.mod Normal file
View File

@ -0,0 +1,3 @@
MODULE CommandLine;
END CommandLine.

75
source/CommandLineInterface.elna
View File

@ -1,75 +0,0 @@
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);
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 parameter[1] <> '-' 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.

74
source/CommandLineInterface.mod Normal file
View File

@ -0,0 +1,74 @@
IMPLEMENTATION MODULE CommandLineInterface;
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;
PROCEDURE 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);
WHILE (i < Narg()) AND (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 parameter[1] <> '-' 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) AND (Length(result^.input) = 0) THEN
WriteString(StdErr, 'Fatal error: no input files.');
WriteLine(StdErr);
result := NIL
END;
RETURN result
END parse_command_line;
END CommandLineInterface.

3
source/Common.elna
View File

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

3
source/Common.mod Normal file
View File

@ -0,0 +1,3 @@
IMPLEMENTATION MODULE Common;
END Common.

45
source/Compiler.elna → source/Compiler.mod
View File

@ -1,32 +1,32 @@
program;
MODULE Compiler;
from FIO import Close, IsNoError, File, OpenToRead, StdErr, StdOut, WriteLine, WriteString;
from SYSTEM import ADR;
from M2RTS import HALT, ExitOnHalt;
FROM FIO IMPORT Close, IsNoError, File, OpenToRead, StdErr, StdOut, WriteLine, WriteString;
FROM SYSTEM IMPORT ADR;
FROM M2RTS IMPORT HALT, ExitOnHalt;
from Lexer import Lexer, lexer_destroy, lexer_initialize;
from Transpiler import transpile;
from CommandLineInterface import PCommandLine, parse_command_line;
FROM Lexer IMPORT Lexer, lexer_destroy, lexer_initialize;
FROM Transpiler IMPORT transpile;
FROM CommandLineInterface IMPORT PCommandLine, parse_command_line;
var
VAR
command_line: PCommandLine;
proc compile_from_stream();
var
PROCEDURE compile_from_stream();
VAR
lexer: Lexer;
source_input: File;
begin
BEGIN
source_input := OpenToRead(command_line^.input);
if IsNoError(source_input) = false then
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;
if IsNoError(source_input) then
END;
IF IsNoError(source_input) THEN
lexer_initialize(ADR(lexer), source_input);
transpile(ADR(lexer), StdOut, command_line^.input);
@ -34,18 +34,17 @@ begin
lexer_destroy(ADR(lexer));
Close(source_input)
end
end;
begin
END
END compile_from_stream;
BEGIN
ExitOnHalt(0);
command_line := parse_command_line();
if command_line <> nil then
IF command_line <> NIL THEN
compile_from_stream()
end;
if command_line = nil then
END;
IF command_line = NIL THEN
ExitOnHalt(1)
end;
END;
HALT()
end.
END Compiler.

499
source/Lexer.elna → source/Lexer.mod
View File

@ -1,19 +1,19 @@
module;
IMPLEMENTATION MODULE Lexer;
from FIO import ReadNBytes, StdErr;
from SYSTEM import ADR, TSIZE;
FROM FIO IMPORT ReadNBytes, StdErr;
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;
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
CONST
CHUNK_SIZE = 65536;
type
TYPE
(*
* Classification table assigns each possible character to a group (class). All
* characters of the same group a handled equivalently.
@ -62,21 +62,21 @@ type
transitionStateDecimalSuffix,
transitionStateEnd
);
TransitionAction = proc(PLexer, PLexerToken);
Transition = record
TransitionAction = PROCEDURE(PLexer, PLexerToken);
Transition = RECORD
Action: TransitionAction;
NextState: TransitionState
end;
TransitionClasses = [22]Transition;
END;
TransitionClasses = ARRAY[1..22] OF Transition;
var
classification: [128]TransitionClass;
transitions: [16]TransitionClasses;
VAR
classification: ARRAY[1..128] OF TransitionClass;
transitions: ARRAY[1..16] OF TransitionClasses;
proc initialize_classification();
var
PROCEDURE initialize_classification();
VAR
i: CARDINAL;
begin
BEGIN
classification[1] := transitionClassEof; (* NUL *)
classification[2] := transitionClassInvalid; (* SOH *)
classification[3] := transitionClassInvalid; (* STX *)
@ -115,7 +115,7 @@ begin
classification[36] := transitionClassOther; (* # *)
classification[37] := transitionClassOther; (* $ *)
classification[38] := transitionClassSingle; (* % *)
classification[39] := transitionClassSingle; (* & *)
classification[39] := transitionClassSingle; (* AND *)
classification[40] := transitionClassSingleQuote; (* ' *)
classification[41] := transitionClassLeftParen; (* ( *)
classification[42] := transitionClassRightParen; (* ) *)
@ -207,280 +207,270 @@ begin
classification[128] := transitionClassInvalid; (* DEL *)
i := 129;
while i <= 256 do
WHILE i <= 256 DO
classification[i] := transitionClassOther;
i := i + 1
end
end;
proc compare_keyword(Keyword: ARRAY OF CHAR, TokenStart: PLexerBuffer, TokenEnd: PLexerBuffer) -> BOOLEAN;
var
END
END initialize_classification;
PROCEDURE compare_keyword(Keyword: ARRAY OF CHAR; TokenStart: PLexerBuffer; TokenEnd: PLexerBuffer): BOOLEAN;
VAR
result: BOOLEAN;
index: CARDINAL;
begin
BEGIN
index := 0;
result := true;
result := TRUE;
while (index < Length(Keyword)) & (TokenStart <> TokenEnd) & result DO
result := (Keyword[index] = TokenStart^) or (Lower(Keyword[index]) = TokenStart^);
WHILE (index < Length(Keyword)) AND (TokenStart <> TokenEnd) AND result DO
result := (Keyword[index] = TokenStart^) OR (Lower(Keyword[index]) = TokenStart^);
INC(TokenStart);
INC(index)
end;
result := (index = Length(Keyword)) & (TokenStart = TokenEnd) & result;
return result
end;
END;
result := (index = Length(Keyword)) AND (TokenStart = TokenEnd) AND result;
RETURN result
END compare_keyword;
(* Reached the end of file. *)
proc transition_action_eof(lexer: PLexer, token: PLexerToken);
begin
PROCEDURE transition_action_eof(lexer: PLexer; token: PLexerToken);
BEGIN
token^.kind := lexerKindEof
end;
END transition_action_eof;
(* Add the character to the token currently read and advance to the next character. *)
proc transition_action_accumulate(lexer: PLexer, token: PLexerToken);
begin
PROCEDURE transition_action_accumulate(lexer: PLexer; token: PLexerToken);
BEGIN
INC(lexer^.Current)
end;
END transition_action_accumulate;
(* 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^ = ':' then
PROCEDURE transition_action_finalize(lexer: PLexer; token: PLexerToken);
BEGIN
IF lexer^.Start^ = ':' THEN
token^.kind := lexerKindColon
end;
if lexer^.Start^ = '>' then
END;
IF lexer^.Start^ = '>' THEN
token^.kind := lexerKindGreaterThan
end;
if lexer^.Start^ = '<' then
END;
IF lexer^.Start^ = '<' THEN
token^.kind := lexerKindLessThan
end;
if lexer^.Start^ = '(' then
END;
IF lexer^.Start^ = '(' THEN
token^.kind := lexerKindLeftParen
end;
if lexer^.Start^ = '-' then
END;
IF lexer^.Start^ = '-' THEN
token^.kind := lexerKindLeftParen
end;
if lexer^.Start^ = '.' then
END;
IF lexer^.Start^ = '.' THEN
token^.kind := lexerKindDot
end
end;
END
END transition_action_finalize;
(* An action for tokens containing multiple characters. *)
proc transition_action_composite(lexer: PLexer, token: PLexerToken);
begin
if lexer^.Start^ = '<' then
if lexer^.Current^ = '>' then
PROCEDURE transition_action_composite(lexer: PLexer; token: PLexerToken);
BEGIN
IF lexer^.Start^ = '<' THEN
IF lexer^.Current^ = '>' THEN
token^.kind := lexerKindNotEqual
end;
if lexer^.Current^ = '=' then
END;
IF lexer^.Current^ = '=' THEN
token^.kind := lexerKindLessEqual
end
end;
if (lexer^.Start^ = '>') & (lexer^.Current^ = '=') then
END
END;
IF (lexer^.Start^ = '>') AND (lexer^.Current^ = '=') THEN
token^.kind := lexerKindGreaterEqual
end;
if (lexer^.Start^ = '.') & (lexer^.Current^ = '.') then
END;
IF (lexer^.Start^ = '.') AND (lexer^.Current^ = '.') THEN
token^.kind := lexerKindRange
end;
if (lexer^.Start^ = ':') & (lexer^.Current^ = '=') then
END;
IF (lexer^.Start^ = ':') AND (lexer^.Current^ = '=') THEN
token^.kind := lexerKindAssignment
end;
if (lexer^.Start^ = '-') & (lexer^.Current^ = '>') then
END;
IF (lexer^.Start^ = '-') AND (lexer^.Current^ = '>') THEN
token^.kind := lexerKindArrow
end;
END;
INC(lexer^.Current)
end;
END transition_action_composite;
(* Skip a space. *)
proc transition_action_skip(lexer: PLexer, token: PLexerToken);
begin
PROCEDURE transition_action_skip(lexer: PLexer; token: PLexerToken);
BEGIN
INC(lexer^.Current);
INC(lexer^.Start)
end;
END transition_action_skip;
(* Delimited string action. *)
proc transition_action_delimited(lexer: PLexer, token: PLexerToken);
var
PROCEDURE transition_action_delimited(lexer: PLexer; token: PLexerToken);
VAR
text_length: CARDINAL;
begin
if lexer^.Start^ = '(' then
BEGIN
IF lexer^.Start^ = '(' THEN
token^.kind := lexerKindComment
end;
if lexer^.Start^ = '"' then
END;
IF lexer^.Start^ = '"' THEN
token^.kind := lexerKindCharacter
end;
if lexer^.Start^ = "'" then
END;
IF lexer^.Start^ = "'" THEN
text_length := lexer^.Current - lexer^.Start;
MemZero(ADR(token^.stringKind), TSIZE(ShortString));
MemCopy(lexer^.Start, text_length, ADR(token^.stringKind));
token^.kind := lexerKindString
end;
END;
INC(lexer^.Current)
end;
(* Finalize keyword or identifier. *)
proc transition_action_key_id(lexer: PLexer, token: PLexerToken);
begin
END transition_action_delimited;
(* Finalize keyword OR identifier. *)
PROCEDURE transition_action_key_id(lexer: PLexer; token: PLexerToken);
BEGIN
token^.kind := lexerKindIdentifier;
token^.identifierKind[1] := lexer^.Current - lexer^.Start;
MemCopy(lexer^.Start, ORD(token^.identifierKind[1]), ADR(token^.identifierKind[2]));
if compare_keyword('PROGRAM', lexer^.Start, lexer^.Current) then
IF compare_keyword('PROGRAM', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindProgram
end;
if compare_keyword('IMPORT', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('IMPORT', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindImport
end;
if compare_keyword('CONST', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('CONST', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindConst
end;
if compare_keyword('VAR', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('VAR', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindVar
end;
if compare_keyword('IF', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('IF', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindIf
end;
if compare_keyword('THEN', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('THEN', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindThen
end;
if compare_keyword('ELSIF', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('ELSIF', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindElsif
end;
if compare_keyword('ELSE', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('ELSE', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindElse
end;
if compare_keyword('WHILE', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('WHILE', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindWhile
end;
if compare_keyword('DO', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('DO', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindDo
end;
if compare_keyword('proc', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('proc', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindProc
end;
if compare_keyword('BEGIN', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('BEGIN', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindBegin
end;
if compare_keyword('END', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('END', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindEnd
end;
if compare_keyword('TYPE', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('TYPE', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindType
end;
if compare_keyword('RECORD', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('RECORD', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindRecord
end;
if compare_keyword('UNION', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('UNION', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindUnion
end;
if compare_keyword('NIL', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('NIL', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindNull
end;
if compare_keyword('AND', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('AND', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindAnd
end;
if compare_keyword('OR', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('OR', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindOr
end;
if compare_keyword('RETURN', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('RETURN', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindReturn
end;
if compare_keyword('DEFINITION', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('DEFINITION', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindDefinition
end;
if compare_keyword('TO', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('TO', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindTo
end;
if compare_keyword('CASE', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('CASE', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindCase
end;
if compare_keyword('OF', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('OF', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindOf
end;
if compare_keyword('FROM', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('FROM', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindFrom
end;
if compare_keyword('MODULE', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('MODULE', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindModule
end;
if compare_keyword('IMPLEMENTATION', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('IMPLEMENTATION', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindImplementation
end;
if compare_keyword('POINTER', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('POINTER', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindPointer
end;
if compare_keyword('ARRAY', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('ARRAY', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindArray
end;
if compare_keyword('TRUE', lexer^.Start, lexer^.Current) then
END;
IF compare_keyword('TRUE', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindBoolean;
token^.booleanKind := true
end;
if compare_keyword('FALSE', lexer^.Start, lexer^.Current) then
token^.booleanKind := TRUE
END;
IF compare_keyword('FALSE', lexer^.Start, lexer^.Current) THEN
token^.kind := lexerKindBoolean;
token^.booleanKind := false
end
end;
token^.booleanKind := FALSE
END
END transition_action_key_id;
(* 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^ = '&' then
PROCEDURE transition_action_single(lexer: PLexer; token: PLexerToken);
BEGIN
IF lexer^.Current^ = '&' THEN
token^.kind := lexerKindAnd
end;
if lexer^.Current^ = ';' then
END;
IF lexer^.Current^ = ';' THEN
token^.kind := lexerKindSemicolon
end;
if lexer^.Current^ = ',' then
END;
IF lexer^.Current^ = ',' THEN
token^.kind := lexerKindComma
end;
if lexer^.Current^ = '~' then
END;
IF lexer^.Current^ = '~' THEN
token^.kind := lexerKindTilde
end;
if lexer^.Current^ = ')' then
END;
IF lexer^.Current^ = ')' THEN
token^.kind := lexerKindRightParen
end;
if lexer^.Current^ = '[' then
END;
IF lexer^.Current^ = '[' THEN
token^.kind := lexerKindLeftSquare
end;
if lexer^.Current^ = ']' then
END;
IF lexer^.Current^ = ']' THEN
token^.kind := lexerKindRightSquare
end;
if lexer^.Current^ = '^' then
END;
IF lexer^.Current^ = '^' THEN
token^.kind := lexerKindHat
end;
if lexer^.Current^ = '=' then
END;
IF lexer^.Current^ = '=' THEN
token^.kind := lexerKindEqual
end;
if lexer^.Current^ = '+' then
END;
IF lexer^.Current^ = '+' THEN
token^.kind := lexerKindPlus
end;
if lexer^.Current^ = '/' then
END;
IF lexer^.Current^ = '/' THEN
token^.kind := lexerKindDivision
end;
if lexer^.Current^ = '%' then
END;
IF lexer^.Current^ = '%' THEN
token^.kind := lexerKindRemainder
end;
if lexer^.Current^ = '@' then
END;
IF lexer^.Current^ = '@' THEN
token^.kind := lexerKindAt
end;
if lexer^.Current^ = '|' then
END;
IF lexer^.Current^ = '|' THEN
token^.kind := lexerKindPipe
end;
END;
INC(lexer^.Current)
end;
END transition_action_single;
(* Handle an integer literal. *)
proc transition_action_integer(lexer: PLexer, token: PLexerToken);
var
PROCEDURE transition_action_integer(lexer: PLexer; token: PLexerToken);
VAR
buffer: String;
integer_length: CARDINAL;
found: BOOLEAN;
begin
BEGIN
token^.kind := lexerKindInteger;
integer_length := lexer^.Current - lexer^.Start;
@ -490,12 +480,11 @@ begin
buffer := InitStringCharStar(ADR(token^.identifierKind[1]));
token^.integerKind := StringToInteger(buffer, 10, found);
buffer := KillString(buffer)
end;
proc set_default_transition(CurrentState: TransitionState, DefaultAction: TransitionAction, NextState: TransitionState);
var
END transition_action_integer;
PROCEDURE set_default_transition(CurrentState: TransitionState; DefaultAction: TransitionAction; NextState: TransitionState);
VAR
DefaultTransition: Transition;
begin
BEGIN
DefaultTransition.Action := DefaultAction;
DefaultTransition.NextState := NextState;
@ -521,8 +510,7 @@ begin
transitions[ORD(CurrentState) + 1][ORD(transitionClassGreater) + 1] := DefaultTransition;
transitions[ORD(CurrentState) + 1][ORD(transitionClassLess) + 1] := DefaultTransition;
transitions[ORD(CurrentState) + 1][ORD(transitionClassOther) + 1] := DefaultTransition
end;
END set_default_transition;
(*
* The transition table describes transitions from one state to another, given
* a symbol (character class).
@ -539,10 +527,10 @@ end;
* For the meaning of actions see labels in the lex_next function, which
* handles each action.
*)
proc initialize_transitions();
begin
PROCEDURE initialize_transitions();
BEGIN
(* Start state. *)
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassInvalid) + 1].Action := nil;
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassInvalid) + 1].Action := NIL;
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassInvalid) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassDigit) + 1].Action := transition_action_accumulate;
@ -605,7 +593,7 @@ begin
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassLess) + 1].Action := transition_action_accumulate;
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassLess) + 1].NextState := transitionStateLess;
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassOther) + 1].Action := nil;
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassOther) + 1].Action := NIL;
transitions[ORD(transitionStateStart) + 1][ORD(transitionClassOther) + 1].NextState := transitionStateEnd;
(* Colon state. *)
@ -644,7 +632,7 @@ begin
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassAlpha) + 1].Action := transition_action_accumulate;
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassAlpha) + 1].NextState := transitionStateDecimalSuffix;
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassUnderscore) + 1].Action := nil;
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassUnderscore) + 1].Action := NIL;
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassUnderscore) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateDecimal) + 1][ORD(transitionClassHex) + 1].Action := transition_action_accumulate;
@ -695,13 +683,13 @@ begin
transitions[ORD(transitionStateComment) + 1][ORD(transitionClassAsterisk) + 1].Action := transition_action_accumulate;
transitions[ORD(transitionStateComment) + 1][ORD(transitionClassAsterisk) + 1].NextState := transitionStateClosingComment;
transitions[ORD(transitionStateComment) + 1][ORD(transitionClassEof) + 1].Action := nil;
transitions[ORD(transitionStateComment) + 1][ORD(transitionClassEof) + 1].Action := NIL;
transitions[ORD(transitionStateComment) + 1][ORD(transitionClassEof) + 1].NextState := 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].Action := NIL;
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassInvalid) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassRightParen) + 1].Action := transition_action_delimited;
@ -710,16 +698,16 @@ begin
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassAsterisk) + 1].Action := transition_action_accumulate;
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassAsterisk) + 1].NextState := transitionStateClosingComment;
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassEof) + 1].Action := nil;
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassEof) + 1].Action := NIL;
transitions[ORD(transitionStateClosingComment) + 1][ORD(transitionClassEof) + 1].NextState := 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].Action := NIL;
transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassInvalid) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassEof) + 1].Action := nil;
transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassEof) + 1].Action := NIL;
transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassEof) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateCharacter) + 1][ORD(transitionClassSingleQuote) + 1].Action := transition_action_delimited;
@ -728,10 +716,10 @@ begin
(* 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].Action := NIL;
transitions[ORD(transitionStateString) + 1][ORD(transitionClassInvalid) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateString) + 1][ORD(transitionClassEof) + 1].Action := nil;
transitions[ORD(transitionStateString) + 1][ORD(transitionClassEof) + 1].Action := NIL;
transitions[ORD(transitionStateString) + 1][ORD(transitionClassEof) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateString) + 1][ORD(transitionClassDoubleQuote) + 1].Action := transition_action_delimited;
@ -740,95 +728,90 @@ begin
(* 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].Action := NIL;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassDigit) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassAlpha) + 1].Action := nil;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassAlpha) + 1].Action := NIL;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassAlpha) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassUnderscore) + 1].Action := nil;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassUnderscore) + 1].Action := NIL;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassUnderscore) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassHex) + 1].Action := nil;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassHex) + 1].Action := NIL;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassHex) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassZero) + 1].Action := nil;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassZero) + 1].Action := NIL;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassZero) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassX) + 1].Action := nil;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassX) + 1].Action := NIL;
transitions[ORD(transitionStateLeadingZero) + 1][ORD(transitionClassX) + 1].NextState := 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].Action := NIL;
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassAlpha) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassDigit) + 1].Action := nil;
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassDigit) + 1].Action := NIL;
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassDigit) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassHex) + 1].Action := nil;
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassHex) + 1].Action := NIL;
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassHex) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassZero) + 1].Action := nil;
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassZero) + 1].Action := NIL;
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassZero) + 1].NextState := transitionStateEnd;
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassX) + 1].Action := nil;
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassX) + 1].Action := NIL;
transitions[ORD(transitionStateDecimalSuffix) + 1][ORD(transitionClassX) + 1].NextState := transitionStateEnd
end;
proc lexer_initialize(lexer: PLexer, Input: File);
begin
END initialize_transitions;
PROCEDURE 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
END lexer_initialize;
PROCEDURE lexer_current(lexer: PLexer): LexerToken;
VAR
CurrentClass: TransitionClass;
CurrentState: TransitionState;
CurrentTransition: Transition;
result: LexerToken;
begin
BEGIN
lexer^.Current := lexer^.Start;
CurrentState := transitionStateStart;
while CurrentState <> transitionStateEnd DO
WHILE CurrentState <> transitionStateEnd DO
CurrentClass := classification[ORD(lexer^.Current^) + 1];
CurrentTransition := transitions[ORD(CurrentState) + 1][ORD(CurrentClass) + 1];
if CurrentTransition.Action <> nil then
IF CurrentTransition.Action <> NIL THEN
CurrentTransition.Action(lexer, ADR(result))
end;
END;
CurrentState := CurrentTransition.NextState
end;
return result
end;
proc lexer_lex(lexer: PLexer) -> LexerToken;
var
END;
RETURN result
END lexer_current;
PROCEDURE lexer_lex(lexer: PLexer): LexerToken;
VAR
result: LexerToken;
begin
if lexer^.Length = 0 then
BEGIN
IF lexer^.Length = 0 THEN
lexer^.Length := ReadNBytes(lexer^.Input, CHUNK_SIZE, lexer^.Buffer);
lexer^.Current := lexer^.Buffer
end;
END;
lexer^.Start := lexer^.Current;
result := lexer_current(lexer);
return result
end;
proc lexer_destroy(lexer: PLexer);
begin
RETURN result
END lexer_lex;
PROCEDURE lexer_destroy(lexer: PLexer);
BEGIN
DEALLOCATE(lexer^.Buffer, lexer^.Size)
end;
begin
END lexer_destroy;
BEGIN
initialize_classification();
initialize_transitions()
end.
END Lexer.

416
source/Parser.elna → source/Parser.mod
View File

@ -1,38 +1,37 @@
module;
IMPLEMENTATION MODULE Parser;
from SYSTEM import TSIZE;
FROM SYSTEM IMPORT TSIZE;
from MemUtils import MemZero;
from Storage import ALLOCATE, REALLOCATE;
FROM MemUtils IMPORT MemZero;
FROM Storage IMPORT ALLOCATE, REALLOCATE;
from Lexer import LexerKind, LexerToken, lexer_current, lexer_lex;
FROM Lexer IMPORT LexerKind, LexerToken, lexer_current, lexer_lex;
(* Calls lexer_lex() but skips the comments. *)
proc transpiler_lex(lexer: PLexer) -> LexerToken;
var
PROCEDURE transpiler_lex(lexer: PLexer): LexerToken;
VAR
result: LexerToken;
begin
BEGIN
result := lexer_lex(lexer);
while result.kind = lexerKindComment do
WHILE result.kind = lexerKindComment DO
result := lexer_lex(lexer)
end;
END;
return result
end;
proc parse_type_fields(lexer: PLexer) -> PAstFieldDeclaration;
var
RETURN result
END transpiler_lex;
PROCEDURE parse_type_fields(lexer: PLexer): PAstFieldDeclaration;
VAR
token: LexerToken;
field_declarations: PAstFieldDeclaration;
field_count: CARDINAL;
current_field: PAstFieldDeclaration;
begin
BEGIN
ALLOCATE(field_declarations, TSIZE(AstFieldDeclaration));
token := transpiler_lex(lexer);
field_count := 0;
while token.kind <> lexerKindEnd do
WHILE token.kind <> lexerKindEnd DO
INC(field_count);
REALLOCATE(field_declarations, TSIZE(AstFieldDeclaration) * (field_count + 1));
current_field := field_declarations;
@ -46,81 +45,77 @@ begin
current_field^.field_type := parse_type_expression(lexer);
token := transpiler_lex(lexer);
if token.kind = lexerKindSemicolon then
IF token.kind = lexerKindSemicolon THEN
token := transpiler_lex(lexer)
end
end;
END
END;
INC(current_field, TSIZE(AstFieldDeclaration));
MemZero(current_field, TSIZE(AstFieldDeclaration));
return field_declarations
end;
proc parse_record_type(lexer: PLexer) -> PAstTypeExpression;
var
RETURN field_declarations
END parse_type_fields;
PROCEDURE parse_record_type(lexer: PLexer): PAstTypeExpression;
VAR
result: PAstTypeExpression;
begin
BEGIN
NEW(result);
result^.kind := astTypeExpressionKindRecord;
result^.fields := parse_type_fields(lexer);
return result
end;
proc parse_pointer_type(lexer: PLexer) -> PAstTypeExpression;
var
RETURN result
END parse_record_type;
PROCEDURE parse_pointer_type(lexer: PLexer): PAstTypeExpression;
VAR
token: LexerToken;
result: PAstTypeExpression;
begin
BEGIN
NEW(result);
result^.kind := astTypeExpressionKindPointer;
token := lexer_current(lexer);
if token.kind = lexerKindPointer then
IF token.kind = lexerKindPointer THEN
token := transpiler_lex(lexer)
end;
END;
token := lexer_current(lexer);
result^.target := parse_type_expression(lexer);
return result
end;
proc parse_array_type(lexer: PLexer) -> PAstTypeExpression;
var
RETURN result
END parse_pointer_type;
PROCEDURE parse_array_type(lexer: PLexer): PAstTypeExpression;
VAR
token: LexerToken;
buffer: [20]CHAR;
buffer: ARRAY[1..20] OF CHAR;
result: PAstTypeExpression;
begin
BEGIN
NEW(result);
result^.kind := astTypeExpressionKindArray;
result^.length := 0;
token := lexer_current(lexer);
if token.kind = lexerKindArray then
IF token.kind = lexerKindArray THEN
token := transpiler_lex(lexer)
end;
if token.kind <> lexerKindOf then
END;
IF token.kind <> lexerKindOf THEN
token := transpiler_lex(lexer);
result^.length := token.integerKind;
token := transpiler_lex(lexer);
end;
END;
token := transpiler_lex(lexer);
result^.base := parse_type_expression(lexer);
return result
end;
proc parse_enumeration_type(lexer: PLexer) -> PAstTypeExpression;
var
RETURN result
END parse_array_type;
PROCEDURE parse_enumeration_type(lexer: PLexer): PAstTypeExpression;
VAR
token: LexerToken;
result: PAstTypeExpression;
current_case: PIdentifier;
case_count: CARDINAL;
begin
BEGIN
NEW(result);
result^.kind := astTypeExpressionKindEnumeration;
@ -132,7 +127,7 @@ begin
token := transpiler_lex(lexer);
while token.kind = lexerKindComma do
WHILE token.kind = lexerKindComma DO
token := transpiler_lex(lexer);
INC(case_count);
@ -142,34 +137,32 @@ begin
current_case^ := token.identifierKind;
token := transpiler_lex(lexer)
end;
END;
INC(current_case, TSIZE(Identifier));
MemZero(current_case, TSIZE(Identifier));
return result
end;
proc parse_named_type(lexer: PLexer) -> PAstTypeExpression;
var
RETURN result
END parse_enumeration_type;
PROCEDURE parse_named_type(lexer: PLexer): PAstTypeExpression;
VAR
token: LexerToken;
result: PAstTypeExpression;
begin
BEGIN
token := lexer_current(lexer);
NEW(result);
result^.kind := astTypeExpressionKindNamed;
result^.name := token.identifierKind;
return result
end;
proc parse_procedure_type(lexer: PLexer) -> PAstTypeExpression;
var
RETURN result
END parse_named_type;
PROCEDURE parse_procedure_type(lexer: PLexer): PAstTypeExpression;
VAR
token: LexerToken;
result: PAstTypeExpression;
current_parameter: PPAstTypeExpression;
parameter_count: CARDINAL;
begin
BEGIN
parameter_count := 0;
NEW(result);
result^.kind := astTypeExpressionKindProcedure;
@ -179,7 +172,7 @@ begin
token := transpiler_lex(lexer);
token := transpiler_lex(lexer);
while token.kind <> lexerKindRightParen do
WHILE token.kind <> lexerKindRightParen DO
INC(parameter_count);
REALLOCATE(result^.parameters, TSIZE(PAstTypeExpression) * (parameter_count + 1));
current_parameter := result^.parameters;
@ -188,51 +181,49 @@ begin
current_parameter^ := parse_type_expression(lexer);
token := transpiler_lex(lexer);
if token.kind = lexerKindComma then
IF token.kind = lexerKindComma THEN
token := transpiler_lex(lexer)
end
end;
END
END;
current_parameter := result^.parameters;
INC(current_parameter, TSIZE(PAstTypeExpression) * parameter_count);
current_parameter^ := nil;
current_parameter^ := NIL;
return result
end;
proc parse_type_expression(lexer: PLexer) -> PAstTypeExpression;
var
RETURN result
END parse_procedure_type;
PROCEDURE parse_type_expression(lexer: PLexer): PAstTypeExpression;
VAR
token: LexerToken;
result: PAstTypeExpression;
begin
result := nil;
BEGIN
result := NIL;
token := lexer_current(lexer);
if token.kind = lexerKindRecord then
IF token.kind = lexerKindRecord THEN
result := parse_record_type(lexer)
end;
if token.kind = lexerKindLeftParen then
END;
IF token.kind = lexerKindLeftParen THEN
result := parse_enumeration_type(lexer)
end;
if (token.kind = lexerKindArray) or (token.kind = lexerKindLeftSquare) then
END;
IF (token.kind = lexerKindArray) OR (token.kind = lexerKindLeftSquare) THEN
result := parse_array_type(lexer)
end;
if token.kind = lexerKindHat then
END;
IF token.kind = lexerKindHat THEN
result := parse_pointer_type(lexer)
end;
if token.kind = lexerKindProc then
END;
IF token.kind = lexerKindProc THEN
result := parse_procedure_type(lexer)
end;
if token.kind = lexerKindIdentifier then
END;
IF token.kind = lexerKindIdentifier THEN
result := parse_named_type(lexer)
end;
return result
end;
proc parse_type_declaration(lexer: PLexer) -> PAstTypeDeclaration;
var
END;
RETURN result
END parse_type_expression;
PROCEDURE parse_type_declaration(lexer: PLexer): PAstTypeDeclaration;
VAR
token: LexerToken;
result: PAstTypeDeclaration;
begin
BEGIN
token := lexer_current(lexer);
NEW(result);
@ -244,26 +235,25 @@ begin
result^.type_expression := parse_type_expression(lexer);
token := transpiler_lex(lexer);
return result
end;
proc parse_type_part(lexer: PLexer) -> PPAstTypeDeclaration;
var
RETURN result
END parse_type_declaration;
PROCEDURE parse_type_part(lexer: PLexer): PPAstTypeDeclaration;
VAR
token: LexerToken;
result: PPAstTypeDeclaration;
current_declaration: PPAstTypeDeclaration;
declaration_count: CARDINAL;
begin
BEGIN
token := lexer_current(lexer);
ALLOCATE(result, TSIZE(PAstTypeDeclaration));
current_declaration := result;
declaration_count := 0;
if token.kind = lexerKindType then
IF token.kind = lexerKindType THEN
token := transpiler_lex(lexer);
while token.kind = lexerKindIdentifier do
WHILE token.kind = lexerKindIdentifier DO
INC(declaration_count);
REALLOCATE(result, TSIZE(PAstTypeDeclaration) * (declaration_count + 1));
@ -272,21 +262,20 @@ begin
current_declaration^ := parse_type_declaration(lexer);
token := transpiler_lex(lexer)
end
end;
if declaration_count <> 0 then
END
END;
IF declaration_count <> 0 THEN
INC(current_declaration, TSIZE(PAstTypeDeclaration))
end;
current_declaration^ := nil;
END;
current_declaration^ := NIL;
return result
end;
proc parse_variable_declaration(lexer: PLexer) -> PAstVariableDeclaration;
var
RETURN result
END parse_type_part;
PROCEDURE parse_variable_declaration(lexer: PLexer): PAstVariableDeclaration;
VAR
token: LexerToken;
result: PAstVariableDeclaration;
begin
BEGIN
NEW(result);
token := lexer_current(lexer);
@ -298,26 +287,25 @@ begin
result^.variable_type := parse_type_expression(lexer);
token := transpiler_lex(lexer);
return result
end;
proc parse_variable_part(lexer: PLexer) -> PPAstVariableDeclaration;
var
RETURN result
END parse_variable_declaration;
PROCEDURE parse_variable_part(lexer: PLexer): PPAstVariableDeclaration;
VAR
token: LexerToken;
result: PPAstVariableDeclaration;
current_declaration: PPAstVariableDeclaration;
declaration_count: CARDINAL;
begin
BEGIN
token := lexer_current(lexer);
ALLOCATE(result, TSIZE(PAstVariableDeclaration));
current_declaration := result;
declaration_count := 0;
if token.kind = lexerKindVar then
IF token.kind = lexerKindVar THEN
token := transpiler_lex(lexer);
while token.kind = lexerKindIdentifier do
WHILE token.kind = lexerKindIdentifier DO
INC(declaration_count);
REALLOCATE(result, TSIZE(PAstVariableDeclaration) * (declaration_count + 1));
@ -326,21 +314,20 @@ begin
current_declaration^ := parse_variable_declaration(lexer);
token := transpiler_lex(lexer)
end
end;
if declaration_count <> 0 then
END
END;
IF declaration_count <> 0 THEN
INC(current_declaration, TSIZE(PAstVariableDeclaration))
end;
current_declaration^ := nil;
END;
current_declaration^ := NIL;
return result
end;
proc parse_constant_declaration(lexer: PLexer) -> PAstConstantDeclaration;
var
RETURN result
END parse_variable_part;
PROCEDURE parse_constant_declaration(lexer: PLexer): PAstConstantDeclaration;
VAR
token: LexerToken;
result: PAstConstantDeclaration;
begin
BEGIN
NEW(result);
token := lexer_current(lexer);
@ -353,26 +340,25 @@ begin
token := transpiler_lex(lexer);
return result
end;
proc parse_constant_part(lexer: PLexer) -> PPAstConstantDeclaration;
var
RETURN result
END parse_constant_declaration;
PROCEDURE parse_constant_part(lexer: PLexer): PPAstConstantDeclaration;
VAR
token: LexerToken;
result: PPAstConstantDeclaration;
current_declaration: PPAstConstantDeclaration;
declaration_count: CARDINAL;
begin
BEGIN
token := lexer_current(lexer);
ALLOCATE(result, TSIZE(PAstConstantDeclaration));
current_declaration := result;
declaration_count := 0;
if token.kind = lexerKindConst then
IF token.kind = lexerKindConst THEN
token := transpiler_lex(lexer);
while token.kind = lexerKindIdentifier do
WHILE token.kind = lexerKindIdentifier DO
INC(declaration_count);
REALLOCATE(result, TSIZE(PAstConstantDeclaration) * (declaration_count + 1));
@ -381,23 +367,22 @@ begin
current_declaration^ := parse_constant_declaration(lexer);
token := transpiler_lex(lexer)
end
end;
if declaration_count <> 0 then
END
END;
IF declaration_count <> 0 THEN
INC(current_declaration, TSIZE(PAstConstantDeclaration))
end;
current_declaration^ := nil;
END;
current_declaration^ := NIL;
return result
end;
proc parse_import_statement(lexer: PLexer) -> PAstImportStatement;
var
RETURN result
END parse_constant_part;
PROCEDURE parse_import_statement(lexer: PLexer): PAstImportStatement;
VAR
result: PAstImportStatement;
token: LexerToken;
symbol_count: CARDINAL;
current_symbol: PIdentifier;
begin
BEGIN
NEW(result);
symbol_count := 1;
@ -413,7 +398,7 @@ begin
current_symbol^ := token.identifierKind;
token := transpiler_lex(lexer);
while token.kind <> lexerKindSemicolon do
WHILE token.kind <> lexerKindSemicolon DO
token := transpiler_lex(lexer);
INC(symbol_count);
@ -423,28 +408,27 @@ begin
current_symbol^ := token.identifierKind;
token := transpiler_lex(lexer)
end;
END;
INC(current_symbol, TSIZE(Identifier));
MemZero(current_symbol, TSIZE(Identifier));
token := transpiler_lex(lexer);
return result
end;
proc parse_import_part(lexer: PLexer) -> PPAstImportStatement;
var
RETURN result
END parse_import_statement;
PROCEDURE parse_import_part(lexer: PLexer): PPAstImportStatement;
VAR
token: LexerToken;
import_statement: PPAstImportStatement;
result: PPAstImportStatement;
import_count: CARDINAL;
begin
BEGIN
token := lexer_current(lexer);
ALLOCATE(result, TSIZE(PAstImportStatement));
import_statement := result;
import_count := 0;
while token.kind = lexerKindFrom do
WHILE token.kind = lexerKindFrom DO
INC(import_count);
REALLOCATE(result, TSIZE(PAstImportStatement) * (import_count + 1));
@ -453,117 +437,114 @@ begin
import_statement^ := parse_import_statement(lexer);
token := lexer_current(lexer)
end;
if import_count > 0 then
END;
IF import_count > 0 THEN
INC(import_statement, TSIZE(PAstImportStatement))
end;
import_statement^ := nil;
END;
import_statement^ := NIL;
return result
end;
proc parse_literal(lexer: PLexer) -> PAstLiteral;
var
RETURN result
END parse_import_part;
PROCEDURE parse_literal(lexer: PLexer): PAstLiteral;
VAR
literal: PAstLiteral;
token: LexerToken;
begin
literal := nil;
BEGIN
literal := NIL;
token := lexer_current(lexer);
if token.kind = lexerKindInteger then
IF token.kind = lexerKindInteger THEN
NEW(literal);
literal^.kind := astLiteralKindInteger;
literal^.integer := token.integerKind;
end;
if token.kind = lexerKindCharacter then
END;
IF token.kind = lexerKindCharacter THEN
NEW(literal);
literal^.kind := astLiteralKindString;
literal^.string := token.stringKind;
end;
if token.kind = lexerKindNull then
END;
IF token.kind = lexerKindNull THEN
NEW(literal);
literal^.kind := astLiteralKindNull;
end;
if literal <> nil then
END;
IF literal <> NIL THEN
token := transpiler_lex(lexer)
end;
END;
return literal
end;
proc parse_factor(lexer: PLexer) -> PAstExpression;
var
RETURN literal
END parse_literal;
PROCEDURE parse_factor(lexer: PLexer): PAstExpression;
VAR
next_token: LexerToken;
result: PAstExpression;
literal: PAstLiteral;
begin
result := nil;
BEGIN
result := NIL;
next_token := lexer_current(lexer);
literal := parse_literal(lexer);
if (result = nil) & (literal <> nil) then
IF (result = NIL) AND (literal <> NIL) THEN
NEW(result);
result^.kind := astExpressionKindLiteral;
result^.literal := literal;
end;
if (result = nil) & (next_token.kind = lexerKindMinus) then
END;
IF (result = NIL) AND (next_token.kind = lexerKindMinus) THEN
NEW(result);
next_token := transpiler_lex(lexer);
result^.kind := astExpressionKindUnary;
result^.unary_operator := astUnaryOperatorMinus;
result^.unary_operand := parse_factor(lexer)
end;
if (result = nil) & (next_token.kind = lexerKindTilde) then
END;
IF (result = NIL) AND (next_token.kind = lexerKindTilde) THEN
NEW(result);
next_token := transpiler_lex(lexer);
result^.kind := astExpressionKindUnary;
result^.unary_operator := astUnaryOperatorNot;
result^.unary_operand := parse_factor(lexer)
end;
if (result = nil) & (next_token.kind = lexerKindIdentifier) then
END;
IF (result = NIL) AND (next_token.kind = lexerKindIdentifier) THEN
NEW(result);
result^.kind := astExpressionKindIdentifier;
result^.identifier := next_token.identifierKind;
next_token := transpiler_lex(lexer)
end;
END;
return result
end;
proc parse_designator(lexer: PLexer) -> PAstExpression;
var
RETURN result
END parse_factor;
PROCEDURE parse_designator(lexer: PLexer): PAstExpression;
VAR
next_token: LexerToken;
inner_expression: PAstExpression;
designator: PAstExpression;
handled: BOOLEAN;
begin
BEGIN
designator := parse_factor(lexer);
handled := designator <> nil;
handled := designator <> NIL;
next_token := lexer_current(lexer);
while handled do
WHILE handled DO
inner_expression := designator;
handled := false;
handled := FALSE;
if ~handled & (next_token.kind = lexerKindHat) then
IF ~handled AND (next_token.kind = lexerKindHat) THEN
NEW(designator);
designator^.kind := astExpressionKindDereference;
designator^.reference := inner_expression;
next_token := transpiler_lex(lexer);
handled := true
end;
if ~handled & (next_token.kind = lexerKindLeftSquare) then
handled := TRUE
END;
IF ~handled AND (next_token.kind = lexerKindLeftSquare) THEN
NEW(designator);
next_token := transpiler_lex(lexer);
@ -572,9 +553,9 @@ begin
designator^.index := parse_designator(lexer);
next_token := transpiler_lex(lexer);
handled := true
end;
if ~handled & (next_token.kind = lexerKindDot) then
handled := TRUE
END;
IF ~handled AND (next_token.kind = lexerKindDot) THEN
NEW(designator);
next_token := transpiler_lex(lexer);
@ -583,11 +564,10 @@ begin
designator^.field := next_token.identifierKind;
next_token := transpiler_lex(lexer);
handled := true
end
end;
handled := TRUE
END
END;
return designator
end;
end.
RETURN designator
END parse_designator;
END Parser.

640
source/Transpiler.elna → source/Transpiler.mod
View File

File diff suppressed because it is too large Load Diff