initial commit

crypto/fift/Dictionary.cpp

@@ -0,0 +1,200 @@
+/*
+    This file is part of TON Blockchain Library.
+
+    TON Blockchain Library is free software: you can redistribute it and/or modify
+    it under the terms of the GNU Lesser General Public License as published by
+    the Free Software Foundation, either version 2 of the License, or
+    (at your option) any later version.
+
+    TON Blockchain Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with TON Blockchain Library.  If not, see <http://www.gnu.org/licenses/>.
+
+    Copyright 2017-2019 Telegram Systems LLP
+*/
+#include "Dictionary.h"
+
+namespace fift {
+
+//
+// WordDef
+//
+void WordDef::run(IntCtx& ctx) const {
+  auto next = run_tail(ctx);
+  while (next.not_null()) {
+    next = next->run_tail(ctx);
+  }
+}
+
+//
+// StackWord
+//
+Ref<WordDef> StackWord::run_tail(IntCtx& ctx) const {
+  f(ctx.stack);
+  return {};
+}
+
+//
+// CtxWord
+//
+Ref<WordDef> CtxWord::run_tail(IntCtx& ctx) const {
+  f(ctx);
+  return {};
+}
+
+//
+// CtxTailWord
+//
+Ref<WordDef> CtxTailWord::run_tail(IntCtx& ctx) const {
+  return f(ctx);
+}
+
+//
+// WordList
+//
+WordList::WordList(std::vector<Ref<WordDef>>&& _list) : list(std::move(_list)) {
+}
+
+WordList::WordList(const std::vector<Ref<WordDef>>& _list) : list(_list) {
+}
+
+WordList& WordList::push_back(Ref<WordDef> word_def) {
+  list.push_back(std::move(word_def));
+  return *this;
+}
+
+WordList& WordList::push_back(WordDef& wd) {
+  list.emplace_back(&wd);
+  return *this;
+}
+
+Ref<WordDef> WordList::run_tail(IntCtx& ctx) const {
+  if (list.empty()) {
+    return {};
+  }
+  auto it = list.cbegin(), it2 = list.cend() - 1;
+  while (it < it2) {
+    (*it)->run(ctx);
+    ++it;
+  }
+  return *it;
+}
+
+void WordList::close() {
+  list.shrink_to_fit();
+}
+
+WordList& WordList::append(const std::vector<Ref<WordDef>>& other) {
+  list.insert(list.end(), other.begin(), other.end());
+  return *this;
+}
+
+//
+// WordRef
+//
+
+WordRef::WordRef(Ref<WordDef> _def, bool _act) : def(std::move(_def)), active(_act) {
+}
+
+WordRef::WordRef(StackWordFunc func) : def(Ref<StackWord>{true, std::move(func)}), active(false) {
+}
+
+WordRef::WordRef(CtxWordFunc func, bool _act) : def(Ref<CtxWord>{true, std::move(func)}), active(_act) {
+}
+
+WordRef::WordRef(CtxTailWordFunc func, bool _act) : def(Ref<CtxTailWord>{true, std::move(func)}), active(_act) {
+}
+
+Ref<WordDef> WordRef::get_def() const & {
+  return def;
+}
+
+Ref<WordDef> WordRef::get_def() && {
+  return std::move(def);
+}
+
+void WordRef::operator()(IntCtx& ctx) const {
+  def->run(ctx);
+}
+
+bool WordRef::is_active() const {
+  return active;
+}
+
+//
+// Dictionary
+//
+WordRef* Dictionary::lookup(td::Slice name) {
+  auto it = words_.find(name);
+  if (it == words_.end()) {
+    return nullptr;
+  }
+  return &it->second;
+}
+
+void Dictionary::def_ctx_word(std::string name, CtxWordFunc func) {
+  def_word(std::move(name), std::move(func));
+}
+
+void Dictionary::def_active_word(std::string name, CtxWordFunc func) {
+  Ref<WordDef> wdef = Ref<CtxWord>{true, std::move(func)};
+  def_word(std::move(name), {std::move(wdef), true});
+}
+
+void Dictionary::def_stack_word(std::string name, StackWordFunc func) {
+  def_word(std::move(name), std::move(func));
+}
+
+void Dictionary::def_ctx_tail_word(std::string name, CtxTailWordFunc func) {
+  def_word(std::move(name), std::move(func));
+}
+
+void Dictionary::def_word(std::string name, WordRef word) {
+  auto res = words_.emplace(name, std::move(word));
+  LOG_IF(FATAL, !res.second) << "Cannot redefine word: " << name;
+}
+
+void Dictionary::undef_word(td::Slice name) {
+  auto it = words_.find(name);
+  if (it == words_.end()) {
+    return;
+  }
+  words_.erase(it);
+}
+
+void interpret_nop(vm::Stack& stack) {
+}
+
+Ref<WordDef> Dictionary::nop_word_def = Ref<StackWord>{true, interpret_nop};
+
+//
+// functions for wordef
+//
+Ref<WordDef> pop_exec_token(vm::Stack& stack) {
+  stack.check_underflow(1);
+  auto wd_ref = stack.pop().as_object<WordDef>();
+  if (wd_ref.is_null()) {
+    throw IntError{"execution token expected"};
+  }
+  return wd_ref;
+}
+
+Ref<WordList> pop_word_list(vm::Stack& stack) {
+  stack.check_underflow(1);
+  auto wl_ref = stack.pop().as_object<WordList>();
+  if (wl_ref.is_null()) {
+    throw IntError{"word list expected"};
+  }
+  return wl_ref;
+}
+
+void push_argcount(vm::Stack& stack, int args) {
+  stack.push_smallint(args);
+  stack.push({vm::from_object, Dictionary::nop_word_def});
+}
+
+}  // namespace fift

crypto/fift/Dictionary.h

@@ -0,0 +1,182 @@
+/*
+    This file is part of TON Blockchain Library.
+
+    TON Blockchain Library is free software: you can redistribute it and/or modify
+    it under the terms of the GNU Lesser General Public License as published by
+    the Free Software Foundation, either version 2 of the License, or
+    (at your option) any later version.
+
+    TON Blockchain Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with TON Blockchain Library.  If not, see <http://www.gnu.org/licenses/>.
+
+    Copyright 2017-2019 Telegram Systems LLP
+*/
+#pragma once
+
+#include <functional>
+#include <map>
+
+#include "IntCtx.h"
+
+namespace fift {
+using td::Ref;
+/*
+ *
+ *    WORD CLASSES
+ *
+ */
+
+typedef std::function<void(vm::Stack&)> StackWordFunc;
+typedef std::function<void(IntCtx&)> CtxWordFunc;
+
+class WordDef : public td::CntObject {
+ public:
+  WordDef() = default;
+  virtual ~WordDef() override = default;
+  virtual Ref<WordDef> run_tail(IntCtx& ctx) const = 0;
+  void run(IntCtx& ctx) const;
+  virtual bool is_list() const {
+    return false;
+  }
+  virtual long long list_size() const {
+    return -1;
+  }
+  virtual const std::vector<Ref<WordDef>>* get_list() const {
+    return nullptr;
+  }
+};
+
+class StackWord : public WordDef {
+  StackWordFunc f;
+
+ public:
+  StackWord(StackWordFunc _f) : f(std::move(_f)) {
+  }
+  ~StackWord() override = default;
+  Ref<WordDef> run_tail(IntCtx& ctx) const override;
+};
+
+class CtxWord : public WordDef {
+  CtxWordFunc f;
+
+ public:
+  CtxWord(CtxWordFunc _f) : f(std::move(_f)) {
+  }
+  ~CtxWord() override = default;
+  Ref<WordDef> run_tail(IntCtx& ctx) const override;
+};
+
+typedef std::function<Ref<WordDef>(IntCtx&)> CtxTailWordFunc;
+
+class CtxTailWord : public WordDef {
+  CtxTailWordFunc f;
+
+ public:
+  CtxTailWord(CtxTailWordFunc _f) : f(std::move(_f)) {
+  }
+  ~CtxTailWord() override = default;
+  Ref<WordDef> run_tail(IntCtx& ctx) const override;
+};
+
+class WordList : public WordDef {
+  std::vector<Ref<WordDef>> list;
+
+ public:
+  ~WordList() override = default;
+  WordList() = default;
+  WordList(std::vector<Ref<WordDef>>&& _list);
+  WordList(const std::vector<Ref<WordDef>>& _list);
+  WordList& push_back(Ref<WordDef> word_def);
+  WordList& push_back(WordDef& wd);
+  Ref<WordDef> run_tail(IntCtx& ctx) const override;
+  void close();
+  bool is_list() const override {
+    return true;
+  }
+  long long list_size() const override {
+    return (long long)list.size();
+  }
+  const std::vector<Ref<WordDef>>* get_list() const override {
+    return &list;
+  }
+  WordList& append(const std::vector<Ref<WordDef>>& other);
+  WordList* make_copy() const override {
+    return new WordList(list);
+  }
+};
+
+class WordRef {
+  Ref<WordDef> def;
+  bool active;
+
+ public:
+  WordRef() = delete;
+  WordRef(const WordRef& ref) = default;
+  WordRef(WordRef&& ref) = default;
+  WordRef(Ref<WordDef> _def, bool _act = false);
+  WordRef(StackWordFunc func);
+  WordRef(CtxWordFunc func, bool _act = false);
+  WordRef(CtxTailWordFunc func, bool _act = false);
+  //WordRef(const std::vector<Ref<WordDef>>& word_list);
+  //WordRef(std::vector<Ref<WordDef>>&& word_list);
+  WordRef& operator=(const WordRef&) = default;
+  WordRef& operator=(WordRef&&) = default;
+  Ref<WordDef> get_def() const &;
+  Ref<WordDef> get_def() &&;
+  void operator()(IntCtx& ctx) const;
+  bool is_active() const;
+  ~WordRef() = default;
+};
+
+/*
+WordRef::WordRef(const std::vector<Ref<WordDef>>& word_list) : def(Ref<WordList>{true, word_list}) {
+}
+
+WordRef::WordRef(std::vector<Ref<WordDef>>&& word_list) : def(Ref<WordList>{true, std::move(word_list)}) {
+}
+*/
+
+/*
+ *
+ *    DICTIONARIES
+ *
+ */
+
+class Dictionary {
+ public:
+  WordRef* lookup(td::Slice name);
+  void def_ctx_word(std::string name, CtxWordFunc func);
+  void def_ctx_tail_word(std::string name, CtxTailWordFunc func);
+  void def_active_word(std::string name, CtxWordFunc func);
+  void def_stack_word(std::string name, StackWordFunc func);
+  void def_word(std::string name, WordRef word);
+  void undef_word(td::Slice name);
+
+  auto begin() const {
+    return words_.begin();
+  }
+  auto end() const {
+    return words_.end();
+  }
+
+  static Ref<WordDef> nop_word_def;
+
+ private:
+  std::map<std::string, WordRef, std::less<>> words_;
+};
+
+/*
+ *
+ *      AUX FUNCTIONS FOR WORD DEFS
+ *
+ */
+
+Ref<WordDef> pop_exec_token(vm::Stack& stack);
+Ref<WordList> pop_word_list(vm::Stack& stack);
+void push_argcount(vm::Stack& stack, int args);
+}  // namespace fift

crypto/fift/Fift.cpp

@@ -0,0 +1,76 @@
+/*
+    This file is part of TON Blockchain Library.
+
+    TON Blockchain Library is free software: you can redistribute it and/or modify
+    it under the terms of the GNU Lesser General Public License as published by
+    the Free Software Foundation, either version 2 of the License, or
+    (at your option) any later version.
+
+    TON Blockchain Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with TON Blockchain Library.  If not, see <http://www.gnu.org/licenses/>.
+
+    Copyright 2017-2019 Telegram Systems LLP
+*/
+#include "Fift.h"
+
+#include "words.h"
+
+#include "td/utils/PathView.h"
+
+namespace fift {
+
+Fift::Fift(Config config) : config_(std::move(config)) {
+}
+
+Fift::Config& Fift::config() {
+  return config_;
+}
+
+td::Result<int> Fift::interpret_file(std::string fname, std::string current_dir, bool is_interactive) {
+  auto r_file = config_.source_lookup.lookup_source(fname, current_dir);
+  if (r_file.is_error()) {
+    return td::Status::Error("cannot locate file `" + fname + "`");
+  }
+  auto file = r_file.move_as_ok();
+  IntCtx ctx;
+  std::stringstream ss(file.data);
+  ctx.input_stream = &ss;
+  ctx.filename = td::PathView(file.path).file_name().str();
+  ctx.currentd_dir = td::PathView(file.path).parent_dir().str();
+  ctx.include_depth = is_interactive ? 0 : 1;
+  return do_interpret(ctx);
+}
+
+td::Result<int> Fift::interpret_istream(std::istream& stream, std::string current_dir, bool is_interactive) {
+  IntCtx ctx;
+  ctx.input_stream = &stream;
+  ctx.filename = "stdin";
+  ctx.currentd_dir = current_dir;
+  ctx.include_depth = is_interactive ? 0 : 1;
+  return do_interpret(ctx);
+}
+
+td::Result<int> Fift::do_interpret(IntCtx& ctx) {
+  ctx.ton_db = &config_.ton_db;
+  ctx.source_lookup = &config_.source_lookup;
+  ctx.dictionary = &config_.dictionary;
+  ctx.output_stream = config_.output_stream;
+  ctx.error_stream = config_.error_stream;
+  if (!ctx.output_stream) {
+    return td::Status::Error("Cannot run interpreter without output_stream");
+  }
+  try {
+    return funny_interpret_loop(ctx);
+  } catch (fift::IntError ab) {
+    return td::Status::Error(ab.msg);
+  } catch (fift::Quit q) {
+    return q.res;
+  }
+  return 0;
+}
+}  // namespace fift

crypto/fift/Fift.h

@@ -0,0 +1,53 @@
+/*
+    This file is part of TON Blockchain Library.
+
+    TON Blockchain Library is free software: you can redistribute it and/or modify
+    it under the terms of the GNU Lesser General Public License as published by
+    the Free Software Foundation, either version 2 of the License, or
+    (at your option) any later version.
+
+    TON Blockchain Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with TON Blockchain Library.  If not, see <http://www.gnu.org/licenses/>.
+
+    Copyright 2017-2019 Telegram Systems LLP
+*/
+#pragma once
+
+#include "SourceLookup.h"
+#include "vm/db/TonDb.h"
+#include "Dictionary.h"
+
+#include "td/utils/Status.h"
+
+namespace fift {
+struct IntCtx;
+int funny_interpret_loop(IntCtx& ctx);
+
+struct Fift {
+ public:
+  struct Config {
+    fift::SourceLookup source_lookup;
+    vm::TonDb ton_db;
+    fift::Dictionary dictionary;
+    std::ostream* output_stream{&std::cout};
+    std::ostream* error_stream{&std::cerr};
+  };
+  // Fift must own ton_db and dictionary, no concurrent access is allowed
+  explicit Fift(Config config);
+
+  td::Result<int> interpret_file(std::string fname, std::string current_dir, bool interactive = false);
+  td::Result<int> interpret_istream(std::istream& stream, std::string current_dir, bool interactive = true);
+
+  Config& config();
+
+ private:
+  Config config_;
+
+  td::Result<int> do_interpret(IntCtx& ctx);
+};
+}  // namespace fift

crypto/fift/IntCtx.cpp

@@ -0,0 +1,192 @@
+/*
+    This file is part of TON Blockchain Library.
+
+    TON Blockchain Library is free software: you can redistribute it and/or modify
+    it under the terms of the GNU Lesser General Public License as published by
+    the Free Software Foundation, either version 2 of the License, or
+    (at your option) any later version.
+
+    TON Blockchain Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with TON Blockchain Library.  If not, see <http://www.gnu.org/licenses/>.
+
+    Copyright 2017-2019 Telegram Systems LLP
+*/
+#include "IntCtx.h"
+
+namespace fift {
+
+td::StringBuilder& operator<<(td::StringBuilder& os, const IntCtx& ctx) {
+  if (ctx.include_depth) {
+    return os << ctx.filename << ":" << ctx.line_no << ": ";
+  } else {
+    return os;
+  }
+}
+
+std::ostream& operator<<(std::ostream& os, const IntCtx& ctx) {
+  return os << (PSLICE() << ctx).c_str();
+}
+
+void CharClassifier::import_from_string(td::Slice str, int space_cls) {
+  set_char_class(' ', space_cls);
+  set_char_class('\t', space_cls);
+  int cls = 3;
+  for (char c : str) {
+    if (c == ' ') {
+      cls--;
+    } else {
+      set_char_class(c, cls);
+    }
+  }
+}
+
+void CharClassifier::import_from_string(std::string str, int space_cls) {
+  import_from_string(td::Slice{str}, space_cls);
+}
+
+void CharClassifier::import_from_string(const char* str, int space_cls) {
+  import_from_string(td::Slice{str}, space_cls);
+}
+
+CharClassifier CharClassifier::from_string(td::Slice str, int space_cls) {
+  return CharClassifier{str, space_cls};
+}
+
+void CharClassifier::set_char_class(int c, int cl) {
+  c &= 0xff;
+  cl &= 3;
+  int offs = (c & 3) * 2;
+  int mask = (3 << offs);
+  cl <<= offs;
+  unsigned char* p = data_ + (c >> 2);
+  *p = static_cast<unsigned char>((*p & ~mask) | cl);
+}
+
+IntCtx::Savepoint::Savepoint(IntCtx& _ctx, std::string new_filename, std::string new_current_dir,
+                             std::istream* new_input_stream)
+    : ctx(_ctx)
+    , old_line_no(_ctx.line_no)
+    , old_filename(_ctx.filename)
+    , old_current_dir(_ctx.currentd_dir)
+    , old_input_stream(_ctx.input_stream)
+    , old_curline(_ctx.str)
+    , old_curpos(_ctx.input_ptr - _ctx.str.c_str()) {
+  ctx.line_no = 0;
+  ctx.filename = new_filename;
+  ctx.currentd_dir = new_current_dir;
+  ctx.input_stream = new_input_stream;
+  ctx.str = "";
+  ctx.input_ptr = 0;
+  ++(ctx.include_depth);
+}
+
+IntCtx::Savepoint::~Savepoint() {
+  ctx.line_no = old_line_no;
+  ctx.filename = old_filename;
+  ctx.currentd_dir = old_current_dir;
+  ctx.input_stream = old_input_stream;
+  ctx.str = old_curline;
+  ctx.input_ptr = ctx.str.c_str() + old_curpos;
+  --(ctx.include_depth);
+}
+
+bool IntCtx::load_next_line() {
+  if (!std::getline(*input_stream, str)) {
+    return false;
+  }
+  if (!str.empty() && str.back() == '\r') {
+    str.pop_back();
+  }
+  set_input(str);
+  return true;
+}
+
+bool IntCtx::is_sb() const {
+  return !eof() && line_no == 1 && *input_ptr == '#' && input_ptr[1] == '!';
+}
+
+td::Slice IntCtx::scan_word_to(char delim, bool err_endl) {
+  auto ptr = input_ptr;
+  while (*ptr && *ptr != delim) {
+    ptr++;
+  }
+  if (*ptr) {
+    std::swap(ptr, input_ptr);
+    return td::Slice{ptr, input_ptr++};
+  } else if (err_endl && delim) {
+    throw IntError{std::string{"end delimiter `"} + delim + "` not found"};
+  } else {
+    std::swap(ptr, input_ptr);
+    return td::Slice{ptr, input_ptr};
+  }
+}
+
+td::Slice IntCtx::scan_word() {
+  skipspc(true);
+  auto ptr = input_ptr;
+  while (*ptr && *ptr != ' ' && *ptr != '\t' && *ptr != '\r') {
+    ptr++;
+  }
+  auto ptr2 = ptr;
+  std::swap(ptr, input_ptr);
+  skipspc();
+  return td::Slice{ptr, ptr2};
+}
+
+td::Slice IntCtx::scan_word_ext(const CharClassifier& classifier) {
+  skipspc(true);
+  auto ptr = input_ptr;
+  while (*ptr && *ptr != '\r' && *ptr != '\n') {
+    int c = classifier.classify(*ptr);
+    if ((c & 1) && ptr != input_ptr) {
+      break;
+    }
+    ptr++;
+    if (c & 2) {
+      break;
+    }
+  }
+  std::swap(ptr, input_ptr);
+  return td::Slice{ptr, input_ptr};
+}
+
+void IntCtx::skipspc(bool skip_eol) {
+  do {
+    while (*input_ptr == ' ' || *input_ptr == '\t' || *input_ptr == '\r') {
+      ++input_ptr;
+    }
+    if (!skip_eol || *input_ptr) {
+      break;
+    }
+  } while (load_next_line());
+}
+
+void check_compile(const IntCtx& ctx) {
+  if (ctx.state <= 0) {
+    throw IntError{"compilation mode only"};
+  }
+}
+
+void check_execute(const IntCtx& ctx) {
+  if (ctx.state != 0) {
+    throw IntError{"interpret mode only"};
+  }
+}
+
+void check_not_int_exec(const IntCtx& ctx) {
+  if (ctx.state < 0) {
+    throw IntError{"not allowed in internal interpret mode"};
+  }
+}
+
+void check_int_exec(const IntCtx& ctx) {
+  if (ctx.state >= 0) {
+    throw IntError{"internal interpret mode only"};
+  }
+}
+}  // namespace fift

crypto/fift/IntCtx.h

@@ -0,0 +1,147 @@
+/*
+    This file is part of TON Blockchain Library.
+
+    TON Blockchain Library is free software: you can redistribute it and/or modify
+    it under the terms of the GNU Lesser General Public License as published by
+    the Free Software Foundation, either version 2 of the License, or
+    (at your option) any later version.
+
+    TON Blockchain Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with TON Blockchain Library.  If not, see <http://www.gnu.org/licenses/>.
+
+    Copyright 2017-2019 Telegram Systems LLP
+*/
+#pragma once
+
+#include "crypto/vm/db/TonDb.h"  // FIXME
+#include "crypto/vm/stack.hpp"
+#include "crypto/common/bitstring.h"
+
+#include <cstdint>
+#include <cstring>
+#include <iostream>
+#include <string>
+
+namespace fift {
+class Dictionary;
+class SourceLookup;
+
+struct IntError {
+  std::string msg;
+  IntError(std::string _msg) : msg(_msg) {
+  }
+};
+
+class CharClassifier {
+  unsigned char data_[64];
+
+ public:
+  CharClassifier() {
+    std::memset(data_, 0, sizeof(data_));
+  }
+  CharClassifier(td::Slice str, int space_cls = 3) : CharClassifier() {
+    import_from_string(str, space_cls);
+  }
+  CharClassifier(std::string str, int space_cls = 3) : CharClassifier(td::Slice{str}, space_cls) {
+  }
+  CharClassifier(const char* str, int space_cls = 3) : CharClassifier(td::Slice{str}, space_cls) {
+  }
+  void import_from_string(td::Slice str, int space_cls = 3);
+  void import_from_string(std::string str, int space_cls = 3);
+  void import_from_string(const char* str, int space_cls = 3);
+  static CharClassifier from_string(td::Slice str, int space_cls = 3);
+  void set_char_class(int c, int cl);
+  int classify(int c) const {
+    c &= 0xff;
+    int offs = (c & 3) * 2;
+    return (data_[(unsigned)c >> 2] >> offs) & 3;
+  }
+};
+
+struct IntCtx {
+  vm::Stack stack;
+  int state{0};
+  int include_depth{0};
+  int line_no{0};
+  std::string filename;
+  std::string currentd_dir;
+  std::istream* input_stream{nullptr};
+  std::ostream* output_stream{nullptr};
+  std::ostream* error_stream{nullptr};
+
+  vm::TonDb* ton_db{nullptr};
+  Dictionary* dictionary{nullptr};
+  SourceLookup* source_lookup{nullptr};
+
+ private:
+  std::string str;
+  const char* input_ptr;
+
+ public:
+  IntCtx() = default;
+
+  operator vm::Stack&() {
+    return stack;
+  }
+
+  td::Slice scan_word_to(char delim, bool err_endl = true);
+  td::Slice scan_word();
+  td::Slice scan_word_ext(const CharClassifier& classifier);
+  void skipspc(bool skip_eol = false);
+
+  bool eof() const {
+    return !*input_stream;
+  }
+
+  bool not_eof() const {
+    return !eof();
+  }
+
+  void set_input(std::string input_str) {
+    str = input_str;
+    input_ptr = str.c_str();
+    ++line_no;
+  }
+  void set_input(const char* ptr) {
+    input_ptr = ptr;
+  }
+  const char* get_input() const {
+    return input_ptr;
+  }
+
+  bool load_next_line();
+
+  bool is_sb() const;
+
+  void clear() {
+    state = 0;
+    stack.clear();
+  }
+  class Savepoint {
+    IntCtx& ctx;
+    int old_line_no;
+    std::string old_filename;
+    std::string old_current_dir;
+    std::istream* old_input_stream;
+    std::string old_curline;
+    std::ptrdiff_t old_curpos;
+
+   public:
+    Savepoint(IntCtx& _ctx, std::string new_filename, std::string new_current_dir, std::istream* new_input_stream);
+    ~Savepoint();
+  };
+};
+
+void check_compile(const IntCtx& ctx);
+void check_execute(const IntCtx& ctx);
+void check_not_int_exec(const IntCtx& ctx);
+void check_int_exec(const IntCtx& ctx);
+
+td::StringBuilder& operator<<(td::StringBuilder& os, const IntCtx& ctx);
+std::ostream& operator<<(std::ostream& os, const IntCtx& ctx);
+}  // namespace fift

crypto/fift/SourceLookup.cpp

@@ -0,0 +1,89 @@
+/*
+    This file is part of TON Blockchain Library.
+
+    TON Blockchain Library is free software: you can redistribute it and/or modify
+    it under the terms of the GNU Lesser General Public License as published by
+    the Free Software Foundation, either version 2 of the License, or
+    (at your option) any later version.
+
+    TON Blockchain Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with TON Blockchain Library.  If not, see <http://www.gnu.org/licenses/>.
+
+    Copyright 2017-2019 Telegram Systems LLP
+*/
+#include "SourceLookup.h"
+
+#include "td/utils/PathView.h"
+#include "td/utils/PathView.h"
+#include "td/utils/port/path.h"
+#include "td/utils/filesystem.h"
+
+#include <fstream>
+
+namespace fift {
+td::Result<FileLoader::File> OsFileLoader::read_file(td::CSlice filename) {
+  File res;
+  TRY_RESULT(data, td::read_file_str(filename));
+  res.data = std::move(data);
+  TRY_RESULT(path, td::realpath(filename));
+  res.path = std::move(path);
+  return std::move(res);
+}
+
+td::Status OsFileLoader::write_file(td::CSlice filename, td::Slice data) {
+  return td::write_file(filename, data);
+}
+
+td::Result<FileLoader::File> OsFileLoader::read_file_part(td::CSlice filename, td::int64 size, td::int64 offset) {
+  File res;
+  TRY_RESULT(data, td::read_file_str(filename, size, offset));
+  res.data = std::move(data);
+  TRY_RESULT(path, td::realpath(filename));
+  res.path = std::move(path);
+  return std::move(res);
+}
+
+bool OsFileLoader::is_file_exists(td::CSlice filename) {
+  return td::stat(filename).is_ok();
+}
+
+void SourceLookup::add_include_path(td::string path) {
+  if (path.empty()) {
+    return;
+  }
+  if (!td::PathView(path).is_dir()) {
+    path += TD_DIR_SLASH;
+  }
+
+  source_include_path_.push_back(std::move(path));
+}
+
+td::Result<FileLoader::File> SourceLookup::lookup_source(std::string filename, std::string current_dir) {
+  CHECK(file_loader_);
+  if (!current_dir.empty() && !td::PathView(current_dir).is_dir()) {
+    current_dir += TD_DIR_SLASH;
+  }
+  if (td::PathView(filename).is_absolute()) {
+    return read_file(filename);
+  }
+  if (!current_dir.empty()) {
+    auto res = read_file(current_dir + filename);
+    if (res.is_ok()) {
+      return res;
+    }
+  }
+  for (auto& dir : source_include_path_) {
+    auto res = read_file(dir + filename);
+    if (res.is_ok()) {
+      return res;
+    }
+  }
+
+  return td::Status::Error(PSLICE() << "failed to lookup file: " << filename);
+}
+}  // namespace fift

crypto/fift/SourceLookup.h

@@ -0,0 +1,71 @@
+/*
+    This file is part of TON Blockchain Library.
+
+    TON Blockchain Library is free software: you can redistribute it and/or modify
+    it under the terms of the GNU Lesser General Public License as published by
+    the Free Software Foundation, either version 2 of the License, or
+    (at your option) any later version.
+
+    TON Blockchain Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with TON Blockchain Library.  If not, see <http://www.gnu.org/licenses/>.
+
+    Copyright 2017-2019 Telegram Systems LLP
+*/
+#pragma once
+#include <iostream>
+
+#include "td/utils/Status.h"
+
+namespace fift {
+class FileLoader {
+ public:
+  virtual ~FileLoader() = default;
+  struct File {
+    std::string data;
+    std::string path;
+  };
+  virtual td::Result<File> read_file(td::CSlice filename) = 0;
+  virtual td::Status write_file(td::CSlice filename, td::Slice data) = 0;
+  virtual td::Result<File> read_file_part(td::CSlice filename, td::int64 size, td::int64 offset) = 0;
+  virtual bool is_file_exists(td::CSlice filename) = 0;
+};
+
+class OsFileLoader : public FileLoader {
+ public:
+  td::Result<File> read_file(td::CSlice filename) override;
+  td::Status write_file(td::CSlice filename, td::Slice data) override;
+  td::Result<File> read_file_part(td::CSlice filename, td::int64 size, td::int64 offset) override;
+  bool is_file_exists(td::CSlice filename) override;
+};
+
+class SourceLookup {
+ public:
+  SourceLookup() = default;
+  explicit SourceLookup(std::unique_ptr<FileLoader> file_loader) : file_loader_(std::move(file_loader)) {
+  }
+  void add_include_path(td::string path);
+  td::Result<FileLoader::File> lookup_source(std::string filename, std::string current_dir);
+
+  td::Result<FileLoader::File> read_file(td::CSlice path) {
+    return file_loader_->read_file(path);
+  }
+  td::Status write_file(td::CSlice path, td::Slice data) {
+    return file_loader_->write_file(path, data);
+  }
+  td::Result<FileLoader::File> read_file_part(td::CSlice filename, td::int64 size, td::int64 offset) {
+    return file_loader_->read_file_part(filename, size, offset);
+  }
+  bool is_file_exists(td::CSlice filename) {
+    return file_loader_->is_file_exists(filename);
+  }
+
+ protected:
+  std::unique_ptr<FileLoader> file_loader_;
+  std::vector<std::string> source_include_path_;
+};
+}  // namespace fift

crypto/fift/fift-main.cpp

@@ -0,0 +1,221 @@
+/* 
+    This file is part of TON Blockchain source code.
+
+    TON Blockchain is free software; you can redistribute it and/or
+    modify it under the terms of the GNU General Public License
+    as published by the Free Software Foundation; either version 2
+    of the License, or (at your option) any later version.
+
+    TON Blockchain is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with TON Blockchain.  If not, see <http://www.gnu.org/licenses/>.
+
+    In addition, as a special exception, the copyright holders give permission 
+    to link the code of portions of this program with the OpenSSL library. 
+    You must obey the GNU General Public License in all respects for all 
+    of the code used other than OpenSSL. If you modify file(s) with this 
+    exception, you may extend this exception to your version of the file(s), 
+    but you are not obligated to do so. If you do not wish to do so, delete this 
+    exception statement from your version. If you delete this exception statement 
+    from all source files in the program, then also delete it here.
+
+    Copyright 2017-2019 Telegram Systems LLP
+*/
+#include "vm/stack.hpp"
+#include <cassert>
+#include <algorithm>
+#include <string>
+#include <vector>
+#include <iostream>
+#include <sstream>
+#include <fstream>
+#include <memory>
+#include <cstring>
+#include <cstdlib>
+#include <cmath>
+#include <map>
+#include <functional>
+#include <getopt.h>
+
+#include "Fift.h"
+#include "Dictionary.h"
+#include "SourceLookup.h"
+#include "words.h"
+
+#include "vm/db/TonDb.h"
+
+#include "td/utils/logging.h"
+#include "td/utils/misc.h"
+#include "td/utils/Parser.h"
+#include "td/utils/port/path.h"
+
+void usage(const char* progname) {
+  std::cerr << "A simple Fift interpreter. Type `bye` to quit, or `words` to get a list of all commands\n";
+  std::cerr
+      << "usage: " << progname
+      << " [-i] [-n] [-I <source-include-path>] {-L <library-fif-file>} <source-file1-fif> <source-file2-fif> ...\n";
+  std::cerr << "\t-n\tDo not preload standard preamble file `Fift.fif`\n"
+               "\t-i\tForce interactive mode even if explicit source file names are indicated\n"
+               "\t-I<source-search-path>\tSets colon-separated library source include path. If not indicated, "
+               "$FIFTPATH is used instead.\n"
+               "\t-L<library-fif-file>\tPre-loads a library source file\n"
+               "\t-d<ton-db-path>\tUse a ton database\n"
+               "\t-s\tScript mode: use first argument as a fift source file and import remaining arguments as $n)\n"
+               "\t-v<verbosity-level>\tSet verbosity level\n";
+  std::exit(2);
+}
+
+void parse_include_path_set(std::string include_path_set, std::vector<std::string>& res) {
+  td::Parser parser(include_path_set);
+  while (!parser.empty()) {
+    auto path = parser.read_till_nofail(':');
+    if (!path.empty()) {
+      res.push_back(path.str());
+    }
+    parser.skip_nofail(':');
+  }
+}
+
+int main(int argc, char* const argv[]) {
+  bool interactive = false;
+  bool fift_preload = true, no_env = false;
+  bool script_mode = false;
+  std::vector<std::string> library_source_files, source_list;
+  std::vector<std::string> source_include_path;
+  std::string ton_db_path;
+
+  fift::Fift::Config config;
+
+  int i;
+  int new_verbosity_level = VERBOSITY_NAME(INFO);
+  while (!script_mode && (i = getopt(argc, argv, "hinI:L:d:sv:")) != -1) {
+    switch (i) {
+      case 'i':
+        interactive = true;
+        break;
+      case 'n':
+        fift_preload = false;
+        break;
+      case 'I':
+        parse_include_path_set(optarg, source_include_path);
+        no_env = true;
+        break;
+      case 'L':
+        library_source_files.emplace_back(optarg);
+        break;
+      case 'd':
+        ton_db_path = optarg;
+        break;
+      case 's':
+        script_mode = true;
+        break;
+      case 'v':
+        new_verbosity_level = VERBOSITY_NAME(FATAL) + td::to_integer<int>(td::Slice(optarg));
+        break;
+      case 'h':
+      default:
+        usage(argv[0]);
+    }
+  }
+  SET_VERBOSITY_LEVEL(new_verbosity_level);
+
+  while (optind < argc) {
+    source_list.emplace_back(argv[optind++]);
+    if (script_mode) {
+      break;
+    }
+  }
+
+  if (!no_env) {
+    const char* path = std::getenv("FIFTPATH");
+    if (path) {
+      parse_include_path_set(path ? path : "/usr/lib/fift", source_include_path);
+    }
+  }
+  std::string current_dir;
+  auto r_current_dir = td::realpath(".");
+  if (r_current_dir.is_ok()) {
+    current_dir = r_current_dir.move_as_ok();
+    source_include_path.push_back(current_dir);
+  }
+  config.source_lookup = fift::SourceLookup(std::make_unique<fift::OsFileLoader>());
+  for (auto& path : source_include_path) {
+    config.source_lookup.add_include_path(path);
+  }
+
+  if (!ton_db_path.empty()) {
+    auto r_ton_db = vm::TonDbImpl::open(ton_db_path);
+    if (r_ton_db.is_error()) {
+      LOG(ERROR) << "Error opening ton database: " << r_ton_db.error().to_string();
+      std::exit(2);
+    }
+    config.ton_db = r_ton_db.move_as_ok();
+    // FIXME //std::atexit([&] { config.ton_db.reset(); });
+  }
+
+  fift::init_words_common(config.dictionary);
+  fift::init_words_vm(config.dictionary);
+  fift::init_words_ton(config.dictionary);
+
+  if (script_mode) {
+    fift::import_cmdline_args(config.dictionary, source_list.empty() ? "" : source_list[0], argc - optind,
+                              argv + optind);
+  }
+
+  fift::Fift fift(std::move(config));
+
+  if (fift_preload) {
+    auto status = fift.interpret_file("Fift.fif", "");
+    if (status.is_error()) {
+      LOG(ERROR) << "Error interpreting standard preamble file `Fift.fif`: " << status.error().message()
+                 << "\nCheck that correct include path is set by -I or by FIFTPATH environment variable, or disable "
+                    "standard preamble by -n.\n";
+      std::exit(2);
+    }
+  }
+
+  for (auto source : library_source_files) {
+    auto status = fift.interpret_file(source, "");
+    if (status.is_error()) {
+      LOG(ERROR) << "Error interpreting preloaded file `" << source << "`: " << status.error().message();
+      std::exit(2);
+    }
+  }
+
+  if (source_list.empty()) {
+    interactive = true;
+  }
+  for (const auto& source : source_list) {
+    bool is_stdin = (source.empty() || source == "-");
+    auto status =
+        !is_stdin ? fift.interpret_file(source, current_dir) : fift.interpret_istream(std::cin, current_dir, false);
+    if (status.is_error()) {
+      if (!is_stdin) {
+        LOG(ERROR) << "Error interpreting file `" << source << "`: " << status.error().message();
+      } else {
+        LOG(ERROR) << "Error interpreting stdin: " << status.error().message();
+      }
+      std::exit(2);
+    }
+    auto res = status.move_as_ok();
+    if (res) {
+      std::exit(~res);
+    }
+  }
+  if (interactive) {
+    auto status = fift.interpret_istream(std::cin, current_dir);
+    if (status.is_error()) {
+      LOG(ERROR) << status.error().message();
+      std::exit(2);
+    } else {
+      int res = status.move_as_ok();
+      if (res) {
+        std::exit(~res);
+      }
+    }
+  }
+}

crypto/fift/lib/Fift.fif

@@ -0,0 +1,83 @@
+{ 0 word drop 0 'nop } :: //
+{ char " word 1 { swap { abort } if drop } } ::_ abort"
+{ { bl word dup "" $= abort"comment extends after end of file" "*/" $= } until 0 'nop } :: /*
+// { bl word 1 2 ' (create) } "::" 1 (create)
+// { bl word 0 2 ' (create) } :: :
+// { bl word 2 2 ' (create) } :: :_
+// { bl word 3 2 ' (create) } :: ::_
+// { bl word 0 (create) } : create
+// { bl word (forget) } : forget
+{ bl word 1 ' (forget) } :: [forget]
+{ char " word 1 ' type } ::_ ."
+{ swap ({) over 2+ -roll swap (compile) (}) } : does
+{ 1 'nop does create } : constant
+{ 2 'nop does create } : 2constant
+{ hole constant } : variable
+10 constant ten
+{ bl word 1 { find 0= abort"word not found" } } :: (')
+{ bl word find not abort"-?" 0 swap } :: [compile]
+{ bl word 1 { 
+  dup find { " -?" $+ abort } ifnot nip execute
+} } :: @'
+{ bl word 1 { swap 1 'nop does swap 0 (create) }
+} :: =:
+{ bl word 1 { -rot 2 'nop does swap 0 (create) }
+} :: 2=:
+{ <b swap s, b> } : s>c
+{ s>c hash } : shash
+// to be more efficiently re-implemented in C++ in the future
+{ dup 0< ' negate if } : abs
+{ 2dup > ' swap if } : minmax
+{ minmax drop } : min
+{ minmax nip } : max
+"" constant <#
+' $reverse : #>
+{ swap 10 /mod char 0 + rot swap hold } : #
+{ { # over 0<= } until } : #s
+{ 0< { char - hold } if } : sign
+// { dup abs <# #s rot sign #> nip } : (.)
+// { (.) type } : ._
+// { ._ space } : .
+{ bl (-trailing) } : -trailing
+{ char 0 (-trailing) } : -trailing0
+{ char " word 1 ' $+ } ::_ +"
+{ find 0<> dup ' nip if } : (def?)
+{ bl word 1 ' (def?) } :: def?
+{ bl word 1 { (def?) not } } :: undef?
+{ def? ' skip-to-eof if } : skip-ifdef
+{ bl word dup (def?) { drop skip-to-eof } { 'nop swap 0 (create) } cond } : library
+{ bl word dup (def?) { 2drop skip-to-eof } { swap 1 'nop does swap 0 (create) } cond } : library-version
+{ char ) word "$" swap $+ 1 { find 0= abort"undefined parameter" execute } } ::_ $(
+// b s -- ?
+{ sbitrefs rot brembitrefs rot >= -rot <= and } : s-fits?
+{ 0 swap ! } : 0!
+{ tuck @ + swap ! } : +!
+{ tuck @ swap - swap ! } : -!
+{ 1 swap +! } : 1+!
+{ -1 swap +! } : 1-!
+{ null swap ! } : null!
+0 tuple constant nil
+{ 1 tuple } : single
+{ 2 tuple } : pair
+{ 3 tuple } : triple
+{ 1 untuple } : unsingle
+{ 2 untuple } : unpair
+{ 3 untuple } : untriple
+{ over tuple? { swap count = } { 2drop false } cond } : tuple-len?
+{ 0 tuple-len? } : nil?
+{ 1 tuple-len? } : single?
+{ 2 tuple-len? } : pair?
+{ 3 tuple-len? } : triple?
+{ 0 [] } : first
+{ 1 [] } : second
+{ 2 [] } : third
+' pair : cons
+' unpair : uncons
+{ 0 [] } : car
+{ 1 [] } : cdr
+{ cdr car } : cadr
+{ cdr cdr } : cddr
+{ cdr cdr car } : caddr
+{ null ' cons rot times } : list
+{ true (atom) drop } : atom
+{ bl word atom 1 'nop } ::_ `

crypto/fift/lib/Lisp.fif

@@ -0,0 +1,436 @@
+library Lisp  // tiny Lisp (or rather Scheme) interpreter
+"Lists.fif" include
+variable lisp-dict
+{ hole dup 1 { @ execute } does create } : recursive
+{ atom>$ +" undefined" abort } : report-not-found
+// a l -- d -1 or a 0  Look up definition d of atom a in dictionary l
+{ { dup null? { drop false true }
+    { uncons -rot unpair -rot over eq?
+      { drop nip true true } { nip swap false } cond
+    } cond
+  } until
+} : lookup-in
+// a dict -- def
+{ lookup-in ' report-not-found ifnot } : lookup-or-fail
+{ lisp-dict @ lookup-or-fail } : lisp-dict-lookup
+// a d --  Defines a with definition d in dictionary lisp-dict
+{ pair lisp-dict @ cons lisp-dict ! } : lisp-dict-int-define
+{ box lisp-dict-int-define } : lisp-dict-define
+// a d -- Defines new a with defininition d
+{ over lisp-dict @ lookup-in { 2drop atom>$ +" already defined" abort }
+  { drop lisp-dict-int-define } cond
+} : lisp-dict-int-define-new
+{ box lisp-dict-int-define-new } : lisp-dict-define-new
+// a e -- Defines a with executable definition given by e
+{ single lisp-dict-define-new } : lisp-dict-define-exec
+// expr ctx def -- val
+{ dup first execute } : run-definition
+// expr ctx -- val
+recursive lisp-ctx-eval {
+  over tuple?
+  { over first over lisp-ctx-eval run-definition }
+  { over atom? { lookup-or-fail @ } { drop } cond }
+  cond
+} swap !
+// exp -- value
+{ lisp-dict @ lisp-ctx-eval } : lisp-eval
+// (exprs) ctx -- (vals)
+recursive lisp-ctx-eval-list
+{ over null? { drop } {
+  swap uncons -rot over lisp-ctx-eval -rot lisp-ctx-eval-list cons
+  } cond 
+} swap !
+// (exprs) ctx -- val
+{ null rot {
+  dup null? { drop nip true } {
+  nip uncons swap 2 pick lisp-ctx-eval swap false
+  } cond } until
+} : lisp-ctx-eval-list-last
+// l c -- (args)
+{ swap uncons nip swap lisp-ctx-eval-list } : extract-eval-arg-list
+{ drop uncons nip } : extract-arg-list
+// (x1 .. xn) e n -- x1 .. xn e
+{ { swap uncons rot } swap times
+  swap null? not abort"invalid number of arguments"
+} : unpack-list
+// l c n e -- v
+{ swap 2swap extract-eval-arg-list  // e n (args)
+  -rot unpack-list execute
+} : eval-exec-fixed
+// l c n e -- v
+{ 2 pick pair
+  swap 2swap extract-arg-list  // [e c] n (args)
+  -rot unpack-list unpair swap execute
+} : exec-fixed
+// l c e -- v
+{ -rot extract-eval-arg-list  // e (args)
+  swap execute
+} : eval-exec-list
+{ -rot tuck extract-arg-list  // e c (args)
+  swap rot execute
+} : exec-list
+// e a n --
+{ rot 2 {  // expr ctx def n e
+    rot drop eval-exec-fixed } does
+  lisp-dict-define-exec
+} : lisp-fixed-primitive
+{ rot 2 { rot drop exec-fixed } does lisp-dict-define-exec
+} : lisp-fixed-lazy-primitive
+// e a --
+{ swap 1 { nip eval-exec-list } does lisp-dict-define-exec
+} : lisp-primitive
+{ swap 1 { nip exec-list } does lisp-dict-define-exec
+} : lisp-lazy-primitive
+
+// Uncomment next line for Fift booleans
+// false constant #f  true constant #t  null constant no-answer
+// Uncomment next line for Scheme booleans
+`#f constant #f  `#t constant #t  #f constant no-answer
+{ #f eq? } : lisp-false?
+{ lisp-false? 0= } : lisp-true?
+{ ' #t ' #f cond } : lisp-bool
+
+// temp for defining a lot of primitives
+{ bl word atom lisp-primitive } : L:
+{ bl word atom swap lisp-dict-define } : L=:
+{ bl word atom swap lisp-fixed-primitive } : #L:
+{ 0 #L: } : 0L:
+{ 1 #L: } : 1L:
+{ 2 #L: } : 2L:
+
+// basic primitives
+{ sum-list } L: +
+{ - } 2L: -
+{ dup null? { drop 1 } { ' * foldl-ne } cond } L: *
+{ / } 2L: /
+{ mod } 2L: modulo
+{ abs } 1L: abs
+{ ' min foldl-ne } L: min
+{ ' max foldl-ne } L: max
+{ true ' and foldl } L: integer-and
+{ false ' or foldl } L: integer-or
+{ 0 ' xor foldl } L: integer-xor
+{ not } 1L: integer-not
+{ = lisp-bool } 2L: =
+{ <> lisp-bool } 2L: <>
+{ < lisp-bool } 2L: <
+{ <= lisp-bool } 2L: <=
+{ > lisp-bool } 2L: >
+{ >= lisp-bool } 2L: >=
+{ eq? lisp-bool } 2L: eq?
+{ eqv? lisp-bool } 2L: eqv?
+{ equal? lisp-bool } 2L: equal?
+{ cons } 2L: cons
+{ car } 1L: car
+{ cdr } 1L: cdr
+{ cadr } 1L: cadr
+{ cddr } 1L: cddr
+{ caddr } 1L: caddr
+{ cdr cddr } 1L: cdddr
+{ concat-list-lists } L: append
+{ list-reverse } 1L: reverse
+{ list-tail } 2L: list-tail
+{ list-ref } 2L: list-ref
+{ list-member-eq } 2L: memq
+{ list-member-eqv } 2L: memv
+{ list-member-equal } 2L: member
+{ assq ' #f ifnot } 2L: assq
+{ assv ' #f ifnot } 2L: assv
+{ assoc ' #f ifnot } 2L: assoc
+{ list? lisp-bool } 1L: list?
+{ pair? lisp-bool } 1L: pair?
+{ tuple? lisp-bool } 1L: tuple?
+{ string? lisp-bool } 1L: string?
+{ integer? lisp-bool } 1L: integer?
+{ integer? lisp-bool } 1L: number?
+{ count } 1L: width
+{ list-length } 1L: length
+{ [] } 2L: tuple-ref
+{ first } 1L: first
+{ second } 1L: second
+{ third } 1L: third
+{ 3 [] } 1L: fourth
+{ list>tuple } 1L: list->tuple
+{ explode list } 1L: tuple->list
+null L=: null
+{ atom? lisp-bool } 1L: symbol?
+{ atom } 1L: string->symbol
+{ atom>$ } 1L: symbol->string
+{ dup #f eq? swap #t eq? or lisp-bool } 1L: boolean?
+#t L=: else
+#f L=: #f
+#t L=: #t
+{ null? lisp-bool } 1L: null?
+{ 0= lisp-bool } 1L: zero?
+{ 0> lisp-bool } 1L: positive?
+{ 0< lisp-bool } 1L: negative?
+{ 1 and 0= lisp-bool } 1L: even?
+{ 1 and 0<> lisp-bool } 1L: odd?
+{ bye } 0L: exit
+{ .l null } 1L: write
+{ lisp-eval } 1L: eval
+{ drop } `quote 1 lisp-fixed-lazy-primitive
+'nop L: list
+{ list>tuple } L: tuple
+{ list-last } L: begin
+{ $len } 1L: string-length
+{ concat-string-list } L: string-append
+{ $= lisp-bool } 2L: string=?
+{ $cmp 0< lisp-bool } 2L: string<?
+{ $cmp 0<= lisp-bool } 2L: string<=?
+{ $cmp 0> lisp-bool } 2L: string>?
+{ $cmp 0>= lisp-bool } 2L: string>=?
+{ (number) dup 1 = { drop } { ' 2drop if no-answer } cond
+} 1L: string->number
+{ (.) } 1L: number->string
+{ box? lisp-bool } 1L: box?
+{ box } 1L: box
+{ hole } 0L: new-box
+{ @ } 1L: unbox
+{ tuck swap ! } 2L: set-box!
+{ abort } 1L: error
+{ dup find { nip execute } { +" -?" abort } cond } : find-execute
+{ explode-list 1- roll find-execute } L: fift-exec
+{ explode-list dup 1- swap roll find-execute } L: fift-exec-cnt
+{ uncons swap find-execute } L: fift-exec-list
+// end of basic primitives
+forget L:  forget #L:  forget L=:
+forget 0L:  forget 1L:  forget 2L:
+
+{ { dup tuple? ' do-quote if } list-map } : map-quote
+{ uncons ' cons foldr-ne map-quote
+  null swap cons lisp-dict @ rot run-definition
+} `apply lisp-primitive  // bad: should have preserved original context
+// e1 e2 e3 ctx
+{ 3 exch 3 pick lisp-ctx-eval lisp-true? ' swap if nip swap lisp-ctx-eval }
+`if 3 lisp-fixed-lazy-primitive
+// (e) ctx
+{ #t -rot 
+  { over null? { 2drop true } {
+    swap uncons swap 2 pick lisp-ctx-eval dup lisp-true? // v' c t v ?
+    { swap 2swap nip false } { -rot 2drop nip true } cond
+  } cond } until
+} `and lisp-lazy-primitive
+{ #f -rot
+  { over null? { 2drop true } {
+    swap uncons swap 2 pick lisp-ctx-eval dup lisp-false? // v' c t v ?
+    { swap 2swap nip false } { -rot 2drop nip true } cond
+  } cond } until
+} `or lisp-lazy-primitive
+{ lisp-false? lisp-bool } `not 1 lisp-fixed-primitive
+// cond-clause ctx -- v -1 or 0
+{ swap uncons -rot dup `else eq? {
+  drop lisp-ctx-eval-list-last true } {
+  over lisp-ctx-eval lisp-true? {
+  lisp-ctx-eval-list-last true } {
+  2drop false
+  } cond } cond
+} : eval-cond-clause
+// (clauses) ctx -- v
+{ { over null? { no-answer true } {
+    swap uncons -rot over eval-cond-clause } cond 
+  } until -rot 2drop
+} `cond lisp-lazy-primitive
+{ lisp-dict @ lookup-in { hole tuck lisp-dict-int-define } ifnot
+} : lisp-create-global-var
+// a e ctx  -- old (simple) define
+{ drop over atom? not abort"only a variable can be define'd"
+  over lisp-create-global-var swap lisp-eval swap ! 
+} drop // `define 2 lisp-fixed-lazy-primitive
+{ tuck lisp-ctx-eval rot dup atom? not abort"only a variable can be set"
+  rot lookup-or-fail dup @ -rot !
+} `set! 2 lisp-fixed-lazy-primitive
+// define lambda
+{ { dup null? { drop true true }
+    { uncons swap atom? { false } { drop false true } cond } cond
+  } until
+} : var-list?
+{ { dup null? over atom? or { drop true true }
+    { uncons swap atom? { false } { drop false true } cond } cond
+  } until
+} : lambda-var-list?
+// (quote x) -- x -1 ; else 0
+{ dup pair? { uncons swap `quote eq? { car true } { drop false } cond }
+  { drop false } cond
+} : is-quote?
+recursive match-arg-list-acc
+// l (vars) (args) -- ((var . arg) ...)+l -1 or ? 0
+{ over atom? { over `_ eq? { 2drop } { pair swap cons } cond true } { 
+  over null? { nip null? } { // (vars) (args)
+  over tuple? not { 2drop false } {
+  over is-quote? { eq? nip } { // (v) (a)
+  dup tuple? not { 2drop false } {
+  over count over count over <> { drop 2drop false } { // l [v] [a] n
+  3 roll 0 rot { // [v] [a] l i
+    dup 0< {
+      3 pick over [] swap  // [v] [a] l vi i
+      3 pick over [] 2swap rot // [v] [a] i l vi ai
+      match-arg-list-acc { // [v] [a] i l'
+        swap 1+ } { nip -1 } cond
+    } ifnot
+  } swap times
+  2swap 2drop 0>=
+  } cond } cond } cond } cond } cond } cond
+} swap !
+{ null -rot match-arg-list-acc } : match-arg-list
+// ((var . arg)...) ctx -- ctx'
+{ { over null? not }
+  { swap uncons swap unpair box pair rot cons } while
+  nip
+} : extend-ctx-by-list
+// ((vars) body) ctx
+{ swap uncons -rot 
+  dup lambda-var-list? not abort"invalid formal parameter list"
+  { // l-expr ctx' [_ body ctx (vars)]
+    -rot 2 pick 3 [] swap rot  // [_ body ...] (vars) ctx' l-expr
+    uncons nip swap lisp-ctx-eval-list  // [_ body ...] (vars) (arg-vals)
+    match-arg-list not abort"invalid arguments to lambda" // [_ body ...] ((var arg)...)
+    over third extend-ctx-by-list // [_ body ctx (vars)] ctx''
+    swap second swap lisp-ctx-eval-list-last
+  } 3 -roll 4 tuple
+} : make-lambda
+{ make-lambda } `lambda lisp-lazy-primitive
+// (a e) ctx -- more sophisticated (define a e)
+{ drop uncons swap dup atom? { // (e) a 
+    tuck lisp-create-global-var
+    swap lisp-dict @ lisp-ctx-eval-list-last swap !
+  } { // (e) (a v..)
+    uncons over atom? not abort"only variables can be define'd"  // (e) a (v..)
+    rot cons over lisp-create-global-var   // a ((v..) (e)) h
+    swap lisp-dict @ make-lambda swap !
+  } cond
+} `define lisp-lazy-primitive
+// ((x e) ..) ctx -- ((x.v) ..)
+recursive eval-assign-list
+{ over null? { drop } {
+  swap uncons swap uncons // ctx t x (e)
+  over atom? not abort"invalid variable name in assignment list"
+  3 pick lisp-ctx-eval-list-last  // ctx t x v
+  pair swap rot eval-assign-list cons
+  } cond
+} swap !
+// (((x v) ..) body) ctx  -- let construct
+{ swap uncons swap 2 pick eval-assign-list  // ctx body ((x v)...)
+  rot extend-ctx-by-list lisp-ctx-eval-list-last
+} `let lisp-lazy-primitive
+// ((x e) ..) ctx -- ctx'
+{ swap {
+  dup null? { drop true } {
+  uncons swap uncons  // ctx t x (e)
+  over atom? not abort"invalid variable name in assignment list"
+  3 pick lisp-ctx-eval-list-last  // ctx t x v
+  box pair rot cons swap false
+  } cond } until
+} : compute-let*-ctx
+// (((x v) ..) body) ctx  -- let* construct
+{ swap uncons swap rot compute-let*-ctx lisp-ctx-eval-list-last
+} `let* lisp-lazy-primitive
+// ((x e) ..) ctx -- ((h e) ..) ctx' , with x bound to h in ctx'
+recursive prepare-letrec-ctx {
+  over null? {
+  swap uncons swap uncons swap // ctx t (e) x
+  hole tuck pair swap rot cons // ctx t (x.h) (h e)
+  3 -roll rot cons prepare-letrec-ctx // (h e) t ctx'
+  -rot cons swap
+  } ifnot
+} swap !
+// (((x v) ..) body) ctx  -- letrec construct
+{ swap uncons swap rot prepare-letrec-ctx swap { // body ctx' ((h e)..)
+    dup null? { drop true } {
+    uncons -rot uncons 2 pick lisp-ctx-eval-list-last // body t ctx' h v
+    swap ! swap false
+  } cond } until
+  lisp-ctx-eval-list-last
+} `letrec lisp-lazy-primitive
+// (e (p e)...) ctx -- match construct
+{ swap uncons swap 2 pick lisp-ctx-eval swap { // ctx v ((p e)..)
+  dup null? { drop 2drop no-answer true } {
+  uncons swap uncons swap 3 pick // ctx v t e p v
+  match-arg-list { // ctx v t e ((x' . v')...)
+  2swap 2drop rot extend-ctx-by-list lisp-ctx-eval-list-last true } {
+  2drop false
+  } cond } cond } until
+} `match lisp-lazy-primitive
+//
+lisp-dict @ constant original-lisp-dict
+{ original-lisp-dict lisp-dict ! } : reset-lisp
+{ ' drop { lisp-eval .l cr } List-generic( } :_ LISP-EVAL-PRINT(
+// LISP-EVAL-PRINT((+ 3 4) (* 5 6)) computes and prints 12 and 30
+{ hole dup 1 { @ nip } does swap 
+  1 { swap lisp-eval swap ! } does 
+  List-generic(
+} :_ LISP-EVAL(
+// LISP-EVAL((+ 3 4) (* 5 6)) computes 12 and 30, returns only 30
+// /*
+LISP-EVAL-PRINT(
+  (define succ (lambda (x) (+ x 1)))
+  (define (twice f) (lambda (x) (f (f x))))
+  (define (fact n) (if (= n 0) 1 (* n (fact (- n 1)))))
+  (fact ((twice succ) 5))
+  (define compare (lambda (x y) (cond ((< x y) 'less) ((= x y) 'equal) (else 'greater))))
+  (compare 2 3)
+  (compare 7 (+ 2 3))
+  (define next (let ((cnt 0)) (lambda () (set! cnt (+ cnt 1)) cnt)))
+  (list (next) (next))
+  (define new-counter (lambda () (let ((x 0)) (lambda () (set! x (+ x 1)) x))))
+  (define c1 (new-counter))
+  (define c2 (new-counter))
+  (list (c1) (c1) (c2) (c1) (c2) (c1) (c1) (c2) (c2))
+  (let* ((x (+ 2 3)) (y (* x x)) (z (+ x y))) (list x y z))
+  (letrec ((even? (lambda (n) (if (= n 0) #t (odd? (- n 1)))))
+           (odd?  (lambda (n) (if (= n 0) #f (even? (- n 1))))))
+          (even? 88))
+  (define (len l) (if (null? l) 0 (+ 1 (len (cdr l)))))
+  (len '(2 3 9))
+  (define (len2 l) (match l (() 0) ((x . t) (+ 1 (len2 t)))))
+  (len2 '(2 3 9))
+  (define (foo x) (match x
+     (('zero) 0)
+     (('succ x) (+ (foo x) 1))
+     (('plus x y) (+ (foo x) (foo y)))
+     (('minus x y) (- (foo x) (foo y)))
+     (x x)))
+  (foo '(plus (succ (zero)) (minus (succ (succ 5)) 3)))
+  (define (bar x) (match x
+     (['zero] 0)
+     (['succ x] (+ (bar x) 1))
+     (['plus x y] (+ (bar x) (bar y)))
+     (['minus x y] (- (bar x) (bar y)))
+     (['const x] x)))
+  (bar '[plus [succ [zero]] [minus [succ [succ [const 5]]] [const 3]]])
+  (define (map f l) (letrec
+    ((map-f (lambda (l) (match l
+      (() ())
+      ((h . t) (cons (f h) (map-f t)))))))
+    (map-f l)))
+  (map (lambda (x) (* x (+ 2 x))) '(2 3 9))
+  (define (make-promise proc) (let ((result-ready? #f) (result #f))
+    (lambda ()
+      (if result-ready? result
+        (let ((x (proc)))
+	  (if result-ready? result
+	    (begin (set! result x) (set! result-ready? #t) result)))))))
+  (define (force promise) (promise))
+)
+// */
+// words for invoking Lisp definitions from Fift
+// (args) def -- val
+{ null rot map-quote cons lisp-dict @ rot run-definition
+} : invoke-lisp-definition
+{ atom lisp-dict-lookup 1 { @ invoke-lisp-definition }
+} : (invoke-lisp)
+{ bl word (invoke-lisp) } :: invoke-lisp
+// ( 2 3 ) invoke-lisp compare .l
+{ atom lisp-dict-lookup 2 { @ mklist-1 invoke-lisp-definition }
+} : (invoke-lisp-fixed)
+{ bl word (invoke-lisp-fixed) } :: invoke-lisp-fixed
+// 9 8  2 invoke-lisp-fixed compare .l
+{ bl word (invoke-lisp) does } : make-lisp-invoker
+{ bl word (invoke-lisp-fixed) does } : make-lisp-fixed-invoker
+// 2 make-lisp-fixed-invoker compare : compare
+// 3 9 compare
+// import Lisp definitions as Fift words
+{ bl word dup (invoke-lisp) does swap 0 (create) } : import-lisp
+{ bl word tuck (invoke-lisp-fixed) does swap 0 (create) } : import-lisp-fixed
+// 1 import-lisp-fixed fact
+// 7 fact .

crypto/fift/lib/Lists.fif

@@ -0,0 +1,184 @@
+library Lists  // List utilities
+//
+{ hole dup 1 { @ execute } does create } : recursive
+// x x' -- ?  recursively compares two S-expressions
+recursive equal? {
+  dup tuple? {
+    over tuple? {
+      over count over count over = { // t t' l ?
+        0 { dup 0>= { 2dup [] 3 pick 2 pick [] equal? { 1+ } { drop -1 } cond
+            } if } rot times
+        nip nip 0>=
+      } { drop 2drop false } cond
+    } { 2drop false } cond
+  } { eqv? } cond
+} swap !
+// (a1 .. an) -- (an .. a1)
+{ null swap { dup null? not } { uncons swap rot cons swap } while drop } : list-reverse
+// (a1 .. an) -- an   Computes last element of non-empty list l
+{ { uncons dup null? { drop true } { nip false } cond } until } : list-last
+// l l' -- l++l'  Concatenates two lists
+recursive list+ {
+  over null? { nip } { swap uncons rot list+ cons } cond
+} swap !
+// l l' -- l'' -1 or 0, where l = l' ++ l''
+// Removes prefix from list
+{ { dup null? { drop true true } {
+  swap dup null? { 2drop false true } { // l' l
+  uncons swap rot uncons -rot equal? { false } {
+  2drop false true
+  } cond } cond } cond } until
+} : list-
+// (a1 .. an) -- a1 .. an n   Explodes a list
+{ 0 { over null? not } { swap uncons rot 1+ } while nip } : explode-list
+// (a1 .. an) x -- a1 .. an n x   Explodes a list under the topmost element
+{ swap explode-list dup 1+ roll } : explode-list-1
+// l -- t   Transforms a list into a tuple with the same elements
+{ explode-list tuple } : list>tuple
+// a1 ... an n x -- (a1 .. an) x
+{ null swap rot { -rot cons swap } swap times } : mklist-1
+// (s1 ... sn) -- s1+...+sn   Concatenates a list of strings
+{ "" { over null? not } { swap uncons -rot $+ } while nip
+} : concat-string-list
+// (x1 ... xn) -- x1+...+xn   Sums a list of integers
+{ 0 { over null? not } { swap uncons -rot + } while nip
+} : sum-list
+// (a1 ... an) a e -- e(...e(e(a,a1),a2),...),an)
+{ -rot { over null? not } { swap uncons -rot 3 pick execute } while nip nip
+} : foldl
+// (a1 ... an) e -- e(...e(e(a1,a2),a3),...),an)
+{ swap uncons swap rot foldl } : foldl-ne
+// (a1 ... an) a e -- e(a1,e(a2,...,e(an,a)...))
+recursive foldr {
+  rot dup null? { 2drop } {
+    uncons -rot 2swap swap 3 pick foldr rot execute
+  } cond
+} swap !
+// (a1 ... an) e -- e(a1,e(a2,...,e(a[n-1],an)...))
+recursive foldr-ne {
+  over cdr null? { drop car } {
+    swap uncons 2 pick foldr-ne rot execute
+  } cond
+} swap !
+// (l1 ... ln) -- l1++...++ln   Concatenates a list of lists
+{ dup null? { ' list+ foldr-ne } ifnot } : concat-list-lists
+// (a1 .. an . t) n -- t   Computes the n-th tail of a list
+{ ' cdr swap times } : list-tail
+// (a0 .. an ..) n -- an   Computes the n-th element of a list
+{ list-tail car } : list-ref
+// l -- ?
+{ { dup null? { drop true true } {
+    dup pair? { cdr false } {
+    drop false true
+  } cond } cond } until
+} : list?
+// l -- n
+{ 0 { over null? not } { 1+ swap uncons nip swap } while nip
+} : list-length
+// l e -- t  // returns tail of l after first member that satisfies e
+{ swap {
+  dup null? { nip true } {
+  tuck car over execute { drop true } {
+  swap cdr false
+  } cond } cond } until
+} : list-tail-from
+// a l -- t  // tail of l after first occurence of a using eq?
+{ swap 1 ' eq? does list-tail-from } : list-member-eq
+{ swap 1 ' eqv? does list-tail-from } : list-member-eqv
+{ swap 1 ' equal? does list-tail-from } : list-member-equal
+// a l -- ?
+{ list-member-eq null? not } : list-member?
+{ list-member-eqv null? not } : list-member-eqv?
+// l -- a -1 or 0 // returns car l if l is non-empty
+{ dup null? { drop false } { car true } cond
+} : safe-car
+{ dup null? { drop false } { car second true } cond
+} : get-first-value
+// l e -- v -1 or 0
+{ list-tail-from safe-car } : assoc-gen
+{ list-tail-from get-first-value } : assoc-gen-x
+// a l -- (a.v) -1 or 0 -- returns first entry (a . v) in l
+{ swap 1 { swap first eq? } does assoc-gen } : assq
+{ swap 1 { swap first eqv? } does assoc-gen } : assv
+{ swap 1 { swap first equal? } does assoc-gen } : assoc
+// a l -- v -1 or 0 -- returns v from first entry (a . v) in l
+{ swap 1 { swap first eq? } does assoc-gen-x } : assq-val
+{ swap 1 { swap first eqv? } does assoc-gen-x } : assv-val
+{ swap 1 { swap first equal? } does assoc-gen-x } : assoc-val
+// (a1 .. an) e -- (e(a1) .. e(an))
+recursive list-map {
+  over null? { drop } {
+  swap uncons -rot over execute -rot list-map cons
+  } cond
+} swap !
+//
+// create Lisp-style lists using words "(" and ")"
+//
+variable ')
+'nop box constant ',
+{ ") without (" abort } ') ! 
+{ ') @ execute } : )
+anon constant dot-marker
+// m x1 ... xn t m -- (x1 ... xn . t)
+{ swap
+  { -rot 2dup eq? not }
+  { over dot-marker eq? abort"invalid dotted list"
+    swap rot cons } while 2drop
+} : list-tail-until-marker
+// m x1 ... xn m -- (x1 ... xn)
+{ null swap list-tail-until-marker } : list-until-marker
+{ over dot-marker eq? { nip 2dup eq? abort"invalid dotted list" }
+  { null swap } cond
+  list-tail-until-marker
+} : list-until-marker-ext
+{ ') @ ', @ } : ops-get
+{ ', ! ') ! } : ops-set
+{ anon dup ops-get 3 { ops-set list-until-marker-ext } does ') ! 'nop ', !
+} : (
+// test of Lisp-style lists
+// ( 42 ( `+ 9 ( `* 3 4 ) ) "test" ) .l cr
+// ( `eq? ( `* 3 4 ) 3 4 * ) .l cr
+// `alpha ( `beta `gamma `delta ) cons .l cr
+// { ( `eq? ( `* 3 5 pick ) 3 4 roll * ) } : 3*sample
+// 17 3*sample .l cr
+
+// similar syntax _( x1 .. xn ) for tuples
+{ 2 { 1+ 2dup pick eq? } until 3 - nip } : count-to-marker
+{ count-to-marker tuple nip } : tuple-until-marker
+{ anon dup ops-get 3 { ops-set tuple-until-marker } does ') ! 'nop ', ! } : _(
+// test of tuples
+// _( _( 2 "two" ) _( 3 "three" ) _( 4 "four" ) ) .dump cr
+
+// pseudo-Lisp tokenizer
+"()[]'" 34 hold constant lisp-delims
+{ lisp-delims 11 (word) } : lisp-token
+{ null cons `quote swap cons } : do-quote
+{ 1 { ', @ 2 { 2 { ', ! execute ', @ execute } does ', ! }
+      does ', ! } does
+} : postpone-prefix
+{ ', @ 1 { ', ! } does ', ! } : postpone-',
+( `( ' ( pair
+  `) ' ) pair
+  `[ ' _( pair
+  `] ' ) pair
+  `' ' do-quote postpone-prefix pair
+  `. ' dot-marker postpone-prefix pair
+  `" { char " word } pair
+  `;; { 0 word drop postpone-', } pair
+) constant lisp-token-dict
+variable eol
+{ eol @ eol 0! anon dup ') @ 'nop 3
+  { ops-set list-until-marker-ext true eol ! } does ') ! rot ', !
+  { lisp-token dup (number) dup { roll drop } {
+      drop atom dup lisp-token-dict assq { nip second execute } if
+    } cond
+    ', @ execute
+    eol @
+  } until
+  -rot eol ! execute
+} :_ List-generic(
+{ 'nop 'nop List-generic( } :_ LIST(
+// LIST((lambda (x) (+ x 1)) (* 3 4))
+// LIST('(+ 3 4))
+// LIST(2 3 "test" . 9)
+// LIST((process '[plus 3 4]))

crypto/fift/lib/Stack.fif

@@ -0,0 +1,266 @@
+library Stack  // advanced stack manupulation library
+"Lists.fif" include
+// S(a b c - a c 2 a b) would compile to code performing the requested stack manipulation
+
+// interface to low-level stack manipulation primitives
+{ (number) 1- abort"index expected" dup 0 < over 255 > or
+  abort"index 0..255 expected"
+} : (idx)
+// push(n) : a0 .. an - a0 .. an a0  equivalent to "n pick"
+// push(0) = dup, push(1) = over
+{ 0 char ) word (idx) <push> } ::_ push(
+// pop(n) : a0 a1 .. a(n-1) an - an a1 .. a(n-1)
+// pop(0) = drop, pop(1) = nip
+{ 0 char ) word (idx) <pop> } ::_ pop(
+// xchg(i,j) : equivalent to "i j exch2"
+{ 0 char , word (idx) char ) word (idx) <xchg> } ::_ xchg(
+// xchg0(i) : equivalent to "i exch" or "xchg(0,i)"
+// xchg0(1) = swap
+{ 0 char ) word (idx) 0 <xchg> } ::_ xchg0(
+forget (idx)
+
+// parser for stack notation expressions
+")" 34 hold +"  -" constant stk-delims
+anon constant stk-start
+anon constant stk-to
+variable stk-mode
+{ stk-delims 11 (word) } : stk-token
+'nop : mk-lit
+// stk-start vn ... v0 -- stk-start ... v0 i  where v[i]=v0
+{ 0 {
+  1+ 2dup 2+ pick dup stk-start eq? { 2drop drop 0 true } { eqv? } cond
+  } until
+} : stk-lookup
+// stk-start a1 .. an stk-to b1 .. bm -- [a1 .. an] [b1 .. bm]
+{ stk-mode @ 0= abort"identifier expected" } : chk-lit
+{ stk-to list-until-marker stk-mode !
+  stk-start list-until-marker stk-mode @
+  stk-mode 0!
+} : build-stk-effect
+{ stk-start stk-mode 0! {
+  stk-token dup ")" $= { drop true } {
+  dup "-" $= {
+    drop stk-mode @ abort"duplicate -" true stk-mode ! stk-to false } {
+  dup 34 chr $= { chk-lit drop char " word mk-lit false } {
+  dup (number) ?dup { chk-lit 1- { swap mk-lit -rot } if mk-lit nip false } {
+  atom dup `_ eq? { stk-mode @ abort"identifier expected" false } {
+  stk-lookup 0= stk-mode @ = {
+    stk-mode @ { atom>$ +" -?" } { atom>$ +" redefined" } cond abort } {
+  false
+  } cond } cond } cond } cond } cond } cond } until
+  stk-mode @ 0= abort"'-' expected"
+  build-stk-effect
+} :_ parse-stk-list(
+
+// stack operation list construction
+variable op-rlist
+{ op-rlist null! } : clear-op-list
+{ op-rlist @ list-reverse } : get-op-list
+{ op-rlist @ cons op-rlist ! } : issue-op
+{ minmax `xchg -rot triple } : op-xchg
+{ `push swap pair } : op-push
+{ `lit swap pair } : op-lit
+{ `pop swap pair } : op-pop
+0 op-pop constant op-drop
+{ 2dup <> { op-xchg issue-op } if } : issue-xchg
+{ op-push issue-op } : issue-push
+{ op-lit issue-op } : issue-lit
+{ op-pop issue-op } : issue-pop
+{ op-drop issue-op } : issue-drop
+{ ' issue-drop swap times } : issue-drop-#
+
+// emulated stack contents
+variable emul-stk
+{ emul-stk @ count } : emul-depth
+{ emul-depth 1- swap - } : adj-i
+{ emul-depth 1- tuck swap - swap rot - swap } : adj-ij
+// i j --
+{ adj-ij 2dup emul-stk @ tuck swap [] swap rot [] rot // i sj si j
+  emul-stk @ -rot []= swap rot []= emul-stk !
+} : emul-xchg
+{ emul-stk @ tpop drop emul-stk ! } : emul-drop
+// i --
+{ 0 emul-xchg emul-drop } : emul-pop
+// i -- s[i]
+{ emul-stk @ swap [] } : emul-stk[]
+// i -- si
+{ adj-i emul-stk[] } : emul-get
+{ 0 emul-get } : emul-tos
+// v i -- ?   Check whether s[i]=v
+{ dup emul-depth < { emul-stk[] eqv? } { 2drop false } cond } : emul[]-eq?
+// v -- i or -1   Returns maximum i with s[i]=v
+{ emul-stk @ dup count { // v s i
+  ?dup 0= { -1 true } { 1- 2dup [] 3 pick eqv? } cond  // v s i' ?
+  } until nip nip
+} : emul-stk-lookup-rev
+// i --
+{ emul-get emul-stk @ swap , emul-stk ! } : emul-push
+{ emul-stk @ swap , emul-stk ! } : emul-lit
+// show emulated stack contents similarly to .s
+{ emul-stk @ explode dup 1 reverse ' .l swap times cr } : .e
+
+// both issue an operation and emulate it
+{ 2dup issue-xchg emul-xchg } : issue-emul-xchg
+{ dup issue-push emul-push } : issue-emul-push
+{ dup issue-lit emul-lit } : issue-emul-lit
+{ dup issue-pop emul-pop } : issue-emul-pop
+{ issue-drop emul-drop } : issue-emul-drop
+{ ' issue-emul-drop swap times } : issue-emul-drop-#
+
+// b.. s -- b.. s   moves tos value to stk[s]
+{ dup emul-stk[] 2 pick cdr list-member-eqv? {
+  dup adj-i 0 issue-emul-xchg } { dup adj-i issue-emul-pop } cond
+} : move-tos-to
+
+// new s -- ops registered
+{ { over null? not } {
+  // .sl .e get-op-list .l cr 
+  // get-op-list list-length 100 > abort"too long"
+  emul-depth over >
+    { over emul-tos swap list-member-eqv? not } { false } cond {
+  // b.. s  tos unneeded
+  issue-emul-drop } {
+  over car // b.. s b1
+  2dup swap emul[]-eq? { drop swap cdr swap 1+ } {
+  dup emul-stk-lookup-rev // b.. s b1 i
+  dup 0< { // b.. s b1 i  not found, must be a literal
+    drop dup atom? abort"unavailable value"
+    issue-emul-lit } {
+  dup 3 pick < { // b.. s b1 i  found in bottom s stack values
+    nip adj-i issue-emul-push  // b.. s
+    dup emul-depth 1- < { move-tos-to } if
+  } {
+  emul-depth 1- over = { // b.. s b1 i  found in tos
+    2drop move-tos-to
+  } { // b.. s b1 i
+    nip over adj-ij issue-emul-xchg
+  } cond } cond } cond } cond } cond } while
+  nip emul-depth swap - issue-emul-drop-#
+} : generate-reorder-ops
+
+// old new -- op-list
+{ emul-stk @ op-rlist @ 2swap 
+  swap list>tuple emul-stk ! clear-op-list
+  0 generate-reorder-ops get-op-list
+  -rot op-rlist ! emul-stk !
+} : generate-reorder
+{ parse-stk-list( generate-reorder } :_ SG(
+
+// op-list rewriting according to a ruleset 
+// l f l1 l2 -- l' -1 or l f  with l' = l2 + (l - l1)
+{ push(3) rot list- { list+ nip nip true } { drop } cond
+} : try-rule
+// l f ll -- l' -1 or l f
+{ { dup null? not } { uncons 3 -roll unpair try-rule rot } while drop
+} : try-ruleset
+// l ll -- l'
+{ swap { over false swap try-ruleset 0= } until nip
+} : try-ruleset*
+// l ruleset -- l'
+recursive try-ruleset*-everywhere {
+  tuck try-ruleset* dup null? { nip } {
+    uncons rot try-ruleset*-everywhere cons } cond
+} swap !
+LIST(
+ [([xchg 0 1] [xchg 0 2]) ([rot])]
+ [([xchg 0 1] [xchg 1 2]) ([-rot])]
+ [([xchg 0 2] [xchg 1 2]) ([rot])]
+ [([xchg 0 2] [xchg 0 1]) ([-rot])]
+ [([xchg 1 2] [xchg 0 1]) ([rot])]
+ [([xchg 1 2] [xchg 0 2]) ([-rot])]
+ [([xchg 0 1] [rot]) ([xchg 0 2])]
+ [([-rot] [xchg 0 1]) ([xchg 0 2])]
+ [([xchg 0 2] [xchg 1 3]) ([2swap])]
+ [([xchg 1 3] [xchg 0 2]) ([2swap])]
+ [([push 1] [push 1]) ([2dup])]
+ [([push 3] [push 3]) ([2over])]
+ [([pop 0] [pop 0]) ([2drop])]
+ [([pop 1] [pop 0]) ([2drop])]
+ [([xchg 0 1] [push 1]) ([tuck])]
+ [([rot] [-rot]) ()]
+ [([-rot] [rot]) ()]
+) constant fift-stack-ruleset
+{ fift-stack-ruleset try-ruleset*-everywhere } : fift-ops-rewrite
+{ SG( fift-ops-rewrite } :_ SGF(
+
+// helpers for creating Fift source strings for one fift-op
+// i j -- s
+{ minmax over { "xchg(" rot (.) $+ +"," swap (.) $+ +")" }
+  { nip dup 1 = { drop "swap" } { 
+    ?dup { "xchg0(" swap (.) $+ +")" } { "" } cond
+  } cond } cond
+} : source-<xchg>
+// i -- s
+{ dup 1 = { drop "over" } {
+  ?dup { "push(" swap (.) $+ +")" } { "dup" } cond
+  } cond
+} : source-<push>
+// i -- s
+{ dup 1 = { drop "nip" } {
+  ?dup { "pop(" swap (.) $+ +")" } { "drop" } cond
+  } cond
+} : source-<pop>
+// lit -- s
+{ dup string? { char " chr swap $+ char " hold } { (.) } cond
+} : source-<lit> 
+
+// dictionary with all fift op compilation/source creation
+{ 0 swap (compile) } : fop-compile
+( _( `xchg 2 { <xchg> fop-compile } { source-<xchg> swap cons } )
+  _( `push 1 { <push> fop-compile } { source-<push> swap cons } )
+  _( `pop 1 { <pop> fop-compile } { source-<pop> swap cons } )
+  _( `lit 1 { 1 'nop (compile) } { source-<lit> swap cons } )
+  _( `rot 0 { ' rot fop-compile } { "rot" swap cons } )
+  _( `-rot 0 { ' -rot fop-compile } { "-rot" swap cons } )
+  _( `tuck 0 { ' tuck fop-compile } { "tuck" swap cons } )
+  _( `2swap 0 { ' 2swap fop-compile } { "2swap" swap cons } )
+  _( `2drop 0 { ' 2drop fop-compile } { "2drop" swap cons } )
+  _( `2dup 0 { ' 2dup fop-compile } { "2dup" swap cons } )
+  _( `2over 0 { ' 2over fop-compile } { "2over" swap cons } )
+) box constant fift-op-dict
+
+{ dup atom? { atom>$ } { drop "" } cond
+  "unknown operation " swap $+ abort
+} : report-unknown-op
+variable 'fop-entry-exec
+// process fift-op according to 'fop-entry-exec
+// ... op - ...
+{ dup first dup fift-op-dict @ assq { report-unknown-op } ifnot
+  dup second 1+ push(3) count <> abort"incorrect param count"
+  nip swap explode dup roll drop 1- roll // o2 .. on entry
+  'fop-entry-exec @ execute 
+} : process-fift-op
+
+// compile op-list into Fift wordlist
+// wl op-list -- wl'
+{ { third execute } 'fop-entry-exec !
+  swap ' process-fift-op foldl } : compile-fift-op*
+// op-list -- e
+{ fift-ops-rewrite ({) swap compile-fift-op* (}) } : ops>wdef
+
+// S(<orig-stack> - <new-stack>) compiles a "word" performing required action
+{ SG( ops>wdef 0 swap } ::_ S(
+// 1 2 3 S(a b c - c a b a) .s  would print 3 1 2 1
+
+// transform op-list into Fift source
+// ls op -- ls'
+{ fift-ops-rewrite 
+  { 3 [] execute } 'fop-entry-exec !
+  null ' process-fift-op foldl
+  dup null? { drop "" } { { +" " swap $+ } foldr-ne } cond
+} : ops>$
+{ SG( ops>$ 1 'nop } ::_ $S(
+{ SG( ops>$ type } :_ .$S(
+// $S(a b c - b c a c a c) => string "rot 2dup over"
+// S(a b c - b c a c a c) => compile/execute block { rot 2dup over }
+// $S(_ x y _ - y x) => string "drop pop(2)"
+// .$S(x1 x2 - 17 x1) => print string "drop 17 swap"
+
+// simplify/transform sequences of stack manipulation operations
+LIST(. [a b c d e f g h i j]) constant std-stack
+{ stk-start std-stack explode drop stk-to std-stack explode drop
+} : simplify<{
+{ build-stk-effect generate-reorder ops>$ } : }>stack
+// simplify<{ drop drop over over -13 }>stack => string "2drop 2dup -13"
+// simplify<{ 17 rot }>stack => string "swap 17 swap"
+// simplify<{ 5 1 reverse }>stack => string "xchg(1,5) xchg(2,4)"

crypto/fift/lib/TonUtil.fif

@@ -0,0 +1,125 @@
+library TonUtil // TON Blockchain Fift Library
+"Lists.fif" include
+
+-1 constant Masterchain
+0 constant Basechain
+
+// parse workchain id
+// ( S -- workchain )
+{ (number) 1- abort"workchain id must be an integer"
+  dup 32 fits not abort"workchain id must fit in 32 bits"
+} : parse-workchain-id
+
+{ (number) 1- abort"integer expected" } : parse-int
+
+// Private key load/generate
+// ( fname -- pubkey privkey )
+{ dup ."Loading private key from file " type cr 
+  file>B dup Blen 32 <> abort"Private key must be exactly 32 bytes long"
+  dup priv>pub swap 
+} : load-keypair
+// ( fname -- pubkey privkey )
+{ dup file-exists?
+  { load-keypair }
+  { dup newkeypair swap rot over swap B>file
+    rot ."Saved new private key to file " type cr 
+  } cond
+} : load-generate-keypair
+
+// Parse smart-contract address
+// ( S -- workchain addr bounce? )
+{ $>smca not abort"invalid smart-contract address"
+  1 and 0= 
+} : parse-smc-addr
+
+// ( wc addr -- )  Show address in <workchain>:<account> form
+{ swap ._ .":" x. } : .addr
+// ( wc addr flags -- )  Show address in base64url form
+{ smca>$ type } : .Addr
+// ( wc addr fname -- )  Save address to file in 36-byte format
+{ -rot 256 u>B swap 32 i>B B+ swap B>file } : save-address
+// ( wc addr fname -- )  Save address and print message
+{ dup ."(Saving address to file " type .")" cr save-address
+} : save-address-verbose
+
+// ( fname -- wc addr )  Load address from file
+{ file>B 32 B| 
+  dup Blen { 32 B>i@ } { drop Basechain } cond
+  swap 256 B>u@
+} : load-address
+// ( fname -- wc addr )  Load address from file and print message
+{ dup ."(Loading address from file " type .")" cr load-address
+} : load-address-verbose
+// Parse string as address or load address from file (if string is prefixed by @)
+// ( S default-bounce -- workchain addr bounce? )
+{ over $len 0= abort"empty smart-contract address"
+  swap dup 1 $| swap "@" $=
+  { nip load-address rot } { drop nip parse-smc-addr } cond
+} : parse-load-address
+
+// ( hex-str -- addr )  Parses ADNL address
+{ dup $len 64 <> abort"ADNL address must consist of exactly 64 hexadecimal characters"
+  (hex-number) 1 <> abort"ADNL address must consist of 64 hexadecimal characters"
+  dup 256 ufits not abort"invalid ADNL address"
+} : parse-adnl-address
+
+// ( b wc addr -- b' )  Serializes address into Builder b
+{ -rot 8 i, swap 256 u, } : addr, 
+
+// Gram utilities
+1000000000 constant Gram
+{ Gram swap */r } : Gram*/
+{ Gram * } : Gram*
+// ( S -- nanograms )
+{ (number) ?dup 0= abort"not a valid Gram amount"
+1- ' Gram*/ ' Gram* cond
+} : $>GR
+{ bl word $>GR 1 'nop } ::_ GR$
+// ( nanograms -- S )
+{ dup abs <# ' # 9 times char . hold #s rot sign #>
+nip -trailing0 } : (.GR)
+{ (.GR) ."GR$" type space } : .GR
+
+// b x -- b'  ( serializes a Gram amount )
+{ -1 { 1+ 2dup 8 * ufits } until
+  rot over 4 u, -rot 8 * u, } : Gram,
+// s -- x s'  ( deserializes a Gram amount )
+{ 4 u@+ swap 8 * u@+ } : Gram@+
+// s -- x
+{ 4 u@+ swap 8 * u@ } : Gram@
+
+// currency collections
+// b x --> b'  ( serializes a VarUInteger32 )
+{ -1 { 1+ 2dup 8 * ufits } until
+  rot over 5 u, -rot 8 * u, } : VarUInt32,
+// s --> x  ( deserializes a VarUInteger32 )
+{ 5 u@+ swap 8 * u@ } : VarUInt32@
+32 constant cc-key-bits
+' VarUInt32, : val,
+' VarUInt32@ : val@
+// d k v -- d'
+{ <b swap val, b> <s swap rot cc-key-bits idict! not abort"cannot add key-value to CurrencyCollection" } : +ccpair
+dictnew constant cc0   // zero currency collection
+// ( v k -- d )  Creates currency collection representing v units of currency k
+{ cc0 swap rot +ccpair } : of-cc
+{ dictnew { over null? not } { swap uncons -rot unpair +ccpair } while nip } : list>cc
+{ dup null? { ."(null) " drop } { val@ . } cond } dup : .maybeVarUInt32 : .val
+{ cc-key-bits { swap 32 1<< rmod . ."-> " .val ."; " true } dictforeach drop cr } : .cc
+{ cc-key-bits { rot . ."-> " swap .val .val ."; " true } dictdiff drop cr } : show-cc-diff
+{ cc-key-bits { val@ swap val@ + val, true } dictmerge } : cc+
+{ null swap cc-key-bits { val@ pair swap cons true } dictforeach drop } : cc>list-rev
+{ cc>list-rev list-reverse } : cc>list
+forget val,  forget val@  forget .val
+
+// Libraries
+// ( -- D )  New empty library collection
+' dictnew : Libs{
+// ( D -- D )  Return library collection as dictionary
+'nop : }Libs
+// ( D c x -- D' )  Add a public/private library c to collection D
+{ <b swap 1 u, over ref, b> <s swap hash rot 256 udict!+
+  0= abort"duplicate library in collection" } : lib+
+// ( D c -- D' )  Add private library c to collection D
+{ 0 lib+ } : private_lib
+// ( D c -- D' )  Add public library c to collection D
+{ 1 lib+ } : public_lib

crypto/fift/utils.cpp

@@ -0,0 +1,175 @@
+/*
+    This file is part of TON Blockchain Library.
+
+    TON Blockchain Library is free software: you can redistribute it and/or modify
+    it under the terms of the GNU Lesser General Public License as published by
+    the Free Software Foundation, either version 2 of the License, or
+    (at your option) any later version.
+
+    TON Blockchain Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with TON Blockchain Library.  If not, see <http://www.gnu.org/licenses/>.
+
+    Copyright 2017-2019 Telegram Systems LLP
+*/
+#include "utils.h"
+#include "words.h"
+#include "td/utils/PathView.h"
+#include "td/utils/filesystem.h"
+#include "td/utils/port/path.h"
+
+namespace fift {
+namespace {
+
+std::string fift_dir(std::string dir) {
+  return dir.size() > 0 ? dir : td::PathView(td::realpath(__FILE__).move_as_ok()).parent_dir().str() + "lib/";
+}
+td::Result<std::string> load_source(std::string name, std::string dir = "") {
+  return td::read_file_str(fift_dir(dir) + name);
+}
+td::Result<std::string> load_Fift_fif(std::string dir = "") {
+  return load_source("Fift.fif", dir);
+}
+td::Result<std::string> load_Asm_fif(std::string dir = "") {
+  return load_source("Asm.fif", dir);
+}
+td::Result<std::string> load_TonUtil_fif(std::string dir = "") {
+  return load_source("TonUtil.fif", dir);
+}
+td::Result<std::string> load_Lists_fif(std::string dir = "") {
+  return load_source("Lists.fif", dir);
+}
+
+class MemoryFileLoader : public fift::FileLoader {
+ public:
+  td::Result<fift::FileLoader::File> read_file(td::CSlice filename) override {
+    auto it = files_.find(filename);
+    if (it == files_.end()) {
+      return td::Status::Error("File not found");
+    }
+    fift::FileLoader::File res;
+    res.data = it->second;
+    res.path = it->first;
+    return std::move(res);
+  }
+
+  td::Status write_file(td::CSlice filename, td::Slice data) override {
+    files_[filename.str()] = data.str();
+    return td::Status::OK();
+  }
+
+  void add_file(std::string path, std::string data) {
+    files_[path] = std::move(data);
+  }
+  td::Result<File> read_file_part(td::CSlice filename, td::int64 size, td::int64 offset) override {
+    auto it = files_.find(filename);
+    if (it == files_.end()) {
+      return td::Status::Error("File not found");
+    }
+    fift::FileLoader::File res;
+    if (static_cast<td::int64>(it->second.size()) < offset) {
+      return td::Status::Error("Offset too large");
+    }
+    if (size > static_cast<td::int64>(it->second.size())) {
+      size = static_cast<td::int64>(it->second.size());
+    }
+    res.data = td::Slice(it->second).substr(td::narrow_cast<size_t>(offset), td::narrow_cast<size_t>(size)).str();
+    res.path = it->first;
+    return std::move(res);
+  }
+
+  bool is_file_exists(td::CSlice filename) override {
+    return files_.count(filename) != 0;
+  }
+
+ private:
+  std::map<std::string, std::string, std::less<>> files_;
+};
+
+td::Result<fift::SourceLookup> create_source_lookup(std::string main, bool need_preamble = true, bool need_asm = true,
+                                                    bool need_ton_util = true, std::string dir = "") {
+  auto loader = std::make_unique<MemoryFileLoader>();
+  loader->add_file("/main.fif", std::move(main));
+  if (need_preamble) {
+    TRY_RESULT(f, load_Fift_fif(dir));
+    loader->add_file("/Fift.fif", std::move(f));
+  }
+  if (need_asm) {
+    TRY_RESULT(f, load_Asm_fif(dir));
+    loader->add_file("/Asm.fif", std::move(f));
+  }
+  if (need_ton_util) {
+    {
+      TRY_RESULT(f, load_Lists_fif(dir));
+      loader->add_file("/Lists.fif", std::move(f));
+    }
+    {
+      TRY_RESULT(f, load_TonUtil_fif(dir));
+      loader->add_file("/TonUtil.fif", std::move(f));
+    }
+  }
+  auto res = fift::SourceLookup(std::move(loader));
+  res.add_include_path("/");
+  return std::move(res);
+}
+
+td::Result<fift::SourceLookup> run_fift(fift::SourceLookup source_lookup, std::ostream *stream,
+                                        bool preload_fift = true, std::vector<std::string> args = {}) {
+  fift::Fift::Config config;
+  config.source_lookup = std::move(source_lookup);
+  fift::init_words_common(config.dictionary);
+  fift::init_words_vm(config.dictionary);
+  fift::init_words_ton(config.dictionary);
+  config.error_stream = stream;
+  config.output_stream = stream;
+  if (args.size() != 0) {
+    std::vector<const char *> argv;
+    for (auto &arg : args) {
+      argv.push_back(arg.c_str());
+    }
+    fift::import_cmdline_args(config.dictionary, argv[0], td::narrow_cast<int>(argv.size() - 1), argv.data() + 1);
+  }
+  fift::Fift fift{std::move(config)};
+  if (preload_fift) {
+    TRY_STATUS(fift.interpret_file("Fift.fif", ""));
+  }
+  TRY_STATUS(fift.interpret_file("main.fif", ""));
+  return std::move(fift.config().source_lookup);
+}
+}  // namespace
+td::Result<FiftOutput> mem_run_fift(std::string source, std::vector<std::string> args, std::string fift_dir) {
+  std::stringstream ss;
+  TRY_RESULT(source_lookup, create_source_lookup(source, true, true, true, fift_dir));
+  TRY_RESULT_ASSIGN(source_lookup, run_fift(std::move(source_lookup), &ss, true, std::move(args)));
+  FiftOutput res;
+  res.source_lookup = std::move(source_lookup);
+  res.output = ss.str();
+  return std::move(res);
+}
+td::Result<FiftOutput> mem_run_fift(SourceLookup source_lookup, std::vector<std::string> args) {
+  std::stringstream ss;
+  TRY_RESULT_ASSIGN(source_lookup, run_fift(std::move(source_lookup), &ss, true, std::move(args)));
+  FiftOutput res;
+  res.source_lookup = std::move(source_lookup);
+  res.output = ss.str();
+  return std::move(res);
+}
+td::Result<fift::SourceLookup> create_mem_source_lookup(std::string main, std::string fift_dir, bool need_preamble,
+                                                        bool need_asm, bool need_ton_util) {
+  return create_source_lookup(main, need_preamble, need_asm, need_ton_util, fift_dir);
+}
+
+td::Result<td::Ref<vm::Cell>> compile_asm(td::Slice asm_code, std::string fift_dir) {
+  std::stringstream ss;
+  TRY_RESULT(source_lookup,
+             create_source_lookup(PSTRING() << "\"Asm.fif\" include\n<{ " << asm_code << "\n}>c boc>B \"res\" B>file",
+                                  true, true, true, fift_dir));
+  TRY_RESULT(res, run_fift(std::move(source_lookup), &ss));
+  TRY_RESULT(boc, res.read_file("res"));
+  return vm::std_boc_deserialize(std::move(boc.data));
+}
+}  // namespace fift

crypto/fift/utils.h

@@ -0,0 +1,35 @@
+/*
+    This file is part of TON Blockchain Library.
+
+    TON Blockchain Library is free software: you can redistribute it and/or modify
+    it under the terms of the GNU Lesser General Public License as published by
+    the Free Software Foundation, either version 2 of the License, or
+    (at your option) any later version.
+
+    TON Blockchain Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with TON Blockchain Library.  If not, see <http://www.gnu.org/licenses/>.
+
+    Copyright 2017-2019 Telegram Systems LLP
+*/
+#pragma once
+
+#include "Fift.h"
+#include <vector>
+
+namespace fift {
+struct FiftOutput {
+  SourceLookup source_lookup;
+  std::string output;
+};
+td::Result<fift::SourceLookup> create_mem_source_lookup(std::string main, std::string fift_dir = "",
+                                                        bool need_preamble = true, bool need_asm = true,
+                                                        bool need_ton_util = true);
+td::Result<FiftOutput> mem_run_fift(std::string source, std::vector<std::string> args = {}, std::string fift_dir = "");
+td::Result<FiftOutput> mem_run_fift(SourceLookup source_lookup, std::vector<std::string> args);
+td::Result<td::Ref<vm::Cell>> compile_asm(td::Slice asm_code, std::string fift_dir = "");
+}  // namespace fift

crypto/fift/words.h

@@ -0,0 +1,43 @@
+/*
+    This file is part of TON Blockchain Library.
+
+    TON Blockchain Library is free software: you can redistribute it and/or modify
+    it under the terms of the GNU Lesser General Public License as published by
+    the Free Software Foundation, either version 2 of the License, or
+    (at your option) any later version.
+
+    TON Blockchain Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with TON Blockchain Library.  If not, see <http://www.gnu.org/licenses/>.
+
+    Copyright 2017-2019 Telegram Systems LLP
+*/
+#pragma once
+#include "Dictionary.h"
+
+namespace fift {
+
+// thrown by 'quit', 'bye' and 'halt' for exiting to top level
+struct Quit {
+  int res;
+  Quit() : res(0) {
+  }
+  Quit(int _res) : res(_res) {
+  }
+};
+
+struct SkipToEof {};
+
+void init_words_common(Dictionary& dictionary);
+void init_words_vm(Dictionary& dictionary);
+void init_words_ton(Dictionary& dictionary);
+
+void import_cmdline_args(Dictionary& d, std::string arg0, int n, const char* const argv[]);
+
+int funny_interpret_loop(IntCtx& ctx);
+
+}  // namespace fift