packages feed

forml 0.1.1 → 0.1.2

raw patch · 22 files changed

+796/−179 lines, 22 filesdep ~jmacro

Dependency ranges changed: jmacro

Files

forml.cabal view
@@ -1,5 +1,5 @@ Name:                forml-Version:             0.1.1+Version:             0.1.2 Synopsis:            A statically typed, functional programming language  License:             MIT Author:              Andrew Stein@@ -23,6 +23,7 @@                      src/forml/readme.forml,                       src/html/footer.html,                       src/html/header.html, +                     src/html/styles.css,                      src/js/FormlReporter.js homepage:            http://texodus.github.com/forml @@ -38,7 +39,7 @@     indents,     containers,     pandoc,-    jmacro,+    jmacro == 0.6.2,     MissingH,     interpolatedstring-perl6,     transformers,
src/forml/prelude.forml view
@@ -17,6 +17,8 @@     inline array?    = do! `is_array`     inline string? x = do! `typeof x === "string"` +    inline cast: _ -> _ | x = do! `x`+     inline     num? x = do! `typeof x == "number"` @@ -223,9 +225,16 @@         inline strip:  String -> String | = lstrip .: rstrip          length: String -> Num | n = do! `n.length`+        +        -- TODO concat cannot be inlined because it shadows concat+        -- in other modules, and inlines currently do not respect+        -- shadows.+        +        concat: Array String -> String+        concat xs = do! `xs.join("")`          inline -        (+++): a -> b -> String+        (+++): _ -> _ -> String         x +++ y = do! `"" + x + y`          strip "    test    " is "test"@@ -285,7 +294,7 @@          inline ($=): -           String -> a -> JS {}+           String -> _ -> JS {}            x      $= y  =               `if (typeof $ != "undefined") {@@ -310,13 +319,13 @@         div: String -> JS String             | x = yield "<div id='`x`'/>" -        move: HTML -> HTML -> JS a+        move: HTML -> HTML -> JS _             | 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 stringify: _ -> String | x = do! `JSON.stringify(x)`          inline (!!): Array a -> Num -> a | x y = do! `x[y]` @@ -459,11 +468,78 @@                body     <- get "#test_suite"                 move reporter body+               +    -- Arrays+    -- ------      module array     -        inline push! : x -> Array x -> Array x-        | x xs = do! `xs.unshift(x); xs`+        type UnboxedArray x = {+            unshift: x -> Num+            push:    x -> Num+            length:  Num+            map:     (x -> y) -> Array y+            forEach: (x -> _) -> {}+        }+        +        private inline unbox: Array a -> UnboxedArray a = cast+        private inline box:   UnboxedArray a -> Array a = cast+           +        private inline+        chain f xs =+        +            let _ = f (unbox xs)+            in  xs++        inline length     = .length .: unbox+        inline map f      = .map f  .: unbox+        inline push! x    = chain (.push x)+        inline unshift! x = chain (.unshift x)+        +        inline get: Num -> Array x -> x+            | x xs = do! `xs[x]`++        inline set: Num -> a -> Array a -> JS (Array a)+            | idx i arr = `arr[idx] = i; return arr`+        +        inline sequence: Array (JS a) -> JS (Array a)+            | xs = `xs.map(run)`+        +        inline (..): Num -> Num -> Array Num +            x .. y = do! `var z = [];+                          for (var i = x; i <= y; i++) z.push(i);+                          return z` +        +        inline put: a -> Array a -> JS (Array a)+            | x xs =+                 +                 do y <- `jQuery.extend(true,[],xs)`+                    yield push! x y+        +        inline+        for_each: (Num -> _) -> Array _ -> JS {}+            | f xs = `for (x in xs) { f(x); }`+        +        inline+        zip_with: (a -> b -> c) -> Array a -> Array b -> Array c+        zip_with f xs ys =+        +            let z   = []+                h m = m ys 'f (m xs) +                g   = flip push! z .: h .: get+        +            in  do! xs 'for_each g+                    yield z +                 +        let x = []+            _ = push! 1 x+        x == [1]++        [1, 2, 3] == do! put 3 [1, 2]+                +        map (.x) [{x: 1}, {x: 2}] == [1, 2]+    +        zip_with (\x y = x + y) [1, 2, 3] [3, 2, 1] == [4, 4, 4]   
src/forml/readme.forml view
@@ -1,30 +1,35 @@ -- Forml--- -----+-- =====  -- <script type="text/javascript"> -- $("header ul").prepend('<li><a href="https://github.com/texodus/forml/zipball/master">Download <strong>ZIP File</strong></a></li><li><a href="https://github.com/texodus/forml/tarball/master">Download <strong>TAR Ball</strong></a></li><li><a href="https://github.com/texodus/forml">View On <strong>GitHub</strong></a></li>').css("width", "360");--- $("header h1").after('<p></p><p class="view"><a href="https://github.com/texodus/forml">View the Project on GitHub <small>texodus/forml</small></a></p><br style="clear: both;"/>');+-- $("header h1").after('<br style="clear: both;"/>');+-- $("h1").css("font-family", "Montserrat");+-- $("header h1:first-letter").css("color", "#E53007");++ -- </script> --- Forml is an modern programming language for the discriminating--- programmer.  More importantly, forml is my vanity project, an--- attempt to learn ML by writing one.  +-- Forml is a contemporary programming language for the discriminating+-- programmer, intended to fill a niche+-- somewhere between [Haskell](http://www.haskell.org) and+-- [Ruby](http://www.ruby.org), should such a niche turn out to exist.   -- Philosophy--- ----------+-- ========== ---     1) Writing software is unnecessarily hard, because the language's---        syntax treats the programmer like a machine.  A modern programming---        language should be read and written for programmers - a philosophy---        lifted unapologetically from [Ruby](http://www.artima.com/intv/ruby4.html).+--     1) Writing software is unnecessarily hard, because syntax is sufficiently+--        abstracted from thought process to lose something in the translation. A +--        modern programming language should be designed for reading - an API +--        exposing the programmer - a philosophy lifted unapologetically+--        from [Ruby](http://www.artima.com/intv/ruby4.html). ---     2) Writing software is unnecessarily hard, because the language---        lets the programmer make mistakes.  A modern programming language---        should prevent the programmer from writing incorrect code, in so far---        as it never conflicts with #1.+--     2) Writing software is unnecessarily hard, because making mistakes is too+--        easy. A modern programming language should prevent the programmer from+--        writing incorrect code, in so far as it doesn't conflict with 1.  -- Features--- --------+-- ========  --   * Buzzwords:  functional, strict, expressive, pure(ish), static(y), inferred, fast, fun. --     Strong like a gorilla, yet soft and yielding like a Nerf ball.@@ -58,20 +63,20 @@ --        , [Ruby](http://www.ruby-lang.org/en/)  -- Installation--- ------------+-- ============  -- Mac OSX (tested on Snow Leopard & Lion).  Note that Forml also requires--- [Closure](https://developers.google.com/closure/)for optimizations and+-- [Closure](https://developers.google.com/closure/) for optimizations and -- either [Phantom.js](http://phantomjs.org) or [Node.js](http://nodejs.org)  -- Install the -- [Haskell Platform](http://hackage.haskell.org/platform/index.html), then ---        <pre><code>--$ cabal install forml</pre></code>+--        <pre><code>$ cabal install forml</pre></code>  -- To compile some forml files:    ---        <pre><code>--$ forml -o app test.forml test2.forml</pre></code>+--        <pre><code>$ forml -o app test.forml test2.forml</pre></code>  -- will create an app.js and app.spec.js with the compiled code and -- test suite respectively.@@ -84,32 +89,32 @@ -- which it expects to find on your PATH.  You may optionally specifiy to run your suite -- via node.js with ---        <pre><code>--$ forml -node-test test.forml</pre></code>+--        <pre><code>$ forml -node-test test.forml</pre></code>  -- To compile literate -- forml (eg, Forml code embedded in Markdown):    ---        <pre><code>--$ forml test.lforml</pre></code>+--        <pre><code>$ forml test.lforml</pre></code>     -- To see the inferred types:    ---        <pre><code>--$ forml -t test.forml</pre></code>+--        <pre><code>$ forml -t test.forml</pre></code>     -- To turn off optimizing (eg, Closure) or testing:    ---        <pre><code>--$ forml -no-test -no-opt test.forml</pre></code>+--        <pre><code>$ forml -no-test -no-opt test.forml</pre></code>  -- To watch a file for changes and incrementally compile:    ---        <pre><code>--$ forml -w test.forml</pre></code>+--        <pre><code>$ forml -w test.forml</pre></code> --- To generate an HTML (like this one!) and test suite:+-- To generate documentation and test runner (like this file):    ---        <pre><code>--$ forml -docs test.forml</pre></code>+--        <pre><code>$ forml -docs test.forml</pre></code>   -- Tutorial--- --------+-- ======== -- This is unfortunately not comprehensive, and presumes some working knowledge of  -- ML or Haskell.  For more examples, see the annotated  -- [prelude](http://texodus.github.com/forml/Prelude)@@ -118,16 +123,20 @@ -- Forml supports a flexible, forgiving syntax that supports many synonymous forms. -- This will be illustrated by adherring to an entirely random, arbitrary style throughout. --- All forml programs must reside in a module.--- Within a module, the compiler recognizes logical sections divided by --- `open` statements and sub modules.  Within a section, declarations+-- The basic unit of code organization in forml is the `module`, which is simply+-- a collection of definitions in a namespace (see [Modules](#)).+-- Within a module, the compiler recognizes strictly ordered logical sections divided by +-- `open` statements and sub modules;  within a section, however, declarations -- can be in any order.  module readme      open prelude     open prelude.string-+    +    -- Definitions+    -- -----------+         -- Simple function.  Forml allows functions to be written in ML style, or     -- in more traditional java style. @@ -140,9 +149,10 @@     fib 0 = 0 | 1 = 1 | n = fib (n - 1) + fib (n - 2)      -- Patterns can be separated with `|`, or by repeating the definition's-    -- name ala Haskell.  Definitions can have optional type annotations and-    -- assertions (which are compiled separately from your application code).-+    -- name ala Haskell.  Definitions can have optional type annotations, which+    -- may restrict the inferred type of the definition, but must not be+    -- more general+         private      fib' : Num -> Num@@ -150,9 +160,65 @@     fib' 0 = 0     fib' 1 = 1     fib' n = fib' (n - 1) + fib' (n - 2)+    +    -- Operators can be defined much like in Haskell.  Precedence is currently fixed,+    -- though you can declare right associative operators by ending them with a `:`.+    -- For performance, you can declare functions to be `inline`.  This example+    -- will compile to a loop, as it is tail recursive. +    inline (**): ++         String -> Num -> String+         text   ** n    =++             var f(_, 0, acc) = acc       -- `let` and `var` are synonyms+                 f(text, n, acc) =+                     f(text, n - 1, acc +++ text)+             +             in f(text, n, "")            -- `in` is optional+    ++    -- Testing+    -- -------+    +    -- Tests are a first class concept in forml - any unbound in a module (or in other words, +    -- any expression which isn't part of a definition), which is inferred as type `Bool`,+    -- is treated as a test, and is compiled+    -- to a [Jasmine](http://pivotal.github.com/jasmine) suite in a separate file from+    -- your definitions.  +     fib' 7 == 13     fib' 0 == 0+    +    "hello" ** 3 == "hellohellohello"+    length ("a" ** 10000) == 10000+    +    -- For example, this file is the result of running the forml compiler with the `-docs`+    -- flag for [readme.forml](https://github.com/texodus/forml/blob/master/src/forml/readme.forml),+    -- and incorporates both the compiled output and the Jasmine suite.  You can execute+    -- this suite by clicking the `RUN TESTS` button, which will highlight the test+    -- results in this document+    +    +    -- Modules+    -- -------+    +    -- Namespaces are not symbols, so this won't work:+    +    --        <pre><code>    prelude.log "Hello, World!"    -- Won't compile!</pre></code>+    +    -- Instead, you must qualify the import and supply +    -- a symbol name to bind to.  The alias will be typed+    -- to a record whose fields are the first-class +    -- definitions in the module.+    +    open prelude.array as array+    +    array.map fib [3,4,5] == [2,3,5]+    +    +    -- Records+    -- -------      -- Forml has the basic primative types from Javascript:  Num, String, Bool;  plus     -- a record, which is structurally typed and implemented as a simple Javascript object.@@ -176,26 +242,7 @@     magnitude {x: 3, y: 4, other: "test"} == 5     magnitude {x: 4, y: 3, test: "other"} == 5 -    -- Operators can be defined much like in Haskell.  Precedence is currently fixed,-    -- though you can declare right associative operators by ending them with a `:`.-    -- For performance, you can declare functions to be `inline`.  This example-    -- will compile to a loop, as it is tail recursive.--    inline (**): --         String -> Num -> String-         text   ** n    =--             var f(_, 0, acc) = acc       -- `let` and `var` are synonyms-                 f(text, n, acc) =-                     f(text, n - 1, acc +++ text)-             -             in f(text, n, "")            -- `in` is optional---    "hello" ** 3 == "hellohellohello"-    length ("a" ** 10000) == 10000-+      -- Anonymous functions also follow Haskell, can be written with `\` or `λ`, and     -- allows pattern seperation via `|` @@ -204,12 +251,14 @@     map!: (a -> b) -> Array a -> Array b     map! f xs = do! `xs.map(f)` -    let fil = λ x when x > 5 = x-              | x            = 5+    let fil =+    +        λ x when x > 5 = x+        | x            = 5      map! fil [2, 6, 3, 7] is [5, 6, 5, 7] -    -- Interop / Side Effects+    -- Interop & Side Effects     -- ----------------------     -- Forml technically allows unrestricted side effects, but by default     -- wraps them in a `JS a` type, which can be composed with the@@ -244,27 +293,38 @@     -- Types, Aliases & Unions     -- ----------------------- -    -- Forml lacks algebraic data types in the ML sense, instead opting for-    -- only structural typing of records.  However, you can add explicit type-    -- signatures to tell the Forml compiler it is OK to overload the types-    -- of specific symbols.-+    -- Forml is strong & statically typed, and will infer types for most symbols+    -- via Damas-Hindley-Milner inferrence.  +    +    increment x = x + 1    -- inferred as `increment: Num -> Num`+    +    -- +          num_or_string:            (Num | String) -> String         | x when num? x   = "Num"         | _               = "String" -    -- You can also gives union types such as these an alias, effectively allowing+    -- Types may be given a polymorphic alias in much the same way you'd +    -- define a function.++    Maybe a = {just: a} | {nothing}++    -- Once a type such as this has a name, you may even refer to it recursively++    LinkedList a = { head: a, tail: LinkedList a }+    +    -- +     -- algebraic data types to be declared in a local scope, for all     -- records which are structurally equivalent to those declared.  For instance,     -- we could declare a `Maybe a` ADT in forml via   -    Maybe a = {just: a} | {nothing}      -- ... where `{nothing}` is shorthand for the strucural type `{nothing: {}}`.-    -- Any scope which imports the alias `Maybe a` will now allow values which-    -- can be typed both a `{just: a}` or `{nothing}` record+    -- When `Maybe a` is in scope, any record type with only the `just` or `nothing`+    -- keys will be inferred to be a type `Maybe a`.          maybe x {just: y} = y     maybe x {nothing} = x@@ -283,7 +343,18 @@     not (has_value {nothing})          -- Changes-    -- -------+    -- =======+    +    -- 0.1.2+    +    -- * Added accessor function syntax for treating record fields+    --   as functions (eg `x.map f == x |> .map f`)+    -- * Added `_` as valid type variable for throwaway unique types.+    -- * Module aliases allow binding a module to+    --   a structurally typed symbol (eg `open prelude.list as list`).+    -- * Prelude expanded, with special attention to the `array` module.+    -- * Embedded prelude tests are skipped.+    -- * Bug fixes.          -- 0.1.1 
src/hs/Forml/Closure.hs view
@@ -40,7 +40,7 @@                                 writeFile "temp.js" x                                 system$ "java -jar $CLOSURE --compilation_level "                                           ++ y -                                       --   ++ " --formatting=pretty_print --formatting=print_input_delimiter "+                                          ++ " --formatting=pretty_print --formatting=print_input_delimiter "                                           ++ " --js temp.js --warning_level QUIET > temp.compiled.js"                                 js <- readFile "temp.compiled.js"                                 system "rm temp.js"
src/hs/Forml/Doc.hs view
@@ -49,6 +49,8 @@ get_title d x = case lines x of                   z @ ((strip -> ('-':'-':_:x')):('-':'-':_:'-':_):_) ->                       (x', unlines $ drop 2 z)+                  z @ ((strip -> ('-':'-':_:x')):('-':'-':_:'=':_):_) ->+                      (x', unlines $ drop 2 z)                   _ -> (d, x)  @@ -60,7 +62,7 @@        filename = [qq|$title.html|]       compiled = [qq|<script>$js $tests</script>|]-      hook     = [qq|<script>$htmljs;window.document.title='{title}';$('h1').html('{title}')</script>|]+      hook     = [qq|<script>$htmljs;window.document.title='{title}';$('header h1').html('{title}')</script>|]    in  do monitor [qq|Docs {title}.html|] $             do writeFile filename $ concat [header, css', scripts, compiled, html, hook, footer]
src/hs/Forml/Javascript.hs view
@@ -32,7 +32,7 @@ instance Compress JStat where     comp (ReturnStat x)      = ReturnStat (comp x)     comp (IfStat a b c)      = IfStat (comp a) (comp b) (comp c)-    comp (WhileStat a b)     = WhileStat (comp a) (comp b)+    comp (WhileStat a b c)   = WhileStat a (comp b) (comp c)     comp (ForInStat a b c d) = ForInStat a b (comp c) (comp d)     comp (SwitchStat a b c)  = SwitchStat (comp a) (comp b) (comp c)     comp (TryStat a b c d)   = TryStat (comp a) b (comp c) (comp d)
src/hs/Forml/Optimize.hs view
@@ -43,12 +43,13 @@ import qualified Forml.Javascript.Utils as J  import Prelude hiding (curry)-+import Text.Parsec.Pos (newPos)  +data Inlineable = InlineSymbol Symbol | InlineRecord (Expression Definition) deriving (Eq) -type Inlines = [((Namespace, Symbol), (Match (Expression Definition), Expression Definition))]-type Inline  = [(Symbol, (Match (Expression Definition), Expression Definition))]+type Inlines = [((Namespace, Inlineable), (Match (Expression Definition), Expression Definition))]+type Inline  = [(Inlineable, (Match (Expression Definition), Expression Definition))]  data OptimizeState = OptimizeState { ns :: Namespace                                    , assumptions :: [(Namespace, [Assumption])]@@ -121,7 +122,7 @@     optimize (ApplyExpression f' @ (SymbolExpression f) args) =          do is <- get_env-           case f `lookup` is of+           case (InlineSymbol f) `lookup` is of              Just (m @ (Match pss _), ex) | length pss == length args ->                   do args' <- mapM optimize args@@ -131,8 +132,19 @@               _ -> ApplyExpression <$> optimize f' <*> mapM optimize args +    optimize (ApplyExpression a @ (AccessorExpression x xs) args) =+    +        do is <- get_env+           case (InlineRecord a) `lookup` is of+             Just (m @ (Match pss _), ex) | length pss == length args -> +                 do args' <- mapM optimize args+                    ex'   <- optimize ex+                    m'    <- optimize m+                    return $ ApplyExpression (FunctionExpression [EqualityAxiom m' (Addr undefined undefined ex')]) args' +             _ -> ApplyExpression <$> optimize a <*> mapM optimize args+     optimize (ApplyExpression f args) = ApplyExpression <$> optimize f <*> mapM optimize args     optimize (IfExpression a b c) = IfExpression <$> optimize a <*> optimize b <*> optimize c     optimize (LazyExpression x l) = flip LazyExpression l <$> optimize x@@ -176,8 +188,8 @@            is  <- get_inline            e   <- get_env            ns  <- get_namespace-           set_inline (((ns, name), (m, get_addr ex)) : is)-           set_env    ((name, (m, get_addr ex)) : e)+           set_inline (((ns, (InlineSymbol name)), (m, get_addr ex)) : is)+           set_env    ((InlineSymbol name, (m, get_addr ex)) : e)            return (Definition a True name [EqualityAxiom m ex])      optimize (Definition a True c (TypeAxiom _ : x)) = optimize (Definition a True c x)@@ -277,7 +289,7 @@            set_namespace ns            return$ ModuleStatement x xs' -    optimize ss @ (ImportStatement (Namespace x)) =+    optimize ss @ (ImportStatement (Namespace x) (Just alias)) =           do is <- get_inline            e  <- get_env@@ -287,10 +299,11 @@         where rfind (Namespace n) is e =                       case lookup' (Namespace x) is of+                        [] ->                             if length n > 0 && head n /= head x-                           then do optimize (ImportStatement (Namespace (head n : x)))+                           then do optimize (ImportStatement (Namespace (head n : x)) Nothing)                                    return ss                            else return ss @@ -302,8 +315,41 @@               cc (((_, s), ex): zs) = (s, ex) : cc zs               cc [] = [] -              lookup' x (((y, z), w):ys) | x == y = (((y, z), w) : lookup' x ys)-                                         | otherwise = lookup' x ys+              lookup' x (((y, (InlineSymbol z)), w):ys)+                  | x == y    = (((y, (InlineRecord (AccessorExpression (Addr  (newPos "Optimizer" 0 0) (newPos "Optimizer" 0 0) (SymbolExpression (Symbol alias))) [z]))), w) : lookup' x ys)+                  | otherwise = lookup' x ys+              lookup' _ [] = []+         +        +    optimize ss @ (ImportStatement (Namespace x) Nothing) =++        do is <- get_inline+           e  <- get_env+           n  <- get_namespace+           rfind n is e++        where rfind (Namespace n) is e =++                     case lookup' (Namespace x) is of++                       [] ->++                           if length n > 0 && head n /= head x+                           then do optimize (ImportStatement (Namespace (head n : x)) Nothing)+                                   return ss+                           else return ss++                       zs ->++                           do set_env $ cc zs ++ e+                              return ss++              cc (((_, s), ex): zs) = (s, ex) : cc zs+              cc [] = []++              lookup' x (((y, z), w):ys)+                  | x == y    = (((y, z), w) : lookup' x ys)+                  | otherwise = lookup' x ys               lookup' _ [] = []      optimize x = return x
src/hs/Forml/Parser/Utils.hs view
@@ -28,14 +28,13 @@ import Data.String.Utils  -import Text.Parsec.Prim hiding ((<|>), State, many, parse, label) import qualified Data.Text as T import System.IO.Unsafe (unsafePerformIO)    -data Addr a = Addr SourcePos SourcePos a+data Addr a = Addr SourcePos SourcePos a deriving (Eq)  instance Functor Addr where @@ -189,19 +188,25 @@ indentPairs :: String -> Parser a -> String -> Parser a not_comma   :: Parser () comma       :: Parser ()+optional_sep :: ParsecT T.Text () (StateT SourcePos Identity) ()  type_sep          = try (spaces *> char '|' <* whitespace) not_comma         = whitespace >> newline >> spaces >> notFollowedBy (string "}")-comma             = spaces *> string "," *> spaces+comma             = P.spaces *> string "," *> P.spaces optional_sep      = try (try comma <|> not_comma) -indentPairs a p b = string a *> P.spaces *> withPosTemp (withPos p) <* P.spaces <* string b+indentPairs a p b = string a *> P.spaces *> withPosTemp p <* P.spaces <* string b  indentAsymmetricPairs :: String -> Parser a -> Parser b -> Parser a-indentAsymmetricPairs a p b = string a *> P.spaces *> withPos p <* P.spaces <* b+indentAsymmetricPairs a p b = string a *> P.spaces *> withPosTemp p <* P.spaces <* b +withPosTemp :: Parser a -> Parser a withPosTemp p = do x <- get-                   try p <|> (put x >> parserFail ("expression continuation indented to " ++ show x))+                   p' <- try (Just <$> withPos p) <|> return Nothing+                   put x+                   case p' of+                     Just p' -> return p'+                     Nothing -> parserFail ("expression continuation indented to " ++ show x)   db :: Show a => a -> a
src/hs/Forml/TypeCheck.hs view
@@ -276,10 +276,20 @@               f _ = error "Fatal error occurred while reticulating splines"  -data BindGroup = Scope [Namespace] [Statement] [Definition] [[Definition]] [Addr (Expression Definition)]-               | Module String [BindGroup]-               deriving (Show)+data BindGroup = +    Scope {+         imports :: [(Namespace, Maybe String)],+         statements :: [Statement],+         explicits :: [Definition],+         implicits :: [[Definition]],+         tests :: [Addr (Expression Definition)]+     } ++   | Module String [BindGroup]++   deriving (Show)+ instance Infer Definition () where      infer (Definition _ _ name axs) =@@ -355,7 +365,7 @@                     Nothing -> sigs xs                     Just x -> g (h name) x ++ sigs xs -              import' (Namespace ns) =+              import' (Namespace ns, Nothing) =                    do z <- get_modules                      a <- get_assumptions@@ -363,9 +373,40 @@                      case Namespace ns `lookup` z of                        Just z' -> assume$ a ++ z'                        Nothing -> if length ns' > 0 && head ns' /= head ns-                                  then import' (Namespace (head ns' : ns))+                                  then import' (Namespace (head ns' : ns), Nothing)                                   else add_error$ "Unknown namespace " ++ show (Namespace ns) +              import' (Namespace ns, Just alias) =++                  do z <- get_modules+                     a <- get_assumptions+                     (Namespace ns') <- get_namespace+                     case Namespace ns `lookup` z of+                       Just z' -> +                           do record <- to_record z'+                              assume $ alias :>: record+                       Nothing -> if length ns' > 0 && head ns' /= head ns+                                  then import' (Namespace (head ns' : ns), Just alias)+                                  else add_error$ "Unknown namespace " ++ show (Namespace ns)+                                  +              to_record assumptions =+              +                  let f (_ :>: scheme) =++                          [ do (_ :=> t) <- freshInst scheme+                               return t ]++                      f _ = []+                      +                      g (i :>: _) = [i]+                      g _ = []+                      +                  in  do schemes <- sequence $ concat $ map f assumptions+                         let symbols = concat $ map g assumptions +                         let rec = TypeRecord (TRecord (M.fromList (zip symbols schemes)) TComplete Star)+                         return $ quantify (tv rec) ([] :=> rec)++               h (Symbol x) = x               h (Operator x) = x @@ -542,29 +583,29 @@  to_group :: [Statement] -> [BindGroup] to_group [] = []-to_group xs = case takeWhile not_module xs of-                [] -> to_group' xs-                yx -> sort_deps (foldl f (Scope [] [] [] [] []) yx)-                      : to_group' (dropWhile not_module xs)+to_group xs = +    case takeWhile not_module xs of+        [] -> to_group' xs+        yx -> sort_deps (foldl f (Scope [] [] [] [] []) yx)+                   : to_group' (dropWhile not_module xs)+     where to_group' [] = []-          to_group' (ModuleStatement x y:xs) = Module (show x) (to_group y) : to_group xs+          to_group' (ModuleStatement x y:ys) = Module (show x) (to_group y) : to_group ys           to_group' _ = error "Unexpected" -          sort_deps (Scope i t a b c) = Scope i t a (sort_dep b) c+          sort_deps s @ Scope { implicits = b } = s { implicits = sort_dep b }            not_module (ModuleStatement _ _) = False           not_module _ = True -          f (Scope i t a b c) (DefinitionStatement x @ (Definition _ _ _ (EqualityAxiom _ _:_))) =-              Scope i t a (b ++ [[x]]) c-          f (Scope i t a b c) (DefinitionStatement x @ (Definition _ _ _ (TypeAxiom _:_))) =-              Scope i t (a ++ [x]) b c-          f (Scope i t a b c) (ExpressionStatement x) =-              Scope i t a b (c ++ [x])-          f (Scope i t a b c) (ImportStatement ns) =-              Scope (i ++ [ns]) t a b c-          f (Scope i t a b c) x @ (TypeStatement _ _) =-              Scope i (t ++ [x]) a b c+          f s @ Scope { implicits = b} (DefinitionStatement x @ (Definition _ _ _ (EqualityAxiom _ _:_))) =+              s { implicits = b ++ [[x]] }+          f s @ Scope { explicits = a} (DefinitionStatement x @ (Definition _ _ _ (TypeAxiom _:_))) =+              s { explicits = a ++ [x] }+          f s @ Scope { tests = c } (ExpressionStatement x) = s { tests = c ++ [x] }+          f s @ Scope { imports = i } (ImportStatement ns Nothing) = s { imports = i ++ [(ns, Nothing)] }+          f s @ Scope { imports = i } (ImportStatement ns (Just alias)) = s { imports = i ++ [(ns, Just alias)] }+          f s @ Scope { statements = t } x @ (TypeStatement _ _) = s { statements = t ++ [x] }           f x _ = x 
src/hs/Forml/TypeCheck/Types.hs view
@@ -232,7 +232,7 @@     where second_chance e x@ (TypeRecord (TRecord _ (TPartial _) _)) y =                              do as <- get_assumptions-                 g  <- find''' as x+                 g  <- find x                   case g of                    Nothing -> return $ Left e --add_error e >> return []@@ -242,31 +242,54 @@            second_chance e y x @ (TypeRecord (TRecord _ (TPartial _) _)) = second_chance e x y           second_chance e (TypeApplication a b) (TypeApplication c d) =-              do xss <- second_chance e a c-                 yss <- second_chance e b d+              do xss <- a `mgu'` c+                 yss <- b `mgu'` d                  case (xss, yss) of                    (Right xss', Right yss') -> return$ Right$ xss' @@ yss'                    (Left e', _) -> return $ Left e'                    (_, Left e') -> return $ Left e'-                   --          second_chance e x y = case x |=| y of-                                  Error _ -> return $ Left e --add_error e >> return []-                                  Z x -> return $ Right x- -          find''' [] _ = return Nothing-          find''' (_:>:_:xs) t = find''' xs t-          find''' ((Forall _ x :>>: y):xs) t =+             +          second_chance e r @ (Type (TypeConst x k)) t' =+          +                do as <- get_assumptions+                   find' as+                +                where find' []              = return $ Left e+                      find' ((i':>>:(Forall _ (_ :=> (Type (TypeConst x' k'))))):as) +                          | x == x' = do (_ :=> i'') <- freshInst i'+                                         i'' `mgu'` t'+                      find' (_:as)          = find' as+                                  +                 +          second_chance e y (Type x) = second_chance e (Type x) y      -              do (_ :=> t') <- return$ inst (map TypeVar$ tv t) x-                 case t' |=| t of-                   Error _ -> find''' xs t+          second_chance e x y = return $ Left e -                   -- TODO Only allow this shorthand if the match is unique - true?-                   Z x  -> do zz' <- find''' xs t-                              case zz' of-                                Nothing -> return$ Just (x, y)-                                Just _ -> return$ Nothing+apply_rules t' r =+        do sc <- find $ quantify (tv r) ([] :=> r)+           case sc of+             Nothing ->+                 do unify t' r+                    return t'+             Just (Forall _ scr, sct) ->+                 do (_ :=> t'') <- freshInst sct+                    (qs :=> t''') <- return$ inst (map TypeVar$ tv t'') (scr)+                    (_ :=> t) <- freshInst (quantify (tv t''' \\ tv t'') (qs :=> t'''))+                    unify t r+                    unify t' t''+                    s <- get_substitution+                    let t''' = apply s t+                        r''' = apply s r+                        qt   = quantify (tv t''') $ [] :=> t'''+                        rt   = quantify (tv r''') $ [] :=> r'''+                        sct' = apply s t''+                    if qt /= rt+                        then do add_error$ "Record does not match expected signature for " ++ show sct' ++ "\n"+                                             ++ "  Expected: " ++ show qt ++ "\n"+                                             ++ "  Actual:   " ++ show rt+                                return t'+                        else return t'+   var_bind u t | t == TypeVar u   = return []              | u `elem` tv t    = fail $ "occurs check fails: " ++ show u ++ show t@@ -499,6 +522,26 @@                                          x <- i'' `can_unify` i'''                                          if x then return $ Just (i', sc) else find' as               find' (_:as)          = find' as+              +instance Find Type (Maybe (Substitution, Scheme)) where++    find x = do as <- get_assumptions+                find''' as x++             where find''' [] _ = return Nothing+                   find''' (_:>:_:xs) t = find''' xs t+                   find''' ((Forall _ x :>>: y):xs) t =+                   +                       do (_ :=> t') <- return$ inst (map TypeVar$ tv t) x+                          case t' |=| t of+                            Error _ -> find''' xs t+                   +                            -- TODO Only allow this shorthand if the match is unique - true?+                            Z x  -> do zz' <- find''' xs t+                                       case zz' of+                                         Nothing -> return$ Just (x, y)+                                         Just _ -> return$ Nothing+   
src/hs/Forml/Types/Axiom.hs view
@@ -35,6 +35,7 @@  data Axiom a = TypeAxiom UnionType              | EqualityAxiom (Match a) (Addr a)+             deriving (Eq)  instance (Show a) => Show (Axiom a) where     show (TypeAxiom x) = ": " ++ show x
src/hs/Forml/Types/Definition.hs view
@@ -41,10 +41,9 @@ -- Definition -- -------------------------------------------------------------------------------- -data Visibility = Public | Private-+data Visibility = Public | Private deriving (Eq) -data Definition = Definition Visibility Bool Symbol [Axiom (Expression Definition)]+data Definition = Definition Visibility Bool Symbol [Axiom (Expression Definition)] deriving (Eq)  instance Show Definition where     show (Definition Public _ name ax) =[qq|$name {sep_with "\\n" ax}|]@@ -102,7 +101,7 @@                        eq_axiom = -                          do try (spaces >> same) <|> (whitespace >> return ())+                          do P.spaces                              string "|" <|> try (string name' <* notFollowedBy (digit <|> letter))                               naked_eq_axiom @@ -118,7 +117,7 @@                        no_args_eq_axiom patterns = -                          do P.spaces *> string "=" *> spaces *> indented+                          do P.spaces *> string "=" *> P.spaces                              ex <- withPos (addr syntax)                              return $ EqualityAxiom patterns ex 
src/hs/Forml/Types/Expression.hs view
@@ -48,7 +48,7 @@ class ToLocalStat a where     toLocal :: a -> JStat -data Lazy = Once | Every+data Lazy = Once | Every deriving (Eq)  data Expression d = ApplyExpression (Expression d) [Expression d]                   | IfExpression (Expression d) (Expression d) (Expression d)@@ -62,6 +62,7 @@                   | LetExpression [d] (Expression d)                   | ListExpression [Expression d]                   | AccessorExpression (Addr (Expression d)) [Symbol]+                  deriving (Eq)  instance (Show d) => Show (Expression d) where @@ -95,8 +96,10 @@                       <|> other_next                other_next =--                      try apply+                      +                      try accessor_apply+                      <|> accessor_val+                      <|> try apply                       <|> function                       <|> try accessor                       <|> inner@@ -104,6 +107,7 @@               inner = try accessor <|> inner_no_accessor                inner_no_accessor =+                       indentPairs "(" syntax ")"                       <|> js                       <|> try record@@ -112,7 +116,35 @@                       <|> symbol                       <|> try array                       <|> list+                      +              accessor_val = +                    do string "."+                       (Addr s c (SymbolExpression x)) <- addr symbol   -- TODO or AccessorExpression+                       return (FunctionExpression+                           [EqualityAxiom+                               (Match [VarPattern "__y"] Nothing)+                               (Addr s c+                                   (AccessorExpression+                                           (Addr s c+                                               (SymbolExpression (Symbol "__y")))+                                           [x]))])         ++              accessor_apply =++                    do string "."+                       (Addr s c (ApplyExpression (SymbolExpression x) xs)) <- addr apply   -- TODO or AccessorExpression+                       return (FunctionExpression+                           [EqualityAxiom+                               (Match [VarPattern "__y"] Nothing)+                               (Addr s c+                                   (ApplyExpression+                                       (AccessorExpression+                                           (Addr s c+                                               (SymbolExpression (Symbol "__y")))+                                           [x])+                                       xs))])              +               let' = withPosTemp $ do string "var" <|> string "let"                                       whitespace1                                       defs <- withPos def@@ -283,18 +315,9 @@                             where  java_args = do x <- syntax `sepEndBy1` comma                                                   option x ((x ++) <$> try arguments) -              -- No idea why this is necessary?-              withPosTemp :: Parser a -> Parser a-              withPosTemp p = do x <- get-                                 z <- try (Just <$> p) <|> return Nothing-                                 put x-                                 case z of-                                   Just z -> return z-                                   Nothing -> parserFail ("expression continuation indented to " ++ show x)--              function = withPosTemp$ withPos $ do try (char '\\') <|> char 'λ'-                                                   whitespace-                                                   pat_fun+              function = withPosTemp$ do try (char '\\') <|> char 'λ'+                                         whitespace+                                         pat_fun                    where pat_fun    = do t <- option [] ( ((:[]) <$> type_axiom <* spaces))                                         eqs <- try eq_axiom `sepBy1` try (spaces *> string "|" <* whitespace)@@ -387,7 +410,8 @@                       Left x -> error$ show x                       Right x -> x -              symbol  = SymbolExpression <$> syntax+              symbol  = (SymbolExpression <$> syntax)+                              list    = ListExpression <$> indentPairs "[" v "]"                   where v = do whitespace@@ -416,7 +440,7 @@ instance Opt JStat where     opt (ReturnStat x)      = ReturnStat (opt x)     opt (IfStat a b c)      = IfStat (opt a) (opt b) (opt c)-    opt (WhileStat a b)     = WhileStat (opt a) (opt b)+    opt (WhileStat a b c)     = WhileStat a (opt b) (opt c)     opt (ForInStat a b c d) = ForInStat a b (opt c) (opt d)     opt (SwitchStat a b c)  = SwitchStat (opt a) (opt b) (opt c)     opt (TryStat a b c d)   = TryStat (opt a) b (opt c) (opt d)
src/hs/Forml/Types/Literal.hs view
@@ -10,7 +10,7 @@ import Forml.Parser.Utils import Forml.TypeCheck.Types -data Literal = StringLiteral String | IntLiteral Int | DoubleLiteral Double+data Literal = StringLiteral String | IntLiteral Int | DoubleLiteral Double deriving (Eq)  instance Show Literal where    show (StringLiteral x) = show x
src/hs/Forml/Types/Namespace.hs view
@@ -39,7 +39,7 @@     syntax = Namespace <$> (many1 lower `sepBy1` char '.')  instance ToJExpr Namespace where-    toJExpr (Namespace []) = ref "this"+    toJExpr (Namespace []) = ref "window"     toJExpr (Namespace (end -> x : xs)) = [jmacroE| `(Namespace xs)`[`(x)`] |]  
src/hs/Forml/Types/Pattern.hs view
@@ -46,7 +46,7 @@ -- Pattern -- -------------------------------------------------------------------------------- -data Match a = Match [Pattern a] (Maybe a)+data Match a = Match [Pattern a] (Maybe a) deriving (Eq) data Pattern a = VarPattern String                | AnyPattern                | LiteralPattern Literal@@ -54,6 +54,7 @@                | ListPattern [Pattern a]                | ViewPattern a (Pattern a)                | AliasPattern [Pattern a]+               deriving (Eq)   instance (Show a) => Show (Match a) where@@ -152,7 +153,11 @@         where alias = let sep = P.spaces <* string "&" <* P.spaces                       in  AliasPattern <$> ((:) <$> syntax <* sep <*> sepBy1 syntax sep)  -              var         = VarPattern <$> type_var+              var = +              +                  do (Symbol x) <- syntax+                     return (VarPattern x)+                             literal     = LiteralPattern <$> syntax               any'        = many1 (string "_") *> return AnyPattern               naked_apply =
src/hs/Forml/Types/Statement.hs view
@@ -55,14 +55,15 @@ data Statement = TypeStatement TypeDefinition UnionType                | DefinitionStatement Definition                | ExpressionStatement (Addr (Expression Definition))-               | ImportStatement Namespace+               | ImportStatement Namespace (Maybe String)                | ModuleStatement Namespace [Statement]  instance Show Statement where     show (TypeStatement t c)     = [qq|type $t = $c|]     show (DefinitionStatement d) = show d     show (ExpressionStatement (Addr _ _ x)) = show x-    show (ImportStatement x) = [qq|import $x|]+    show (ImportStatement x Nothing) = [qq|open $x|]+    show (ImportStatement x (Just a)) = [qq|open $x as $a|]     show (ModuleStatement x xs) = replace "\n |" "\n     |"                                    $ replace "\n\n" "\n\n    "                                    $ "module " @@ -82,10 +83,23 @@                def_statement = DefinitionStatement <$> syntax -              import_statement = do string "open"-                                    whitespace-                                    ImportStatement <$> syntax+              import_statement = +                  do string "open"+                     whitespace+                     imports <- syntax+                     alias   <- try alias_statement <|> return Nothing+                     return $ ImportStatement imports alias+                     +                  where alias_statement =++                            do spaces+                               string "as"+                               spaces+                               (Symbol x) <- syntax+                               return  (Just x)+                                    +               module_statement = do try (string "module")                                     whitespace1                                     name <- try syntax <|> (char '"' *> (Namespace . (:[]) <$> (anyChar `manyTill` char '"')))@@ -146,23 +160,28 @@     -- Imports work identically for both targets     toJS (Meta { modules,                   namespace = Namespace [], -                 expr      = ImportStatement target_namespace @ (find modules -> Nothing) }) = +                 expr      = ImportStatement target_namespace @ (find modules -> Nothing) _ }) =           fail [qq| Could not resolve namespace $target_namespace |]        toJS (Meta { modules, -                 expr      = ImportStatement target_namespace, +                 expr      = ImportStatement target_namespace Nothing,                   namespace = (find modules . (++ target_namespace) -> Just y) }) =          return $ open target_namespace y -    toJS meta @ (Meta { expr = ImportStatement _, .. }) = +    toJS (Meta { modules, +                 expr      = ImportStatement target_namespace (Just alias), +                 namespace = (find modules . (++ target_namespace) -> Just y) }) = +        return $ declare alias target_namespace++    toJS meta @ (Meta { expr = ImportStatement _ _, .. }) = +         let slice (Namespace ns) = Namespace . take (length ns - 1) $ ns         in  toJS (meta { namespace = slice namespace })  -     -- Modules in test mode must open the contents of the Library      toJS meta @ (Meta { target = Library, namespace = Namespace [], expr = ModuleStatement ns xs, .. }) =@@ -185,7 +204,7 @@     toJS meta @ (Meta { target = Test, expr = ModuleStatement ns xs, .. }) =          let (imports, rest) = L.partition f xs-            f (ImportStatement _) = True+            f (ImportStatement _ _) = True             f _ = False in          do imports' <- toJS $ map (\z -> meta { namespace = namespace ++ ns, expr = z }) imports@@ -227,7 +246,7 @@ find [] (Namespace [])               = Just [] find [] _                            = Nothing -find (Module _ xs : ms) n @ (Namespace []) = Just (map show xs) ++ find ms n+find (Module _ xs : ms) n @ (Namespace []) = find ms n find (Module (Namespace ys) x : zs) n @ (Namespace xs)      | length xs >= length ys && take (length ys) xs == ys =           find x (Namespace $ drop (length ys) xs)
src/hs/Forml/Types/Type.hs view
@@ -166,6 +166,12 @@ type_var    :: Parser String  type_name   = Symbol <$> not_reserved (upper <:> many (alphaNum <|> oneOf "_'"))-type_var    = not_reserved (oneOf "abscdefghijklmnopqrstuvwxyz" <:> many (alphaNum <|> oneOf "_'"))++type_var    = +    not_reserved (oneOf "_abscdefghijklmnopqrstuvwxyz" <:> many (alphaNum <|> oneOf "_'")) >>= f+    +    where f "_" = do x <- getPosition+                     return $ "_" ++ show (sourceLine x * sourceColumn x)+          f x   = return x  
src/hs/Main.hs view
@@ -117,19 +117,19 @@                   tests <- case rc of                               RunConfig { optimize = True, run_tests = Phantom } ->-                                  zipWithM (\title t -> monitor [qq|Closure {title}.spec.js |]$ closure_local t "SIMPLE_OPTIMIZATIONS") titles tests'+                                  zipWithM (\title t -> monitor [qq|Closure {title}.spec.js |]$ closure_local t "SIMPLE_OPTIMIZATIONS") (drop 1 titles) (drop 1 tests')                               _ -> warn "Closure [tests]" tests'                   writeFile (output rc ++ ".js") js                  zipWithM writeFile (map (++ ".spec.js") titles) tests                   if write_docs rc-                     then let programs = map fst src'-                              sources  = map snd src'-                          in  do docs js tests titles programs sources+                     then let programs = map fst (drop 1 src')+                              sources  = map snd (drop 1 src')+                          in  do docs js tests (drop 1 titles) programs sources                      else monitor "Docs" $ return $ Right () -                 sequence (zipWith (test rc js) titles tests)+                 sequence (zipWith (test rc js) (drop 1 titles) tests)                   if (show_types rc)                       then putStrLn ("\nTypes\n\n  " ++ concat (map f types))
src/html/header.html view
@@ -5,6 +5,7 @@     <meta http-equiv="X-UA-Compatible" content="chrome=1">     <title>Forml</title>     <meta name="viewport" content="width=device-width, initial-scale=1, user-scalable=no">+    <link href='http://fonts.googleapis.com/css?family=Montserrat' rel='stylesheet' type='text/css'>     <!--[if lt IE 9]>     <script src="//html5shiv.googlecode.com/svn/trunk/html5.js"></script>     <![endif]-->
+ src/html/styles.css view
@@ -0,0 +1,276 @@+@import url(https://fonts.googleapis.com/css?family=Lato:300italic,700italic,300,700);++body {+  padding:50px;+  font:14px/1.5 Lato, Helvetica, Arial, sans-serif;+  font-weight:300;+  color:black;+}++h1, h2, h3, h4, h5, h6 {+  color:#222;+  margin:0 0 20px;+  font-family: Montserrat;+}++p, ul, ol, table, pre, dl {+  margin:0 0 20px;+}++h1, h2, h3 {+  line-height:1.1;+}++h1 {+  font-size:20px;+}++h2 {+  font-size: 16px;+}++header h1 {+	font-size: 60px;+}++header h1:first-letter {+	color: #E53007;+}++h2 {+  color:#393939;+}++h3, h4, h5, h6 {+  color:#494949;+}++a {+  color:#39c;+  font-weight:400;+  text-decoration:none;+}++a small {+  font-size:11px;+  color:#777;+  margin-top:-0.6em;+  display:block;+}++.wrapper {+  width:960px;+  margin:0 auto;+}++blockquote {+  border-left:1px solid #e5e5e5;+  margin:0;+  padding:0 0 0 20px;+  font-style:italic;+}++code, pre {+  font-family:Monaco, Bitstream Vera Sans Mono, Lucida Console, Terminal;+  color:#333;+  font-size:12px;+}++pre {+  padding:8px 15px;+  background: #f8f8f8;  +  border-radius:5px;+  border:1px solid #e5e5e5;+  overflow-x: auto;+}++table {+  width:100%;+  border-collapse:collapse;+}++th, td {+  text-align:left;+  padding:5px 10px;+  border-bottom:1px solid #e5e5e5;+}++dt {+  color:#444;+  font-weight:700;+}++th {+  color:#444;+}++img {+  max-width:100%;+}++header {+  width:410px;+  float:left;+  position:fixed;+}++header ul {+  list-style:none;+  height:40px;+  +  padding:0;+  +  background: #eee;+  background: -moz-linear-gradient(top, #f8f8f8 0%, #dddddd 100%);+  background: -webkit-gradient(linear, left top, left bottom, color-stop(0%,#f8f8f8), color-stop(100%,#dddddd));+  background: -webkit-linear-gradient(top, #f8f8f8 0%,#dddddd 100%);+  background: -o-linear-gradient(top, #f8f8f8 0%,#dddddd 100%);+  background: -ms-linear-gradient(top, #f8f8f8 0%,#dddddd 100%);+  background: linear-gradient(top, #f8f8f8 0%,#dddddd 100%);+  +  border-radius:5px;+  border:1px solid #d2d2d2;+  box-shadow:inset #fff 0 1px 0, inset rgba(0,0,0,0.03) 0 -1px 0;+	width: 90px;+	cursor: pointer;+}++header li {+  width:89px;+  float:left;+  border-right:1px solid #d2d2d2;+  height:40px;+}++header ul a {+  line-height:1;+  font-size:11px;+  color:#999;+  display:block;+  text-align:center;+  padding-top:6px;+  height:40px;+}++strong {+  color:#222;+  font-weight:700;+}++header ul li + li {+  width:88px;+  border-left:1px solid #fff;+}++header ul li + li + li + li {+  border-right:none;+  width:89px;+}++header ul a strong {+  font-size:14px;+  display:block;+  color:#222;+}++section {+  width:550px;+  float:right;+  padding-bottom:50px;+}++small {+  font-size:11px;+}++hr {+  border:0;+  background:#e5e5e5;+  height:1px;+  margin:0 0 20px;+}++footer {+  width:360px;+  float:left;+  position:fixed;+  bottom:0px;+  top: 220px;+  overflow: auto;+}++#test_suite {+	top: 165px;+	margin-top: 20px;+}++@media print, screen and (max-width: 1060px) {+  +  div.wrapper {+    width:auto;+    margin:0;+  }+  +  header, section, footer {+    float:none;+    position:static;+    width:auto;+  }+  +  header {+    padding-right:320px;+  }+  +  section {+    border:1px solid #e5e5e5;+    border-width:1px 0;+    padding:20px 0;+    margin:0 0 20px;+  }+  +  header a small {+    display:inline;+  }+  +  header ul {+    position:absolute;+    right:50px;+    top: 52px; +  }+}++@media print, screen and (max-width: 720px) {+  body {+    word-wrap:break-word;+  }+  +  header {+    padding:0;+  }+  +  header ul, header p.view {+    position:static;+  }+  +  pre, code {+    word-wrap:normal;+  }+}++@media print, screen and (max-width: 480px) {+  body {+    padding:15px;+  }+  +  header ul {+    display:none;+  }+}++@media print {+  body {+    padding:0.4in;+    font-size:12pt;+    color:#444;+  }+}
src/js/FormlReporter.js view
@@ -24,7 +24,8 @@    jasmine.FormlReporter.prototype.reportRunnerResults = function(runner) {      $("#run_tests").unbind();-     $("header #test_button").css({"background-color":"lightgreen"})+     $("header #test_button").css({"background-color":"lightgreen"});+     $("header #test_button a, header #test_button strong").css({"color":"white"});  };    jasmine.FormlReporter.prototype.reportSuiteResults = function(suite) {