9 files changed, 594 insertions, 0 deletions
diff --git a/tiger-compiler/src/desugar/bounds-checking-visitor.cc b/tiger-compiler/src/desugar/bounds-checking-visitor.cc
new file mode 100644
index 0000000..30f691e
--- /dev/null
+++ b/tiger-compiler/src/desugar/bounds-checking-visitor.cc
@@ -0,0 +1,31 @@
+/**
+ ** \file desugar/bounds-checking-visitor.cc
+ ** \brief Implementation of desugar::BoundsCheckingVisitor.
+ */
+
+#include <ast/all.hh>
+#include <ast/libast.hh>
+#include <desugar/bounds-checking-visitor.hh>
+#include <misc/symbol.hh>
+#include <parse/libparse.hh>
+
+namespace desugar
+{
+  namespace
+  {
+    /// Return the name of the boxed type for \a s.
+    std::string box(misc::symbol s) { return "_box_" + s.get(); }
+
+  } // namespace
+
+  BoundsCheckingVisitor::BoundsCheckingVisitor()
+    : super_type()
+  {}
+
+  /*-----------------------.
+  | Array bounds checking.  |
+  `-----------------------*/
+
+  // FIXME: Some code was deleted here.
+
+} // namespace desugar
diff --git a/tiger-compiler/src/desugar/bounds-checking-visitor.hh b/tiger-compiler/src/desugar/bounds-checking-visitor.hh
new file mode 100644
index 0000000..65e955d
--- /dev/null
+++ b/tiger-compiler/src/desugar/bounds-checking-visitor.hh
@@ -0,0 +1,46 @@
+/**
+ ** \file desugar/bounds-checking-visitor.hh
+ ** \brief Declaration of desugar::BoundsCheckingVisitor.
+ */
+
+#pragma once
+
+#include <map>
+
+#include <astclone/cloner.hh>
+#include <parse/tweast.hh>
+
+namespace desugar
+{
+  /// \brief Add dynamic array bounds checks while duplicating an AST.
+  class BoundsCheckingVisitor : public astclone::Cloner
+  {
+  public:
+    /// Parent type.
+    using super_type = astclone::Cloner;
+
+    // Import overloaded virtual functions.
+    using super_type::operator();
+
+    /// Build a BoundsCheckingVisitor.
+    BoundsCheckingVisitor();
+
+    /// \name Visit methods.
+    /// \{
+    // FIXME: Some code was deleted here.
+    /// \}
+
+  private:
+    /// The bounds checking runtime.
+    ///
+    /// Additional definitions to insert in the prelude.
+    static const std::string prelude;
+
+    // Symbols would be nicer, but maps of symbols are
+    // inconvenient since there is no default ctor.
+    using boxes_type = std::map<const type::Array*, std::string>;
+    /// Map from an array type to the corresponding `box' type name.
+    boxes_type boxes_;
+  };
+
+} // namespace desugar
diff --git a/tiger-compiler/src/desugar/desugar-visitor.cc b/tiger-compiler/src/desugar/desugar-visitor.cc
new file mode 100644
index 0000000..770cdf6
--- /dev/null
+++ b/tiger-compiler/src/desugar/desugar-visitor.cc
@@ -0,0 +1,144 @@
+/**
+ ** \file desugar/desugar-visitor.cc
+ ** \brief Implementation of desugar::DesugarVisitor.
+ */
+
+#include <ast/all.hh>
+#include <ast/libast.hh>
+#include <desugar/desugar-visitor.hh>
+#include <misc/algorithm.hh>
+#include <misc/symbol.hh>
+#include <parse/libparse.hh>
+#include <parse/tweast.hh>
+
+namespace desugar
+{
+  DesugarVisitor::DesugarVisitor(bool desugar_for_p, bool desugar_string_cmp_p)
+    : super_type()
+    , desugar_for_p_(desugar_for_p)
+    , desugar_string_cmp_p_(desugar_string_cmp_p)
+  {}
+
+  /*-----------------------------.
+  | Desugar string comparisons.  |
+  `-----------------------------*/
+  void DesugarVisitor::operator()(const ast::OpExp& e)
+  {
+    // FIXME DONE: Some code was deleted here.
+    // Check to see that all of the elements to operate on are strings
+    if (dynamic_cast<const type::String*>(e.left_get().type_get()) == nullptr
+        || dynamic_cast<const type::String*>(e.right_get().type_get()) == nullptr)
+      {
+        return super_type::operator()(e);
+      }
+
+    const auto left = recurse(e.left_get());
+    const auto right = recurse(e.right_get());
+
+    misc::variant<ast::Exp*, ast::ChunkList*> res;
+
+    switch (e.oper_get())
+    {
+    case ast::OpExp::Oper::eq:
+    {
+        res = parse::parse(parse::Tweast() << "streq(" << left << ", " << right << ") = 0");
+        break;
+    }
+    case ast::OpExp::Oper::ne:
+    {
+        res = parse::parse(parse::Tweast() << "streq(" << left << ", " << right << ") <> 0");
+        break;
+    }
+    case ast::OpExp::Oper::lt:
+    {
+        res = parse::parse(parse::Tweast() << "strcmp(" << left << ", " << right << ") = -1");
+        break;
+    }
+    case ast::OpExp::Oper::le:
+    {
+        res = parse::parse(parse::Tweast() << "strcmp(" << left << ", " << right << ") <= 0");
+        break;
+    }
+    case ast::OpExp::Oper::gt:
+    {
+        res = parse::parse(parse::Tweast() << "strcmp(" << left << ", " << right << ") = 1");
+        break;
+    }
+    case ast::OpExp::Oper::ge:
+    {
+        res = parse::parse(parse::Tweast() << "strcmp(" << left << ", " << right << ") >= 0");
+        break;
+    }
+    default:
+        break;
+    }
+
+    ast::Exp* final = std::get<ast::Exp*>(res);
+    result_ = final;
+  }
+
+  /*----------------------.
+  | Desugar `for' loops.  |
+  `----------------------*/
+
+  /*<<-
+    Desugar `for' loops as `while' loops:
+
+       for i := lo to hi do
+         body
+
+     is transformed as:
+
+       let
+         var _lo := lo
+         var _hi := hi
+         var i := _lo
+       in
+         if i <= _hi then
+           while 1 do
+             (
+               body;
+               if i = _hi then
+                 break;
+               i := i + 1
+             )
+       end
+
+     Notice that:
+
+     - a `_hi' variable is introduced so that `hi' is evaluated only
+       once;
+
+     - a `_lo' variable is introduced to prevent `i' from being in the
+       scope of `_hi';
+
+     - a first test is performed before entering the loop, so that the
+       loop condition becomes `i < _hi' (instead of `i <= _hi'); this
+       is done to prevent overflows on INT_MAX.
+       ->>*/
+
+  void DesugarVisitor::operator()(const ast::ForExp& e)
+  {
+    // FIXME DONE: Some code was deleted here.
+    auto var_init = recurse(e.vardec_get().init_get());
+    auto lim = recurse(e.hi_get());
+    auto body = recurse(e.body_get());
+    auto iterator = e.vardec_get().name_get();
+    auto res = parse::parse(parse::Tweast() << "let "
+                            "var _lo := " << var_init <<
+                            " var _hi := " << lim <<
+                            " var " << iterator << " := _lo "
+                            "in "
+                            "if " << iterator << " <= _hi then "
+                            "while 1 do "
+                            "( " << body << ";"
+                            "if " << iterator << " = _hi then "
+                            "break;"
+                             << iterator << " := " << iterator << " + 1 "
+                            ") "
+                            "end");
+    ast::Exp* final = std::get<ast::Exp*>(res);
+    result_ = final;
+  }
+
+} // namespace desugar
diff --git a/tiger-compiler/src/desugar/desugar-visitor.hh b/tiger-compiler/src/desugar/desugar-visitor.hh
new file mode 100644
index 0000000..c6eee69
--- /dev/null
+++ b/tiger-compiler/src/desugar/desugar-visitor.hh
@@ -0,0 +1,42 @@
+/**
+ ** \file desugar/desugar-visitor.hh
+ ** \brief Declaration of desugar::DesugarVisitor.
+ */
+
+#pragma once
+
+#include <map>
+
+#include <astclone/cloner.hh>
+
+namespace desugar
+{
+  /// \brief Desugar some syntactic structures while duplicating an Ast.
+  class DesugarVisitor : public astclone::Cloner
+  {
+  public:
+    /// Superclass.
+    using super_type = astclone::Cloner;
+
+    // Import overloaded virtual functions.
+    using super_type::operator();
+
+    /// Build a DesugarVisitor.
+    DesugarVisitor(bool desugar_for_p, bool desugar_string_cmp_p);
+
+    /// \name Visit methods.
+    /// \{
+    /// Desugar string comparisons.
+    void operator()(const ast::OpExp&) override;
+    /// Desugar `for' loops as `while' loops.
+    void operator()(const ast::ForExp&) override;
+    /// \}
+
+  private:
+    /// Desugar `for' loops?
+    bool desugar_for_p_;
+    /// Desugar string comparisons?
+    bool desugar_string_cmp_p_;
+  };
+
+} // namespace desugar
diff --git a/tiger-compiler/src/desugar/libdesugar.hh b/tiger-compiler/src/desugar/libdesugar.hh
new file mode 100644
index 0000000..d758ed2
--- /dev/null
+++ b/tiger-compiler/src/desugar/libdesugar.hh
@@ -0,0 +1,85 @@
+/**
+ ** \file desugar/libdesugar.hh
+ ** \brief Declare functions exported by the desugar module.
+ */
+
+#pragma once
+
+#include <misc/error.hh>
+
+/// Desugaring an ast::Ast.
+namespace desugar
+{
+  /*----------.
+  | Helpers.  |
+  `----------*/
+
+  /// Recompute the bindings and the types of the AST \a tree.
+  ///
+  /// Raise an Internal Compiler Error on failure.
+  template <typename A> void bind_and_types_check(A& tree);
+
+  /*----------.
+  | Desugar.  |
+  `----------*/
+
+  /** \brief Remove the syntactic sugar from an AST.
+
+      \param tree                 abstract syntax tree's root, whose bindings
+                                  and types have been computed, and whose
+                                  identifiers are all unique.
+      \param desugar_for_p        desugar `for' loops.
+      \param desugar_string_cmp_p desugar string comparisons.
+
+      \return the desugared, bound and type-checked AST.  */
+  template <typename A>
+  A* desugar(const A& tree, bool desugar_for_p, bool desugar_string_cmp_p);
+
+  /** \brief Remove the syntactic sugar from an AST without
+      recomputing its bindings nor its types.
+
+      This function acts like desugar::desugar, but stops just after
+      the desugaring step (in fact, desugar::desugar is built upon
+      this function).  It is meant to be used as a test of
+      DesugarVisitor (i.e., even if the desugared tree is badly bound
+      or typed, it can still be pretty-printed).
+
+      \param tree                 AST to desugar.
+      \param desugar_for_p        desugar `for' loops.
+      \param desugar_string_cmp_p desugar string comparisons.
+
+      \return the desugared AST.  */
+  template <typename A>
+  A* raw_desugar(const A& tree, bool desugar_for_p, bool desugar_string_cmp_p);
+
+  /*-----------------------.
+  | Array bounds checking.  |
+  `-----------------------*/
+
+  /** \brief Add runtime checks of array bounds.
+
+      \param tree abstract syntax tree's root, whose bindings and types
+                  have been computed, and whose identifiers are all unique.
+
+      \return the AST with bounds checks, with bindings and type-checked. */
+
+  template <typename A> A* bounds_checks_add(const A& tree);
+
+  /** \brief Remove the syntactic sugar from an AST without
+      recomputing its bindings nor its types.
+
+      This function acts like desugar::bounds_checks_add, but stops
+      just after the tranformation step (in fact,
+      desugar::bounds_checks_add is built upon this function).  It is
+      meant to be used as a test of BoundsCheckingVisitor (i.e., even
+      if the tree with bounds checks is badly bound or typed, it can
+      still be pretty-printed).
+
+      \param tree AST on which bounds checks are to be added
+
+      \return the AST with bounds checks.  */
+  template <typename A> A* raw_bounds_checks_add(const A& tree);
+
+} // namespace desugar
+
+#include <desugar/libdesugar.hxx>
diff --git a/tiger-compiler/src/desugar/libdesugar.hxx b/tiger-compiler/src/desugar/libdesugar.hxx
new file mode 100644
index 0000000..191bd8d
--- /dev/null
+++ b/tiger-compiler/src/desugar/libdesugar.hxx
@@ -0,0 +1,95 @@
+#pragma once
+
+/**
+ ** \file desugar/libdesugar.hxx
+ ** \brief Functions exported by the desugar module.
+ */
+
+#include <memory>
+
+#include <ast/chunk-list.hh>
+#include <ast/exp.hh>
+#include <bind/libbind.hh>
+#include <desugar/bounds-checking-visitor.hh>
+#include <desugar/desugar-visitor.hh>
+#include <desugar/libdesugar.hh>
+#include <escapes/libescapes.hh>
+#include <overload/liboverload.hh>
+#include <type/libtype.hh>
+
+namespace desugar
+{
+  /*----------.
+  | Helpers.  |
+  `----------*/
+
+  template <typename A> void bind_and_types_check(A& tree)
+  {
+    misc::error e;
+    // FIXME DONE: Some code was deleted here.
+    e << bind::bind(&tree);
+    e.ice_on_error_here();
+    e << type::types_check(tree);
+    e.ice_on_error_here();
+  }
+
+  // Explicit instantiation.
+  template void bind_and_types_check<ast::ChunkList>(ast::ChunkList&);
+
+  /*----------.
+  | Desugar.  |
+  `----------*/
+
+  template <typename A>
+  A* raw_desugar(const A& tree, bool desugar_for_p, bool desugar_string_cmp_p)
+  {
+    // Desugar.
+    DesugarVisitor desugar(desugar_for_p, desugar_string_cmp_p);
+    desugar(tree);
+    return dynamic_cast<A*>(desugar.result_get());
+  }
+
+  template <typename A>
+  A* desugar(const A& tree, bool desugar_for_p, bool desugar_string_cmp_p)
+  {
+    // Desugar.
+    A* desugared = raw_desugar(tree, desugar_for_p, desugar_string_cmp_p);
+    assertion(desugared);
+    std::unique_ptr<A> desugared_ptr(desugared);
+    // Recompute the bindings and the types.
+    bind_and_types_check(*desugared_ptr);
+    return desugared_ptr.release();
+  }
+
+  /// Explicit instantiations.
+  template ast::ChunkList* raw_desugar(const ast::ChunkList&, bool, bool);
+  template ast::ChunkList* desugar(const ast::ChunkList&, bool, bool);
+
+  /*-----------------------.
+  | Array bounds checking.  |
+  `-----------------------*/
+
+  template <typename A> A* raw_bounds_checks_add(const A& tree)
+  {
+    // Add array bounds checking code.
+    BoundsCheckingVisitor add_bounds_checks;
+    add_bounds_checks(tree);
+    return dynamic_cast<A*>(add_bounds_checks.result_get());
+  }
+
+  template <typename A> A* bounds_checks_add(const A& tree)
+  {
+    // Add bounds checks.
+    A* transformed = raw_bounds_checks_add(tree);
+    assertion(transformed);
+    std::unique_ptr<A> transformed_ptr(transformed);
+    // Recompute the bindings and the types.
+    bind_and_types_check(*transformed_ptr);
+    return transformed_ptr.release();
+  }
+
+  /// Explicit instantiations.
+  template ast::ChunkList* raw_bounds_checks_add(const ast::ChunkList&);
+  template ast::ChunkList* bounds_checks_add(const ast::ChunkList&);
+
+} // namespace desugar
diff --git a/tiger-compiler/src/desugar/local.am b/tiger-compiler/src/desugar/local.am
new file mode 100644
index 0000000..701d537
--- /dev/null
+++ b/tiger-compiler/src/desugar/local.am
@@ -0,0 +1,27 @@
+## desugar module.
+src_libtc_la_SOURCES +=                                                        \
+  %D%/desugar-visitor.hh %D%/desugar-visitor.cc                                \
+  %D%/libdesugar.hh %D%/libdesugar.hxx
+
+check_PROGRAMS +=                                                              \
+  %D%/test-string-cmp-desugar                                                  \
+  %D%/test-for-loops-desugar
+
+
+
+%C%_test_string_cmp_desugar_LDADD = src/libtc.la
+%C%_test_string_cmp_desugar_CPPFLAGS = $(AM_CPPFLAGS) -DPKGDATADIR=\"$(pkgdatadir)\"
+
+%C%_test_for_loops_desugar_LDADD = src/libtc.la
+%C%_test_for_loops_desugar_CPPFLAGS = $(AM_CPPFLAGS) -DPKGDATADIR=\"$(pkgdatadir)\"
+
+src_libtc_la_SOURCES +=           \
+  %D%/bounds-checking-visitor.hh %D%/bounds-checking-visitor.cc
+
+check_PROGRAMS +=                 \
+  %D%/test-bounds-checking
+
+%C%_test_bounds_checking_LDADD = src/libtc.la
+%C%_test_bounds_checking_CPPFLAGS = $(AM_CPPFLAGS) -DPKGDATADIR=\"$(pkgdatadir)\"
+
+TASKS += %D%/tasks.hh %D%/tasks.cc
diff --git a/tiger-compiler/src/desugar/tasks.cc b/tiger-compiler/src/desugar/tasks.cc
new file mode 100644
index 0000000..0b83cb7
--- /dev/null
+++ b/tiger-compiler/src/desugar/tasks.cc
@@ -0,0 +1,49 @@
+/**
+ ** \file desugar/tasks.cc
+ ** \brief Desugar module related tasks' implementation.
+ **/
+
+#include <ast/tasks.hh>
+#include <astclone/libastclone.hh>
+#include <common.hh>
+#include <desugar/libdesugar.hh>
+#define DEFINE_TASKS 1
+#include <desugar/tasks.hh>
+#undef DEFINE_TASKS
+
+namespace desugar::tasks
+{
+  /*-------------.
+    | Desugaring.  |
+    `-------------*/
+
+  void desugar()
+  {
+    astclone::apply(::desugar::desugar, ast::tasks::the_program, desugar_for_p,
+                    desugar_string_cmp_p);
+    /// Escape after desugaring if escape was done before
+    if (escapes::escaped)
+      escapes::escapes_compute(*ast::tasks::the_program);
+  }
+
+  void raw_desugar()
+  {
+    astclone::apply(::desugar::raw_desugar, ast::tasks::the_program,
+                    desugar_for_p, desugar_string_cmp_p);
+  }
+
+  /*-----------------------.
+    | Array bounds checking.  |
+    `-----------------------*/
+
+  void bounds_checks_add()
+  {
+    astclone::apply(::desugar::bounds_checks_add, ast::tasks::the_program);
+  }
+
+  void raw_bounds_checks_add()
+  {
+    astclone::apply(::desugar::raw_bounds_checks_add, ast::tasks::the_program);
+  }
+
+} // namespace desugar::tasks
diff --git a/tiger-compiler/src/desugar/tasks.hh b/tiger-compiler/src/desugar/tasks.hh
new file mode 100644
index 0000000..44a68e6
--- /dev/null
+++ b/tiger-compiler/src/desugar/tasks.hh
@@ -0,0 +1,75 @@
+/**
+ ** \file desugar/tasks.hh
+ ** \brief Desugar module tasks.
+ */
+
+#pragma once
+
+#include <config.h>
+#include <misc/fwd.hh>
+#include <task/libtask.hh>
+
+/// Tasks of the desugar module.
+namespace desugar::tasks
+{
+  TASK_GROUP("Desugaring and bounds-checking");
+
+  /*-------------.
+    | Desugaring.  |
+    `-------------*/
+
+  /// Enable translation of `for' loops into `while' loops.
+  BOOLEAN_TASK_DECLARE("desugar-for", "desugar `for' loops", desugar_for_p, "");
+
+  /// Enable string comparison desugaring.
+  BOOLEAN_TASK_DECLARE("desugar-string-cmp",
+                       "desugar string comparisons",
+                       desugar_string_cmp_p,
+                       "");
+
+  /// Default the removal of syntactic sugar from the AST to Tiger
+  /// (without overloading).
+  DISJUNCTIVE_TASK_DECLARE("desugared",
+                           "Default the removal of syntactic sugar "
+                           "from the AST to Tiger (without overloading)",
+                           " assert-desugar"
+                           " desugar");
+
+  /// Remove syntactic sugar from the Ast.
+  TASK_DECLARE("desugar", "desugar the AST", desugar, "types-compute rename");
+
+  /* FIXME: Careful with this options (and with
+     --raw-bounds-checks-add), as they leave the AST in a bad state
+     (without bindings nor types).  For instance,
+
+     tc --raw-desugar -H  will probably result in a SEGV.
+
+     since hir-compute wants a type-checked AST. */
+
+  /// Remove syntactic sugar from the AST without recomputing
+  /// bindings nor types.
+  TASK_DECLARE("raw-desugar",
+               "desugar the AST without recomputing "
+               "bindings nor types",
+               raw_desugar,
+               "typed rename");
+
+  /*-----------------------.
+    | Array bounds checking.  |
+    `-----------------------*/
+
+  /// Enable emission of dynamic array bounds checking code.
+  TASK_DECLARE("bounds-checks-add",
+               "add dynamic bounds checks",
+               bounds_checks_add,
+               "types-compute rename");
+
+  /// Enable emission of dynamic array bounds checking code without
+  /// recomputing bindings nor types.
+  TASK_DECLARE("raw-bounds-checks-add",
+               "add bounds-checking to the AST without recomputing "
+               "bindings nor types",
+               raw_bounds_checks_add,
+               "typed rename");
+
+} // namespace desugar::tasks