administrator/blaise
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Мои изменения для версии 0.12.0

Browse source
This commit is contained in:
mzhoot 2026-07-04 21:31:55 +03:00
parent 65e7b87a7c
commit ec10da32b9
4 changed files with 664 additions and 62 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

153
build-blaise.sh Executable file
View file

@ -0,0 +1,153 @@
#!/bin/bash
#
# Blaise Compiler Build Script
# Automates bootstrap of Blaise v0.12.0 from source
#
set -e
# Цвета
RED='\033[0;31m'
GREEN='\033[0;32m'
YELLOW='\033[1;33m'
BLUE='\033[0;34m'
NC='\033[0m'
print_step() {
echo ""
echo -e "${BLUE}━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━${NC}"
echo -e "${GREEN}▶ $1${NC}"
echo -e "${BLUE}━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━${NC}"
}
print_success() { echo -e "${GREEN}✔ $1${NC}"; }
print_info() { echo -e "${YELLOW}ℹ $1${NC}"; }
print_error() { echo -e "${RED}✘ $1${NC}"; }
# Проверка директории
if [ ! -f "compiler/src/main/pascal/Blaise.pas" ]; then
print_error "Запустите скрипт из корня проекта Blaise"
exit 1
fi
print_step "ШАГ 1: Проверка релизного компилятора"
if [ ! -f "compiler/target/blaise" ]; then
print_error "Компилятор не найден в compiler/target/blaise"
echo ""
echo -e "${YELLOW}Скачайте релизный бинарник v0.12.0:${NC}"
echo " wget https://github.com/graemeg/blaise/releases/download/v0.12.0/blaise-linux-x86_64 -O compiler/target/blaise"
echo " chmod +x compiler/target/blaise"
exit 1
fi
chmod +x compiler/target/blaise
VERSION=$(./compiler/target/blaise --version 2>&1 | grep -oP 'v\d+\.\d+\.\d+' | head -1)
if [ "$VERSION" != "v0.12.0" ]; then
print_error "Неверная версия: $VERSION (ожидается v0.12.0)"
exit 1
fi
print_success "Версия: $VERSION"
print_step "ШАГ 2: Сборка рантайма"
cd runtime
make clean 2>/dev/null || true
make
make install
cd ..
print_success "Рантайм установлен"
print_step "ШАГ 3: Сборка компилятора"
./compiler/target/blaise \
--source compiler/src/main/pascal/Blaise.pas \
--unit-path compiler/src/main/pascal \
--unit-path runtime/src/main/pascal \
--unit-path stdlib/src/main/pascal \
--output compiler/target/blaise-new
if [ ! -f "compiler/target/blaise-new" ]; then
print_error "Компилятор не собрался"
exit 1
fi
print_success "Компилятор собран"
print_step "ШАГ 4: Проверка самовоспроизводимости"
if diff compiler/target/blaise compiler/target/blaise-new > /dev/null 2>&1; then
print_success "Бинарники идентичны! ✨ Идеальный fixpoint!"
else
print_info "Бинарники различаются (временные метки)"
fi
print_step "ШАГ 5: Замена компилятора"
print_info "Проверка нового компилятора..."
if ./compiler/target/blaise-new --help > /dev/null 2>&1; then
print_success "Новый компилятор работает"
else
print_error "Новый компилятор не запускается"
exit 1
fi
mv compiler/target/blaise-new compiler/target/blaise
print_success "Компилятор обновлён"
print_step "ШАГ 6: Создание и компиляция тестовой программы"
# И русский вариант для проверки синонимов
cat > test_program.pas << 'EOF'
ПРОГРАММА Привет;
НАЧАЛО
WriteLn('Привет от ВИРТ v0.12.0!');
WriteLn('Русские ключевые слова работают!');
КОНЕЦ.
EOF
print_info "Компиляция тестовой программы..."
./compiler/target/blaise --source test_program.pas --output test_program
if [ ! -f "test_program" ]; then
print_error "Тестовая программа не скомпилировалась"
exit 1
fi
print_success "Тестовая программа скомпилирована"
print_info "Запуск тестовой программы..."
echo ""
echo -e "${YELLOW}═══════════════════════════════════════════════════════════════${NC}"
./test_program
echo -e "${YELLOW}═══════════════════════════════════════════════════════════════${NC}"
echo ""
if [ $? -eq 0 ]; then
print_success "Тестовая программа успешно выполнена!"
else
print_error "Ошибка при выполнении теста"
exit 1
fi
print_step "✅ СБОРКА ЗАВЕРШЕНА УСПЕШНО!"
echo ""
echo -e "${GREEN}━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━${NC}"
echo -e "${GREEN} Компилятор Blaise v0.12.0 успешно собран!${NC}"
echo -e "${GREEN}━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━${NC}"
echo ""
echo "📁 Компилятор: compiler/target/blaise"
echo "📁 Рантайм: compiler/target/blaise_rtl.a"
echo "📁 Тест: test_program"
echo ""
echo "🚀 Использование:"
echo " ./compiler/target/blaise --source program.pas --output program"
echo ""
read -p "Удалить тестовые файлы? [y/N] " -n 1 -r
echo
if [[ $REPLY =~ ^[Yy]$ ]]; then
rm -f test_program.pas test_program
print_info "Тестовые файлы удалены"
fi
print_success "Готово! 🎉"

94
compiler/src/main/pascal/uLexer.pas
View file

@ -10,7 +10,11 @@ unit uLexer;
{ Compiler lexer — wraps uPasTokeniser and converts its flat token stream { Compiler lexer — wraps uPasTokeniser and converts its flat token stream
into the compiler's specific token kinds. Skips whitespace, line endings, into the compiler's specific token kinds. Skips whitespace, line endings,
comments, and compiler directives. Unescapes string literal values. } comments, and compiler directives. Unescapes string literal values.
UTF-8 aware: identifiers may contain Latin (A-Z, a-z) and Cyrillic
(А-Я, а-я, Ё, ё) letters plus underscore and digits. Russian keyword
synonyms are recognised through MapKeyword. }
interface interface
@ -218,6 +222,7 @@ end;
function TLexer.MapKeyword(const AUpper: string): TTokenKind; function TLexer.MapKeyword(const AUpper: string): TTokenKind;
begin begin
{ Английские ключевые слова }
if AUpper = 'PROGRAM' then Result := tkProgram if AUpper = 'PROGRAM' then Result := tkProgram
else if AUpper = 'USES' then Result := tkUses else if AUpper = 'USES' then Result := tkUses
else if AUpper = 'VAR' then Result := tkVar else if AUpper = 'VAR' then Result := tkVar
@ -276,6 +281,66 @@ begin
else if AUpper = 'INHERITED' then Result := tkInherited else if AUpper = 'INHERITED' then Result := tkInherited
else if AUpper = 'INITIALIZATION' then Result := tkInitialization else if AUpper = 'INITIALIZATION' then Result := tkInitialization
else if AUpper = 'FINALIZATION' then Result := tkFinalization else if AUpper = 'FINALIZATION' then Result := tkFinalization
{ Русские синонимы ключевых слов }
else if AUpper = 'ПРОГРАММА' then Result := tkProgram
else if AUpper = 'ИСПОЛЬЗУЕТ' then Result := tkUses
else if AUpper = 'ПЕРЕМ' then Result := tkVar
else if AUpper = 'ПОТОКПЕРЕМ' then Result := tkThreadVar
else if AUpper = 'НАЧАЛО' then Result := tkBegin
else if AUpper = 'КОНЕЦ' then Result := tkEnd
else if AUpper = 'ТИП' then Result := tkType
else if AUpper = 'ЗАПИСЬ' then Result := tkRecord
else if AUpper = 'УПАКОВАН' then Result := tkPacked
else if AUpper = 'КЛАСС' then Result := tkClass
else if AUpper = 'ПРОЦЕДУРА' then Result := tkProcedure
else if AUpper = 'ФУНКЦИЯ' then Result := tkFunction
else if AUpper = 'ЦЕЛДЕЛ' then Result := tkDiv
else if AUpper = 'ОСТАТОК' then Result := tkMod
else if AUpper = 'ЕСЛИ' then Result := tkIf
else if AUpper = 'ТОГДА' then Result := tkThen
else if AUpper = 'ИНАЧЕ' then Result := tkElse
else if AUpper = 'ПОКА' then Result := tkWhile
else if AUpper = 'ВЫПОЛНИТЬ' then Result := tkDo
else if AUpper = 'ДЛЯ' then Result := tkFor
else if AUpper = 'К' then Result := tkTo
else if AUpper = 'ДО' then Result := tkDownto
else if AUpper = 'ПОВТОРЯТЬ' then Result := tkRepeat
else if AUpper = 'ДО_ТЕХ_ПОР' then Result := tkUntil
else if AUpper = 'ПОПЫТАТЬСЯ' then Result := tkTry
else if AUpper = 'НАКОНЕЦ' then Result := tkFinally
else if AUpper = 'ИСКЛЮЧЕНИЕ' then Result := tkExcept
else if AUpper = 'ВОЗБУДИТЬ' then Result := tkRaise
else if AUpper = 'НИЧТО' then Result := tkNil
else if AUpper = 'МОДУЛЬ' then Result := tkUnit
else if AUpper = 'ИНТЕРФЕЙС' then Result := tkIntf
else if AUpper = 'РЕАЛИЗАЦИЯ' then Result := tkImplementation
else if AUpper = 'ВИРТУАЛЬНЫЙ' then Result := tkVirtual
else if AUpper = 'ПЕРЕОПРЕДЕЛИТЬ' then Result := tkOverride
else if AUpper = 'ЭТО' then Result := tkIs
else if AUpper = 'КАК' then Result := tkAs
else if AUpper = 'И' then Result := tkAnd
else if AUpper = 'ИЛИ' then Result := tkOr
else if AUpper = 'НЕ' then Result := tkNot
else if AUpper = 'ВЫХОД' then Result := tkExit
else if AUpper = 'ПРЕРВАТЬ' then Result := tkBreak
else if AUpper = 'ПРОДОЛЖИТЬ' then Result := tkContinue
else if AUpper = 'ВЫБОР' then Result := tkCase
else if AUpper = 'ИЗ' then Result := tkOf
else if AUpper = 'МАССИВ' then Result := tkArray
else if AUpper = 'МНОЖЕСТВО' then Result := tkSet
else if AUpper = 'В' then Result := tkIn
else if AUpper = 'СДВИГВЛЕВО' then Result := tkShl
else if AUpper = 'СДВИГВПРАВО' then Result := tkShr
else if AUpper = 'АРИФСДВИГ' then Result := tkSar
else if AUpper = 'ИСКЛ_ИЛИ' then Result := tkXor
else if AUpper = 'КОНСТ' then Result := tkConst
else if AUpper = 'ВЫВОД' then Result := tkOut
else if AUpper = 'СОЗДАТЕЛЬ' then Result := tkConstructor
else if AUpper = 'УНИЧТОЖИТЕЛЬ' then Result := tkDestructor
else if AUpper = 'НАСЛЕДОВАН' then Result := tkInherited
else if AUpper = 'ИНИЦИАЛИЗАЦИЯ' then Result := tkInitialization
else if AUpper = 'ФИНАЛИЗАЦИЯ' then Result := tkFinalization
else else
Result := tkIdent; { keyword outside Phase 1 grammar treated as ident } Result := tkIdent; { keyword outside Phase 1 grammar treated as ident }
end; end;
@ -284,7 +349,10 @@ function TLexer.UnescapeString(const ARaw: string): string;
{ ARaw is the full source span. Handles: 'text' with '' → ' escaping, { ARaw is the full source span. Handles: 'text' with '' → ' escaping,
#nn numeric char literals (decimal), and concatenated runs like #nn numeric char literals (decimal), and concatenated runs like
'abc'#13#10'def'. Uses OrdAt (0-based) so the body parses under both 'abc'#13#10'def'. Uses OrdAt (0-based) so the body parses under both
FPC and the self-hosted Blaise compiler. } FPC and the self-hosted Blaise compiler.
UTF-8 note: Cyrillic characters inside quoted strings are preserved
as-is since string content is opaque to the tokeniser. }
var var
I, Len, N, C: Integer; I, Len, N, C: Integer;
begin begin
@ -339,6 +407,13 @@ begin
end; end;
function TLexer.ProcessTextBlock(const ARaw: string): string; function TLexer.ProcessTextBlock(const ARaw: string): string;
{ Process a triple-quoted text block (''' ... '''). Strips the opening and
closing delimiters, normalises CRLF→LF, and removes leading whitespace
margin (determined by the indentation of the closing delimiter).
UTF-8 note: multi-byte characters inside text blocks are preserved
correctly since the margin calculation operates on bytes (spaces are
ASCII 0x20, never part of a multi-byte sequence). }
var var
Len, I, C, Margin, LineStart, LineLen, Skip: Integer; Len, I, C, Margin, LineStart, LineLen, Skip: Integer;
Body: string; Body: string;
@ -601,6 +676,19 @@ begin
else if text = 'OF' then Result.Kind := tkOf else if text = 'OF' then Result.Kind := tkOf
else if text = 'CONST' then Result.Kind := tkConst else if text = 'CONST' then Result.Kind := tkConst
else if text = 'OUT' then Result.Kind := tkOut else if text = 'OUT' then Result.Kind := tkOut
{ Русские синонимы для идентификаторов-ключевых слов }
else if text = 'ВИРТУАЛЬНЫЙ' then Result.Kind := tkVirtual
else if text = 'ПЕРЕОПРЕДЕЛИТЬ' then Result.Kind := tkOverride
else if text = 'ВНЕШНИЙ' then Result.Kind := tkExternal
else if text = 'ВЫХОД' then Result.Kind := tkExit
else if text = 'ПРЕРВАТЬ' then Result.Kind := tkBreak
else if text = 'ПРОДОЛЖИТЬ' then Result.Kind := tkContinue
else if text = 'ИНИЦИАЛИЗАЦИЯ' then Result.Kind := tkInitialization
else if text = 'ФИНАЛИЗАЦИЯ' then Result.Kind := tkFinalization
else if text = 'ВЫБОР' then Result.Kind := tkCase
else if text = 'ИЗ' then Result.Kind := tkOf
else if text = 'КОНСТ' then Result.Kind := tkConst
else if text = 'ВЫВОД' then Result.Kind := tkOut
else Result.Kind := tkIdent; else Result.Kind := tkIdent;
Result.Value := FTok.TokenText(); Result.Value := FTok.TokenText();
end; end;
@ -767,4 +855,4 @@ begin
end; end;
end; end;
end. end.

301
compiler/src/main/pascal/uPasTokeniser.pas
View file

@ -19,6 +19,10 @@
Ported from the fpGUI IDE tokeniser (same author). Ported from the fpGUI IDE tokeniser (same author).
UTF-8 support: identifiers may contain Latin (A-Z, a-z) and Cyrillic
(А-Я, а-я, Ё, ё) letters plus underscore and digits. Peek/Advance
operate on whole Unicode codepoints, not raw bytes.
Implementation uses OrdAt and integer-based char comparisons throughout Implementation uses OrdAt and integer-based char comparisons throughout
so the unit compiles under both FPC and the self-hosted Blaise compiler. so the unit compiles under both FPC and the self-hosted Blaise compiler.
} }
@ -26,7 +30,7 @@ unit uPasTokeniser;
interface interface
uses Classes, SysUtils; uses Classes, SysUtils, uStrCompat;
type type
TFpgPasTokenKind = ( TFpgPasTokenKind = (
@ -47,20 +51,35 @@ type
Kind: TFpgPasTokenKind; Kind: TFpgPasTokenKind;
Line: Integer; { 1-based line number } Line: Integer; { 1-based line number }
Column: Integer; { 1-based column } Column: Integer; { 1-based column }
Len: Integer; { character length in source } Len: Integer; { character length in source (bytes) }
TextStart: Integer; { 1-based index into source string } TextStart: Integer; { 1-based index into source string }
end; end;
TFpgPascalTokeniser = class(TObject) TFpgPascalTokeniser = class(TObject)
private
FSource: string; FSource: string;
FPos: Integer; FPos: Integer; { 1-based byte position in FSource }
FLine: Integer; FLine: Integer;
FLineStart: Integer; FLineStart: Integer;
FToken: TFpgPasToken; FToken: TFpgPasToken;
{ Return the Unicode codepoint at FPos (decodes UTF-8 if multi-byte).
Returns 0 at end-of-source. }
function Peek: Integer; function Peek: Integer;
{ Return the Unicode codepoint at FPos + AOffset bytes. AOffset is a
raw byte offset from FPos — used only for small lookaheads (1–3 bytes)
where the caller knows the first byte is ASCII or the previous char
was single-byte. Returns 0 if out of bounds. }
function PeekAt(AOffset: Integer): Integer; function PeekAt(AOffset: Integer): Integer;
{ Advance FPos past the current character (1 byte for ASCII, 2+ for
multi-byte UTF-8). }
procedure Advance; procedure Advance;
{ Advance one source line (called after consuming a line ending). }
procedure AdvanceLine; procedure AdvanceLine;
procedure ReadWhitespace; procedure ReadWhitespace;
procedure ReadLineEnding; procedure ReadLineEnding;
procedure ReadIdentifierOrKeyword; procedure ReadIdentifierOrKeyword;
@ -71,6 +90,7 @@ type
procedure ReadParenStarCommentOrDirective; procedure ReadParenStarCommentOrDirective;
procedure ReadLineComment; procedure ReadLineComment;
procedure ReadSymbol; procedure ReadSymbol;
public
constructor Create; constructor Create;
procedure SetSource(const ASource: string); procedure SetSource(const ASource: string);
function NextToken: TFpgPasToken; function NextToken: TFpgPasToken;
@ -108,6 +128,8 @@ begin
KwList := TStringList.Create(); KwList := TStringList.Create();
KwList.Sorted := True; KwList.Sorted := True;
KwList.CaseSensitive := True; KwList.CaseSensitive := True;
{ Оригинальные английские ключевые слова }
KwList.Add('ABSOLUTE'); KwList.Add('AND'); KwList.Add('ARRAY'); KwList.Add('ABSOLUTE'); KwList.Add('AND'); KwList.Add('ARRAY');
KwList.Add('AS'); KwList.Add('ASM'); KwList.Add('BEGIN'); KwList.Add('AS'); KwList.Add('ASM'); KwList.Add('BEGIN');
KwList.Add('BITPACKED'); KwList.Add('CASE'); KwList.Add('CLASS'); KwList.Add('BITPACKED'); KwList.Add('CASE'); KwList.Add('CLASS');
@ -135,7 +157,89 @@ begin
KwList.Add('TRUE'); KwList.Add('TRY'); KwList.Add('TYPE'); KwList.Add('TRUE'); KwList.Add('TRY'); KwList.Add('TYPE');
KwList.Add('UNIT'); KwList.Add('UNTIL'); KwList.Add('USES'); KwList.Add('UNIT'); KwList.Add('UNTIL'); KwList.Add('USES');
KwList.Add('VAR'); KwList.Add('WHILE'); KwList.Add('WITH'); KwList.Add('VAR'); KwList.Add('WHILE'); KwList.Add('WITH');
KwList.Add('XOR') KwList.Add('XOR');
{ Русские синонимы ключевых слов }
KwList.Add('АБСОЛЮТНЫЙ'); // ABSOLUTE
KwList.Add('И'); // AND
KwList.Add('МАССИВ'); // ARRAY
KwList.Add('КАК'); // AS
KwList.Add('АССЕМБЛЕР'); // ASM
KwList.Add('НАЧАЛО'); // BEGIN
KwList.Add('БИТОВЫЙ'); // BITPACKED
KwList.Add('ВЫБОР'); // CASE
KwList.Add('КЛАСС'); // CLASS
KwList.Add('КОНСТ'); // CONST
KwList.Add('КОНСТСЫЛКА'); // CONSTREF
KwList.Add('СОЗДАТЕЛЬ'); // CONSTRUCTOR
KwList.Add('СОДЕРЖИТ'); // CONTAINS
KwList.Add('УНИЧТОЖИТЕЛЬ'); // DESTRUCTOR
KwList.Add('ДИСПИНТЕРФЕЙС'); // DISPINTERFACE
KwList.Add('ЦЕЛДЕЛ'); // DIV
KwList.Add('ВЫПОЛНИТЬ'); // DO
KwList.Add('ДО'); // DOWNTO
KwList.Add('ИНАЧЕ'); // ELSE
KwList.Add('КОНЕЦ'); // END
KwList.Add('ИСКЛЮЧЕНИЕ'); // EXCEPT
KwList.Add('ЭКСПОРТЫ'); // EXPORTS
KwList.Add('ЛОЖЬ'); // FALSE
KwList.Add('ФАЙЛ'); // FILE
KwList.Add('ФИНАЛИЗАЦИЯ'); // FINALIZATION
KwList.Add('НАКОНЕЦ'); // FINALLY
KwList.Add('ДЛЯ'); // FOR
KwList.Add('ФУНКЦИЯ'); // FUNCTION
KwList.Add('ОБОБЩЁННЫЙ'); // GENERIC
KwList.Add('ПЕРЕЙТИ'); // GOTO
KwList.Add('ЕСЛИ'); // IF
KwList.Add('РЕАЛИЗАЦИЯ'); // IMPLEMENTATION
KwList.Add('В'); // IN
KwList.Add('НАСЛЕДОВАН'); // INHERITED
KwList.Add('ИНИЦИАЛИЗАЦИЯ'); // INITIALIZATION
KwList.Add('ВСТРОЕННЫЙ'); // INLINE
KwList.Add('ИНТЕРФЕЙС'); // INTERFACE
KwList.Add('ЭТО'); // IS
KwList.Add('МЕТКА'); // LABEL
KwList.Add('БИБЛИОТЕКА'); // LIBRARY
KwList.Add('ОСТАТОК'); // MOD
KwList.Add('НИЧТО'); // NIL
KwList.Add('НЕ'); // NOT
KwList.Add('ОБЬЕКТКАТЕГОРИЯ'); // OBJCCATEGORY
KwList.Add('ОБЬЕКТКЛАСС'); // OBJCCLASS
KwList.Add('ОБЬЕКТПРОТОКОЛ'); // OBJCPROTOCOL
KwList.Add('ОБЬЕКТ'); // OBJECT
KwList.Add('ИЗ'); // OF
KwList.Add('ОПЕРАТОР'); // OPERATOR
KwList.Add('ИЛИ'); // OR
KwList.Add('ИНАЧЕ'); // OTHERWISE (note: same as ELSE in Russian)
KwList.Add('ПАКЕТ'); // PACKAGE
KwList.Add('УПАКОВАН'); // PACKED
KwList.Add('ПРОЦЕДУРА'); // PROCEDURE
KwList.Add('ПРОГРАММА'); // PROGRAM
KwList.Add('СВОЙСТВО'); // PROPERTY
KwList.Add('ВОЗБУДИТЬ'); // RAISE
KwList.Add('ЗАПИСЬ'); // RECORD
KwList.Add('ПОВТОРЯТЬ'); // REPEAT
KwList.Add('ТРЕБУЕТ'); // REQUIRES
KwList.Add('РЕСУРССТРОКА'); // RESOURCESTRING
KwList.Add('АРИФСДВИГ'); // SAR
KwList.Add('СЕБЯ'); // SELF
KwList.Add('МНОЖЕСТВО'); // SET
KwList.Add('СДВИГВЛЕВО'); // SHL
KwList.Add('СДВИГВПРАВО'); // SHR
KwList.Add('СПЕЦИАЛИЗИРОВАТЬ'); // SPECIALIZE
KwList.Add('ТОГДА'); // THEN
KwList.Add('ПОТОКПЕРЕМ'); // THREADVAR
KwList.Add('К'); // TO
KwList.Add('ИСТИНА'); // TRUE
KwList.Add('ПОПЫТАТЬСЯ'); // TRY
KwList.Add('ТИП'); // TYPE
KwList.Add('МОДУЛЬ'); // UNIT
KwList.Add('ДО_ТЕХ_ПОР'); // UNTIL
KwList.Add('ИСПОЛЬЗУЕТ'); // USES
KwList.Add('ПЕРЕМ'); // VAR
KwList.Add('ПОКА'); // WHILE
KwList.Add('С'); // WITH
KwList.Add('ИСКЛ_ИЛИ'); // XOR
end; end;
function BinarySearchKeyword(const AText: string): Boolean; function BinarySearchKeyword(const AText: string): Boolean;
@ -180,42 +284,99 @@ begin
FToken.TextStart := 1 FToken.TextStart := 1
end; end;
{ ------------------------------------------------------------------------ }
{ Peek / PeekAt / Advance — UTF-8 aware }
{ ------------------------------------------------------------------------ }
function TFpgPascalTokeniser.Peek: Integer; function TFpgPascalTokeniser.Peek: Integer;
var
Len: Integer;
begin begin
if FPos <= Length(FSource) then if FPos > Length(FSource) then
Result := PosOrd(FSource, FPos) begin
else Result := 0;
Result := 0 Exit;
end;
{ Use UTF8CodePoint which decodes the full Unicode codepoint from the
UTF-8 sequence starting at FPos. uStrCompat expects 0-based indexing,
so pass FPos - 1. }
Result := UTF8CodePoint(FSource, FPos - 1);
if Result = -1 then
{ Invalid or truncated UTF-8: fall back to the raw byte value so the
tokeniser can still make progress (produce a symbol token etc.). }
Result := PosOrd(FSource, FPos);
end; end;
function TFpgPascalTokeniser.PeekAt(AOffset: Integer): Integer; function TFpgPascalTokeniser.PeekAt(AOffset: Integer): Integer;
var var
P: Integer; P: Integer;
Len: Integer;
begin begin
P := FPos + AOffset; P := FPos + AOffset;
if (P >= 1) and (P <= Length(FSource)) then if (P < 1) or (P > Length(FSource)) then
Result := PosOrd(FSource, P) begin
else Result := 0;
Result := 0 Exit;
end;
{ PeekAt is used exclusively for small lookaheads (1–3 bytes) in contexts
where the immediately preceding character was already consumed and we
know it was single-byte ASCII (e.g. after '(', '$', '%', '&', '/').
We can safely read the raw byte at the offset.
The one exception is looking ahead from a Cyrillic character — but
PeekAt is never called from inside a multi-byte character's span because
Advance always moves past all bytes of a character. }
Result := PosOrd(FSource, P);
end; end;
procedure TFpgPascalTokeniser.Advance; procedure TFpgPascalTokeniser.Advance;
var
B: Integer;
Skip: Integer;
begin begin
FPos := FPos + 1 if FPos > Length(FSource) then
Exit;
B := PosOrd(FSource, FPos);
if B <= 127 then
FPos := FPos + 1
else
begin
{ Use UTF8CharLen to determine how many bytes this character occupies.
For valid UTF-8 this returns 2, 3, or 4; for invalid bytes it returns 0
— in that case advance by 1 to avoid getting stuck. }
Skip := UTF8CharLen(FSource, FPos - 1);
if Skip <= 0 then
Skip := 1;
FPos := FPos + Skip;
end;
end; end;
{ ------------------------------------------------------------------------ }
{ Line handling }
{ ------------------------------------------------------------------------ }
procedure TFpgPascalTokeniser.AdvanceLine; procedure TFpgPascalTokeniser.AdvanceLine;
begin begin
FLine := FLine + 1; FLine := FLine + 1;
FLineStart := FPos FLineStart := FPos
end; end;
{ ------------------------------------------------------------------------ }
{ Token readers }
{ ------------------------------------------------------------------------ }
procedure TFpgPascalTokeniser.ReadWhitespace; procedure TFpgPascalTokeniser.ReadWhitespace;
var
C: Integer;
begin begin
FToken.Kind := fptkWhitespace; FToken.Kind := fptkWhitespace;
while (FPos <= Length(FSource)) and while FPos <= Length(FSource) do
((PosOrd(FSource, FPos) = 32) or (PosOrd(FSource, FPos) = 9)) do begin
C := Peek();
if (C <> 32) and (C <> 9) then
Break;
Advance(); Advance();
end;
FToken.Len := FPos - FToken.TextStart FToken.Len := FPos - FToken.TextStart
end; end;
@ -235,11 +396,10 @@ var
begin begin
while FPos <= Length(FSource) do while FPos <= Length(FSource) do
begin begin
C := PosOrd(FSource, FPos); C := Peek();
if not (((C >= 65) and (C <= 90)) or ((C >= 97) and (C <= 122)) or if not (IsUTF8Letter(C) or IsUTF8Digit(C)) then
((C >= 48) and (C <= 57)) or (C = 95)) then
Break; Break;
Advance() Advance();
end; end;
FToken.Len := FPos - FToken.TextStart; FToken.Len := FPos - FToken.TextStart;
if BinarySearchKeyword(UpperCase(TokenText())) then if BinarySearchKeyword(UpperCase(TokenText())) then
@ -258,12 +418,16 @@ begin
if C = 36 then { $ hex } if C = 36 then { $ hex }
begin begin
Advance(); Advance();
while (FPos <= Length(FSource)) and while FPos <= Length(FSource) do
(((PosOrd(FSource, FPos) >= 48) and (PosOrd(FSource, FPos) <= 57)) or begin
((PosOrd(FSource, FPos) >= 65) and (PosOrd(FSource, FPos) <= 70)) or C := PosOrd(FSource, FPos);
((PosOrd(FSource, FPos) >= 97) and (PosOrd(FSource, FPos) <= 102)) or if not (((C >= 48) and (C <= 57)) or
(PosOrd(FSource, FPos) = 95)) do ((C >= 65) and (C <= 70)) or
((C >= 97) and (C <= 102)) or
(C = 95)) then
Break;
Advance(); Advance();
end;
FToken.Len := FPos - FToken.TextStart; FToken.Len := FPos - FToken.TextStart;
Exit Exit
end; end;
@ -271,10 +435,13 @@ begin
if C = 37 then { % binary } if C = 37 then { % binary }
begin begin
Advance(); Advance();
while (FPos <= Length(FSource)) and while FPos <= Length(FSource) do
((PosOrd(FSource, FPos) = 48) or (PosOrd(FSource, FPos) = 49) or begin
(PosOrd(FSource, FPos) = 95)) do C := PosOrd(FSource, FPos);
if not ((C = 48) or (C = 49) or (C = 95)) then
Break;
Advance(); Advance();
end;
FToken.Len := FPos - FToken.TextStart; FToken.Len := FPos - FToken.TextStart;
Exit Exit
end; end;
@ -282,28 +449,37 @@ begin
if C = 38 then { & octal } if C = 38 then { & octal }
begin begin
Advance(); Advance();
while (FPos <= Length(FSource)) and while FPos <= Length(FSource) do
(((PosOrd(FSource, FPos) >= 48) and (PosOrd(FSource, FPos) <= 55)) or begin
(PosOrd(FSource, FPos) = 95)) do C := PosOrd(FSource, FPos);
if not (((C >= 48) and (C <= 55)) or (C = 95)) then
Break;
Advance(); Advance();
end;
FToken.Len := FPos - FToken.TextStart; FToken.Len := FPos - FToken.TextStart;
Exit Exit
end; end;
{ decimal integer — also allows _ between digits } { decimal integer — also allows _ between digits }
while (FPos <= Length(FSource)) and while FPos <= Length(FSource) do
(((PosOrd(FSource, FPos) >= 48) and (PosOrd(FSource, FPos) <= 57)) or begin
(PosOrd(FSource, FPos) = 95)) do C := PosOrd(FSource, FPos);
if not (((C >= 48) and (C <= 57)) or (C = 95)) then
Break;
Advance(); Advance();
end;
if (FPos <= Length(FSource)) and (PosOrd(FSource, FPos) = 46) and if (FPos <= Length(FSource)) and (PosOrd(FSource, FPos) = 46) and
(PeekAt(1) <> 46) then (PeekAt(1) <> 46) then
begin begin
Advance(); Advance();
while (FPos <= Length(FSource)) and while FPos <= Length(FSource) do
(((PosOrd(FSource, FPos) >= 48) and (PosOrd(FSource, FPos) <= 57)) or begin
(PosOrd(FSource, FPos) = 95)) do C := PosOrd(FSource, FPos);
Advance() if not (((C >= 48) and (C <= 57)) or (C = 95)) then
Break;
Advance();
end;
end; end;
if (FPos <= Length(FSource)) and if (FPos <= Length(FSource)) and
@ -313,10 +489,13 @@ begin
if (FPos <= Length(FSource)) and if (FPos <= Length(FSource)) and
((PosOrd(FSource, FPos) = 43) or (PosOrd(FSource, FPos) = 45)) then ((PosOrd(FSource, FPos) = 43) or (PosOrd(FSource, FPos) = 45)) then
Advance(); Advance();
while (FPos <= Length(FSource)) and while FPos <= Length(FSource) do
(((PosOrd(FSource, FPos) >= 48) and (PosOrd(FSource, FPos) <= 57)) or begin
(PosOrd(FSource, FPos) = 95)) do C := PosOrd(FSource, FPos);
Advance() if not (((C >= 48) and (C <= 57)) or (C = 95)) then
Break;
Advance();
end;
end; end;
FToken.Len := FPos - FToken.TextStart FToken.Len := FPos - FToken.TextStart
@ -329,7 +508,7 @@ begin
FToken.Kind := fptkString; FToken.Kind := fptkString;
while True do while True do
begin begin
C := Peek(); C := PosOrd(FSource, FPos);
if C = 39 then if C = 39 then
begin begin
Advance(); Advance();
@ -355,17 +534,25 @@ begin
if (FPos <= Length(FSource)) and (PosOrd(FSource, FPos) = 36) then if (FPos <= Length(FSource)) and (PosOrd(FSource, FPos) = 36) then
begin begin
Advance(); Advance();
while (FPos <= Length(FSource)) and while FPos <= Length(FSource) do
(((PosOrd(FSource, FPos) >= 48) and (PosOrd(FSource, FPos) <= 57)) or begin
((PosOrd(FSource, FPos) >= 65) and (PosOrd(FSource, FPos) <= 70)) or C := PosOrd(FSource, FPos);
((PosOrd(FSource, FPos) >= 97) and (PosOrd(FSource, FPos) <= 102))) do if not (((C >= 48) and (C <= 57)) or
Advance() ((C >= 65) and (C <= 70)) or
((C >= 97) and (C <= 102))) then
Break;
Advance();
end
end end
else else
begin begin
while (FPos <= Length(FSource)) and while FPos <= Length(FSource) do
((PosOrd(FSource, FPos) >= 48) and (PosOrd(FSource, FPos) <= 57)) do begin
Advance() C := PosOrd(FSource, FPos);
if not ((C >= 48) and (C <= 57)) then
Break;
Advance();
end
end end
end end
else if C = 94 then else if C = 94 then
@ -523,6 +710,10 @@ begin
FToken.Len := FPos - FToken.TextStart FToken.Len := FPos - FToken.TextStart
end; end;
{ ------------------------------------------------------------------------ }
{ NextToken — main dispatch }
{ ------------------------------------------------------------------------ }
function TFpgPascalTokeniser.NextToken: TFpgPasToken; function TFpgPascalTokeniser.NextToken: TFpgPasToken;
var var
C, C2: Integer; C, C2: Integer;
@ -542,7 +733,7 @@ begin
FToken.Line := FLine; FToken.Line := FLine;
FToken.Column := FPos - FLineStart + 1; FToken.Column := FPos - FLineStart + 1;
C := PosOrd(FSource, FPos); C := Peek();
if (C = 32) or (C = 9) then if (C = 32) or (C = 9) then
begin begin
@ -558,7 +749,10 @@ begin
Exit Exit
end; end;
if ((C >= 65) and (C <= 90)) or ((C >= 97) and (C <= 122)) or (C = 95) then { Identifier start: UTF-8 letter (Latin, Cyrillic) or underscore.
Note: Peek() already returns full Unicode codepoint, so Cyrillic
letters like 'П' ($041F) are correctly recognised. }
if IsUTF8Letter(C) then
begin begin
ReadIdentifierOrKeyword(); ReadIdentifierOrKeyword();
Result := FToken; Result := FToken;
@ -572,6 +766,7 @@ begin
Exit Exit
end; end;
C := PosOrd(FSource, FPos);
C2 := PeekAt(1); C2 := PeekAt(1);
if (C = 36) and (((C2 >= 48) and (C2 <= 57)) or if (C = 36) and (((C2 >= 48) and (C2 <= 57)) or
@ -651,4 +846,4 @@ begin
Result := UpperCase(TokenText()) Result := UpperCase(TokenText())
end; end;
end. end.

178
compiler/src/main/pascal/uStrCompat.pas
View file

@ -12,11 +12,11 @@
Blaise strings are 0-based: S[0] is the first character, Pos returns Blaise strings are 0-based: S[0] is the first character, Pos returns
a 0-based index (-1 = not found), Copy takes a 0-based From argument. a 0-based index (-1 = not found), Copy takes a 0-based From argument.
Usage: UTF-8 aware functions added for lexer/parser support:
- Replace s[1] with StrAt(s, 0) - UTF8CharLen: returns byte length of UTF-8 sequence starting at given byte
- Replace Pos(sub, s) > 0 with Pos(sub, s) >= 0 - UTF8CodePoint: decodes Unicode codepoint from UTF-8 bytes at position
- Replace Copy(s, n, len) with Copy(s, n, len) (already 0-based in Blaise) - IsUTF8Letter: checks if codepoint is a letter (Latin, Cyrillic) or underscore
- Use StrAt(s, i) instead of s[i+1] style char access - IsUTF8Digit: checks if codepoint is an ASCII digit 0-9
} }
unit uStrCompat; unit uStrCompat;
@ -53,6 +53,24 @@ function ParseIntLiteral(const S: string): Int64;
procedure ParseIntOrUInt64Literal(const S: string; procedure ParseIntOrUInt64Literal(const S: string;
var AValue: Int64; var AIsUInt64: Boolean); var AValue: Int64; var AIsUInt64: Boolean);
{ UTF-8 helper routines }
{ Return number of bytes in the UTF-8 sequence that starts at byte I.
Returns 1 for ASCII, 2 for Cyrillic (U+0080..U+07FF), 0 for invalid. }
function UTF8CharLen(const S: string; I: Integer): Integer;
{ Decode a Unicode codepoint from the UTF-8 sequence starting at byte I.
Returns the codepoint (e.g. $041F for 'П'), or -1 if the sequence is
invalid or truncated. }
function UTF8CodePoint(const S: string; I: Integer): Integer;
{ Returns True if the codepoint is a letter (Latin A-Z, a-z, Cyrillic
А-Я, а-я, Ё, ё) or underscore (_). }
function IsUTF8Letter(CP: Integer): Boolean;
{ Returns True if the codepoint is an ASCII digit 0-9. }
function IsUTF8Digit(CP: Integer): Boolean;
implementation implementation
function StrAt(const S: string; I: Integer): Integer; function StrAt(const S: string; I: Integer): Integer;
@ -204,4 +222,152 @@ begin
Result := V; Result := V;
end; end;
end. { ------------------------------------------------------------------------ }
{ UTF-8 helper routines }
{ ------------------------------------------------------------------------ }
function UTF8CharLen(const S: string; I: Integer): Integer;
var
B: Integer;
begin
if (I < 0) or (I >= Length(S)) then
begin
Result := 0;
Exit;
end;
B := OrdAt(S, I);
if B <= 127 then
Result := 1
else if (B >= $C2) and (B <= $DF) then
begin
{ 2-byte sequence: need 1 continuation byte }
if I + 1 < Length(S) then
Result := 2
else
Result := 0; { truncated }
end
else if (B >= $E0) and (B <= $EF) then
begin
{ 3-byte sequence: need 2 continuation bytes }
if I + 2 < Length(S) then
Result := 3
else
Result := 0;
end
else if (B >= $F0) and (B <= $F4) then
begin
{ 4-byte sequence: need 3 continuation bytes }
if I + 3 < Length(S) then
Result := 4
else
Result := 0;
end
else
Result := 0; { invalid leading byte or continuation byte alone }
end;
function UTF8CodePoint(const S: string; I: Integer): Integer;
var
B0, B1, B2, B3: Integer;
Len: Integer;
begin
Len := Length(S);
if (I < 0) or (I >= Len) then
begin
Result := -1;
Exit;
end;
B0 := OrdAt(S, I);
if B0 <= 127 then
begin
Result := B0;
Exit;
end
else if (B0 >= $C2) and (B0 <= $DF) then
begin
if I + 1 >= Len then
begin
Result := -1;
Exit;
end;
B1 := OrdAt(S, I + 1);
if (B1 and $C0) <> $80 then
begin
Result := -1;
Exit;
end;
Result := ((B0 and $1F) shl 6) or (B1 and $3F);
end
else if (B0 >= $E0) and (B0 <= $EF) then
begin
if I + 2 >= Len then
begin
Result := -1;
Exit;
end;
B1 := OrdAt(S, I + 1);
B2 := OrdAt(S, I + 2);
if ((B1 and $C0) <> $80) or ((B2 and $C0) <> $80) then
begin
Result := -1;
Exit;
end;
Result := ((B0 and $0F) shl 12) or ((B1 and $3F) shl 6) or (B2 and $3F);
end
else if (B0 >= $F0) and (B0 <= $F4) then
begin
if I + 3 >= Len then
begin
Result := -1;
Exit;
end;
B1 := OrdAt(S, I + 1);
B2 := OrdAt(S, I + 2);
B3 := OrdAt(S, I + 3);
if ((B1 and $C0) <> $80) or ((B2 and $C0) <> $80) or ((B3 and $C0) <> $80) then
begin
Result := -1;
Exit;
end;
Result := ((B0 and $07) shl 18) or ((B1 and $3F) shl 12) or
((B2 and $3F) shl 6) or (B3 and $3F);
end
else
Result := -1; { invalid byte }
end;
function IsUTF8Letter(CP: Integer): Boolean;
begin
{ ASCII letters }
if ((CP >= 65) and (CP <= 90)) or ((CP >= 97) and (CP <= 122)) then
begin
Result := True;
Exit;
end;
{ Underscore }
if CP = 95 then
begin
Result := True;
Exit;
end;
{ Cyrillic basic: U+0410..U+044F (А-Я, а-я) }
if (CP >= $0410) and (CP <= $044F) then
begin
Result := True;
Exit;
end;
{ Ё (U+0401) and ё (U+0451) }
if (CP = $0401) or (CP = $0451) then
begin
Result := True;
Exit;
end;
Result := False;
end;
function IsUTF8Digit(CP: Integer): Boolean;
begin
Result := (CP >= 48) and (CP <= 57);
end;
end.