#+title: Ferret Programmer's Manual
#+STARTUP: hidestars
#+TAGS: noexport(e)
#+EXPORT_EXCLUDE_TAGS: noexport
#+SETUPFILE: org-mode.conf
#+OPTIONS: H:10 author:nil
* Getting Started
** What Is Ferret
Ferret is a free software lisp implementation designed to be used in
real time embedded control systems. Ferret lisp compiles down to self
contained *C++11*. Generated code is portable between any Operating
System and/or Microcontroller that supports a *C++11* compliant
compiler. It has been verified to run on architectures ranging from
embedded systems with as little as *2KB of RAM* to general purpose
computers running Linux/Mac OS X/Windows.
- General Purpose Computers
- Clang on Mac OS X
- GCC & Clang on Linux
- Microcontrollers
- Arduino
- Uno / Atmega328
- Due / AT91SAM3X8E
- 101 / Intel Curie
- Teensy
- 2.0 / 16 MHz AVR
- 3.2 / Cortex-M4
- 3.6 / Cortex-M4F
- SparkFun SAMD21 Mini / ATSAMD21G18 - ARM Cortex-M0+
- NodeMcu - ESP8266
- [[Hardware / Operating System Support]]
** Features
- Tailored for Real Time Control Applications. (Deterministic Execution.)
- Immutable Data Structures
- Functional
- Macros
- Easy FFI (Inline C,C++. See [[Accessing C,C++ Libraries]])
- Easily Embeddable (i.e Ferret fns are just C++ functors.)
- Memory Pooling (Ability to *run without heap memory*. See [[Memory Management]])
- Destructuring
- Module System
** Download
Ferret is available as prebuilt and source code distributions. See
[[Building From Sources]] for links to source distribution.
#+BEGIN_HTML
#+END_HTML
Platform independent builds (requires JVM),
- [[https://ferret-lang.org/builds/ferret.jar][Standalone Jar]]
- [[https://ferret-lang.org/builds/ferret][Executable]] (Requires Bash)
Supported package managers,
- Debian/Ubuntu
#+begin_src sh :noweb yes :tangle no
echo "deb [trusted=yes]\
https://ferret-lang.org/debian-repo ferret-lisp main" >> /etc/apt/sources.list
apt-get update
apt-get install ferret-lisp
#+end_src
- Clojars - https://clojars.org/ferret
#+begin_src clojure :noweb yes :tangle no
[ferret "<>"]
#+end_src
** A glimpse of Ferret
On any system, we can just compile a program directly into an
executable. Here's a program that sums the first 5 positive numbers.
#+begin_src clojure
;;; lazy-sum.clj
(defn positive-numbers
([]
(positive-numbers 1))
([n]
(cons n (lazy-seq (positive-numbers (inc n))))))
(println (->> (positive-numbers)
(take 5)
(apply +)))
#+end_src
We can compile this program using *ferret*, creating an executable named
*lazy-sum*.
#+BEGIN_EXAMPLE
$ ./ferret -i lazy-sum.clj
$ g++ -std=c++11 -pthread lazy-sum.cpp -o lazy-sum
$ ./lazy-sum
15
#+END_EXAMPLE
Output will be placed in a a file called *lazy-sum.cpp*. When *-c*
flag is used ferret will call *g++* or if set *CXX* environment
variable on the resulting *cpp* file.
#+BEGIN_EXAMPLE
$ ./ferret -i lazy-sum.clj -c
$ ./lazy-sum
15
#+END_EXAMPLE
Following shows a blink example for Arduino. (See section [[Arduino
Boards]] for more info on how to use Ferret lisp on Arduino boards.)
#+begin_src clojure :mkdirp yes :noweb yes :tangle test/arduino/blink/blink.clj
;;; blink.clj
(require '[ferret.arduino :as gpio])
(gpio/pin-mode 13 :output)
(forever
(gpio/digital-write 13 1)
(sleep 500)
(gpio/digital-write 13 0)
(sleep 500))
#+end_src
#+BEGIN_EXAMPLE
$ ./ferret -i blink.clj -o blink/blink.ino
#+END_EXAMPLE
Then upload as usual. Following is another example, showing the usage
of [[Memory Management][Memory Pooling]]. Program will blink two LEDs simultaneously at
different frequencies (Yellow LED at 5 hz Blue LED at 20 hz). It uses
a memory pool of 512 bytes allocated at compile time instead of
calling malloc/free at runtime.
#+begin_src clojure :mkdirp yes :noweb yes :tangle test/arduino/blink-multi/blink-multi.clj
(configure-runtime! FERRET_MEMORY_POOL_SIZE 512
FERRET_MEMORY_POOL_PAGE_TYPE byte)
(require '[ferret.arduino :as gpio])
(def yellow-led 13)
(def blue-led 12)
(gpio/pin-mode yellow-led :output)
(gpio/pin-mode blue-led :output)
(defn make-led-toggler [pin]
(fn []
(->> (gpio/digital-read pin)
(bit-xor 1)
(gpio/digital-write pin))))
(def job-one
(fn-throttler (make-led-toggler yellow-led) 5 :second :non-blocking))
(def job-two
(fn-throttler (make-led-toggler blue-led) 20 :second :non-blocking))
(forever
(job-one)
(job-two))
#+end_src
#+BEGIN_EXAMPLE
$ ./ferret -i ferret-multi-led.clj -o ferret-multi-led/ferret-multi-led.ino
#+END_EXAMPLE
* Overview
Ferret is a functional, lazy language designed to be used in real time
embedded control systems. It is heavily inspired by Clojure both
syntactically and semantically. Functions / Macros that are present
in both Ferret and Clojure should mimic their Clojure counter
parts. If they don't it is considered a bug. (or not possible to
implement with the current implementation.)
This document is not intended to be a full lisp tutorial. It is a
specification of the subset of lisp implemented by Ferret, and the
particular workings of the [[*Runtime][Runtime]] and [[*Core][Core]] library. Any getting
started guide for Clojure should get you upto speed on Ferret.
** Documentation Structure
This is a literate program, inspired by Donald Knuth (Knuth, Donald
“Literate Programming (1984)” Literate Programming CSLI, p99). It is
intended to be read like a novel from cover to cover. The ideas are
expressed clearly but they are grounded in the actual source code.
The compiler and the C++ runtime needed is split into three sections.
- [[*Compiler][Compiler]]
- [[*Runtime][Runtime]]
- [[*Core][Core]]
[[*Compiler][Compiler]] section contains the actual compiler written in Clojure. It
takes the Ferret code and converts it to a Intermediate
representation by taking the Ferret form and running it [[Compilation][through some
transformations]]. This IR is then run through [[Code Generation]] module to
create C++ code. [[*Runtime][Runtime]] contains the C++ runtime needed to support
Ferret such as [[Object System]], [[Memory Pool][Memory Pooling]], [[Reference Counting][Garbage Collection]]. It
is written in a mixture of C++ and Ferret DSL. [[*Core][Core]] is the standard
library of Ferret, provides a ton of general-purpose functionality for
writing robust, maintainable embedded applications.
** Hardware / Operating System Support
Ferret does not depend on any external dependencies (Including the C++
Standard Library). Unit tests are run on Mac OS X and Linux, any
operating system with a C++11 compiler is supported. When running on a
microcontroller ferret will check if it is a supported platform during
compile time and enable hardware specific features. (Currently only
UART is hardware specific.) If running on an unknown hardware it
will run in *safe mode* (UART disabled.). Everything else is supported
in safe mode. Like operating system support any embedded system with a
C++11 compiler is supported. See [[What Is Ferret]] for a list of
currently supported microcontrollers.
*** Arduino Boards
Ferret standard library has built in support for Arduino library. *Any
board* that Arduino IDE supports should work with Ferret lisp.
*Post Arduino 1.5.0*, Ferret compiler can upload directly to a Arduino
board by adding the following build command to the top of the file,
#+begin_src clojure
(configure-ferret! :command "~/apps/arduino-1.8.0/arduino \\
--board arduino:sam:arduino_due_x_dbg \\
--port /dev/ttyACM0 \\
--upload ./blink.cpp")
#+end_src
When *-c* option is passed Ferret will execute the above command and
upload the solution to the board. (See [[https://github.com/arduino/Arduino/blob/master/build/shared/manpage.adoc][ARDUINO(1) Manual Page]] for
details.)
#+BEGIN_EXAMPLE
$ ./ferret -i blink.clj -c
#+END_EXAMPLE
Sample Makefile for automating compilation and upload on an Arduino,
#+begin_src makefile
FERRET = ferret
INPUT = core.clj
OUTPUT = core.ino
ARDUINO = ~/arduino-1.8.5/arduino
BOARD = arduino:sam:arduino_due_x_dbg
PORT = /dev/ttyACM0
RM = rm -f
.PHONY: verify upload clean
default: verify
core: core.clj
$(FERRET) -o $(OUTPUT)
verify: core
$(ARDUINO) --board $(BOARD) --verify $(OUTPUT)
upload: core
$(ARDUINO) --board $(BOARD) --port $(PORT) --upload $(OUTPUT)
clean:
$(RM) $(OUTPUT)
#+end_src
*Pre Arduino 1.5.0*, recommended way is to go to preferences and set
Arduino IDE to use an External Editor. This way when Ferret recompiles
the sketch changes will be automatically picked up by the IDE ready to
be uploaded. To automatically rename the *cpp* file to *ino* or *pde*
use the following option,
#+begin_src clojure
(configure-ferret! :command "mv blink.cpp blink.ino")
#+end_src
Then compile with,
#+BEGIN_EXAMPLE
$ ./ferret -i blink.clj -c
#+END_EXAMPLE
Result will be *blink.ino* ready to be uploaded. Any changes to the
*clj* file should be picked up by the IDE.
*** Yocto
Install [[https://wiki.yoctoproject.org/wiki/Building_your_own_recipes_from_first_principles][Yocto]] and create a package for your application. A sample
recipe for a simple Ferret application is given below.
#+BEGIN_EXAMPLE
recipes-example/
└── core
├── core-0.1
│ └── core.clj
└── core_0.1.bb
#+END_EXAMPLE
#+begin_src clojure
;; core.clj
(println "Hello World!")
#+end_src
#+begin_src fundamental
# core_0.1.bb
SUMMARY = "Simple Ferret application"
SECTION = "examples"
LICENSE = "MIT"
LIC_FILES_CHKSUM = "file://${COMMON_LICENSE_DIR}/MIT;md5=0835ade698e0bcf8506ecda2f7b4f302"
SRC_URI = "file://core.cpp"
S = "${WORKDIR}"
do_compile() {
ferret -i ./core.clj
${CXX} -std=c++11 core.cpp -o core
}
do_install() {
install -d ${D}${bindir}
install -m 0755 core ${D}${bindir}
}
#+end_src
Finally add the application to your =layer.conf=.
#+BEGIN_EXAMPLE
IMAGE_INSTALL_append = " core"
#+END_EXAMPLE
*** Raspberry Pi
Clone required layers,
#+BEGIN_EXAMPLE
git clone -b jethro git://git.yoctoproject.org/meta-raspberrypi
#+END_EXAMPLE
Add =meta-raspberrypi= to =BBLAYERS= in =build/conf/bblayers.conf=,
and and Select your machine type in =build/conf/local.conf=. See
[[http://meta-raspberrypi.readthedocs.io/en/latest/layer-contents.html#supported-machines][Supported Machines]] for =MACHINE= type. Build the image,
#+BEGIN_EXAMPLE
bitbake rpi-basic-image
#+END_EXAMPLE
Write the image,
#+BEGIN_EXAMPLE
dd if=tmp/deploy/images/raspberrypi2/rpi-basic-image-raspberrypi2.rpi-sdimg of=/dev/mmcblk0
#+END_EXAMPLE
** Support
- [[https://groups.google.com/forum/#!forum/ferret-lang][ferret-lang]] - Mailing List
** Further Reading
*** Articles
- [[https://nakkaya.com/2017/06/24/ferret-lisp-ffi-notes/][Ferret Lisp FFI Notes]]
- [[https://news.ycombinator.com/item?id=14951116][Hacker News Thread]] (2017)
- [[https://news.ycombinator.com/item?id=17644580][Hacker News Thread]] (2018)
*** Projects
- [[https://nakkaya.com/2017/02/15/bare-metal-lisp-rc-control-using-ferret/][Bare Metal Lisp - RC Control using Ferret]]
- [[http://nakkaya.com/2016/06/10/ferret-a-hard-real-time-clojure-for-lisp-machines/][Ferret - A Hard Real-Time Clojure for Lisp Machines]] -
Implementation of a line following robot in Ferret.
** Building From Sources
All source code for the project is kept in a single =org-mode= file
named =ferret.org=. =emacs= is used to extract the sources and
documentation.
#+BEGIN_HTML
#+END_HTML
The latest sources are available at,
- [[https://github.com/nakkaya/ferret][Github]]
Dependencies,
- make
- Java
- Emacs (>= 24.5)
- Leiningen
Assuming all of the above is in your path just run,
#+BEGIN_EXAMPLE
make
#+END_EXAMPLE
This will extract the source from =ferret.org= file to current directory and
build the =jar= and =executable= distributions to =bin/=
directory. =Makefile= assumes it is running on a =*NIX= based system
if not, open =ferret.org= file using =emacs= and run,
#+BEGIN_EXAMPLE
M-x org-babel-tangle
#+END_EXAMPLE
that will extract the source code then you can threat it as any other
Clojure/Lein project. Documentation can be built using,
#+BEGIN_EXAMPLE
make docs
#+END_EXAMPLE
Unit tests can be run using,
#+BEGIN_EXAMPLE
make test
#+END_EXAMPLE
A release can be made by running,
#+BEGIN_EXAMPLE
make docker-release
#+END_EXAMPLE
This will compile =ferret= run unit tests against all supported
compilers/frameworks and generate a =release/= folder containing
deployment files.
** License
BSD 2-Clause License
Copyright (c) 2019, Nurullah Akkaya
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
- Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
- Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
* Compiler
Ferret has a similar architecture to other modern compilers,
#+CAPTION: Ferret Compiler Architecture
#+NAME: fig:compiler_architecture
[[./ferret-styles/graphs/compiler_arch.png]]
First, an input file containing Ferret code is loaded from the
command line. From there a series of source-to-source transformations
are performed on the AST to expand macros, perform optimizations, and
make the code easier to compile to C++. (Optionally these intermediate
representations (IR) can be printed out in a readable format to aid
debugging.) The final AST is then output as a .cpp file and the C++
compiler is invoked to create the final executable or object file.
** Compilation
Ferret (or any other Lisp) has features not provided by C++ such as
automatic memory management i.e. garbage collection (GC), closures
etc. Source-to-source transformations are used to add constructs
required by C++, restructure Ferret forms in preparation to generate
C++ code. Final intermediate representation can be directly compiled
to C++. Any Ferret form go through nine transformations before they
are passed to the code generation phase. Each transformation makes a
separate pass over the form, this makes the compiler easier to
maintain.
#+begin_src clojure :tangle no :noweb-ref core-compiler-emitter
(defn compile [form options]
(->> (ferret-runtime options form)
(remove-assertions options)
(expand-macros)
(let->fn)
(do->fn)
(fn->lift)
(fn->inline options)
(escape-analysis)
(symbol-conversion)))
#+end_src
*** Modules
Supported =require= forms for importing modules,
#+BEGIN_SRC clojure :tangle no
(require 'package.io)
(require '[package.io :as io])
(require '[package.io :as io]
'[package.udp :as udp])
#+END_SRC
Helper functions or variables in modules that should not be exposed
outside the namespace can be defined using the following form,
#+BEGIN_SRC clojure :tangle no
(def ^{:private true} helper-var :value)
(defn ^{:private true} helper-fn [] 42)
#+END_SRC
If a file named =deps.clj= is found on the same path as the input
file. Modules listed in it can be downloaded using =--deps= CLI
argument.
#+BEGIN_SRC clojure :tangle no
;;deps.clj
(git :url "https://github.com/nakkaya/ferret-opencv.git")
(git :url "https://github.com/nakkaya/ferret-mosquitto.git"
:commit "8c8c0890194a0b98130a3d4d78b71c99b833b12a")
#+END_SRC
#+begin_src clojure :tangle no :noweb-ref core-compiler-checkout-deps
(defn checkout-deps [path]
(when (io/file-exists (str path "/deps.clj"))
(let [deps (-> (read-clojure-file "deps.clj")
(parser/peek (parser/form? 'git)))
deps (map (fn [[_ & kvs]] (apply hash-map kvs)) deps)]
(doseq [{url :url commit :commit} deps]
(let [folder (str path (jgit-util/name-from-uri url))]
(info "dep =>" url)
(when (io/file-exists folder)
(org.apache.commons.io.FileUtils/deleteDirectory
(java.io.File. folder)))
(let [repo (jgit/git-clone-full
url (org.apache.commons.io.FilenameUtils/normalize folder))]
(jgit/git-checkout (:repo repo)
(if commit
commit
"master"))))))))
#+end_src
Compiler will look for a file under current working directory called,
=package/io.clj= all expression in the that file will be added to the
front of the current form with symbols renamed from =some-fn= to
=io/some-function=.
#+begin_src clojure :tangle no :noweb-ref core-compiler-transformations
(defn import-modules-select-require [form]
(let [norm-require (fn [f]
(if (symbol? f)
[f :as f]
f))]
(->> (parser/peek form (parser/form? 'require))
(reduce (fn[h v]
(if (= 2 (count v))
;; require single module
(conj h (norm-require (->> v last last)))
;; require multiple modules
(concat h (map #(norm-require (last %)) (rest v))))) [])
(map (fn [[mod _ as]] [mod as]))
(reduce (fn[h [mod as]]
(if (h mod)
(assoc h mod (conj (h mod) as))
(assoc h mod [as]))) {}))))
#+end_src
Extract the list of packages and aliases from the form. Returns a map
of =mod / aliases= pairs.
#+begin_src clojure :tangle no :noweb-ref core-compiler-transformations
(defn import-modules-load-modules [package-list options]
(->> package-list
(reduce (fn[h [m aliases]]
(let [file-name (str (.replace (str m) "." "/") ".clj")
mod (-> (if (clojure.java.io/resource file-name)
file-name
(str (:path options) file-name))
(read-clojure-file)
(parser/drop (parser/form? 'configure-runtime!))
(parser/drop (parser/form? 'configure-ferret!)))
macro-symbols (->> (parser/peek mod (parser/form? 'defmacro))
(map second)
(into #{}))
def-symbols (->> (parser/peek (expand-macros mod) (parser/form? 'def))
(map second)
(into #{}))
replace? (set/union macro-symbols def-symbols)
mod (parser/transform
mod
#(and (symbol? %)
(replace? %))
#(parser/new-symbol m "_" %))]
(reduce (fn [h v] (conj h v)) h mod)))
[])
lazy-seq))
#+end_src
Loads all modules listed in the package list. When a module is loaded
all its symbols are replaced with its module name except =core=
functions. Module names acts as namespaces. Returns a form that the is
concatenation of all modules listed in form.
#+begin_src clojure :tangle no :noweb-ref core-compiler-transformations
(defn import-modules-convert-alias-to-module [package-list form]
(let [alias-to-mod (reduce (fn[h [mod aliases]]
(reduce (fn[h v] (assoc h v mod)) h aliases))
{} package-list)]
(parser/transform form symbol?
(fn [f]
(if-let [[_ alias fn] (re-find #"(.*?)/(.*)" (str f))]
(if-let [mod-sym (alias-to-mod (symbol alias))]
(parser/new-symbol mod-sym "_" fn)
f)
f)))))
#+end_src
Convert all aliased symbols in the form to their fully qualified
modules names. So =helper-a= defined in module =util.db= becomes
=util_db_helper-a=.
#+begin_src clojure :tangle no :noweb-ref core-compiler-transformations
(defn import-modules [form options]
(let [package-list (import-modules-select-require form)
form (parser/drop form (parser/form? 'require))
modules (import-modules-load-modules package-list options)
non-public? (->> modules
(reduce (fn[private-symbols mod]
(-> mod
(parser/peek #(and (symbol? %)
(-> % meta :private)))
(concat private-symbols))) [])
(into #{}))
form (import-modules-convert-alias-to-module package-list form)
violations (parser/peek form #(non-public? %) #(zip/node (zip/up %)))]
(when (not (empty? violations))
(doseq [v violations]
(warn "non-public-access =>" v))
(io/exit-failure))
(shake-concat modules form)))
(defn import-modules-all [form options]
(loop [f form]
(let [expanded (import-modules f options)]
(if (= f expanded)
expanded
(recur expanded)))))
#+end_src
Generates the required runtime for the form by importing the required
modules and concatenate the required runtime from [[*Core][Core]].
#+begin_src clojure :tangle no :noweb-ref core-compiler-transformations
(defn ferret-runtime [options form]
(->> (-> form
(import-modules-all options)
(expand-reader-macros))
(shake-concat (read-clojure-file "ferret/core.clj"))
;; tag form with the build info
(cons `(~'native-define ~(try
(let [version (io/read-file-from-url "build.info")]
(str "// ferret-lisp " version))
(catch Exception e
(str "// ferret-lisp")))))))
#+end_src
*** Macros
Process some supported reader macros, =@= and =#(some-fn)= and convert
=map= reader forms to Ferret =d-list=. Maps are zero or more
key/value pairs enclosed in braces: ={:a 1 :b 2}=.
#+begin_src clojure :tangle no :noweb-ref core-compiler-macro-expansion
(defn expand-reader-macros [form]
(-> form
(parser/transform
(parser/form? 'clojure.core/deref)
(fn [f] (cons 'deref (rest f))))
(parser/transform
map?
(fn [x]
(->> (seq x)
(reduce
(fn[h [k v]]
(conj h k v)) [])
(seq)
(cons 'fir-new-map))))))
#+end_src
Prepare form =f= for macro expansion,
#+begin_src clojure :tangle no :noweb-ref core-compiler-macro-expansion
(defn macro-normalize [f]
(parser/transform f
(parser/form? 'let)
(fn [[_ bindings & body]]
`(~'let* ~(apply list bindings) ~@body))))
#+end_src
Macro expansion is done by reading all the macros present in
=src/lib/ferret/core.clj= and combining them with user defined macros. They
are evaluated in a temporary namespace, using =parser/transform= we iterate
all the macros used in the code that we are compiling and expand them
in the temporary namespace then the node is replaced with its expanded
form.
#+begin_src clojure :tangle no :noweb-ref core-compiler-macro-expansion
(defn expand-macros-single [form]
(let [core-macros (->> (read-clojure-file "ferret/core.clj")
(filter (parser/form? 'defmacro)))
core-macro-symbols (into #{} (map second core-macros))
form-macros (->> (filter (parser/form? 'defmacro) form)
(filter (fn [[_ name]]
(not (core-macro-symbols name)))))
form-macro-symbols (map second form-macros)
form (parser/drop form (parser/form? 'defmacro))
temp-ns (gensym)
macro-symbols (concat core-macro-symbols form-macro-symbols)]
(create-ns temp-ns)
(binding [*ns* (the-ns temp-ns)]
(refer 'clojure.core :exclude (concat macro-symbols ['fn 'def]))
(use '[compiler.io :only [exit-failure]])
(use '[compiler.core :only [symbol-conversion]])
(use '[compiler.parser :only [new-fir-fn]])
(doseq [m (concat core-macros form-macros)]
(eval m)))
(let [form (-> form
(macro-normalize)
(expand-reader-macros)
(parser/transform
(fn [f]
(some true? (map #(parser/form? % f) macro-symbols)))
(fn [f]
(binding [*ns* (the-ns temp-ns)]
(-> (walk/macroexpand-all f)
;;strip ns from symbols
(parser/transform symbol? #(-> % name symbol)))))))]
(remove-ns temp-ns)
form)))
(defn expand-macros-aux [form]
(loop [f form]
(let [expanded (expand-macros-single f)]
(if (= f expanded)
expanded
(recur expanded)))))
(def expand-macros (memoize expand-macros-aux))
#+end_src
*** let->fn
=let= forms are transformed into nested functions which are then
called immediately, bindings are setup in the outer function,
expressions are placed in the inner function which takes the bindings
as arguments.
So following form,
#+begin_src clojure :tangle no
(let->fn '(let* [a 1
b 2]
(+ a b)))
#+end_src
after transformation becomes,
#+begin_src clojure :tangle no
((fn* [a__1548] ((fn* [b__1549] (+ a__1548 b__1549)) 2)) 1)
#+end_src
#+begin_src clojure :tangle no :noweb-ref ferret-unit-tests
(deftest let-test
(let [args (list "1" "2")]
(is (= args (rest *command-line-args*))))
(let [a 1]
(is (= 1 a)))
(let [a 1
a 3]
(is (= 3 a)))
(let [a 1
b 2]
(is (= 3 (+ a b))))
(let [a 1
b 2
c 3]
(is (= 6 (+ a b c))))
(let [a 1
b 2]
(let []
(is (= 3 (+ a b)))))
(let [x 42]
(defn let-over-lambda [] x))
(is (= 42 (let-over-lambda))))
#+end_src
#+begin_src clojure :tangle no :noweb-ref core-compiler-transformations
(defn let-closure [bindings body]
(if (empty? bindings)
`((~'fir-let-fn () ~@body))
(apply
(fn close [[arg val] & more]
(if (empty? more)
`((~'fir-let-fn [~arg] ~@body) ~val)
`((~'fir-let-fn [~arg] ~(apply close more)) ~val)))
(partition 2 bindings))))
(defn let-assert [bindings body]
(when (odd? (count bindings))
(warn
(str "let requires an even number of forms in binding vector => " bindings))
(io/exit-failure)))
(defn let->fn [form]
(-> form
(parser/transform (parser/form? 'let*)
(fn [[_ bindings & body]]
(let-assert bindings body)
(let-closure bindings body)))
(parser/transform (parser/form? 'fir-let-fn)
(fn [[_ args & body]]
(parser/new-fir-fn :args args :body body)))))
#+end_src
*** do->fn
A similar method is used for the do form, expressions are wrapped in a fn
that takes no parameters and executed in place.
#+begin_src clojure :tangle no
(do->fn '(do (+ 1 1)))
#+end_src
#+begin_src clojure :tangle no
((fn [] (+ 1 1)))
#+end_src
#+begin_src clojure :tangle no :noweb-ref core-compiler-transformations
(defn do->fn [form]
(parser/transform form
(parser/form? 'do)
(fn [f] `(~(parser/new-fir-fn :body (rest f))))))
#+end_src
*** fn->lift
=fn->lift= handles the problem of free variables. Free
variables passed to a nested function must be captured in a closure so
they can be referenced at runtime. The closure conversion
transformation modifies function definitions as necessary to create new
closures.
#+begin_src clojure :tangle no :noweb-ref ferret-unit-tests
(defn make-adder [x]
(fn [n] (+ x n)))
(def adder
(make-adder 1))
(def fibo
(fn [n]
(if (< n 2)
1
(+ (fibo (- n 1))
(fibo (- n 2))))))
(deftest fn->list-test
(is (= 10 (adder 9)))
(is (= 89 (fibo 10))))
#+end_src
in the above snippet =x= is a free variable, when the function
=make-adder= returns, it needs to have a way of referencing that
variable when it is used. The way Ferret handles this is that, every
function will pass its arguments to inner functions (if any) it
contains.
#+begin_src clojure :tangle no
(fn->lift '(fn* [x]
(fn* [n] (+ x n))))
#+end_src
Above form will be converted to,
#+begin_src clojure :tangle no
(fir-defn-heap G__1333 (x) (n) (+ x n))
(fir-defn-heap G__1334 () (x) (fir-fn-heap G__1333 x))
(fir-fn-heap G__1334)
#+end_src
What this means is, define a functor named =G__3154= that holds a
reference to =x=, and another functor =G__1334= that has no
state. When we create an instance of =G__1333= we pass =x= to its
constructor. Since every thing is already converted to fns this
mechanism allows variables to be referenced down the line and solves
the free variable problem.
#+begin_src clojure :tangle no :noweb-ref core-compiler-transformations
(defn fn-defined? [fns env args body]
(if-let [fn-name (@fns (concat [env args] body))]
(apply list 'fir-fn-heap fn-name env)))
(defn define-fn [fns env name args body]
(let [n (if name
name
(gensym "FN__"))]
(swap! fns assoc (concat [env args] body) n)
(apply list 'fir-fn-heap n env)))
(defn fn->lift
([form]
(let [fns (atom (ordered-map/ordered-map))
form (fn->lift form fns)
fns (map (fn [[body name]] (concat ['fir-defn-heap name] body)) @fns)]
(concat fns form)))
([form fns & [env]]
(parser/transform
form
(parser/form? 'fn*)
(fn [sig]
(let [[name args body] (parser/split-fn sig)
;; transform named recursion in body
body (if name
(parser/transform
body
(parser/form? name)
(fn [[_ & args]]
(cons
(apply list 'fir-fn-heap name env)
args)))
body)
body (fn->lift body fns (concat args env))
symbols (parser/symbol-set body)
env (->> (set/intersection
symbols
(into #{} (flatten env)))
(into ()))
args (if (parser/ffi-fn?
(filter #(not (parser/form? 'native-declare %)) body))
args
(parser/transform args
symbol?
(fn [v]
(if (or (not (parser/fn-arg-symbol? v))
(symbols v))
v '_))))]
(if-let [n (fn-defined? fns env args body)]
n
(define-fn fns env name args body)))))))
#+end_src
#+begin_src clojure :tangle no :noweb-ref clojure-unit-tests
(deftest test-fn->lift
(let [prg-a (compile '((defn one-plus-one []
(+ 1 1))
(while true
(+ 1 1))) {})
prg-b (fn->lift
'(fn* outer [a]
(fn* inner-a [b]
(+ a b))
(fn* inner-b [c] c)))
prg-c (fn->lift
'((fn* inner-a [a]
((fn* inner-b [b]
((fn* inner-c [c] (+ b c))
3))
2))
1))
prg-d (fn->lift
'((fn* inner-a [a]
((fn* inner-b [b]
((fn* inner-c [c] (+ b))
3))
2))
1))]
;;while shoud use one-plus-one in its body
;;check fn-defined?
(is (= 2 (count (parser/peek prg-a (fn [f] (= 'one_plus_one f))))))
(is (= 1 (->> (fn [f] (= '(fir-defn-heap inner-a (a) [b] (+ a b)) f))
(parser/peek prg-b)
count)))
(is (= 1 (->> (fn [f] (= '(fir-defn-heap inner-b () [c] c) f))
(parser/peek prg-b)
count)))
(is (= 1 (->> (fn [f] (= '(fir-defn-heap inner-c (b) [c] (+ b c)) f))
(parser/peek prg-c)
count)))
(is (= 1 (->> (fn [f] (= '(fir-defn-heap inner-c (b) [_] (+ b)) f))
(parser/peek prg-d)
count)))))
#+end_src
*** Symbol Conversion
Some symbols valid in lisp are not valid C++ identifiers. This
transformation converts all symbols that are not legal C++ identifiers
into legal ones.
#+begin_src clojure :tangle no :noweb-ref core-compiler-transformations
(defn escape-cpp-symbol [s]
(clojure.string/escape
(str s)
{\- \_ \* "_star_" \+ "_plus_" \/ "_slash_"
\< "_lt_" \> "_gt_" \= "_eq_" \? "_QMARK_"
\! "_BANG_" \# "_"}))
(defn symbol-conversion [form]
(let [c (comp #(symbol (escape-cpp-symbol %))
#(cond (= 'not %) '_not_
:default %))]
(parser/transform form symbol? c)))
#+end_src
*** Remove Assertions
#+begin_src clojure :tangle no :noweb-ref core-compiler-transformations
(defn remove-assertions [options form]
(if (:release options)
(do (info "option => release mode")
(parser/drop form (parser/form? 'assert)))
form))
#+end_src
*** Optimizations
**** Inline Functions
This optimization trades memory for performance. When a global
variable pointing to a function is defined, memory for that function
is allocated at the start of the program and never released until
program exits even if the said function is called only once in the
program. In order to keep the memory usage low Ferret will replace all
functions calls with new function objects. So every time a function is
called a new function object is created used and released. If
performance is more important than memory usage this optimization can
be disabled using compiler option =--global-functions=. This
optimization can be turned of on a per =def= basis by setting the
metadata of the object to =^volatile= =true=,
#+BEGIN_SRC clojure :tangle no
(defn ^volatile no-inline [] 42)
#+END_SRC
#+begin_src clojure :tangle no :noweb-ref core-compiler-transformations
(defn inline-defn? [f]
(and (parser/form? 'def f)
(-> f second meta :tag (not= 'volatile))
(parser/form? 'fir-fn-heap
(->> f (drop 2) first))))
(defn fn->inline [options form]
(if (:global-functions options)
form
(let [defns (->> (parser/peek form inline-defn?)
(filter #(= 2 (-> % last count))))
fn-table (map (fn [[_ name [_ gensym]]] [name gensym]) defns)
impl-table (apply hash-map (flatten fn-table))
defn? (fn [f]
(and (inline-defn? f)
(impl-table (second f))))
invoke #(if-let [imp (impl-table %)]
(list 'fir-fn-heap imp)
%)
no-defn (reduce (fn[h v] (parser/drop h defn?)) form defns)
inlined (reduce (fn[h [name gensym]]
(parser/transform h
#(or (parser/form? name %)
(parser/form? 'def %))
(fn [f] (map invoke f))))
no-defn fn-table)]
(reduce (fn[h [name gensym]]
(parser/transform h #(and (symbol? %)
(= % gensym))
(fn [_] (identity name))))
inlined fn-table))))
#+end_src
#+begin_src clojure :tangle no :noweb-ref clojure-unit-tests
(deftest test-fn->inline
(let [prg-a (compile '((defn fn-inline [x] x)
(defn ^volatile fn-no-inline [y] y)
(fn-inline 42)
(fn-no-inline 42)) {})]
(is (= 1 (->> (fn [f] (= '(fn_no_inline 42) f))
(parser/peek prg-a)
count)))
(is (= 1 (->> (fn [f] (= '((fir_fn_stack fn_inline) 42) f))
(parser/peek prg-a)
count)))))
#+end_src
**** Tree Shaking
Concats two forms. Shakes the first form by removing any symbols not
present in second form.
In order to keep the generated C++ code compact only the functions used
will be present in the generated source file. Which means if you don't
use =println= anywhere in the code it won't be defined in the final
C++ file, but if you use it, it and everything it uses will be
defined, in the case of =println= it will pull =apply=, =print= and
=newline= with it.
#+begin_src clojure :noweb-ref core-compiler-tree-shaking
(defn shake-concat
([header form]
(let [shakeable? (fn [f]
(or (parser/form? 'defn f)
(parser/form? 'defnative f)))
header-symbols (->> (parser/peek header seq?)
(parser/symbol-set))
header-fns (->> (parser/peek header shakeable?)
(map #(vector (second %) %))
(into {}))
header-non-shakeable (parser/drop header shakeable?)
form-expanded (expand-macros (concat header-non-shakeable form))
fns (atom #{})
_ (shake-concat form-expanded header-fns fns header-non-shakeable)
header-shaked (parser/drop header (fn [f]
(and (shakeable? f)
(not (@fns (second f))))))]
(concat header-shaked form)))
([form built-in fns non-shakeable]
(parser/transform form symbol?
#(do
(if-let [f (built-in %)]
(when (not (@fns %))
(swap! fns conj %)
(shake-concat (expand-macros (concat non-shakeable f))
built-in fns non-shakeable))) %))))
#+end_src
#+begin_src clojure :tangle no :noweb-ref clojure-unit-tests
(deftest three-shaking
(is (= '((defn c [] 1)
(defn b [] (c))
(defn a [] (b))
(a))
(shake-concat '((defn no-call-a [])
(defnative no-call-b [] (on "" ""))
(defn c [] 1)
(defn b [] (c))
(defn a [] (b)))
'((a)))))
(is (= '((defn y [])
(let [a 1]
(defn b []))
(println (b) (y)))
(shake-concat '((defn x [] )
(defn y [] )
(let [a 1]
(defn b [] )
(defn c [] a)))
'((println (b) (y))))))
(is (= '((defn p-create []) (defn p-update []))
(take 2 (shake-concat '((defn p-create [])
(defn p-update [])
(defmacro pc [& options]
`(let [controller# (p-create)]
(fn [input#] (p-update)))))
'((pc))))))
(is (= '(defn new-lazy-seq [f] )
(first (shake-concat '((defn new-lazy-seq [f] )
(defmacro lazy-seq [& body]
`(new-lazy-seq (fn [] ~@body)))
(defn range
([high]
(range 0 high))
([low high]
(if (< low high)
(cons low (lazy-seq
(range (inc low) high)))))))
'((range 10)))))))
#+end_src
**** Escape Analysis
Determines that a certain allocation never escapes the local
function. This means that allocation can be done on the stack.
#+begin_src clojure :noweb-ref core-compiler-transformations
(defn escape-analysis [form]
(->> form
(escape-fn-calls)
(escape-fn-inheritance)))
#+end_src
#+begin_src clojure :tangle no :noweb-ref clojure-unit-tests
(deftest test-escape-analysis
(let [prg-a (compile '((defn self [x] x)
(self 42)) {})
prg-b (compile '((defn self [x] x)
(self self)) {})
prg-c (compile '((defn multi ([x] x))) {})]
(is (not (empty? (parser/peek prg-a (parser/form? 'fir_defn_stack)))))
(is (not (empty? (parser/peek
prg-a (fn [f] (= '(fir_fn_stack self) f))))))
(is (not (empty? (parser/peek prg-b (parser/form? 'fir_defn_heap)))))
(is (not (empty? (parser/peek
prg-b (fn [f] (= '((fir_fn_stack self) (fir_fn_heap self)) f))))))
(is (= (->> (parser/peek prg-c (parser/form? 'fir_defn_arity))
first second first second second)
(->> (parser/peek prg-c (parser/form? 'fir_defn_stack)) first second)))))
#+end_src
***** Function Calls
Some function calls can be optimized away depending on the following
heuristics. User programs has no access to dispatch functions used by
multi-arity functions. They can be safely escaped and replaced by the
stack allocated versions. If dispatch functions can be resolved in
compile time they will be replaced. By default Ferret assumes all
functions can escape their scope and they are allocated on the
heap. Functions proven to not escape their scope are replaced with
stack allocated functions.
#+begin_src clojure :noweb-ref core-compiler-escape-analysis
(defn escape-fn-calls [form]
(let [arity (parser/peek
form
(fn [f]
(and (parser/form? 'fir-defn-heap f)
(-> (parser/peek f (parser/form? 'fir-defn-arity))
(empty?)
(not )))))
arity (reduce
(fn [h [_ name _ _ [_ dispatch [_ default]] :as form]]
(let [jmp (if default
{:default default}
{})
jmp (reduce (fn[h [arity [_ call]]]
(assoc h arity call))
jmp dispatch)]
(assoc h name jmp)))
{} arity)
arity-renames (reduce (fn [h [name jmps]]
(reduce
(fn [h jump]
(assoc h jump (gensym (str name "__"))))
h (vals jmps)))
{} arity)]
(-> form
;; resolve arity calls
(parser/transform
(parser/form? 'fir-defn-arity)
(fn [f]
(parser/transform f
(parser/form? 'fir-fn-heap)
(fn [[_ & f]]
`(~'fir-fn-stack ~@f)))))
(parser/transform
(fn [f]
(and (seq? f)
(parser/form? 'fir-fn-heap (first f))
(arity (-> f first second))))
(fn [f]
(let [[[_ fn] & args] f
dispatch ((arity fn) (count args))
default ((arity fn) :default)]
(cond dispatch `((~'fir-fn-heap ~dispatch) ~@args)
default `((~'fir-fn-heap ~default) ~@args)
:default f))))
(parser/transform
(fn [f]
(and (symbol? f)
(arity-renames f)))
(fn [f]
(arity-renames f)))
;; resolve fn calls
(parser/transform
(fn [f]
(and (seq? f)
(parser/form? 'fir-fn-heap (first f))))
(fn [f]
(let [[[_ & fn] & args] f]
`((~'fir-fn-stack ~@fn) ~@args)))))))
#+end_src
***** Function Inheritance
Each Ferret =fn= generates a corresponding C++ class that extends a
Ferret Object. If a function can be proven to be only allocated on the
stack in all uses of the said function, it can be replaced with a C++
POD type. This saves program space since said function does not need
to inherit from a Ferret Object.
#+begin_src clojure :noweb-ref core-compiler-escape-analysis
(defn escape-fn-inheritance [form]
(let [heap-fns (->> (parser/peek form (parser/form? 'fir-fn-heap))
(map second)
(into #{}))
stack-fns (->> (parser/peek form (parser/form? 'fir-fn-stack))
(map second)
(into #{}))
escapeable-fns (set/difference stack-fns heap-fns)]
(parser/transform form
(fn [f]
(and (seq? f)
(= (first f) 'fir-defn-heap)
(escapeable-fns (second f))))
(fn [[_ & f]]
`(~'fir-defn-stack ~@f)))))
#+end_src
*** Parser
Ferret programs are read using the Clojure reader via =read-string=,
#+begin_src clojure :tangle no :noweb-ref core-file-io
(defn read-clojure-file [f]
(let [ns (gensym)
ns-str (str ns)]
(create-ns ns)
(binding [*ns* (the-ns ns)]
(refer 'clojure.core)
(-> (read-string (str \( (io/read-file f) \)))
(parser/transform
symbol?
#(if (= (namespace %) ns-str)
(-> % name symbol)
%))
;;replace clojure.core/fn with fn
;;replace clojure.core/while with while
(parser/transform
(fn [x]
(and (parser/form? 'quote x)
(or (= 'clojure.core/fn (second x))
(= 'clojure.core/defn (second x))
(= 'clojure.core/while (second x)))))
(fn [[_ s]] `'~(-> s name symbol)))))))
#+end_src
Each transformation happens by walking over the program form. Forms
are selected using =form?= function.
#+begin_src clojure :tangle no
(form? 'fn* '(fn* [n] (+ x n)))
;; true
#+end_src
#+begin_src clojure :tangle no :noweb-ref core-compiler-parser
(defn form?
([s]
#(form? s %))
([s f]
(and (seq? f)
(= (first f) s))))
#+end_src
Returns the set of symbols used in the form.
#+begin_src clojure :tangle no :noweb-ref core-compiler-parser
(defn symbol-set [form]
(->> form flatten (filter symbol?) (into #{})))
#+end_src
Splits a function form into compnents.
#+begin_src clojure :tangle no :noweb-ref core-compiler-parser
(defn split-fn [sig]
(let [name (if (symbol? (second sig)) (second sig) nil)
sig (if name (clojure.core/drop 2 sig) (rest sig))
[args & body] sig]
[name args body]))
#+end_src
Predicate for checking if function body is a FFI call or not.
#+begin_src clojure :tangle no :noweb-ref core-compiler-parser
(defn ffi-fn? [body]
(and (not (nil? body))
(not (empty? body))
(->> (map string? body)
(every? true?))))
#+end_src
Predicate for checking if a symbol in =fn= arguments is a valid symbol
or not.
#+begin_src clojure :tangle no :noweb-ref core-compiler-parser
(defn fn-arg-symbol? [s]
(and (symbol? s)
(not= s '&)
(not= s '_)
(not= s 'fir-destructure-associative)))
#+end_src
During each pass we iterate over the nodes in the form using one of
three functions, =transform= , =drop= and =peek=. They
all take a s-expression and a predicate. If the predicate returns
true, =transform= will call =f= passing the current node as an argument
and replace that node with =f= 's return value, =drop= on the
other hand does what its name suggests and removes the node when
predicate returns true. =peek= is used to peek at sections of
the form, does not alter the form only returns the list of nodes
matching the predicate.
#+begin_src clojure :tangle no :noweb-ref core-compiler-parser
(defn transform [tree pred f]
(walk/prewalk (fn [form]
(if (pred form)
(let [new-form (f form)
meta (meta form)]
(if (and (instance? clojure.lang.IMeta form)
(instance? clojure.lang.IMeta new-form))
(with-meta new-form meta)
new-form))
form))
tree))
(defn drop [tree pred]
(if (every? true? (map #(pred %) tree))
(list )
(loop [loc (zip/seq-zip tree)]
(if (zip/end? loc)
(zip/root loc)
(recur
(zip/next
(if (pred (zip/node loc))
(zip/remove loc)
loc)))))))
(defn peek [tree pred & [node-fn]]
(let [node-fn (if node-fn
node-fn
#(zip/node %))]
(loop [loc (zip/seq-zip tree)
nodes []]
(if (zip/end? loc)
nodes
(recur
(zip/next loc)
(if (pred (zip/node loc))
(conj nodes (node-fn loc))
nodes))))))
#+end_src
Takes a *fn* form and converts all argument symbols with their unique
replacements. This is needed because most lisp forms are represented
as =fn='s and some forms such as =let= need to be able to shadow
already defined variable names.
#+begin_src clojure
(fn [a b] (list a b))
;;becomes
(fn [a__1510 b__1511] (list a__1510 b__1511))
#+end_src
#+begin_src clojure :tangle no :noweb-ref core-compiler-parser
(defn new-symbol [& parts]
(let [parts (map #(.replace (str %) "." "_") parts)]
(symbol (apply str parts))))
(defn fn-make-unique [args body]
(if (string? (->> body
(filter #(not (form? 'native-declare %)))
first))
[args body]
(let [unique-args (->> args
flatten
(filter fn-arg-symbol?)
(map #(new-symbol % (gensym "__"))))
replace? (->> (interleave (->> args
flatten
(filter fn-arg-symbol?))
unique-args)
(apply hash-map))
body (transform body #(replace? %) #(replace? %))
replace? (merge replace? {'fir-new-map 'fir-destructure-associative})
args (transform args #(replace? %) #(replace? %))]
[args body])))
(defn new-fir-fn
([& {:keys [name args body escape] :or {escape true
args []}}]
(let [name-unique (if name
(new-symbol name (gensym "__")))
[args body] (if escape
(fn-make-unique args body)
[args body])
body (if name-unique
(transform body #(= % name) (fn [_] name-unique))
body)]
(if name-unique
`(fn* ~name-unique ~args ~@body)
`(fn* ~args ~@body)))))
#+end_src
** Code Generation
The compiler's code generation phase takes a single pass over the
transformed lisp code and outputs C++ code. All Ferret modules and
the program code is amalgamated in to a single source file which
allows the generated code to be compiled as a single translation
unit.This allows many compilers to do optimization's that would not be
possible if the files were compiled separately. Code generation is
done by running =emit= on the final intermediate representation.
#+begin_src clojure :tangle no
(emit options '(list 1 2 3) (ref {}))
;;"run(list,obj(1),obj(2),obj(3))"
(emit options '(+ 1 2) (ref {}))
;;"run(+,obj(1),obj(2))"
(emit options '(if (< a b)
b a)
(ref {}))
;;"((<,b,a) ? a : b)"
#+end_src
#+begin_src clojure :tangle no :noweb-ref core-compiler-emitter
(defmulti emit (fn [_ f _]
(cond (parser/form? '(fir_fn_stack list) f) 'fir_inline_list
(parser/form? '(fir_fn_stack first) f) 'fir_inline_first
(parser/form? '(fir_fn_stack rest) f) 'fir_inline_rest
(parser/form? 'fir_defn_heap f) 'fir_defn_heap
(parser/form? 'fir_defn_stack f) 'fir_defn_stack
(parser/form? 'fir_defn_arity f) 'fir_defn_arity
(parser/form? 'fir_fn_heap f) 'fir_fn_heap
(parser/form? 'fir_fn_stack f) 'fir_fn_stack
(parser/form? 'list f) 'list
(parser/form? 'defobject f) 'defobject
(parser/form? 'matrix f) 'matrix
(parser/form? 'native_header f) 'native_header
(parser/form? 'native_declare f) 'native_declare
(parser/form? 'native_define f) 'native_define
(parser/form? 'if f) 'if
(parser/form? 'def f) 'def
(parser/form? 'fir_new_map f) 'fir_new_map
(symbol? f) :symbol
(keyword? f) :keyword
(number? f) :number
(nil? f) :nil
(char? f) :char
(string? f) :string
(instance?
java.util.regex.Pattern f) :regex-pattern
(or (true? f) (false? f)) :boolean
(seq? f) :invoke-fn
:default :unsupported-form)))
(defmethod emit :unsupported-form [_ form _]
(warn "unsupported form =>" form)
(io/exit-failure))
(defn emit-ast [options ast state]
(reduce (fn[h v] (conj h (emit options v state))) [] ast))
#+end_src
Code generation for a Ferret program is done by running =emit= on all
nodes of the program AST.
#+begin_src clojure :tangle no :noweb-ref core-compiler-helpers
(defn append-to! [r ks v]
(let [cv (reduce (fn[h v] (v h)) @r ks)]
(swap! r assoc-in ks (conj cv v))
""))
#+end_src
#+begin_src clojure :tangle no :noweb-ref core-compiler-emitter
(defn emit-source [form options]
(let [state (atom {:native-headers []
:native-declarations []
:objects []
:symbol-table #{}
:lambdas []
:native-defines []})
ast (compile form options)
body (emit-ast options ast state)]
(when (:ast options)
(pprint/pprint ast))
(assoc @state :body body)))
#+end_src
*** Object Types
#+begin_src clojure :tangle no :noweb-ref core-compiler-emitter
(defmethod emit :symbol [_ form state] (str form))
(defmethod emit :string [_ form state]
(str "obj(\"" (io/escape-string form) "\"," (count form) ")"))
(defmethod emit :boolean [_ form state]
(if (true? form)
(str "cached::true_o")
(str "cached::false_o")))
(defmethod emit :nil [_ form state] "nil()")
(defmethod emit :keyword [_ form _]
(str "obj(" (reduce (fn[h v] (+ h (int v))) 0 (str form)) ")"))
(defmethod emit :char [_ form state] (str "obj(" (int form) ")"))
(defmethod emit :number [_ form state] (str "obj(" (double form) ")"))
(defmethod emit 'fir_new_map [options [_ & kvs] state]
(let [kvs (partition 2 kvs)
keys (->> (map first kvs)
(map #(emit options % state))
(interpose \,))
vals (->> (map second kvs)
(map #(emit options % state))
(interpose \,))]
(str "obj("
"rt::list(" (apply str keys) "),"
"rt::list(" (apply str vals) "))")))
(defmethod emit :regex-pattern [options regex state]
(emit options
(org.apache.commons.lang.StringEscapeUtils/unescapeJava
(str regex))
state))
#+end_src
*** Special Forms
Special forms have evaluation rules that differ from standard Ferret
evaluation rules and are understood directly by the compiler. Most
special forms define control structures or perform variable
bindings—things which functions cannot do.
#+begin_src clojure :tangle no :noweb-ref core-compiler-emitter
(defmethod emit 'def [options [_ name & form] state]
(append-to! state [:symbol-table] name)
(str "(" name " = " (apply str (emit-ast options form state)) ")"))
(defmethod emit 'if [options [_ cond t f] state]
(let [cond (emit options cond state)
t (emit options t state)
f (if (nil? f) "nil()" (emit options f state))]
(apply str "(" cond " ? " t " : " f ")")))
(defn defobject [name f options]
(let [def (io/read-file (first f) options)]
(render-template
"#ifndef FERRET_OBJECT_$guard$
#define FERRET_OBJECT_$guard$
$body$
#endif"
:guard (.toUpperCase (str name))
:body def)))
(defmethod emit 'list [options [fn & args] state]
(let [elements (->> (emit-ast options args state)
(interpose \,)
(apply str))]
(str "rt::list(" elements ")")))
(defmethod emit 'defobject [options [_ name & spec] state]
(append-to! state [:objects] (defobject name spec options)))
(defmethod emit 'matrix [options [_ elements] state]
(let [rows (count elements)
cols (-> elements first count)
elements (apply concat elements)
elements (map #(if (number? %)
(str "real_t(" % ")")
(str
"number::to"
"(" (emit options % state) ")"))
elements)
elements (apply str (interpose \, elements))
matrix-t (str "size_t(" rows "), size_t(" cols ")," elements)
matrix-decl (str "obj(" matrix-t ")")]
matrix-decl))
(defmethod emit 'native_header [_ [_ & declarations] state]
(append-to! state [:native-headers] declarations))
(defmethod emit 'native_declare [_ [_ declaration] state]
(append-to! state [:native-declarations] declaration))
(defmethod emit 'native_define [_ [_ define] state]
(append-to! state [:native-defines] define))
#+end_src
Inline primitive sequence operations. Some sequence operations such as
=first= / =rest= are implemented as native C++ functions instead of
executing a Ferret =fn= for these operations, these can be replaced
with calls to native implementations resulting in much smaller code.
#+begin_src clojure :tangle no :noweb-ref core-compiler-emitter
(defmethod emit 'fir_inline_list [options [_ & args] state]
(str "rt::list(" (apply str (interpose \, (emit-ast options args state))) ")"))
(defmethod emit 'fir_inline_first [options [_ & seq] state]
(str "rt::first(" (apply str (emit-ast options seq state)) ")"))
(defmethod emit 'fir_inline_rest [options [_ & seq] state]
(str "rt::rest(" (apply str (emit-ast options seq state)) ")"))
#+end_src
*** Functions
#+begin_src clojure :tangle no :noweb-ref core-compiler-emitter
(defn norm-fn-env [env]
(->> env
(flatten)
(filter #(and (not (= '& %))
(not (= '_ %))
(not (= :as %))))))
(defn new-fn-heap [l]
(let [n (second l)
e (norm-fn-env (drop 2 l))]
(if (empty? e)
(str "obj<" n ">()")
(str "obj<" n ">(" (apply str (interpose \, e)) ")"))))
(defn new-fn-stack [l]
(let [n (second l)
e (norm-fn-env (drop 2 l))]
(if (empty? e)
(str n "()")
(str n "(" (apply str (interpose \, e)) ")"))))
(defn invoke-fn [n args]
(if (empty? args)
(str "run(" n ")")
(str "run(" n "," (apply str (interpose \, args))")")))
#+end_src
Initialize function arguments. Clojure style sequential destructuring
is supported.
#+begin_src clojure :tangle no :noweb-ref ferret-unit-tests
(defn destructure-test-1 [[a b c]]
(list a b c))
(defn destructure-test-2 [[a [b] c]]
b)
(defn destructure-test-3 [[a [_ b] c]]
b)
(defn destructure-test-4 [& a]
a)
(defn destructure-test-5 []
(let [[a b c] (list 1 2 3)]
(list a b c)))
(defn destructure-test-6 []
(let [[_ _ a] (list 1 2 3)]
a))
(defn destructure-test-7 [a b & [c d]]
(list c d))
(defn destructure-test-8 [{a :a} b {c :c}]
(list a b c))
(deftest destructuring-test
(is (= 3 (count (destructure-test-1 (list 1 2 3)))))
(is (= 2 (destructure-test-2 (list 1 (list 2) 3))))
(is (= 3 (destructure-test-3 (list 1 (list 2 3) 3))))
(is (= (list (list 1 2 3)) (destructure-test-4 (list 1 2 3))))
(is (= (list 1 2 3) (destructure-test-8 {:a 1} 2 {:c 3})))
(let [a (list 1 2 3 4)
[b c & r] a]
(is (= 1 b))
(is (= 2 c))
(is (= (list 3 4) r)))
(let [a 1 b 2
[c & r] (list 4 5)]
(is (= 1 a))
(is (= 2 b))
(is (= 4 c))
(is (= (list 5) r)))
(let [[a & r] (list 1 2 3)
rr (rest r)]
(is (= (list 3) rr)))
(is (= (list 1 2 3) (destructure-test-5)))
(is (= 3 (destructure-test-6)))
(is (= (list 3 4) (destructure-test-7 1 2 3 4)))
(let [[a & b :as all-list] (list 1 2 3)
[c :as other-list] all-list]
(is (= 1 a))
(is (= (list 2 3) b))
(is (= (list 1 2 3) all-list))
(is (= 1 c))
(is (= (list 1 2 3) other-list)))
(let [[_ _ a] (list 1 2 3)
[_ b] (list 4 5 6)]
(is (= 3 a))
(is (= 5 b)))
(let [a (list 1 2 3)
[b c d e f g] a]
(is (= 1 b))
(is (= 2 c))
(is (= 3 d))
(is (= nil e))
(is (= nil f))
(is (= nil g))))
#+end_src
#+begin_src clojure :tangle no :noweb-ref core-compiler-emitter
(declare destructure-arguments)
(defn destructure-nth-rest [parent pos]
(reduce (fn[h v] (str v "(" h ")")) parent (repeat pos "rt::rest")))
(defn destructure-nth [parent pos]
(str "rt::first(" (destructure-nth-rest parent pos) ")"))
(defn destructure-get [name parent key]
(str "ref " name " = "
parent ".cast()->val_at(rt::list(" (emit nil key nil) "));"))
(defn new-fn-arg [name parent pos]
(let [value (destructure-nth parent pos)
tag (-> name meta :tag)]
(condp = tag
'bool_t (str "bool " name " = " "bool(" value ")")
'real_t (str "real_t " name " = " "number::to(" value ")")
'number_t (str "number_t " name " = " "number::to(" value ")")
'size_t (str "size_t " name " = " "number::to(" value ")")
'byte (str "byte " name " = " "number::to(" value ")")
'c_str (str "var " name "_packed = string::pack(" value ");\n"
"char* " name " = " "string::c_str(" name "_packed)")
'matrix (str "matrix &" name " = " "value::to_reference(" value ")")
(str "ref " name " = " value))))
(defn new-fn-var-arg [name parent pos]
(str "ref " name " = " (destructure-nth-rest parent pos)))
(defn destructure-associative [name parent pos]
(let [tmp-name (gensym)]
[(new-fn-arg tmp-name parent pos)
(map (fn [[s k]] (destructure-get s tmp-name k)) name)]))
(defn destructure-sequential [args parent]
(reduce
(fn [h [pos name]]
(let [name (cond
(symbol? name)
(new-fn-arg name parent pos)
(parser/form? 'fir_destructure_associative name)
(let [[_ & args ] name
args (->> args
(partition 2)
(remove #(= (first %) '_))
flatten
(apply hash-map))]
(destructure-associative args parent pos))
(coll? name)
(destructure-arguments name (destructure-nth parent pos)))]
(conj h name))) [] args))
(defn destructure-var-args [name parent pos]
(cond (nil? name) []
(symbol? name) (new-fn-var-arg name parent pos)
(coll? name) (let [tmp-name (gensym)]
[(new-fn-var-arg tmp-name parent pos)
(destructure-arguments name tmp-name)])))
(defn destructure-as-arg [name parent]
(if (symbol? name)
(new-fn-var-arg name parent 0)
[]))
(defn destructure-arguments
([args]
(->> (destructure-arguments args "_args_") flatten))
([args parent]
(let [t-args args
args (take-while #(and (not= % '&) (not= % :as)) t-args)
var-args (->> t-args (drop-while #(not= % '&)) second)
as-arg (->> t-args (drop-while #(not= % :as)) second)
args-indexed (->> args
(map-indexed (fn [p v] [p v]))
(filter #(not= (second %) '_)))
as-arg (destructure-as-arg as-arg parent)
var-args (destructure-var-args var-args parent (count args))
args (destructure-sequential args-indexed parent)]
[args var-args as-arg])))
#+end_src
#+begin_src clojure :tangle no :noweb-ref core-compiler-emitter
(defmethod emit :invoke-fn [options [fn & args] state]
(invoke-fn (emit options fn state) (emit-ast options args state)))
(defmethod emit 'fir_fn_heap [_ f state]
(new-fn-heap f))
(defmethod emit 'fir_fn_stack [_ f state]
(new-fn-stack f))
(defn emit-lambda [options name env args body state]
(let [native-declarations (filter (parser/form? 'native_declare) body)
return (fn [b] (conj (pop b) (str "return " (last b))))
body (filter #(not (parser/form? 'native_declare %)) body)
body (cond (empty? body)
["return nil()"]
;; multi arity dispacth
(parser/form? 'fir_defn_arity (first body))
(return
(emit options (first body) state))
;; ffi call
(parser/ffi-fn? body)
(let [buffer (StringBuilder.)]
(doseq [b body]
(.append buffer b))
(let [body (.toString buffer)]
(cond (.contains body "__result")
["var __result" body "return __result"]
(.contains body "return")
[body]
:default [body "return nil()"])))
;; s-expression
:default (return
(emit-ast options body state)))
env (norm-fn-env env)
vars (destructure-arguments args)]
(doseq [dec native-declarations]
(emit options dec state))
{:name name :env env :args args :vars vars :body body}))
(defmethod emit 'fir_defn_heap [options [_ name env args & body] state]
(append-to! state [:lambdas] (emit-lambda options name env args body state)))
(defmethod emit 'fir_defn_stack [options [_ name env args & body] state]
(append-to! state [:lambdas] (-> (emit-lambda options name env args body state)
(assoc :stack true))))
#+end_src
#+begin_src clojure :tangle no :noweb-ref core-compiler-emitter
(defmethod emit 'fir_defn_arity [_ [_ switch default] state]
(let [default (if default
(str (new-fn-stack default) ".invoke(_args_)")
"nil()")
switch (render-template
"switch(rt::count(_args_)) {
$fns: {fn|
case $fn.case$ :
return $fn.fn$.invoke(_args_); };separator=\"\n\"$
}"
:fns (map (fn [[s f]] {:fn (new-fn-stack f) :case s}) switch))]
[switch default]))
#+end_src
#+begin_src clojure :tangle no :noweb-ref core-compiler-emitter
(defn lambda-definitions [fns]
(render-template
"$fns: {fn|
$if(!fn.stack)$
class $fn.name$ final : public lambda_i{
$else$
class $fn.name$ \\{
$endif$
$fn.env:{const var $it$;} ;separator=\"\n\"$
public:
$if(fn.env)$
explicit $fn.name$ ($fn.env:{ref $it$} ;separator=\",\"$) :
$fn.env:{$it$($it$)} ;separator=\",\"$ { }
$endif$
var invoke (ref _args_) const $if(!fn.stack)$ final $endif$ ;
};};separator=\"\n\n\"$"
:fns fns))
(defn lambda-implementations [fns]
(render-template
"$fns: {fn|
inline var $fn.name$::invoke (ref _args_) const {
(void)(_args_);
$fn.vars:{$it$;} ;separator=\"\n\"$
$fn.body:{$it$;} ;separator=\"\n\"$
}
};separator=\"\n\n\"$"
:fns fns))
#+end_src
*** Program
Generated C++ code has the following structure, (All Ferret code is
defined within =ferret= namespace, all Ferret macros starts with
=FERRET_=, all user defined functions are defined in file name
namespace.)
- Detect Hardware
- Include files
- Ferret Header (src/runtime/runtime.h)
- Ferret Native Runtime Prototypes (rt::first, rt::rest
etc.)
- Native Declarations
- Object Definitions
- Symbol Definitions
- Native Runtime Implementations
- Lambda Prototypes
- Lambda Implementations
- Ferret Main
- Hardware Dependent Main Functions
#+begin_src clojure :tangle no :noweb yes :noweb-ref core-compiler-emitter
(defn program-template [source options]
(let [{:keys [body lambdas symbol-table native-headers objects
native-declarations native-defines]} source
native-headers (->> native-headers flatten (into #{}))
file-ns (-> options :base-name escape-cpp-symbol)
main (render-template
(io/read-file "main.cpp")
:file file-ns)]
(render-template
"
$native_defines:{$it$} ;separator=\"\n\"$
$native_headers:{#include \"$it$\"} ;separator=\"\n\"$
#ifndef FERRET_RUNTIME_H
#define FERRET_RUNTIME_H
$ferret_h$
#endif
// Objects
namespace ferret{
$objects:{$it$} ;separator=\"\n\"$
}
// Symbols
namespace $file${
using namespace ferret;
#if defined(ARDUINO)
typedef ferret::boolean boolean;
#endif
$symbols:{var $it$;} ;separator=\"\n\"$
}
$native_declarations:{$it$} ;separator=\"\n\"$
// Runtime Implementations
#ifndef FERRET_RUNTIME_CPP
#define FERRET_RUNTIME_CPP
$ferret_cpp$
#endif
// Lambda Prototypes
namespace $file${
$lambda_classes:{$it$} ;separator=\"\n\"$
}
// Command Line Arguments
#if defined(FERRET_STD_LIB) && \\
!defined(FERRET_DISABLE_CLI_ARGS) && \\
!defined(FERRET_DISABLE_STD_MAIN)
ferret::var _star_command_line_args_star_;
#endif
// Lambda Implementations
namespace $file${
$lambda_bodies:{$it$} ;separator=\"\n\"$
}
// Program Run
namespace $file${
void main(){
$body:{$it$;} ;separator=\"\n\"$
}
}
$ferret_main$"
:file file-ns
:native_defines native-defines
:ferret_h (io/read-file "runtime.h")
:native_headers native-headers
:objects objects
:symbols symbol-table
:native_declarations native-declarations
:ferret_cpp (io/read-file "runtime.cpp")
:lambda_classes (lambda-definitions lambdas)
:lambda_bodies (lambda-implementations lambdas)
:body (filter #(not (empty? %)) body)
:ferret_main main)))
#+end_src
** Main
*** Options
Default compile options,
#+begin_src clojure :noweb-ref core-compiler-main
(defn compile-options [& [options]]
(merge {:compiler "g++"
:compiler-options ["-std=c++11"]
:source-extension io/extension-cpp
:base-name "solution"
:binary-file "solution"}
options))
(defn file-name [options]
(str (:base-name options) "." (:source-extension options)))
(defn cpp-file-name [options]
(str (:output-path options) (file-name options)))
#+end_src
Read the /cpp/ file parse build options embedded in
it. =configure-ferret!= macro can embed build options into C++
files. These can be used later when build the binary.
#+begin_src clojure :noweb-ref core-compiler-main
(defn compile-options-parse-source [file]
(try
(let [program (slurp file)
options (->> program
(re-seq #"(?s)build-conf-begin.*?//(.*?)// build-conf-end")
(map second)
(map #(.replaceAll % "//" ""))
(map #(.replaceAll % "\n" " "))
(map read-string))
keys (->> options
(map #(keys %))
flatten
(into #{})
(into []))
combine (fn [key]
(->> options
(reduce (fn[h v]
(if (nil? (key v))
h
(apply merge (flatten [h (key v)])))) #{})
(into [])))]
(compile-options
(reduce (fn[h v]
(assoc h v (combine v))) {} keys)))
(catch Exception e
(compile-options {}))))
#+end_src
Takes the compiler CLI arguments and a file name, returns a map of
build options.
#+begin_src clojure :noweb-ref core-compiler-main
(defn build-specs [input args]
(fn []
(let [args (fn [k]
(->> args :options k))
output (if (args :output)
(args :output)
input)
output-path (io/file-path output)
output-extension (if (args :output)
(io/file-extension (args :output))
io/extension-cpp)
base-name (io/file-base-name output)
input-path (io/file-path input)
output-file (io/make-file output-path base-name output-extension)
binary-file (if (args :binary)
(args :binary)
base-name)
default-options (compile-options-parse-source output-file)]
(-> default-options
(assoc :input-file input)
(assoc :base-name base-name)
(assoc :path input-path)
(assoc :output-path output-path)
(assoc :source-extension output-extension)
(assoc :binary-file binary-file)
(assoc :ast (args :ast))
(assoc :compile-program (args :compile))
(assoc :release (args :release))
(assoc :format-code (not (args :disable-formatting)))
(assoc :global-functions (args :global-functions))
(assoc :extra-source-files
(cond (not (empty? (:arguments args)))
(:arguments args)
(not (empty? (:extra-source-files default-options)))
(:extra-source-files default-options)
:default []))))))
#+end_src
*** Compile to C++
Compile the form to C++,
#+begin_src clojure :noweb-ref core-compiler-main
(defn compile->cpp [form options]
(let [file-name (cpp-file-name options)
source (emit-source form options)
program (program-template source options)]
(io/write-to-file file-name program)
(info "compiled" "=>" file-name)
true))
#+end_src
*** Compile to Binary
Pick compiler to use. If set, use the value of =CXX= environment
variable, if not set use the default compiler =gcc=,
#+begin_src clojure :noweb-ref core-compiler-main
(defn cxx-compiler [options]
(let [compiler (if (System/getenv "CXX")
(System/getenv "CXX")
(:compiler options))
env-options (if (System/getenv "CXXFLAGS")
(seq (.split (System/getenv "CXXFLAGS") " ")))
options (->> (:compiler-options options) (map str))]
[compiler (concat options env-options)]))
#+end_src
Compiler build command,
#+begin_src clojure :noweb-ref core-compiler-main
(defn cxx-command [options]
(if (:command options)
(flatten ["/usr/bin/env" "sh" "-c" (:command options)])
(let [[cxx cxx-options] (cxx-compiler options)
source-files (map #(let [extension (io/file-extension %)]
[(cond (= extension "c") ["-x" "c"]
(= extension "c++") ["-x" "c++"]
:default "")
%])
(:extra-source-files options))]
(flatten [cxx cxx-options source-files
["-x" "c++"] (file-name options)
["-o" (:binary-file options)]]))))
#+end_src
Run the compiler on the generated source and create the binary,
#+begin_src clojure :noweb-ref core-compiler-main
(defn compile->binary [options]
(let [command (cxx-command options)]
(info "building" "=>" (apply str (interpose " " command)))
(let [build-dir (:output-path options)
ret (try
(with-sh-dir build-dir
(apply sh command))
(catch Exception e
(warn (str "error executing C++ compiler."))
(warn (str "" (.getMessage e)))
(io/exit-failure)))]
(if (not= 0 (:exit ret))
(do (warn "build error")
(warn (:err ret))
(io/exit-failure)))
true)))
#+end_src
*** Build Solution
Compile and build program,
#+begin_src clojure :noweb-ref core-compiler-main
(defn clang-format [options]
(let [file (cpp-file-name options)
source (try (with-sh-dir "./"
(sh "clang-format" "-style" "{Standard: Cpp11}" file))
(catch Exception e nil))]
(if source
(do (info "formatting code")
(io/write-to-file file (:out source))))))
(defn build-solution [spec-fn]
(let [{:keys [input-file compile-program format-code path]} (spec-fn)]
(info "dir =>" path)
(info "file =>" input-file)
(compile->cpp (read-clojure-file input-file) (spec-fn))
(when format-code
(clang-format (spec-fn)))
(when compile-program
(compile->binary (spec-fn)))))
#+end_src
*** Compiler Main
Compiler options,
#+begin_src clojure :noweb-ref core-compiler-main
(def program-options
[["-i" "--input FILE" "Input File" :default "./core.clj"]
["-o" "--output FILE" "Output C++ File"]
["-b" "--binary FILE" "Output Binary File"]
["-c" "--compile" "Compile to Binary"]
[nil "--deps" "Checkout Input Dependencies"]
["-w" "--watch-input" "Automatically Recompile Input File on Change"]
[nil "--release" "Compile in Release Mode. Strip Debug Information"]
[nil "--disable-formatting" "Disables Output File Formatting Using clang-format"]
[nil "--global-functions" "Disables inline-global-fns Optimization"]
[nil "--ast" "Print Intermediate AST"]
[nil "--silent" "Silent or quiet mode"]
["-h" "--help" "Print Help"]])
#+end_src
Compiler /main/,
#+begin_src clojure :noweb-ref core-compiler-main
(defn -main [& args]
(try
(let [args (parse-opts args program-options)
{:keys [help input deps watch-input silent]} (:options args)]
(when help
(try
(let [version (io/read-file "build.info")]
(print "ferret-lisp" version))
(catch Exception e
(print "ferret-lisp")))
(println )
(println )
(println (:summary args))
(io/exit-success))
(when silent
(System/setProperty "org.slf4j.simpleLogger.defaultLogLevel" "warn"))
(when (not (io/file-exists input))
(warn "no input file")
(io/exit-failure))
(let [specs (build-specs input args)]
(when deps
(try
(checkout-deps (:path (specs)))
(catch Exception e
(io/exit-failure)))
(io/exit-success))
(if (not watch-input)
(build-solution specs)
(do (watcher/watcher [input]
(watcher/rate 1000)
(watcher/on-change
(fn [_] (build-solution specs))))
@(promise)))
(shutdown-agents))
(io/exit-success))
(catch Exception e
(stacktrace/print-stack-trace e 10))))
#+end_src
** I/O
Common I/O operations.
#+begin_src clojure :tangle no :noweb-ref core-main-io
(def extension-cpp "cpp")
(defn os-name []
(let [os (-> (System/getProperty "os.name") .toLowerCase)]
(cond (.contains os "win") :windows
(.contains os "mac") :mac
(or (.contains os "nix")
(.contains os "nux")
(.contains os "aix")) :unix
(.contains os "sunos") :solaris)))
(defn exit-failure []
(System/exit 1))
(defn exit-success []
(System/exit 0))
(defn read-file-from-url [f]
(with-open [in (.getResourceAsStream (ClassLoader/getSystemClassLoader) f)
rdr (BufferedReader. (InputStreamReader. in))]
(apply str (interpose \newline (line-seq rdr)))))
(defn read-file [f & [options]]
(try
(read-file-from-url f)
(catch Exception e-url
(try
(if (nil? options)
(FileUtils/readFileToString (file f))
(FileUtils/readFileToString (file (str (:path options) f))))
(catch Exception e-path
(warn "error reading =>" f)
(exit-failure))))))
(defn write-to-file [f s]
(FileUtils/writeStringToFile (file f) (.trim s)))
(defn escape-string [s]
(org.apache.commons.lang.StringEscapeUtils/escapeJava s))
(defn file-path [file]
(let [path (str (org.apache.commons.io.FilenameUtils/getPrefix file)
(org.apache.commons.io.FilenameUtils/getPath file))]
(if (empty? path)
"./"
path)))
(defn file-extension [f]
(org.apache.commons.io.FilenameUtils/getExtension f))
(defn file-base-name [f]
(org.apache.commons.io.FilenameUtils/getBaseName f))
(defn file-exists [f]
(.exists (file f)))
(defn make-file [p n e]
(file (str p n "." e)))
#+end_src
* Runtime
Runtime needed to support [[*Core][Core]]. [[Object System][Object system]], [[*Memory%20Management][Memory Management]] etc.
** Object System
*** Base
All our types are derived from the base Object type. Which is a
=typedef= of =obj::base=. See
[[Reference Counting]] for available reference counting policies and
[[Memory Allocation]] for available allocation policies.
#+begin_src c++ :tangle no :noweb-ref runtime-native-object
template
void type_id(){}
using type_id_t = void(*)();
typedef type_id_t type_t;
class var;
typedef var const & ref;
class seekable_i;
template
class object_i : public rc{
public:
object_i() { }
virtual ~object_i() { };
virtual type_t type() const = 0;
#if !defined(FERRET_DISABLE_STD_OUT)
virtual void stream_console() const {
rt::print("var#");
const void* addr = this;
rt::print(addr);
}
#endif
virtual bool equals(ref) const;
virtual seekable_i* cast_seekable_i() { return nullptr; }
void* operator new(size_t, void* ptr){ return ptr; }
void operator delete(void * ptr){ FERRET_ALLOCATOR::free(ptr); }
};
typedef object_i object;
#+end_src
A =pointer_t= holds a pointer to a Ferret object. Default =pointer_t=
does nothing and delegates all requests to a regular =object *=. See
[[Pointers]] for rationale.
#+begin_src c++ :tangle no :noweb-ref runtime-native-object
#if !defined(FERRET_POINTER_T)
#define FERRET_POINTER_T memory::pointer