Compare commits
No commits in common. "cpp" and "haskell" have entirely different histories.
2
.gitignore
vendored
2
.gitignore
vendored
@ -2,3 +2,5 @@
|
||||
.cache/
|
||||
CMakeFiles/
|
||||
CMakeCache.txt
|
||||
node_modules/
|
||||
/dist-newstyle/
|
||||
|
||||
@ -1,34 +0,0 @@
|
||||
cmake_minimum_required(VERSION 3.21)
|
||||
project(Elna)
|
||||
|
||||
set(CMAKE_EXPORT_COMPILE_COMMANDS 1)
|
||||
set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin)
|
||||
set(CMAKE_CXX_STANDARD 14)
|
||||
|
||||
find_package(Boost CONFIG COMPONENTS process program_options REQUIRED)
|
||||
find_package(FLEX REQUIRED)
|
||||
find_package(BISON REQUIRED)
|
||||
|
||||
FLEX_TARGET(lexer source/lexer.ll ${CMAKE_CURRENT_BINARY_DIR}/lexer.cc)
|
||||
BISON_TARGET(parser source/parser.yy ${CMAKE_CURRENT_BINARY_DIR}/parser.cc)
|
||||
add_flex_bison_dependency(lexer parser)
|
||||
|
||||
add_library(elna-frontend
|
||||
source/ast.cc include/elna/source/ast.h
|
||||
source/types.cc include/elna/source/types.h
|
||||
source/driver.cc include/elna/source/driver.h
|
||||
source/result.cc include/elna/source/result.h
|
||||
${BISON_parser_OUTPUTS} ${FLEX_lexer_OUTPUTS}
|
||||
)
|
||||
target_include_directories(elna-frontend PRIVATE ${CMAKE_CURRENT_BINARY_DIR} include)
|
||||
target_compile_options(elna-frontend PRIVATE
|
||||
$<$<COMPILE_LANGUAGE:CXX>:-fno-exceptions -fno-rtti>
|
||||
)
|
||||
|
||||
add_executable(elna cli/main.cc)
|
||||
target_link_libraries(elna PRIVATE elna-frontend)
|
||||
target_include_directories(elna PRIVATE ${CMAKE_CURRENT_BINARY_DIR} include ${Boost_INCLUDE_DIR})
|
||||
target_link_libraries(elna LINK_PUBLIC ${Boost_LIBRARIES})
|
||||
target_compile_options(elna PRIVATE
|
||||
$<$<COMPILE_LANGUAGE:CXX>:-fno-exceptions -fno-rtti>
|
||||
)
|
||||
373
LICENSE
Normal file
373
LICENSE
Normal file
@ -0,0 +1,373 @@
|
||||
Mozilla Public License Version 2.0
|
||||
==================================
|
||||
|
||||
1. Definitions
|
||||
--------------
|
||||
|
||||
1.1. "Contributor"
|
||||
means each individual or legal entity that creates, contributes to
|
||||
the creation of, or owns Covered Software.
|
||||
|
||||
1.2. "Contributor Version"
|
||||
means the combination of the Contributions of others (if any) used
|
||||
by a Contributor and that particular Contributor's Contribution.
|
||||
|
||||
1.3. "Contribution"
|
||||
means Covered Software of a particular Contributor.
|
||||
|
||||
1.4. "Covered Software"
|
||||
means Source Code Form to which the initial Contributor has attached
|
||||
the notice in Exhibit A, the Executable Form of such Source Code
|
||||
Form, and Modifications of such Source Code Form, in each case
|
||||
including portions thereof.
|
||||
|
||||
1.5. "Incompatible With Secondary Licenses"
|
||||
means
|
||||
|
||||
(a) that the initial Contributor has attached the notice described
|
||||
in Exhibit B to the Covered Software; or
|
||||
|
||||
(b) that the Covered Software was made available under the terms of
|
||||
version 1.1 or earlier of the License, but not also under the
|
||||
terms of a Secondary License.
|
||||
|
||||
1.6. "Executable Form"
|
||||
means any form of the work other than Source Code Form.
|
||||
|
||||
1.7. "Larger Work"
|
||||
means a work that combines Covered Software with other material, in
|
||||
a separate file or files, that is not Covered Software.
|
||||
|
||||
1.8. "License"
|
||||
means this document.
|
||||
|
||||
1.9. "Licensable"
|
||||
means having the right to grant, to the maximum extent possible,
|
||||
whether at the time of the initial grant or subsequently, any and
|
||||
all of the rights conveyed by this License.
|
||||
|
||||
1.10. "Modifications"
|
||||
means any of the following:
|
||||
|
||||
(a) any file in Source Code Form that results from an addition to,
|
||||
deletion from, or modification of the contents of Covered
|
||||
Software; or
|
||||
|
||||
(b) any new file in Source Code Form that contains any Covered
|
||||
Software.
|
||||
|
||||
1.11. "Patent Claims" of a Contributor
|
||||
means any patent claim(s), including without limitation, method,
|
||||
process, and apparatus claims, in any patent Licensable by such
|
||||
Contributor that would be infringed, but for the grant of the
|
||||
License, by the making, using, selling, offering for sale, having
|
||||
made, import, or transfer of either its Contributions or its
|
||||
Contributor Version.
|
||||
|
||||
1.12. "Secondary License"
|
||||
means either the GNU General Public License, Version 2.0, the GNU
|
||||
Lesser General Public License, Version 2.1, the GNU Affero General
|
||||
Public License, Version 3.0, or any later versions of those
|
||||
licenses.
|
||||
|
||||
1.13. "Source Code Form"
|
||||
means the form of the work preferred for making modifications.
|
||||
|
||||
1.14. "You" (or "Your")
|
||||
means an individual or a legal entity exercising rights under this
|
||||
License. For legal entities, "You" includes any entity that
|
||||
controls, is controlled by, or is under common control with You. For
|
||||
purposes of this definition, "control" means (a) the power, direct
|
||||
or indirect, to cause the direction or management of such entity,
|
||||
whether by contract or otherwise, or (b) ownership of more than
|
||||
fifty percent (50%) of the outstanding shares or beneficial
|
||||
ownership of such entity.
|
||||
|
||||
2. License Grants and Conditions
|
||||
--------------------------------
|
||||
|
||||
2.1. Grants
|
||||
|
||||
Each Contributor hereby grants You a world-wide, royalty-free,
|
||||
non-exclusive license:
|
||||
|
||||
(a) under intellectual property rights (other than patent or trademark)
|
||||
Licensable by such Contributor to use, reproduce, make available,
|
||||
modify, display, perform, distribute, and otherwise exploit its
|
||||
Contributions, either on an unmodified basis, with Modifications, or
|
||||
as part of a Larger Work; and
|
||||
|
||||
(b) under Patent Claims of such Contributor to make, use, sell, offer
|
||||
for sale, have made, import, and otherwise transfer either its
|
||||
Contributions or its Contributor Version.
|
||||
|
||||
2.2. Effective Date
|
||||
|
||||
The licenses granted in Section 2.1 with respect to any Contribution
|
||||
become effective for each Contribution on the date the Contributor first
|
||||
distributes such Contribution.
|
||||
|
||||
2.3. Limitations on Grant Scope
|
||||
|
||||
The licenses granted in this Section 2 are the only rights granted under
|
||||
this License. No additional rights or licenses will be implied from the
|
||||
distribution or licensing of Covered Software under this License.
|
||||
Notwithstanding Section 2.1(b) above, no patent license is granted by a
|
||||
Contributor:
|
||||
|
||||
(a) for any code that a Contributor has removed from Covered Software;
|
||||
or
|
||||
|
||||
(b) for infringements caused by: (i) Your and any other third party's
|
||||
modifications of Covered Software, or (ii) the combination of its
|
||||
Contributions with other software (except as part of its Contributor
|
||||
Version); or
|
||||
|
||||
(c) under Patent Claims infringed by Covered Software in the absence of
|
||||
its Contributions.
|
||||
|
||||
This License does not grant any rights in the trademarks, service marks,
|
||||
or logos of any Contributor (except as may be necessary to comply with
|
||||
the notice requirements in Section 3.4).
|
||||
|
||||
2.4. Subsequent Licenses
|
||||
|
||||
No Contributor makes additional grants as a result of Your choice to
|
||||
distribute the Covered Software under a subsequent version of this
|
||||
License (see Section 10.2) or under the terms of a Secondary License (if
|
||||
permitted under the terms of Section 3.3).
|
||||
|
||||
2.5. Representation
|
||||
|
||||
Each Contributor represents that the Contributor believes its
|
||||
Contributions are its original creation(s) or it has sufficient rights
|
||||
to grant the rights to its Contributions conveyed by this License.
|
||||
|
||||
2.6. Fair Use
|
||||
|
||||
This License is not intended to limit any rights You have under
|
||||
applicable copyright doctrines of fair use, fair dealing, or other
|
||||
equivalents.
|
||||
|
||||
2.7. Conditions
|
||||
|
||||
Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted
|
||||
in Section 2.1.
|
||||
|
||||
3. Responsibilities
|
||||
-------------------
|
||||
|
||||
3.1. Distribution of Source Form
|
||||
|
||||
All distribution of Covered Software in Source Code Form, including any
|
||||
Modifications that You create or to which You contribute, must be under
|
||||
the terms of this License. You must inform recipients that the Source
|
||||
Code Form of the Covered Software is governed by the terms of this
|
||||
License, and how they can obtain a copy of this License. You may not
|
||||
attempt to alter or restrict the recipients' rights in the Source Code
|
||||
Form.
|
||||
|
||||
3.2. Distribution of Executable Form
|
||||
|
||||
If You distribute Covered Software in Executable Form then:
|
||||
|
||||
(a) such Covered Software must also be made available in Source Code
|
||||
Form, as described in Section 3.1, and You must inform recipients of
|
||||
the Executable Form how they can obtain a copy of such Source Code
|
||||
Form by reasonable means in a timely manner, at a charge no more
|
||||
than the cost of distribution to the recipient; and
|
||||
|
||||
(b) You may distribute such Executable Form under the terms of this
|
||||
License, or sublicense it under different terms, provided that the
|
||||
license for the Executable Form does not attempt to limit or alter
|
||||
the recipients' rights in the Source Code Form under this License.
|
||||
|
||||
3.3. Distribution of a Larger Work
|
||||
|
||||
You may create and distribute a Larger Work under terms of Your choice,
|
||||
provided that You also comply with the requirements of this License for
|
||||
the Covered Software. If the Larger Work is a combination of Covered
|
||||
Software with a work governed by one or more Secondary Licenses, and the
|
||||
Covered Software is not Incompatible With Secondary Licenses, this
|
||||
License permits You to additionally distribute such Covered Software
|
||||
under the terms of such Secondary License(s), so that the recipient of
|
||||
the Larger Work may, at their option, further distribute the Covered
|
||||
Software under the terms of either this License or such Secondary
|
||||
License(s).
|
||||
|
||||
3.4. Notices
|
||||
|
||||
You may not remove or alter the substance of any license notices
|
||||
(including copyright notices, patent notices, disclaimers of warranty,
|
||||
or limitations of liability) contained within the Source Code Form of
|
||||
the Covered Software, except that You may alter any license notices to
|
||||
the extent required to remedy known factual inaccuracies.
|
||||
|
||||
3.5. Application of Additional Terms
|
||||
|
||||
You may choose to offer, and to charge a fee for, warranty, support,
|
||||
indemnity or liability obligations to one or more recipients of Covered
|
||||
Software. However, You may do so only on Your own behalf, and not on
|
||||
behalf of any Contributor. You must make it absolutely clear that any
|
||||
such warranty, support, indemnity, or liability obligation is offered by
|
||||
You alone, and You hereby agree to indemnify every Contributor for any
|
||||
liability incurred by such Contributor as a result of warranty, support,
|
||||
indemnity or liability terms You offer. You may include additional
|
||||
disclaimers of warranty and limitations of liability specific to any
|
||||
jurisdiction.
|
||||
|
||||
4. Inability to Comply Due to Statute or Regulation
|
||||
---------------------------------------------------
|
||||
|
||||
If it is impossible for You to comply with any of the terms of this
|
||||
License with respect to some or all of the Covered Software due to
|
||||
statute, judicial order, or regulation then You must: (a) comply with
|
||||
the terms of this License to the maximum extent possible; and (b)
|
||||
describe the limitations and the code they affect. Such description must
|
||||
be placed in a text file included with all distributions of the Covered
|
||||
Software under this License. Except to the extent prohibited by statute
|
||||
or regulation, such description must be sufficiently detailed for a
|
||||
recipient of ordinary skill to be able to understand it.
|
||||
|
||||
5. Termination
|
||||
--------------
|
||||
|
||||
5.1. The rights granted under this License will terminate automatically
|
||||
if You fail to comply with any of its terms. However, if You become
|
||||
compliant, then the rights granted under this License from a particular
|
||||
Contributor are reinstated (a) provisionally, unless and until such
|
||||
Contributor explicitly and finally terminates Your grants, and (b) on an
|
||||
ongoing basis, if such Contributor fails to notify You of the
|
||||
non-compliance by some reasonable means prior to 60 days after You have
|
||||
come back into compliance. Moreover, Your grants from a particular
|
||||
Contributor are reinstated on an ongoing basis if such Contributor
|
||||
notifies You of the non-compliance by some reasonable means, this is the
|
||||
first time You have received notice of non-compliance with this License
|
||||
from such Contributor, and You become compliant prior to 30 days after
|
||||
Your receipt of the notice.
|
||||
|
||||
5.2. If You initiate litigation against any entity by asserting a patent
|
||||
infringement claim (excluding declaratory judgment actions,
|
||||
counter-claims, and cross-claims) alleging that a Contributor Version
|
||||
directly or indirectly infringes any patent, then the rights granted to
|
||||
You by any and all Contributors for the Covered Software under Section
|
||||
2.1 of this License shall terminate.
|
||||
|
||||
5.3. In the event of termination under Sections 5.1 or 5.2 above, all
|
||||
end user license agreements (excluding distributors and resellers) which
|
||||
have been validly granted by You or Your distributors under this License
|
||||
prior to termination shall survive termination.
|
||||
|
||||
************************************************************************
|
||||
* *
|
||||
* 6. Disclaimer of Warranty *
|
||||
* ------------------------- *
|
||||
* *
|
||||
* Covered Software is provided under this License on an "as is" *
|
||||
* basis, without warranty of any kind, either expressed, implied, or *
|
||||
* statutory, including, without limitation, warranties that the *
|
||||
* Covered Software is free of defects, merchantable, fit for a *
|
||||
* particular purpose or non-infringing. The entire risk as to the *
|
||||
* quality and performance of the Covered Software is with You. *
|
||||
* Should any Covered Software prove defective in any respect, You *
|
||||
* (not any Contributor) assume the cost of any necessary servicing, *
|
||||
* repair, or correction. This disclaimer of warranty constitutes an *
|
||||
* essential part of this License. No use of any Covered Software is *
|
||||
* authorized under this License except under this disclaimer. *
|
||||
* *
|
||||
************************************************************************
|
||||
|
||||
************************************************************************
|
||||
* *
|
||||
* 7. Limitation of Liability *
|
||||
* -------------------------- *
|
||||
* *
|
||||
* Under no circumstances and under no legal theory, whether tort *
|
||||
* (including negligence), contract, or otherwise, shall any *
|
||||
* Contributor, or anyone who distributes Covered Software as *
|
||||
* permitted above, be liable to You for any direct, indirect, *
|
||||
* special, incidental, or consequential damages of any character *
|
||||
* including, without limitation, damages for lost profits, loss of *
|
||||
* goodwill, work stoppage, computer failure or malfunction, or any *
|
||||
* and all other commercial damages or losses, even if such party *
|
||||
* shall have been informed of the possibility of such damages. This *
|
||||
* limitation of liability shall not apply to liability for death or *
|
||||
* personal injury resulting from such party's negligence to the *
|
||||
* extent applicable law prohibits such limitation. Some *
|
||||
* jurisdictions do not allow the exclusion or limitation of *
|
||||
* incidental or consequential damages, so this exclusion and *
|
||||
* limitation may not apply to You. *
|
||||
* *
|
||||
************************************************************************
|
||||
|
||||
8. Litigation
|
||||
-------------
|
||||
|
||||
Any litigation relating to this License may be brought only in the
|
||||
courts of a jurisdiction where the defendant maintains its principal
|
||||
place of business and such litigation shall be governed by laws of that
|
||||
jurisdiction, without reference to its conflict-of-law provisions.
|
||||
Nothing in this Section shall prevent a party's ability to bring
|
||||
cross-claims or counter-claims.
|
||||
|
||||
9. Miscellaneous
|
||||
----------------
|
||||
|
||||
This License represents the complete agreement concerning the subject
|
||||
matter hereof. If any provision of this License is held to be
|
||||
unenforceable, such provision shall be reformed only to the extent
|
||||
necessary to make it enforceable. Any law or regulation which provides
|
||||
that the language of a contract shall be construed against the drafter
|
||||
shall not be used to construe this License against a Contributor.
|
||||
|
||||
10. Versions of the License
|
||||
---------------------------
|
||||
|
||||
10.1. New Versions
|
||||
|
||||
Mozilla Foundation is the license steward. Except as provided in Section
|
||||
10.3, no one other than the license steward has the right to modify or
|
||||
publish new versions of this License. Each version will be given a
|
||||
distinguishing version number.
|
||||
|
||||
10.2. Effect of New Versions
|
||||
|
||||
You may distribute the Covered Software under the terms of the version
|
||||
of the License under which You originally received the Covered Software,
|
||||
or under the terms of any subsequent version published by the license
|
||||
steward.
|
||||
|
||||
10.3. Modified Versions
|
||||
|
||||
If you create software not governed by this License, and you want to
|
||||
create a new license for such software, you may create and use a
|
||||
modified version of this License if you rename the license and remove
|
||||
any references to the name of the license steward (except to note that
|
||||
such modified license differs from this License).
|
||||
|
||||
10.4. Distributing Source Code Form that is Incompatible With Secondary
|
||||
Licenses
|
||||
|
||||
If You choose to distribute Source Code Form that is Incompatible With
|
||||
Secondary Licenses under the terms of this version of the License, the
|
||||
notice described in Exhibit B of this License must be attached.
|
||||
|
||||
Exhibit A - Source Code Form License Notice
|
||||
-------------------------------------------
|
||||
|
||||
This Source Code Form is subject to the terms of the Mozilla Public
|
||||
License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
|
||||
If it is not possible or desirable to put the notice in a particular
|
||||
file, then You may include the notice in a location (such as a LICENSE
|
||||
file in a relevant directory) where a recipient would be likely to look
|
||||
for such a notice.
|
||||
|
||||
You may add additional accurate notices of copyright ownership.
|
||||
|
||||
Exhibit B - "Incompatible With Secondary Licenses" Notice
|
||||
---------------------------------------------------------
|
||||
|
||||
This Source Code Form is "Incompatible With Secondary Licenses", as
|
||||
defined by the Mozilla Public License, v. 2.0.
|
||||
37
README
Normal file
37
README
Normal file
@ -0,0 +1,37 @@
|
||||
# Elna programming language
|
||||
|
||||
Elna compiles simple mathematical operations to machine code.
|
||||
The compiled program returns the result of the operation.
|
||||
|
||||
## File extension
|
||||
|
||||
.elna
|
||||
|
||||
## Grammar PL/0
|
||||
|
||||
program = block "." ;
|
||||
|
||||
block = [ "const" ident "=" number {"," ident "=" number} ";"]
|
||||
[ "var" ident {"," ident} ";"]
|
||||
{ "procedure" ident ";" block ";" } statement ;
|
||||
|
||||
statement = [ ident ":=" expression | "call" ident
|
||||
| "?" ident | "!" expression
|
||||
| "begin" statement {";" statement } "end"
|
||||
| "if" condition "then" statement
|
||||
| "while" condition "do" statement ];
|
||||
|
||||
condition = "odd" expression |
|
||||
expression ("="|"#"|"<"|"<="|">"|">=") expression ;
|
||||
|
||||
expression = [ "+"|"-"] term { ("+"|"-") term};
|
||||
|
||||
term = factor {("*"|"/") factor};
|
||||
|
||||
factor = ident | number | "(" expression ")";
|
||||
|
||||
## Operations
|
||||
|
||||
"!" - Write a line.
|
||||
"?" - Read user input.
|
||||
"odd" - The only function, returns whether a number is odd.
|
||||
101
README.md
101
README.md
@ -1,101 +0,0 @@
|
||||
# Elna programming language
|
||||
|
||||
Elna is a simple, imperative, low-level programming language.
|
||||
|
||||
It is intendet to accompany other languages in the areas, where a high-level
|
||||
language doesn't fit well. It is also supposed to be an intermediate
|
||||
representation for a such high-level hypothetical programming language.
|
||||
|
||||
## File extension
|
||||
|
||||
.elna
|
||||
|
||||
## Current implementation
|
||||
|
||||
This repository contains a GCC frontend for Elna. After finishing the frontend
|
||||
I'm planning to rewrite the compiler in Elna itself with its own backend and
|
||||
a hand-written parser. So GCC gives a way to have a simple bootstrap compiler
|
||||
and a possbility to compile Elna programs for different platforms.
|
||||
|
||||
## Grammar
|
||||
|
||||
```ebnf
|
||||
digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9";
|
||||
letter = "A" | "B" | … | "Z" | "a" | "b" | … | "z";
|
||||
|
||||
ident = letter { letter | digit | "_" };
|
||||
integer = digit { digit };
|
||||
float = integer "." integer;
|
||||
boolean = "true" | "false";
|
||||
|
||||
literal = integer | float | boolean | "'" character "'" | """ { character } """;
|
||||
|
||||
program = [ "type" type_definitions ";" ]
|
||||
[ constant_part ]
|
||||
{ procedure_definition }
|
||||
[ variable_part ]
|
||||
"begin" [ statement_list ] "end" ".";
|
||||
|
||||
procedure_definition = "proc" ident formal_parameter_list ";" ( block | "extern" ) ";";
|
||||
|
||||
block = [ constant_part ]
|
||||
[ variable_part ]
|
||||
statement;
|
||||
|
||||
constant_part = "const" ident "=" integer { "," ident "=" integer } ";";
|
||||
variable_part = "var" variable_declarations ";";
|
||||
|
||||
statement = ident ":=" expression
|
||||
| ident actual_parameter_list
|
||||
| while_do
|
||||
| if_then_else;
|
||||
|
||||
|
||||
while_do = "while" condition "do" [ statement_list ] "end";
|
||||
if_then_else = "if" expression
|
||||
"then" [ statement_list ]
|
||||
[ else statement_list ] "end";
|
||||
|
||||
statement_list = statement {";" statement };
|
||||
|
||||
condition = "odd" expression |
|
||||
expression ("="|"#"|"<"|"<="|">"|">=") expression;
|
||||
|
||||
comparison_operator = "=", "/=", "<", ">", "<=", ">=";
|
||||
unary_prefix = "not", "@";
|
||||
|
||||
expression = logical_operand { ("and" | "or") logical_operand };
|
||||
logical_operand = comparand { comparison_operator comparand };
|
||||
comparand = summand { ("+" | "-") summand };
|
||||
summand = factor { ("*" | "/") factor };
|
||||
factor = pointer { unary_prefix pointer };
|
||||
|
||||
pointer = literal
|
||||
| designator_expression { $$ = $1; }
|
||||
| "(" expression ")";
|
||||
|
||||
designator_expression = designator_expression "[" expression "]"
|
||||
| designator_expression "." ident
|
||||
| designator_expression "^"
|
||||
| ident;
|
||||
|
||||
formal_parameter_list = "(" [ variable_declarations ] ")";
|
||||
|
||||
actual_parameter_list = "(" [ expressions ] ")";
|
||||
|
||||
expressions = expression { "," expression };
|
||||
|
||||
variable_declarations = variable_declaration { ";" variable_declaration };
|
||||
|
||||
variable_declaration = ident ":" type_expression;
|
||||
|
||||
type_expression = "array" integer "of" type_expression
|
||||
| "pointer" "to" type_expression
|
||||
| "record" field_list "end"
|
||||
| "union" field_list "end"
|
||||
| ident;
|
||||
|
||||
field_list = field_declaration { ";" field_declaration };
|
||||
|
||||
field_declaration = ident ":" type_expression;
|
||||
```
|
||||
15
Rakefile
15
Rakefile
@ -1,15 +0,0 @@
|
||||
# MacOS:
|
||||
# ---
|
||||
# CC=gcc-14 CXX=g++-14 \
|
||||
# CFLAGS="-I/opt/homebrew/Cellar/flex/2.6.4_2/include" \
|
||||
# CXXFLAGS="-I/opt/homebrew/Cellar/flex/2.6.4_2/include" \
|
||||
# ../gcc-14.2.0/configure \
|
||||
# --disable-bootstrap \
|
||||
# --enable-languages=c,c++,elna \
|
||||
# --with-sysroot=/Library/Developer/CommandLineTools/SDKs/MacOSX15.2.sdk \
|
||||
# --prefix=$(realpath ../gcc-install)
|
||||
|
||||
task :default do
|
||||
sh 'make -C build'
|
||||
sh './build/bin/elna'
|
||||
end
|
||||
10
TODO
Normal file
10
TODO
Normal file
@ -0,0 +1,10 @@
|
||||
# ELF generation
|
||||
|
||||
- Don't ignore relocations where the symbol is not defined in the symbol table.
|
||||
Report an error about an undefined symbol.
|
||||
|
||||
# Register allocation
|
||||
|
||||
- Each temporary variable gets a tn register where n is the variable index. If
|
||||
there more variables the allocation will fail with out of bounds runtime
|
||||
error. Implement spill over.
|
||||
41
cli/main.cc
41
cli/main.cc
@ -1,41 +0,0 @@
|
||||
#include <elna/source/driver.h>
|
||||
#include "parser.hh"
|
||||
#include <sstream>
|
||||
|
||||
constexpr std::size_t pointer_size = 4;
|
||||
|
||||
int main()
|
||||
{
|
||||
elna::source::driver driver{ "-" };
|
||||
std::istringstream inp(R"(
|
||||
proc f();
|
||||
begin
|
||||
end;
|
||||
|
||||
var x: Int;
|
||||
|
||||
begin
|
||||
x := 4 + 2
|
||||
end.
|
||||
)");
|
||||
|
||||
elna::source::lexer lexer(inp);
|
||||
yy::parser parser(lexer, driver);
|
||||
|
||||
if (auto result = parser())
|
||||
{
|
||||
for (const auto& error : driver.errors())
|
||||
{
|
||||
std::cerr << error->path << ':'
|
||||
<< error->line() << ':' << error->column()
|
||||
<< ": error: " << error->what()
|
||||
<< '.' << std::endl;
|
||||
}
|
||||
return result;
|
||||
}
|
||||
for (auto& definition : driver.tree->definitions())
|
||||
{
|
||||
std::cout << "Definition identifier: " << definition->identifier() << std::endl;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
@ -1,4 +0,0 @@
|
||||
language="elna"
|
||||
gcc_subdir="elna/gcc"
|
||||
|
||||
. ${srcdir}/elna/gcc/config-lang.in
|
||||
88
elna.cabal
Normal file
88
elna.cabal
Normal file
@ -0,0 +1,88 @@
|
||||
cabal-version: 3.4
|
||||
name: elna
|
||||
version: 0.1.0.0
|
||||
synopsis:
|
||||
Elna programming language compiles simple mathematical operations to RISC-V code
|
||||
|
||||
license: MPL-2.0
|
||||
license-file: LICENSE
|
||||
author: Eugen Wissner
|
||||
maintainer: belka@caraus.de
|
||||
category: Language
|
||||
build-type: Simple
|
||||
extra-doc-files: TODO README
|
||||
|
||||
common warnings
|
||||
build-depends:
|
||||
base >=4.7 && <5,
|
||||
bytestring ^>= 0.12.1,
|
||||
filepath ^>= 1.5.3,
|
||||
megaparsec ^>= 9.6,
|
||||
optparse-applicative ^>= 0.18.1,
|
||||
vector ^>= 0.13.1,
|
||||
text ^>= 2.0
|
||||
ghc-options: -Wall
|
||||
default-extensions:
|
||||
DataKinds,
|
||||
ExplicitForAll,
|
||||
LambdaCase,
|
||||
OverloadedStrings,
|
||||
DuplicateRecordFields,
|
||||
RecordWildCards
|
||||
default-language: GHC2021
|
||||
|
||||
library elna-internal
|
||||
import: warnings
|
||||
exposed-modules:
|
||||
Language.Elna.Architecture.RiscV
|
||||
Language.Elna.Backend.Allocator
|
||||
Language.Elna.Backend.Intermediate
|
||||
Language.Elna.Driver
|
||||
Language.Elna.Driver.CommandLine
|
||||
Language.Elna.Frontend.AST
|
||||
Language.Elna.Frontend.NameAnalysis
|
||||
Language.Elna.Frontend.Parser
|
||||
Language.Elna.Frontend.SymbolTable
|
||||
Language.Elna.Frontend.TypeAnalysis
|
||||
Language.Elna.Frontend.Types
|
||||
Language.Elna.Glue
|
||||
Language.Elna.Location
|
||||
Language.Elna.Object.Elf
|
||||
Language.Elna.Object.ElfCoder
|
||||
Language.Elna.Object.StringTable
|
||||
Language.Elna.RiscV.CodeGenerator
|
||||
Language.Elna.RiscV.ElfWriter
|
||||
build-depends:
|
||||
exceptions ^>= 0.10,
|
||||
hashable ^>= 1.4.3,
|
||||
parser-combinators ^>= 1.3,
|
||||
transformers ^>= 0.6.1,
|
||||
unordered-containers ^>= 0.2.20
|
||||
hs-source-dirs: lib
|
||||
|
||||
executable elna
|
||||
import: warnings
|
||||
main-is: Main.hs
|
||||
build-depends:
|
||||
elna:elna-internal
|
||||
hs-source-dirs: src
|
||||
|
||||
test-suite elna-test
|
||||
import: warnings
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
other-modules:
|
||||
Language.Elna.NameAnalysisSpec
|
||||
Language.Elna.ParserSpec
|
||||
hs-source-dirs:
|
||||
tests
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
|
||||
|
||||
build-depends:
|
||||
elna:elna-internal,
|
||||
hspec >= 2.10.9 && < 2.12,
|
||||
hspec-expectations ^>= 0.8.2,
|
||||
hspec-megaparsec ^>= 2.2.0,
|
||||
text
|
||||
build-tool-depends:
|
||||
hspec-discover:hspec-discover
|
||||
154
example.elna
154
example.elna
@ -1,154 +0,0 @@
|
||||
type
|
||||
T = array 5 of Int,
|
||||
R = record
|
||||
x: Int;
|
||||
y: Int
|
||||
end,
|
||||
U = union
|
||||
a: Int;
|
||||
b: Int
|
||||
end;
|
||||
|
||||
proc test_string();
|
||||
var s: String;
|
||||
begin
|
||||
s := "Test string.";
|
||||
|
||||
writei("");
|
||||
writei(s)
|
||||
end;
|
||||
|
||||
proc test_array();
|
||||
var a: T, x: Int;
|
||||
begin
|
||||
a[0] := 2;
|
||||
a[1] := 5;
|
||||
|
||||
writei("");
|
||||
writei("Test array:");
|
||||
|
||||
x := 0;
|
||||
while x < 2 do
|
||||
writei(a[x]);
|
||||
x := x + 1
|
||||
end
|
||||
end;
|
||||
|
||||
proc test_pointer();
|
||||
var x: Int, p: pointer to Int;
|
||||
begin
|
||||
x := 5;
|
||||
p := @x;
|
||||
|
||||
writei("");
|
||||
writei("Test pointer:");
|
||||
writei(p);
|
||||
writei(p^)
|
||||
end;
|
||||
|
||||
proc test_record();
|
||||
var r: R;
|
||||
begin
|
||||
writei("");
|
||||
writei("Test record:");
|
||||
|
||||
r.x := 4;
|
||||
r.y := 8;
|
||||
|
||||
writei(r.y)
|
||||
end;
|
||||
|
||||
proc test_union();
|
||||
var u: U;
|
||||
begin
|
||||
writei("");
|
||||
writei("Test union:");
|
||||
|
||||
u.a := 9;
|
||||
|
||||
writei(u.b)
|
||||
end;
|
||||
|
||||
proc test_primitive();
|
||||
var c: Char, z: Float;
|
||||
begin
|
||||
c := 'x';
|
||||
z := 8.2;
|
||||
|
||||
writei("");
|
||||
writei("Test primitives:");
|
||||
writei(c);
|
||||
writei(z)
|
||||
end;
|
||||
|
||||
proc test_const();
|
||||
const t = 5;
|
||||
var x: Int;
|
||||
begin
|
||||
x := t;
|
||||
|
||||
writei("");
|
||||
writei("Test const:");
|
||||
writei(x)
|
||||
end;
|
||||
|
||||
proc test_if();
|
||||
var x: Bool, y: Bool;
|
||||
begin
|
||||
x := true;
|
||||
y := false;
|
||||
|
||||
writei("");
|
||||
if x and y then
|
||||
writei("Test if: True")
|
||||
else
|
||||
writei("Test if: False")
|
||||
end
|
||||
end;
|
||||
|
||||
proc test_not();
|
||||
var x: Bool;
|
||||
begin
|
||||
x := false;
|
||||
|
||||
writei("");
|
||||
if not x then
|
||||
writei("Test not true.")
|
||||
else
|
||||
writei("Test not false")
|
||||
end
|
||||
end;
|
||||
|
||||
proc test_param(d: Int, e: Int);
|
||||
begin
|
||||
writei("");
|
||||
writei("Test param");
|
||||
writei(d);
|
||||
writei(e)
|
||||
end;
|
||||
|
||||
proc test_const_char();
|
||||
const x = 'u';
|
||||
begin
|
||||
writei("");
|
||||
writei("Test constant character");
|
||||
writei(x)
|
||||
end;
|
||||
|
||||
proc exit(code: Int); extern;
|
||||
|
||||
begin
|
||||
test_primitive();
|
||||
test_string();
|
||||
test_array();
|
||||
test_pointer();
|
||||
test_record();
|
||||
test_const();
|
||||
test_if();
|
||||
test_not();
|
||||
test_param(8, 7);
|
||||
test_const_char();
|
||||
test_union();
|
||||
|
||||
exit(0)
|
||||
end.
|
||||
112
gcc/Make-lang.in
112
gcc/Make-lang.in
@ -1,112 +0,0 @@
|
||||
ELNA_INSTALL_NAME := $(shell echo gelna|sed '$(program_transform_name)')
|
||||
ELNA_TARGET_INSTALL_NAME := $(target_noncanonical)-$(shell echo gelna|sed '$(program_transform_name)')
|
||||
|
||||
elna: elna1$(exeext)
|
||||
|
||||
.PHONY: elna
|
||||
|
||||
# Driver
|
||||
|
||||
ELNA_OBJS = \
|
||||
$(GCC_OBJS) \
|
||||
elna/elna-spec.o \
|
||||
$(END)
|
||||
|
||||
gelna$(exeext): $(ELNA_OBJS) $(EXTRA_GCC_OBJS) libcommon-target.a $(LIBDEPS)
|
||||
+$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ \
|
||||
$(ELNA_OBJS) $(EXTRA_GCC_OBJS) libcommon-target.a \
|
||||
$(EXTRA_GCC_LIBS) $(LIBS)
|
||||
|
||||
# The compiler proper
|
||||
|
||||
elna_OBJS = \
|
||||
elna/elna1.o \
|
||||
elna/elna-generic.o \
|
||||
elna/elna-convert.o \
|
||||
elna/elna-diagnostic.o \
|
||||
elna/elna-tree.o \
|
||||
elna/ast.o \
|
||||
elna/driver.o \
|
||||
elna/lexer.o \
|
||||
elna/parser.o \
|
||||
elna/result.o \
|
||||
$(END)
|
||||
|
||||
elna1$(exeext): attribs.o $(elna_OBJS) $(BACKEND) $(LIBDEPS)
|
||||
+$(LLINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ \
|
||||
attribs.o $(elna_OBJS) $(BACKEND) $(LIBS) $(BACKENDLIBS)
|
||||
|
||||
elna.all.cross:
|
||||
|
||||
elna.start.encap: gelna$(exeext)
|
||||
elna.rest.encap:
|
||||
|
||||
# No elna-specific selftests.
|
||||
selftest-elna:
|
||||
|
||||
elna.install-common: installdirs
|
||||
-rm -f $(DESTDIR)$(bindir)/$(ELNA_INSTALL_NAME)$(exeext)
|
||||
$(INSTALL_PROGRAM) gelna$(exeext) $(DESTDIR)$(bindir)/$(ELNA_INSTALL_NAME)$(exeext)
|
||||
rm -f $(DESTDIR)$(bindir)/$(ELNA_TARGET_INSTALL_NAME)$(exeext); \
|
||||
( cd $(DESTDIR)$(bindir) && \
|
||||
$(LN) $(ELNA_INSTALL_NAME)$(exeext) $(ELNA_TARGET_INSTALL_NAME)$(exeext) ); \
|
||||
|
||||
# Required goals, they still do nothing
|
||||
elna.install-man:
|
||||
elna.install-info:
|
||||
elna.install-pdf:
|
||||
elna.install-plugin:
|
||||
elna.install-html:
|
||||
elna.info:
|
||||
elna.dvi:
|
||||
elna.pdf:
|
||||
elna.html:
|
||||
elna.man:
|
||||
elna.mostlyclean:
|
||||
elna.clean:
|
||||
elna.distclean:
|
||||
elna.maintainer-clean:
|
||||
|
||||
# make uninstall
|
||||
elna.uninstall:
|
||||
-rm -f gelna$(exeext) elna1$(exeext)
|
||||
-rm -f $(elna_OBJS)
|
||||
|
||||
# Used for handling bootstrap
|
||||
elna.stage1: stage1-start
|
||||
-mv elna/*$(objext) stage1/elna
|
||||
elna.stage2: stage2-start
|
||||
-mv elna/*$(objext) stage2/elna
|
||||
elna.stage3: stage3-start
|
||||
-mv elna/*$(objext) stage3/elna
|
||||
elna.stage4: stage4-start
|
||||
-mv elna/*$(objext) stage4/elna
|
||||
elna.stageprofile: stageprofile-start
|
||||
-mv elna/*$(objext) stageprofile/elna
|
||||
elna.stagefeedback: stagefeedback-start
|
||||
-mv elna/*$(objext) stagefeedback/elna
|
||||
|
||||
ELNA_INCLUDES = -I $(srcdir)/elna/include -I elna/generated
|
||||
|
||||
elna/%.o: elna/source/%.cc elna/generated/parser.hh elna/generated/location.hh
|
||||
$(COMPILE) $(ELNA_INCLUDES) $<
|
||||
$(POSTCOMPILE)
|
||||
|
||||
elna/%.o: elna/generated/%.cc elna/generated/parser.hh elna/generated/location.hh
|
||||
$(COMPILE) $(ELNA_INCLUDES) $<
|
||||
$(POSTCOMPILE)
|
||||
|
||||
elna/%.o: elna/gcc/%.cc elna/generated/parser.hh elna/generated/location.hh
|
||||
$(COMPILE) $(ELNA_INCLUDES) $<
|
||||
$(POSTCOMPILE)
|
||||
|
||||
elna/generated/parser.cc: elna/source/parser.yy
|
||||
mkdir -p $(dir $@)
|
||||
$(BISON) -d -o $@ $<
|
||||
|
||||
elna/generated/parser.hh elna/generated/location.hh: elna/generated/parser.cc
|
||||
@touch $@
|
||||
|
||||
elna/generated/lexer.cc: elna/source/lexer.ll
|
||||
mkdir -p $(dir $@)
|
||||
$(FLEX) -o $@ $<
|
||||
@ -1,13 +0,0 @@
|
||||
language="elna"
|
||||
gcc_subdir="elna/gcc"
|
||||
|
||||
compilers="elna1\$(exeext)"
|
||||
|
||||
target_libs=""
|
||||
|
||||
gtfiles="\$(srcdir)/elna/gcc/elna1.cc"
|
||||
|
||||
lang_requires_boot_languages=c++
|
||||
|
||||
# Do not build by default
|
||||
build_by_default="no"
|
||||
@ -1,14 +0,0 @@
|
||||
#include "config.h"
|
||||
#include "system.h"
|
||||
#include "coretypes.h"
|
||||
#include "tree.h"
|
||||
#include "fold-const.h"
|
||||
#include "convert.h"
|
||||
|
||||
/* Creates an expression whose value is that of EXPR, converted to type TYPE.
|
||||
This function implements all reasonable scalar conversions. */
|
||||
|
||||
tree convert(tree /* type */, tree expr)
|
||||
{
|
||||
return expr;
|
||||
}
|
||||
@ -1,61 +0,0 @@
|
||||
#include "elna/gcc/elna-diagnostic.h"
|
||||
#include "elna/gcc/elna-tree.h"
|
||||
|
||||
namespace elna
|
||||
{
|
||||
namespace gcc
|
||||
{
|
||||
location_t get_location(const elna::source::position *position)
|
||||
{
|
||||
linemap_line_start(line_table, position->line, 0);
|
||||
|
||||
return linemap_position_for_column(line_table, position->column);
|
||||
}
|
||||
|
||||
const char *print_type(tree type)
|
||||
{
|
||||
gcc_assert(TYPE_P(type));
|
||||
|
||||
if (type == integer_type_node)
|
||||
{
|
||||
return "Int";
|
||||
}
|
||||
else if (type == boolean_type_node)
|
||||
{
|
||||
return "Bool";
|
||||
}
|
||||
else if (type == double_type_node)
|
||||
{
|
||||
return "Float";
|
||||
}
|
||||
else if (type == elna_char_type_node)
|
||||
{
|
||||
return "Char";
|
||||
}
|
||||
else if (is_string_type(type))
|
||||
{
|
||||
return "String";
|
||||
}
|
||||
else if (is_pointer_type(type))
|
||||
{
|
||||
return "pointer";
|
||||
}
|
||||
else if (TREE_CODE(type) == ARRAY_TYPE)
|
||||
{
|
||||
return "array";
|
||||
}
|
||||
else if (TREE_CODE(type) == RECORD_TYPE)
|
||||
{
|
||||
return "record";
|
||||
}
|
||||
else if (TREE_CODE(type) == UNION_TYPE)
|
||||
{
|
||||
return "union";
|
||||
}
|
||||
else
|
||||
{
|
||||
return "<<unknown-type>>";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -1,859 +0,0 @@
|
||||
#include "elna/gcc/elna-generic.h"
|
||||
#include "elna/gcc/elna-diagnostic.h"
|
||||
|
||||
#include "input.h"
|
||||
#include "cgraph.h"
|
||||
#include "gimplify.h"
|
||||
#include "stringpool.h"
|
||||
#include "diagnostic.h"
|
||||
#include "realmpfr.h"
|
||||
#include "stor-layout.h"
|
||||
#include "varasm.h"
|
||||
#include <set>
|
||||
|
||||
namespace elna
|
||||
{
|
||||
namespace gcc
|
||||
{
|
||||
generic_visitor::generic_visitor(std::shared_ptr<source::symbol_table<tree>> symbol_table)
|
||||
{
|
||||
this->symbol_map = symbol_table;
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::call_expression *statement)
|
||||
{
|
||||
auto symbol = this->symbol_map->lookup(statement->name());
|
||||
|
||||
if (statement->name() == "writei")
|
||||
{
|
||||
if (statement->arguments().size() != 1)
|
||||
{
|
||||
error_at(get_location(&statement->position()),
|
||||
"procedure '%s' expects 1 argument, %lu given",
|
||||
statement->name().c_str(), statement->arguments().size());
|
||||
return;
|
||||
}
|
||||
auto& argument = statement->arguments().at(0);
|
||||
argument->accept(this);
|
||||
auto argument_type = TREE_TYPE(this->current_expression);
|
||||
|
||||
const char *format_number{ nullptr };
|
||||
if (argument_type == integer_type_node)
|
||||
{
|
||||
format_number = "%d\n";
|
||||
}
|
||||
else if (argument_type == double_type_node)
|
||||
{
|
||||
format_number = "%f\n";
|
||||
}
|
||||
else if (argument_type == elna_char_type_node)
|
||||
{
|
||||
format_number = "%c\n";
|
||||
}
|
||||
else if (is_string_type(argument_type))
|
||||
{
|
||||
format_number = "%s\n";
|
||||
}
|
||||
else if (is_pointer_type(argument_type))
|
||||
{
|
||||
format_number = "%p\n";
|
||||
}
|
||||
else
|
||||
{
|
||||
error_at(get_location(&argument->position()),
|
||||
"invalid argument of type %s for procedure %s",
|
||||
print_type(argument_type), statement->name().c_str());
|
||||
this->current_expression = error_mark_node;
|
||||
return;
|
||||
}
|
||||
tree args[] = {
|
||||
build_string_literal(strlen(format_number) + 1, format_number),
|
||||
this->current_expression
|
||||
};
|
||||
tree fndecl_type_param[] = {
|
||||
build_pointer_type(build_qualified_type(char_type_node, TYPE_QUAL_CONST)) /* const char* */
|
||||
};
|
||||
tree fndecl_type = build_varargs_function_type_array(integer_type_node, 1, fndecl_type_param);
|
||||
|
||||
tree printf_fn_decl = build_fn_decl("printf", fndecl_type);
|
||||
DECL_EXTERNAL(printf_fn_decl) = 1;
|
||||
|
||||
tree printf_fn = build1(ADDR_EXPR, build_pointer_type(fndecl_type), printf_fn_decl);
|
||||
|
||||
tree stmt = build_call_array(integer_type_node, printf_fn, 2, args);
|
||||
|
||||
append_to_statement_list(stmt, &this->current_statements);
|
||||
this->current_expression = NULL_TREE;
|
||||
}
|
||||
else if (symbol)
|
||||
{
|
||||
tree return_type = TREE_TYPE(TREE_TYPE(symbol->payload));
|
||||
tree fndecl_type = build_function_type(return_type, TYPE_ARG_TYPES(symbol->payload));
|
||||
tree printf_fn = build1(ADDR_EXPR, build_pointer_type(fndecl_type), symbol->payload);
|
||||
|
||||
std::vector<tree> arguments(statement->arguments().size());
|
||||
for (std::size_t i = 0; i < statement->arguments().size(); ++i)
|
||||
{
|
||||
statement->arguments().at(i)->accept(this);
|
||||
arguments[i] = this->current_expression;
|
||||
}
|
||||
tree stmt = build_call_array_loc(get_location(&statement->position()),
|
||||
return_type, printf_fn, arguments.size(), arguments.data());
|
||||
|
||||
if (return_type == void_type_node)
|
||||
{
|
||||
append_to_statement_list(stmt, &this->current_statements);
|
||||
this->current_expression = NULL_TREE;
|
||||
}
|
||||
else
|
||||
{
|
||||
this->current_expression = stmt;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
error_at(get_location(&statement->position()),
|
||||
"procedure '%s' not declared",
|
||||
statement->name().c_str());
|
||||
}
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::program *program)
|
||||
{
|
||||
for (const auto& constant : program->type_definitions)
|
||||
{
|
||||
constant->accept(this);
|
||||
}
|
||||
|
||||
tree parameter_types[] = {
|
||||
integer_type_node,
|
||||
build_pointer_type(build_pointer_type(char_type_node))
|
||||
};
|
||||
tree declaration_type = build_function_type_array(integer_type_node, 2, parameter_types);
|
||||
this->main_fndecl = build_fn_decl("main", declaration_type);
|
||||
tree resdecl = build_decl(UNKNOWN_LOCATION, RESULT_DECL, NULL_TREE, integer_type_node);
|
||||
DECL_CONTEXT(resdecl) = this->main_fndecl;
|
||||
DECL_RESULT(this->main_fndecl) = resdecl;
|
||||
|
||||
enter_scope();
|
||||
|
||||
for (const auto definition : program->value_definitions)
|
||||
{
|
||||
definition->accept(this);
|
||||
}
|
||||
for (const auto body_statement : program->body)
|
||||
{
|
||||
body_statement->accept(this);
|
||||
}
|
||||
tree set_result = build2(INIT_EXPR, void_type_node, DECL_RESULT(main_fndecl),
|
||||
build_int_cst_type(integer_type_node, 0));
|
||||
tree return_stmt = build1(RETURN_EXPR, void_type_node, set_result);
|
||||
append_to_statement_list(return_stmt, &this->current_statements);
|
||||
tree_symbol_mapping mapping = leave_scope();
|
||||
|
||||
BLOCK_SUPERCONTEXT(mapping.block()) = this->main_fndecl;
|
||||
DECL_INITIAL(this->main_fndecl) = mapping.block();
|
||||
DECL_SAVED_TREE(this->main_fndecl) = mapping.bind_expression();
|
||||
|
||||
DECL_EXTERNAL(this->main_fndecl) = 0;
|
||||
DECL_PRESERVE_P(this->main_fndecl) = 1;
|
||||
|
||||
gimplify_function_tree(this->main_fndecl);
|
||||
|
||||
cgraph_node::finalize_function(this->main_fndecl, true);
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::procedure_definition *definition)
|
||||
{
|
||||
std::vector<tree> parameter_types(definition->parameters.size());
|
||||
|
||||
for (std::size_t i = 0; i < definition->parameters.size(); ++i)
|
||||
{
|
||||
parameter_types[i] = build_type(definition->parameters.at(i)->type());
|
||||
}
|
||||
tree return_type = definition->return_type() == nullptr
|
||||
? void_type_node
|
||||
: build_type(*definition->return_type());
|
||||
tree declaration_type = build_function_type_array(return_type,
|
||||
definition->parameters.size(), parameter_types.data());
|
||||
this->main_fndecl = build_fn_decl(definition->identifier().c_str(), declaration_type);
|
||||
this->symbol_map->enter(definition->identifier(), source::make_info(this->main_fndecl));
|
||||
|
||||
if (definition->body() != nullptr)
|
||||
{
|
||||
tree resdecl = build_decl(UNKNOWN_LOCATION, RESULT_DECL, NULL_TREE, return_type);
|
||||
DECL_CONTEXT(resdecl) = this->main_fndecl;
|
||||
DECL_RESULT(this->main_fndecl) = resdecl;
|
||||
|
||||
enter_scope();
|
||||
}
|
||||
gcc::tree_chain argument_chain;
|
||||
for (std::size_t i = 0; i < definition->parameters.size(); ++i)
|
||||
{
|
||||
auto parameter = definition->parameters.at(i);
|
||||
|
||||
tree declaration_tree = build_decl(get_location(¶meter->position()), PARM_DECL,
|
||||
get_identifier(parameter->identifier().c_str()), parameter_types[i]);
|
||||
DECL_CONTEXT(declaration_tree) = this->main_fndecl;
|
||||
DECL_ARG_TYPE(declaration_tree) = parameter_types[i];
|
||||
|
||||
if (definition->body() != nullptr)
|
||||
{
|
||||
this->symbol_map->enter(parameter->identifier(), source::make_info(declaration_tree));
|
||||
}
|
||||
argument_chain.append(declaration_tree);
|
||||
}
|
||||
DECL_ARGUMENTS(this->main_fndecl) = argument_chain.head();
|
||||
|
||||
if (definition->body() != nullptr)
|
||||
{
|
||||
definition->body()->accept(this);
|
||||
tree_symbol_mapping mapping = leave_scope();
|
||||
|
||||
BLOCK_SUPERCONTEXT(mapping.block()) = this->main_fndecl;
|
||||
DECL_INITIAL(this->main_fndecl) = mapping.block();
|
||||
DECL_SAVED_TREE(this->main_fndecl) = mapping.bind_expression();
|
||||
|
||||
DECL_EXTERNAL(this->main_fndecl) = 0;
|
||||
DECL_PRESERVE_P(this->main_fndecl) = 1;
|
||||
|
||||
gimplify_function_tree(this->main_fndecl);
|
||||
|
||||
cgraph_node::finalize_function(this->main_fndecl, true);
|
||||
}
|
||||
else
|
||||
{
|
||||
DECL_EXTERNAL(this->main_fndecl) = 1;
|
||||
}
|
||||
}
|
||||
|
||||
void generic_visitor::enter_scope()
|
||||
{
|
||||
this->current_statements = alloc_stmt_list();
|
||||
this->variable_chain = tree_chain();
|
||||
this->symbol_map = std::make_shared<source::symbol_table<tree>>(this->symbol_map);
|
||||
}
|
||||
|
||||
tree_symbol_mapping generic_visitor::leave_scope()
|
||||
{
|
||||
tree new_block = build_block(variable_chain.head(),
|
||||
NULL_TREE, NULL_TREE, NULL_TREE);
|
||||
tree bind_expr = build3(BIND_EXPR, void_type_node, variable_chain.head(),
|
||||
this->current_statements, new_block);
|
||||
this->symbol_map = this->symbol_map->scope();
|
||||
|
||||
return tree_symbol_mapping{ bind_expr, new_block };
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::number_literal<std::int32_t> *literal)
|
||||
{
|
||||
this->current_expression = build_int_cst_type(integer_type_node, literal->number());
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::number_literal<double> *literal)
|
||||
{
|
||||
REAL_VALUE_TYPE real_value1;
|
||||
|
||||
mpfr_t number;
|
||||
mpfr_init2(number, SIGNIFICAND_BITS);
|
||||
mpfr_set_d(number, literal->number(), MPFR_RNDN);
|
||||
|
||||
real_from_mpfr(&real_value1, number, double_type_node, MPFR_RNDN);
|
||||
|
||||
this->current_expression = build_real(double_type_node, real_value1);
|
||||
|
||||
mpfr_clear(number);
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::number_literal<bool> *boolean)
|
||||
{
|
||||
this->current_expression = build_int_cst_type(boolean_type_node, boolean->number());
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::number_literal<unsigned char> *character)
|
||||
{
|
||||
this->current_expression = build_int_cstu(elna_char_type_node, character->number());
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::string_literal *string)
|
||||
{
|
||||
this->current_expression = build_string_literal(string->string().size() + 1, string->string().c_str());
|
||||
}
|
||||
|
||||
void generic_visitor::build_binary_operation(bool condition, source::binary_expression *expression,
|
||||
tree_code operator_code, tree left, tree right, tree target_type)
|
||||
{
|
||||
auto expression_location = get_location(&expression->position());
|
||||
auto left_type = TREE_TYPE(left);
|
||||
auto right_type = TREE_TYPE(right);
|
||||
|
||||
if (condition)
|
||||
{
|
||||
this->current_expression = build2_loc(expression_location,
|
||||
operator_code, target_type, left, right);
|
||||
}
|
||||
else
|
||||
{
|
||||
error_at(expression_location,
|
||||
"invalid operands of type %s and %s for operator %s",
|
||||
print_type(left_type), print_type(right_type),
|
||||
elna::source::print_binary_operator(expression->operation()));
|
||||
this->current_expression = error_mark_node;
|
||||
}
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::binary_expression *expression)
|
||||
{
|
||||
expression->lhs().accept(this);
|
||||
auto left = this->current_expression;
|
||||
auto left_type = TREE_TYPE(left);
|
||||
|
||||
expression->rhs().accept(this);
|
||||
auto right = this->current_expression;
|
||||
auto right_type = TREE_TYPE(right);
|
||||
|
||||
auto expression_location = get_location(&expression->position());
|
||||
tree_code operator_code = ERROR_MARK;
|
||||
tree target_type = error_mark_node;
|
||||
|
||||
if (left_type != right_type)
|
||||
{
|
||||
error_at(expression_location,
|
||||
"invalid operands of type %s and %s for operator %s",
|
||||
print_type(left_type), print_type(right_type),
|
||||
elna::source::print_binary_operator(expression->operation()));
|
||||
this->current_expression = error_mark_node;
|
||||
return;
|
||||
}
|
||||
switch (expression->operation())
|
||||
{
|
||||
case source::binary_operator::sum:
|
||||
operator_code = PLUS_EXPR;
|
||||
target_type = left_type;
|
||||
break;
|
||||
case source::binary_operator::subtraction:
|
||||
operator_code = MINUS_EXPR;
|
||||
target_type = left_type;
|
||||
break;
|
||||
case source::binary_operator::division:
|
||||
operator_code = TRUNC_DIV_EXPR;
|
||||
target_type = left_type;
|
||||
break;
|
||||
case source::binary_operator::multiplication:
|
||||
operator_code = MULT_EXPR;
|
||||
target_type = left_type;
|
||||
break;
|
||||
case source::binary_operator::less:
|
||||
operator_code = LT_EXPR;
|
||||
target_type = boolean_type_node;
|
||||
break;
|
||||
case source::binary_operator::greater:
|
||||
operator_code = GT_EXPR;
|
||||
target_type = boolean_type_node;
|
||||
break;
|
||||
case source::binary_operator::less_equal:
|
||||
operator_code = LE_EXPR;
|
||||
target_type = boolean_type_node;
|
||||
break;
|
||||
case source::binary_operator::greater_equal:
|
||||
operator_code = GE_EXPR;
|
||||
target_type = boolean_type_node;
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
}
|
||||
if (operator_code != ERROR_MARK) // An arithmetic operation.
|
||||
{
|
||||
build_binary_operation(left_type == integer_type_node || left_type == double_type_node,
|
||||
expression, operator_code, left, right, target_type);
|
||||
return;
|
||||
}
|
||||
switch (expression->operation())
|
||||
{
|
||||
case source::binary_operator::conjunction:
|
||||
operator_code = TRUTH_ANDIF_EXPR;
|
||||
target_type = boolean_type_node;
|
||||
break;
|
||||
case source::binary_operator::disjunction:
|
||||
operator_code = TRUTH_ORIF_EXPR;
|
||||
target_type = boolean_type_node;
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
}
|
||||
if (operator_code != ERROR_MARK) // A logical operation.
|
||||
{
|
||||
build_binary_operation(left_type == boolean_type_node,
|
||||
expression, operator_code, left, right, target_type);
|
||||
return;
|
||||
}
|
||||
switch (expression->operation())
|
||||
{
|
||||
case source::binary_operator::equals:
|
||||
operator_code = EQ_EXPR;
|
||||
target_type = boolean_type_node;
|
||||
break;
|
||||
case source::binary_operator::not_equals:
|
||||
operator_code = NE_EXPR;
|
||||
target_type = boolean_type_node;
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
}
|
||||
gcc_assert(operator_code != ERROR_MARK);
|
||||
gcc_assert(target_type != error_mark_node);
|
||||
|
||||
this->current_expression = build2_loc(expression_location,
|
||||
operator_code, target_type, left, right);
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::unary_expression *expression)
|
||||
{
|
||||
expression->operand().accept(this);
|
||||
|
||||
switch (expression->operation())
|
||||
{
|
||||
case source::unary_operator::reference:
|
||||
this->current_expression = build1_loc(get_location(&expression->position()), ADDR_EXPR,
|
||||
build_pointer_type_for_mode(TREE_TYPE(this->current_expression), VOIDmode, true),
|
||||
this->current_expression);
|
||||
break;
|
||||
case source::unary_operator::negation:
|
||||
this->current_expression = build1_loc(get_location(&expression->position()), TRUTH_NOT_EXPR,
|
||||
boolean_type_node, this->current_expression);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::constant_definition *definition)
|
||||
{
|
||||
location_t definition_location = get_location(&definition->position());
|
||||
definition->body().accept(this);
|
||||
|
||||
tree definition_tree = build_decl(definition_location, CONST_DECL,
|
||||
get_identifier(definition->identifier().c_str()), TREE_TYPE(this->current_expression));
|
||||
auto result = this->symbol_map->enter(definition->identifier(), source::make_info(definition_tree));
|
||||
|
||||
if (result)
|
||||
{
|
||||
DECL_INITIAL(definition_tree) = this->current_expression;
|
||||
TREE_CONSTANT(definition_tree) = 1;
|
||||
TREE_READONLY(definition_tree) = 1;
|
||||
|
||||
auto declaration_statement = build1_loc(definition_location, DECL_EXPR,
|
||||
void_type_node, definition_tree);
|
||||
append_to_statement_list(declaration_statement, &this->current_statements);
|
||||
}
|
||||
else
|
||||
{
|
||||
error_at(definition_location,
|
||||
"variable '%s' already declared in this scope",
|
||||
definition->identifier().c_str());
|
||||
}
|
||||
this->current_expression = NULL_TREE;
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::type_definition *definition)
|
||||
{
|
||||
tree tree_type = build_type(definition->body());
|
||||
|
||||
if (tree_type == NULL_TREE)
|
||||
{
|
||||
return;
|
||||
}
|
||||
location_t definition_location = get_location(&definition->position());
|
||||
tree definition_tree = build_decl(definition_location, TYPE_DECL,
|
||||
get_identifier(definition->identifier().c_str()), tree_type);
|
||||
auto result = this->symbol_map->enter(definition->identifier(), source::make_info(tree_type));
|
||||
|
||||
if (result)
|
||||
{
|
||||
DECL_CONTEXT(definition_tree) = this->main_fndecl;
|
||||
variable_chain.append(definition_tree);
|
||||
|
||||
auto declaration_statement = build1_loc(definition_location, DECL_EXPR,
|
||||
void_type_node, definition_tree);
|
||||
append_to_statement_list(declaration_statement, &this->current_statements);
|
||||
}
|
||||
else
|
||||
{
|
||||
error_at(definition_location,
|
||||
"type '%s' already declared in this scope",
|
||||
definition->identifier().c_str());
|
||||
}
|
||||
}
|
||||
|
||||
tree generic_visitor::build_type(source::type_expression& type)
|
||||
{
|
||||
if (source::basic_type_expression *basic_type = type.is_basic())
|
||||
{
|
||||
auto symbol = this->symbol_map->lookup(basic_type->base_name());
|
||||
|
||||
if (symbol && TYPE_P(symbol->payload))
|
||||
{
|
||||
return symbol->payload;
|
||||
}
|
||||
error_at(get_location(&basic_type->position()),
|
||||
"type '%s' not declared", basic_type->base_name().c_str());
|
||||
|
||||
return error_mark_node;
|
||||
}
|
||||
else if (source::array_type_expression *array_type = type.is_array())
|
||||
{
|
||||
tree lower_bound = build_int_cst_type(integer_type_node, 0);
|
||||
tree upper_bound = build_int_cst_type(integer_type_node, array_type->size);
|
||||
tree base_type = build_type(array_type->base());
|
||||
|
||||
if (base_type == NULL_TREE || base_type == error_mark_node)
|
||||
{
|
||||
return base_type;
|
||||
}
|
||||
tree range_type = build_range_type(integer_type_node, lower_bound, upper_bound);
|
||||
|
||||
return build_array_type(base_type, range_type);
|
||||
}
|
||||
else if (source::pointer_type_expression *pointer_type = type.is_pointer())
|
||||
{
|
||||
tree base_type = build_type(pointer_type->base());
|
||||
|
||||
if (base_type == NULL_TREE || base_type == error_mark_node)
|
||||
{
|
||||
return base_type;
|
||||
}
|
||||
return build_pointer_type_for_mode(base_type, VOIDmode, true);
|
||||
}
|
||||
else if (source::record_type_expression *record_type = type.is_record())
|
||||
{
|
||||
std::set<std::string> field_names;
|
||||
tree record_type_node = make_node(RECORD_TYPE);
|
||||
tree_chain record_chain;
|
||||
|
||||
for (auto& field : record_type->fields)
|
||||
{
|
||||
if (field_names.find(field.first) != field_names.cend())
|
||||
{
|
||||
error_at(get_location(&field.second->position()), "repeated field name");
|
||||
return error_mark_node;
|
||||
}
|
||||
field_names.insert(field.first);
|
||||
|
||||
tree field_type = build_type(*field.second);
|
||||
if (field_type == NULL_TREE || field_type == error_mark_node)
|
||||
{
|
||||
return field_type;
|
||||
}
|
||||
tree field_declaration = build_decl(get_location(&field.second->position()),
|
||||
FIELD_DECL, get_identifier(field.first.c_str()), field_type);
|
||||
TREE_ADDRESSABLE(field_declaration) = 1;
|
||||
DECL_CONTEXT(field_declaration) = record_type_node;
|
||||
|
||||
record_chain.append(field_declaration);
|
||||
}
|
||||
TYPE_FIELDS(record_type_node) = record_chain.head();
|
||||
layout_type(record_type_node);
|
||||
|
||||
return record_type_node;
|
||||
}
|
||||
else if (source::union_type_expression *union_type = type.is_union())
|
||||
{
|
||||
std::set<std::string> field_names;
|
||||
tree union_type_node = make_node(UNION_TYPE);
|
||||
tree_chain union_chain;
|
||||
|
||||
for (auto& field : union_type->fields)
|
||||
{
|
||||
if (field_names.find(field.first) != field_names.cend())
|
||||
{
|
||||
error_at(get_location(&field.second->position()), "repeated field name");
|
||||
return error_mark_node;
|
||||
}
|
||||
field_names.insert(field.first);
|
||||
|
||||
tree field_type = build_type(*field.second);
|
||||
if (field_type == NULL_TREE || field_type == error_mark_node)
|
||||
{
|
||||
return field_type;
|
||||
}
|
||||
tree field_declaration = build_decl(get_location(&field.second->position()),
|
||||
FIELD_DECL, get_identifier(field.first.c_str()), field_type);
|
||||
TREE_ADDRESSABLE(field_declaration) = 1;
|
||||
DECL_CONTEXT(field_declaration) = union_type_node;
|
||||
|
||||
union_chain.append(field_declaration);
|
||||
}
|
||||
TYPE_FIELDS(union_type_node) = union_chain.head();
|
||||
layout_type(union_type_node);
|
||||
|
||||
return union_type_node;
|
||||
}
|
||||
return NULL_TREE;
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::variable_declaration *declaration)
|
||||
{
|
||||
tree declaration_type = build_type(declaration->type());
|
||||
gcc_assert(declaration_type != NULL_TREE);
|
||||
|
||||
auto declaration_location = get_location(&declaration->position());
|
||||
tree declaration_tree = build_decl(declaration_location, VAR_DECL,
|
||||
get_identifier(declaration->identifier().c_str()), declaration_type);
|
||||
auto result = this->symbol_map->enter(declaration->identifier(), source::make_info(declaration_tree));
|
||||
|
||||
if (result)
|
||||
{
|
||||
DECL_CONTEXT(declaration_tree) = this->main_fndecl;
|
||||
variable_chain.append(declaration_tree);
|
||||
|
||||
auto declaration_statement = build1_loc(declaration_location, DECL_EXPR,
|
||||
void_type_node, declaration_tree);
|
||||
append_to_statement_list(declaration_statement, &this->current_statements);
|
||||
}
|
||||
else
|
||||
{
|
||||
error_at(declaration_location,
|
||||
"variable '%s' already declared in this scope",
|
||||
declaration->identifier().c_str());
|
||||
}
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::variable_expression *expression)
|
||||
{
|
||||
auto symbol = this->symbol_map->lookup(expression->name());
|
||||
|
||||
if (!symbol)
|
||||
{
|
||||
error_at(get_location(&expression->position()),
|
||||
"variable '%s' not declared in the current scope",
|
||||
expression->name().c_str());
|
||||
this->current_expression = error_mark_node;
|
||||
return;
|
||||
}
|
||||
this->current_expression = symbol->payload;
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::array_access_expression *expression)
|
||||
{
|
||||
expression->base().accept(this);
|
||||
tree designator = this->current_expression;
|
||||
|
||||
expression->index().accept(this);
|
||||
tree index = this->current_expression;
|
||||
|
||||
tree element_type = TREE_TYPE(TREE_TYPE(designator));
|
||||
|
||||
this->current_expression = build4_loc(get_location(&expression->position()),
|
||||
ARRAY_REF, element_type, designator, index, NULL_TREE, NULL_TREE);
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::field_access_expression *expression)
|
||||
{
|
||||
expression->base().accept(this);
|
||||
tree field_declaration = TYPE_FIELDS(TREE_TYPE(this->current_expression));
|
||||
|
||||
while (field_declaration != NULL_TREE)
|
||||
{
|
||||
tree declaration_name = DECL_NAME(field_declaration);
|
||||
const char *identifier_pointer = IDENTIFIER_POINTER(declaration_name);
|
||||
|
||||
if (expression->field() == identifier_pointer)
|
||||
{
|
||||
break;
|
||||
}
|
||||
field_declaration = TREE_CHAIN(field_declaration);
|
||||
}
|
||||
location_t expression_location = get_location(&expression->position());
|
||||
if (field_declaration == NULL_TREE)
|
||||
{
|
||||
error_at(expression_location,
|
||||
"record type does not have a field named '%s'",
|
||||
expression->field().c_str());
|
||||
this->current_expression = error_mark_node;
|
||||
}
|
||||
else
|
||||
{
|
||||
this->current_expression = build3_loc(expression_location, COMPONENT_REF,
|
||||
TREE_TYPE(field_declaration), this->current_expression,
|
||||
field_declaration, NULL_TREE);
|
||||
}
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::dereference_expression *expression)
|
||||
{
|
||||
expression->base().accept(this);
|
||||
|
||||
this->current_expression = build1_loc(get_location(&expression->position()), INDIRECT_REF,
|
||||
TREE_TYPE(TREE_TYPE(this->current_expression)), this->current_expression);
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::assign_statement *statement)
|
||||
{
|
||||
statement->lvalue().accept(this);
|
||||
|
||||
auto lvalue = this->current_expression;
|
||||
auto statement_location = get_location(&statement->position());
|
||||
|
||||
statement->rvalue().accept(this);
|
||||
|
||||
if (TREE_CODE(lvalue) == CONST_DECL)
|
||||
{
|
||||
error_at(statement_location, "cannot modify constant '%s'",
|
||||
statement->lvalue().is_variable()->name().c_str());
|
||||
this->current_expression = error_mark_node;
|
||||
return;
|
||||
}
|
||||
if (TREE_TYPE(this->current_expression) != TREE_TYPE(lvalue))
|
||||
{
|
||||
error_at(statement_location,
|
||||
"cannot assign value of type %s to variable of type %s",
|
||||
print_type(TREE_TYPE(this->current_expression)),
|
||||
print_type(TREE_TYPE(lvalue)));
|
||||
this->current_expression = error_mark_node;
|
||||
return;
|
||||
}
|
||||
auto assignment = build2_loc(statement_location, MODIFY_EXPR,
|
||||
void_type_node, lvalue, this->current_expression);
|
||||
|
||||
append_to_statement_list(assignment, &this->current_statements);
|
||||
this->current_expression = NULL_TREE;
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::if_statement *statement)
|
||||
{
|
||||
statement->prerequisite().accept(this);
|
||||
|
||||
if (TREE_TYPE(this->current_expression) != boolean_type_node)
|
||||
{
|
||||
error_at(get_location(&statement->prerequisite().position()),
|
||||
"expected expression of boolean type but its type is %s",
|
||||
print_type(TREE_TYPE(this->current_expression)));
|
||||
this->current_expression = error_mark_node;
|
||||
return;
|
||||
}
|
||||
auto then_location = get_location(&statement->body().position());
|
||||
auto prerequisite_location = get_location(&statement->prerequisite().position());
|
||||
|
||||
auto then_label_decl = build_label_decl("then", then_location);
|
||||
auto endif_label_decl = build_label_decl("end_if", then_location);
|
||||
|
||||
auto goto_then = build1_loc(prerequisite_location, GOTO_EXPR,
|
||||
void_type_node, then_label_decl);
|
||||
auto goto_endif = build1_loc(prerequisite_location, GOTO_EXPR,
|
||||
void_type_node, endif_label_decl);
|
||||
|
||||
tree else_label_decl = NULL_TREE;
|
||||
tree goto_else_or_endif = NULL_TREE;
|
||||
if (statement->alternative() != nullptr)
|
||||
{
|
||||
auto else_location = get_location(&statement->alternative()->position());
|
||||
else_label_decl = build_label_decl("else", else_location);
|
||||
goto_else_or_endif = build1_loc(else_location, GOTO_EXPR, void_type_node, else_label_decl);
|
||||
}
|
||||
else
|
||||
{
|
||||
goto_else_or_endif = goto_endif;
|
||||
}
|
||||
|
||||
auto cond_expr = build3_loc(prerequisite_location, COND_EXPR,
|
||||
void_type_node, this->current_expression, goto_then, goto_else_or_endif);
|
||||
append_to_statement_list(cond_expr, &this->current_statements);
|
||||
|
||||
auto then_label_expr = build1_loc(then_location, LABEL_EXPR,
|
||||
void_type_node, then_label_decl);
|
||||
append_to_statement_list(then_label_expr, &this->current_statements);
|
||||
|
||||
statement->body().accept(this);
|
||||
|
||||
if (statement->alternative() != nullptr)
|
||||
{
|
||||
append_to_statement_list(goto_endif, &this->current_statements);
|
||||
|
||||
auto else_label_expr = build1(LABEL_EXPR, void_type_node, else_label_decl);
|
||||
append_to_statement_list(else_label_expr, &this->current_statements);
|
||||
|
||||
statement->alternative()->accept(this);
|
||||
}
|
||||
auto endif_label_expr = build1(LABEL_EXPR, void_type_node, endif_label_decl);
|
||||
append_to_statement_list(endif_label_expr, &this->current_statements);
|
||||
|
||||
this->current_expression = NULL_TREE;
|
||||
}
|
||||
|
||||
tree generic_visitor::build_label_decl(const char *name, location_t loc)
|
||||
{
|
||||
auto label_decl = build_decl(loc,
|
||||
LABEL_DECL, get_identifier(name), void_type_node);
|
||||
|
||||
DECL_CONTEXT(label_decl) = this->main_fndecl;
|
||||
|
||||
return label_decl;
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::while_statement *statement)
|
||||
{
|
||||
statement->prerequisite().accept(this);
|
||||
|
||||
if (TREE_TYPE(this->current_expression) != boolean_type_node)
|
||||
{
|
||||
error_at(get_location(&statement->prerequisite().position()),
|
||||
"expected expression of boolean type but its type is %s",
|
||||
print_type(TREE_TYPE(this->current_expression)));
|
||||
this->current_expression = error_mark_node;
|
||||
return;
|
||||
}
|
||||
auto prerequisite_location = get_location(&statement->prerequisite().position());
|
||||
auto body_location = get_location(&statement->body().position());
|
||||
|
||||
auto prerequisite_label_decl = build_label_decl("while_check", prerequisite_location);
|
||||
auto prerequisite_label_expr = build1_loc(prerequisite_location, LABEL_EXPR,
|
||||
void_type_node, prerequisite_label_decl);
|
||||
append_to_statement_list(prerequisite_label_expr, &this->current_statements);
|
||||
|
||||
auto body_label_decl = build_label_decl("while_body", body_location);
|
||||
auto end_label_decl = build_label_decl("end_while", UNKNOWN_LOCATION);
|
||||
|
||||
auto goto_body = build1_loc(prerequisite_location, GOTO_EXPR,
|
||||
void_type_node, body_label_decl);
|
||||
auto goto_end = build1_loc(prerequisite_location, GOTO_EXPR,
|
||||
void_type_node, end_label_decl);
|
||||
|
||||
auto cond_expr = build3_loc(prerequisite_location, COND_EXPR,
|
||||
void_type_node, this->current_expression, goto_body, goto_end);
|
||||
append_to_statement_list(cond_expr, &this->current_statements);
|
||||
|
||||
auto body_label_expr = build1_loc(body_location, LABEL_EXPR,
|
||||
void_type_node, body_label_decl);
|
||||
append_to_statement_list(body_label_expr, &this->current_statements);
|
||||
|
||||
statement->body().accept(this);
|
||||
|
||||
auto goto_check = build1(GOTO_EXPR, void_type_node, prerequisite_label_decl);
|
||||
append_to_statement_list(goto_check, &this->current_statements);
|
||||
|
||||
auto endif_label_expr = build1(LABEL_EXPR, void_type_node, end_label_decl);
|
||||
append_to_statement_list(endif_label_expr, &this->current_statements);
|
||||
|
||||
this->current_expression = NULL_TREE;
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::expression_statement *statement)
|
||||
{
|
||||
statement->body().accept(this);
|
||||
}
|
||||
|
||||
void generic_visitor::visit(source::return_statement *statement)
|
||||
{
|
||||
source::expression *return_expression = statement->return_expression();
|
||||
|
||||
if (return_expression == nullptr)
|
||||
{
|
||||
return;
|
||||
}
|
||||
return_expression->accept(this);
|
||||
|
||||
tree set_result = build2(INIT_EXPR, void_type_node, DECL_RESULT(main_fndecl),
|
||||
this->current_expression);
|
||||
tree return_stmt = build1(RETURN_EXPR, void_type_node, set_result);
|
||||
append_to_statement_list(return_stmt, &this->current_statements);
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -1,16 +0,0 @@
|
||||
void
|
||||
lang_specific_driver (struct cl_decoded_option ** /* in_decoded_options */,
|
||||
unsigned int * /* in_decoded_options_count */,
|
||||
int * /*in_added_libraries */)
|
||||
{
|
||||
}
|
||||
|
||||
/* Called before linking. Returns 0 on success and -1 on failure. */
|
||||
int
|
||||
lang_specific_pre_link (void)
|
||||
{
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Number of extra output files that lang_specific_pre_link may generate. */
|
||||
int lang_specific_extra_outfiles = 0;
|
||||
@ -1,85 +0,0 @@
|
||||
#include "elna/gcc/elna-tree.h"
|
||||
|
||||
#include "stor-layout.h"
|
||||
|
||||
tree elna_global_trees[ELNA_TI_MAX];
|
||||
|
||||
namespace elna
|
||||
{
|
||||
namespace gcc
|
||||
{
|
||||
void init_ttree()
|
||||
{
|
||||
elna_char_type_node = make_unsigned_type(8);
|
||||
elna_string_type_node = build_pointer_type(
|
||||
build_qualified_type(char_type_node, TYPE_QUAL_CONST)); /* const char* */
|
||||
TYPE_STRING_FLAG(elna_char_type_node) = 1;
|
||||
}
|
||||
|
||||
bool is_pointer_type(tree type)
|
||||
{
|
||||
gcc_assert(TYPE_P(type));
|
||||
return TREE_CODE(type) == POINTER_TYPE;
|
||||
}
|
||||
|
||||
bool is_string_type(tree type)
|
||||
{
|
||||
return is_pointer_type(type)
|
||||
&& TYPE_MAIN_VARIANT(TREE_TYPE(type)) == char_type_node;
|
||||
}
|
||||
|
||||
tree tree_chain_base::head()
|
||||
{
|
||||
return first;
|
||||
}
|
||||
|
||||
void tree_chain_base::append(tree t)
|
||||
{
|
||||
gcc_assert(t != NULL_TREE);
|
||||
|
||||
if (this->first == NULL_TREE)
|
||||
{
|
||||
this->first = this->last = t;
|
||||
}
|
||||
else
|
||||
{
|
||||
chain(t);
|
||||
this->last = t;
|
||||
}
|
||||
}
|
||||
|
||||
void tree_chain::chain(tree t)
|
||||
{
|
||||
TREE_CHAIN(this->last) = t;
|
||||
}
|
||||
|
||||
tree_symbol_mapping::tree_symbol_mapping(tree bind_expression, tree block)
|
||||
: m_bind_expression(bind_expression), m_block(block)
|
||||
{
|
||||
}
|
||||
|
||||
tree tree_symbol_mapping::bind_expression()
|
||||
{
|
||||
return m_bind_expression;
|
||||
}
|
||||
|
||||
tree tree_symbol_mapping::block()
|
||||
{
|
||||
return m_block;
|
||||
}
|
||||
|
||||
std::shared_ptr<elna::source::symbol_table<tree>> builtin_symbol_table()
|
||||
{
|
||||
std::shared_ptr<elna::source::symbol_table<tree>> initial_table =
|
||||
std::make_shared<elna::source::symbol_table<tree>>();
|
||||
|
||||
initial_table->enter("Int", source::make_info(integer_type_node));
|
||||
initial_table->enter("Bool", source::make_info(boolean_type_node));
|
||||
initial_table->enter("Float", source::make_info(double_type_node));
|
||||
initial_table->enter("Char", source::make_info(elna_char_type_node));
|
||||
initial_table->enter("String", source::make_info(elna_string_type_node));
|
||||
|
||||
return initial_table;
|
||||
}
|
||||
}
|
||||
}
|
||||
243
gcc/elna1.cc
243
gcc/elna1.cc
@ -1,243 +0,0 @@
|
||||
#include "config.h"
|
||||
#include "system.h"
|
||||
#include "coretypes.h"
|
||||
#include "target.h"
|
||||
#include "tree.h"
|
||||
#include "tree-iterator.h"
|
||||
#include "gimple-expr.h"
|
||||
#include "diagnostic.h"
|
||||
#include "opts.h"
|
||||
#include "fold-const.h"
|
||||
#include "stor-layout.h"
|
||||
#include "debug.h"
|
||||
#include "langhooks.h"
|
||||
#include "langhooks-def.h"
|
||||
#include "common/common-target.h"
|
||||
|
||||
#include <fstream>
|
||||
#include <elna/source/driver.h>
|
||||
#include "elna/gcc/elna-tree.h"
|
||||
#include "elna/gcc/elna-generic.h"
|
||||
#include "elna/gcc/elna-diagnostic.h"
|
||||
#include "parser.hh"
|
||||
|
||||
/* Language-dependent contents of a type. */
|
||||
|
||||
struct GTY (()) lang_type
|
||||
{
|
||||
char dummy;
|
||||
};
|
||||
|
||||
/* Language-dependent contents of a decl. */
|
||||
|
||||
struct GTY (()) lang_decl
|
||||
{
|
||||
char dummy;
|
||||
};
|
||||
|
||||
/* Language-dependent contents of an identifier. This must include a
|
||||
tree_identifier. */
|
||||
|
||||
struct GTY (()) lang_identifier
|
||||
{
|
||||
struct tree_identifier common;
|
||||
};
|
||||
|
||||
/* The resulting tree type. */
|
||||
|
||||
union GTY ((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
|
||||
chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), "
|
||||
"TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN "
|
||||
"(&%h.generic)) : NULL"))) lang_tree_node
|
||||
{
|
||||
union tree_node GTY ((tag ("0"), desc ("tree_node_structure (&%h)"))) generic;
|
||||
struct lang_identifier GTY ((tag ("1"))) identifier;
|
||||
};
|
||||
|
||||
/* We don't use language_function. */
|
||||
|
||||
struct GTY (()) language_function
|
||||
{
|
||||
int dummy;
|
||||
};
|
||||
|
||||
/* Language hooks. */
|
||||
|
||||
static bool elna_langhook_init(void)
|
||||
{
|
||||
build_common_tree_nodes(false);
|
||||
elna::gcc::init_ttree();
|
||||
|
||||
void_list_node = build_tree_list(NULL_TREE, void_type_node);
|
||||
|
||||
build_common_builtin_nodes();
|
||||
|
||||
return true;
|
||||
}
|
||||
|
||||
static void elna_parse_file(const char *filename)
|
||||
{
|
||||
std::ifstream file{ filename, std::ios::in };
|
||||
|
||||
if (!file)
|
||||
{
|
||||
fatal_error(UNKNOWN_LOCATION, "cannot open filename %s: %m", filename);
|
||||
}
|
||||
|
||||
elna::source::driver driver{ filename };
|
||||
elna::source::lexer lexer(file);
|
||||
yy::parser parser(lexer, driver);
|
||||
|
||||
linemap_add(line_table, LC_ENTER, 0, filename, 1);
|
||||
if (parser())
|
||||
{
|
||||
for (const auto& error : driver.errors())
|
||||
{
|
||||
auto gcc_location = elna::gcc::get_location(&error->position);
|
||||
|
||||
error_at(gcc_location, error->what().c_str());
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
elna::gcc::generic_visitor generic_visitor{ elna::gcc::builtin_symbol_table() };
|
||||
|
||||
generic_visitor.visit(driver.tree.get());
|
||||
}
|
||||
linemap_add(line_table, LC_LEAVE, 0, NULL, 0);
|
||||
}
|
||||
|
||||
static void elna_langhook_parse_file(void)
|
||||
{
|
||||
for (unsigned int i = 0; i < num_in_fnames; i++)
|
||||
{
|
||||
elna_parse_file(in_fnames[i]);
|
||||
}
|
||||
}
|
||||
|
||||
static tree elna_langhook_type_for_mode(enum machine_mode mode, int unsignedp)
|
||||
{
|
||||
if (mode == TYPE_MODE(float_type_node))
|
||||
{
|
||||
return float_type_node;
|
||||
}
|
||||
else if (mode == TYPE_MODE(double_type_node))
|
||||
{
|
||||
return double_type_node;
|
||||
}
|
||||
if (mode == TYPE_MODE(intQI_type_node))
|
||||
{
|
||||
return unsignedp ? unsigned_intQI_type_node : intQI_type_node;
|
||||
}
|
||||
else if (mode == TYPE_MODE(intHI_type_node))
|
||||
{
|
||||
return unsignedp ? unsigned_intHI_type_node : intHI_type_node;
|
||||
}
|
||||
else if (mode == TYPE_MODE(intSI_type_node))
|
||||
{
|
||||
return unsignedp ? unsigned_intSI_type_node : intSI_type_node;
|
||||
}
|
||||
else if (mode == TYPE_MODE(intDI_type_node))
|
||||
{
|
||||
return unsignedp ? unsigned_intDI_type_node : intDI_type_node;
|
||||
}
|
||||
else if (mode == TYPE_MODE(intTI_type_node))
|
||||
{
|
||||
return unsignedp ? unsigned_intTI_type_node : intTI_type_node;
|
||||
}
|
||||
else if (mode == TYPE_MODE(integer_type_node))
|
||||
{
|
||||
return unsignedp ? unsigned_type_node : integer_type_node;
|
||||
}
|
||||
else if (mode == TYPE_MODE(long_integer_type_node))
|
||||
{
|
||||
return unsignedp ? long_unsigned_type_node : long_integer_type_node;
|
||||
}
|
||||
else if (mode == TYPE_MODE(long_long_integer_type_node))
|
||||
{
|
||||
return unsignedp
|
||||
? long_long_unsigned_type_node
|
||||
: long_long_integer_type_node;
|
||||
}
|
||||
if (COMPLEX_MODE_P(mode))
|
||||
{
|
||||
if (mode == TYPE_MODE(complex_float_type_node))
|
||||
{
|
||||
return complex_float_type_node;
|
||||
}
|
||||
if (mode == TYPE_MODE(complex_double_type_node))
|
||||
{
|
||||
return complex_double_type_node;
|
||||
}
|
||||
if (mode == TYPE_MODE(complex_long_double_type_node))
|
||||
{
|
||||
return complex_long_double_type_node;
|
||||
}
|
||||
if (mode == TYPE_MODE(complex_integer_type_node) && !unsignedp)
|
||||
{
|
||||
return complex_integer_type_node;
|
||||
}
|
||||
}
|
||||
/* gcc_unreachable */
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
static tree elna_langhook_type_for_size(unsigned int bits ATTRIBUTE_UNUSED,
|
||||
int unsignedp ATTRIBUTE_UNUSED)
|
||||
{
|
||||
gcc_unreachable();
|
||||
}
|
||||
|
||||
/* Record a builtin function. We just ignore builtin functions. */
|
||||
|
||||
static tree elna_langhook_builtin_function(tree decl)
|
||||
{
|
||||
return decl;
|
||||
}
|
||||
|
||||
static bool elna_langhook_global_bindings_p(void)
|
||||
{
|
||||
return false;
|
||||
}
|
||||
|
||||
static tree elna_langhook_pushdecl(tree decl ATTRIBUTE_UNUSED)
|
||||
{
|
||||
gcc_unreachable();
|
||||
}
|
||||
|
||||
static tree elna_langhook_getdecls(void)
|
||||
{
|
||||
return NULL;
|
||||
}
|
||||
|
||||
#undef LANG_HOOKS_NAME
|
||||
#define LANG_HOOKS_NAME "Elna"
|
||||
|
||||
#undef LANG_HOOKS_INIT
|
||||
#define LANG_HOOKS_INIT elna_langhook_init
|
||||
|
||||
#undef LANG_HOOKS_PARSE_FILE
|
||||
#define LANG_HOOKS_PARSE_FILE elna_langhook_parse_file
|
||||
|
||||
#undef LANG_HOOKS_TYPE_FOR_MODE
|
||||
#define LANG_HOOKS_TYPE_FOR_MODE elna_langhook_type_for_mode
|
||||
|
||||
#undef LANG_HOOKS_TYPE_FOR_SIZE
|
||||
#define LANG_HOOKS_TYPE_FOR_SIZE elna_langhook_type_for_size
|
||||
|
||||
#undef LANG_HOOKS_BUILTIN_FUNCTION
|
||||
#define LANG_HOOKS_BUILTIN_FUNCTION elna_langhook_builtin_function
|
||||
|
||||
#undef LANG_HOOKS_GLOBAL_BINDINGS_P
|
||||
#define LANG_HOOKS_GLOBAL_BINDINGS_P elna_langhook_global_bindings_p
|
||||
|
||||
#undef LANG_HOOKS_PUSHDECL
|
||||
#define LANG_HOOKS_PUSHDECL elna_langhook_pushdecl
|
||||
|
||||
#undef LANG_HOOKS_GETDECLS
|
||||
#define LANG_HOOKS_GETDECLS elna_langhook_getdecls
|
||||
|
||||
struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
|
||||
|
||||
#include "gt-elna-elna1.h"
|
||||
#include "gtype-elna.h"
|
||||
@ -1,6 +0,0 @@
|
||||
/* gcc/gcc.cc */
|
||||
{".elna", "@elna", nullptr, 0, 0},
|
||||
{"@elna",
|
||||
"elna1 %{!Q:-quiet} \
|
||||
%i %{!fsyntax-only:%(invoke_as)}",
|
||||
nullptr, 0, 0},
|
||||
@ -1,19 +0,0 @@
|
||||
#pragma once
|
||||
|
||||
#include "config.h"
|
||||
#include "system.h"
|
||||
#include "coretypes.h"
|
||||
#include "input.h"
|
||||
#include "tree.h"
|
||||
|
||||
#include "elna/source/result.h"
|
||||
|
||||
namespace elna
|
||||
{
|
||||
namespace gcc
|
||||
{
|
||||
location_t get_location(const elna::source::position *position);
|
||||
|
||||
const char *print_type(tree type);
|
||||
}
|
||||
}
|
||||
@ -1,64 +0,0 @@
|
||||
#pragma once
|
||||
|
||||
#include "elna/source/ast.h"
|
||||
#include "elna/source/symbol.h"
|
||||
#include "elna/gcc/elna-tree.h"
|
||||
|
||||
#include "config.h"
|
||||
#include "system.h"
|
||||
#include "coretypes.h"
|
||||
#include "tree.h"
|
||||
#include "tree-iterator.h"
|
||||
|
||||
#include <unordered_map>
|
||||
#include <string>
|
||||
|
||||
namespace elna
|
||||
{
|
||||
namespace gcc
|
||||
{
|
||||
class generic_visitor final : public source::empty_visitor
|
||||
{
|
||||
tree current_statements{ NULL_TREE };
|
||||
tree current_expression{ NULL_TREE };
|
||||
std::shared_ptr<source::symbol_table<tree>> symbol_map;
|
||||
tree main_fndecl{ NULL_TREE };
|
||||
tree_chain variable_chain;
|
||||
|
||||
tree build_label_decl(const char *name, location_t loc);
|
||||
tree build_type(source::type_expression& type);
|
||||
|
||||
void enter_scope();
|
||||
tree_symbol_mapping leave_scope();
|
||||
|
||||
void build_binary_operation(bool condition, source::binary_expression *expression,
|
||||
tree_code operator_code, tree left, tree right, tree target_type);
|
||||
|
||||
public:
|
||||
generic_visitor(std::shared_ptr<source::symbol_table<tree>> symbol_table);
|
||||
|
||||
void visit(source::program *program) override;
|
||||
void visit(source::procedure_definition *definition) override;
|
||||
void visit(source::call_expression *statement) override;
|
||||
void visit(source::number_literal<std::int32_t> *literal) override;
|
||||
void visit(source::number_literal<double> *literal) override;
|
||||
void visit(source::number_literal<bool> *boolean) override;
|
||||
void visit(source::number_literal<unsigned char> *character) override;
|
||||
void visit(source::string_literal *string) override;
|
||||
void visit(source::binary_expression *expression) override;
|
||||
void visit(source::unary_expression *expression) override;
|
||||
void visit(source::constant_definition *definition) override;
|
||||
void visit(source::type_definition *definition) override;
|
||||
void visit(source::variable_declaration *declaration) override;
|
||||
void visit(source::variable_expression *expression) override;
|
||||
void visit(source::array_access_expression *expression) override;
|
||||
void visit(source::field_access_expression *expression) override;
|
||||
void visit(source::dereference_expression *expression) override;
|
||||
void visit(source::assign_statement *statement) override;
|
||||
void visit(source::if_statement *statement) override;
|
||||
void visit(source::while_statement *statement) override;
|
||||
void visit(source::expression_statement *statement) override;
|
||||
void visit(source::return_statement *statement) override;
|
||||
};
|
||||
}
|
||||
}
|
||||
@ -1,64 +0,0 @@
|
||||
#pragma once
|
||||
|
||||
#include "config.h"
|
||||
#include "system.h"
|
||||
#include "coretypes.h"
|
||||
#include "tree.h"
|
||||
#include "tree.h"
|
||||
|
||||
#include "elna/source/symbol.h"
|
||||
|
||||
enum elna_tree_index
|
||||
{
|
||||
ELNA_TI_CHAR_TYPE,
|
||||
ELNA_TI_STRING_TYPE,
|
||||
ELNA_TI_MAX
|
||||
};
|
||||
|
||||
extern GTY(()) tree elna_global_trees[ELNA_TI_MAX];
|
||||
|
||||
#define elna_char_type_node elna_global_trees[ELNA_TI_CHAR_TYPE]
|
||||
#define elna_string_type_node elna_global_trees[ELNA_TI_STRING_TYPE]
|
||||
|
||||
namespace elna
|
||||
{
|
||||
namespace gcc
|
||||
{
|
||||
void init_ttree();
|
||||
bool is_pointer_type(tree type);
|
||||
bool is_string_type(tree type);
|
||||
|
||||
class tree_chain_base
|
||||
{
|
||||
protected:
|
||||
tree first{};
|
||||
tree last{};
|
||||
|
||||
public:
|
||||
tree head();
|
||||
void append(tree t);
|
||||
|
||||
protected:
|
||||
virtual void chain(tree t) = 0;
|
||||
};
|
||||
|
||||
class tree_chain final : public tree_chain_base
|
||||
{
|
||||
void chain(tree t) override;
|
||||
};
|
||||
|
||||
class tree_symbol_mapping final
|
||||
{
|
||||
tree m_bind_expression;
|
||||
tree m_block;
|
||||
|
||||
public:
|
||||
tree_symbol_mapping(tree bind_expression, tree block);
|
||||
|
||||
tree bind_expression();
|
||||
tree block();
|
||||
};
|
||||
|
||||
std::shared_ptr<source::symbol_table<tree>> builtin_symbol_table();
|
||||
}
|
||||
}
|
||||
@ -1,750 +0,0 @@
|
||||
// This Source Code Form is subject to the terms of the Mozilla Public License
|
||||
// v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
// obtain one at http://mozilla.org/MPL/2.0/.
|
||||
#pragma once
|
||||
|
||||
#include <cstdint>
|
||||
#include <memory>
|
||||
#include <string>
|
||||
#include <vector>
|
||||
#include "elna/source/result.h"
|
||||
|
||||
namespace elna
|
||||
{
|
||||
namespace source
|
||||
{
|
||||
enum class binary_operator
|
||||
{
|
||||
sum,
|
||||
subtraction,
|
||||
multiplication,
|
||||
division,
|
||||
equals,
|
||||
not_equals,
|
||||
less,
|
||||
greater,
|
||||
less_equal,
|
||||
greater_equal,
|
||||
disjunction,
|
||||
conjunction
|
||||
};
|
||||
|
||||
enum class unary_operator
|
||||
{
|
||||
reference,
|
||||
negation
|
||||
};
|
||||
|
||||
class variable_declaration;
|
||||
class constant_definition;
|
||||
class procedure_definition;
|
||||
class type_definition;
|
||||
class call_expression;
|
||||
class compound_statement;
|
||||
class assign_statement;
|
||||
class if_statement;
|
||||
class while_statement;
|
||||
class return_statement;
|
||||
class expression_statement;
|
||||
class block;
|
||||
class program;
|
||||
class binary_expression;
|
||||
class unary_expression;
|
||||
class basic_type_expression;
|
||||
class array_type_expression;
|
||||
class pointer_type_expression;
|
||||
class record_type_expression;
|
||||
class union_type_expression;
|
||||
class variable_expression;
|
||||
class array_access_expression;
|
||||
class field_access_expression;
|
||||
class dereference_expression;
|
||||
template<typename T>
|
||||
class number_literal;
|
||||
class char_literal;
|
||||
class string_literal;
|
||||
|
||||
/**
|
||||
* Interface for AST visitors.
|
||||
*/
|
||||
struct parser_visitor
|
||||
{
|
||||
virtual void visit(variable_declaration *) = 0;
|
||||
virtual void visit(constant_definition *) = 0;
|
||||
virtual void visit(procedure_definition *) = 0;
|
||||
virtual void visit(type_definition *) = 0;
|
||||
virtual void visit(call_expression *) = 0;
|
||||
virtual void visit(expression_statement *) = 0;
|
||||
virtual void visit(compound_statement *) = 0;
|
||||
virtual void visit(assign_statement *) = 0;
|
||||
virtual void visit(if_statement *) = 0;
|
||||
virtual void visit(while_statement *) = 0;
|
||||
virtual void visit(return_statement *) = 0;
|
||||
virtual void visit(block *) = 0;
|
||||
virtual void visit(program *) = 0;
|
||||
virtual void visit(binary_expression *) = 0;
|
||||
virtual void visit(unary_expression *) = 0;
|
||||
virtual void visit(basic_type_expression *) = 0;
|
||||
virtual void visit(array_type_expression *) = 0;
|
||||
virtual void visit(pointer_type_expression *) = 0;
|
||||
virtual void visit(record_type_expression *) = 0;
|
||||
virtual void visit(union_type_expression *) = 0;
|
||||
virtual void visit(variable_expression *) = 0;
|
||||
virtual void visit(array_access_expression *) = 0;
|
||||
virtual void visit(field_access_expression *is_field_access) = 0;
|
||||
virtual void visit(dereference_expression *is_dereference) = 0;
|
||||
virtual void visit(number_literal<std::int32_t> *) = 0;
|
||||
virtual void visit(number_literal<double> *) = 0;
|
||||
virtual void visit(number_literal<bool> *) = 0;
|
||||
virtual void visit(number_literal<unsigned char> *) = 0;
|
||||
virtual void visit(string_literal *) = 0;
|
||||
};
|
||||
|
||||
/**
|
||||
* A visitor which visits all nodes but does nothing.
|
||||
*/
|
||||
struct empty_visitor : parser_visitor
|
||||
{
|
||||
virtual void visit(variable_declaration *) override;
|
||||
virtual void visit(constant_definition *definition) override;
|
||||
virtual void visit(procedure_definition *definition) override;
|
||||
virtual void visit(type_definition *definition) override;
|
||||
virtual void visit(call_expression *statement) override;
|
||||
virtual void visit(expression_statement *statement) override;
|
||||
virtual void visit(compound_statement *statement) override;
|
||||
virtual void visit(assign_statement *statement) override;
|
||||
virtual void visit(if_statement *) override;
|
||||
virtual void visit(while_statement *) override;
|
||||
virtual void visit(return_statement *) override;
|
||||
virtual void visit(block *block) override;
|
||||
virtual void visit(program *program) override;
|
||||
virtual void visit(binary_expression *expression) override;
|
||||
virtual void visit(unary_expression *expression) override;
|
||||
virtual void visit(basic_type_expression *) override;
|
||||
virtual void visit(array_type_expression *expression) override;
|
||||
virtual void visit(pointer_type_expression *) override;
|
||||
virtual void visit(record_type_expression *expression) override;
|
||||
virtual void visit(union_type_expression *expression) override;
|
||||
virtual void visit(variable_expression *) override;
|
||||
virtual void visit(array_access_expression *expression) override;
|
||||
virtual void visit(field_access_expression *expression) override;
|
||||
virtual void visit(dereference_expression *expression) override;
|
||||
virtual void visit(number_literal<std::int32_t> *) override;
|
||||
virtual void visit(number_literal<double> *) override;
|
||||
virtual void visit(number_literal<bool> *) override;
|
||||
virtual void visit(number_literal<unsigned char> *) override;
|
||||
virtual void visit(string_literal *) override;
|
||||
};
|
||||
|
||||
/**
|
||||
* Operand representing a subexpression in the 3 address code.
|
||||
*/
|
||||
struct operand
|
||||
{
|
||||
public:
|
||||
virtual ~operand() = 0;
|
||||
};
|
||||
|
||||
struct integer_operand final : public operand
|
||||
{
|
||||
std::int32_t m_value;
|
||||
|
||||
public:
|
||||
explicit integer_operand(const std::int32_t value);
|
||||
|
||||
std::int32_t value() const;
|
||||
};
|
||||
|
||||
class variable_operand final : public operand
|
||||
{
|
||||
std::string m_name;
|
||||
|
||||
public:
|
||||
explicit variable_operand(const std::string& name);
|
||||
|
||||
const std::string& name() const;
|
||||
};
|
||||
|
||||
struct temporary_variable final : public operand
|
||||
{
|
||||
std::size_t m_counter;
|
||||
|
||||
public:
|
||||
explicit temporary_variable(const std::size_t counter);
|
||||
|
||||
std::size_t counter() const;
|
||||
};
|
||||
|
||||
struct label_operand final : public operand
|
||||
{
|
||||
std::size_t m_counter;
|
||||
|
||||
public:
|
||||
explicit label_operand(const std::size_t counter);
|
||||
|
||||
std::size_t counter() const;
|
||||
};
|
||||
|
||||
/**
|
||||
* AST node.
|
||||
*/
|
||||
class node
|
||||
{
|
||||
const struct position source_position;
|
||||
|
||||
protected:
|
||||
/**
|
||||
* \param position Source code position.
|
||||
*/
|
||||
explicit node(const position position);
|
||||
|
||||
public:
|
||||
virtual ~node() = default;
|
||||
virtual void accept(parser_visitor *) = 0;
|
||||
|
||||
/**
|
||||
* \return Node position in the source code.
|
||||
*/
|
||||
const struct position& position() const;
|
||||
};
|
||||
|
||||
class statement : public node
|
||||
{
|
||||
protected:
|
||||
/**
|
||||
* \param position Source code position.
|
||||
*/
|
||||
explicit statement(const struct position position);
|
||||
};
|
||||
|
||||
class expression : public node
|
||||
{
|
||||
public:
|
||||
std::shared_ptr<operand> place;
|
||||
|
||||
protected:
|
||||
/**
|
||||
* \param position Source code position.
|
||||
*/
|
||||
explicit expression(const struct position position);
|
||||
};
|
||||
|
||||
/**
|
||||
* Symbol definition.
|
||||
*/
|
||||
class definition : public node
|
||||
{
|
||||
std::string m_identifier;
|
||||
|
||||
protected:
|
||||
/**
|
||||
* Constructs a definition identified by some name.
|
||||
*
|
||||
* \param position Source code position.
|
||||
* \param identifier Definition name.
|
||||
*/
|
||||
definition(const struct position position, const std::string& identifier);
|
||||
|
||||
public:
|
||||
/**
|
||||
* \return Definition name.
|
||||
*/
|
||||
std::string& identifier();
|
||||
};
|
||||
|
||||
/**
|
||||
* Some type expression.
|
||||
*/
|
||||
class type_expression : public node
|
||||
{
|
||||
public:
|
||||
virtual basic_type_expression *is_basic();
|
||||
virtual array_type_expression *is_array();
|
||||
virtual pointer_type_expression *is_pointer();
|
||||
virtual record_type_expression *is_record();
|
||||
virtual union_type_expression *is_union();
|
||||
|
||||
protected:
|
||||
type_expression(const struct position position);
|
||||
};
|
||||
|
||||
/**
|
||||
* Expression defining a basic type.
|
||||
*/
|
||||
class basic_type_expression final : public type_expression
|
||||
{
|
||||
const std::string m_name;
|
||||
|
||||
public:
|
||||
/**
|
||||
* \param position Source code position.
|
||||
* \param name Type name.
|
||||
*/
|
||||
basic_type_expression(const struct position position, const std::string& name);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
const std::string& base_name();
|
||||
|
||||
basic_type_expression *is_basic() override;
|
||||
};
|
||||
|
||||
class array_type_expression final : public type_expression
|
||||
{
|
||||
type_expression *m_base;
|
||||
|
||||
public:
|
||||
const std::uint32_t size;
|
||||
|
||||
array_type_expression(const struct position position, type_expression *base, const std::uint32_t size);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
type_expression& base();
|
||||
|
||||
array_type_expression *is_array() override;
|
||||
|
||||
virtual ~array_type_expression() override;
|
||||
};
|
||||
|
||||
class pointer_type_expression final : public type_expression
|
||||
{
|
||||
type_expression *m_base;
|
||||
|
||||
public:
|
||||
pointer_type_expression(const struct position position, type_expression *base);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
type_expression& base();
|
||||
|
||||
pointer_type_expression *is_pointer() override;
|
||||
|
||||
virtual ~pointer_type_expression() override;
|
||||
};
|
||||
|
||||
using field_t = std::pair<std::string, type_expression *>;
|
||||
using fields_t = std::vector<field_t>;
|
||||
|
||||
class composite_type_expression : public type_expression
|
||||
{
|
||||
protected:
|
||||
composite_type_expression(const struct position position, fields_t&& fields);
|
||||
|
||||
public:
|
||||
fields_t fields;
|
||||
|
||||
virtual ~composite_type_expression() override;
|
||||
};
|
||||
|
||||
class record_type_expression final : public composite_type_expression
|
||||
{
|
||||
public:
|
||||
record_type_expression(const struct position position, fields_t&& fields);
|
||||
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
record_type_expression *is_record() override;
|
||||
};
|
||||
|
||||
class union_type_expression final : public composite_type_expression
|
||||
{
|
||||
public:
|
||||
union_type_expression(const struct position position, fields_t&& fields);
|
||||
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
union_type_expression *is_union() override;
|
||||
};
|
||||
|
||||
/**
|
||||
* Variable declaration.
|
||||
*/
|
||||
class variable_declaration : public definition
|
||||
{
|
||||
type_expression *m_type;
|
||||
|
||||
public:
|
||||
/**
|
||||
* Constructs a declaration with a name and a type.
|
||||
*
|
||||
* \param position Source code position.
|
||||
* \param identifier Definition name.
|
||||
* \param type Declared type.
|
||||
*/
|
||||
variable_declaration(const struct position position, const std::string& identifier,
|
||||
type_expression *type);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
type_expression& type();
|
||||
|
||||
virtual ~variable_declaration() override;
|
||||
};
|
||||
|
||||
class literal : public expression
|
||||
{
|
||||
protected:
|
||||
explicit literal(const struct position position);
|
||||
};
|
||||
|
||||
/**
|
||||
* Constant definition.
|
||||
*/
|
||||
class constant_definition : public definition
|
||||
{
|
||||
literal *m_body;
|
||||
|
||||
public:
|
||||
/**
|
||||
* \param position Source code position.
|
||||
* \param identifier Constant name.
|
||||
* \param body Constant value.
|
||||
*/
|
||||
constant_definition(const struct position position, const std::string& identifier,
|
||||
literal *body);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
literal& body();
|
||||
|
||||
virtual ~constant_definition() override;
|
||||
};
|
||||
|
||||
/**
|
||||
* Procedure definition.
|
||||
*/
|
||||
class procedure_definition : public definition
|
||||
{
|
||||
type_expression *m_return_type{ nullptr };
|
||||
block *m_body{ nullptr };
|
||||
|
||||
public:
|
||||
std::vector<variable_declaration *> parameters;
|
||||
|
||||
/**
|
||||
* \param position Source code position.
|
||||
* \param identifier Procedure name.
|
||||
* \param parameters Procedure formal parameters.
|
||||
* \param return_type Return type if any.
|
||||
* \param body Procedure body.
|
||||
*/
|
||||
procedure_definition(const struct position position, const std::string& identifier,
|
||||
std::vector<variable_declaration *>&& parameters,
|
||||
type_expression *return_type = nullptr, block *body = nullptr);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
type_expression *return_type();
|
||||
block *body();
|
||||
|
||||
virtual ~procedure_definition() override;
|
||||
};
|
||||
|
||||
class type_definition : public definition
|
||||
{
|
||||
type_expression *m_body;
|
||||
|
||||
public:
|
||||
type_definition(const struct position position, const std::string& identifier,
|
||||
type_expression *expression);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
type_expression& body();
|
||||
|
||||
virtual ~type_definition() override;
|
||||
};
|
||||
|
||||
/**
|
||||
* Call statement.
|
||||
*/
|
||||
class call_expression : public expression
|
||||
{
|
||||
std::string m_name;
|
||||
std::vector<expression *> m_arguments;
|
||||
|
||||
public:
|
||||
/**
|
||||
* \param position Source code position.
|
||||
* \param name Callable's name.
|
||||
*/
|
||||
call_expression(const struct position position, const std::string& name);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
std::string& name();
|
||||
std::vector<expression *>& arguments();
|
||||
|
||||
virtual ~call_expression() override;
|
||||
};
|
||||
|
||||
class expression_statement : public statement
|
||||
{
|
||||
expression *m_body;
|
||||
|
||||
public:
|
||||
expression_statement(const struct position position, expression *body);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
expression& body();
|
||||
|
||||
virtual ~expression_statement() override;
|
||||
};
|
||||
|
||||
class compound_statement : public node
|
||||
{
|
||||
public:
|
||||
std::vector<statement *> statements;
|
||||
|
||||
compound_statement(const struct position position, std::vector<statement *>&& statements);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
virtual ~compound_statement() override;
|
||||
};
|
||||
|
||||
class return_statement : public statement
|
||||
{
|
||||
expression *m_return_expression{ nullptr };
|
||||
|
||||
public:
|
||||
return_statement(const struct position position, expression *return_expression);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
expression *return_expression();
|
||||
|
||||
virtual ~return_statement() override;
|
||||
};
|
||||
|
||||
class designator_expression : public expression
|
||||
{
|
||||
public:
|
||||
virtual variable_expression *is_variable();
|
||||
virtual array_access_expression *is_array_access();
|
||||
virtual field_access_expression *is_field_access();
|
||||
virtual dereference_expression *is_dereference();
|
||||
|
||||
protected:
|
||||
designator_expression(const struct position position);
|
||||
};
|
||||
|
||||
class variable_expression : public designator_expression
|
||||
{
|
||||
std::string m_name;
|
||||
|
||||
public:
|
||||
variable_expression(const struct position position, const std::string& name);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
const std::string& name() const;
|
||||
|
||||
variable_expression *is_variable() override;
|
||||
};
|
||||
|
||||
class array_access_expression : public designator_expression
|
||||
{
|
||||
designator_expression *m_base;
|
||||
expression *m_index;
|
||||
|
||||
public:
|
||||
array_access_expression(const struct position position, designator_expression *base, expression *index);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
designator_expression& base();
|
||||
expression& index();
|
||||
|
||||
array_access_expression *is_array_access() override;
|
||||
|
||||
~array_access_expression() override;
|
||||
};
|
||||
|
||||
class field_access_expression : public designator_expression
|
||||
{
|
||||
designator_expression *m_base;
|
||||
std::string m_field;
|
||||
|
||||
public:
|
||||
field_access_expression(const struct position position, designator_expression *base,
|
||||
const std::string& field);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
designator_expression& base();
|
||||
std::string& field();
|
||||
|
||||
field_access_expression *is_field_access() override;
|
||||
|
||||
~field_access_expression() override;
|
||||
};
|
||||
|
||||
class dereference_expression : public designator_expression
|
||||
{
|
||||
designator_expression *m_base;
|
||||
|
||||
public:
|
||||
dereference_expression(const struct position position, designator_expression *base);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
designator_expression& base();
|
||||
|
||||
dereference_expression *is_dereference() override;
|
||||
|
||||
~dereference_expression() override;
|
||||
};
|
||||
|
||||
class assign_statement : public statement
|
||||
{
|
||||
designator_expression *m_lvalue;
|
||||
expression *m_rvalue;
|
||||
|
||||
public:
|
||||
/**
|
||||
* \param position Source code position.
|
||||
* \param lvalue Left-hand side.
|
||||
* \param rvalue Assigned expression.
|
||||
*/
|
||||
assign_statement(const struct position position, designator_expression *lvalue,
|
||||
expression *rvalue);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
designator_expression& lvalue();
|
||||
expression& rvalue();
|
||||
|
||||
virtual ~assign_statement() override;
|
||||
};
|
||||
|
||||
/**
|
||||
* If-statement.
|
||||
*/
|
||||
class if_statement : public statement
|
||||
{
|
||||
expression *m_prerequisite;
|
||||
compound_statement *m_body;
|
||||
compound_statement *m_alternative;
|
||||
|
||||
public:
|
||||
/**
|
||||
* \param position Source code position.
|
||||
* \param prerequisite Condition.
|
||||
* \param body Statement executed if the condition is met.
|
||||
* \param alternative Statement executed if the condition is not met.
|
||||
*/
|
||||
if_statement(const struct position position, expression *prerequisite,
|
||||
compound_statement *body, compound_statement *alternative = nullptr);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
expression& prerequisite();
|
||||
compound_statement& body();
|
||||
compound_statement *alternative();
|
||||
|
||||
virtual ~if_statement() override;
|
||||
};
|
||||
|
||||
/**
|
||||
* While-statement.
|
||||
*/
|
||||
class while_statement : public statement
|
||||
{
|
||||
expression *m_prerequisite;
|
||||
compound_statement *m_body;
|
||||
|
||||
public:
|
||||
/**
|
||||
* \param position Source code position.
|
||||
* \param prerequisite Condition.
|
||||
* \param body Statement executed while the condition is met.
|
||||
*/
|
||||
while_statement(const struct position position, expression *prerequisite,
|
||||
compound_statement *body);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
expression& prerequisite();
|
||||
compound_statement& body();
|
||||
|
||||
virtual ~while_statement() override;
|
||||
};
|
||||
|
||||
class block : public node
|
||||
{
|
||||
public:
|
||||
std::vector<definition *> value_definitions;
|
||||
std::vector<statement *> body;
|
||||
|
||||
block(const struct position position, std::vector<definition *>&& value_definitions,
|
||||
std::vector<statement *>&& body);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
virtual ~block() override;
|
||||
};
|
||||
|
||||
class program : public block
|
||||
{
|
||||
public:
|
||||
std::vector<definition *> type_definitions;
|
||||
|
||||
program(const struct position position, std::vector<definition *>&& type_definitions,
|
||||
std::vector<definition *>&& value_definitions, std::vector<statement *>&& body);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
virtual ~program() override;
|
||||
};
|
||||
|
||||
template<typename T>
|
||||
class number_literal : public literal
|
||||
{
|
||||
T m_number;
|
||||
|
||||
public:
|
||||
number_literal(const struct position position, const T value)
|
||||
: literal(position), m_number(value)
|
||||
{
|
||||
}
|
||||
|
||||
virtual void accept(parser_visitor *visitor) override
|
||||
{
|
||||
visitor->visit(this);
|
||||
}
|
||||
|
||||
T number() const
|
||||
{
|
||||
return m_number;
|
||||
}
|
||||
};
|
||||
|
||||
class string_literal : public literal
|
||||
{
|
||||
std::string m_string;
|
||||
|
||||
public:
|
||||
string_literal(const struct position position, const std::string& value);
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
|
||||
const std::string& string() const;
|
||||
};
|
||||
|
||||
class binary_expression : public expression
|
||||
{
|
||||
expression *m_lhs;
|
||||
expression *m_rhs;
|
||||
binary_operator m_operator;
|
||||
|
||||
public:
|
||||
binary_expression(const struct position position, expression *lhs,
|
||||
expression *rhs, const unsigned char operation);
|
||||
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
expression& lhs();
|
||||
expression& rhs();
|
||||
binary_operator operation() const;
|
||||
|
||||
virtual ~binary_expression() override;
|
||||
};
|
||||
|
||||
class unary_expression : public expression
|
||||
{
|
||||
expression *m_operand;
|
||||
unary_operator m_operator;
|
||||
|
||||
public:
|
||||
unary_expression(const struct position position, expression *operand,
|
||||
const unsigned char operation);
|
||||
|
||||
virtual void accept(parser_visitor *visitor) override;
|
||||
expression& operand();
|
||||
unary_operator operation() const;
|
||||
|
||||
virtual ~unary_expression() override;
|
||||
};
|
||||
|
||||
const char *print_binary_operator(const binary_operator operation);
|
||||
}
|
||||
}
|
||||
@ -1,41 +0,0 @@
|
||||
// This Source Code Form is subject to the terms of the Mozilla Public License
|
||||
// v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
// obtain one at http://mozilla.org/MPL/2.0/.
|
||||
#pragma once
|
||||
|
||||
#include <list>
|
||||
#include "elna/source/ast.h"
|
||||
#include "location.hh"
|
||||
|
||||
namespace elna
|
||||
{
|
||||
namespace source
|
||||
{
|
||||
position make_position(const yy::location& location);
|
||||
|
||||
class syntax_error final : public error
|
||||
{
|
||||
std::string message;
|
||||
|
||||
public:
|
||||
syntax_error(const std::string& message,
|
||||
const char *input_file, const yy::location& location);
|
||||
|
||||
virtual std::string what() const override;
|
||||
};
|
||||
|
||||
class driver
|
||||
{
|
||||
std::list<std::unique_ptr<struct error>> m_errors;
|
||||
const char *input_file;
|
||||
|
||||
public:
|
||||
std::unique_ptr<program> tree;
|
||||
|
||||
driver(const char *input_file);
|
||||
|
||||
void error(const yy::location& loc, const std::string& message);
|
||||
const std::list<std::unique_ptr<struct error>>& errors() const noexcept;
|
||||
};
|
||||
}
|
||||
}
|
||||
@ -1,55 +0,0 @@
|
||||
// This Source Code Form is subject to the terms of the Mozilla Public License
|
||||
// v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
// obtain one at http://mozilla.org/MPL/2.0/.
|
||||
#pragma once
|
||||
|
||||
#include <cstddef>
|
||||
#include <string>
|
||||
|
||||
namespace elna
|
||||
{
|
||||
namespace source
|
||||
{
|
||||
/**
|
||||
* Position in the source text.
|
||||
*/
|
||||
struct position
|
||||
{
|
||||
/// Line.
|
||||
std::size_t line = 1;
|
||||
|
||||
/// Column.
|
||||
std::size_t column = 1;
|
||||
};
|
||||
|
||||
/**
|
||||
* A compilation error consists of an error message and position.
|
||||
*/
|
||||
class error
|
||||
{
|
||||
protected:
|
||||
/**
|
||||
* Constructs an error.
|
||||
*
|
||||
* \param path Source file name.
|
||||
* \param position Error position in the source text.
|
||||
*/
|
||||
error(const char *path, const struct position position);
|
||||
|
||||
public:
|
||||
const struct position position;
|
||||
const char *path;
|
||||
|
||||
virtual ~error() noexcept = default;
|
||||
|
||||
/// Error text.
|
||||
virtual std::string what() const = 0;
|
||||
|
||||
/// Error line in the source text.
|
||||
std::size_t line() const noexcept;
|
||||
|
||||
/// Error column in the source text.
|
||||
std::size_t column() const noexcept;
|
||||
};
|
||||
}
|
||||
}
|
||||
@ -1,106 +0,0 @@
|
||||
// This Source Code Form is subject to the terms of the Mozilla Public License
|
||||
// v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
// obtain one at http://mozilla.org/MPL/2.0/.
|
||||
#pragma once
|
||||
|
||||
#include <cstdint>
|
||||
#include <unordered_map>
|
||||
#include <string>
|
||||
#include <memory>
|
||||
|
||||
namespace elna
|
||||
{
|
||||
namespace source
|
||||
{
|
||||
/**
|
||||
* Generic language entity information.
|
||||
*/
|
||||
template<typename T>
|
||||
class info
|
||||
{
|
||||
public:
|
||||
T payload;
|
||||
|
||||
info(T payload)
|
||||
: payload(payload)
|
||||
{
|
||||
}
|
||||
};
|
||||
|
||||
template<typename T>
|
||||
std::shared_ptr<info<T>> make_info(T payload)
|
||||
{
|
||||
return std::make_shared<info<T>>(info(payload));
|
||||
}
|
||||
|
||||
/**
|
||||
* Symbol table.
|
||||
*/
|
||||
template<typename T>
|
||||
class symbol_table
|
||||
{
|
||||
public:
|
||||
using symbol_ptr = std::shared_ptr<info<T>>;
|
||||
|
||||
private:
|
||||
std::unordered_map<std::string, symbol_ptr> entries;
|
||||
std::shared_ptr<symbol_table> outer_scope;
|
||||
|
||||
public:
|
||||
/**
|
||||
* Constructs a new symbol with an optional outer scope.
|
||||
*
|
||||
* \param scope Outer scope.
|
||||
*/
|
||||
explicit symbol_table(std::shared_ptr<symbol_table> scope = nullptr)
|
||||
: outer_scope(scope)
|
||||
{
|
||||
}
|
||||
|
||||
/**
|
||||
* Looks for symbol in the table by name. Returns nullptr if the symbol
|
||||
* can not be found.
|
||||
*
|
||||
* \param name Symbol name.
|
||||
* \return Symbol from the table if found.
|
||||
*/
|
||||
symbol_ptr lookup(const std::string& name)
|
||||
{
|
||||
auto entry = entries.find(name);
|
||||
|
||||
if (entry != entries.cend())
|
||||
{
|
||||
return entry->second;
|
||||
}
|
||||
if (this->outer_scope != nullptr)
|
||||
{
|
||||
return this->outer_scope->lookup(name);
|
||||
}
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
/**
|
||||
* Registers new symbol.
|
||||
*
|
||||
* \param name Symbol name.
|
||||
* \param entry Symbol information.
|
||||
*
|
||||
* \return Whether the insertion took place.
|
||||
*/
|
||||
bool enter(const std::string& name, symbol_ptr entry)
|
||||
{
|
||||
return entries.insert({ name, entry }).second;
|
||||
}
|
||||
|
||||
/**
|
||||
* Returns the outer scope or nullptr if the this is the global scope.
|
||||
*
|
||||
* \return Outer scope.
|
||||
*/
|
||||
std::shared_ptr<symbol_table> scope()
|
||||
{
|
||||
return this->outer_scope;
|
||||
}
|
||||
};
|
||||
}
|
||||
}
|
||||
@ -1,116 +0,0 @@
|
||||
// This Source Code Form is subject to the terms of the Mozilla Public License
|
||||
// v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
// obtain one at http://mozilla.org/MPL/2.0/.
|
||||
#pragma once
|
||||
|
||||
#include <memory>
|
||||
#include <string>
|
||||
#include <vector>
|
||||
|
||||
namespace elna
|
||||
{
|
||||
namespace source
|
||||
{
|
||||
class primitive_type;
|
||||
class pointer_type;
|
||||
class procedure_type;
|
||||
|
||||
/**
|
||||
* Type representation.
|
||||
*/
|
||||
class type
|
||||
{
|
||||
const std::size_t byte_size;
|
||||
|
||||
protected:
|
||||
/**
|
||||
* Constructor.
|
||||
*
|
||||
* \param byte_size The type size in bytes.
|
||||
*/
|
||||
explicit type(const std::size_t byte_size);
|
||||
|
||||
public:
|
||||
/**
|
||||
* \return The type size in bytes.
|
||||
*/
|
||||
virtual std::size_t size() const noexcept;
|
||||
|
||||
/**
|
||||
* \return Unique type representation.
|
||||
*/
|
||||
virtual std::string type_name() const = 0;
|
||||
|
||||
virtual const pointer_type *is_pointer_type() const;
|
||||
|
||||
friend bool operator==(const type& lhs, const type& rhs) noexcept;
|
||||
friend bool operator!=(const type& lhs, const type& rhs) noexcept;
|
||||
};
|
||||
|
||||
/**
|
||||
* Built-in type representation.
|
||||
*/
|
||||
class primitive_type final : public type
|
||||
{
|
||||
/// Type name.
|
||||
const std::string m_type_name;
|
||||
|
||||
public:
|
||||
/**
|
||||
* Constructor.
|
||||
*
|
||||
* \param type_name Type name.
|
||||
* \param byte_size The type size in bytes.
|
||||
*/
|
||||
primitive_type(const std::string& type_name, const std::size_t byte_size);
|
||||
|
||||
virtual std::string type_name() const override;
|
||||
};
|
||||
|
||||
/**
|
||||
* Typed pointer.
|
||||
*/
|
||||
struct pointer_type final : public type
|
||||
{
|
||||
/// Pointer target type.
|
||||
std::shared_ptr<const type> base_type;
|
||||
|
||||
/**
|
||||
* Constructor.
|
||||
*
|
||||
* \param base_type Pointer target type.
|
||||
* \param byte_size The type size in bytes.
|
||||
*/
|
||||
pointer_type(std::shared_ptr<const type> base_type, const std::size_t byte_size);
|
||||
|
||||
virtual std::string type_name() const override;
|
||||
|
||||
virtual const pointer_type *is_pointer_type() const override;
|
||||
};
|
||||
|
||||
/**
|
||||
* Type of a procedure.
|
||||
*/
|
||||
struct procedure_type final : public type
|
||||
{
|
||||
/// Argument types.
|
||||
std::vector<std::shared_ptr<const type>> arguments;
|
||||
|
||||
/**
|
||||
* Constructor.
|
||||
*
|
||||
* \param arguments Argument types.
|
||||
* \param byte_size Function pointer size.
|
||||
*/
|
||||
procedure_type(std::vector<std::shared_ptr<const type>> arguments, const std::size_t byte_size);
|
||||
|
||||
virtual std::string type_name() const override;
|
||||
};
|
||||
|
||||
bool operator==(const type& lhs, const type& rhs) noexcept;
|
||||
bool operator!=(const type& lhs, const type& rhs) noexcept;
|
||||
|
||||
extern const primitive_type boolean_type;
|
||||
extern const primitive_type int_type;
|
||||
}
|
||||
}
|
||||
326
lib/Language/Elna/Architecture/RiscV.hs
Normal file
326
lib/Language/Elna/Architecture/RiscV.hs
Normal file
@ -0,0 +1,326 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.Architecture.RiscV
|
||||
( BaseOpcode(..)
|
||||
, RelocationType(..)
|
||||
, Funct3(..)
|
||||
, Funct7(..)
|
||||
, Funct12(..)
|
||||
, Instruction(..)
|
||||
, Type(..)
|
||||
, XRegister(..)
|
||||
, baseOpcode
|
||||
, funct3
|
||||
, funct12
|
||||
, instruction
|
||||
, xRegister
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Builder as ByteString.Builder
|
||||
import Data.Bits (Bits(..))
|
||||
import Data.Text (Text)
|
||||
import Data.Word (Word8, Word32)
|
||||
|
||||
data XRegister
|
||||
= Zero
|
||||
| RA
|
||||
| SP
|
||||
| GP
|
||||
| TP
|
||||
| T0
|
||||
| T1
|
||||
| T2
|
||||
| S0
|
||||
| S1
|
||||
| A0
|
||||
| A1
|
||||
| A2
|
||||
| A3
|
||||
| A4
|
||||
| A5
|
||||
| A6
|
||||
| A7
|
||||
| S2
|
||||
| S3
|
||||
| S4
|
||||
| S5
|
||||
| S6
|
||||
| S7
|
||||
| S8
|
||||
| S9
|
||||
| S10
|
||||
| S11
|
||||
| T3
|
||||
| T4
|
||||
| T5
|
||||
| T6
|
||||
deriving Eq
|
||||
|
||||
data Funct3
|
||||
= ADDI
|
||||
| SLTI
|
||||
| SLTIU
|
||||
| ANDI
|
||||
| ORI
|
||||
| XORI
|
||||
| SLLI
|
||||
| SRLI
|
||||
| SRAI
|
||||
| ADD
|
||||
| SLT
|
||||
| SLTU
|
||||
| AND
|
||||
| OR
|
||||
| XOR
|
||||
| SLL
|
||||
| SRL
|
||||
| SUB
|
||||
| SRA
|
||||
| BEQ
|
||||
| BNE
|
||||
| BLT
|
||||
| BLTU
|
||||
| BGE
|
||||
| BGEU
|
||||
| FENCE
|
||||
| FENCEI
|
||||
| CSRRW
|
||||
| CSRRS
|
||||
| CSRRC
|
||||
| CSRRWI
|
||||
| CSRRSI
|
||||
| CSRRCI
|
||||
| PRIV
|
||||
| SB
|
||||
| SH
|
||||
| SW
|
||||
| LB
|
||||
| LH
|
||||
| LW
|
||||
| LBU
|
||||
| LHU
|
||||
| JALR
|
||||
| MUL
|
||||
| MULH
|
||||
| MULHSU
|
||||
| MULHU
|
||||
| DIV
|
||||
| DIVU
|
||||
| REM
|
||||
| REMU
|
||||
deriving Eq
|
||||
|
||||
data Funct12
|
||||
= ECALL
|
||||
| EBREAK
|
||||
deriving Eq
|
||||
|
||||
newtype Funct7 = Funct7
|
||||
{ funct7 :: Word8
|
||||
} deriving Eq
|
||||
|
||||
data BaseOpcode
|
||||
= OpImm
|
||||
| Lui
|
||||
| Auipc
|
||||
| Op
|
||||
| Jal
|
||||
| Jalr
|
||||
| Branch
|
||||
| Load
|
||||
| Store
|
||||
| MiscMem
|
||||
| System
|
||||
deriving Eq
|
||||
|
||||
data Type
|
||||
= I XRegister Funct3 XRegister Word32
|
||||
| S Word32 Funct3 XRegister XRegister
|
||||
| B Word32 Funct3 XRegister XRegister
|
||||
| R XRegister Funct3 XRegister XRegister Funct7
|
||||
| U XRegister Word32
|
||||
| J XRegister Word32
|
||||
| Type XRegister Funct3 XRegister Funct12 -- Privileged.
|
||||
deriving Eq
|
||||
|
||||
data RelocationType
|
||||
= RLower12I XRegister Funct3 XRegister Text
|
||||
| RLower12S Text Funct3 XRegister XRegister
|
||||
| RHigher20 XRegister Text -- Type U.
|
||||
| RBranch Text Funct3 XRegister XRegister -- Type B.
|
||||
| RJal XRegister Text -- Type J.
|
||||
deriving Eq
|
||||
|
||||
data Instruction
|
||||
= BaseInstruction BaseOpcode Type
|
||||
| RelocatableInstruction BaseOpcode RelocationType
|
||||
| CallInstruction Text
|
||||
deriving Eq
|
||||
|
||||
xRegister :: XRegister -> Word8
|
||||
xRegister Zero = 0
|
||||
xRegister RA = 1
|
||||
xRegister SP = 2
|
||||
xRegister GP = 3
|
||||
xRegister TP = 4
|
||||
xRegister T0 = 5
|
||||
xRegister T1 = 6
|
||||
xRegister T2 = 7
|
||||
xRegister S0 = 8
|
||||
xRegister S1 = 9
|
||||
xRegister A0 = 10
|
||||
xRegister A1 = 11
|
||||
xRegister A2 = 12
|
||||
xRegister A3 = 13
|
||||
xRegister A4 = 14
|
||||
xRegister A5 = 15
|
||||
xRegister A6 = 16
|
||||
xRegister A7 = 17
|
||||
xRegister S2 = 18
|
||||
xRegister S3 = 19
|
||||
xRegister S4 = 20
|
||||
xRegister S5 = 21
|
||||
xRegister S6 = 22
|
||||
xRegister S7 = 23
|
||||
xRegister S8 = 24
|
||||
xRegister S9 = 25
|
||||
xRegister S10 = 26
|
||||
xRegister S11 = 27
|
||||
xRegister T3 = 28
|
||||
xRegister T4 = 29
|
||||
xRegister T5 = 30
|
||||
xRegister T6 = 31
|
||||
|
||||
funct3 :: Funct3 -> Word8
|
||||
funct3 ADDI = 0b000
|
||||
funct3 SLTI = 0b001
|
||||
funct3 SLTIU = 0b011
|
||||
funct3 ANDI = 0b111
|
||||
funct3 ORI = 0b110
|
||||
funct3 XORI = 0b100
|
||||
funct3 SLLI = 0b000
|
||||
funct3 SRLI = 0b101
|
||||
funct3 SRAI = 0b101
|
||||
funct3 ADD = 0b000
|
||||
funct3 SLT = 0b010
|
||||
funct3 SLTU = 0b011
|
||||
funct3 AND = 0b111
|
||||
funct3 OR = 0b110
|
||||
funct3 XOR = 0b100
|
||||
funct3 SLL = 0b001
|
||||
funct3 SRL = 0b101
|
||||
funct3 SUB = 0b000
|
||||
funct3 SRA = 0b101
|
||||
funct3 BEQ = 0b000
|
||||
funct3 BNE = 0b001
|
||||
funct3 BLT = 0b100
|
||||
funct3 BLTU = 0b110
|
||||
funct3 BGE = 0b101
|
||||
funct3 BGEU = 0b111
|
||||
funct3 FENCE = 0b000
|
||||
funct3 FENCEI = 0b001
|
||||
funct3 CSRRW = 0b001
|
||||
funct3 CSRRS = 0b010
|
||||
funct3 CSRRC = 0b011
|
||||
funct3 CSRRWI = 0b101
|
||||
funct3 CSRRSI = 0b110
|
||||
funct3 CSRRCI = 0b111
|
||||
funct3 PRIV = 0b000
|
||||
funct3 SB = 0b000
|
||||
funct3 SH = 0b001
|
||||
funct3 SW = 0b010
|
||||
funct3 LB = 0b000
|
||||
funct3 LH = 0b001
|
||||
funct3 LW = 0b010
|
||||
funct3 LBU = 0b100
|
||||
funct3 LHU = 0b101
|
||||
funct3 JALR = 0b000
|
||||
funct3 MUL = 0b000
|
||||
funct3 MULH = 0b001
|
||||
funct3 MULHSU = 0b010
|
||||
funct3 MULHU = 0b011
|
||||
funct3 DIV = 0b100
|
||||
funct3 DIVU = 0b101
|
||||
funct3 REM = 0b110
|
||||
funct3 REMU = 0b111
|
||||
|
||||
funct12 :: Funct12 -> Word8
|
||||
funct12 ECALL = 0b000000000000
|
||||
funct12 EBREAK = 0b000000000001
|
||||
|
||||
baseOpcode :: BaseOpcode -> Word8
|
||||
baseOpcode OpImm = 0b0010011
|
||||
baseOpcode Lui = 0b0110111
|
||||
baseOpcode Auipc = 0b0010111
|
||||
baseOpcode Op = 0b0110011
|
||||
baseOpcode Jal = 0b1101111
|
||||
baseOpcode Jalr = 0b1100111
|
||||
baseOpcode Branch = 0b1100011
|
||||
baseOpcode Load = 0b0000011
|
||||
baseOpcode Store = 0b0100011
|
||||
baseOpcode MiscMem = 0b0001111
|
||||
baseOpcode System = 0b1110011
|
||||
|
||||
type' :: Type -> Word32
|
||||
type' (I rd funct3' rs1 immediate)
|
||||
= (fromIntegral (xRegister rd) `shiftL` 7)
|
||||
.|. (fromIntegral (funct3 funct3') `shiftL` 12)
|
||||
.|. (fromIntegral (xRegister rs1) `shiftL` 15)
|
||||
.|. (immediate `shiftL` 20);
|
||||
type' (S immediate funct3' rs1 rs2)
|
||||
= ((immediate .&. 0x1f) `shiftL` 7)
|
||||
.|. (fromIntegral (funct3 funct3') `shiftL` 12)
|
||||
.|. (fromIntegral (xRegister rs1) `shiftL` 15)
|
||||
.|. (fromIntegral (xRegister rs2) `shiftL` 20)
|
||||
.|. ((immediate .&. 0xfe0) `shiftL` 20)
|
||||
type' (B immediate funct3' rs1 rs2)
|
||||
= ((immediate .&. 0x800) `shiftR` 4)
|
||||
.|. ((immediate .&. 0x1e) `shiftL` 7)
|
||||
.|. (fromIntegral (funct3 funct3') `shiftL` 12)
|
||||
.|. (fromIntegral (xRegister rs1) `shiftL` 15)
|
||||
.|. (fromIntegral (xRegister rs2) `shiftL` 20)
|
||||
.|. ((immediate .&. 0x7e0) `shiftL` 20)
|
||||
.|. ((immediate .&. 0x1000) `shiftL` 19)
|
||||
type' (R rd funct3' rs1 rs2 funct7')
|
||||
= (fromIntegral (xRegister rd) `shiftL` 7)
|
||||
.|. (fromIntegral (funct3 funct3') `shiftL` 12)
|
||||
.|. (fromIntegral (xRegister rs1) `shiftL` 15)
|
||||
.|. (fromIntegral (xRegister rs2) `shiftL` 20)
|
||||
.|. (fromIntegral (funct7 funct7') `shiftL` 25);
|
||||
type' (U rd immediate)
|
||||
= (fromIntegral (xRegister rd) `shiftL` 7)
|
||||
.|. (immediate `shiftL` 12)
|
||||
type' (J rd immediate)
|
||||
= (fromIntegral (xRegister rd) `shiftL` 7)
|
||||
.|. (immediate .&. 0xff000)
|
||||
.|. ((immediate .&. 0x800) `shiftL` 9)
|
||||
.|. ((immediate .&. 0x7fe) `shiftL` 20)
|
||||
.|. ((immediate .&. 0x100000) `shiftL` 11);
|
||||
type' (Type rd funct3' rs1 funct12')
|
||||
= (fromIntegral (xRegister rd) `shiftL` 7)
|
||||
.|. (fromIntegral (funct3 funct3') `shiftL` 12)
|
||||
.|. (fromIntegral (xRegister rs1) `shiftL` 15)
|
||||
.|. (fromIntegral (funct12 funct12') `shiftL` 20);
|
||||
|
||||
relocationType :: RelocationType -> Word32
|
||||
relocationType (RLower12I rd funct3' rs1 _) = type' $ I rd funct3' rs1 0
|
||||
relocationType (RLower12S _ funct3' rs1 rs2) = type' $ S 0 funct3' rs1 rs2
|
||||
relocationType (RHigher20 rd _) = type' $ U rd 0
|
||||
relocationType (RBranch _ funct3' rs1 rs2) = type' $ B 0 funct3' rs1 rs2
|
||||
relocationType (RJal rd _) = type' $ J rd 0
|
||||
|
||||
instruction :: Instruction -> ByteString.Builder.Builder
|
||||
instruction = \case
|
||||
(BaseInstruction base instructionType) -> go base $ type' instructionType
|
||||
(RelocatableInstruction base instructionType) -> go base $ relocationType instructionType
|
||||
(CallInstruction _) -> foldMap instruction
|
||||
[ BaseInstruction Auipc $ U RA 0
|
||||
, BaseInstruction Jalr $ I RA JALR RA 0
|
||||
]
|
||||
where
|
||||
go base instructionType
|
||||
= ByteString.Builder.word32LE
|
||||
$ fromIntegral (baseOpcode base)
|
||||
.|. instructionType
|
||||
182
lib/Language/Elna/Backend/Allocator.hs
Normal file
182
lib/Language/Elna/Backend/Allocator.hs
Normal file
@ -0,0 +1,182 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.Backend.Allocator
|
||||
( MachineConfiguration(..)
|
||||
, Store(..)
|
||||
, allocate
|
||||
) where
|
||||
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Int (Int32)
|
||||
import Data.Vector (Vector)
|
||||
import Language.Elna.Backend.Intermediate
|
||||
( ProcedureQuadruples(..)
|
||||
, Operand(..)
|
||||
, Quadruple(..)
|
||||
, Variable(..)
|
||||
)
|
||||
import Language.Elna.Location (Identifier(..))
|
||||
import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT)
|
||||
import Control.Monad.Trans.State (State, runState)
|
||||
import GHC.Records (HasField(..))
|
||||
import Control.Monad.Trans.Class (MonadTrans(..))
|
||||
import Control.Monad.Trans.Except (ExceptT(..), runExceptT, throwE)
|
||||
import Data.List ((!?))
|
||||
import Language.Elna.Frontend.SymbolTable (Info(..), SymbolTable)
|
||||
import qualified Language.Elna.Frontend.SymbolTable as SymbolTable
|
||||
|
||||
data Store r
|
||||
= RegisterStore r
|
||||
| StackStore Int32 r
|
||||
|
||||
data AllocationError
|
||||
= OutOfRegistersError
|
||||
| UnexpectedProcedureInfoError Info
|
||||
| UndefinedSymbolError Identifier
|
||||
deriving Eq
|
||||
|
||||
instance Show AllocationError
|
||||
where
|
||||
show OutOfRegistersError = "Ran out of registers during register allocation"
|
||||
show (UnexpectedProcedureInfoError info) =
|
||||
"Expected to encounter a procedure, got: " <> show info
|
||||
show (UndefinedSymbolError identifier) =
|
||||
concat ["Symbol \"", show identifier, "\" is not defined"]
|
||||
|
||||
newtype MachineConfiguration r = MachineConfiguration
|
||||
{ temporaryRegisters :: [r]
|
||||
}
|
||||
|
||||
newtype MachineState = MachineState
|
||||
{ symbolTable :: SymbolTable
|
||||
} deriving (Eq, Show)
|
||||
|
||||
newtype Allocator r a = Allocator
|
||||
{ runAllocator :: ExceptT AllocationError (ReaderT (MachineConfiguration r) (State MachineState)) a
|
||||
}
|
||||
|
||||
instance forall r. Functor (Allocator r)
|
||||
where
|
||||
fmap f = Allocator . fmap f . runAllocator
|
||||
|
||||
instance forall r. Applicative (Allocator r)
|
||||
where
|
||||
pure = Allocator . pure
|
||||
(Allocator x) <*> (Allocator y) = Allocator $ x <*> y
|
||||
|
||||
instance forall r. Monad (Allocator r)
|
||||
where
|
||||
(Allocator allocator) >>= f = Allocator $ allocator >>= (runAllocator . f)
|
||||
|
||||
allocate
|
||||
:: forall r
|
||||
. MachineConfiguration r
|
||||
-> SymbolTable
|
||||
-> HashMap Identifier (Vector (Quadruple Variable))
|
||||
-> Either AllocationError (HashMap Identifier (ProcedureQuadruples (Store r)))
|
||||
allocate machineConfiguration globalTable = HashMap.traverseWithKey function
|
||||
where
|
||||
run localTable = flip runState (MachineState{ symbolTable = localTable })
|
||||
. flip runReaderT machineConfiguration
|
||||
. runExceptT
|
||||
. runAllocator
|
||||
. mapM quadruple
|
||||
function :: Identifier -> Vector (Quadruple Variable) -> Either AllocationError (ProcedureQuadruples (Store r))
|
||||
function procedureName quadruples' =
|
||||
case SymbolTable.lookup procedureName globalTable of
|
||||
Just (ProcedureInfo localTable _) ->
|
||||
let (result, lastState) = run localTable quadruples'
|
||||
in makeResult lastState <$> result
|
||||
Just anotherInfo -> Left $ UnexpectedProcedureInfoError anotherInfo
|
||||
Nothing -> Left $ UndefinedSymbolError procedureName
|
||||
|
||||
makeResult MachineState{ symbolTable } result = ProcedureQuadruples
|
||||
{ quadruples = result
|
||||
, stackSize = fromIntegral $ SymbolTable.size symbolTable * 4
|
||||
}
|
||||
|
||||
quadruple :: Quadruple Variable -> Allocator r (Quadruple (Store r))
|
||||
quadruple = \case
|
||||
StartQuadruple -> pure StartQuadruple
|
||||
StopQuadruple -> pure StopQuadruple
|
||||
ParameterQuadruple operand1 -> ParameterQuadruple
|
||||
<$> operand operand1
|
||||
CallQuadruple name count -> pure $ CallQuadruple name count
|
||||
AddQuadruple operand1 operand2 variable -> AddQuadruple
|
||||
<$> operand operand1
|
||||
<*> operand operand2
|
||||
<*> storeVariable variable
|
||||
SubtractionQuadruple operand1 operand2 variable -> SubtractionQuadruple
|
||||
<$> operand operand1
|
||||
<*> operand operand2
|
||||
<*> storeVariable variable
|
||||
NegationQuadruple operand1 variable -> NegationQuadruple
|
||||
<$> operand operand1
|
||||
<*> storeVariable variable
|
||||
ProductQuadruple operand1 operand2 variable -> ProductQuadruple
|
||||
<$> operand operand1
|
||||
<*> operand operand2
|
||||
<*> storeVariable variable
|
||||
DivisionQuadruple operand1 operand2 variable -> DivisionQuadruple
|
||||
<$> operand operand1
|
||||
<*> operand operand2
|
||||
<*> storeVariable variable
|
||||
LabelQuadruple label -> pure $ LabelQuadruple label
|
||||
GoToQuadruple label -> pure $ GoToQuadruple label
|
||||
EqualQuadruple operand1 operand2 goToLabel -> EqualQuadruple
|
||||
<$> operand operand1
|
||||
<*> operand operand2
|
||||
<*> pure goToLabel
|
||||
NonEqualQuadruple operand1 operand2 goToLabel -> NonEqualQuadruple
|
||||
<$> operand operand1
|
||||
<*> operand operand2
|
||||
<*> pure goToLabel
|
||||
LessQuadruple operand1 operand2 goToLabel -> LessQuadruple
|
||||
<$> operand operand1
|
||||
<*> operand operand2
|
||||
<*> pure goToLabel
|
||||
GreaterQuadruple operand1 operand2 goToLabel -> do
|
||||
operand1' <- operand operand1
|
||||
operand2' <- operand operand2
|
||||
pure $ GreaterQuadruple operand1' operand2' goToLabel
|
||||
LessOrEqualQuadruple operand1 operand2 goToLabel -> LessOrEqualQuadruple
|
||||
<$> operand operand1
|
||||
<*> operand operand2
|
||||
<*> pure goToLabel
|
||||
GreaterOrEqualQuadruple operand1 operand2 goToLabel -> GreaterOrEqualQuadruple
|
||||
<$> operand operand1
|
||||
<*> operand operand2
|
||||
<*> pure goToLabel
|
||||
AssignQuadruple operand1 variable -> AssignQuadruple
|
||||
<$> operand operand1
|
||||
<*> storeVariable variable
|
||||
ArrayAssignQuadruple operand1 operand2 variable -> ArrayAssignQuadruple
|
||||
<$> operand operand1
|
||||
<*> operand operand2
|
||||
<*> storeVariable variable
|
||||
ArrayQuadruple variable1 operand1 variable2 -> ArrayQuadruple
|
||||
<$> storeVariable variable1
|
||||
<*> operand operand1
|
||||
<*> storeVariable variable2
|
||||
|
||||
operand :: Operand Variable -> Allocator r (Operand (Store r))
|
||||
operand (IntOperand literalOperand) = pure $ IntOperand literalOperand
|
||||
operand (VariableOperand variableOperand) =
|
||||
VariableOperand <$> storeVariable variableOperand
|
||||
|
||||
storeVariable :: Variable -> Allocator r (Store r)
|
||||
storeVariable (TempVariable index) = do
|
||||
temporaryRegisters' <- Allocator $ lift $ asks $ getField @"temporaryRegisters"
|
||||
maybe (Allocator $ throwE OutOfRegistersError) (pure . RegisterStore)
|
||||
$ temporaryRegisters' !? fromIntegral index
|
||||
storeVariable (LocalVariable index) = do
|
||||
temporaryRegisters' <- Allocator $ lift $ asks $ getField @"temporaryRegisters"
|
||||
maybe (Allocator $ throwE OutOfRegistersError) (pure . StackStore (fromIntegral (succ index) * (-4)))
|
||||
$ temporaryRegisters' !? pred (length temporaryRegisters' - fromIntegral index)
|
||||
storeVariable (ParameterVariable index) = do
|
||||
temporaryRegisters' <- Allocator $ lift $ asks $ getField @"temporaryRegisters"
|
||||
maybe (Allocator $ throwE OutOfRegistersError) (pure . StackStore (fromIntegral index * 4))
|
||||
$ temporaryRegisters' !? fromIntegral index
|
||||
66
lib/Language/Elna/Backend/Intermediate.hs
Normal file
66
lib/Language/Elna/Backend/Intermediate.hs
Normal file
@ -0,0 +1,66 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.Backend.Intermediate
|
||||
( ProcedureQuadruples(..)
|
||||
, Operand(..)
|
||||
, Quadruple(..)
|
||||
, Label(..)
|
||||
, Variable(..)
|
||||
) where
|
||||
|
||||
import Data.Int (Int32)
|
||||
import Data.Vector (Vector)
|
||||
import Data.Word (Word32)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
|
||||
newtype Label = Label { unLabel :: Text }
|
||||
deriving Eq
|
||||
|
||||
instance Show Label
|
||||
where
|
||||
show (Label label) = '.' : Text.unpack label
|
||||
|
||||
data Variable = TempVariable Word32 | LocalVariable Word32 | ParameterVariable Word32
|
||||
deriving Eq
|
||||
|
||||
instance Show Variable
|
||||
where
|
||||
show (LocalVariable variable) = '@' : show variable
|
||||
show (TempVariable variable) = '$' : show variable
|
||||
show (ParameterVariable variable) = '%' : show variable
|
||||
|
||||
data Operand v
|
||||
= IntOperand Int32
|
||||
| VariableOperand v
|
||||
deriving (Eq, Show)
|
||||
|
||||
data ProcedureQuadruples v = ProcedureQuadruples
|
||||
{ quadruples :: Vector (Quadruple v)
|
||||
, stackSize :: Word32
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data Quadruple v
|
||||
= StartQuadruple
|
||||
| StopQuadruple
|
||||
| ParameterQuadruple (Operand v)
|
||||
| CallQuadruple Text Word32
|
||||
| AddQuadruple (Operand v) (Operand v) v
|
||||
| SubtractionQuadruple (Operand v) (Operand v) v
|
||||
| NegationQuadruple (Operand v) v
|
||||
| ProductQuadruple (Operand v) (Operand v) v
|
||||
| DivisionQuadruple (Operand v) (Operand v) v
|
||||
| GoToQuadruple Label
|
||||
| AssignQuadruple (Operand v) v
|
||||
| ArrayQuadruple v (Operand v) v
|
||||
| ArrayAssignQuadruple (Operand v) (Operand v) v
|
||||
| LessOrEqualQuadruple (Operand v) (Operand v) Label
|
||||
| GreaterOrEqualQuadruple (Operand v) (Operand v) Label
|
||||
| GreaterQuadruple (Operand v) (Operand v) Label
|
||||
| LessQuadruple (Operand v) (Operand v) Label
|
||||
| NonEqualQuadruple (Operand v) (Operand v) Label
|
||||
| EqualQuadruple (Operand v) (Operand v) Label
|
||||
| LabelQuadruple Label
|
||||
deriving (Eq, Show)
|
||||
37
lib/Language/Elna/Driver.hs
Normal file
37
lib/Language/Elna/Driver.hs
Normal file
@ -0,0 +1,37 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.Driver
|
||||
( Driver(..)
|
||||
, IntermediateStage(..)
|
||||
, drive
|
||||
, execParser
|
||||
) where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Language.Elna.Driver.CommandLine
|
||||
( CommandLine(..)
|
||||
, IntermediateStage(..)
|
||||
, commandLine
|
||||
)
|
||||
import Options.Applicative (execParser)
|
||||
import System.FilePath (replaceExtension, takeFileName)
|
||||
|
||||
data Driver = Driver
|
||||
{ input :: FilePath
|
||||
, output :: FilePath
|
||||
, intermediateStage :: Maybe IntermediateStage
|
||||
} deriving (Eq, Show)
|
||||
|
||||
drive :: IO Driver
|
||||
drive = rewrite <$> execParser commandLine
|
||||
where
|
||||
rewrite CommandLine{..} =
|
||||
let defaultOutputName = replaceExtension (takeFileName input) "o"
|
||||
outputName = fromMaybe defaultOutputName output
|
||||
in Driver
|
||||
{ input = input
|
||||
, output = outputName
|
||||
, intermediateStage = intermediateStage
|
||||
}
|
||||
69
lib/Language/Elna/Driver/CommandLine.hs
Normal file
69
lib/Language/Elna/Driver/CommandLine.hs
Normal file
@ -0,0 +1,69 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.Driver.CommandLine
|
||||
( CommandLine(..)
|
||||
, IntermediateStage(..)
|
||||
, commandLine
|
||||
) where
|
||||
|
||||
import Options.Applicative
|
||||
( Parser
|
||||
, ParserInfo(..)
|
||||
, argument
|
||||
, flag'
|
||||
, fullDesc
|
||||
, help
|
||||
, helper
|
||||
, info
|
||||
, long
|
||||
, metavar
|
||||
, optional
|
||||
, progDesc
|
||||
, short
|
||||
, str
|
||||
, strOption
|
||||
)
|
||||
import Control.Applicative (Alternative(..), (<**>))
|
||||
|
||||
data IntermediateStage
|
||||
= ParseStage
|
||||
| ValidateStage
|
||||
| CodeGenStage
|
||||
deriving (Eq, Show)
|
||||
|
||||
data CommandLine = CommandLine
|
||||
{ input :: FilePath
|
||||
, output :: Maybe FilePath
|
||||
, intermediateStage :: Maybe IntermediateStage
|
||||
} deriving (Eq, Show)
|
||||
|
||||
intermediateStageP :: Parser IntermediateStage
|
||||
intermediateStageP
|
||||
= flag' ParseStage parseStageP
|
||||
<|> flag' ValidateStage validateStageP
|
||||
<|> flag' CodeGenStage codeGenStageP
|
||||
where
|
||||
parseStageP = long "parse"
|
||||
<> help "Run the lexer and parser, but stop before assembly generation"
|
||||
validateStageP = long "validate"
|
||||
<> help "Run through the semantic analysis stage, stopping before TAC generation"
|
||||
codeGenStageP = long "codegen"
|
||||
<> help "Perform lexing, parsing, and assembly generation, but stop before code emission"
|
||||
|
||||
commandLineP :: Parser CommandLine
|
||||
commandLineP = CommandLine
|
||||
<$> argument str inFile
|
||||
<*> optional (strOption outFile)
|
||||
<*> optional intermediateStageP
|
||||
where
|
||||
inFile = metavar "INFILE" <> help "Input file."
|
||||
outFile = long "output"
|
||||
<> short 'o'
|
||||
<> metavar "OUTFILE"
|
||||
<> help "Output file."
|
||||
|
||||
commandLine :: ParserInfo CommandLine
|
||||
commandLine = info (commandLineP <**> helper)
|
||||
$ fullDesc <> progDesc "Elna compiler."
|
||||
210
lib/Language/Elna/Frontend/AST.hs
Normal file
210
lib/Language/Elna/Frontend/AST.hs
Normal file
@ -0,0 +1,210 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.Frontend.AST
|
||||
( Declaration(..)
|
||||
, Identifier(..)
|
||||
, Parameter(..)
|
||||
, Program(..)
|
||||
, Statement(..)
|
||||
, TypeExpression(..)
|
||||
, VariableDeclaration(..)
|
||||
, VariableAccess(..)
|
||||
, Condition(..)
|
||||
, Expression(..)
|
||||
, Literal(..)
|
||||
) where
|
||||
|
||||
import Data.Char (chr)
|
||||
import Data.Int (Int32)
|
||||
import Data.List (intercalate)
|
||||
import Data.Word (Word8)
|
||||
import Language.Elna.Location (Identifier(..), showArrayType)
|
||||
import Numeric (showHex)
|
||||
import Data.Bifunctor (Bifunctor(bimap))
|
||||
|
||||
newtype Program = Program [Declaration]
|
||||
deriving Eq
|
||||
|
||||
instance Show Program
|
||||
where
|
||||
show (Program declarations) = unlines (show <$> declarations)
|
||||
|
||||
data Declaration
|
||||
= ProcedureDeclaration Identifier [Parameter] [VariableDeclaration] [Statement]
|
||||
| TypeDefinition Identifier TypeExpression
|
||||
deriving Eq
|
||||
|
||||
instance Show Declaration
|
||||
where
|
||||
show (TypeDefinition identifier typeExpression) =
|
||||
concat ["type ", show identifier, " = ", show typeExpression, ";"]
|
||||
show (ProcedureDeclaration procedureName parameters variables body)
|
||||
= "proc " <> show procedureName <> showParameters parameters <> " {\n"
|
||||
<> unlines ((" " <>) . show <$> variables)
|
||||
<> unlines ((" " <>) . show <$> body)
|
||||
<> "}"
|
||||
|
||||
data Parameter = Parameter Identifier TypeExpression Bool
|
||||
deriving Eq
|
||||
|
||||
instance Show Parameter
|
||||
where
|
||||
show (Parameter identifier typeName ref) = concat
|
||||
[ if ref then "ref " else ""
|
||||
, show identifier, ": ", show typeName
|
||||
]
|
||||
|
||||
showParameters :: [Parameter] -> String
|
||||
showParameters parameters =
|
||||
"(" <> intercalate ", " (show <$> parameters) <> ")"
|
||||
|
||||
data TypeExpression
|
||||
= NamedType Identifier
|
||||
| ArrayType Literal TypeExpression
|
||||
deriving Eq
|
||||
|
||||
instance Show TypeExpression
|
||||
where
|
||||
show (NamedType typeName) = show typeName
|
||||
show (ArrayType elementCount typeName) =
|
||||
showArrayType elementCount typeName
|
||||
|
||||
data Statement
|
||||
= EmptyStatement
|
||||
| IfStatement Condition Statement (Maybe Statement)
|
||||
| AssignmentStatement VariableAccess Expression
|
||||
| WhileStatement Condition Statement
|
||||
| CompoundStatement [Statement]
|
||||
| CallStatement Identifier [Expression]
|
||||
deriving Eq
|
||||
|
||||
instance Show Statement
|
||||
where
|
||||
show EmptyStatement = ";"
|
||||
show (IfStatement condition if' else') = concat
|
||||
[ "if (", show condition, ") "
|
||||
, show if'
|
||||
, maybe "" ((<> " else ") . show) else'
|
||||
]
|
||||
show (AssignmentStatement lhs rhs) =
|
||||
concat [show lhs, " := ", show rhs, ";"]
|
||||
show (WhileStatement expression statement) =
|
||||
concat ["while (", show expression, ") ", show statement, ";"]
|
||||
show (CompoundStatement statements) =
|
||||
concat ["{\n", unlines (show <$> statements), " }"]
|
||||
show (CallStatement name parameters) = show name <> "("
|
||||
<> intercalate ", " (show <$> parameters) <> ")"
|
||||
|
||||
data VariableDeclaration =
|
||||
VariableDeclaration Identifier TypeExpression
|
||||
deriving Eq
|
||||
|
||||
data Literal
|
||||
= DecimalLiteral Int32
|
||||
| HexadecimalLiteral Int32
|
||||
| CharacterLiteral Word8
|
||||
deriving Eq
|
||||
|
||||
instance Show Literal
|
||||
where
|
||||
show (DecimalLiteral integer) = show integer
|
||||
show (HexadecimalLiteral integer) = '0' : 'x' : showHex integer ""
|
||||
show (CharacterLiteral character) =
|
||||
'\'' : chr (fromEnum character) : ['\'']
|
||||
|
||||
instance Ord Literal
|
||||
where
|
||||
compare x y = compare (int32Literal x) (int32Literal y)
|
||||
|
||||
instance Num Literal
|
||||
where
|
||||
x + y = DecimalLiteral $ int32Literal x + int32Literal y
|
||||
x * y = DecimalLiteral $ int32Literal x * int32Literal y
|
||||
abs (DecimalLiteral x) = DecimalLiteral $ abs x
|
||||
abs (HexadecimalLiteral x) = HexadecimalLiteral $ abs x
|
||||
abs (CharacterLiteral x) = CharacterLiteral $ abs x
|
||||
negate (DecimalLiteral x) = DecimalLiteral $ negate x
|
||||
negate (HexadecimalLiteral x) = HexadecimalLiteral $ negate x
|
||||
negate (CharacterLiteral x) = CharacterLiteral $ negate x
|
||||
signum (DecimalLiteral x) = DecimalLiteral $ signum x
|
||||
signum (HexadecimalLiteral x) = HexadecimalLiteral $ signum x
|
||||
signum (CharacterLiteral x) = CharacterLiteral $ signum x
|
||||
fromInteger = DecimalLiteral . fromInteger
|
||||
|
||||
instance Real Literal
|
||||
where
|
||||
toRational (DecimalLiteral integer) = toRational integer
|
||||
toRational (HexadecimalLiteral integer) = toRational integer
|
||||
toRational (CharacterLiteral integer) = toRational integer
|
||||
|
||||
instance Enum Literal
|
||||
where
|
||||
toEnum = DecimalLiteral . fromIntegral
|
||||
fromEnum = fromEnum . int32Literal
|
||||
|
||||
instance Integral Literal
|
||||
where
|
||||
toInteger = toInteger . int32Literal
|
||||
quotRem x y = bimap DecimalLiteral DecimalLiteral
|
||||
$ quotRem (int32Literal x) (int32Literal y)
|
||||
|
||||
int32Literal :: Literal -> Int32
|
||||
int32Literal (DecimalLiteral integer) = integer
|
||||
int32Literal (HexadecimalLiteral integer) = integer
|
||||
int32Literal (CharacterLiteral integer) = fromIntegral integer
|
||||
|
||||
instance Show VariableDeclaration
|
||||
where
|
||||
show (VariableDeclaration identifier typeExpression) =
|
||||
concat ["var ", show identifier, ": " <> show typeExpression, ";"]
|
||||
|
||||
data Expression
|
||||
= LiteralExpression Literal
|
||||
| SumExpression Expression Expression
|
||||
| SubtractionExpression Expression Expression
|
||||
| NegationExpression Expression
|
||||
| ProductExpression Expression Expression
|
||||
| DivisionExpression Expression Expression
|
||||
| VariableExpression VariableAccess
|
||||
deriving Eq
|
||||
|
||||
instance Show Expression
|
||||
where
|
||||
show (LiteralExpression literal) = show literal
|
||||
show (SumExpression lhs rhs) = concat [show lhs, " + ", show rhs]
|
||||
show (SubtractionExpression lhs rhs) = concat [show lhs, " - ", show rhs]
|
||||
show (NegationExpression negation) = '-' : show negation
|
||||
show (ProductExpression lhs rhs) = concat [show lhs, " * ", show rhs]
|
||||
show (DivisionExpression lhs rhs) = concat [show lhs, " / ", show rhs]
|
||||
show (VariableExpression variable) = show variable
|
||||
|
||||
data VariableAccess
|
||||
= VariableAccess Identifier
|
||||
| ArrayAccess VariableAccess Expression
|
||||
deriving Eq
|
||||
|
||||
instance Show VariableAccess
|
||||
where
|
||||
show (VariableAccess variableName) = show variableName
|
||||
show (ArrayAccess arrayAccess elementIndex) =
|
||||
concat [show arrayAccess, "[", show elementIndex, "]"]
|
||||
|
||||
data Condition
|
||||
= EqualCondition Expression Expression
|
||||
| NonEqualCondition Expression Expression
|
||||
| LessCondition Expression Expression
|
||||
| GreaterCondition Expression Expression
|
||||
| LessOrEqualCondition Expression Expression
|
||||
| GreaterOrEqualCondition Expression Expression
|
||||
deriving Eq
|
||||
|
||||
instance Show Condition
|
||||
where
|
||||
show (EqualCondition lhs rhs) = concat [show lhs, " = ", show rhs]
|
||||
show (NonEqualCondition lhs rhs) = concat [show lhs, " # ", show rhs]
|
||||
show (LessCondition lhs rhs) = concat [show lhs, " < ", show rhs]
|
||||
show (GreaterCondition lhs rhs) = concat [show lhs, " > ", show rhs]
|
||||
show (LessOrEqualCondition lhs rhs) = concat [show lhs, " <= ", show rhs]
|
||||
show (GreaterOrEqualCondition lhs rhs) = concat [show lhs, " >= ", show rhs]
|
||||
211
lib/Language/Elna/Frontend/NameAnalysis.hs
Normal file
211
lib/Language/Elna/Frontend/NameAnalysis.hs
Normal file
@ -0,0 +1,211 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.Frontend.NameAnalysis
|
||||
( nameAnalysis
|
||||
, Error(..)
|
||||
) where
|
||||
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import qualified Data.Vector as Vector
|
||||
import qualified Language.Elna.Frontend.AST as AST
|
||||
import qualified Language.Elna.Frontend.SymbolTable as SymbolTable
|
||||
import Language.Elna.Frontend.SymbolTable
|
||||
( SymbolTable
|
||||
, Info(..)
|
||||
, ParameterInfo(..)
|
||||
)
|
||||
import Control.Monad.Trans.Except (Except, runExcept, throwE)
|
||||
import Data.Functor ((<&>))
|
||||
import Language.Elna.Location (Identifier(..))
|
||||
import Language.Elna.Frontend.Types (Type(..))
|
||||
import Data.Foldable (traverse_)
|
||||
import Control.Monad (foldM, unless)
|
||||
|
||||
data Error
|
||||
= UndefinedTypeError Identifier
|
||||
| UnexpectedTypeInfoError Info
|
||||
| IdentifierAlreadyDefinedError Identifier
|
||||
| UndefinedSymbolError Identifier
|
||||
| UnexpectedArrayByValue Identifier
|
||||
deriving Eq
|
||||
|
||||
instance Show Error
|
||||
where
|
||||
show (UndefinedTypeError identifier) =
|
||||
concat ["Type \"", show identifier, "\" is not defined"]
|
||||
show (UnexpectedTypeInfoError info) = show info
|
||||
<> " expected to be a type"
|
||||
show (IdentifierAlreadyDefinedError identifier) =
|
||||
concat ["The identifier \"", show identifier, "\" is already defined"]
|
||||
show (UndefinedSymbolError identifier) =
|
||||
concat ["Symbol \"", show identifier, "\" is not defined"]
|
||||
show (UnexpectedArrayByValue identifier) = concat
|
||||
[ "Array \""
|
||||
, show identifier
|
||||
, "\" cannot be passed by value, only by reference"
|
||||
]
|
||||
|
||||
newtype NameAnalysis a = NameAnalysis
|
||||
{ runNameAnalysis :: Except Error a
|
||||
}
|
||||
|
||||
instance Functor NameAnalysis
|
||||
where
|
||||
fmap f (NameAnalysis x) = NameAnalysis $ f <$> x
|
||||
|
||||
instance Applicative NameAnalysis
|
||||
where
|
||||
pure = NameAnalysis . pure
|
||||
(NameAnalysis f) <*> (NameAnalysis x) = NameAnalysis $ f <*> x
|
||||
|
||||
instance Monad NameAnalysis
|
||||
where
|
||||
(NameAnalysis x) >>= f = NameAnalysis $ x >>= (runNameAnalysis . f)
|
||||
|
||||
nameAnalysis :: AST.Program -> Either Error SymbolTable
|
||||
nameAnalysis = runExcept
|
||||
. runNameAnalysis
|
||||
. program SymbolTable.builtInSymbolTable
|
||||
|
||||
program :: SymbolTable -> AST.Program -> NameAnalysis SymbolTable
|
||||
program symbolTable (AST.Program declarations) = do
|
||||
globalTable <- foldM procedureDeclaration symbolTable declarations
|
||||
foldM declaration globalTable declarations
|
||||
|
||||
procedureDeclaration :: SymbolTable -> AST.Declaration -> NameAnalysis SymbolTable
|
||||
procedureDeclaration globalTable = \case
|
||||
(AST.ProcedureDeclaration identifier parameters _ _)
|
||||
-> mapM (parameter globalTable) parameters
|
||||
>>= enterOrFail identifier
|
||||
. ProcedureInfo SymbolTable.empty
|
||||
. Vector.fromList
|
||||
(AST.TypeDefinition identifier typeExpression)
|
||||
-> dataType globalTable typeExpression
|
||||
>>= enterOrFail identifier . SymbolTable.TypeInfo
|
||||
where
|
||||
enterOrFail identifier declarationInfo =
|
||||
maybe (NameAnalysis $ throwE $ IdentifierAlreadyDefinedError identifier) pure
|
||||
$ SymbolTable.enter identifier declarationInfo globalTable
|
||||
|
||||
declaration :: SymbolTable -> AST.Declaration -> NameAnalysis SymbolTable
|
||||
declaration globalTable (AST.ProcedureDeclaration identifier parameters variables body) = do
|
||||
variableInfo <- mapM (variableDeclaration globalTable) variables
|
||||
parameterInfo <- mapM (parameterToVariableInfo globalTable) parameters
|
||||
procedureTable <- fmap (SymbolTable.scope globalTable)
|
||||
$ either (NameAnalysis . throwE . IdentifierAlreadyDefinedError . NonEmpty.head) pure
|
||||
$ SymbolTable.fromList
|
||||
$ parameterInfo <> variableInfo
|
||||
traverse_ (statement procedureTable) body
|
||||
pure $ SymbolTable.update (updater procedureTable) identifier globalTable
|
||||
where
|
||||
updater procedureTable (ProcedureInfo _ parameters') = Just
|
||||
$ ProcedureInfo procedureTable parameters'
|
||||
updater _ _ = Nothing
|
||||
declaration globalTable (AST.TypeDefinition _ _) = pure globalTable
|
||||
|
||||
parameterToVariableInfo :: SymbolTable -> AST.Parameter -> NameAnalysis (Identifier, Info)
|
||||
parameterToVariableInfo symbolTable (AST.Parameter identifier typeExpression isReferenceParameter')
|
||||
= (identifier,) . VariableInfo isReferenceParameter'
|
||||
<$> dataType symbolTable typeExpression
|
||||
|
||||
variableDeclaration :: SymbolTable -> AST.VariableDeclaration -> NameAnalysis (Identifier, Info)
|
||||
variableDeclaration globalTable (AST.VariableDeclaration identifier typeExpression)
|
||||
= (identifier,) . VariableInfo False
|
||||
<$> dataType globalTable typeExpression
|
||||
|
||||
parameter :: SymbolTable -> AST.Parameter -> NameAnalysis ParameterInfo
|
||||
parameter environmentSymbolTable (AST.Parameter identifier typeExpression isReferenceParameter') = do
|
||||
parameterType <- dataType environmentSymbolTable typeExpression
|
||||
case parameterType of
|
||||
ArrayType _ _
|
||||
| not isReferenceParameter' -> NameAnalysis
|
||||
$ throwE $ UnexpectedArrayByValue identifier
|
||||
_ ->
|
||||
let parameterInfo = ParameterInfo
|
||||
{ name = identifier
|
||||
, type' = parameterType
|
||||
, isReferenceParameter = isReferenceParameter'
|
||||
}
|
||||
in pure parameterInfo
|
||||
|
||||
dataType :: SymbolTable -> AST.TypeExpression -> NameAnalysis Type
|
||||
dataType environmentSymbolTable (AST.NamedType baseType) = do
|
||||
case SymbolTable.lookup baseType environmentSymbolTable of
|
||||
Just baseInfo
|
||||
| TypeInfo baseType' <- baseInfo -> pure baseType'
|
||||
| otherwise -> NameAnalysis $ throwE $ UnexpectedTypeInfoError baseInfo
|
||||
_ -> NameAnalysis $ throwE $ UndefinedTypeError baseType
|
||||
dataType environmentSymbolTable (AST.ArrayType arraySize baseType) =
|
||||
dataType environmentSymbolTable baseType <&> ArrayType (fromIntegral arraySize)
|
||||
|
||||
checkSymbol :: SymbolTable -> Identifier -> NameAnalysis ()
|
||||
checkSymbol globalTable identifier
|
||||
= unless (SymbolTable.member identifier globalTable)
|
||||
$ NameAnalysis $ throwE
|
||||
$ UndefinedSymbolError identifier
|
||||
|
||||
expression :: SymbolTable -> AST.Expression -> NameAnalysis ()
|
||||
expression _ (AST.LiteralExpression _) = pure ()
|
||||
expression globalTable (AST.SumExpression lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
expression globalTable (AST.SubtractionExpression lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
expression globalTable (AST.NegationExpression negation) =
|
||||
expression globalTable negation
|
||||
expression globalTable (AST.ProductExpression lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
expression globalTable (AST.DivisionExpression lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
expression globalTable (AST.VariableExpression variableExpression) =
|
||||
variableAccess globalTable variableExpression
|
||||
|
||||
statement :: SymbolTable -> AST.Statement -> NameAnalysis ()
|
||||
statement _ AST.EmptyStatement = pure ()
|
||||
statement globalTable (AST.CallStatement name arguments)
|
||||
= checkSymbol globalTable name
|
||||
>> traverse_ (expression globalTable) arguments
|
||||
statement globalTable (AST.CompoundStatement statements) =
|
||||
traverse_ (statement globalTable) statements
|
||||
statement globalTable (AST.IfStatement ifCondition ifStatement elseStatement)
|
||||
= condition globalTable ifCondition
|
||||
>> statement globalTable ifStatement
|
||||
>> maybe (pure ()) (statement globalTable) elseStatement
|
||||
statement globalTable (AST.AssignmentStatement lvalue rvalue)
|
||||
= variableAccess globalTable lvalue
|
||||
>> expression globalTable rvalue
|
||||
statement globalTable (AST.WhileStatement whileCondition loop)
|
||||
= condition globalTable whileCondition
|
||||
>> statement globalTable loop
|
||||
|
||||
condition :: SymbolTable -> AST.Condition -> NameAnalysis ()
|
||||
condition globalTable (AST.EqualCondition lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
condition globalTable (AST.NonEqualCondition lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
condition globalTable (AST.LessCondition lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
condition globalTable (AST.GreaterCondition lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
condition globalTable (AST.LessOrEqualCondition lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
condition globalTable (AST.GreaterOrEqualCondition lhs rhs)
|
||||
= expression globalTable lhs
|
||||
>> expression globalTable rhs
|
||||
|
||||
variableAccess :: SymbolTable -> AST.VariableAccess -> NameAnalysis ()
|
||||
variableAccess globalTable (AST.VariableAccess identifier) =
|
||||
checkSymbol globalTable identifier
|
||||
variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression)
|
||||
= variableAccess globalTable arrayExpression
|
||||
>> expression globalTable indexExpression
|
||||
227
lib/Language/Elna/Frontend/Parser.hs
Normal file
227
lib/Language/Elna/Frontend/Parser.hs
Normal file
@ -0,0 +1,227 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.Frontend.Parser
|
||||
( Parser
|
||||
, programP
|
||||
) where
|
||||
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.Combinators.Expr (Operator(..), makeExprParser)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Void (Void)
|
||||
import Language.Elna.Frontend.AST
|
||||
( Declaration(..)
|
||||
, Identifier(..)
|
||||
, Parameter(..)
|
||||
, Program(..)
|
||||
, Statement(..)
|
||||
, TypeExpression(..)
|
||||
, VariableDeclaration(..)
|
||||
, VariableAccess(..)
|
||||
, Condition(..)
|
||||
, Expression(..)
|
||||
, Literal(..)
|
||||
)
|
||||
import Text.Megaparsec
|
||||
( Parsec
|
||||
, (<?>)
|
||||
, MonadParsec(..)
|
||||
, eof
|
||||
, optional
|
||||
, between
|
||||
, sepBy
|
||||
, choice
|
||||
)
|
||||
import qualified Text.Megaparsec.Char.Lexer as Lexer
|
||||
import Text.Megaparsec.Char
|
||||
( alphaNumChar
|
||||
, char
|
||||
, letterChar
|
||||
, space1
|
||||
, string
|
||||
)
|
||||
import Control.Applicative (Alternative(..))
|
||||
import Data.Maybe (isJust)
|
||||
|
||||
type Parser = Parsec Void Text
|
||||
|
||||
literalP :: Parser Literal
|
||||
literalP
|
||||
= HexadecimalLiteral <$> Lexer.signed space hexadecimalP
|
||||
<|> DecimalLiteral <$> Lexer.signed space decimalP
|
||||
<|> CharacterLiteral <$> lexeme charP
|
||||
where
|
||||
charP = fromIntegral . fromEnum
|
||||
<$> between (char '\'') (char '\'') Lexer.charLiteral
|
||||
|
||||
typeDefinitionP :: Parser Declaration
|
||||
typeDefinitionP = TypeDefinition
|
||||
<$> (symbol "type" *> identifierP)
|
||||
<*> (symbol "=" *> typeExpressionP)
|
||||
<* semicolonP
|
||||
<?> "type definition"
|
||||
|
||||
termP :: Parser Expression
|
||||
termP = choice
|
||||
[ parensP expressionP
|
||||
, LiteralExpression <$> literalP
|
||||
, VariableExpression <$> variableAccessP
|
||||
]
|
||||
|
||||
operatorTable :: [[Operator Parser Expression]]
|
||||
operatorTable =
|
||||
[ unaryOperator
|
||||
, factorOperator
|
||||
, termOperator
|
||||
]
|
||||
where
|
||||
unaryOperator =
|
||||
[ prefix "-" NegationExpression
|
||||
, prefix "+" id
|
||||
]
|
||||
factorOperator =
|
||||
[ binary "*" ProductExpression
|
||||
, binary "/" DivisionExpression
|
||||
]
|
||||
termOperator =
|
||||
[ binary "+" SumExpression
|
||||
, binary "-" SubtractionExpression
|
||||
]
|
||||
prefix name f = Prefix (f <$ symbol name)
|
||||
binary name f = InfixL (f <$ symbol name)
|
||||
|
||||
expressionP :: Parser Expression
|
||||
expressionP = makeExprParser termP operatorTable
|
||||
|
||||
variableAccessP :: Parser VariableAccess
|
||||
variableAccessP = do
|
||||
identifier <- identifierP
|
||||
indices <- many $ bracketsP expressionP
|
||||
pure $ foldr (flip ArrayAccess) (VariableAccess identifier) indices
|
||||
|
||||
conditionP :: Parser Condition
|
||||
conditionP = do
|
||||
lhs <- expressionP
|
||||
conditionCons <- choice comparisonOperator
|
||||
conditionCons lhs <$> expressionP
|
||||
where
|
||||
comparisonOperator =
|
||||
[ symbol "<=" >> pure LessOrEqualCondition
|
||||
, symbol "<" >> pure LessCondition
|
||||
, symbol ">=" >> pure GreaterOrEqualCondition
|
||||
, symbol ">" >> pure GreaterCondition
|
||||
, symbol "=" >> pure EqualCondition
|
||||
, symbol "#" >> pure NonEqualCondition
|
||||
]
|
||||
|
||||
symbol :: Text -> Parser Text
|
||||
symbol = Lexer.symbol space
|
||||
|
||||
space :: Parser ()
|
||||
space = Lexer.space space1 (Lexer.skipLineComment "//")
|
||||
$ Lexer.skipBlockComment "/*" "*/"
|
||||
|
||||
lexeme :: forall a. Parser a -> Parser a
|
||||
lexeme = Lexer.lexeme space
|
||||
|
||||
blockP :: forall a. Parser a -> Parser a
|
||||
blockP = between (symbol "{") (symbol "}")
|
||||
|
||||
parensP :: forall a. Parser a -> Parser a
|
||||
parensP = between (symbol "(") (symbol ")")
|
||||
|
||||
bracketsP :: forall a. Parser a -> Parser a
|
||||
bracketsP = between (symbol "[") (symbol "]")
|
||||
|
||||
colonP :: Parser ()
|
||||
colonP = void $ symbol ":"
|
||||
|
||||
commaP :: Parser ()
|
||||
commaP = void $ symbol ","
|
||||
|
||||
semicolonP :: Parser ()
|
||||
semicolonP = void $ symbol ";"
|
||||
|
||||
decimalP :: Integral a => Parser a
|
||||
decimalP = lexeme Lexer.decimal
|
||||
|
||||
hexadecimalP :: Integral a => Parser a
|
||||
hexadecimalP = string "0x" *> lexeme Lexer.hexadecimal
|
||||
|
||||
identifierP :: Parser Identifier
|
||||
identifierP =
|
||||
let wordParser = (:) <$> letterChar <*> many alphaNumChar <?> "identifier"
|
||||
in fmap Identifier $ lexeme $ Text.pack <$> wordParser
|
||||
|
||||
procedureP :: Parser ()
|
||||
procedureP = void $ symbol "proc"
|
||||
|
||||
parameterP :: Parser Parameter
|
||||
parameterP = paramCons
|
||||
<$> optional (symbol "ref")
|
||||
<*> identifierP
|
||||
<*> (colonP *> typeExpressionP)
|
||||
where
|
||||
paramCons ref name typeName = Parameter name typeName (isJust ref)
|
||||
|
||||
typeExpressionP :: Parser TypeExpression
|
||||
typeExpressionP = arrayTypeExpression
|
||||
<|> NamedType <$> identifierP
|
||||
<?> "type expression"
|
||||
where
|
||||
arrayTypeExpression = ArrayType
|
||||
<$> (symbol "array" *> bracketsP literalP)
|
||||
<*> (symbol "of" *> typeExpressionP)
|
||||
|
||||
procedureDeclarationP :: Parser Declaration
|
||||
procedureDeclarationP = procedureCons
|
||||
<$> (procedureP *> identifierP)
|
||||
<*> parensP (sepBy parameterP commaP)
|
||||
<*> blockP ((,) <$> many variableDeclarationP <*> many statementP)
|
||||
<?> "procedure definition"
|
||||
where
|
||||
procedureCons procedureName parameters (variables, body) =
|
||||
ProcedureDeclaration procedureName parameters variables body
|
||||
|
||||
statementP :: Parser Statement
|
||||
statementP
|
||||
= EmptyStatement <$ semicolonP
|
||||
<|> ifElseP
|
||||
<|> CompoundStatement <$> blockP (many statementP)
|
||||
<|> try assignmentP
|
||||
<|> try whileP
|
||||
<|> callP
|
||||
<?> "statement"
|
||||
where
|
||||
callP = CallStatement
|
||||
<$> identifierP
|
||||
<*> parensP (sepBy expressionP commaP)
|
||||
<* semicolonP
|
||||
ifElseP = IfStatement
|
||||
<$> (symbol "if" *> parensP conditionP)
|
||||
<*> statementP
|
||||
<*> optional (symbol "else" *> statementP)
|
||||
whileP = WhileStatement
|
||||
<$> (symbol "while" *> parensP conditionP)
|
||||
<*> statementP
|
||||
assignmentP = AssignmentStatement
|
||||
<$> variableAccessP
|
||||
<* symbol ":="
|
||||
<*> expressionP
|
||||
<* semicolonP
|
||||
|
||||
variableDeclarationP :: Parser VariableDeclaration
|
||||
variableDeclarationP = VariableDeclaration
|
||||
<$> (symbol "var" *> identifierP)
|
||||
<*> (colonP *> typeExpressionP)
|
||||
<* semicolonP
|
||||
<?> "variable declaration"
|
||||
|
||||
declarationP :: Parser Declaration
|
||||
declarationP = procedureDeclarationP <|> typeDefinitionP
|
||||
|
||||
programP :: Parser Program
|
||||
programP = Program <$> many declarationP <* eof
|
||||
109
lib/Language/Elna/Frontend/SymbolTable.hs
Normal file
109
lib/Language/Elna/Frontend/SymbolTable.hs
Normal file
@ -0,0 +1,109 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.Frontend.SymbolTable
|
||||
( SymbolTable
|
||||
, Info(..)
|
||||
, ParameterInfo(..)
|
||||
, builtInSymbolTable
|
||||
, empty
|
||||
, enter
|
||||
, fromList
|
||||
, lookup
|
||||
, member
|
||||
, scope
|
||||
, size
|
||||
, toMap
|
||||
, update
|
||||
) where
|
||||
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.List (sort)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Vector (Vector)
|
||||
import qualified Data.Vector as Vector
|
||||
import Language.Elna.Location (Identifier(..))
|
||||
import Language.Elna.Frontend.Types (Type(..), intType)
|
||||
import Prelude hiding (lookup)
|
||||
|
||||
data SymbolTable = SymbolTable (Maybe SymbolTable) (HashMap Identifier Info)
|
||||
deriving (Eq, Show)
|
||||
|
||||
empty :: SymbolTable
|
||||
empty = SymbolTable Nothing HashMap.empty
|
||||
|
||||
update :: (Info -> Maybe Info) -> Identifier -> SymbolTable -> SymbolTable
|
||||
update updater key (SymbolTable parent mappings) = SymbolTable parent
|
||||
$ HashMap.update updater key mappings
|
||||
|
||||
scope :: SymbolTable -> SymbolTable -> SymbolTable
|
||||
scope parent (SymbolTable _ mappings) = SymbolTable (Just parent) mappings
|
||||
|
||||
builtInSymbolTable :: SymbolTable
|
||||
builtInSymbolTable = SymbolTable Nothing $ HashMap.fromList
|
||||
[ ("printi", ProcedureInfo empty (Vector.singleton printiX))
|
||||
, ("printc", ProcedureInfo empty (Vector.singleton printcI))
|
||||
, ("exit", ProcedureInfo empty Vector.empty)
|
||||
, ("int", TypeInfo intType)
|
||||
]
|
||||
where
|
||||
printiX = ParameterInfo
|
||||
{ name = "x"
|
||||
, type' = intType
|
||||
, isReferenceParameter = False
|
||||
}
|
||||
printcI = ParameterInfo
|
||||
{ name = "i"
|
||||
, type' = intType
|
||||
, isReferenceParameter = False
|
||||
}
|
||||
|
||||
toMap :: SymbolTable -> HashMap Identifier Info
|
||||
toMap (SymbolTable _ map') = map'
|
||||
|
||||
enter :: Identifier -> Info -> SymbolTable -> Maybe SymbolTable
|
||||
enter identifier info table@(SymbolTable parent hashTable)
|
||||
| member identifier table = Nothing
|
||||
| otherwise = Just
|
||||
$ SymbolTable parent (HashMap.insert identifier info hashTable)
|
||||
|
||||
lookup :: Identifier -> SymbolTable -> Maybe Info
|
||||
lookup identifier (SymbolTable parent table)
|
||||
| Just found <- HashMap.lookup identifier table = Just found
|
||||
| Just parent' <- parent = lookup identifier parent'
|
||||
| otherwise = Nothing
|
||||
|
||||
member :: Identifier -> SymbolTable -> Bool
|
||||
member identifier table =
|
||||
isJust $ lookup identifier table
|
||||
|
||||
size :: SymbolTable -> Int
|
||||
size (SymbolTable _ map') = HashMap.size map'
|
||||
|
||||
fromList :: [(Identifier, Info)] -> Either (NonEmpty Identifier) SymbolTable
|
||||
fromList elements
|
||||
| Just identifierDuplicates' <- identifierDuplicates =
|
||||
Left identifierDuplicates'
|
||||
| otherwise = Right $ SymbolTable Nothing $ HashMap.fromList elements
|
||||
where
|
||||
identifierDuplicates = NonEmpty.nonEmpty
|
||||
$ fmap NonEmpty.head
|
||||
$ filter ((> 1) . NonEmpty.length)
|
||||
$ NonEmpty.group . sort
|
||||
$ fst <$> elements
|
||||
|
||||
data ParameterInfo = ParameterInfo
|
||||
{ name :: Identifier
|
||||
, type' :: Type
|
||||
, isReferenceParameter :: Bool
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data Info
|
||||
= TypeInfo Type
|
||||
| VariableInfo Bool Type
|
||||
| ProcedureInfo SymbolTable (Vector ParameterInfo)
|
||||
deriving (Eq, Show)
|
||||
208
lib/Language/Elna/Frontend/TypeAnalysis.hs
Normal file
208
lib/Language/Elna/Frontend/TypeAnalysis.hs
Normal file
@ -0,0 +1,208 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.Frontend.TypeAnalysis
|
||||
( typeAnalysis
|
||||
, -- Error(..)
|
||||
) where
|
||||
|
||||
import Control.Applicative (Alternative(..))
|
||||
import Control.Monad (unless)
|
||||
import Control.Monad.Trans.Class (MonadTrans(..))
|
||||
import Control.Monad.Trans.Except (Except, runExcept, throwE)
|
||||
import Control.Monad.Trans.Reader (ReaderT, runReaderT, withReaderT, ask, asks)
|
||||
import Data.Foldable (traverse_)
|
||||
import qualified Data.Vector as Vector
|
||||
import qualified Language.Elna.Frontend.AST as AST
|
||||
import Language.Elna.Frontend.SymbolTable (Info(..), ParameterInfo(..), SymbolTable)
|
||||
import qualified Language.Elna.Frontend.SymbolTable as SymbolTable
|
||||
import Language.Elna.Frontend.Types (Type(..), booleanType, intType)
|
||||
import Language.Elna.Location (Identifier(..))
|
||||
|
||||
typeAnalysis :: SymbolTable -> AST.Program -> Maybe Error
|
||||
typeAnalysis globalTable = either Just (const Nothing)
|
||||
. runExcept
|
||||
. flip runReaderT globalTable
|
||||
. runTypeAnalysis
|
||||
. program
|
||||
|
||||
data Error
|
||||
= UnexpectedProcedureInfoError Info
|
||||
| UndefinedSymbolError Identifier
|
||||
| ParameterCountMismatchError Int Int
|
||||
| UnexpectedVariableInfoError Info
|
||||
| ArithmeticExpressionError Type
|
||||
| ComparisonExpressionError Type Type
|
||||
| InvalidConditionTypeError Type
|
||||
{- | ExpectedLvalueError AST.Expression
|
||||
| ArgumentTypeMismatchError Type Type -}
|
||||
| ArrayIndexError Type
|
||||
| ArrayAccessError Type
|
||||
deriving Eq
|
||||
|
||||
instance Show Error
|
||||
where
|
||||
show (UnexpectedProcedureInfoError info) =
|
||||
"Expected to encounter a procedure, got: " <> show info
|
||||
show (UndefinedSymbolError identifier) =
|
||||
concat ["Symbol \"", show identifier, "\" is not defined"]
|
||||
show (ParameterCountMismatchError parameterCount argumentCount)
|
||||
= "The function was expected to receive " <> show argumentCount
|
||||
<> " arguments, but got " <> show parameterCount
|
||||
show (UnexpectedVariableInfoError info) =
|
||||
"Expected to encounter a variable, got: " <> show info
|
||||
show (ArithmeticExpressionError got) =
|
||||
"Expected an arithmetic expression to be an integer, got: " <> show got
|
||||
show (ComparisonExpressionError lhs rhs)
|
||||
= "Expected an arithmetic expression to be an integer, got \""
|
||||
<> show lhs <> "\" and \"" <> show rhs <> "\""
|
||||
show (InvalidConditionTypeError got) =
|
||||
"Expected a condition to be a boolean, got: " <> show got
|
||||
show (ArrayIndexError got) =
|
||||
"Expected an array index expression to be an integer, got: " <> show got
|
||||
show (ArrayAccessError got) =
|
||||
"Expected to encounter an array, got: " <> show got
|
||||
|
||||
newtype TypeAnalysis a = TypeAnalysis
|
||||
{ runTypeAnalysis :: ReaderT SymbolTable (Except Error) a
|
||||
}
|
||||
|
||||
instance Functor TypeAnalysis
|
||||
where
|
||||
fmap f (TypeAnalysis x) = TypeAnalysis $ f <$> x
|
||||
|
||||
instance Applicative TypeAnalysis
|
||||
where
|
||||
pure = TypeAnalysis . pure
|
||||
(TypeAnalysis f) <*> (TypeAnalysis x) = TypeAnalysis $ f <*> x
|
||||
|
||||
instance Monad TypeAnalysis
|
||||
where
|
||||
(TypeAnalysis x) >>= f = TypeAnalysis $ x >>= (runTypeAnalysis . f)
|
||||
|
||||
program :: AST.Program -> TypeAnalysis ()
|
||||
program (AST.Program declarations) = traverse_ declaration declarations
|
||||
|
||||
declaration :: AST.Declaration -> TypeAnalysis ()
|
||||
declaration (AST.ProcedureDeclaration procedureName _ _ body) = do
|
||||
globalTable <- TypeAnalysis ask
|
||||
case SymbolTable.lookup procedureName globalTable of
|
||||
Just (ProcedureInfo localTable _) -> TypeAnalysis
|
||||
$ withReaderT (const localTable)
|
||||
$ runTypeAnalysis
|
||||
$ traverse_ (statement globalTable) body
|
||||
Just anotherInfo -> TypeAnalysis $ lift $ throwE
|
||||
$ UnexpectedProcedureInfoError anotherInfo
|
||||
Nothing -> TypeAnalysis $ lift $ throwE
|
||||
$ UndefinedSymbolError procedureName
|
||||
declaration (AST.TypeDefinition _ _) = pure ()
|
||||
|
||||
statement :: SymbolTable -> AST.Statement -> TypeAnalysis ()
|
||||
statement globalTable = \case
|
||||
AST.EmptyStatement -> pure ()
|
||||
AST.AssignmentStatement lhs rhs -> do
|
||||
lhsType <- variableAccess globalTable lhs
|
||||
rhsType <- expression globalTable rhs
|
||||
unless (lhsType == intType)
|
||||
$ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError lhsType
|
||||
unless (rhsType == intType)
|
||||
$ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError rhsType
|
||||
AST.WhileStatement whileCondition whileStatement -> do
|
||||
conditionType <- condition globalTable whileCondition
|
||||
unless (conditionType == booleanType)
|
||||
$ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError conditionType
|
||||
statement globalTable whileStatement
|
||||
AST.IfStatement ifCondition ifStatement elseStatement -> do
|
||||
conditionType <- condition globalTable ifCondition
|
||||
unless (conditionType == booleanType)
|
||||
$ TypeAnalysis $ lift $ throwE $ InvalidConditionTypeError conditionType
|
||||
statement globalTable ifStatement
|
||||
maybe (pure ()) (statement globalTable) elseStatement
|
||||
AST.CompoundStatement statements -> traverse_ (statement globalTable) statements
|
||||
AST.CallStatement procedureName arguments ->
|
||||
case SymbolTable.lookup procedureName globalTable of
|
||||
Just (ProcedureInfo _ parameters)
|
||||
| parametersLength <- Vector.length parameters
|
||||
, argumentsLength <- length arguments
|
||||
, Vector.length parameters /= length arguments -> TypeAnalysis $ lift $ throwE
|
||||
$ ParameterCountMismatchError parametersLength argumentsLength
|
||||
| otherwise -> traverse_ (uncurry checkArgument)
|
||||
$ Vector.zip parameters (Vector.fromList arguments)
|
||||
Just anotherInfo -> TypeAnalysis $ lift $ throwE
|
||||
$ UnexpectedVariableInfoError anotherInfo
|
||||
Nothing -> TypeAnalysis $ lift $ throwE
|
||||
$ UndefinedSymbolError procedureName
|
||||
where
|
||||
checkArgument ParameterInfo{} _argument = pure () {-
|
||||
argumentType <- expression globalTable argument
|
||||
unless (argumentType == type')
|
||||
$ TypeAnalysis $ lift $ throwE $ ArgumentTypeMismatchError type' argumentType
|
||||
when (isReferenceParameter && not (isLvalue argument))
|
||||
$ TypeAnalysis $ lift $ throwE $ ExpectedLvalueError argument
|
||||
isLvalue (AST.VariableExpression _) = True
|
||||
isLvalue _ = False -}
|
||||
|
||||
variableAccess :: SymbolTable -> AST.VariableAccess -> TypeAnalysis Type
|
||||
variableAccess globalTable (AST.VariableAccess identifier) = do
|
||||
localLookup <- TypeAnalysis $ asks $ SymbolTable.lookup identifier
|
||||
case localLookup <|> SymbolTable.lookup identifier globalTable of
|
||||
Just (VariableInfo _ variableType) -> pure variableType
|
||||
Just anotherInfo -> TypeAnalysis $ lift $ throwE
|
||||
$ UnexpectedVariableInfoError anotherInfo
|
||||
Nothing -> TypeAnalysis $ lift $ throwE
|
||||
$ UndefinedSymbolError identifier
|
||||
variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression) = do
|
||||
arrayType <- variableAccess globalTable arrayExpression
|
||||
indexType <- expression globalTable indexExpression
|
||||
unless (indexType == intType)
|
||||
$ TypeAnalysis $ lift $ throwE $ ArrayIndexError indexType
|
||||
case arrayType of
|
||||
ArrayType _ baseType -> pure baseType
|
||||
nonArrayType -> TypeAnalysis $ lift $ throwE
|
||||
$ ArrayAccessError nonArrayType
|
||||
|
||||
expression :: SymbolTable -> AST.Expression -> TypeAnalysis Type
|
||||
expression globalTable = \case
|
||||
AST.VariableExpression variableExpression ->
|
||||
variableAccess globalTable variableExpression
|
||||
AST.LiteralExpression literal' -> literal literal'
|
||||
AST.NegationExpression negation -> do
|
||||
operandType <- expression globalTable negation
|
||||
if operandType == intType
|
||||
then pure intType
|
||||
else TypeAnalysis $ lift $ throwE $ ArithmeticExpressionError operandType
|
||||
AST.SumExpression lhs rhs -> arithmeticExpression lhs rhs
|
||||
AST.SubtractionExpression lhs rhs -> arithmeticExpression lhs rhs
|
||||
AST.ProductExpression lhs rhs -> arithmeticExpression lhs rhs
|
||||
AST.DivisionExpression lhs rhs -> arithmeticExpression lhs rhs
|
||||
where
|
||||
arithmeticExpression lhs rhs = do
|
||||
lhsType <- expression globalTable lhs
|
||||
unless (lhsType == intType)
|
||||
$ TypeAnalysis $ lift $ throwE $ ArithmeticExpressionError lhsType
|
||||
rhsType <- expression globalTable rhs
|
||||
unless (rhsType == intType)
|
||||
$ TypeAnalysis $ lift $ throwE $ ArithmeticExpressionError rhsType
|
||||
pure intType
|
||||
|
||||
condition :: SymbolTable -> AST.Condition -> TypeAnalysis Type
|
||||
condition globalTable = \case
|
||||
AST.EqualCondition lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.NonEqualCondition lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.LessCondition lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.GreaterCondition lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.LessOrEqualCondition lhs rhs -> comparisonExpression lhs rhs
|
||||
AST.GreaterOrEqualCondition lhs rhs -> comparisonExpression lhs rhs
|
||||
where
|
||||
comparisonExpression lhs rhs = do
|
||||
lhsType <- expression globalTable lhs
|
||||
rhsType <- expression globalTable rhs
|
||||
if lhsType == intType && rhsType == intType
|
||||
then pure booleanType
|
||||
else TypeAnalysis $ lift $ throwE $ ComparisonExpressionError lhsType rhsType
|
||||
|
||||
literal :: AST.Literal -> TypeAnalysis Type
|
||||
literal (AST.DecimalLiteral _) = pure intType
|
||||
literal (AST.HexadecimalLiteral _) = pure intType
|
||||
literal (AST.CharacterLiteral _) = pure intType
|
||||
33
lib/Language/Elna/Frontend/Types.hs
Normal file
33
lib/Language/Elna/Frontend/Types.hs
Normal file
@ -0,0 +1,33 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.Frontend.Types
|
||||
( Type(..)
|
||||
, addressByteSize
|
||||
, booleanType
|
||||
, intType
|
||||
) where
|
||||
|
||||
import Data.Text (Text)
|
||||
import Data.Word (Word32)
|
||||
import Language.Elna.Location (showArrayType)
|
||||
|
||||
addressByteSize :: Int
|
||||
addressByteSize = 4
|
||||
|
||||
data Type
|
||||
= PrimitiveType Text Int
|
||||
| ArrayType Word32 Type
|
||||
deriving Eq
|
||||
|
||||
instance Show Type
|
||||
where
|
||||
show (PrimitiveType typeName _) = show typeName
|
||||
show (ArrayType elementCount typeName) = showArrayType elementCount typeName
|
||||
|
||||
intType :: Type
|
||||
intType = PrimitiveType "int" 4
|
||||
|
||||
booleanType :: Type
|
||||
booleanType = PrimitiveType "boolean" 1
|
||||
312
lib/Language/Elna/Glue.hs
Normal file
312
lib/Language/Elna/Glue.hs
Normal file
@ -0,0 +1,312 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.Glue
|
||||
( glue
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (State, gets, modify', runState)
|
||||
import Data.Bifunctor (Bifunctor(..))
|
||||
import Data.Foldable (Foldable(..), traverse_)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Vector (Vector)
|
||||
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
|
||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
||||
import qualified Data.Text.Lazy as Text.Lazy
|
||||
import qualified Data.Vector as Vector
|
||||
import Data.Word (Word32)
|
||||
import qualified Language.Elna.Frontend.AST as AST
|
||||
import Language.Elna.Frontend.Types (Type(..))
|
||||
import Language.Elna.Backend.Intermediate
|
||||
( Label(..)
|
||||
, Operand(..)
|
||||
, Quadruple(..)
|
||||
, Variable(..)
|
||||
)
|
||||
import Language.Elna.Frontend.SymbolTable (Info(..), SymbolTable)
|
||||
import qualified Language.Elna.Frontend.SymbolTable as SymbolTable
|
||||
import GHC.Records (HasField(..))
|
||||
import Language.Elna.Frontend.AST (Identifier(..))
|
||||
import Debug.Trace (traceShow)
|
||||
|
||||
data Paste = Paste
|
||||
{ temporaryCounter :: Word32
|
||||
, labelCounter :: Word32
|
||||
, localMap :: HashMap Identifier Variable
|
||||
}
|
||||
|
||||
newtype Glue a = Glue
|
||||
{ runGlue :: State Paste a }
|
||||
|
||||
instance Functor Glue
|
||||
where
|
||||
fmap f (Glue x) = Glue $ f <$> x
|
||||
|
||||
instance Applicative Glue
|
||||
where
|
||||
pure = Glue . pure
|
||||
(Glue f) <*> (Glue x) = Glue $ f <*> x
|
||||
|
||||
instance Monad Glue
|
||||
where
|
||||
(Glue x) >>= f = Glue $ x >>= (runGlue . f)
|
||||
|
||||
glue :: SymbolTable -> AST.Program -> HashMap Identifier (Vector (Quadruple Variable))
|
||||
glue globalTable
|
||||
= fst
|
||||
. flip runState emptyPaste
|
||||
. runGlue
|
||||
. program globalTable
|
||||
where
|
||||
emptyPaste = Paste
|
||||
{ temporaryCounter = 0
|
||||
, labelCounter = 0
|
||||
, localMap = mempty
|
||||
}
|
||||
|
||||
program :: SymbolTable -> AST.Program -> Glue (HashMap Identifier (Vector (Quadruple Variable)))
|
||||
program globalTable (AST.Program declarations)
|
||||
= HashMap.fromList . catMaybes
|
||||
<$> traverse (declaration globalTable) declarations
|
||||
|
||||
declaration
|
||||
:: SymbolTable
|
||||
-> AST.Declaration
|
||||
-> Glue (Maybe (AST.Identifier, Vector (Quadruple Variable)))
|
||||
declaration globalTable (AST.ProcedureDeclaration procedureName parameters variableDeclarations statements) =
|
||||
let Just (ProcedureInfo localTable _) = SymbolTable.lookup procedureName globalTable
|
||||
in Glue (modify' resetTemporaryCounter)
|
||||
>> traverseWithIndex registerVariable variableDeclarations
|
||||
>> traverseWithIndex registerParameter (reverse parameters)
|
||||
>> nameQuadruplesTuple <$> traverse (statement localTable) statements
|
||||
where
|
||||
traverseWithIndex f = traverse_ (uncurry f) . zip [0..]
|
||||
registerParameter index (AST.Parameter identifier _ _) =
|
||||
Glue $ modify' $ modifier identifier $ ParameterVariable index
|
||||
registerVariable index (AST.VariableDeclaration identifier _) =
|
||||
Glue $ modify' $ modifier identifier $ LocalVariable index
|
||||
modifier identifier currentCounter generator = generator
|
||||
{ localMap = HashMap.insert identifier currentCounter
|
||||
$ getField @"localMap" generator
|
||||
}
|
||||
nameQuadruplesTuple quadrupleList = Just
|
||||
( procedureName
|
||||
, Vector.cons StartQuadruple
|
||||
$ flip Vector.snoc StopQuadruple
|
||||
$ fold quadrupleList
|
||||
)
|
||||
resetTemporaryCounter paste = paste
|
||||
{ temporaryCounter = 0
|
||||
, localMap = mempty
|
||||
}
|
||||
declaration _ (AST.TypeDefinition _ _) = pure Nothing
|
||||
|
||||
statement :: SymbolTable -> AST.Statement -> Glue (Vector (Quadruple Variable))
|
||||
statement _ AST.EmptyStatement = pure mempty
|
||||
statement localTable (AST.CallStatement (AST.Identifier callName) arguments) = do
|
||||
visitedArguments <- traverse (expression localTable) arguments
|
||||
let (parameterStatements, argumentStatements)
|
||||
= bimap (Vector.fromList . fmap ParameterQuadruple) Vector.concat
|
||||
$ unzip visitedArguments
|
||||
in pure
|
||||
$ Vector.snoc (argumentStatements <> parameterStatements)
|
||||
$ CallQuadruple callName
|
||||
$ fromIntegral
|
||||
$ length arguments
|
||||
statement localTable (AST.CompoundStatement statements) =
|
||||
fold <$> traverse (statement localTable) statements
|
||||
statement localTable (AST.IfStatement ifCondition ifStatement elseStatement) = do
|
||||
(conditionStatements, jumpConstructor) <- condition localTable ifCondition
|
||||
ifLabel <- createLabel
|
||||
endLabel <- createLabel
|
||||
ifStatements <- statement localTable ifStatement
|
||||
possibleElseStatements <- traverse (statement localTable) elseStatement
|
||||
pure $ conditionStatements <> case possibleElseStatements of
|
||||
Just elseStatements -> Vector.cons (jumpConstructor ifLabel) elseStatements
|
||||
<> Vector.fromList [GoToQuadruple endLabel, LabelQuadruple ifLabel]
|
||||
<> Vector.snoc ifStatements (LabelQuadruple endLabel)
|
||||
Nothing -> Vector.fromList [jumpConstructor ifLabel, GoToQuadruple endLabel, LabelQuadruple ifLabel]
|
||||
<> Vector.snoc ifStatements (LabelQuadruple endLabel)
|
||||
statement localTable (AST.AssignmentStatement variableAccess' assignee) = do
|
||||
(rhsOperand, rhsStatements) <- expression localTable assignee
|
||||
let variableType' = variableType variableAccess' localTable
|
||||
accessResult <- variableAccess localTable variableAccess' Nothing variableType' mempty
|
||||
lhsStatements <- case accessResult of
|
||||
(identifier, Just accumulatedIndex, accumulatedStatements)
|
||||
-> Vector.snoc accumulatedStatements
|
||||
. ArrayAssignQuadruple rhsOperand accumulatedIndex
|
||||
<$> lookupLocal identifier
|
||||
(identifier, Nothing, accumulatedStatements)
|
||||
-> Vector.snoc accumulatedStatements
|
||||
. AssignQuadruple rhsOperand
|
||||
<$> lookupLocal identifier
|
||||
pure $ rhsStatements <> lhsStatements
|
||||
statement localTable (AST.WhileStatement whileCondition whileStatement) = do
|
||||
(conditionStatements, jumpConstructor) <- condition localTable whileCondition
|
||||
startLabel <- createLabel
|
||||
endLabel <- createLabel
|
||||
conditionLabel <- createLabel
|
||||
whileStatements <- statement localTable whileStatement
|
||||
pure $ Vector.fromList [LabelQuadruple conditionLabel]
|
||||
<> conditionStatements
|
||||
<> Vector.fromList [jumpConstructor startLabel, GoToQuadruple endLabel, LabelQuadruple startLabel]
|
||||
<> whileStatements
|
||||
<> Vector.fromList [GoToQuadruple conditionLabel, LabelQuadruple endLabel]
|
||||
|
||||
createTemporary :: Glue Variable
|
||||
createTemporary = do
|
||||
currentCounter <- Glue $ gets $ getField @"temporaryCounter"
|
||||
Glue $ modify' modifier
|
||||
pure $ TempVariable currentCounter
|
||||
where
|
||||
modifier generator = generator
|
||||
{ temporaryCounter = getField @"temporaryCounter" generator + 1
|
||||
}
|
||||
|
||||
lookupLocal :: Identifier -> Glue Variable
|
||||
lookupLocal identifier =
|
||||
fmap (HashMap.! identifier) $ Glue $ gets $ getField @"localMap"
|
||||
|
||||
createLabel :: Glue Label
|
||||
createLabel = do
|
||||
currentCounter <- Glue $ gets $ getField @"labelCounter"
|
||||
Glue $ modify' modifier
|
||||
pure $ Label
|
||||
$ Text.Lazy.toStrict
|
||||
$ Text.Builder.toLazyText
|
||||
$ ".L" <> Text.Builder.decimal currentCounter
|
||||
where
|
||||
modifier generator = generator
|
||||
{ labelCounter = getField @"labelCounter" generator + 1
|
||||
}
|
||||
|
||||
condition
|
||||
:: SymbolTable
|
||||
-> AST.Condition
|
||||
-> Glue (Vector (Quadruple Variable), Label -> Quadruple Variable)
|
||||
condition localTable (AST.EqualCondition lhs rhs) = do
|
||||
(lhsOperand, lhsStatements) <- expression localTable lhs
|
||||
(rhsOperand, rhsStatements) <- expression localTable rhs
|
||||
pure
|
||||
( lhsStatements <> rhsStatements
|
||||
, EqualQuadruple lhsOperand rhsOperand
|
||||
)
|
||||
condition localTable (AST.NonEqualCondition lhs rhs) = do
|
||||
(lhsOperand, lhsStatements) <- expression localTable lhs
|
||||
(rhsOperand, rhsStatements) <- expression localTable rhs
|
||||
pure
|
||||
( lhsStatements <> rhsStatements
|
||||
, NonEqualQuadruple lhsOperand rhsOperand
|
||||
)
|
||||
condition localTable (AST.LessCondition lhs rhs) = do
|
||||
(lhsOperand, lhsStatements) <- expression localTable lhs
|
||||
(rhsOperand, rhsStatements) <- expression localTable rhs
|
||||
pure (lhsStatements <> rhsStatements, LessQuadruple lhsOperand rhsOperand)
|
||||
condition localTable (AST.GreaterCondition lhs rhs) = do
|
||||
(lhsOperand, lhsStatements) <- expression localTable lhs
|
||||
(rhsOperand, rhsStatements) <- expression localTable rhs
|
||||
pure
|
||||
( lhsStatements <> rhsStatements
|
||||
, GreaterQuadruple lhsOperand rhsOperand
|
||||
)
|
||||
condition localTable (AST.LessOrEqualCondition lhs rhs) = do
|
||||
(lhsOperand, lhsStatements) <- expression localTable lhs
|
||||
(rhsOperand, rhsStatements) <- expression localTable rhs
|
||||
pure
|
||||
( lhsStatements <> rhsStatements
|
||||
, LessOrEqualQuadruple lhsOperand rhsOperand
|
||||
)
|
||||
condition localTable (AST.GreaterOrEqualCondition lhs rhs) = do
|
||||
(lhsOperand, lhsStatements) <- expression localTable lhs
|
||||
(rhsOperand, rhsStatements) <- expression localTable rhs
|
||||
pure
|
||||
( lhsStatements <> rhsStatements
|
||||
, GreaterOrEqualQuadruple lhsOperand rhsOperand
|
||||
)
|
||||
|
||||
variableAccess
|
||||
:: SymbolTable
|
||||
-> AST.VariableAccess
|
||||
-> Maybe (Operand Variable)
|
||||
-> Type
|
||||
-> Vector (Quadruple Variable)
|
||||
-> Glue (AST.Identifier, Maybe (Operand Variable), Vector (Quadruple Variable))
|
||||
variableAccess _ (AST.VariableAccess identifier) accumulatedIndex _ accumulatedStatements =
|
||||
pure (identifier, accumulatedIndex, accumulatedStatements)
|
||||
variableAccess localTable accessKind accumulatedIndex arrayType statements
|
||||
| (AST.ArrayAccess access1 index1) <- accessKind
|
||||
, (ArrayType arraySize baseType) <- arrayType = do
|
||||
(indexPlace, statements') <- expression localTable index1
|
||||
case accumulatedIndex of
|
||||
Just baseIndex -> do
|
||||
resultVariable <- createTemporary
|
||||
let resultOperand = VariableOperand resultVariable
|
||||
indexCalculation = Vector.fromList
|
||||
[ ProductQuadruple (IntOperand $ fromIntegral arraySize) baseIndex resultVariable
|
||||
, AddQuadruple indexPlace resultOperand resultVariable
|
||||
]
|
||||
in variableAccess localTable access1 (Just resultOperand) baseType
|
||||
$ statements <> indexCalculation <> statements'
|
||||
Nothing ->
|
||||
variableAccess localTable access1 (Just indexPlace) baseType statements'
|
||||
variableAccess _ _ _ _ _ = error "Array access operator doesn't match the type."
|
||||
|
||||
variableType :: AST.VariableAccess -> SymbolTable -> Type
|
||||
variableType (AST.VariableAccess identifier) symbolTable
|
||||
| Just (TypeInfo type') <- SymbolTable.lookup identifier symbolTable = type'
|
||||
| Just (VariableInfo _ type') <- SymbolTable.lookup identifier symbolTable = type'
|
||||
| otherwise = traceShow identifier $ error "Undefined type."
|
||||
variableType (AST.ArrayAccess arrayAccess' _) symbolTable =
|
||||
variableType arrayAccess' symbolTable
|
||||
|
||||
expression :: SymbolTable -> AST.Expression -> Glue (Operand Variable, Vector (Quadruple Variable))
|
||||
expression localTable = \case
|
||||
(AST.LiteralExpression literal') -> pure (literal literal', mempty)
|
||||
(AST.SumExpression lhs rhs) -> binaryExpression AddQuadruple lhs rhs
|
||||
(AST.SubtractionExpression lhs rhs) ->
|
||||
binaryExpression SubtractionQuadruple lhs rhs
|
||||
(AST.NegationExpression negation) -> do
|
||||
(operand, statements) <- expression localTable negation
|
||||
tempVariable <- createTemporary
|
||||
let negationQuadruple = NegationQuadruple operand tempVariable
|
||||
pure
|
||||
( VariableOperand tempVariable
|
||||
, Vector.snoc statements negationQuadruple
|
||||
)
|
||||
(AST.ProductExpression lhs rhs) ->
|
||||
binaryExpression ProductQuadruple lhs rhs
|
||||
(AST.DivisionExpression lhs rhs) ->
|
||||
binaryExpression DivisionQuadruple lhs rhs
|
||||
(AST.VariableExpression variableExpression) -> do
|
||||
let variableType' = variableType variableExpression localTable
|
||||
variableAccess' <- variableAccess localTable variableExpression Nothing variableType' mempty
|
||||
case variableAccess' of
|
||||
(identifier, Nothing, statements)
|
||||
-> (, statements) . VariableOperand
|
||||
<$> lookupLocal identifier
|
||||
(identifier, Just operand, statements) -> do
|
||||
arrayAddress <- createTemporary
|
||||
localVariable <- lookupLocal identifier
|
||||
let arrayStatement = ArrayQuadruple localVariable operand arrayAddress
|
||||
pure
|
||||
( VariableOperand arrayAddress
|
||||
, Vector.snoc statements arrayStatement
|
||||
)
|
||||
where
|
||||
binaryExpression f lhs rhs = do
|
||||
(lhsOperand, lhsStatements) <- expression localTable lhs
|
||||
(rhsOperand, rhsStatements) <- expression localTable rhs
|
||||
tempVariable <- createTemporary
|
||||
let newQuadruple = f lhsOperand rhsOperand tempVariable
|
||||
pure
|
||||
( VariableOperand tempVariable
|
||||
, Vector.snoc (lhsStatements <> rhsStatements) newQuadruple
|
||||
)
|
||||
|
||||
literal :: AST.Literal -> Operand Variable
|
||||
literal (AST.DecimalLiteral integer) = IntOperand integer
|
||||
literal (AST.HexadecimalLiteral integer) = IntOperand integer
|
||||
literal (AST.CharacterLiteral character) = IntOperand $ fromIntegral character
|
||||
62
lib/Language/Elna/Location.hs
Normal file
62
lib/Language/Elna/Location.hs
Normal file
@ -0,0 +1,62 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.Location
|
||||
( Identifier(..)
|
||||
, Location(..)
|
||||
, Node(..)
|
||||
, showArrayType
|
||||
) where
|
||||
|
||||
import Data.Hashable (Hashable(..))
|
||||
import Data.String (IsString(..))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Word (Word32)
|
||||
|
||||
data Location = Location
|
||||
{ line :: Word32
|
||||
, column :: Word32
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance Semigroup Location
|
||||
where
|
||||
(Location thisLine thisColumn) <> (Location thatLine thatColumn) = Location
|
||||
{ line = thisLine + thatLine
|
||||
, column = thisColumn + thatColumn
|
||||
}
|
||||
|
||||
instance Monoid Location
|
||||
where
|
||||
mempty = Location{ line = 1, column = 1 }
|
||||
|
||||
data Node a = Node a Location
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Functor Node
|
||||
where
|
||||
fmap f (Node node location) = Node (f node) location
|
||||
|
||||
newtype Identifier = Identifier { unIdentifier :: Text }
|
||||
deriving Eq
|
||||
|
||||
instance Show Identifier
|
||||
where
|
||||
show (Identifier identifier) = Text.unpack identifier
|
||||
|
||||
instance IsString Identifier
|
||||
where
|
||||
fromString = Identifier . Text.pack
|
||||
|
||||
instance Ord Identifier
|
||||
where
|
||||
compare (Identifier lhs) (Identifier rhs) = compare lhs rhs
|
||||
|
||||
instance Hashable Identifier
|
||||
where
|
||||
hashWithSalt salt (Identifier identifier) = hashWithSalt salt identifier
|
||||
|
||||
showArrayType :: (Show a, Show b) => a -> b -> String
|
||||
showArrayType elementCount typeName = concat
|
||||
["array[", show elementCount, "] of ", show typeName]
|
||||
492
lib/Language/Elna/Object/Elf.hs
Normal file
492
lib/Language/Elna/Object/Elf.hs
Normal file
@ -0,0 +1,492 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.Object.Elf
|
||||
( ByteOrder(..)
|
||||
, Elf32_Addr
|
||||
, Elf32_Off
|
||||
, Elf32_Half
|
||||
, Elf32_Word
|
||||
, Elf32_Sword
|
||||
, Elf32_Ehdr(..)
|
||||
, Elf32_Rel(..)
|
||||
, Elf32_Rela(..)
|
||||
, Elf32_Shdr(..)
|
||||
, Elf32_Sym(..)
|
||||
, ElfEncodingError(..)
|
||||
, ElfIdentification(..)
|
||||
, ElfMachine(..)
|
||||
, ElfVersion(..)
|
||||
, ElfClass(..)
|
||||
, ElfData(..)
|
||||
, ElfType(..)
|
||||
, ElfSectionType(..)
|
||||
, ElfSymbolBinding(..)
|
||||
, ElfSymbolType(..)
|
||||
, byteOrder
|
||||
, elf32Addr
|
||||
, elf32Half
|
||||
, elf32Off
|
||||
, elf32Shdr
|
||||
, elf32Sword
|
||||
, elf32Word
|
||||
, elf32Ehdr
|
||||
, elf32Rel
|
||||
, elf32Rela
|
||||
, elf32Sym
|
||||
, elfIdentification
|
||||
, rInfo
|
||||
, shfWrite
|
||||
, shfAlloc
|
||||
, shfExecinstr
|
||||
, shfMascproc
|
||||
, shfInfoLink
|
||||
, stInfo
|
||||
) where
|
||||
|
||||
import Control.Exception (Exception(..))
|
||||
import Data.Bits (Bits(..))
|
||||
import qualified Data.ByteString.Builder as ByteString.Builder
|
||||
import Data.Int (Int32)
|
||||
import Data.Word (Word8, Word16, Word32)
|
||||
import qualified Data.ByteString as ByteString
|
||||
|
||||
-- * Data types.
|
||||
|
||||
type Elf32_Addr = Word32 -- ^ Unsigned program address.
|
||||
type Elf32_Half = Word16 -- ^ Unsigned medium integer.
|
||||
type Elf32_Off = Word32 -- ^ Unsigned file offset.
|
||||
type Elf32_Sword = Int32 -- ^ Signed large integer.
|
||||
type Elf32_Word = Word32 -- ^ Unsigned large integer.
|
||||
|
||||
data ElfClass
|
||||
= ELFCLASSNONE -- ^ Invalid class.
|
||||
| ELFCLASS32 -- ^ 32-bit objects.
|
||||
| ELFCLASS64 -- ^ 64-bit objects.
|
||||
deriving Eq
|
||||
|
||||
instance Show ElfClass
|
||||
where
|
||||
show ELFCLASSNONE = "ELFCLASSNONE"
|
||||
show ELFCLASS32 = "ELFCLASS32"
|
||||
show ELFCLASS64 = "ELFCLASS64"
|
||||
|
||||
instance Enum ElfClass
|
||||
where
|
||||
toEnum 0 = ELFCLASSNONE
|
||||
toEnum 1 = ELFCLASS32
|
||||
toEnum 2 = ELFCLASS64
|
||||
toEnum _ = error "Unknown Elf class"
|
||||
fromEnum ELFCLASSNONE = 0
|
||||
fromEnum ELFCLASS32 = 1
|
||||
fromEnum ELFCLASS64 = 1
|
||||
|
||||
-- | Data encoding.
|
||||
data ElfData
|
||||
= ELFDATANONE
|
||||
| ELFDATA2LSB
|
||||
| ELFDATA2MSB
|
||||
deriving Eq
|
||||
|
||||
instance Show ElfData
|
||||
where
|
||||
show ELFDATANONE = "ELFDATANONE"
|
||||
show ELFDATA2LSB = "ELFDATA2LSB"
|
||||
show ELFDATA2MSB = "ELFDATA2MSB"
|
||||
|
||||
instance Enum ElfData
|
||||
where
|
||||
toEnum 0 = ELFDATANONE
|
||||
toEnum 1 = ELFDATA2LSB
|
||||
toEnum 2 = ELFDATA2MSB
|
||||
toEnum _ = error "Unknown elf data"
|
||||
fromEnum ELFDATANONE = 0
|
||||
fromEnum ELFDATA2LSB = 1
|
||||
fromEnum ELFDATA2MSB = 2
|
||||
|
||||
data ElfIdentification = ElfIdentification ElfClass ElfData
|
||||
deriving Eq
|
||||
|
||||
-- | ELF header.
|
||||
data Elf32_Ehdr = Elf32_Ehdr
|
||||
{ e_ident :: ElfIdentification
|
||||
, e_type :: ElfType
|
||||
, e_machine :: ElfMachine
|
||||
, e_version :: ElfVersion
|
||||
, e_entry :: Elf32_Addr
|
||||
, e_phoff :: Elf32_Off
|
||||
, e_shoff :: Elf32_Off
|
||||
, e_flags :: Elf32_Word
|
||||
, e_ehsize :: Elf32_Half
|
||||
, e_phentsize :: Elf32_Half
|
||||
, e_phnum :: Elf32_Half
|
||||
, e_shentsize :: Elf32_Half
|
||||
, e_shnum :: Elf32_Half
|
||||
, e_shstrndx :: Elf32_Half
|
||||
} deriving Eq
|
||||
|
||||
-- | Section header.
|
||||
data Elf32_Shdr = Elf32_Shdr
|
||||
{ sh_name :: Elf32_Word
|
||||
, sh_type :: ElfSectionType
|
||||
, sh_flags :: Elf32_Word
|
||||
, sh_addr :: Elf32_Addr
|
||||
, sh_offset :: Elf32_Off
|
||||
, sh_size :: Elf32_Word
|
||||
, sh_link :: Elf32_Word
|
||||
, sh_info :: Elf32_Word
|
||||
, sh_addralign :: Elf32_Word
|
||||
, sh_entsize :: Elf32_Word
|
||||
} deriving Eq
|
||||
|
||||
data ElfMachine
|
||||
= ElfMachine Elf32_Half
|
||||
| EM_NONE -- ^ No machine.
|
||||
| EM_M32 -- ^ AT&T WE 32100.
|
||||
| EM_SPARC -- ^ SPARC.
|
||||
| EM_386 -- ^ Intel Architecture.
|
||||
| EM_68K -- ^ Motorola 68000.
|
||||
| EM_88K -- ^ Motorola 88000.
|
||||
| EM_860 -- ^ Intel 80860.
|
||||
| EM_MIPS -- ^ MIPS RS3000 Big-Endian.
|
||||
| EM_MIPS_RS4_BE -- ^ MIPS RS4000 Big-Endian.
|
||||
| EM_RISCV -- ^ RISC-V.
|
||||
deriving Eq
|
||||
|
||||
instance Enum ElfMachine
|
||||
where
|
||||
toEnum 0x0 = EM_NONE
|
||||
toEnum 0x1 = EM_M32
|
||||
toEnum 0x2 = EM_SPARC
|
||||
toEnum 0x3 = EM_386
|
||||
toEnum 0x4 = EM_68K
|
||||
toEnum 0x5 = EM_88K
|
||||
toEnum 0x7 = EM_860
|
||||
toEnum 0x8 = EM_MIPS
|
||||
toEnum 0xa = EM_MIPS_RS4_BE
|
||||
toEnum 0xf3 = EM_RISCV
|
||||
toEnum x = ElfMachine $ fromIntegral x
|
||||
fromEnum EM_NONE = 0x0
|
||||
fromEnum EM_M32 = 0x1
|
||||
fromEnum EM_SPARC = 0x2
|
||||
fromEnum EM_386 = 0x3
|
||||
fromEnum EM_68K = 0x4
|
||||
fromEnum EM_88K = 0x5
|
||||
fromEnum EM_860 = 0x7
|
||||
fromEnum EM_MIPS = 0x8
|
||||
fromEnum EM_MIPS_RS4_BE = 0xa
|
||||
fromEnum EM_RISCV = 0xf3
|
||||
fromEnum (ElfMachine x) = fromIntegral x
|
||||
|
||||
data ElfVersion
|
||||
= ElfVersion Elf32_Word
|
||||
| EV_NONE -- ^ Invalid versionn.
|
||||
| EV_CURRENT -- ^ Current version.
|
||||
deriving Eq
|
||||
|
||||
instance Enum ElfVersion
|
||||
where
|
||||
toEnum 0 = EV_NONE
|
||||
toEnum 1 = EV_CURRENT
|
||||
toEnum x = ElfVersion $ fromIntegral x
|
||||
fromEnum EV_NONE = 0
|
||||
fromEnum EV_CURRENT = 1
|
||||
fromEnum (ElfVersion x) = fromIntegral x
|
||||
|
||||
data ElfType
|
||||
= ElfType Elf32_Half
|
||||
| ET_NONE -- ^ No file type.
|
||||
| ET_REL -- ^ Relocatable file.
|
||||
| ET_EXEC -- ^ Executable file.
|
||||
| ET_DYN -- ^ Shared object file.
|
||||
| ET_CORE -- ^ Core file.
|
||||
| ET_LOPROC -- ^ Processor-specific.
|
||||
| ET_HIPROC -- ^ Processor-specific.
|
||||
deriving Eq
|
||||
|
||||
instance Enum ElfType
|
||||
where
|
||||
toEnum 0 = ET_NONE
|
||||
toEnum 1 = ET_REL
|
||||
toEnum 2 = ET_EXEC
|
||||
toEnum 3 = ET_DYN
|
||||
toEnum 4 = ET_CORE
|
||||
toEnum 0xff00 = ET_LOPROC
|
||||
toEnum 0xffff = ET_HIPROC
|
||||
toEnum x = ElfType $ fromIntegral x
|
||||
fromEnum ET_NONE = 0
|
||||
fromEnum ET_REL = 1
|
||||
fromEnum ET_EXEC = 2
|
||||
fromEnum ET_DYN = 3
|
||||
fromEnum ET_CORE = 4
|
||||
fromEnum ET_LOPROC = 0xff00
|
||||
fromEnum ET_HIPROC = 0xffff
|
||||
fromEnum (ElfType x) = fromIntegral x
|
||||
|
||||
data Elf32_Sym = Elf32_Sym
|
||||
{ st_name :: Elf32_Word
|
||||
, st_value :: Elf32_Addr
|
||||
, st_size :: Elf32_Word
|
||||
, st_info :: Word8
|
||||
, st_other :: Word8
|
||||
, st_shndx :: Elf32_Half
|
||||
} deriving Eq
|
||||
|
||||
data ElfSymbolBinding
|
||||
= ElfSymbolBinding Word8
|
||||
| STB_LOCAL
|
||||
| STB_GLOBAL
|
||||
| STB_WEAK
|
||||
| STB_LOPROC
|
||||
| STB_HIPROC
|
||||
deriving Eq
|
||||
|
||||
instance Enum ElfSymbolBinding
|
||||
where
|
||||
toEnum 0 = STB_LOCAL
|
||||
toEnum 1 = STB_GLOBAL
|
||||
toEnum 2 = STB_WEAK
|
||||
toEnum 13 = STB_LOPROC
|
||||
toEnum 15 = STB_HIPROC
|
||||
toEnum x = ElfSymbolBinding $ fromIntegral x
|
||||
fromEnum STB_LOCAL = 0
|
||||
fromEnum STB_GLOBAL = 1
|
||||
fromEnum STB_WEAK = 2
|
||||
fromEnum STB_LOPROC = 13
|
||||
fromEnum STB_HIPROC = 15
|
||||
fromEnum (ElfSymbolBinding x) = fromIntegral x
|
||||
|
||||
data ElfSymbolType
|
||||
= ElfSymbolType Word8
|
||||
| STT_NOTYPE
|
||||
| STT_OBJECT
|
||||
| STT_FUNC
|
||||
| STT_SECTION
|
||||
| STT_FILE
|
||||
| STT_LOPROC
|
||||
| STT_HIPROC
|
||||
deriving Eq
|
||||
|
||||
instance Enum ElfSymbolType
|
||||
where
|
||||
toEnum 0 = STT_NOTYPE
|
||||
toEnum 1 = STT_OBJECT
|
||||
toEnum 2 = STT_FUNC
|
||||
toEnum 3 = STT_SECTION
|
||||
toEnum 4 = STT_FILE
|
||||
toEnum 13 = STT_LOPROC
|
||||
toEnum 15 = STT_HIPROC
|
||||
toEnum x = ElfSymbolType $ fromIntegral x
|
||||
fromEnum STT_NOTYPE = 0
|
||||
fromEnum STT_OBJECT = 1
|
||||
fromEnum STT_FUNC = 2
|
||||
fromEnum STT_SECTION = 3
|
||||
fromEnum STT_FILE = 4
|
||||
fromEnum STT_LOPROC = 13
|
||||
fromEnum STT_HIPROC = 15
|
||||
fromEnum (ElfSymbolType x) = fromIntegral x
|
||||
|
||||
data Elf32_Rel = Elf32_Rel
|
||||
{ r_offset :: Elf32_Addr
|
||||
, r_info :: Elf32_Word
|
||||
} deriving Eq
|
||||
|
||||
data Elf32_Rela = Elf32_Rela
|
||||
{ r_offset :: Elf32_Addr
|
||||
, r_info :: Elf32_Word
|
||||
, r_addend :: Elf32_Sword
|
||||
} deriving Eq
|
||||
|
||||
data ElfSectionType
|
||||
= ElfSectionType Elf32_Word
|
||||
| SHT_NULL
|
||||
| SHT_PROGBITS
|
||||
| SHT_SYMTAB
|
||||
| SHT_STRTAB
|
||||
| SHT_RELA
|
||||
| SHT_HASH
|
||||
| SHT_DYNAMIC
|
||||
| SHT_NOTE
|
||||
| SHT_NOBITS
|
||||
| SHT_REL
|
||||
| SHT_SHLIB
|
||||
| SHT_DYNSYM
|
||||
| SHT_LOPROC
|
||||
| SHT_HIPROC
|
||||
| SHT_LOUSER
|
||||
| SHT_HIUSER
|
||||
deriving Eq
|
||||
|
||||
instance Enum ElfSectionType
|
||||
where
|
||||
toEnum 0 = SHT_NULL
|
||||
toEnum 1 = SHT_PROGBITS
|
||||
toEnum 2 = SHT_SYMTAB
|
||||
toEnum 3 = SHT_STRTAB
|
||||
toEnum 4 = SHT_RELA
|
||||
toEnum 5 = SHT_HASH
|
||||
toEnum 6 = SHT_DYNAMIC
|
||||
toEnum 7 = SHT_NOTE
|
||||
toEnum 8 = SHT_NOBITS
|
||||
toEnum 9 = SHT_REL
|
||||
toEnum 10 = SHT_SHLIB
|
||||
toEnum 11 = SHT_DYNSYM
|
||||
toEnum 0x70000000 = SHT_LOPROC
|
||||
toEnum 0x7fffffff = SHT_HIPROC
|
||||
toEnum 0x80000000 = SHT_LOUSER
|
||||
toEnum 0xffffffff = SHT_HIUSER
|
||||
toEnum x = ElfSectionType $ fromIntegral x
|
||||
fromEnum SHT_NULL = 0
|
||||
fromEnum SHT_PROGBITS = 1
|
||||
fromEnum SHT_SYMTAB = 2
|
||||
fromEnum SHT_STRTAB = 3
|
||||
fromEnum SHT_RELA = 4
|
||||
fromEnum SHT_HASH = 5
|
||||
fromEnum SHT_DYNAMIC = 6
|
||||
fromEnum SHT_NOTE = 7
|
||||
fromEnum SHT_NOBITS = 8
|
||||
fromEnum SHT_REL = 9
|
||||
fromEnum SHT_SHLIB = 10
|
||||
fromEnum SHT_DYNSYM = 11
|
||||
fromEnum SHT_LOPROC = 0x70000000
|
||||
fromEnum SHT_HIPROC = 0x7fffffff
|
||||
fromEnum SHT_LOUSER = 0x80000000
|
||||
fromEnum SHT_HIUSER = 0xffffffff
|
||||
fromEnum (ElfSectionType x) = fromIntegral x
|
||||
|
||||
-- * Constants.
|
||||
|
||||
shfWrite :: Elf32_Word
|
||||
shfWrite = 0x1
|
||||
|
||||
shfAlloc :: Elf32_Word
|
||||
shfAlloc = 0x2
|
||||
|
||||
shfExecinstr:: Elf32_Word
|
||||
shfExecinstr = 0x4
|
||||
|
||||
shfMascproc :: Elf32_Word
|
||||
shfMascproc = 0xf0000000
|
||||
|
||||
shfInfoLink :: Elf32_Word
|
||||
shfInfoLink = 0x40
|
||||
|
||||
-- * Encoding functions.
|
||||
|
||||
elf32Addr :: ByteOrder -> Elf32_Addr -> ByteString.Builder.Builder
|
||||
elf32Addr LSB = ByteString.Builder.word32LE
|
||||
elf32Addr MSB = ByteString.Builder.word32BE
|
||||
|
||||
elf32Half :: ByteOrder -> Elf32_Half -> ByteString.Builder.Builder
|
||||
elf32Half LSB = ByteString.Builder.word16LE
|
||||
elf32Half MSB = ByteString.Builder.word16BE
|
||||
|
||||
elf32Off :: ByteOrder -> Elf32_Off -> ByteString.Builder.Builder
|
||||
elf32Off LSB = ByteString.Builder.word32LE
|
||||
elf32Off MSB = ByteString.Builder.word32BE
|
||||
|
||||
elf32Sword :: ByteOrder -> Elf32_Sword -> ByteString.Builder.Builder
|
||||
elf32Sword LSB = ByteString.Builder.int32LE
|
||||
elf32Sword MSB = ByteString.Builder.int32BE
|
||||
|
||||
elf32Word :: ByteOrder -> Elf32_Word -> ByteString.Builder.Builder
|
||||
elf32Word LSB = ByteString.Builder.word32LE
|
||||
elf32Word MSB = ByteString.Builder.word32BE
|
||||
|
||||
elfIdentification :: ElfIdentification -> ByteString.Builder.Builder
|
||||
elfIdentification (ElfIdentification elfClass elfData)
|
||||
= ByteString.Builder.word8 0x7f
|
||||
<> ByteString.Builder.string7 "ELF"
|
||||
<> ByteString.Builder.word8 (fromIntegralEnum elfClass)
|
||||
<> ByteString.Builder.word8 (fromIntegralEnum elfData)
|
||||
<> ByteString.Builder.word8 (fromIntegralEnum EV_CURRENT)
|
||||
<> ByteString.Builder.byteString (ByteString.replicate 9 0)
|
||||
|
||||
elf32Ehdr :: Elf32_Ehdr -> Either ElfEncodingError ByteString.Builder.Builder
|
||||
elf32Ehdr Elf32_Ehdr{..} = encode <$> byteOrder e_ident
|
||||
where
|
||||
encode byteOrder'
|
||||
= elfIdentification e_ident
|
||||
<> elf32Half byteOrder' (fromIntegralEnum e_type)
|
||||
<> elf32Half byteOrder' (fromIntegralEnum e_machine)
|
||||
<> elf32Word byteOrder' (fromIntegralEnum e_version)
|
||||
<> elf32Addr byteOrder' e_entry
|
||||
<> elf32Off byteOrder' e_phoff
|
||||
<> elf32Off byteOrder' e_shoff
|
||||
<> elf32Word byteOrder' e_flags
|
||||
<> elf32Half byteOrder' e_ehsize
|
||||
<> elf32Half byteOrder' e_phentsize
|
||||
<> elf32Half byteOrder' e_phnum
|
||||
<> elf32Half byteOrder' e_shentsize
|
||||
<> elf32Half byteOrder' e_shnum
|
||||
<> elf32Half byteOrder' e_shstrndx
|
||||
|
||||
byteOrder :: ElfIdentification -> Either ElfEncodingError ByteOrder
|
||||
byteOrder (ElfIdentification class' _)
|
||||
| class' /= ELFCLASS32 = Left $ ElfUnsupportedClassError class'
|
||||
byteOrder (ElfIdentification _ ELFDATA2MSB) = Right MSB
|
||||
byteOrder (ElfIdentification _ ELFDATA2LSB) = Right LSB
|
||||
byteOrder (ElfIdentification _ ELFDATANONE) = Left ElfInvalidByteOrderError
|
||||
|
||||
elf32Shdr :: ByteOrder -> Elf32_Shdr -> ByteString.Builder.Builder
|
||||
elf32Shdr byteOrder' Elf32_Shdr{..}
|
||||
= elf32Word byteOrder' sh_name
|
||||
<> elf32Word byteOrder' (fromIntegralEnum sh_type)
|
||||
<> elf32Word byteOrder' sh_flags
|
||||
<> elf32Addr byteOrder' sh_addr
|
||||
<> elf32Off byteOrder' sh_offset
|
||||
<> elf32Word byteOrder' sh_size
|
||||
<> elf32Word byteOrder' sh_link
|
||||
<> elf32Word byteOrder' sh_info
|
||||
<> elf32Word byteOrder' sh_addralign
|
||||
<> elf32Word byteOrder' sh_entsize
|
||||
|
||||
elf32Sym :: ByteOrder -> Elf32_Sym -> ByteString.Builder.Builder
|
||||
elf32Sym byteOrder' Elf32_Sym{..}
|
||||
= elf32Word byteOrder' st_name
|
||||
<> elf32Addr byteOrder' st_value
|
||||
<> elf32Word byteOrder' st_size
|
||||
<> ByteString.Builder.word8 st_info
|
||||
<> ByteString.Builder.word8 st_other
|
||||
<> elf32Half byteOrder' st_shndx
|
||||
|
||||
elf32Rel :: ByteOrder -> Elf32_Rel -> ByteString.Builder.Builder
|
||||
elf32Rel byteOrder' Elf32_Rel{..}
|
||||
= elf32Addr byteOrder' r_offset
|
||||
<> elf32Word byteOrder' r_info
|
||||
|
||||
elf32Rela :: ByteOrder -> Elf32_Rela -> ByteString.Builder.Builder
|
||||
elf32Rela byteOrder' Elf32_Rela{..}
|
||||
= elf32Addr byteOrder' r_offset
|
||||
<> elf32Word byteOrder' r_info
|
||||
<> elf32Sword byteOrder' r_addend
|
||||
|
||||
stInfo :: ElfSymbolBinding -> ElfSymbolType -> Word8
|
||||
stInfo binding type' = fromIntegralEnum binding `shiftL` 4
|
||||
.|. (fromIntegralEnum type' .&. 0xf)
|
||||
|
||||
rInfo :: Elf32_Word -> Word8 -> Elf32_Word
|
||||
rInfo symbol type' = symbol `shiftL` 8
|
||||
.|. fromIntegralEnum type'
|
||||
|
||||
-- * Help types and functions.
|
||||
|
||||
data ByteOrder = LSB | MSB
|
||||
deriving Eq
|
||||
|
||||
data ElfEncodingError
|
||||
= ElfInvalidByteOrderError
|
||||
| ElfUnsupportedClassError ElfClass
|
||||
deriving Eq
|
||||
|
||||
instance Show ElfEncodingError
|
||||
where
|
||||
show ElfInvalidByteOrderError = "Invalid byte order."
|
||||
show (ElfUnsupportedClassError class') =
|
||||
concat ["Elf class \"", show class', "\" is not supported."]
|
||||
|
||||
instance Exception ElfEncodingError
|
||||
|
||||
fromIntegralEnum :: (Enum a, Num b) => a -> b
|
||||
fromIntegralEnum = fromIntegral . fromEnum
|
||||
148
lib/Language/Elna/Object/ElfCoder.hs
Normal file
148
lib/Language/Elna/Object/ElfCoder.hs
Normal file
@ -0,0 +1,148 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
-- | Object file generation.
|
||||
module Language.Elna.Object.ElfCoder
|
||||
( ElfEnvironment(..)
|
||||
, ElfWriter(..)
|
||||
, ElfHeaderResult(..)
|
||||
, UnresolvedRelocation(..)
|
||||
, UnresolvedRelocations(..)
|
||||
, addHeaderToResult
|
||||
, addSectionHeader
|
||||
, elfHeaderSize
|
||||
, elfObject
|
||||
, elfSectionsSize
|
||||
, putSectionHeader
|
||||
, partitionSymbols
|
||||
, module Language.Elna.Object.Elf
|
||||
) where
|
||||
|
||||
import Control.Exception (throwIO)
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Control.Monad.Trans.State (StateT, runStateT, modify', gets)
|
||||
import Data.Bits (Bits(..))
|
||||
import Data.ByteString (StrictByteString)
|
||||
import qualified Data.ByteString as ByteString
|
||||
import qualified Data.ByteString.Builder as ByteString.Builder
|
||||
import Data.Word (Word8)
|
||||
import Data.Vector (Vector)
|
||||
import qualified Data.Vector as Vector
|
||||
import System.IO (Handle, IOMode(..), SeekMode(..), hSeek, withFile)
|
||||
import Data.Foldable (traverse_)
|
||||
import Language.Elna.Object.Elf
|
||||
import Language.Elna.Object.StringTable (StringTable)
|
||||
import qualified Language.Elna.Object.StringTable as StringTable
|
||||
import GHC.Records (HasField(..))
|
||||
|
||||
data UnresolvedRelocation = UnresolvedRelocation StrictByteString Elf32_Addr Word8
|
||||
data UnresolvedRelocations =
|
||||
UnresolvedRelocations (Vector UnresolvedRelocation) (ElfHeaderResult Elf32_Sym) Elf32_Word
|
||||
|
||||
data ElfEnvironment = ElfEnvironment
|
||||
{ objectHeaders :: ElfHeaderResult Elf32_Shdr
|
||||
, objectHandle :: Handle
|
||||
}
|
||||
|
||||
newtype ElfWriter a = ElfWriter
|
||||
{ runElfWriter :: StateT ElfEnvironment IO a
|
||||
}
|
||||
|
||||
data ElfHeaderResult a = ElfHeaderResult
|
||||
{ sectionNames :: StringTable
|
||||
, sectionHeaders :: Vector a
|
||||
} deriving Eq
|
||||
|
||||
instance Functor ElfWriter
|
||||
where
|
||||
fmap f (ElfWriter x) = ElfWriter $ f <$> x
|
||||
|
||||
instance Applicative ElfWriter
|
||||
where
|
||||
pure = ElfWriter . pure
|
||||
(ElfWriter f) <*> (ElfWriter x) = ElfWriter $ f <*> x
|
||||
|
||||
instance Monad ElfWriter
|
||||
where
|
||||
(ElfWriter x) >>= f = ElfWriter $ x >>= (runElfWriter . f)
|
||||
|
||||
instance MonadIO ElfWriter
|
||||
where
|
||||
liftIO = ElfWriter . liftIO
|
||||
|
||||
partitionSymbols :: ElfHeaderResult Elf32_Sym -> (Vector Elf32_Sym, Vector Elf32_Sym)
|
||||
partitionSymbols = Vector.partition go . getField @"sectionHeaders"
|
||||
where
|
||||
go Elf32_Sym{ st_info } = (st_info .&. 0xf0) == 0
|
||||
|
||||
-- | ELF header size.
|
||||
elfHeaderSize :: Elf32_Off
|
||||
elfHeaderSize = 52
|
||||
|
||||
-- | Calculates the size of all sections based on the 'sh_size' in the given
|
||||
-- headers and adds 'elfHeaderSize' to it.
|
||||
elfSectionsSize :: Vector Elf32_Shdr -> Elf32_Off
|
||||
elfSectionsSize = (elfHeaderSize +)
|
||||
. Vector.foldr ((+) . sh_size) 0
|
||||
|
||||
addHeaderToResult :: StrictByteString -> a -> ElfHeaderResult a -> ElfHeaderResult a
|
||||
addHeaderToResult name newHeader accumulator@ElfHeaderResult{..} = accumulator
|
||||
{ sectionHeaders = Vector.snoc sectionHeaders newHeader
|
||||
, sectionNames = StringTable.append name sectionNames
|
||||
}
|
||||
|
||||
addSectionHeader :: StrictByteString -> Elf32_Shdr -> ElfWriter ()
|
||||
addSectionHeader name newHeader = ElfWriter $ modify' modifier
|
||||
where
|
||||
modifier elfEnvironment@ElfEnvironment{ objectHeaders } = elfEnvironment
|
||||
{ objectHeaders = addHeaderToResult name newHeader objectHeaders
|
||||
}
|
||||
|
||||
putSectionHeader :: StrictByteString -> Elf32_Shdr -> StrictByteString -> ElfWriter ()
|
||||
putSectionHeader name newHeader encoded = do
|
||||
objectHandle' <- ElfWriter $ gets $ getField @"objectHandle"
|
||||
liftIO $ ByteString.hPut objectHandle' encoded
|
||||
addSectionHeader name newHeader
|
||||
|
||||
-- Writes an ELF object to the provided file path. The callback writes the
|
||||
-- sections, collects headers for those sections and returns the ELF header.
|
||||
elfObject :: FilePath -> ElfWriter Elf32_Ehdr -> IO ()
|
||||
elfObject outFile putContents = withFile outFile WriteMode withObjectFile
|
||||
where
|
||||
withObjectFile objectHandle
|
||||
= hSeek objectHandle AbsoluteSeek (fromIntegral elfHeaderSize)
|
||||
>> putContents' objectHandle
|
||||
>>= uncurry afterContents
|
||||
putContents' objectHandle
|
||||
= flip runStateT (initialState objectHandle)
|
||||
$ runElfWriter putContents
|
||||
zeroHeader = Elf32_Shdr
|
||||
{ sh_type = SHT_NULL
|
||||
, sh_size = 0
|
||||
, sh_offset = 0
|
||||
, sh_name = 0
|
||||
, sh_link = 0
|
||||
, sh_info = 0
|
||||
, sh_flags = 0
|
||||
, sh_entsize = 0
|
||||
, sh_addralign = 0
|
||||
, sh_addr = 0
|
||||
}
|
||||
initialState objectHandle = ElfEnvironment
|
||||
{ objectHeaders = ElfHeaderResult
|
||||
{ sectionHeaders = Vector.singleton zeroHeader
|
||||
, sectionNames = mempty
|
||||
}
|
||||
, objectHandle = objectHandle
|
||||
}
|
||||
afterContents header ElfEnvironment{ objectHeaders = ElfHeaderResult{..}, ..} =
|
||||
let hPutBuilder = ByteString.Builder.hPutBuilder objectHandle
|
||||
writeSectionHeaders byteOrder' =
|
||||
traverse_ (hPutBuilder . elf32Shdr byteOrder') sectionHeaders
|
||||
in either throwIO pure (byteOrder (e_ident header))
|
||||
>>= writeSectionHeaders
|
||||
>> either throwIO (putHeaders objectHandle) (elf32Ehdr header)
|
||||
putHeaders objectHandle encodedHeader
|
||||
= hSeek objectHandle AbsoluteSeek 0
|
||||
>> ByteString.Builder.hPutBuilder objectHandle encodedHeader
|
||||
48
lib/Language/Elna/Object/StringTable.hs
Normal file
48
lib/Language/Elna/Object/StringTable.hs
Normal file
@ -0,0 +1,48 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.Object.StringTable
|
||||
( StringTable
|
||||
, append
|
||||
, elem
|
||||
, index
|
||||
, encode
|
||||
, size
|
||||
) where
|
||||
|
||||
import Data.ByteString (StrictByteString)
|
||||
import qualified Data.ByteString as ByteString
|
||||
import Language.Elna.Object.Elf
|
||||
import Prelude hiding (elem)
|
||||
|
||||
newtype StringTable = StringTable StrictByteString
|
||||
deriving Eq
|
||||
|
||||
instance Semigroup StringTable
|
||||
where
|
||||
(StringTable x) <> (StringTable y) = StringTable $ x <> ByteString.drop 1 y
|
||||
|
||||
instance Monoid StringTable
|
||||
where
|
||||
mempty = StringTable "\0"
|
||||
|
||||
size :: StringTable -> Elf32_Word
|
||||
size (StringTable container) =
|
||||
fromIntegral $ ByteString.length container
|
||||
|
||||
elem :: StrictByteString -> StringTable -> Bool
|
||||
elem needle (StringTable container) =
|
||||
("\0" <> needle <> "\0") `ByteString.isInfixOf` container
|
||||
|
||||
append :: StrictByteString -> StringTable -> StringTable
|
||||
append element (StringTable container) =
|
||||
StringTable $ container <> element <> "\0"
|
||||
|
||||
index :: Elf32_Word -> StringTable -> StrictByteString
|
||||
index stringTableIndex (StringTable stringTable)
|
||||
= ByteString.takeWhile (/= 0)
|
||||
$ ByteString.drop (fromIntegral stringTableIndex) stringTable
|
||||
|
||||
encode :: StringTable -> StrictByteString
|
||||
encode (StringTable container) = container
|
||||
519
lib/Language/Elna/RiscV/CodeGenerator.hs
Normal file
519
lib/Language/Elna/RiscV/CodeGenerator.hs
Normal file
@ -0,0 +1,519 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.RiscV.CodeGenerator
|
||||
( Directive(..)
|
||||
, Statement(..)
|
||||
, generateRiscV
|
||||
, riscVConfiguration
|
||||
) where
|
||||
|
||||
import Control.Monad.Trans.State (State, get, evalState, modify')
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Int (Int32)
|
||||
import Data.Word (Word32)
|
||||
import Data.Vector (Vector)
|
||||
import qualified Data.Vector as Vector
|
||||
import qualified Language.Elna.Architecture.RiscV as RiscV
|
||||
import Language.Elna.Backend.Allocator (MachineConfiguration(..), Store(..))
|
||||
import Language.Elna.Backend.Intermediate
|
||||
( Label(..)
|
||||
, Operand(..)
|
||||
, ProcedureQuadruples(..)
|
||||
, Quadruple(..)
|
||||
)
|
||||
import Language.Elna.Location (Identifier(..))
|
||||
import Data.Bits (Bits(..))
|
||||
import Data.Foldable (Foldable(..), foldlM)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
|
||||
import qualified Data.Text.Lazy.Builder as Text.Builder
|
||||
import qualified Data.Text.Lazy as Text.Lazy
|
||||
|
||||
data Directive
|
||||
= GlobalDirective
|
||||
| FunctionDirective
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Statement
|
||||
= Instruction RiscV.Instruction
|
||||
| JumpLabel Text [Directive]
|
||||
deriving Eq
|
||||
|
||||
riscVConfiguration :: MachineConfiguration RiscV.XRegister
|
||||
riscVConfiguration = MachineConfiguration
|
||||
{ temporaryRegisters =
|
||||
[ RiscV.T0
|
||||
, RiscV.T1
|
||||
, RiscV.T2
|
||||
, RiscV.T3
|
||||
, RiscV.T4
|
||||
, RiscV.T5
|
||||
, RiscV.T6
|
||||
]
|
||||
}
|
||||
|
||||
-- | Reserved register used for calculations to save an immediate temporary.
|
||||
immediateRegister :: RiscV.XRegister
|
||||
immediateRegister = RiscV.A7
|
||||
|
||||
type RiscVStore = Store RiscV.XRegister
|
||||
type RiscVQuadruple = Quadruple RiscVStore
|
||||
type RiscVOperand = Operand RiscVStore
|
||||
|
||||
newtype RiscVGenerator a = RiscVGenerator
|
||||
{ runRiscVGenerator :: State Word32 a }
|
||||
|
||||
instance Functor RiscVGenerator
|
||||
where
|
||||
fmap f (RiscVGenerator x) = RiscVGenerator $ f <$> x
|
||||
|
||||
instance Applicative RiscVGenerator
|
||||
where
|
||||
pure = RiscVGenerator . pure
|
||||
(RiscVGenerator f) <*> (RiscVGenerator x) = RiscVGenerator $ f <*> x
|
||||
|
||||
instance Monad RiscVGenerator
|
||||
where
|
||||
(RiscVGenerator x) >>= f = RiscVGenerator $ x >>= (runRiscVGenerator . f)
|
||||
|
||||
createLabel :: RiscVGenerator Text
|
||||
createLabel = do
|
||||
currentCounter <- RiscVGenerator get
|
||||
RiscVGenerator $ modify' (+ 1)
|
||||
pure
|
||||
$ mappend ".A"
|
||||
$ Text.Lazy.toStrict
|
||||
$ Text.Builder.toLazyText
|
||||
$ Text.Builder.decimal currentCounter
|
||||
|
||||
generateRiscV :: HashMap Identifier (ProcedureQuadruples RiscVStore) -> Vector Statement
|
||||
generateRiscV = flip evalState 0
|
||||
. runRiscVGenerator
|
||||
. foldlM go Vector.empty
|
||||
. HashMap.toList
|
||||
where
|
||||
go accumulator (Identifier key, ProcedureQuadruples{ stackSize, quadruples = value }) =
|
||||
let code = Vector.cons (JumpLabel key [GlobalDirective, FunctionDirective])
|
||||
. fold <$> mapM (quadruple stackSize) value
|
||||
in (accumulator <>) <$> code
|
||||
|
||||
quadruple :: Word32 -> RiscVQuadruple -> RiscVGenerator (Vector Statement)
|
||||
quadruple stackSize StartQuadruple =
|
||||
let totalStackSize = stackSize + 8
|
||||
in pure $ Vector.fromList
|
||||
[ Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP (negate totalStackSize))
|
||||
, Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 0 RiscV.SW RiscV.SP RiscV.S0)
|
||||
, Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 4 RiscV.SW RiscV.SP RiscV.RA)
|
||||
, Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.S0 RiscV.ADDI RiscV.SP totalStackSize)
|
||||
]
|
||||
quadruple stackSize StopQuadruple =
|
||||
let totalStackSize = stackSize + 8
|
||||
in pure $ Vector.fromList
|
||||
[ Instruction (RiscV.BaseInstruction RiscV.Load $ RiscV.I RiscV.S0 RiscV.LW RiscV.SP 0)
|
||||
, Instruction (RiscV.BaseInstruction RiscV.Load $ RiscV.I RiscV.RA RiscV.LW RiscV.SP 4)
|
||||
, Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP totalStackSize)
|
||||
, Instruction (RiscV.BaseInstruction RiscV.Jalr $ RiscV.I RiscV.RA RiscV.JALR RiscV.Zero 0)
|
||||
]
|
||||
quadruple _ (ParameterQuadruple operand1) =
|
||||
let (operandRegister, statements) = loadImmediateOrRegister operand1 RiscV.A0
|
||||
in pure $ mappend statements $ Vector.fromList
|
||||
[ Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP (negate 4))
|
||||
, Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 0 RiscV.SW RiscV.SP operandRegister)
|
||||
]
|
||||
quadruple _ (CallQuadruple callName numberOfArguments) =
|
||||
let restoreStackSize = numberOfArguments * 4
|
||||
in pure $ Vector.fromList
|
||||
[ Instruction (RiscV.CallInstruction callName)
|
||||
, Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP restoreStackSize)
|
||||
]
|
||||
quadruple _ (AddQuadruple operand1 operand2 store) =
|
||||
commutativeBinary (+) RiscV.ADD (RiscV.Funct7 0b0000000) (operand1, operand2) store
|
||||
quadruple _ (ProductQuadruple operand1 operand2 store) =
|
||||
commutativeBinary (*) RiscV.MUL (RiscV.Funct7 0b0000001) (operand1, operand2) store
|
||||
quadruple _ (SubtractionQuadruple operand1 operand2 store)
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
let (storeRegister, storeStatements) = storeToStore store
|
||||
in pure $ lui (immediateOperand1 - immediateOperand2) storeRegister <> storeStatements
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 =
|
||||
let (storeRegister, storeStatements) = storeToStore store
|
||||
(operandRegister1, statements1) = loadFromStore variableOperand1
|
||||
(operandRegister2, statements2) = loadFromStore variableOperand2
|
||||
instruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R storeRegister RiscV.SUB operandRegister1 operandRegister2
|
||||
$ RiscV.Funct7 0b0100000
|
||||
in pure $ statements1 <> statements2 <> Vector.cons instruction storeStatements
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 =
|
||||
let (storeRegister, storeStatements) = storeToStore store
|
||||
statements1 = lui immediateOperand1 storeRegister
|
||||
(operandRegister2, statements2) = loadFromStore variableOperand2
|
||||
instruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R storeRegister RiscV.SUB storeRegister operandRegister2
|
||||
$ RiscV.Funct7 0b0100000
|
||||
in pure $ statements1 <> statements2 <> Vector.cons instruction storeStatements
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
let (storeRegister, storeStatements) = storeToStore store
|
||||
statements2 = lui (negate immediateOperand2) storeRegister
|
||||
(operandRegister1, statements1) = loadFromStore variableOperand1
|
||||
instruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R storeRegister RiscV.ADD storeRegister operandRegister1
|
||||
$ RiscV.Funct7 0b0000000
|
||||
in pure $ statements1 <> statements2 <> Vector.cons instruction storeStatements
|
||||
quadruple _ (NegationQuadruple operand1 store)
|
||||
| IntOperand immediateOperand1 <- operand1 =
|
||||
let (storeRegister, storeStatements) = storeToStore store
|
||||
in pure $ lui (negate immediateOperand1) storeRegister <> storeStatements
|
||||
| VariableOperand variableOperand1 <- operand1 =
|
||||
let (storeRegister, storeStatements) = storeToStore store
|
||||
(operandRegister1, statements1) = loadFromStore variableOperand1
|
||||
instruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R storeRegister RiscV.SUB RiscV.Zero operandRegister1
|
||||
$ RiscV.Funct7 0b0100000
|
||||
in pure $ statements1 <> Vector.cons instruction storeStatements
|
||||
quadruple _ (DivisionQuadruple operand1 operand2 store)
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
if immediateOperand2 == 0
|
||||
then pure $ Vector.singleton
|
||||
$ Instruction (RiscV.CallInstruction "_divide_by_zero_error")
|
||||
else
|
||||
let (storeRegister, storeStatements) = storeToStore store
|
||||
in pure $ lui (quot immediateOperand1 immediateOperand2) storeRegister <> storeStatements
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 = do
|
||||
let (storeRegister, storeStatements) = storeToStore store
|
||||
(operandRegister1, statements1) = loadFromStore variableOperand1
|
||||
(operandRegister2, statements2) = loadFromStore variableOperand2
|
||||
divisionInstruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R storeRegister RiscV.DIV operandRegister1 operandRegister2 (RiscV.Funct7 0b0000001)
|
||||
branchLabel <- createLabel
|
||||
let branchInstruction = Instruction
|
||||
$ RiscV.RelocatableInstruction RiscV.Branch
|
||||
$ RiscV.RBranch branchLabel RiscV.BNE RiscV.Zero operandRegister2
|
||||
pure $ statements1 <> statements2 <> Vector.fromList
|
||||
[ branchInstruction
|
||||
, Instruction (RiscV.CallInstruction "_divide_by_zero_error")
|
||||
, JumpLabel branchLabel []
|
||||
, divisionInstruction
|
||||
] <> storeStatements
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
let (storeRegister, storeStatements) = storeToStore store
|
||||
statements2 = lui immediateOperand2 storeRegister
|
||||
(operandRegister1, statements1) = loadFromStore variableOperand1
|
||||
operationInstruction
|
||||
| immediateOperand2 == 0 =
|
||||
RiscV.CallInstruction "_divide_by_zero_error"
|
||||
| otherwise = RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R storeRegister RiscV.DIV operandRegister1 storeRegister
|
||||
$ RiscV.Funct7 0b0000001
|
||||
in pure $ statements1 <> statements2
|
||||
<> Vector.cons (Instruction operationInstruction) storeStatements
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 = do
|
||||
let (storeRegister, storeStatements) = storeToStore store
|
||||
statements1 = lui immediateOperand1 storeRegister
|
||||
(operandRegister2, statements2) = loadFromStore variableOperand2
|
||||
divisionInstruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R storeRegister RiscV.DIV storeRegister operandRegister2 (RiscV.Funct7 0b0000001)
|
||||
branchLabel <- createLabel
|
||||
let branchInstruction = Instruction
|
||||
$ RiscV.RelocatableInstruction RiscV.Branch
|
||||
$ RiscV.RBranch branchLabel RiscV.BNE RiscV.Zero operandRegister2
|
||||
pure $ statements1 <> statements2 <> Vector.fromList
|
||||
[ branchInstruction
|
||||
, Instruction (RiscV.CallInstruction "_divide_by_zero_error")
|
||||
, JumpLabel branchLabel []
|
||||
, divisionInstruction
|
||||
] <> storeStatements
|
||||
quadruple _ (LabelQuadruple (Label label)) = pure $ Vector.singleton $ JumpLabel label mempty
|
||||
quadruple _ (GoToQuadruple label) = pure $ Vector.singleton $ unconditionalJal label
|
||||
quadruple _ (EqualQuadruple operand1 operand2 goToLabel) =
|
||||
commutativeComparison (==) RiscV.BEQ (operand1, operand2) goToLabel
|
||||
quadruple _ (NonEqualQuadruple operand1 operand2 goToLabel) =
|
||||
commutativeComparison (/=) RiscV.BNE (operand1, operand2) goToLabel
|
||||
quadruple _ (LessQuadruple operand1 operand2 goToLabel) =
|
||||
lessThan (operand1, operand2) goToLabel
|
||||
quadruple _ (GreaterQuadruple operand1 operand2 goToLabel) =
|
||||
lessThan (operand2, operand1) goToLabel
|
||||
quadruple _ (LessOrEqualQuadruple operand1 operand2 goToLabel) =
|
||||
lessOrEqualThan (operand1, operand2) goToLabel
|
||||
quadruple _ (GreaterOrEqualQuadruple operand1 operand2 goToLabel) =
|
||||
lessOrEqualThan (operand2, operand1) goToLabel
|
||||
quadruple _ (AssignQuadruple operand1 store)
|
||||
| IntOperand immediateOperand1 <- operand1 =
|
||||
let (storeRegister, storeStatements) = storeToStore store
|
||||
in pure $ lui immediateOperand1 storeRegister <> storeStatements
|
||||
| VariableOperand variableOperand1 <- operand1 =
|
||||
let (operandRegister1, statements1) = loadFromStore variableOperand1
|
||||
(storeRegister, storeStatements) = storeToStore store
|
||||
instruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.OpImm
|
||||
$ RiscV.I storeRegister RiscV.ADDI operandRegister1 0
|
||||
in pure $ statements1 <> Vector.cons instruction storeStatements
|
||||
quadruple _ (ArrayAssignQuadruple assigneeOperand indexOperand store)
|
||||
| IntOperand immediateAssigneeOperand <- assigneeOperand =
|
||||
let (storeRegister, storeStatements) = storeWithOffset store indexOperand
|
||||
in pure $ lui immediateAssigneeOperand storeRegister <> storeStatements
|
||||
| VariableOperand variableAssigneeOperand <- assigneeOperand =
|
||||
let (assigneeOperandRegister, assigneeStatements) = loadFromStore variableAssigneeOperand
|
||||
(storeRegister, storeStatements) = storeWithOffset store indexOperand
|
||||
instruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.OpImm
|
||||
$ RiscV.I storeRegister RiscV.ADDI assigneeOperandRegister 0
|
||||
in pure $ assigneeStatements <> Vector.cons instruction storeStatements
|
||||
where
|
||||
storeWithOffset :: RiscVStore -> Operand RiscVStore -> (RiscV.XRegister, Vector Statement)
|
||||
storeWithOffset (RegisterStore register) _ = (register, mempty)
|
||||
storeWithOffset (StackStore offset register) (IntOperand indexOffset) =
|
||||
let storeInstruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Store
|
||||
$ RiscV.S (fromIntegral $ offset + indexOffset * 4) RiscV.SW RiscV.S0 register
|
||||
in (register, Vector.singleton storeInstruction)
|
||||
storeWithOffset (StackStore offset register) (VariableOperand indexOffset) =
|
||||
let storeInstruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Store
|
||||
$ RiscV.S (fromIntegral offset) RiscV.SW immediateRegister register
|
||||
statements = calculateIndexOffset indexOffset
|
||||
in (register, Vector.snoc statements storeInstruction)
|
||||
quadruple _ (ArrayQuadruple assigneeVariable indexOperand store) =
|
||||
let (operandRegister1, statements1) = loadWithOffset assigneeVariable indexOperand
|
||||
(storeRegister, storeStatements) = storeToStore store
|
||||
instruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.OpImm
|
||||
$ RiscV.I storeRegister RiscV.ADDI operandRegister1 0
|
||||
in pure $ statements1 <> Vector.cons instruction storeStatements
|
||||
where
|
||||
loadWithOffset :: RiscVStore -> Operand RiscVStore -> (RiscV.XRegister, Vector Statement)
|
||||
loadWithOffset (RegisterStore register) _ = (register, mempty)
|
||||
loadWithOffset (StackStore offset register) (IntOperand indexOffset) =
|
||||
let loadInstruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Load
|
||||
$ RiscV.I register RiscV.LW RiscV.S0 (fromIntegral $ offset + indexOffset * 4)
|
||||
in (register, Vector.singleton loadInstruction)
|
||||
loadWithOffset (StackStore offset register) (VariableOperand indexOffset) =
|
||||
let loadInstruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Load
|
||||
$ RiscV.I register RiscV.SW immediateRegister (fromIntegral offset)
|
||||
statements = calculateIndexOffset indexOffset
|
||||
in (register, Vector.snoc statements loadInstruction)
|
||||
|
||||
calculateIndexOffset :: RiscVStore -> Vector Statement
|
||||
calculateIndexOffset indexOffset =
|
||||
let (indexRegister, indexStatements) = loadFromStore indexOffset
|
||||
baseRegisterInstruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.OpImm
|
||||
$ RiscV.I immediateRegister RiscV.ADDI RiscV.Zero 4
|
||||
indexRelativeOffset = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R immediateRegister RiscV.MUL immediateRegister indexRegister (RiscV.Funct7 0b0000001)
|
||||
registerWithOffset = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R immediateRegister RiscV.ADD immediateRegister RiscV.S0 (RiscV.Funct7 0b0000000)
|
||||
statements = Vector.fromList
|
||||
[ baseRegisterInstruction
|
||||
, indexRelativeOffset
|
||||
, registerWithOffset
|
||||
]
|
||||
in indexStatements <> statements
|
||||
|
||||
unconditionalJal :: Label -> Statement
|
||||
unconditionalJal (Label goToLabel) = Instruction
|
||||
$ RiscV.RelocatableInstruction RiscV.Jal
|
||||
$ RiscV.RJal RiscV.Zero goToLabel
|
||||
|
||||
loadImmediateOrRegister :: RiscVOperand -> RiscV.XRegister -> (RiscV.XRegister, Vector Statement)
|
||||
loadImmediateOrRegister (IntOperand intValue) targetRegister =
|
||||
(targetRegister, lui intValue targetRegister)
|
||||
loadImmediateOrRegister (VariableOperand store) _ = loadFromStore store
|
||||
|
||||
lui :: Int32 -> RiscV.XRegister -> Vector Statement
|
||||
lui intValue targetRegister
|
||||
| intValue >= -2048
|
||||
, intValue <= 2047 = Vector.singleton
|
||||
$ Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I targetRegister RiscV.ADDI RiscV.Zero lo)
|
||||
| intValue .&. 0x800 /= 0 = Vector.fromList
|
||||
[ Instruction (RiscV.BaseInstruction RiscV.Lui $ RiscV.U targetRegister $ fromIntegral $ succ hi)
|
||||
, Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I targetRegister RiscV.ADDI targetRegister lo)
|
||||
]
|
||||
| otherwise = Vector.fromList
|
||||
[ Instruction (RiscV.BaseInstruction RiscV.Lui $ RiscV.U targetRegister $ fromIntegral hi)
|
||||
, Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I targetRegister RiscV.ADDI targetRegister lo)
|
||||
]
|
||||
where
|
||||
hi = intValue `shiftR` 12
|
||||
lo = fromIntegral intValue
|
||||
|
||||
commutativeBinary
|
||||
:: (Int32 -> Int32 -> Int32)
|
||||
-> RiscV.Funct3
|
||||
-> RiscV.Funct7
|
||||
-> (Operand RiscVStore, Operand RiscVStore)
|
||||
-> Store RiscV.XRegister
|
||||
-> RiscVGenerator (Vector Statement)
|
||||
commutativeBinary immediateOperation funct3 funct7 (operand1, operand2) store
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
let (storeRegister, storeStatements) = storeToStore store
|
||||
immediateOperation' = immediateOperation immediateOperand1 immediateOperand2
|
||||
in pure $ lui immediateOperation' storeRegister <> storeStatements
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 =
|
||||
let (operandRegister1, statements1) = loadFromStore variableOperand1
|
||||
(operandRegister2, statements2) = loadFromStore variableOperand2
|
||||
(storeRegister, storeStatements) = storeToStore store
|
||||
instruction = Instruction $ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R storeRegister funct3 operandRegister1 operandRegister2 funct7
|
||||
in pure $ statements1 <> statements2
|
||||
<> Vector.cons instruction storeStatements
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
commutativeImmediateRegister variableOperand1 immediateOperand2
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 =
|
||||
commutativeImmediateRegister variableOperand2 immediateOperand1
|
||||
where
|
||||
commutativeImmediateRegister variableOperand immediateOperand =
|
||||
let (storeRegister, storeStatements) = storeToStore store
|
||||
immediateStatements = lui immediateOperand storeRegister
|
||||
(operandRegister, registerStatements) = loadFromStore variableOperand
|
||||
instruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Op
|
||||
$ RiscV.R storeRegister funct3 storeRegister operandRegister funct7
|
||||
in pure $ immediateStatements <> registerStatements
|
||||
<> Vector.cons instruction storeStatements
|
||||
|
||||
commutativeComparison
|
||||
:: (Int32 -> Int32 -> Bool)
|
||||
-> RiscV.Funct3
|
||||
-> (Operand RiscVStore, Operand RiscVStore)
|
||||
-> Label
|
||||
-> RiscVGenerator (Vector Statement)
|
||||
commutativeComparison immediateOperation funct3 (operand1, operand2) goToLabel
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
if immediateOperation immediateOperand1 immediateOperand2
|
||||
then pure $ Vector.singleton $ unconditionalJal goToLabel
|
||||
else pure Vector.empty
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 = do
|
||||
let (operandRegister1, statements1) = loadFromStore variableOperand1
|
||||
(operandRegister2, statements2) = loadFromStore variableOperand2
|
||||
Label goToLabel' = goToLabel
|
||||
pure $ Vector.snoc (statements1 <> statements2)
|
||||
$ Instruction
|
||||
$ RiscV.RelocatableInstruction RiscV.Branch
|
||||
$ RiscV.RBranch goToLabel' funct3 operandRegister1 operandRegister2
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
compareImmediateRegister variableOperand1 immediateOperand2
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 =
|
||||
compareImmediateRegister variableOperand2 immediateOperand1
|
||||
where
|
||||
compareImmediateRegister variableOperand immediateOperand =
|
||||
let immediateStatements = lui immediateOperand immediateRegister
|
||||
(operandRegister, registerStatements) = loadFromStore variableOperand
|
||||
Label goToLabel' = goToLabel
|
||||
in pure $ Vector.snoc (immediateStatements <> registerStatements)
|
||||
$ Instruction
|
||||
$ RiscV.RelocatableInstruction RiscV.Branch
|
||||
$ RiscV.RBranch goToLabel' funct3 operandRegister immediateRegister
|
||||
|
||||
lessThan :: (Operand RiscVStore, Operand RiscVStore) -> Label -> RiscVGenerator (Vector Statement)
|
||||
lessThan (operand1, operand2) goToLabel
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
if immediateOperand1 < immediateOperand2
|
||||
then pure $ Vector.singleton $ unconditionalJal goToLabel
|
||||
else pure Vector.empty
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 = do
|
||||
let (operandRegister1, statements1) = loadFromStore variableOperand1
|
||||
(operandRegister2, statements2) = loadFromStore variableOperand2
|
||||
Label goToLabel' = goToLabel
|
||||
pure $ Vector.snoc (statements1 <> statements2)
|
||||
$ Instruction
|
||||
$ RiscV.RelocatableInstruction RiscV.Branch
|
||||
$ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 operandRegister2
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
let statements2 = lui immediateOperand2 immediateRegister
|
||||
(operandRegister1, statements1) = loadFromStore variableOperand1
|
||||
Label goToLabel' = goToLabel
|
||||
in pure $ Vector.snoc (statements1 <> statements2)
|
||||
$ Instruction
|
||||
$ RiscV.RelocatableInstruction RiscV.Branch
|
||||
$ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 immediateRegister
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 =
|
||||
let statements1 = lui immediateOperand1 immediateRegister
|
||||
(operandRegister2, statements2) = loadFromStore variableOperand2
|
||||
Label goToLabel' = goToLabel
|
||||
in pure $ Vector.snoc (statements1 <> statements2)
|
||||
$ Instruction
|
||||
$ RiscV.RelocatableInstruction RiscV.Branch
|
||||
$ RiscV.RBranch goToLabel' RiscV.BLT immediateRegister operandRegister2
|
||||
|
||||
lessOrEqualThan :: (Operand RiscVStore, Operand RiscVStore) -> Label -> RiscVGenerator (Vector Statement)
|
||||
lessOrEqualThan (operand1, operand2) goToLabel
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
if immediateOperand1 <= immediateOperand2
|
||||
then pure $ Vector.singleton $ unconditionalJal goToLabel
|
||||
else pure Vector.empty
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 = do
|
||||
let (operandRegister1, statements1) = loadFromStore variableOperand1
|
||||
(operandRegister2, statements2) = loadFromStore variableOperand2
|
||||
Label goToLabel' = goToLabel
|
||||
pure $ Vector.snoc (statements1 <> statements2)
|
||||
$ Instruction
|
||||
$ RiscV.RelocatableInstruction RiscV.Branch
|
||||
$ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 operandRegister1
|
||||
| VariableOperand variableOperand1 <- operand1
|
||||
, IntOperand immediateOperand2 <- operand2 =
|
||||
let statements2 = lui immediateOperand2 immediateRegister
|
||||
(operandRegister1, statements1) = loadFromStore variableOperand1
|
||||
Label goToLabel' = goToLabel
|
||||
in pure $ Vector.snoc (statements1 <> statements2)
|
||||
$ Instruction
|
||||
$ RiscV.RelocatableInstruction RiscV.Branch
|
||||
$ RiscV.RBranch goToLabel' RiscV.BGE immediateRegister operandRegister1
|
||||
| IntOperand immediateOperand1 <- operand1
|
||||
, VariableOperand variableOperand2 <- operand2 =
|
||||
let statements1 = lui immediateOperand1 immediateRegister
|
||||
(operandRegister2, statements2) = loadFromStore variableOperand2
|
||||
Label goToLabel' = goToLabel
|
||||
in pure $ Vector.snoc (statements1 <> statements2)
|
||||
$ Instruction
|
||||
$ RiscV.RelocatableInstruction RiscV.Branch
|
||||
$ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 immediateRegister
|
||||
|
||||
loadFromStore :: RiscVStore -> (RiscV.XRegister, Vector Statement)
|
||||
loadFromStore (RegisterStore register) = (register, mempty)
|
||||
loadFromStore (StackStore offset register) =
|
||||
let loadInstruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Load
|
||||
$ RiscV.I register RiscV.LW RiscV.S0 (fromIntegral offset)
|
||||
in (register, Vector.singleton loadInstruction)
|
||||
|
||||
storeToStore :: RiscVStore -> (RiscV.XRegister, Vector Statement)
|
||||
storeToStore (RegisterStore register) = (register, mempty)
|
||||
storeToStore (StackStore offset register) =
|
||||
let storeInstruction = Instruction
|
||||
$ RiscV.BaseInstruction RiscV.Store
|
||||
$ RiscV.S (fromIntegral offset) RiscV.SW RiscV.S0 register
|
||||
in (register, Vector.singleton storeInstruction)
|
||||
338
lib/Language/Elna/RiscV/ElfWriter.hs
Normal file
338
lib/Language/Elna/RiscV/ElfWriter.hs
Normal file
@ -0,0 +1,338 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
-- | Writer assembler to an object file.
|
||||
module Language.Elna.RiscV.ElfWriter
|
||||
( riscv32Elf
|
||||
) where
|
||||
|
||||
import Data.ByteString (StrictByteString)
|
||||
import qualified Data.ByteString as ByteString
|
||||
import qualified Data.ByteString.Builder as ByteString.Builder
|
||||
import Data.ByteString.Lazy (LazyByteString)
|
||||
import qualified Data.ByteString.Lazy as LazyByteString
|
||||
import Data.Vector (Vector)
|
||||
import qualified Data.Vector as Vector
|
||||
import Language.Elna.Object.ElfCoder
|
||||
( ByteOrder(..)
|
||||
, Elf32_Ehdr(..)
|
||||
, Elf32_Half
|
||||
, Elf32_Word
|
||||
, Elf32_Sym(..)
|
||||
, ElfMachine(..)
|
||||
, ElfType(..)
|
||||
, ElfVersion(..)
|
||||
, ElfIdentification(..)
|
||||
, ElfClass(..)
|
||||
, ElfData(..)
|
||||
, Elf32_Shdr(..)
|
||||
, ElfSectionType(..)
|
||||
, ElfSymbolBinding(..)
|
||||
, ElfSymbolType(..)
|
||||
, Elf32_Rel(..)
|
||||
, ElfWriter(..)
|
||||
, ElfHeaderResult(..)
|
||||
, ElfEnvironment(..)
|
||||
, UnresolvedRelocation(..)
|
||||
, UnresolvedRelocations(..)
|
||||
, addHeaderToResult
|
||||
, addSectionHeader
|
||||
, elf32Sym
|
||||
, elfHeaderSize
|
||||
, elfSectionsSize
|
||||
, stInfo
|
||||
, rInfo
|
||||
, elf32Rel
|
||||
, shfInfoLink
|
||||
, partitionSymbols
|
||||
, putSectionHeader
|
||||
)
|
||||
import qualified Language.Elna.Architecture.RiscV as RiscV
|
||||
import qualified Data.Text.Encoding as Text
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Control.Monad.Trans.State (get, gets)
|
||||
import Language.Elna.RiscV.CodeGenerator (Directive(..), Statement(..))
|
||||
import Language.Elna.Object.StringTable (StringTable)
|
||||
import qualified Language.Elna.Object.StringTable as StringTable
|
||||
import Data.HashSet (HashSet)
|
||||
import qualified Data.HashSet as HashSet
|
||||
import GHC.Records (HasField(..))
|
||||
|
||||
data TextAccumulator = TextAccumulator
|
||||
{ encodedAccumulator :: LazyByteString
|
||||
, relocationAccumulator :: Vector UnresolvedRelocation
|
||||
, symbolAccumulator :: ElfHeaderResult Elf32_Sym
|
||||
, definitionAccumulator :: HashSet StrictByteString
|
||||
}
|
||||
|
||||
riscv32Elf :: Vector Statement -> ElfWriter Elf32_Ehdr
|
||||
riscv32Elf code = text code
|
||||
>>= symtab
|
||||
>>= uncurry symrel
|
||||
>>= strtab
|
||||
>> shstrtab
|
||||
>>= riscv32Header
|
||||
where
|
||||
riscv32Header :: Elf32_Half -> ElfWriter Elf32_Ehdr
|
||||
riscv32Header shstrndx = do
|
||||
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
|
||||
pure $ Elf32_Ehdr
|
||||
{ e_version = EV_CURRENT
|
||||
, e_type = ET_REL
|
||||
, e_shstrndx = shstrndx
|
||||
, e_shoff = elfSectionsSize sectionHeaders
|
||||
, e_shnum = fromIntegral (Vector.length sectionHeaders)
|
||||
, e_shentsize = 40
|
||||
, e_phoff = 0
|
||||
, e_phnum = 0
|
||||
, e_phentsize = 32
|
||||
, e_machine = EM_RISCV
|
||||
, e_ident = ElfIdentification ELFCLASS32 ELFDATA2LSB
|
||||
, e_flags = 0x4 -- EF_RISCV_FLOAT_ABI_DOUBLE
|
||||
, e_entry = 0
|
||||
, e_ehsize = fromIntegral elfHeaderSize
|
||||
}
|
||||
|
||||
text :: Vector Statement -> ElfWriter UnresolvedRelocations
|
||||
text code = do
|
||||
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
|
||||
let textTabIndex = fromIntegral $ Vector.length sectionHeaders
|
||||
initialHeaders = ElfHeaderResult mempty
|
||||
$ Vector.singleton
|
||||
$ Elf32_Sym
|
||||
{ st_value = 0
|
||||
, st_size = 0
|
||||
, st_shndx = 0
|
||||
, st_other = 0
|
||||
, st_name = 0
|
||||
, st_info = 0
|
||||
}
|
||||
TextAccumulator{..} = encodeFunctions textTabIndex code
|
||||
$ TextAccumulator
|
||||
{ encodedAccumulator = mempty
|
||||
, relocationAccumulator = Vector.empty
|
||||
, symbolAccumulator = initialHeaders
|
||||
, definitionAccumulator = HashSet.empty
|
||||
}
|
||||
size = fromIntegral $ LazyByteString.length encodedAccumulator
|
||||
newHeader = Elf32_Shdr
|
||||
{ sh_type = SHT_PROGBITS
|
||||
, sh_size = size
|
||||
, sh_offset = elfSectionsSize sectionHeaders
|
||||
, sh_name = StringTable.size sectionNames
|
||||
, sh_link = 0
|
||||
, sh_info = 0
|
||||
, sh_flags = 0b110
|
||||
, sh_entsize = 0
|
||||
, sh_addralign = 4
|
||||
, sh_addr = 0
|
||||
}
|
||||
putSectionHeader ".text" newHeader $ LazyByteString.toStrict encodedAccumulator
|
||||
let filterPredicate :: StrictByteString -> Bool
|
||||
filterPredicate = not
|
||||
. (`StringTable.elem` getField @"sectionNames" symbolAccumulator)
|
||||
symbolResult = HashSet.foldl' encodeEmptyDefinitions symbolAccumulator
|
||||
$ HashSet.filter filterPredicate definitionAccumulator
|
||||
pure $ UnresolvedRelocations relocationAccumulator symbolResult
|
||||
$ fromIntegral $ Vector.length sectionHeaders
|
||||
where
|
||||
encodeEmptyDefinitions (ElfHeaderResult names entries) definition =
|
||||
let nextEntry = Elf32_Sym
|
||||
{ st_value = 0
|
||||
, st_size = 0
|
||||
, st_shndx = 0
|
||||
, st_other = 0
|
||||
, st_name = StringTable.size names
|
||||
, st_info = stInfo STB_GLOBAL STT_FUNC
|
||||
}
|
||||
in ElfHeaderResult (StringTable.append definition names)
|
||||
$ Vector.snoc entries nextEntry
|
||||
encodeFunctions shndx instructions textAccumulator
|
||||
| Just (instruction, rest) <- Vector.uncons instructions =
|
||||
case instruction of
|
||||
Instruction _ ->
|
||||
let (textAccumulator', rest') = encodeInstructions shndx (textAccumulator, instructions)
|
||||
in encodeFunctions shndx rest' textAccumulator'
|
||||
JumpLabel labelName directives ->
|
||||
let (TextAccumulator{..}, rest') =
|
||||
encodeInstructions shndx (textAccumulator, rest)
|
||||
newEntry = Elf32_Sym
|
||||
{ st_value = fromIntegral
|
||||
$ LazyByteString.length
|
||||
$ getField @"encodedAccumulator" textAccumulator
|
||||
, st_size = fromIntegral $ LazyByteString.length encodedAccumulator
|
||||
, st_shndx = shndx
|
||||
, st_other = 0
|
||||
, st_name = StringTable.size $ getField @"sectionNames" symbolAccumulator
|
||||
, st_info = stInfo (directivesBinding directives) STT_FUNC
|
||||
}
|
||||
in encodeFunctions shndx rest'
|
||||
$ TextAccumulator
|
||||
{ encodedAccumulator = encodedAccumulator
|
||||
, relocationAccumulator = relocationAccumulator
|
||||
, symbolAccumulator =
|
||||
addHeaderToResult (Text.encodeUtf8 labelName) newEntry symbolAccumulator
|
||||
, definitionAccumulator = definitionAccumulator
|
||||
}
|
||||
| otherwise = textAccumulator
|
||||
directivesBinding directives
|
||||
| GlobalDirective `elem` directives = STB_GLOBAL
|
||||
| otherwise = STB_LOCAL
|
||||
encodeInstructions shndx (TextAccumulator encoded relocations symbolResult definitions, instructions)
|
||||
| Just (Instruction instruction, rest) <- Vector.uncons instructions =
|
||||
let offset = fromIntegral $ LazyByteString.length encoded
|
||||
unresolvedRelocation = case instruction of
|
||||
RiscV.RelocatableInstruction _ instructionType
|
||||
| RiscV.RHigher20 _ symbolName <- instructionType
|
||||
-> Just -- R_RISCV_HI20
|
||||
$ UnresolvedRelocation (Text.encodeUtf8 symbolName) offset 26
|
||||
| RiscV.RLower12I _ _ _ symbolName <- instructionType
|
||||
-> Just -- R_RISCV_LO12_I
|
||||
$ UnresolvedRelocation (Text.encodeUtf8 symbolName) offset 27
|
||||
| RiscV.RLower12S symbolName _ _ _ <- instructionType
|
||||
-> Just -- R_RISCV_LO12_S
|
||||
$ UnresolvedRelocation (Text.encodeUtf8 symbolName) offset 28
|
||||
| RiscV.RBranch symbolName _ _ _ <- instructionType
|
||||
-> Just -- R_RISCV_BRANCH
|
||||
$ UnresolvedRelocation (Text.encodeUtf8 symbolName) offset 16
|
||||
| RiscV.RJal _ symbolName <- instructionType
|
||||
-> Just -- R_RISCV_JAL
|
||||
$ UnresolvedRelocation (Text.encodeUtf8 symbolName) offset 17
|
||||
RiscV.CallInstruction symbolName
|
||||
-> Just -- R_RISCV_CALL_PLT
|
||||
$ UnresolvedRelocation (Text.encodeUtf8 symbolName) offset 19
|
||||
RiscV.BaseInstruction _ _ -> Nothing
|
||||
chunk = ByteString.Builder.toLazyByteString
|
||||
$ RiscV.instruction instruction
|
||||
result = TextAccumulator
|
||||
(encoded <> chunk)
|
||||
(maybe relocations (Vector.snoc relocations) unresolvedRelocation)
|
||||
symbolResult
|
||||
(addDefinition unresolvedRelocation definitions)
|
||||
in encodeInstructions shndx (result, rest)
|
||||
| Just (JumpLabel labelName directives , rest) <- Vector.uncons instructions
|
||||
, FunctionDirective `notElem` directives =
|
||||
let newEntry = Elf32_Sym
|
||||
{ st_value = fromIntegral $ LazyByteString.length encoded
|
||||
, st_size = 0
|
||||
, st_shndx = shndx
|
||||
, st_other = 0
|
||||
, st_name = StringTable.size $ getField @"sectionNames" symbolResult
|
||||
, st_info = stInfo (directivesBinding directives) STT_NOTYPE
|
||||
}
|
||||
result = TextAccumulator
|
||||
encoded
|
||||
relocations
|
||||
(addHeaderToResult (Text.encodeUtf8 labelName) newEntry symbolResult)
|
||||
definitions
|
||||
in encodeInstructions shndx (result, rest)
|
||||
| otherwise = (TextAccumulator encoded relocations symbolResult definitions, instructions)
|
||||
addDefinition (Just (UnresolvedRelocation symbolName _ _)) =
|
||||
HashSet.insert symbolName
|
||||
addDefinition Nothing = id
|
||||
|
||||
shstrtab :: ElfWriter Elf32_Half
|
||||
shstrtab = do
|
||||
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
|
||||
let stringTable = ".shstrtab"
|
||||
currentNamesSize = StringTable.size sectionNames
|
||||
nextHeader = Elf32_Shdr
|
||||
{ sh_type = SHT_STRTAB
|
||||
, sh_size = currentNamesSize -- Adding trailing null character.
|
||||
+ fromIntegral (succ $ ByteString.length stringTable)
|
||||
, sh_offset = elfSectionsSize sectionHeaders
|
||||
, sh_name = currentNamesSize
|
||||
, sh_link = 0
|
||||
, sh_info = 0
|
||||
, sh_flags = 0
|
||||
, sh_entsize = 0
|
||||
, sh_addralign = 1
|
||||
, sh_addr = 0
|
||||
}
|
||||
addSectionHeader stringTable nextHeader
|
||||
|
||||
ElfEnvironment{..} <- ElfWriter get
|
||||
liftIO $ ByteString.hPut objectHandle
|
||||
$ StringTable.encode
|
||||
$ getField @"sectionNames" objectHeaders
|
||||
pure $ fromIntegral $ Vector.length sectionHeaders
|
||||
|
||||
symtab :: UnresolvedRelocations -> ElfWriter (Elf32_Word, UnresolvedRelocations)
|
||||
symtab (UnresolvedRelocations relocationList symbolResult index) = do
|
||||
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
|
||||
let (localSymbols, globalSymbols) = partitionSymbols symbolResult
|
||||
sortedSymbols = localSymbols <> globalSymbols
|
||||
sortedResult = symbolResult{ sectionHeaders = sortedSymbols }
|
||||
encodedSymbols = LazyByteString.toStrict
|
||||
$ ByteString.Builder.toLazyByteString
|
||||
$ foldMap (elf32Sym LSB) sortedSymbols
|
||||
symHeader = Elf32_Shdr
|
||||
{ sh_type = SHT_SYMTAB
|
||||
, sh_size = fromIntegral $ ByteString.length encodedSymbols
|
||||
, sh_offset = elfSectionsSize sectionHeaders
|
||||
, sh_name = StringTable.size sectionNames
|
||||
, sh_link = fromIntegral $ Vector.length sectionHeaders + 2
|
||||
, sh_info = fromIntegral $ Vector.length localSymbols
|
||||
, sh_flags = 0
|
||||
, sh_entsize = 16
|
||||
, sh_addralign = 4
|
||||
, sh_addr = 0
|
||||
}
|
||||
putSectionHeader ".symtab" symHeader encodedSymbols
|
||||
pure
|
||||
( fromIntegral $ Vector.length sectionHeaders
|
||||
, UnresolvedRelocations relocationList sortedResult index
|
||||
)
|
||||
|
||||
symrel :: Elf32_Word -> UnresolvedRelocations -> ElfWriter StringTable
|
||||
symrel sectionHeadersLength relocations = do
|
||||
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
|
||||
|
||||
let UnresolvedRelocations relocationList symbols index = relocations
|
||||
encodedRelocations = LazyByteString.toStrict
|
||||
$ ByteString.Builder.toLazyByteString
|
||||
$ Vector.foldMap (either (const mempty) (elf32Rel LSB))
|
||||
$ resolveRelocation symbols <$> relocationList
|
||||
relHeader = Elf32_Shdr
|
||||
{ sh_type = SHT_REL
|
||||
, sh_size = fromIntegral $ ByteString.length encodedRelocations
|
||||
, sh_offset = elfSectionsSize sectionHeaders
|
||||
, sh_name = StringTable.size sectionNames
|
||||
, sh_link = sectionHeadersLength
|
||||
, sh_info = index
|
||||
, sh_flags = shfInfoLink
|
||||
, sh_entsize = 8
|
||||
, sh_addralign = 4
|
||||
, sh_addr = 0
|
||||
}
|
||||
putSectionHeader ".rel.text" relHeader encodedRelocations
|
||||
pure $ getField @"sectionNames" symbols
|
||||
where
|
||||
takeStringZ stringTable Elf32_Sym{ st_name }
|
||||
= StringTable.index st_name stringTable
|
||||
resolveRelocation (ElfHeaderResult stringTable entries) unresolvedRelocation
|
||||
| UnresolvedRelocation symbolName offset type' <- unresolvedRelocation
|
||||
, Just entry <- Vector.findIndex ((== symbolName) . takeStringZ stringTable) entries =
|
||||
Right $ Elf32_Rel
|
||||
{ r_offset = offset
|
||||
, r_info = rInfo (fromIntegral entry) type'
|
||||
}
|
||||
| otherwise = Left unresolvedRelocation
|
||||
|
||||
strtab :: StringTable -> ElfWriter ()
|
||||
strtab stringTable = do
|
||||
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
|
||||
let strHeader = Elf32_Shdr
|
||||
{ sh_type = SHT_STRTAB
|
||||
, sh_size = StringTable.size stringTable
|
||||
, sh_offset = elfSectionsSize sectionHeaders
|
||||
, sh_name = StringTable.size sectionNames
|
||||
, sh_link = 0
|
||||
, sh_info = 0
|
||||
, sh_flags = 0
|
||||
, sh_entsize = 0
|
||||
, sh_addralign = 1
|
||||
, sh_addr = 0
|
||||
}
|
||||
putSectionHeader ".strtab" strHeader $ StringTable.encode stringTable
|
||||
1023
source/ast.cc
1023
source/ast.cc
File diff suppressed because it is too large
Load Diff
@ -1,44 +0,0 @@
|
||||
// This Source Code Form is subject to the terms of the Mozilla Public License
|
||||
// v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
// obtain one at http://mozilla.org/MPL/2.0/.
|
||||
#include "elna/source/driver.h"
|
||||
|
||||
namespace elna
|
||||
{
|
||||
namespace source
|
||||
{
|
||||
position make_position(const yy::location& location)
|
||||
{
|
||||
return position{
|
||||
static_cast<std::size_t>(location.begin.line),
|
||||
static_cast<std::size_t>(location.begin.column)
|
||||
};
|
||||
}
|
||||
|
||||
syntax_error::syntax_error(const std::string& message,
|
||||
const char *input_file, const yy::location& location)
|
||||
: error(input_file, make_position(location)), message(message)
|
||||
{
|
||||
}
|
||||
|
||||
std::string syntax_error::what() const
|
||||
{
|
||||
return message;
|
||||
}
|
||||
|
||||
driver::driver(const char *input_file)
|
||||
: input_file(input_file)
|
||||
{
|
||||
}
|
||||
|
||||
void driver::error(const yy::location& loc, const std::string& message)
|
||||
{
|
||||
m_errors.emplace_back(std::make_unique<elna::source::syntax_error>(message, input_file, loc));
|
||||
}
|
||||
|
||||
const std::list<std::unique_ptr<struct error>>& driver::errors() const noexcept
|
||||
{
|
||||
return m_errors;
|
||||
}
|
||||
}
|
||||
}
|
||||
192
source/lexer.ll
192
source/lexer.ll
@ -1,192 +0,0 @@
|
||||
/*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public License
|
||||
* v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
* obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*/
|
||||
%{
|
||||
#define YY_NO_UNISTD_H
|
||||
#define YY_USER_ACTION this->location.columns(yyleng);
|
||||
|
||||
#include <sstream>
|
||||
#include "parser.hh"
|
||||
|
||||
#undef YY_DECL
|
||||
#define YY_DECL yy::parser::symbol_type elna::source::lexer::lex(elna::source::driver& driver)
|
||||
#define yyterminate() return yy::parser::make_YYEOF(this->location)
|
||||
%}
|
||||
|
||||
%option c++ noyywrap never-interactive
|
||||
%option yyclass="elna::source::lexer"
|
||||
|
||||
%%
|
||||
%{
|
||||
this->location.step();
|
||||
%}
|
||||
|
||||
\-\-.* {
|
||||
/* Skip the comment */
|
||||
}
|
||||
[\ \t\r] ; /* Skip the whitespaces */
|
||||
\n+ {
|
||||
this->location.lines(yyleng);
|
||||
this->location.step();
|
||||
}
|
||||
if {
|
||||
return yy::parser::make_IF(this->location);
|
||||
}
|
||||
then {
|
||||
return yy::parser::make_THEN(this->location);
|
||||
}
|
||||
else {
|
||||
return yy::parser::make_ELSE(this->location);
|
||||
}
|
||||
while {
|
||||
return yy::parser::make_WHILE(this->location);
|
||||
}
|
||||
do {
|
||||
return yy::parser::make_DO(this->location);
|
||||
}
|
||||
proc {
|
||||
return yy::parser::make_PROCEDURE(this->location);
|
||||
}
|
||||
begin {
|
||||
return yy::parser::make_BEGIN_BLOCK(this->location);
|
||||
}
|
||||
end {
|
||||
return yy::parser::make_END_BLOCK(this->location);
|
||||
}
|
||||
extern {
|
||||
return yy::parser::make_EXTERN(this->location);
|
||||
}
|
||||
const {
|
||||
return yy::parser::make_CONST(this->location);
|
||||
}
|
||||
var {
|
||||
return yy::parser::make_VAR(this->location);
|
||||
}
|
||||
array {
|
||||
return yy::parser::make_ARRAY(this->location);
|
||||
}
|
||||
of {
|
||||
return yy::parser::make_OF(this->location);
|
||||
}
|
||||
type {
|
||||
return yy::parser::make_TYPE(this->location);
|
||||
}
|
||||
record {
|
||||
return yy::parser::make_RECORD(this->location);
|
||||
}
|
||||
union {
|
||||
return yy::parser::make_UNION(this->location);
|
||||
}
|
||||
pointer {
|
||||
return yy::parser::make_POINTER(this->location);
|
||||
}
|
||||
to {
|
||||
return yy::parser::make_TO(this->location);
|
||||
}
|
||||
true {
|
||||
return yy::parser::make_BOOLEAN(true, this->location);
|
||||
}
|
||||
false {
|
||||
return yy::parser::make_BOOLEAN(false, this->location);
|
||||
}
|
||||
and {
|
||||
return yy::parser::make_AND(this->location);
|
||||
}
|
||||
or {
|
||||
return yy::parser::make_OR(this->location);
|
||||
}
|
||||
not {
|
||||
return yy::parser::make_NOT(this->location);
|
||||
}
|
||||
return {
|
||||
return yy::parser::make_RETURN(this->location);
|
||||
}
|
||||
[A-Za-z_][A-Za-z0-9_]* {
|
||||
return yy::parser::make_IDENTIFIER(yytext, this->location);
|
||||
}
|
||||
[0-9]+ {
|
||||
return yy::parser::make_INTEGER(strtol(yytext, NULL, 10), this->location);
|
||||
}
|
||||
[0-9]+\.[0-9] {
|
||||
return yy::parser::make_FLOAT(strtof(yytext, NULL), this->location);
|
||||
}
|
||||
'[^']' {
|
||||
return yy::parser::make_CHARACTER(
|
||||
std::string(yytext, 1, strlen(yytext) - 2), this->location);
|
||||
}
|
||||
\"[^\"]*\" {
|
||||
return yy::parser::make_STRING(
|
||||
std::string(yytext, 1, strlen(yytext) - 2), this->location);
|
||||
}
|
||||
\( {
|
||||
return yy::parser::make_LEFT_PAREN(this->location);
|
||||
}
|
||||
\) {
|
||||
return yy::parser::make_RIGHT_PAREN(this->location);
|
||||
}
|
||||
\[ {
|
||||
return yy::parser::make_LEFT_SQUARE(this->location);
|
||||
}
|
||||
\] {
|
||||
return yy::parser::make_RIGHT_SQUARE(this->location);
|
||||
}
|
||||
\>= {
|
||||
return yy::parser::make_GREATER_EQUAL(this->location);
|
||||
}
|
||||
\<= {
|
||||
return yy::parser::make_LESS_EQUAL(this->location);
|
||||
}
|
||||
\> {
|
||||
return yy::parser::make_GREATER_THAN(this->location);
|
||||
}
|
||||
\< {
|
||||
return yy::parser::make_LESS_THAN(this->location);
|
||||
}
|
||||
\/= {
|
||||
return yy::parser::make_NOT_EQUAL(this->location);
|
||||
}
|
||||
= {
|
||||
return yy::parser::make_EQUALS(this->location);
|
||||
}
|
||||
; {
|
||||
return yy::parser::make_SEMICOLON(this->location);
|
||||
}
|
||||
\. {
|
||||
return yy::parser::make_DOT(this->location);
|
||||
}
|
||||
, {
|
||||
return yy::parser::make_COMMA(this->location);
|
||||
}
|
||||
\+ {
|
||||
return yy::parser::make_PLUS(this->location);
|
||||
}
|
||||
\- {
|
||||
return yy::parser::make_MINUS(this->location);
|
||||
}
|
||||
\* {
|
||||
return yy::parser::make_MULTIPLICATION(this->location);
|
||||
}
|
||||
\/ {
|
||||
return yy::parser::make_DIVISION(this->location);
|
||||
}
|
||||
:= {
|
||||
return yy::parser::make_ASSIGNMENT(this->location);
|
||||
}
|
||||
: {
|
||||
return yy::parser::make_COLON(this->location);
|
||||
}
|
||||
\^ {
|
||||
return yy::parser::make_HAT(this->location);
|
||||
}
|
||||
@ {
|
||||
return yy::parser::make_AT(this->location);
|
||||
}
|
||||
. {
|
||||
std::stringstream ss;
|
||||
|
||||
ss << "Illegal character 0x" << std::hex << static_cast<unsigned int>(yytext[0]);
|
||||
driver.error(this->location, ss.str());
|
||||
}
|
||||
%%
|
||||
423
source/parser.yy
423
source/parser.yy
@ -1,423 +0,0 @@
|
||||
/*
|
||||
* This Source Code Form is subject to the terms of the Mozilla Public License
|
||||
* v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
* obtain one at http://mozilla.org/MPL/2.0/.
|
||||
*/
|
||||
%require "3.2"
|
||||
%language "c++"
|
||||
|
||||
%code requires {
|
||||
#include <cstdint>
|
||||
#include <iostream>
|
||||
#include "elna/source/driver.h"
|
||||
|
||||
#if !defined(yyFlexLexerOnce)
|
||||
#include <FlexLexer.h>
|
||||
#endif
|
||||
|
||||
namespace elna::source
|
||||
{
|
||||
class lexer;
|
||||
}
|
||||
}
|
||||
|
||||
%code provides {
|
||||
namespace elna::source
|
||||
{
|
||||
|
||||
class lexer: public yyFlexLexer
|
||||
{
|
||||
public:
|
||||
yy::location location;
|
||||
|
||||
lexer(std::istream& arg_yyin)
|
||||
: yyFlexLexer(&arg_yyin)
|
||||
{
|
||||
}
|
||||
|
||||
yy::parser::symbol_type lex(elna::source::driver& driver);
|
||||
};
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
%define api.token.raw
|
||||
%define api.token.constructor
|
||||
%define api.value.type variant
|
||||
|
||||
%parse-param {elna::source::lexer& lexer}
|
||||
%param {elna::source::driver& driver}
|
||||
%locations
|
||||
|
||||
%header
|
||||
|
||||
%code {
|
||||
#define yylex lexer.lex
|
||||
}
|
||||
%start program;
|
||||
|
||||
%token <std::string> IDENTIFIER "identifier"
|
||||
%token <std::int32_t> INTEGER "integer"
|
||||
%token <float> FLOAT "float"
|
||||
%token <std::string> CHARACTER "character"
|
||||
%token <std::string> STRING "string"
|
||||
%token <bool> BOOLEAN
|
||||
%token IF WHILE DO THEN ELSE RETURN
|
||||
%token CONST VAR PROCEDURE ARRAY OF TYPE RECORD POINTER TO UNION
|
||||
%token BEGIN_BLOCK END_BLOCK EXTERN
|
||||
%token LEFT_PAREN RIGHT_PAREN LEFT_SQUARE RIGHT_SQUARE SEMICOLON DOT COMMA
|
||||
%token AND OR NOT
|
||||
%token GREATER_EQUAL LESS_EQUAL LESS_THAN GREATER_THAN NOT_EQUAL EQUALS
|
||||
%token PLUS MINUS MULTIPLICATION DIVISION
|
||||
%token ASSIGNMENT COLON HAT AT
|
||||
|
||||
%type <elna::source::literal *> literal;
|
||||
%type <elna::source::constant_definition *> constant_definition;
|
||||
%type <std::vector<elna::source::constant_definition *>> constant_part constant_definitions;
|
||||
%type <elna::source::variable_declaration *> variable_declaration;
|
||||
%type <std::vector<elna::source::variable_declaration *>> variable_declarations variable_part
|
||||
formal_parameter_list;
|
||||
%type <elna::source::type_expression *> type_expression;
|
||||
%type <elna::source::expression *> expression pointer summand factor comparand logical_operand;
|
||||
%type <std::vector<elna::source::expression *>> expressions actual_parameter_list;
|
||||
%type <elna::source::designator_expression *> designator_expression;
|
||||
%type <elna::source::assign_statement *> assign_statement;
|
||||
%type <elna::source::call_expression *> call_expression;
|
||||
%type <elna::source::while_statement *> while_statement;
|
||||
%type <elna::source::if_statement *> if_statement;
|
||||
%type <elna::source::return_statement *> return_statement;
|
||||
%type <elna::source::statement *> statement;
|
||||
%type <std::vector<elna::source::statement *>> statements optional_statements;
|
||||
%type <elna::source::procedure_definition *> procedure_definition;
|
||||
%type <std::vector<elna::source::procedure_definition *>> procedure_definitions procedure_part;
|
||||
%type <elna::source::type_definition *> type_definition;
|
||||
%type <std::vector<elna::source::type_definition *>> type_definitions type_part;
|
||||
%type <elna::source::block *> block;
|
||||
%type <std::pair<std::string, elna::source::type_expression *>> field_declaration;
|
||||
%type <std::vector<std::pair<std::string, elna::source::type_expression *>>> field_list;
|
||||
%%
|
||||
program:
|
||||
type_part constant_part procedure_part variable_part BEGIN_BLOCK optional_statements END_BLOCK DOT
|
||||
{
|
||||
std::vector<elna::source::definition *> definitions($1.size() + $3.size());
|
||||
std::vector<elna::source::definition *>::iterator definition = definitions.begin();
|
||||
std::vector<elna::source::definition *> value_definitions($2.size() + $4.size());
|
||||
std::vector<elna::source::definition *>::iterator value_definition = value_definitions.begin();
|
||||
|
||||
for (auto type : $1)
|
||||
{
|
||||
*definition++ = type;
|
||||
}
|
||||
for (auto constant : $2)
|
||||
{
|
||||
*value_definition++ = constant;
|
||||
}
|
||||
for (auto procedure : $3)
|
||||
{
|
||||
*definition++ = procedure;
|
||||
}
|
||||
for (auto variable : $4)
|
||||
{
|
||||
*value_definition++ = variable;
|
||||
}
|
||||
auto tree = new elna::source::program(elna::source::position{},
|
||||
std::move(definitions), std::move(value_definitions), std::move($6));
|
||||
|
||||
driver.tree.reset(tree);
|
||||
}
|
||||
block: constant_part variable_part BEGIN_BLOCK optional_statements END_BLOCK
|
||||
{
|
||||
std::vector<elna::source::definition *> definitions($1.size() + $2.size());
|
||||
std::vector<elna::source::definition *>::iterator definition = definitions.begin();
|
||||
|
||||
for (auto constant : $1)
|
||||
{
|
||||
*definition++ = constant;
|
||||
}
|
||||
for (auto variable : $2)
|
||||
{
|
||||
*definition++ = variable;
|
||||
}
|
||||
$$ = new elna::source::block(elna::source::position{},
|
||||
std::move(definitions), std::move($4));
|
||||
}
|
||||
procedure_definition:
|
||||
PROCEDURE IDENTIFIER formal_parameter_list SEMICOLON block SEMICOLON
|
||||
{
|
||||
$$ = new elna::source::procedure_definition(elna::source::position{},
|
||||
$2, std::move($3), nullptr, $5);
|
||||
}
|
||||
| PROCEDURE IDENTIFIER formal_parameter_list SEMICOLON EXTERN SEMICOLON
|
||||
{
|
||||
$$ = new elna::source::procedure_definition(elna::source::position{},
|
||||
$2, std::move($3), nullptr, nullptr);
|
||||
}
|
||||
| PROCEDURE IDENTIFIER formal_parameter_list COLON type_expression SEMICOLON block SEMICOLON
|
||||
{
|
||||
$$ = new elna::source::procedure_definition(elna::source::position{},
|
||||
$2, std::move($3), $5, $7);
|
||||
}
|
||||
| PROCEDURE IDENTIFIER formal_parameter_list COLON type_expression SEMICOLON EXTERN SEMICOLON
|
||||
{
|
||||
$$ = new elna::source::procedure_definition(elna::source::position{},
|
||||
$2, std::move($3), $5, nullptr);
|
||||
}
|
||||
procedure_definitions:
|
||||
procedure_definition procedure_definitions
|
||||
{
|
||||
std::swap($$, $2);
|
||||
$$.emplace($$.cbegin(), std::move($1));
|
||||
}
|
||||
| procedure_definition { $$.emplace_back(std::move($1)); }
|
||||
procedure_part:
|
||||
/* no procedure definitions */ {}
|
||||
| procedure_definitions { std::swap($$, $1); }
|
||||
assign_statement: designator_expression ASSIGNMENT expression
|
||||
{
|
||||
$$ = new elna::source::assign_statement(elna::source::make_position(@1), $1, $3);
|
||||
}
|
||||
call_expression: IDENTIFIER actual_parameter_list
|
||||
{
|
||||
$$ = new elna::source::call_expression(elna::source::make_position(@1), $1);
|
||||
std::swap($$->arguments(), $2);
|
||||
}
|
||||
while_statement: WHILE expression DO optional_statements END_BLOCK
|
||||
{
|
||||
auto body = new elna::source::compound_statement(elna::source::make_position(@3), std::move($4));
|
||||
$$ = new elna::source::while_statement(elna::source::make_position(@1), $2, body);
|
||||
}
|
||||
if_statement:
|
||||
IF expression THEN optional_statements END_BLOCK
|
||||
{
|
||||
auto then = new elna::source::compound_statement(elna::source::make_position(@3), std::move($4));
|
||||
$$ = new elna::source::if_statement(elna::source::make_position(@1), $2, then);
|
||||
}
|
||||
| IF expression THEN optional_statements ELSE optional_statements END_BLOCK
|
||||
{
|
||||
auto then = new elna::source::compound_statement(elna::source::make_position(@3), std::move($4));
|
||||
auto _else = new elna::source::compound_statement(elna::source::make_position(@5), std::move($6));
|
||||
$$ = new elna::source::if_statement(elna::source::make_position(@1), $2, then, _else);
|
||||
}
|
||||
return_statement:
|
||||
RETURN expression
|
||||
{
|
||||
$$ = new elna::source::return_statement(elna::source::make_position(@1), $2);
|
||||
}
|
||||
literal:
|
||||
INTEGER
|
||||
{
|
||||
$$ = new elna::source::number_literal<std::int32_t>(elna::source::make_position(@1), $1);
|
||||
}
|
||||
| FLOAT
|
||||
{
|
||||
$$ = new elna::source::number_literal<double>(elna::source::make_position(@1), $1);
|
||||
}
|
||||
| BOOLEAN
|
||||
{
|
||||
$$ = new elna::source::number_literal<bool>(elna::source::make_position(@1), $1);
|
||||
}
|
||||
| CHARACTER
|
||||
{
|
||||
$$ = new elna::source::number_literal<unsigned char>(elna::source::make_position(@1), $1.at(0));
|
||||
}
|
||||
| STRING
|
||||
{
|
||||
$$ = new elna::source::string_literal(elna::source::make_position(@1), $1);
|
||||
}
|
||||
pointer:
|
||||
literal { $$ = $1; }
|
||||
| designator_expression { $$ = $1; }
|
||||
| LEFT_PAREN expression RIGHT_PAREN { $$ = std::move($2); }
|
||||
summand:
|
||||
factor { $$ = std::move($1); }
|
||||
| factor MULTIPLICATION factor
|
||||
{
|
||||
$$ = new elna::source::binary_expression(elna::source::make_position(@1),
|
||||
$1, $3, '*');
|
||||
}
|
||||
| factor DIVISION factor
|
||||
{
|
||||
$$ = new elna::source::binary_expression(elna::source::make_position(@1),
|
||||
$1, $3, '/');
|
||||
}
|
||||
factor:
|
||||
AT pointer
|
||||
{
|
||||
$$ = new elna::source::unary_expression(elna::source::make_position(@1), $2, '@');
|
||||
}
|
||||
| NOT pointer
|
||||
{
|
||||
$$ = new elna::source::unary_expression(elna::source::make_position(@1), $2, '!');
|
||||
}
|
||||
| pointer { $$ = $1; }
|
||||
comparand:
|
||||
summand PLUS summand
|
||||
{
|
||||
$$ = new elna::source::binary_expression(elna::source::make_position(@1), $1, $3, '+');
|
||||
}
|
||||
| summand MINUS summand
|
||||
{
|
||||
$$ = new elna::source::binary_expression(elna::source::make_position(@1), $1, $3, '-');
|
||||
}
|
||||
| summand { $$ = std::move($1); }
|
||||
logical_operand:
|
||||
comparand EQUALS comparand
|
||||
{
|
||||
$$ = new elna::source::binary_expression(elna::source::make_position(@1), $1, $3, '=');
|
||||
}
|
||||
| comparand NOT_EQUAL comparand
|
||||
{
|
||||
$$ = new elna::source::binary_expression(elna::source::make_position(@1), $1, $3, 'n');
|
||||
}
|
||||
| comparand LESS_THAN comparand
|
||||
{
|
||||
$$ = new elna::source::binary_expression(elna::source::make_position(@1), $1, $3, '<');
|
||||
}
|
||||
| comparand GREATER_THAN comparand
|
||||
{
|
||||
$$ = new elna::source::binary_expression(elna::source::make_position(@1), $1, $3, '>');
|
||||
}
|
||||
| comparand LESS_EQUAL comparand
|
||||
{
|
||||
$$ = new elna::source::binary_expression(elna::source::make_position(@1), $1, $3, '<');
|
||||
}
|
||||
| comparand GREATER_EQUAL comparand
|
||||
{
|
||||
$$ = new elna::source::binary_expression(elna::source::make_position(@1), $1, $3, '>');
|
||||
}
|
||||
| comparand { $$ = $1; }
|
||||
expression:
|
||||
logical_operand AND logical_operand
|
||||
{
|
||||
$$ = new elna::source::binary_expression(elna::source::make_position(@1), $1, $3, 'a');
|
||||
}
|
||||
| logical_operand OR logical_operand
|
||||
{
|
||||
$$ = new elna::source::binary_expression(elna::source::make_position(@1), $1, $3, 'o');
|
||||
}
|
||||
| logical_operand { $$ = $1; }
|
||||
| call_expression { $$ = $1; }
|
||||
expressions:
|
||||
expression COMMA expressions
|
||||
{
|
||||
std::swap($$, $3);
|
||||
$$.emplace($$.cbegin(), $1);
|
||||
}
|
||||
| expression { $$.emplace_back(std::move($1)); }
|
||||
designator_expression:
|
||||
designator_expression LEFT_SQUARE expression RIGHT_SQUARE
|
||||
{
|
||||
$$ = new elna::source::array_access_expression(elna::source::make_position(@1), $1, $3);
|
||||
}
|
||||
| designator_expression DOT IDENTIFIER
|
||||
{
|
||||
$$ = new elna::source::field_access_expression(elna::source::make_position(@1), $1, $3);
|
||||
}
|
||||
| designator_expression HAT
|
||||
{
|
||||
$$ = new elna::source::dereference_expression(elna::source::make_position(@1), $1);
|
||||
}
|
||||
| IDENTIFIER
|
||||
{
|
||||
$$ = new elna::source::variable_expression(elna::source::make_position(@1), $1);
|
||||
}
|
||||
statement:
|
||||
assign_statement { $$ = $1; }
|
||||
| while_statement { $$ = $1; }
|
||||
| if_statement { $$ = $1; }
|
||||
| return_statement { $$ = $1; }
|
||||
| expression { $$ = new elna::source::expression_statement(elna::source::make_position(@1), $1); }
|
||||
statements:
|
||||
statement SEMICOLON statements
|
||||
{
|
||||
std::swap($$, $3);
|
||||
$$.emplace($$.cbegin(), $1);
|
||||
}
|
||||
| statement { $$.push_back($1); }
|
||||
optional_statements:
|
||||
statements { std::swap($$, $1); }
|
||||
| /* no statements */ {}
|
||||
field_declaration:
|
||||
IDENTIFIER COLON type_expression { $$ = std::make_pair($1, $3); }
|
||||
field_list:
|
||||
field_declaration SEMICOLON field_list
|
||||
{
|
||||
std::swap($$, $3);
|
||||
$$.emplace($$.cbegin(), $1);
|
||||
}
|
||||
| field_declaration { $$.emplace_back($1); }
|
||||
type_expression:
|
||||
ARRAY INTEGER OF type_expression
|
||||
{
|
||||
$$ = new elna::source::array_type_expression(elna::source::make_position(@1), $4, $2);
|
||||
}
|
||||
| POINTER TO type_expression
|
||||
{
|
||||
$$ = new elna::source::pointer_type_expression(elna::source::make_position(@1), $3);
|
||||
}
|
||||
| RECORD field_list END_BLOCK
|
||||
{
|
||||
$$ = new elna::source::record_type_expression(elna::source::make_position(@1), std::move($2));
|
||||
}
|
||||
| UNION field_list END_BLOCK
|
||||
{
|
||||
$$ = new elna::source::union_type_expression(elna::source::make_position(@1), std::move($2));
|
||||
}
|
||||
| IDENTIFIER
|
||||
{
|
||||
$$ = new elna::source::basic_type_expression(elna::source::make_position(@1), $1);
|
||||
}
|
||||
variable_declaration: IDENTIFIER COLON type_expression
|
||||
{
|
||||
$$ = new elna::source::variable_declaration(elna::source::make_position(@1), $1, $3);
|
||||
}
|
||||
variable_declarations:
|
||||
variable_declaration COMMA variable_declarations
|
||||
{
|
||||
std::swap($$, $3);
|
||||
$$.emplace($$.cbegin(), $1);
|
||||
}
|
||||
| variable_declaration { $$.emplace_back(std::move($1)); }
|
||||
variable_part:
|
||||
/* no variable declarations */ {}
|
||||
| VAR variable_declarations SEMICOLON { std::swap($$, $2); }
|
||||
constant_definition: IDENTIFIER EQUALS literal
|
||||
{
|
||||
$$ = new elna::source::constant_definition(elna::source::make_position(@1), $1, $3);
|
||||
}
|
||||
constant_definitions:
|
||||
constant_definition COMMA constant_definitions
|
||||
{
|
||||
std::swap($$, $3);
|
||||
$$.emplace($$.cbegin(), std::move($1));
|
||||
}
|
||||
| constant_definition { $$.emplace_back(std::move($1)); }
|
||||
constant_part:
|
||||
/* no constant definitions */ {}
|
||||
| CONST constant_definitions SEMICOLON { std::swap($$, $2); }
|
||||
type_definition: IDENTIFIER EQUALS type_expression
|
||||
{
|
||||
$$ = new elna::source::type_definition(elna::source::make_position(@1), $1, $3);
|
||||
}
|
||||
type_definitions:
|
||||
type_definition COMMA type_definitions
|
||||
{
|
||||
std::swap($$, $3);
|
||||
$$.emplace($$.cbegin(), std::move($1));
|
||||
}
|
||||
| type_definition { $$.emplace_back(std::move($1)); }
|
||||
type_part:
|
||||
/* no type definitions */ {}
|
||||
| TYPE type_definitions SEMICOLON { std::swap($$, $2); }
|
||||
formal_parameter_list:
|
||||
LEFT_PAREN RIGHT_PAREN {}
|
||||
| LEFT_PAREN variable_declarations RIGHT_PAREN { std::swap($$, $2); }
|
||||
actual_parameter_list:
|
||||
LEFT_PAREN RIGHT_PAREN {}
|
||||
| LEFT_PAREN expressions RIGHT_PAREN { std::swap($$, $2); }
|
||||
%%
|
||||
|
||||
void yy::parser::error(const location_type& loc, const std::string& message)
|
||||
{
|
||||
driver.error(loc, message);
|
||||
}
|
||||
@ -1,25 +0,0 @@
|
||||
// This Source Code Form is subject to the terms of the Mozilla Public License
|
||||
// v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
// obtain one at http://mozilla.org/MPL/2.0/.
|
||||
#include "elna/source/result.h"
|
||||
|
||||
namespace elna
|
||||
{
|
||||
namespace source
|
||||
{
|
||||
error::error(const char *path, const struct position position)
|
||||
: position(position), path(path)
|
||||
{
|
||||
}
|
||||
|
||||
std::size_t error::line() const noexcept
|
||||
{
|
||||
return this->position.line;
|
||||
}
|
||||
|
||||
std::size_t error::column() const noexcept
|
||||
{
|
||||
return this->position.column;
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -1,83 +0,0 @@
|
||||
// This Source Code Form is subject to the terms of the Mozilla Public License
|
||||
// v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
// obtain one at http://mozilla.org/MPL/2.0/.
|
||||
#include <elna/source/types.h>
|
||||
|
||||
namespace elna
|
||||
{
|
||||
namespace source
|
||||
{
|
||||
type::type(const std::size_t byte_size)
|
||||
: byte_size(byte_size)
|
||||
{
|
||||
}
|
||||
|
||||
std::size_t type::size() const noexcept
|
||||
{
|
||||
return this->byte_size;
|
||||
}
|
||||
|
||||
const pointer_type *type::is_pointer_type() const
|
||||
{
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
primitive_type::primitive_type(const std::string& type_name, const std::size_t byte_size)
|
||||
: type(byte_size), m_type_name(type_name)
|
||||
{
|
||||
}
|
||||
|
||||
std::string primitive_type::type_name() const
|
||||
{
|
||||
return m_type_name;
|
||||
}
|
||||
|
||||
pointer_type::pointer_type(std::shared_ptr<const type> base_type, const std::size_t byte_size)
|
||||
: type(byte_size), base_type(base_type)
|
||||
{
|
||||
}
|
||||
|
||||
const pointer_type *pointer_type::is_pointer_type() const
|
||||
{
|
||||
return this;
|
||||
}
|
||||
|
||||
std::string pointer_type::type_name() const
|
||||
{
|
||||
return '^' + base_type->type_name();
|
||||
}
|
||||
|
||||
procedure_type::procedure_type(std::vector<std::shared_ptr<const type>> arguments, const std::size_t byte_size)
|
||||
:type(byte_size), arguments(std::move(arguments))
|
||||
{
|
||||
}
|
||||
|
||||
std::string procedure_type::type_name() const
|
||||
{
|
||||
std::string result{ "proc(" };
|
||||
for (const auto& argument : arguments)
|
||||
{
|
||||
result += argument->type_name() + ',';
|
||||
}
|
||||
result.at(result.size() - 1) = ')';
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
bool operator==(const type& lhs, const type& rhs) noexcept
|
||||
{
|
||||
auto lhs_type = lhs.type_name();
|
||||
auto rhs_type = rhs.type_name();
|
||||
|
||||
return lhs_type == rhs_type;
|
||||
}
|
||||
|
||||
bool operator!=(const type& lhs, const type& rhs) noexcept
|
||||
{
|
||||
return !(lhs == rhs);
|
||||
}
|
||||
|
||||
const primitive_type boolean_type{ "Boolean", 1 };
|
||||
const primitive_type int_type{ "Int", 4 };
|
||||
}
|
||||
}
|
||||
62
src/Main.hs
Normal file
62
src/Main.hs
Normal file
@ -0,0 +1,62 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Main
|
||||
( main
|
||||
) where
|
||||
|
||||
import Language.Elna.Driver
|
||||
( Driver(..)
|
||||
, IntermediateStage(..)
|
||||
, drive
|
||||
)
|
||||
import Language.Elna.Object.ElfCoder (elfObject)
|
||||
import Language.Elna.Backend.Allocator (allocate)
|
||||
import Language.Elna.Glue (glue)
|
||||
import Language.Elna.Frontend.NameAnalysis (nameAnalysis)
|
||||
import Language.Elna.Frontend.Parser (programP)
|
||||
import Language.Elna.Frontend.TypeAnalysis (typeAnalysis)
|
||||
import Language.Elna.RiscV.CodeGenerator (generateRiscV, riscVConfiguration)
|
||||
import Language.Elna.RiscV.ElfWriter (riscv32Elf)
|
||||
import Text.Megaparsec (runParser, errorBundlePretty)
|
||||
import qualified Data.Text.IO as Text
|
||||
import System.Exit (ExitCode(..), exitWith)
|
||||
import Control.Exception (IOException, catch)
|
||||
|
||||
-- * Error codes
|
||||
--
|
||||
-- 1 - Command line parsing failed and other errors.
|
||||
-- 2 - The input could not be read.
|
||||
-- 3 - Parse error.
|
||||
-- 4 - Name analysis error.
|
||||
-- 5 - Type error.
|
||||
-- 6 - Register allocation error.
|
||||
|
||||
main :: IO ()
|
||||
main = drive >>= withCommandLine
|
||||
where
|
||||
withCommandLine driver@Driver{ input }
|
||||
= catch (Text.readFile input) (printAndExit 2 :: IOException -> IO a)
|
||||
>>= withParsedInput driver
|
||||
. runParser programP input
|
||||
withParsedInput driver@Driver{ intermediateStage } (Right program)
|
||||
| Just ParseStage <- intermediateStage = pure ()
|
||||
| otherwise
|
||||
= either (printAndExit 4) (withSymbolTable driver program)
|
||||
$ nameAnalysis program
|
||||
withParsedInput _ (Left errorBundle)
|
||||
= putStrLn (errorBundlePretty errorBundle)
|
||||
>> exitWith (ExitFailure 3)
|
||||
withSymbolTable driver@Driver{ intermediateStage } program symbolTable
|
||||
| Just typeError <- typeAnalysis symbolTable program =
|
||||
printAndExit 5 typeError
|
||||
| Just ValidateStage <- intermediateStage = pure ()
|
||||
| otherwise = either (printAndExit 6) (withTac driver)
|
||||
$ allocate riscVConfiguration symbolTable
|
||||
$ glue symbolTable program
|
||||
withTac Driver{ intermediateStage, output } tac
|
||||
| Just CodeGenStage <- intermediateStage = pure ()
|
||||
| otherwise = elfObject output $ riscv32Elf $ generateRiscV tac
|
||||
printAndExit :: Show b => forall a. Int -> b -> IO a
|
||||
printAndExit failureCode e = print e >> exitWith (ExitFailure failureCode)
|
||||
82
tests/Language/Elna/NameAnalysisSpec.hs
Normal file
82
tests/Language/Elna/NameAnalysisSpec.hs
Normal file
@ -0,0 +1,82 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.NameAnalysisSpec
|
||||
( spec
|
||||
) where
|
||||
|
||||
import Data.Text (Text)
|
||||
import Text.Megaparsec (runParser)
|
||||
import Test.Hspec
|
||||
( Spec
|
||||
, describe
|
||||
, expectationFailure
|
||||
, it
|
||||
, shouldBe
|
||||
, shouldSatisfy
|
||||
)
|
||||
import Language.Elna.NameAnalysis (Error(..), nameAnalysis)
|
||||
import Language.Elna.SymbolTable (Info(..), SymbolTable)
|
||||
import qualified Language.Elna.SymbolTable as SymbolTable
|
||||
import qualified Language.Elna.Parser as AST
|
||||
import Language.Elna.Types (intType)
|
||||
import Control.Exception (throwIO)
|
||||
|
||||
nameAnalysisOnText :: Text -> IO (Either Error SymbolTable)
|
||||
nameAnalysisOnText sourceText = nameAnalysis
|
||||
<$> either throwIO pure (runParser AST.programP "" sourceText)
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "nameAnalysis" $ do
|
||||
it "adds type to the symbol table" $ do
|
||||
let given = "type A = int;"
|
||||
expected = Right $ Just $ TypeInfo intType
|
||||
actual <- nameAnalysisOnText given
|
||||
|
||||
actual `shouldSatisfy` (expected ==) . fmap (SymbolTable.lookup "A")
|
||||
|
||||
it "errors when the aliased type is not defined" $ do
|
||||
let given = "type A = B;"
|
||||
expected = Left $ UndefinedTypeError "B"
|
||||
actual <- nameAnalysisOnText given
|
||||
|
||||
actual `shouldBe` expected
|
||||
|
||||
it "errors if the aliased identifier is not a type" $ do
|
||||
let given = "proc main() {} type A = main;"
|
||||
expected = Left
|
||||
$ UnexpectedTypeInfoError
|
||||
$ ProcedureInfo mempty mempty
|
||||
actual <- nameAnalysisOnText given
|
||||
|
||||
actual `shouldBe` expected
|
||||
|
||||
it "replaces the alias with an equivalent base type" $ do
|
||||
let given = "type A = int; type B = A; type C = B;"
|
||||
expected = Right $ Just $ TypeInfo intType
|
||||
actual <- nameAnalysisOnText given
|
||||
|
||||
actual `shouldSatisfy` (expected ==) . fmap (SymbolTable.lookup "C")
|
||||
|
||||
it "puts parameters into the local symbol table" $ do
|
||||
let given = "proc main(ref param: int) {}"
|
||||
expected = SymbolTable.enter "param" (VariableInfo True intType) SymbolTable.empty
|
||||
actual <- nameAnalysisOnText given
|
||||
|
||||
case SymbolTable.lookup "main" <$> actual of
|
||||
Right lookupResult
|
||||
| Just (ProcedureInfo localTable _) <- lookupResult ->
|
||||
Just localTable `shouldBe` expected
|
||||
_ -> expectationFailure "Procedure symbol not found"
|
||||
|
||||
it "puts variables into the local symbol table" $ do
|
||||
let given = "proc main() { var var1: int; }"
|
||||
expected = SymbolTable.enter "var1" (VariableInfo False intType) SymbolTable.empty
|
||||
actual <- nameAnalysisOnText given
|
||||
|
||||
case SymbolTable.lookup "main" <$> actual of
|
||||
Right lookupResult
|
||||
| Just (ProcedureInfo localTable _) <- lookupResult ->
|
||||
Just localTable `shouldBe` expected
|
||||
_ -> expectationFailure "Procedure symbol not found"
|
||||
146
tests/Language/Elna/ParserSpec.hs
Normal file
146
tests/Language/Elna/ParserSpec.hs
Normal file
@ -0,0 +1,146 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
module Language.Elna.ParserSpec
|
||||
( spec
|
||||
) where
|
||||
|
||||
import Test.Hspec (Spec, describe, it)
|
||||
import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn, parseSatisfies)
|
||||
import Language.Elna.Parser (programP)
|
||||
import Text.Megaparsec (parse)
|
||||
import Language.Elna.AST
|
||||
( Declaration(..)
|
||||
, Expression(..)
|
||||
, Literal(..)
|
||||
, Statement(..)
|
||||
, Parameter(..)
|
||||
, Program(..)
|
||||
, VariableDeclaration(..)
|
||||
, TypeExpression(..)
|
||||
)
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "programP" $ do
|
||||
it "parses an empty main function" $
|
||||
parse programP "" `shouldSucceedOn` "proc main() {}"
|
||||
|
||||
it "parses type definition for a type starting like array" $
|
||||
let expected = Program [TypeDefinition "t" $ NamedType "arr"]
|
||||
actual = parse programP "" "type t = arr;"
|
||||
in actual `shouldParse` expected
|
||||
|
||||
it "parses array type definition" $
|
||||
let expected = Program [TypeDefinition "t" $ ArrayType 10 (NamedType "int")]
|
||||
actual = parse programP "" "type t = array[10] of int;"
|
||||
in actual `shouldParse` expected
|
||||
|
||||
it "parses parameters" $
|
||||
let given = "proc main(x: int) {}"
|
||||
parameters = [Parameter "x" (NamedType "int") False]
|
||||
expected = Program [ProcedureDefinition "main" parameters [] []]
|
||||
actual = parse programP "" given
|
||||
in actual `shouldParse` expected
|
||||
|
||||
it "parses ref parameters" $
|
||||
let given = "proc main(x: int, ref y: boolean) {}"
|
||||
parameters =
|
||||
[ Parameter "x" (NamedType "int") False
|
||||
, Parameter "y" (NamedType "boolean") True
|
||||
]
|
||||
expected = Program [ProcedureDefinition "main" parameters [] []]
|
||||
actual = parse programP "" given
|
||||
in actual `shouldParse` expected
|
||||
|
||||
it "parses variable declaration" $
|
||||
let given = "proc main() { var x: int; }"
|
||||
expected (Program [ProcedureDefinition _ _ variables _]) =
|
||||
not $ null variables
|
||||
expected _ = False
|
||||
actual = parse programP "" given
|
||||
in actual `parseSatisfies` expected
|
||||
|
||||
it "parses negation" $
|
||||
let given = "proc main(x: int) { var y: int; y := -x; }"
|
||||
parameters = pure $ Parameter "x" (NamedType "int") False
|
||||
variables = pure
|
||||
$ VariableDeclaration "y"
|
||||
$ NamedType "int"
|
||||
body = pure
|
||||
$ AssignmentStatement (VariableExpression "y")
|
||||
$ NegationExpression
|
||||
$ VariableExpression "x"
|
||||
expected = Program
|
||||
[ProcedureDefinition "main" parameters variables body]
|
||||
actual = parse programP "" given
|
||||
in actual `shouldParse` expected
|
||||
|
||||
it "parses comparison with lower precedence than other binary operators" $
|
||||
let given = "proc main() { var x: boolean; x := 1 + 2 = 3 * 4; }"
|
||||
variables = pure
|
||||
$ VariableDeclaration "x"
|
||||
$ NamedType "boolean"
|
||||
lhs = SumExpression (LiteralExpression (IntegerLiteral 1))
|
||||
$ LiteralExpression (IntegerLiteral 2)
|
||||
rhs = ProductExpression (LiteralExpression (IntegerLiteral 3))
|
||||
$ LiteralExpression (IntegerLiteral 4)
|
||||
body = pure
|
||||
$ AssignmentStatement (VariableExpression "x")
|
||||
$ EqualExpression lhs rhs
|
||||
expected = Program
|
||||
[ProcedureDefinition "main" [] variables body]
|
||||
actual = parse programP "" given
|
||||
in actual `shouldParse` expected
|
||||
|
||||
it "parses hexadecimals" $
|
||||
let given = "proc main() { var x: int; x := 0x10; }"
|
||||
variables = pure
|
||||
$ VariableDeclaration "x"
|
||||
$ NamedType "int"
|
||||
body = pure
|
||||
$ AssignmentStatement (VariableExpression "x")
|
||||
$ LiteralExpression (HexadecimalLiteral 16)
|
||||
expected = Program
|
||||
[ProcedureDefinition "main" [] variables body]
|
||||
actual = parse programP "" given
|
||||
in actual `shouldParse` expected
|
||||
|
||||
it "parses procedure calls" $
|
||||
let given = "proc main() { f('c'); }"
|
||||
body = pure
|
||||
$ CallStatement "f" [LiteralExpression (CharacterLiteral 99)]
|
||||
expected = Program
|
||||
[ProcedureDefinition "main" [] [] body]
|
||||
actual = parse programP "" given
|
||||
in actual `shouldParse` expected
|
||||
|
||||
it "parses an if statement" $
|
||||
let given = "proc main() { if (true) ; }"
|
||||
body = pure
|
||||
$ IfStatement (LiteralExpression $ BooleanLiteral True) EmptyStatement Nothing
|
||||
expected = Program
|
||||
[ProcedureDefinition "main" [] [] body]
|
||||
actual = parse programP "" given
|
||||
in actual `shouldParse` expected
|
||||
|
||||
it "associates else with the nearst if statement" $
|
||||
let given = "proc main() { if (true) if (false) ; else ; }"
|
||||
if' = IfStatement (LiteralExpression $ BooleanLiteral False) EmptyStatement
|
||||
$ Just EmptyStatement
|
||||
body = pure
|
||||
$ IfStatement (LiteralExpression $ BooleanLiteral True) if' Nothing
|
||||
expected = Program
|
||||
[ProcedureDefinition "main" [] [] body]
|
||||
actual = parse programP "" given
|
||||
in actual `shouldParse` expected
|
||||
|
||||
it "parses a while statement" $
|
||||
let given = "proc main() { while (true) ; }"
|
||||
body = pure
|
||||
$ WhileStatement (LiteralExpression $ BooleanLiteral True) EmptyStatement
|
||||
expected = Program
|
||||
[ProcedureDefinition "main" [] [] body]
|
||||
actual = parse programP "" given
|
||||
in actual `shouldParse` expected
|
||||
5
tests/Spec.hs
Normal file
5
tests/Spec.hs
Normal file
@ -0,0 +1,5 @@
|
||||
{- This Source Code Form is subject to the terms of the Mozilla Public License,
|
||||
v. 2.0. If a copy of the MPL was not distributed with this file, You can
|
||||
obtain one at https://mozilla.org/MPL/2.0/. -}
|
||||
|
||||
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
||||
1
tests/expectations/add_products.txt
Normal file
1
tests/expectations/add_products.txt
Normal file
@ -0,0 +1 @@
|
||||
38
|
||||
1
tests/expectations/add_to_variable.txt
Normal file
1
tests/expectations/add_to_variable.txt
Normal file
@ -0,0 +1 @@
|
||||
58
|
||||
1
tests/expectations/array_element_assignment.txt
Normal file
1
tests/expectations/array_element_assignment.txt
Normal file
@ -0,0 +1 @@
|
||||
5
|
||||
2
tests/expectations/array_with_variable_index.txt
Normal file
2
tests/expectations/array_with_variable_index.txt
Normal file
@ -0,0 +1,2 @@
|
||||
5
|
||||
7
|
||||
1
tests/expectations/define_variable.txt
Normal file
1
tests/expectations/define_variable.txt
Normal file
@ -0,0 +1 @@
|
||||
58
|
||||
1
tests/expectations/exit_between_statements.txt
Normal file
1
tests/expectations/exit_between_statements.txt
Normal file
@ -0,0 +1 @@
|
||||
c
|
||||
1
tests/expectations/parse_negative_numbers.txt
Normal file
1
tests/expectations/parse_negative_numbers.txt
Normal file
@ -0,0 +1 @@
|
||||
-8
|
||||
1
tests/expectations/print0.txt
Normal file
1
tests/expectations/print0.txt
Normal file
@ -0,0 +1 @@
|
||||
0
|
||||
1
tests/expectations/print_2_digits.txt
Normal file
1
tests/expectations/print_2_digits.txt
Normal file
@ -0,0 +1 @@
|
||||
13
|
||||
2
tests/expectations/print_2_statements.txt
Normal file
2
tests/expectations/print_2_statements.txt
Normal file
@ -0,0 +1,2 @@
|
||||
13
|
||||
2097150
|
||||
1
tests/expectations/print_after_loop.txt
Normal file
1
tests/expectations/print_after_loop.txt
Normal file
@ -0,0 +1 @@
|
||||
2
|
||||
2
tests/expectations/print_array_element.txt
Normal file
2
tests/expectations/print_array_element.txt
Normal file
@ -0,0 +1,2 @@
|
||||
5
|
||||
7
|
||||
1
tests/expectations/print_char.txt
Normal file
1
tests/expectations/print_char.txt
Normal file
@ -0,0 +1 @@
|
||||
x
|
||||
2
tests/expectations/print_in_proc.txt
Normal file
2
tests/expectations/print_in_proc.txt
Normal file
@ -0,0 +1,2 @@
|
||||
14
|
||||
8
|
||||
1
tests/expectations/print_more_20_bits.txt
Normal file
1
tests/expectations/print_more_20_bits.txt
Normal file
@ -0,0 +1 @@
|
||||
2097150
|
||||
1
tests/expectations/print_negate.txt
Normal file
1
tests/expectations/print_negate.txt
Normal file
@ -0,0 +1 @@
|
||||
-8
|
||||
1
tests/expectations/print_product.txt
Normal file
1
tests/expectations/print_product.txt
Normal file
@ -0,0 +1 @@
|
||||
1000
|
||||
1
tests/expectations/print_subtraction.txt
Normal file
1
tests/expectations/print_subtraction.txt
Normal file
@ -0,0 +1 @@
|
||||
-8
|
||||
1
tests/expectations/print_sum.txt
Normal file
1
tests/expectations/print_sum.txt
Normal file
@ -0,0 +1 @@
|
||||
18
|
||||
1
tests/expectations/printi_hex.txt
Normal file
1
tests/expectations/printi_hex.txt
Normal file
@ -0,0 +1 @@
|
||||
129
|
||||
1
tests/expectations/printi_if.txt
Normal file
1
tests/expectations/printi_if.txt
Normal file
@ -0,0 +1 @@
|
||||
3
|
||||
1
tests/expectations/printi_if_greater.txt
Normal file
1
tests/expectations/printi_if_greater.txt
Normal file
@ -0,0 +1 @@
|
||||
5
|
||||
1
tests/expectations/printi_if_greater_equal.txt
Normal file
1
tests/expectations/printi_if_greater_equal.txt
Normal file
@ -0,0 +1 @@
|
||||
5
|
||||
1
tests/expectations/printi_if_less.txt
Normal file
1
tests/expectations/printi_if_less.txt
Normal file
@ -0,0 +1 @@
|
||||
3
|
||||
1
tests/expectations/printi_if_less_equal.txt
Normal file
1
tests/expectations/printi_if_less_equal.txt
Normal file
@ -0,0 +1 @@
|
||||
3
|
||||
1
tests/expectations/printi_if_not.txt
Normal file
1
tests/expectations/printi_if_not.txt
Normal file
@ -0,0 +1 @@
|
||||
3
|
||||
2
tests/expectations/printi_if_not_compound.txt
Normal file
2
tests/expectations/printi_if_not_compound.txt
Normal file
@ -0,0 +1,2 @@
|
||||
3
|
||||
7
|
||||
1
tests/expectations/printi_negative_hex.txt
Normal file
1
tests/expectations/printi_negative_hex.txt
Normal file
@ -0,0 +1 @@
|
||||
-129
|
||||
1
tests/expectations/printi_quotient.txt
Normal file
1
tests/expectations/printi_quotient.txt
Normal file
@ -0,0 +1 @@
|
||||
2
|
||||
1
tests/expectations/printi_signed_hex.txt
Normal file
1
tests/expectations/printi_signed_hex.txt
Normal file
@ -0,0 +1 @@
|
||||
129
|
||||
2
tests/expectations/two_variables.txt
Normal file
2
tests/expectations/two_variables.txt
Normal file
@ -0,0 +1,2 @@
|
||||
58
|
||||
28
|
||||
3
tests/vm/add_products.elna
Normal file
3
tests/vm/add_products.elna
Normal file
@ -0,0 +1,3 @@
|
||||
proc main() {
|
||||
printi(2 * 3 + 4 * 8);
|
||||
}
|
||||
6
tests/vm/add_to_variable.elna
Normal file
6
tests/vm/add_to_variable.elna
Normal file
@ -0,0 +1,6 @@
|
||||
proc main() {
|
||||
var i: int;
|
||||
i := 28;
|
||||
|
||||
printi(i + 30);
|
||||
}
|
||||
6
tests/vm/array_element_assignment.elna
Normal file
6
tests/vm/array_element_assignment.elna
Normal file
@ -0,0 +1,6 @@
|
||||
proc main() {
|
||||
var a: array[1] of int;
|
||||
a[0] := 5;
|
||||
|
||||
printi(a[0]);
|
||||
}
|
||||
11
tests/vm/array_with_variable_index.elna
Normal file
11
tests/vm/array_with_variable_index.elna
Normal file
@ -0,0 +1,11 @@
|
||||
proc main() {
|
||||
var a: array[2] of int;
|
||||
var i: int;
|
||||
|
||||
i := 1;
|
||||
a[0] := 5;
|
||||
a[i] := 7;
|
||||
|
||||
printi(a[0]);
|
||||
printi(a[i]);
|
||||
}
|
||||
6
tests/vm/define_variable.elna
Normal file
6
tests/vm/define_variable.elna
Normal file
@ -0,0 +1,6 @@
|
||||
proc main() {
|
||||
var i: int;
|
||||
i := 58;
|
||||
|
||||
printi(i);
|
||||
}
|
||||
5
tests/vm/exit_between_statements.elna
Normal file
5
tests/vm/exit_between_statements.elna
Normal file
@ -0,0 +1,5 @@
|
||||
proc main() {
|
||||
printc('c');
|
||||
exit();
|
||||
printi(1234);
|
||||
}
|
||||
3
tests/vm/parse_negative_numbers.elna
Normal file
3
tests/vm/parse_negative_numbers.elna
Normal file
@ -0,0 +1,3 @@
|
||||
proc main() {
|
||||
printi(-8);
|
||||
}
|
||||
3
tests/vm/print0.elna
Normal file
3
tests/vm/print0.elna
Normal file
@ -0,0 +1,3 @@
|
||||
proc main() {
|
||||
printi(0);
|
||||
}
|
||||
3
tests/vm/print_2_digits.elna
Normal file
3
tests/vm/print_2_digits.elna
Normal file
@ -0,0 +1,3 @@
|
||||
proc main() {
|
||||
printi(13);
|
||||
}
|
||||
4
tests/vm/print_2_statements.elna
Normal file
4
tests/vm/print_2_statements.elna
Normal file
@ -0,0 +1,4 @@
|
||||
proc main() {
|
||||
printi(13);
|
||||
printi(2097150);
|
||||
}
|
||||
9
tests/vm/print_after_loop.elna
Normal file
9
tests/vm/print_after_loop.elna
Normal file
@ -0,0 +1,9 @@
|
||||
proc main() {
|
||||
var x: int;
|
||||
|
||||
x := 0;
|
||||
while (x < 2) {
|
||||
x := x + 1;
|
||||
}
|
||||
printi(x);
|
||||
}
|
||||
8
tests/vm/print_array_element.elna
Normal file
8
tests/vm/print_array_element.elna
Normal file
@ -0,0 +1,8 @@
|
||||
proc main() {
|
||||
var a: array[2] of int;
|
||||
a[0] := 5;
|
||||
a[1] := 7;
|
||||
|
||||
printi(a[0]);
|
||||
printi(a[1]);
|
||||
}
|
||||
3
tests/vm/print_char.elna
Normal file
3
tests/vm/print_char.elna
Normal file
@ -0,0 +1,3 @@
|
||||
proc main() {
|
||||
printc('x');
|
||||
}
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
x
Reference in New Issue
Block a user