Move write procedures to the common module

This commit is contained in:
2025-08-14 14:06:57 +03:00
parent 5146ea61b9
commit cec020ea92
6 changed files with 101 additions and 118 deletions

View File

@@ -3,11 +3,10 @@
obtain one at https://mozilla.org/MPL/2.0/. *)
module;
from FIO import WriteString, WriteChar, WriteLine, StdErr;
import cstdlib, common;
import cstdlib, cstring, common;
type
CommandLine = record
CommandLine* = record
input: ^Char;
output: ^Char;
lex: Bool;
@@ -17,16 +16,16 @@ type
proc parse_command_line*(argc: Int, argv: ^^Char) -> ^CommandLine;
var
parameter: ^Char;
i: Word;
i: Int;
result: ^CommandLine;
parsed: Bool;
begin
i := 1u;
NEW(result);
i := 1;
result := cast(malloc(#size(CommandLine)): ^CommandLine);
result^.lex := false;
result^.parse := false;
memset(@result^.input, 0, 256);
result^.output[1] := CHAR(0);
result^.input := nil;
result^.output := nil;
while i < argc & result <> nil do
parameter := (argv + i)^;
@@ -41,10 +40,10 @@ begin
result^.parse := true
end;
if strcmp(parameter, "-o\0".ptr) = 0 then
i := i + 1u;
i := i + 1;
if i = argc then
WriteString(StdErr, "Fatal error: expecting a file name following -o.");
write_s("Fatal error: expecting a file name following -o.");
result := nil
end;
if i < argc then
@@ -57,12 +56,11 @@ begin
parsed := true;
if result^.input <> nil then
WriteString(StdErr, "Fatal error: only one source file can be compiled at once. First given \"");
WriteString(StdErr, result^.input);
WriteString(StdErr, "\", then \"");
WriteString(StdErr, parameter);
WriteString(StdErr, "\".");
WriteLine(StdErr);
write_s("Fatal error: only one source file can be compiled at once. First given \"");
write_z(result^.input);
write_s("\", then \"");
write_z(parameter);
write_s("\".\n");
result := nil
end;
if result <> nil then
@@ -70,20 +68,18 @@ begin
end
end;
if ~parsed then
WriteString(StdErr, "Fatal error: unknown command line options: ");
write_s("Fatal error: unknown command line options: ");
WriteString(StdErr, parameter);
WriteChar(StdErr, '.');
WriteLine(StdErr);
write_z(parameter);
write_s(".\n");
result := nil
end;
i := i + 1u
i := i + 1
end;
if result <> nil & result^.input = nil then
WriteString(StdErr, "Fatal error: no input files.");
WriteLine(StdErr);
write_s("Fatal error: no input files.\n");
result := nil
end;

View File

@@ -432,7 +432,7 @@ begin
token^.kind := LexerKind.identifier;
token^.identifierKind[1] := cast(lexer^.current.iterator - lexer^.start.iterator: Char);
memcpy(@token^.identifierKind[2], lexer^.start.iterator, ORD(token^.identifierKind[1]));
memcpy(@token^.identifierKind[2], lexer^.start.iterator, cast(token^.identifierKind[1]: Word));
if compare_keyword("program", lexer^.start, lexer^.current.iterator) then
token^.kind := LexerKind._program

View File

@@ -271,7 +271,7 @@ end;
proc parse_array_type(parser: ^Parser) -> ^AstTypeExpression;
var
token: LexerToken;
buffer: [20]CHAR;
buffer: [20]Char;
result: ^AstTypeExpression;
begin
NEW(result);

View File

@@ -37,21 +37,20 @@ end;
proc transpile_import_statement(context: ^TranspilerContext, import_statement: ^AstImportStatement);
var
written_bytes: Word;
current_symbol: ^Identifier;
begin
WriteString(context^.output, "FROM ");
written_bytes := WriteNBytes(context^.output, ORD(import_statement^.package[1]), @import_statement^.package[2]);
transpile_identifier(context, import_statement^.package);
WriteString(context^.output, " IMPORT ");
current_symbol := import_statement^.symbols;
written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), @current_symbol^[2]);
transpile_identifier(context, current_symbol^);
current_symbol := current_symbol + 1;
while current_symbol^[1] <> '\0' do
WriteString(context^.output, ", ");
written_bytes := WriteNBytes(context^.output, ORD(current_symbol^[1]), @current_symbol^[2]);
transpile_identifier(context, current_symbol^);
current_symbol := current_symbol + 1;
end;
write_semicolon(context^.output)
@@ -70,11 +69,10 @@ end;
proc transpile_constant_declaration(context: ^TranspilerContext, declaration: ^AstConstantDeclaration);
var
buffer: [20]CHAR;
written_bytes: Word;
buffer: [20]Char;
begin
WriteString(context^.output, " ");
written_bytes := WriteNBytes(context^.output, ORD(declaration^.constant_name[1]), @declaration^.constant_name[2]);
transpile_identifier(context, declaration^.constant_name);
WriteString(context^.output, " = ");
@@ -135,14 +133,13 @@ end;
proc transpile_type_fields(context: ^TranspilerContext, fields: ^AstFieldDeclaration);
var
written_bytes: Word;
current_field: ^AstFieldDeclaration;
begin
current_field := fields;
while current_field^.field_name[1] <> '\0' do
WriteString(context^.output, " ");
written_bytes := WriteNBytes(context^.output, ORD(current_field^.field_name[1]), @current_field^.field_name[2]);
transpile_identifier(context, current_field^.field_name);
WriteString(context^.output, ": ");
transpile_type_expression(context, current_field^.field_type);
@@ -173,7 +170,7 @@ end;
proc transpile_array_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
var
buffer: [20]CHAR;
buffer: [20]Char;
begin
WriteString(context^.output, "ARRAY");
@@ -193,21 +190,20 @@ end;
proc transpile_enumeration_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
var
current_case: ^Identifier;
written_bytes: Word;
begin
current_case := type_expression^.cases;
WriteString(context^.output, "(");
WriteLine(context^.output);
WriteString(context^.output, " ");
written_bytes := WriteNBytes(context^.output, ORD(current_case^[1]), @current_case^[2]);
transpile_identifier(context, current_case^);
current_case := current_case + 1;
while current_case^[1] <> '\0' do
WriteChar(context^.output, ',');
WriteLine(context^.output);
WriteString(context^.output, " ");
written_bytes := WriteNBytes(context^.output, ORD(current_case^[1]), @current_case^[2]);
transpile_identifier(context, current_case^);
current_case := current_case + 1
end;
@@ -215,11 +211,11 @@ begin
WriteString(context^.output, " )")
end;
proc transpile_named_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
proc transpile_identifier(context: ^TranspilerContext, identifier: Identifier);
var
written_bytes: Word;
begin
written_bytes := WriteNBytes(context^.output, ORD(type_expression^.name[1]), @type_expression^.name[2])
written_bytes := WriteNBytes(context^.output, cast(identifier[1]: Word), @identifier[2])
end;
proc transpile_procedure_type(context: ^TranspilerContext, type_expression: ^AstTypeExpression);
@@ -261,7 +257,7 @@ begin
transpile_procedure_type(context, type_expression)
end;
if type_expression^.kind = astTypeExpressionKindNamed then
transpile_named_type(context, type_expression)
transpile_identifier(context, type_expression^.name)
end
end;
@@ -271,7 +267,7 @@ var
begin
WriteString(context^.output, " ");
written_bytes := WriteNBytes(context^.output, ORD(declaration^.identifier[1]), @declaration^.identifier[2]);
transpile_identifier(context^.output, declaration^.identifier);
WriteString(context^.output, " = ");
transpile_type_expression(context, declaration^.type_expression);
@@ -297,11 +293,9 @@ begin
end;
proc transpile_variable_declaration(context: ^TranspilerContext, declaration: ^AstVariableDeclaration);
var
written_bytes: Word;
begin
WriteString(context^.output, " ");
written_bytes := WriteNBytes(context^.output, ORD(declaration^.variable_name[1]), @declaration^.variable_name[2]);
transpile_identifier(context, declaration^.variable_name);
WriteString(context^.output, ": ");
@@ -331,19 +325,18 @@ end;
proc transpile_procedure_heading(context: ^TranspilerContext, declaration: ^AstProcedureDeclaration);
var
written_bytes: Word;
parameter_index: Word;
current_parameter: ^AstTypedDeclaration;
begin
WriteString(context^.output, "PROCEDURE ");
written_bytes := WriteNBytes(context^.output, ORD(declaration^.name[1]), @declaration^.name[2]);
transpile_identifier(context, declaration^.name);
WriteChar(context^.output, '(');
parameter_index := 0;
current_parameter := declaration^.parameters;
while parameter_index < declaration^.parameter_count do
written_bytes := WriteNBytes(context^.output, ORD(current_parameter^.identifier[1]), @current_parameter^.identifier[2]);
transpile_identifier(context, current_parameter^.identifier);
WriteString(context^.output, ": ");
transpile_type_expression(context, current_parameter^.type_expression);
@@ -395,8 +388,7 @@ end;
proc transpile_expression(context: ^TranspilerContext, expression: ^AstExpression);
var
literal: ^AstLiteral;
buffer: [20]CHAR;
written_bytes: Word;
buffer: [20]Char;
argument_index: Word;
current_argument: ^^AstExpression;
begin
@@ -421,7 +413,7 @@ begin
end
end;
if expression^.kind = astExpressionKindIdentifier then
written_bytes := WriteNBytes(context^.output, ORD(expression^.identifier[1]), @expression^.identifier[2])
transpile_identifier(context, expression^.identifier)
end;
if expression^.kind = astExpressionKindDereference then
transpile_expression(context, expression^.reference);
@@ -436,7 +428,7 @@ begin
if expression^.kind = astExpressionKindFieldAccess then
transpile_expression(context, expression^.aggregate);
WriteChar(context^.output, '.');
written_bytes := WriteNBytes(context^.output, ORD(expression^.field[1]), @expression^.field[2])
transpile_identifier(contextexpression^.field)
end;
if expression^.kind = astExpressionKindUnary then
transpile_unary_operator(context, expression^.unary_operator);
@@ -574,8 +566,6 @@ begin
end;
proc transpile_procedure_declaration(context: ^TranspilerContext, declaration: ^AstProcedureDeclaration);
var
written_bytes: Word;
begin
transpile_procedure_heading(context, declaration);
@@ -584,7 +574,7 @@ begin
transpile_statement_part(context, declaration^.statements);
WriteString(context^.output, "END ");
written_bytes := WriteNBytes(context^.output, ORD(declaration^.name[1]), @declaration^.name[2]);
transpile_identifier(context^.output, declaration^.name);
write_semicolon(context^.output)
end;

View File

@@ -3,6 +3,8 @@
obtain one at https://mozilla.org/MPL/2.0/. *)
module;
import cstring, cstdio;
type
Identifier = [256]Char;
TextLocation* = record
@@ -10,4 +12,60 @@ type
column: Word
end;
proc write*(fd: Int, buf: Pointer, Word: Int) -> Int; extern;
proc write_s*(value: String);
begin
write(1, cast(value.ptr: Pointer), cast(value.length: Int))
end;
proc write_z*(value: ^Char);
begin
write(1, cast(value: Pointer), cast(strlen(value): Int))
end;
proc write_b*(value: Bool);
begin
if value then
write_s("true")
else
write_s("false")
end
end;
proc write_c*(value: Char);
begin
putchar(cast(value: Int));
fflush(nil)
end;
proc write_i*(value: Int);
var
digit: Int;
n: Word;
buffer: [10]Char;
begin
n := 10u;
if value = 0 then
write_c('0')
end;
while value <> 0 do
digit := value % 10;
value := value / 10;
buffer[n] := cast(cast('0': Int) + digit: Char);
n := n - 1u
end;
while n < 10u do
n := n + 1u;
write_c(buffer[n])
end
end;
proc write_u*(value: Word);
begin
write_i(cast(value: Int))
end;
end.

View File

@@ -3,7 +3,7 @@
obtain one at https://mozilla.org/MPL/2.0/. *)
program;
import cstdlib, cstring, cstdio, cctype, common, Lexer;
import cstdlib, cstdio, cctype, common, Lexer;
const
SEEK_SET* := 0;
@@ -113,7 +113,7 @@ type
end;
location: Location
end;
CommandLine* = record
CommandLine = record
input: ^Char;
lex: Bool;
parse: Bool
@@ -123,74 +123,13 @@ type
data: ^Token
end;
(*
External procedures.
*)
proc write(fd: Int, buf: Pointer, Word: Int) -> Int; extern;
(*
Standard procedures.
*)
proc reallocarray(ptr: Pointer, n: Word, size: Word) -> Pointer;
return realloc(ptr, n * size)
end;
proc write_s(value: String);
begin
write(1, cast(value.ptr: Pointer), cast(value.length: Int))
end;
proc write_z(value: ^Char);
begin
write(1, cast(value: Pointer), cast(strlen(value): Int))
end;
proc write_b(value: Bool);
begin
if value then
write_s("true")
else
write_s("false")
end
end;
proc write_c(value: Char);
begin
putchar(cast(value: Int));
fflush(nil)
end;
proc write_i(value: Int);
var
digit: Int;
n: Word;
buffer: [10]Char;
begin
n := 10u;
if value = 0 then
write_c('0')
end;
while value <> 0 do
digit := value % 10;
value := value / 10;
buffer[n] := cast(cast('0': Int) + digit: Char);
n := n - 1u
end;
while n < 10u do
n := n + 1u;
write_c(buffer[n])
end
end;
proc write_u(value: Word);
begin
write_i(cast(value: Int))
end;
proc substring(string: String, start: Word, count: Word) -> String;
return String(string.ptr + start, count)
end;