Formal is an opinionative programming language for the discriminating modern programmer. More importantly, formal is my vanity project, an attempt to learn ML by writing one.
What opinions, you may ask? Several:
Buzzwords: functional, strict, pure(ish), static(y), inferred, fast, fun. Strong like a gorilla, yet soft and yielding like a Nerf ball.
Targets Javascript. Please regard this as an implementation detail - formal is not intended as an answer to "the Javascript problem."
Testing is first class.
Detriments:
Unreadable Javascript. As a vanity project, this was simply not a priority. Long term, source maps seem a much better solution to this issue than targetting
Buggy. But you can help - by reporting bugs!
Designed for readability and
Hybrid type system - complete polymorphic type system w/ stuctural records, plus a dynamic type for unrestricted Javascript.
First class testing - types and tests are equal first class citizens of the language.
Inline Javascript - For bootstrapping, quickly importing a Javascript library, accessing un-formalized APIs or simply writing fast mutation algorithms "natively."
Simple data types - The basic data types in Formal are the exact same basic data types of Javascript: Num, String, Array, Object, Function.
Advanced pattern matching - Traditional pattern matching goodness with a few extras: match on record partials & define your own matches with view patterns.
Pure by default - Like Haskell, any function which has a side effect returns the polymorphic type JS a by default, including any inline Javascript, and these types can be composed without evaluation via do, yield, lazy or simple combinators. Unlike Haskell, JS a types can be trivially unwrapped anywhere via do!
Targets Closure advanced mode - Formal does not aim to emit readable Javascript, instead opting to produce the most efficient output possible.
This document is a both the compiler's README, and the Formal language's standard library as literate code, which serves as a simple language feature spec/tutorial
Mac OSX (tested on Snow Leopard & Lion)
Install the Haskell Platform, then
--$ cabal install formalTo compile some formal files:
--$ formal -o app test.formal test2.formalwill create an app.js, app.spec.js and app.html file with the compiled code, test suite and annotated documentation respectively. To compile literate formal (eg, Formal code embedded in Markdown, ala this file):
--$ formal test.lformalTo see the inferred types:
--$ formal -t test.formalTo turn off optimizing (eg, Closure) or testing:
--$ formal -no-test -no-opt test.formalFormal is a literate language embedded in Markdown, so any line not indented at least 4 spaces is considered a comment. The primary unit of code organization is the module, a named collection of functions and values.
module preludeSome simple reflection by lifting from Javascript. The definitions of object? and array? must use Javascript's === operator directly here, as the "==" operator defined in Numbers is defined in terms of them.
type
JS a = {} -> a
inline object? x = do! `typeof x === "object"`
inline array? = do! `is_array`
inline string? x = do! `typeof x === "string"`
inline type? x = do! `typeof x`
inline
not: Bool -> Bool
not x = do! `!x`
not false
object? {}
array? []
not (array? {})
not (object? 0)Side effects can only happen in Javascript, so we use a monadic container to compose these bits.
inline
(>>=): JS a -> (a -> JS b) -> JS b
(>>=) x y = y (run x)
inline
(>>): JS a -> JS b -> JS b
(>>) x y = `run x; return (run y)`
inline return:
a -> JS a
return x = `x`
do! x <- `1 + 4`
y <- `2 + 3`
ans <- `x + y`
return (10 == ans)
5 == do! return 5
10 == do! `5 + 5`
inline log: a -> JS {}
| x = `console.log(x)`Testing to verify that escaping Javascript & utilizing escaped Javascript with do sugar and composition in general works as expected.
var x = 0
y = do z <- `x = 1`
return z
x == 0Some basic aliases to native javascript infix functions. These are type annotated to constrain inferrence - otherwise, these functions would all be inferred as a -> b -> c.
inline (&&): Bool -> Bool -> Bool | x y = do! `x && y`
inline (||): Bool -> Bool -> Bool | x y = do! `x || y`
inline (*): Num -> Num -> Num | x y = do! `x * y`
inline (/): Num -> Num -> Num | x y = do! `x / y`
inline (%): Num -> Num -> Num | x y = do! `x % y`
inline (+): Num -> Num -> Num | x y = do! `x + y`
inline (-): Num -> Num -> Num | x y = do! `x - y`
inline (<=): Num -> Num -> Bool | x y = do! `x <= y`
inline (>=): Num -> Num -> Bool | x y = do! `x >= y`
inline (<): Num -> Num -> Bool | x y = do! `x < y`
inline (>): Num -> Num -> Bool | x y = do! `x > y`Equality is overloaded to match records and arrays. By constraining the type of this operator, we need only dispatch on the type of the first element, constraining
inline x != y = not (x is y)
inline x /= y = not (x == y)
(==): a -> a -> Bool
| x y when do! `x === y` = true
| x y when object? x =
do! `var result = true;
for (key in x) {
result = result && y.hasOwnProperty(key) && _eq_eq(x[key])(y[key]);
};
var z = Object.keys(x).length
=== Object.keys(y).length;
result && z`
| x y when array? x =
do! `var result = true;
for (z in x) {
result = result && _eq_eq(x[z])(y[z]);
};
result && x.length == y.length`
| x y = falseAnd a few simple tests to verify the correctness of these implementations. This is not meant to be exhaustive, only a smoke test against regressions.
(3 * 4) + 5 * 4 == 64 / 2
4 - 1 != 5 - 10
(10 >= 5 + 5) != (4 + 5 <= 10 - 2)
({test: 1} == {test: 1}) == true
({test: 1} != {test: 1}) == falseFibonacci function
fib 0 = 0 | 1 = 1 | n = fib(n - 1) + fib(n - 2)Due to the nested recursion, fib is an excellent function for testing the runtime speed versus raw javascript. fast_fib is a trivial javascript implementation of the same function, recursed itself to remove any potential overhead from formal's dispatch mechanism.
module speedtest
private inline get_time = `new Date().getTime()`
time js =
do start <- get_time
js
stop <- get_time
return (stop - start)
private inline
fast_fib =
do! `var f = function(n) {
return 0 === n ? 0 : 1 === n ? 1 : f(n - 1) + f(n - 2)
}; f`
fast_fib 7 == fib 7With this, we can set up a simple canary to let us know if the prelude is suddenly dramatically slower than it previously was; in this case, we fail a test if the formal version isn't at least 90% as fast as the native javascript version.
floor: Num -> Num = do! `Math.floor`
do! fast_time <- time yield fast_fib 30
slow_time <- time yield fib 30
return (floor (fast_time / slow_time * 100) >= 80)Simple left & right pipes, ala F#.
inline x <| y = x y
inline x |> y = y x
3 |> (λy = y + 1) |> λy = y + 1 == 5
(λy x z = x + y + z + 1) 1 <| 3 <| 4 == 9Alternatively, there is a right associative version of <|, ala haskell. All operators which end with a : are right associative.
inline x <: y = x y
(λx = x - 3) <: (λx = x - 3) <: 5 + 5 == 4Function composition
inline x .: y = λz = x y(z)
inline id x = x
inline flip(f) x y = f(y, x)
inline x ' y = y x
((λx = x + 1) .: (λx = x * 2) .: λx = x - 3) 4 == 3
id [1, 2, 3] == [1, 2, 3]
flip (λx y = x - y) 3 5 == 2 module string
inline
lstrip: String -> String
lstrip x = do! `x.replace(/^\s+/, '')`
inline rstrip: String -> String | x = do! `x.replace(/\s+$/, '')`
inline strip: String -> String | = lstrip .: rstrip
inline
(+++): a -> b -> String
x +++ y = do! `"" + x + y`
strip " test " is "test"interpolated strings
let x = "test"
in "hello `x`" is "hello test"
open stringBy invoking javascript, we can listen for exceptions.
err x = do! `try {
x();
return false;
} catch (e) {
return e;
}` module option
Option a = {some: a} | {none}
option b {none} = b
| _ {some: x} = x
option 3 {some: 2} == 2
module html
HTML = { element: a
inner: JS String
on_click: JS {} -> JS {}
set: b -> JS {}
add_class: String -> JS {}
add_style: String -> String -> JS {} }
get:
String -> JS HTML
| x = do el <- `$(x).get(0)`
return { element = el
inner = `el.innerHTML`
on_click y = `el.onclick = y`
set y = `el.innerHTML = y`
add_class y =
`el.setAttribute("class", el.getAttribute("class") + " " + y)`
add_style y z = `el.style[y] = z` }
inline ($=):
String -> a -> JS {}
x $= y =
`if (typeof $ != "undefined") {
var xx = $(x).get(0);
if (typeof xx != "undefined") {
xx.innerHTML = y;
}
}`
inline ($|):
String -> String -> String -> JS {}
selector $| rule value = `$(selector).css(rule, value)`
inline
($.): String -> String -> JS {}
($.) x y = `$(x).addClass(y)`
inline ($+): String -> String -> JS {}
| x y = `$(x).append(y)`
div: String -> JS String
| x = yield "<div id='`x`'/>"
move: HTML -> HTML -> JS a
| x y = `$(y.element).append($(x.element).detach())`
on_load: JS {} -> JS {}
| x = `window.addEventListener("load", x, false)`
inline stringify: a -> String | x = do! `JSON.stringify(x)`
inline (!!): Array a -> Num -> a | x y = do! `x[y]`
with_page: JS a -> JS a
| x = do old <- `$("body").clone()`
xx <- x
`$("body").replaceWith(old)`
return xxdo! with_page do "body" $= "Test" text <- get "body" text <- text.inner return (text == "Test")
do! d <- div "test1"
"body" $+ d
"#test1" $= "I am a test!"
text <- get "#test1"
text <- text.inner
"#test1" $= ""
return (text == "I am a test!")
inline split: String -> String -> Array String | y x = do! `x.split(y)`This is the initializer for prelude's console test suite.
console_runner: JS {} =
var is_error = 0
var report spec =
do! results <- `spec.results()`
passed <- `results.passed()`
if passed
then return {}
else let items = spec.results_.items_
desc = spec.description.split "__::__" !! 1
exp = stringify (items !! 0).expected
act = stringify (items !! 0).actual
let line = spec.description
|> split "__::__"
|> \x = x !! 0
|> split "_"
|> \x = x !! 0
|> \x = do! `parseInt x`
|> \x = x + 1
|> stringify
do if is_error == 0
then log "\r "
else return {}
`is_error = 1`
log "Test failed at line `line`
`desc`
Expected `exp`
Actual `act`"
log ""
var reporter = { reportSpecResults: report
reportRunnerResults: `phantom.exit(is_error)` }
do env <- `jasmine.getEnv()`
`env.addReporter(reporter)`
`env.execute()`
push : a -> Array a -> JS (Array a)
push xs x = `xs.push(x)`
private console_reporter = {
total = 0
failed = 0
messages = []
reportSpecResults spec =
do! results <- `spec.results()`
passed <- `results.passed()`
`console_reporter.total++`
if not passed then do
`console_reporter.failed++`
push console_reporter.messages spec.description
return {}
else return {}
reportRunnerResults =
do if console_reporter.failed > 0
log console_reporter.messages
else
return {}
log "`console_reporter.total - console_reporter.failed`/`console_reporter.total` tests passed"
}This is the initializer for prelude's HTML test suite.
table_of_contents =
on_load do "code" $. "prettyprint"
"code" $. "lang-hs"
".test" $| "position" <| "relative"
".test" $| "left" <| "50px"
`prettyPrint()`
trivial <- `new jasmine.TrivialReporter()`
formal <- `new jasmine.FormalReporter()`
env <- `jasmine.getEnv()`
`env.addReporter trivial`
`env.addReporter formal`
`env.addReporter console_reporter`
`env.execute()`
reporter <- get ".jasmine_reporter"
body <- get "#test_suite"
move reporter bodyA simple implementation of a library for manipulating linked lists.
module list
List a = { head: a, tail: List a }
| { nil }This complex type can be hidden behind a constructor function which works more like a traditional cons.
inline
x :: y = { head = x, tail = y }The compiler itself also supports the list sugar [: 1, 2, 3 ] (or [: 1, 2, 3 :], if you prefer symmetry). All of these lists are synonyms.
var xs = [:
[:1,2,3]
[:1,2,3:]
(1::2::3::{nil})
{ head = 1
tail = { head = 2
tail = { head = 3
tail = {nil} }}}
]
all? (λy = [:1,2,3] == y) xs Simple implementations of list accessors, which illustrate incomplete definition.
empty? { nil } = true | _ = false
head { head: x, tail: _ } = x
| { nil } = error "Head called on empty list"
tail { head: _, tail: x } = x
| { nil } = error "Tail called on empty list"
last { head: x, tail: { nil } } = x
last { head: _, tail: x } = last x
last { nil } = error "Last called on empty list"
take 0 x = { nil } | n x = head x :: take (n - 1) (tail x)
drop 0 x = x | n x = drop (n - 1) (tail x)
x .. y =
let f xx z when xx >= x = f (xx - 1) (xx :: z)
f _ z = z
f y {nil}
1 .. 5 == [:1,2,3,4,5]Project Euler problem 1, modified to protect the innocent:
288045 == 1 .. 1111 |> filter (λx = x % 3 == 0 || x % 5 == 0) |> sum
take_while f { nil } = { nil }
| f x when f (head x) = head x :: filter f (tail x)
| _ _ = { nil }
drop_while f { nil } = { nil }
| f x when f (head x) = drop_while f (tail x)
| _ x = x
not (empty? (1 :: {nil}))
empty? [:]
head [: 1, 2 ] is 1
tail [: 1, 2 ] is [:2]
last [: 1, 2 ] is 2
err (lazy head {nil}) is "Head called on empty list"
err (lazy tail {nil}) is "Tail called on empty list"
err (lazy last {nil}) is "Last called on empty list"
take(2, [: 1, 2, 3 ]) == [: 1, 2 ]
drop(2, [: 1, 2, 3 ]) == [: 3 ]
take_while (λx = x < 0) [:] == [:]
take_while (λx = x > 0) [: 2, 1, 0 ] == [: 2, 1 ]
drop_while (λx = x < 0) {nil} == {nil}
drop_while (λx = x > 0) [: 2, 1, 0 ] == [: 0 ]Cardinality
length
| {nil} = 0
| {head: _, tail: x} = 1 + length x
length [: 1, 2, 3, 4 ] == 4Generators
init 0 _ = {nil}
| n x = x :: init (n - 1) x
length (init 30 0) == 30
tail (init 3 0) == init 2 0List concatenation
(++)
| {nil} y = y
| {head: y, tail: ys} xs = y :: (ys ++ xs)
{nil} ++ (1 :: 2 :: {nil}) == 1 :: 2 :: {nil}
[: 1, 2 ] ++ [: 3, 4 ] == [: 1, 2, 3, 4 ]Filter.
filter: (a -> Bool) -> List a -> List a
| f {nil} = {nil}
| f x when f (head x) = head x :: filter f (tail x)
| f x = filter f <| tail x
[: 1, 2, 3, 4 ] 'filter (λx = x > 2) == [: 3, 4 ]Map
map(f, {nil}) = {nil}
map(f, x) = f(head(x)) :: map(f, tail(x))
[: 2, 3, 4 ] == [: 1, 2, 3 ] |> map λx = x + 1Reverse
reverse y =
let r rest [:] = rest
r rest { head: x, tail: xs } =
r (x :: rest) xs
in r {nil} y
reverse [: 1, 2, 3, 4 ] == [: 4, 3, 2, 1 ]
var test_x = [: 1, 2, 3, 4 ]
test_x == reverse <| reverse test_x
take' x y =
let t(0, _, acc) = acc
t(n, x, acc) = t(n - 1, tail x, head x :: acc)
in reverse t(x, y, {nil})
var x = [: 1, 2, 3, 4, 5, 6, 7, 8 ]
take 5 x == take' 5 xFolds
foldl f x xs =
var g y {nil} = y
| y { head: z, tail: zs } = g (f y z) zs
g x xs
foldl1 _ {nil} = error "Foldl1 called on empty list"
| f x = foldl f (head x) (tail x)
foldr f x =
var g {nil} = x
g { head: y, tail: ys } = f y (g ys)
g
foldr1 _ {nil} = error "Foldr1 called on empty list"
| f x = foldr f (head x) (tail x)
all? f = foldl1 (λx y = x && y) .: map f
any? f = foldl1 (λx y = x || y) .: map f
sum = foldl1 λ(x, y) = x + y
product = foldl1 λ(x, y) = x * y
concat = foldl1 λx y = x ++ y
concat_map f xs = concat (map f xs)
maximum = foldl1 λ(x, y) when x > y = x
|(_, y) = y
minimum = foldl1 λx y = if x > y then y else x
foldl (λx y = x + y) 0 [: 1, 2, 3, 4 ] == 10
foldr (λx y = x + y) 0 [: 1, 2, 3, 4 ] == 10
all? id [:true,true]
not (all? id [:true,false])
any? id [:true,false]
not (any? id [:false,false])
sum [:1,2,3] == 6
product [:1,2,4] == 8
let x = [:1,2], y = [:3,4]
concat [:x,y] == [:1,2,3,4]
concat_map (λx = [:x,x+1]) [:1,2] == [:1,2,2,3]
minimum [: 1, 2, 3 ] == 1
maximum [: 1, 2, 3 ] == 3Sequences are an abstract data type which resembles a list, except that elements Sequences may be infinite, as long as you never try to read every element. However, the current implementation is stack-consuming and thus limited by the underlying javascript runtime [TODO].
module seq
open list
open speedtest
open html
Seq a = { seq: JS { elem: a, next: Seq a}}
| { end }
inline seq x = {seq: x}
iterate f x = seq yield { elem: x, next: iterate f (f x) }
from_list {nil} = {end}
| { head: x, tail: xs } =
{ seq: yield { elem: x, next: from_list xs }}
to_list { end } = {nil}
| { seq: x } = do! { elem: y, next: ys } <- x
return (y :: to_list ys)
take _ {end} = {end}
| 0 _ = {end}
| x { seq: y } = seq do { elem: z, next: zs } <- y
return { elem: z, next: take (x - 1) zs }
to_list (from_list [:1,2]) == [:1,2]
iterate (λx = x + 1) 0 |> take 100 |> to_list |> length == 100
zip_with:
(a -> b -> c) -> Seq a -> Seq b -> Seq c
| _ {end} _____ = {end}
| _ _____ {end} = {end}
| f {seq: a} {seq: b} = seq do
{ elem: xx, next: xs } <- a
{ elem: yy, next: ys } <- b
return { elem: f xx yy, next: zip_with f xs ys }
inline x ::: y = seq yield { elem: x, next: do! y }
tail:
Seq a -> Seq a
| {end} = error "tail called on empty seq"
| {seq: t} = do! t >>= λx = return x.next
to_lazy
| {end} = {end}
| {seq: y} = seq lazy do!
{elem: x, next: xs} <- y
return {elem: x, next: to_lazy xs}Infinite sequence example
fibs = to_lazy <: 1 ::: return <: 1 ::: yield zip_with (λx y = x + y) fibs <: tail fibsSince the lazy keyword memoizes it's argument, this fibonacci implementation is ridiculously faster than the recursive version. For example, the runtime speed of this fib implementation compared to the native recursive one is __________%.
do! fast_time <- time yield fast_fib 30
slow_time <- time yield fibs |> take 30 |> to_list |> last
let ratio = floor (fast_time / slow_time * 100)
"#speedtest" $= ratio
return (ratio >= 2)
fibs |> take 5 |> to_list == [:1,1,2,3,5]
fast_fib 15 == fibs |> take 15
|> to_list
|> lastDemonstration of some classic FP data structures. This form of polymorphism can be simulated in Formal the same way they are implemented in Haskell - as a function dictionary, the only difference being that you must explicitly bind the dictionary instance to a symbol (as opposed to it being referenced by the type variable's instantiation).
module "Formal Z"
open list
Functor f =
{ map: (a -> b) -> f a -> f b }
Monad m =
{ (>>=): m a -> (a -> m b) -> m b
ret: a -> m a }
map z x f = z.map f x
bind { ret: f, _ } x = f x
list_functor =
{ map _ {nil} = {nil}
| f { head: x, tail: xs } =
{ head: f x
tail: list_functor.map f xs }}
list_monad =
{ (>>=) x g = concat_map g x
return x = [:x] }
js_monad =
{ (>>=) x f = x >>= f
return x = return x }
let (>>>=) x g = concat_map g x
z = 1..3 >>>= λx = [:x,x+1,x+2]
z == [:1,2,3,2,3,4,3,4,5]module parsec
open prelude
open prelude.option
open prelude.string
open prelude.html
Parser a = {parser: String -> {rest: String, parsed: Option a}}
inline run_parser:Runs a parser over a text argument and throws away the leftover text.
Parser p -> String -> Option p
| {parser = p} x = p x |> λ {parsed = {some = y}, _} = {some = y}
| _ = {none}
inline (<$>):Applies a function to the parse result, only if the parse was successful.
(a -> b) -> Parser a -> Parser b
f <$> {parser = z} =
{ parser s =
z s |> λ {parsed = {some: x}, rest = ss} =
{parsed = {some = f x}, rest = ss}
| {parsed = {none}, rest = x} =
{parsed = {none}, rest = x} }
inline (<*>):Allows functions that take multiple arguments to be applied sequentially to a sequence of parsed values.
Parser (a -> b) -> Parser a -> Parser b
{parser = fp} <*> {parser = p} =
{ parser s =
fp s |> λ {parsed = {some: f}, rest = rr} =
p rr |> λ {parsed = {some = x}, rest = z} =
{parsed = {some = f x}, rest = z}
| {parsed = {none}, rest = x} =
{parsed = {none}, rest = x}
| {parsed: {none}, rest: x} =
{parsed: {none}, rest: x} }
private inline lift(g, {parser: f}) =
{ parser text =
let f' = f text
in g { text: text
f: f
parsed: f'.parsed
rest: f'.rest
f': f' }}
inline (*>):Applies two parsers in sequence, throwing out the result of the first.
Parser a -> Parser b -> Parser b
{parser = f} *> {parser = g} =
{ parser s =
f s |> λ {parsed = {some = x}, rest = zz} = g zz
| {parsed = {none}, rest = x} =
{parsed = {none}, rest = x} }
inline (<|>):Alternative will try the first parser, and applies the second only if the first fails and consumes no input from the text.
Parser a -> Parser a -> Parser a
{parser = f} <|> {parser = g} =
let h text {parsed = {none}, rest = textt} when text == textt =
g text
| _ x = x
in {parser text = h text (f text)}
inline try':Tries to apply a parser, but restores the parser state in the case of a failure. This is useful with combinators that check the state of the consumed text, like <|>
Parser a -> Parser a
= lift λ (x & {_, parsed: {none}}) =
{parsed: {none}, rest: x.text}
| x = x.f'
inline string:A parser that matches a string. Unlike Haskell's Parsec library, parsec.formal will not consume any input if the entire string doesn't match. This is for efficiency reasons currently, but may change in the future.
String -> Parser String
| x = { parser y =
let sub = do! `y.substring(0, x.length)`
if (sub == x)
{ rest = do! `y.substring(x.length)`
parsed = {some = x} }
else {rest = y, parsed = {none}} }
inline push! : x -> Array x -> Array x
| x xs = do! `xs.unshift(x); xs`
many:Applies a parser repeatedly, until parsing fails.
Parser a -> Parser (Array a)
= lift λ (x & {_, parsed: {none}}) =
{parsed: {some: []}, rest = x.rest}
| (y & {_, parsed: {some: x}}) =
(push! x <$> many {parser: y.f}).parser y.rest
module "Testing"
{some = "ten"} == run_parser (string "ten") "tens"
{some = "tenten"} == run_parser ((λx = x +++ x) <$> string "ten") "tenfingers"
{parsed = {some = "tenten"}, rest = "fingers"}
== ((λx = x +++ x) <$> string "ten").parser "tenfingers"
var result = run_parser ((λx y = y +++ x) <$> string "ten" <*> string "fingers") "tenfingers"
result == {some: "fingersten"}
var result = run_parser (string "ten" <|> string "eleven") "eleven"
result == {some: "eleven"}
var result = run_parser (string "ten" *> string "fingers") "tenfingers"
result == {some: "fingers"}
var parser = (string "ten" *> string "fingers") <|> string "tentoes"
result = run_parser parser "tentoes"
result == {none}
var parser = try' (string "ten" *> string "fingers") <|> string "tentoes"
result = run_parser parser "tentoes"
result == {some: "tentoes"}
var parser = many (string "ten")
result = run_parser parser "tententententen"
result == {some: ["ten", "ten", "ten", "ten", "ten"]}A collection of tests for compiler bugs, benchmarking, etc.
A collection of simple benchmarks. You can view the results by opening your browser's terminal.
module "Benchmarks for the prelude"
title x =
do log "\r "
log x
return true
open prelude
open prelude.speedtest
open prelude.list
open prelude.stringHere we have 5 implementations of (Project Euler problem #1)[http://projecteuler.net/problem=1]. The first is simply a native JS implementation.
euler_1 x = `var sum = 0;
for (var i = 1; i < x; i++) {
if (i % 3 == 0 || i % 5 == 0) sum += i;
};
return sum;`The second is a tail recursive. The formal compiler will optimize simple functions which are tail recursive into javascript for loops automatically, making them much faster.
euler_2 x y when x < 3 = y
| x y when x % 3 == 0 || x % 5 == 0 =
euler_2 (x - 1) (y + 1)
| x y = euler_2 (x - 1) y
euler_3 x when x < 3 = 0
euler_3 x = if x % 3 == 0 || x % 5 == 0
then 1 + euler_3 (x - 1)
else euler_3 (x - 1)
euler_4 z = yield 1 .. z
|> filter (λx = x % 3 == 0 || x % 5 == 0)
|> sum
euler_5 x y when x < 3 = y
| x y when do! `x % 3 == 0 || x % 5 == 0` =
euler_5 (x - 1) (y + 1)
| x y = euler_5 (x - 1) y
do! title "Relative Speeds (10k)"
w <- time (euler_1 10000)
x <- time yield euler_2 10000 0
y <- time yield euler_3 10000
z <- time (euler_4 10000)
q <- time yield euler_5 10000 0
log " Native JS: `w / 1000`s"
log " Formal TCO Unboxed: `q / 1000`s"
log " Formal TCO: `x / 1000`s"
log " Formal Recursive: `y / 1000`s"
log " Formal list: `z / 1000`s"
return <| (x <= y && y < z)
string? (err yield euler_3(250000)).message
do! title "Relative Speeds (2.5M)"
w <- time (euler_1 2500000)
x <- time yield euler_2 2500000 0
y <- time yield euler_5 2500000 0
log " Native JS: `w / 1000`s"
log " Formal TCO Unboxed: `y / 1000`s"
log " Formal TCO: `x / 1000`s"
log " Formal Recursive: `err yield euler_3(250000)`"
log " Formal list: `err (euler_4 250000)`"
log ""
return <| (w < x)
module "Tests for partial records"
open prelude
var f {a: x, b: y, _ } = x + y
f { a: 5, b: 5, c: 5 } == f { a: 5, b: 5, d: 5 }
var f {a: 1, b: 1, _ } = 2
f {b: 2, c: 2, _ } = 2
f {a:1,b:1,c:3,d:5} + f {a:1,b:2,c:2,e:5} == 4
var f { a = 1, b = 2, _ } = 1
g { b = 2, c = 3, _ } = 2
x = { a = 1, b = 2, c = 3, d = 4 }
f x + 1 == g x
module "Tests for TCO bugs"
open prelude
open prelude.list
rev_1 y =
var r rest [:] = rest
| rest { head: x, tail: xs } =
r (x :: rest) xs
r {nil} y
rev_2 =
var rrr rest [:] = rest
rrr rest { head: x, tail: xs } =
rrr (x :: rest) xs
rrr {nil}
rev_2 [: 1, 2, 3, 4 ] == [: 4, 3, 2, 1 ]
test_x = [: 1, 2, 3, 4, 5, 6, 7 ]
rev_2 test_x == rev_1 test_x
rev_1 test_x == reverse test_x
length (rev_2 test_x) == length (rev_1 test_x)
length (rev_2 test_x) == length test_x
length (rev_1 test_x) == length (reverse test_x)
module "Tests for parser bugs"
open prelude
open prelude.string
open prelude.html
var x = do! `[ { x: 1}, {x: 2}, {x: 3} ]`
stringify (x !! 0).x == "1"