From ec10da32b91dcfec35342b2f051c16376b31c793 Mon Sep 17 00:00:00 2001 From: mzhoot Date: Sat, 4 Jul 2026 21:31:55 +0300 Subject: [PATCH] =?UTF-8?q?=D0=9C=D0=BE=D0=B8=20=D0=B8=D0=B7=D0=BC=D0=B5?= =?UTF-8?q?=D0=BD=D0=B5=D0=BD=D0=B8=D1=8F=20=D0=B4=D0=BB=D1=8F=20=D0=B2?= =?UTF-8?q?=D0=B5=D1=80=D1=81=D0=B8=D0=B8=200.12.0?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- build-blaise.sh | 153 +++++++++++ compiler/src/main/pascal/uLexer.pas | 94 ++++++- compiler/src/main/pascal/uPasTokeniser.pas | 301 +++++++++++++++++---- compiler/src/main/pascal/uStrCompat.pas | 178 +++++++++++- 4 files changed, 664 insertions(+), 62 deletions(-) create mode 100755 build-blaise.sh diff --git a/build-blaise.sh b/build-blaise.sh new file mode 100755 index 0000000..224d395 --- /dev/null +++ b/build-blaise.sh @@ -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 "Готово! 🎉" \ No newline at end of file diff --git a/compiler/src/main/pascal/uLexer.pas b/compiler/src/main/pascal/uLexer.pas index 239eebd..cb1094b 100644 --- a/compiler/src/main/pascal/uLexer.pas +++ b/compiler/src/main/pascal/uLexer.pas @@ -10,7 +10,11 @@ unit uLexer; { Compiler lexer — wraps uPasTokeniser and converts its flat token stream 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 @@ -218,6 +222,7 @@ end; function TLexer.MapKeyword(const AUpper: string): TTokenKind; begin + { Английские ключевые слова } if AUpper = 'PROGRAM' then Result := tkProgram else if AUpper = 'USES' then Result := tkUses else if AUpper = 'VAR' then Result := tkVar @@ -276,6 +281,66 @@ begin else if AUpper = 'INHERITED' then Result := tkInherited else if AUpper = 'INITIALIZATION' then Result := tkInitialization 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 Result := tkIdent; { keyword outside Phase 1 grammar treated as ident } end; @@ -284,7 +349,10 @@ function TLexer.UnescapeString(const ARaw: string): string; { ARaw is the full source span. Handles: 'text' with '' → ' escaping, #nn numeric char literals (decimal), and concatenated runs like '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 I, Len, N, C: Integer; begin @@ -339,6 +407,13 @@ begin end; 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 Len, I, C, Margin, LineStart, LineLen, Skip: Integer; Body: string; @@ -601,6 +676,19 @@ begin else if text = 'OF' then Result.Kind := tkOf else if text = 'CONST' then Result.Kind := tkConst 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; Result.Value := FTok.TokenText(); end; @@ -767,4 +855,4 @@ begin end; end; -end. +end. \ No newline at end of file diff --git a/compiler/src/main/pascal/uPasTokeniser.pas b/compiler/src/main/pascal/uPasTokeniser.pas index 1da6f64..3d1cd36 100644 --- a/compiler/src/main/pascal/uPasTokeniser.pas +++ b/compiler/src/main/pascal/uPasTokeniser.pas @@ -19,6 +19,10 @@ 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 so the unit compiles under both FPC and the self-hosted Blaise compiler. } @@ -26,7 +30,7 @@ unit uPasTokeniser; interface -uses Classes, SysUtils; +uses Classes, SysUtils, uStrCompat; type TFpgPasTokenKind = ( @@ -47,20 +51,35 @@ type Kind: TFpgPasTokenKind; Line: Integer; { 1-based line number } 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 } end; TFpgPascalTokeniser = class(TObject) + private FSource: string; - FPos: Integer; + FPos: Integer; { 1-based byte position in FSource } FLine: Integer; FLineStart: Integer; FToken: TFpgPasToken; + + { Return the Unicode codepoint at FPos (decodes UTF-8 if multi-byte). + Returns 0 at end-of-source. } 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; + + { Advance FPos past the current character (1 byte for ASCII, 2+ for + multi-byte UTF-8). } procedure Advance; + + { Advance one source line (called after consuming a line ending). } procedure AdvanceLine; + procedure ReadWhitespace; procedure ReadLineEnding; procedure ReadIdentifierOrKeyword; @@ -71,6 +90,7 @@ type procedure ReadParenStarCommentOrDirective; procedure ReadLineComment; procedure ReadSymbol; + public constructor Create; procedure SetSource(const ASource: string); function NextToken: TFpgPasToken; @@ -108,6 +128,8 @@ begin KwList := TStringList.Create(); KwList.Sorted := True; KwList.CaseSensitive := True; + + { Оригинальные английские ключевые слова } 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'); @@ -135,7 +157,89 @@ begin 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') + 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; function BinarySearchKeyword(const AText: string): Boolean; @@ -180,42 +284,99 @@ begin FToken.TextStart := 1 end; +{ ------------------------------------------------------------------------ } +{ Peek / PeekAt / Advance — UTF-8 aware } +{ ------------------------------------------------------------------------ } + function TFpgPascalTokeniser.Peek: Integer; +var + Len: Integer; begin - if FPos <= Length(FSource) then - Result := PosOrd(FSource, FPos) - else - Result := 0 + if FPos > Length(FSource) then + begin + 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; function TFpgPascalTokeniser.PeekAt(AOffset: Integer): Integer; var P: Integer; + Len: Integer; begin P := FPos + AOffset; - if (P >= 1) and (P <= Length(FSource)) then - Result := PosOrd(FSource, P) - else - Result := 0 + if (P < 1) or (P > Length(FSource)) then + begin + 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; procedure TFpgPascalTokeniser.Advance; +var + B: Integer; + Skip: Integer; 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; +{ ------------------------------------------------------------------------ } +{ Line handling } +{ ------------------------------------------------------------------------ } + procedure TFpgPascalTokeniser.AdvanceLine; begin FLine := FLine + 1; FLineStart := FPos end; +{ ------------------------------------------------------------------------ } +{ Token readers } +{ ------------------------------------------------------------------------ } + procedure TFpgPascalTokeniser.ReadWhitespace; +var + C: Integer; begin FToken.Kind := fptkWhitespace; - while (FPos <= Length(FSource)) and - ((PosOrd(FSource, FPos) = 32) or (PosOrd(FSource, FPos) = 9)) do + while FPos <= Length(FSource) do + begin + C := Peek(); + if (C <> 32) and (C <> 9) then + Break; Advance(); + end; FToken.Len := FPos - FToken.TextStart end; @@ -235,11 +396,10 @@ var begin while FPos <= Length(FSource) do begin - C := PosOrd(FSource, FPos); - if not (((C >= 65) and (C <= 90)) or ((C >= 97) and (C <= 122)) or - ((C >= 48) and (C <= 57)) or (C = 95)) then + C := Peek(); + if not (IsUTF8Letter(C) or IsUTF8Digit(C)) then Break; - Advance() + Advance(); end; FToken.Len := FPos - FToken.TextStart; if BinarySearchKeyword(UpperCase(TokenText())) then @@ -258,12 +418,16 @@ begin if C = 36 then { $ hex } begin Advance(); - while (FPos <= Length(FSource)) and - (((PosOrd(FSource, FPos) >= 48) and (PosOrd(FSource, FPos) <= 57)) or - ((PosOrd(FSource, FPos) >= 65) and (PosOrd(FSource, FPos) <= 70)) or - ((PosOrd(FSource, FPos) >= 97) and (PosOrd(FSource, FPos) <= 102)) or - (PosOrd(FSource, FPos) = 95)) do + while FPos <= Length(FSource) do + begin + C := PosOrd(FSource, FPos); + if not (((C >= 48) and (C <= 57)) or + ((C >= 65) and (C <= 70)) or + ((C >= 97) and (C <= 102)) or + (C = 95)) then + Break; Advance(); + end; FToken.Len := FPos - FToken.TextStart; Exit end; @@ -271,10 +435,13 @@ begin if C = 37 then { % binary } begin Advance(); - while (FPos <= Length(FSource)) and - ((PosOrd(FSource, FPos) = 48) or (PosOrd(FSource, FPos) = 49) or - (PosOrd(FSource, FPos) = 95)) do + while FPos <= Length(FSource) do + begin + C := PosOrd(FSource, FPos); + if not ((C = 48) or (C = 49) or (C = 95)) then + Break; Advance(); + end; FToken.Len := FPos - FToken.TextStart; Exit end; @@ -282,28 +449,37 @@ begin if C = 38 then { & octal } begin Advance(); - while (FPos <= Length(FSource)) and - (((PosOrd(FSource, FPos) >= 48) and (PosOrd(FSource, FPos) <= 55)) or - (PosOrd(FSource, FPos) = 95)) do + while FPos <= Length(FSource) do + begin + C := PosOrd(FSource, FPos); + if not (((C >= 48) and (C <= 55)) or (C = 95)) then + Break; Advance(); + end; FToken.Len := FPos - FToken.TextStart; Exit end; { decimal integer — also allows _ between digits } - while (FPos <= Length(FSource)) and - (((PosOrd(FSource, FPos) >= 48) and (PosOrd(FSource, FPos) <= 57)) or - (PosOrd(FSource, FPos) = 95)) do + while FPos <= Length(FSource) do + begin + C := PosOrd(FSource, FPos); + if not (((C >= 48) and (C <= 57)) or (C = 95)) then + Break; Advance(); + end; if (FPos <= Length(FSource)) and (PosOrd(FSource, FPos) = 46) and (PeekAt(1) <> 46) then begin Advance(); - while (FPos <= Length(FSource)) and - (((PosOrd(FSource, FPos) >= 48) and (PosOrd(FSource, FPos) <= 57)) or - (PosOrd(FSource, FPos) = 95)) do - Advance() + while FPos <= Length(FSource) do + begin + C := PosOrd(FSource, FPos); + if not (((C >= 48) and (C <= 57)) or (C = 95)) then + Break; + Advance(); + end; end; if (FPos <= Length(FSource)) and @@ -313,10 +489,13 @@ begin if (FPos <= Length(FSource)) and ((PosOrd(FSource, FPos) = 43) or (PosOrd(FSource, FPos) = 45)) then Advance(); - while (FPos <= Length(FSource)) and - (((PosOrd(FSource, FPos) >= 48) and (PosOrd(FSource, FPos) <= 57)) or - (PosOrd(FSource, FPos) = 95)) do - Advance() + while FPos <= Length(FSource) do + begin + C := PosOrd(FSource, FPos); + if not (((C >= 48) and (C <= 57)) or (C = 95)) then + Break; + Advance(); + end; end; FToken.Len := FPos - FToken.TextStart @@ -329,7 +508,7 @@ begin FToken.Kind := fptkString; while True do begin - C := Peek(); + C := PosOrd(FSource, FPos); if C = 39 then begin Advance(); @@ -355,17 +534,25 @@ begin if (FPos <= Length(FSource)) and (PosOrd(FSource, FPos) = 36) then begin Advance(); - while (FPos <= Length(FSource)) and - (((PosOrd(FSource, FPos) >= 48) and (PosOrd(FSource, FPos) <= 57)) or - ((PosOrd(FSource, FPos) >= 65) and (PosOrd(FSource, FPos) <= 70)) or - ((PosOrd(FSource, FPos) >= 97) and (PosOrd(FSource, FPos) <= 102))) do - Advance() + while FPos <= Length(FSource) do + begin + C := PosOrd(FSource, FPos); + if not (((C >= 48) and (C <= 57)) or + ((C >= 65) and (C <= 70)) or + ((C >= 97) and (C <= 102))) then + Break; + Advance(); + end end else begin - while (FPos <= Length(FSource)) and - ((PosOrd(FSource, FPos) >= 48) and (PosOrd(FSource, FPos) <= 57)) do - Advance() + while FPos <= Length(FSource) do + begin + C := PosOrd(FSource, FPos); + if not ((C >= 48) and (C <= 57)) then + Break; + Advance(); + end end end else if C = 94 then @@ -523,6 +710,10 @@ begin FToken.Len := FPos - FToken.TextStart end; +{ ------------------------------------------------------------------------ } +{ NextToken — main dispatch } +{ ------------------------------------------------------------------------ } + function TFpgPascalTokeniser.NextToken: TFpgPasToken; var C, C2: Integer; @@ -542,7 +733,7 @@ begin FToken.Line := FLine; FToken.Column := FPos - FLineStart + 1; - C := PosOrd(FSource, FPos); + C := Peek(); if (C = 32) or (C = 9) then begin @@ -558,7 +749,10 @@ begin Exit 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 ReadIdentifierOrKeyword(); Result := FToken; @@ -572,6 +766,7 @@ begin Exit end; + C := PosOrd(FSource, FPos); C2 := PeekAt(1); if (C = 36) and (((C2 >= 48) and (C2 <= 57)) or @@ -651,4 +846,4 @@ begin Result := UpperCase(TokenText()) end; -end. +end. \ No newline at end of file diff --git a/compiler/src/main/pascal/uStrCompat.pas b/compiler/src/main/pascal/uStrCompat.pas index 76053b9..8a94e78 100644 --- a/compiler/src/main/pascal/uStrCompat.pas +++ b/compiler/src/main/pascal/uStrCompat.pas @@ -12,11 +12,11 @@ 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. - Usage: - - Replace s[1] with StrAt(s, 0) - - Replace Pos(sub, s) > 0 with Pos(sub, s) >= 0 - - Replace Copy(s, n, len) with Copy(s, n, len) (already 0-based in Blaise) - - Use StrAt(s, i) instead of s[i+1] style char access + UTF-8 aware functions added for lexer/parser support: + - UTF8CharLen: returns byte length of UTF-8 sequence starting at given byte + - UTF8CodePoint: decodes Unicode codepoint from UTF-8 bytes at position + - IsUTF8Letter: checks if codepoint is a letter (Latin, Cyrillic) or underscore + - IsUTF8Digit: checks if codepoint is an ASCII digit 0-9 } unit uStrCompat; @@ -53,6 +53,24 @@ function ParseIntLiteral(const S: string): Int64; procedure ParseIntOrUInt64Literal(const S: string; 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 function StrAt(const S: string; I: Integer): Integer; @@ -204,4 +222,152 @@ begin Result := V; 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. \ No newline at end of file