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

Merge version-0.12.0 into master с разрешением конфликтов

Browse source
This commit is contained in:
mzhoot 2026-07-04 21:34:25 +03:00
parent 8d1130852f ec10da32b9
commit 8b50bc0c9f
4 changed files with 669 additions and 61 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 "Готово! 🎉"

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

@ -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
@ -252,6 +256,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
@ -311,6 +316,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;
@ -347,9 +412,18 @@ end;
function TLexer.UnescapeString(const ARaw: string): string;
{ ARaw is the full source span. Handles: 'text' with '' → ' escaping,
<<<<<<< HEAD
#nnnn / #$hhhh Unicode-codepoint literals (decimal or hex, UTF-8 encoded),
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. }
=======
#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.
UTF-8 note: Cyrillic characters inside quoted strings are preserved
as-is since string content is opaque to the tokeniser. }
>>>>>>> version-0.12.0
var
I, Len, N, C: Integer;
begin
@ -420,6 +494,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;
@ -725,6 +806,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;
@ -892,4 +986,4 @@ begin
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).
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.

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
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.