IMPLEMENTATION MODULE Parser;

FROM SYSTEM IMPORT TSIZE;

FROM MemUtils IMPORT MemZero;
FROM Storage IMPORT ALLOCATE, REALLOCATE;

FROM Lexer IMPORT LexerKind, LexerToken, lexer_current, lexer_lex;

(* Calls lexer_lex() but skips the comments. *)
PROCEDURE transpiler_lex(lexer: PLexer): LexerToken;
VAR
  result: LexerToken;
BEGIN
  result := lexer_lex(lexer);

  WHILE result.kind = lexerKindComment DO
    result := lexer_lex(lexer)
  END;

  RETURN result
END transpiler_lex;
PROCEDURE parse_type_fields(lexer: PLexer): PAstFieldDeclaration;
VAR
  token: LexerToken;
  field_declarations: PAstFieldDeclaration;
  field_count: CARDINAL;
  current_field: PAstFieldDeclaration;
BEGIN
  ALLOCATE(field_declarations, TSIZE(AstFieldDeclaration));
  token := transpiler_lex(lexer);
  field_count := 0;

  WHILE token.kind <> lexerKindEnd DO
    INC(field_count);
	REALLOCATE(field_declarations, TSIZE(AstFieldDeclaration) * (field_count + 1));
    current_field := field_declarations;
    INC(current_field , TSIZE(AstFieldDeclaration) * (field_count - 1));

    token := transpiler_lex(lexer);

    current_field^.field_name := token.identifierKind;

    token := transpiler_lex(lexer);
    current_field^.field_type := parse_type_expression(lexer);
    token := transpiler_lex(lexer);

    IF token.kind = lexerKindSemicolon THEN
      token := transpiler_lex(lexer)
    END
  END;
  INC(current_field, TSIZE(AstFieldDeclaration));
  MemZero(current_field, TSIZE(AstFieldDeclaration));

  RETURN field_declarations
END parse_type_fields;
PROCEDURE parse_record_type(lexer: PLexer): PAstTypeExpression;
VAR
  result: PAstTypeExpression;
BEGIN
  ALLOCATE(result, TSIZE(AstTypeExpression));
  result^.kind := astTypeExpressionKindRecord;
  result^.fields := parse_type_fields(lexer);

  RETURN result
END parse_record_type;
PROCEDURE parse_pointer_type(lexer: PLexer): PAstTypeExpression;
VAR
  token: LexerToken;
  result: PAstTypeExpression;
BEGIN
  ALLOCATE(result, TSIZE(AstTypeExpression));
  result^.kind := astTypeExpressionKindPointer;

  token := lexer_current(lexer);

  IF token.kind = lexerKindPointer THEN
    token := transpiler_lex(lexer)
  END;
  token := lexer_current(lexer);
  result^.target := parse_type_expression(lexer);

  RETURN result
END parse_pointer_type;
PROCEDURE parse_array_type(lexer: PLexer): PAstTypeExpression;
VAR
  token: LexerToken;
  buffer: ARRAY[1..20] OF CHAR;
  result: PAstTypeExpression;
BEGIN
  ALLOCATE(result, TSIZE(AstTypeExpression));
  result^.kind := astTypeExpressionKindArray;
  result^.length := 0;

  token := lexer_current(lexer);

  IF token.kind = lexerKindArray THEN
    token := transpiler_lex(lexer)
  END;
  IF token.kind <> lexerKindOf THEN
    token := transpiler_lex(lexer);

    result^.length := token.integerKind;

    token := transpiler_lex(lexer);
  END;
  token := transpiler_lex(lexer);
  result^.base := parse_type_expression(lexer);

  RETURN result
END parse_array_type;
PROCEDURE parse_enumeration_type(lexer: PLexer): PAstTypeExpression;
VAR
  token: LexerToken;
  result: PAstTypeExpression;
  current_case: PIdentifier;
  case_count: CARDINAL;
BEGIN
  ALLOCATE(result, TSIZE(AstTypeExpression));
  result^.kind := astTypeExpressionKindEnumeration;

  case_count := 1;
  ALLOCATE(result^.cases, TSIZE(Identifier) * 2);
  token := transpiler_lex(lexer);
  current_case := result^.cases;
  current_case^ := token.identifierKind;

  token := transpiler_lex(lexer);

  WHILE token.kind = lexerKindComma DO
    token := transpiler_lex(lexer);

    INC(case_count);
    REALLOCATE(result^.cases, TSIZE(Identifier) * (case_count + 1));
    current_case := result^.cases;
	INC(current_case, TSIZE(Identifier) * (case_count - 1));
	current_case^ := token.identifierKind;

    token := transpiler_lex(lexer)
  END;
  INC(current_case, TSIZE(Identifier));
  MemZero(current_case, TSIZE(Identifier));

  RETURN result
END parse_enumeration_type;
PROCEDURE parse_named_type(lexer: PLexer): PAstTypeExpression;
VAR
  token: LexerToken;
  result: PAstTypeExpression;
  written_bytes: CARDINAL;
BEGIN
  token := lexer_current(lexer);
  ALLOCATE(result, TSIZE(AstTypeExpression));

  result^.kind := astTypeExpressionKindNamed;
  result^.name := token.identifierKind;

  RETURN result
END parse_named_type;
PROCEDURE parse_procedure_type(lexer: PLexer): PAstTypeExpression;
VAR
  token: LexerToken;
  result: PAstTypeExpression;
  current_parameter: PPAstTypeExpression;
  parameter_count: CARDINAL;
BEGIN
  parameter_count := 0;
  ALLOCATE(result, TSIZE(AstTypeExpression));
  result^.kind := astTypeExpressionKindProcedure;

  ALLOCATE(result^.parameters, 1);

  token := transpiler_lex(lexer);
  token := transpiler_lex(lexer);

  WHILE token.kind <> lexerKindRightParen DO
    INC(parameter_count);
    REALLOCATE(result^.parameters, TSIZE(PAstTypeExpression) * (parameter_count + 1));
    current_parameter := result^.parameters;
	INC(current_parameter, TSIZE(PAstTypeExpression) * (parameter_count - 1));

    current_parameter^ := parse_type_expression(lexer);

    token := transpiler_lex(lexer);
    IF token.kind = lexerKindComma THEN
      token := transpiler_lex(lexer)
    END
  END;
  current_parameter := result^.parameters;
  INC(current_parameter, TSIZE(PAstTypeExpression) * parameter_count);
  current_parameter^ := NIL;

  RETURN result
END parse_procedure_type;
PROCEDURE parse_type_expression(lexer: PLexer): PAstTypeExpression;
VAR
  token: LexerToken;
  result: PAstTypeExpression;
BEGIN
  result := NIL;
  token := lexer_current(lexer);

  IF token.kind = lexerKindRecord THEN
    result := parse_record_type(lexer)
  END;
  IF token.kind = lexerKindLeftParen THEN
    result := parse_enumeration_type(lexer)
  END;
  IF (token.kind = lexerKindArray) OR (token.kind = lexerKindLeftSquare) THEN
    result := parse_array_type(lexer)
  END;
  IF token.kind = lexerKindHat THEN
    result := parse_pointer_type(lexer)
  END;
  IF token.kind = lexerKindProc THEN
    result := parse_procedure_type(lexer)
  END;
  IF token.kind = lexerKindIdentifier THEN
    result := parse_named_type(lexer)
  END;
  RETURN result
END parse_type_expression;
PROCEDURE parse_type_declaration(lexer: PLexer): PAstTypeDeclaration;
VAR
  token: LexerToken;
  result: PAstTypeDeclaration;
BEGIN
  token := lexer_current(lexer);

  ALLOCATE(result, TSIZE(AstTypeDeclaration));
  result^.identifier := token.identifierKind;

  token := transpiler_lex(lexer);
  token := transpiler_lex(lexer);

  result^.type_expression := parse_type_expression(lexer);
  token := transpiler_lex(lexer);

  RETURN result
END parse_type_declaration;
PROCEDURE parse_type_part(lexer: PLexer): PPAstTypeDeclaration;
VAR
  token: LexerToken;
  result: PPAstTypeDeclaration;
  current_declaration: PPAstTypeDeclaration;
  declaration_count: CARDINAL;
BEGIN
  token := lexer_current(lexer);

  ALLOCATE(result, TSIZE(PAstTypeDeclaration));
  current_declaration := result;
  declaration_count := 0;

  IF token.kind = lexerKindType THEN
    token := transpiler_lex(lexer);

    WHILE token.kind = lexerKindIdentifier DO
      INC(declaration_count);

      REALLOCATE(result, TSIZE(PAstTypeDeclaration) * (declaration_count + 1));
      current_declaration := result;
      INC(current_declaration, TSIZE(PAstTypeDeclaration) * (declaration_count - 1));

      current_declaration^ := parse_type_declaration(lexer);
      token := transpiler_lex(lexer)
    END
  END;
  IF declaration_count <> 0 THEN
    INC(current_declaration, TSIZE(PAstTypeDeclaration))
  END;
  current_declaration^ := NIL;

  RETURN result
END parse_type_part;
END Parser.