fay 0.4.0.4 → 0.5.0.0

raw patch · 50 files changed

+512/−379 lines, 50 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +0/−40
• docs/home.hs +0/−10
• examples/alert.hs +2/−2
• examples/canvaswater.hs +17/−17
• examples/console.hs +2/−2
• examples/data.hs +1/−1
• examples/dom.hs +4/−4
• examples/ref.hs +4/−4
• examples/tailrecursive.hs +3/−3
• fay.cabal +4/−5
• hs/stdlib.hs +1/−11
• js/runtime.js +270/−199
• src/Language/Fay.hs +52/−38
• src/Language/Fay/Compiler.hs +1/−0
• src/Language/Fay/FFI.hs +1/−2
• src/Language/Fay/Prelude.hs +1/−2
• src/Language/Fay/Types.hs +14/−7
• src/Main.hs +4/−1
• tests/10.hs +1/−1
• tests/11.hs +5/−2
• tests/12.hs +4/−4
• tests/13.hs +1/−1
• tests/14.hs +1/−1
• tests/15.hs +1/−1
• tests/16.hs +1/−1
• tests/17.hs +1/−1
• tests/18.hs +1/−1
• tests/19.hs +1/−1
• tests/20.hs +1/−1
• tests/21.hs +1/−1
• tests/22.hs +1/−1
• tests/23.hs +1/−1
• tests/24.hs +1/−1
• tests/25.hs +1/−1
• tests/26.hs +1/−1
• tests/27.hs +2/−2
• tests/28.hs +1/−1
• tests/29 +3/−0
• tests/29.hs +28/−0
• tests/3.hs +1/−1
• tests/30 +3/−0
• tests/30.hs +30/−0
• tests/31 +1/−0
• tests/31.hs +32/−0
• tests/4.hs +1/−1
• tests/5.hs +1/−1
• tests/6.hs +1/−1
• tests/7.hs +1/−1
• tests/8.hs +1/−1
• tests/9.hs +1/−1

@@ -1,40 +0,0 @@-2012-07-26-0.1.1.0: Lots of documentation updates, some runtime fixes, some more examples, tail-call optimization prototype.--cf6b848 Add analytics to .cabal.-13b8d0e Fix types for ghc.-4a021a3 Use continue (for now) for TCO (refs #19).-b43220c Tail recursive optimization prototype (refs #19).-137a702 Tail recursive example doc.-6ec356b Ref example.-e10023c fromInteger/fromRational in the runtime (closes #20).-7527aaa Add missing operators to Prelude and built-ins list (closes #16).-9ce6915 Throw error about unsupported `where' (closes #17).-406067c Fix silly enumFromTo mistake.-8c37842 A test-case that tail-recursive functions run iteratively.-1791e68 Optimize constant patterns slightly, shaves off some time.-f016d01 Add Fay.Show (preliminary implementation).-66cf298 Add data/show example.-486c4f3 Add note about generating docs.-15fd56c Add note that you need nodejs installed to run the tests.-ae207b7 Include google analytics in docs and generate index.html rather than home.html.-07f7f4a Updated dom example with onload handler.-e702218 Remove max-width to fix firefox.-aa5dc2b Mention minifying slightly in docs.-e53addc Remove language-javascript dependency.-f976ff6 Remove non-ascii character in runtime.js-2abd59d Don't print counts in fay-tests.-c0127c3 Add small note about livescript.-0d35867 Added fork on github for docs.-f6a0d62 Use === instead of == for jseq (closes #6).-7d1a382 Some word break on the pre's.-37e3d53 Rename modules from Main to X (closes #5).-6734221 Ignore more stuff.-4479709 Toggle examples.-3ddf795 Put examples side-by-side (closes #3).-5ae7cca s/strict/proper to avoid confusion.-a482a5b Convert from function expression assignments to function definitions--2012-07-21-0.1.0.0: First version.-

@@ -25,16 +25,6 @@     indentAndHighlight     setupExpanders     setupTableOfContents-    body <- query ".subheadline"-    addClassWith (\i f -> do alert (show i)-                             alert f-                             return f)-                 body-    return ()--addClassWith :: (Double -> String -> Fay String) -> JQuery -> Fay JQuery-addClassWith = ffi "%2.addClass(function(x,i){ return %1(x,Fay$$list(i)); })" FayNone-  -- | Setup highlighting/code re-indenting. indentAndHighlight :: Fay ()

@@ -9,5 +9,5 @@ main = alert "Hello, World!"  -- | Alert using window.alert.-alert :: Foreign a => a -> Fay ()-alert = ffi "window.alert(%1)" FayNone+alert :: String -> Fay ()+alert = ffi "window.alert(%1)"

@@ -55,11 +55,11 @@  -- | Add an event listener to an element. addEventListener :: (Foreign a,Eventable a) => a -> String -> Fay () -> Bool -> Fay ()-addEventListener = ffi "%1['addEventListener'](%2,%3,%4)" FayNone+addEventListener = ffi "%1['addEventListener'](%2,%3,%4)"  -- | Get an element by its ID. getElementById :: String -> Fay Element-getElementById = ffi "document['getElementById'](%1)" FayNone+getElementById = ffi "document['getElementById'](%1)"  -------------------------------------------------------------------------------- -- Images@@ -70,11 +70,11 @@  -- | Make a new image. newImage :: Fay Image-newImage = ffi "new Image()" FayNone+newImage = ffi "new Image()"  -- | Make a new image. setSrc :: Image -> String -> Fay ()-setSrc = ffi "%1['src'] = %2" FayNone+setSrc = ffi "%1['src'] = %2"  -------------------------------------------------------------------------------- -- Canvas@@ -85,11 +85,11 @@  -- | Get an element by its ID. getContext :: Element -> String -> Fay Context-getContext = ffi "%1['getContext'](%2)" FayNone+getContext = ffi "%1['getContext'](%2)"  -- | Draw an image onto a canvas rendering context. drawImage :: Context -> Image -> Double -> Double -> Fay ()-drawImage = ffi "%1['drawImage'](%2,%3,%4)" FayNone+drawImage = ffi "%1['drawImage'](%2,%3,%4)"  -- | Draw an image onto a canvas rendering context. --@@ -101,15 +101,15 @@ drawImageSpecific :: Context -> Image                   -> Double -> Double -> Double -> Double -> Double -> Double -> Double -> Double                   -> Fay ()-drawImageSpecific = ffi "%1['drawImage'](%2,%3,%4,%5,%6,%7,%8,%9,%10)" FayNone+drawImageSpecific = ffi "%1['drawImage'](%2,%3,%4,%5,%6,%7,%8,%9,%10)"  -- | Set the fill style. setFillStyle :: Context -> String -> Fay ()-setFillStyle = ffi "%1['fillStyle']=%2" FayNone+setFillStyle = ffi "%1['fillStyle']=%2"  -- | Set the fill style. setFillRect :: Context -> Double -> Double -> Double -> Double -> Fay ()-setFillRect = ffi "%1['fillRect'](%2,%3,%4,%5)" FayNone+setFillRect = ffi "%1['fillRect'](%2,%3,%4,%5)"  -------------------------------------------------------------------------------- -- Ref@@ -120,35 +120,35 @@  -- | Make a new mutable reference. newRef :: Foreign a => a -> Fay (Ref a)-newRef = ffi "new Fay$$Ref(%1)" FayNone+newRef = ffi "new Fay$$Ref(%1)"  -- | Replace the value in the mutable reference. writeRef :: Foreign a => Ref a -> a -> Fay ()-writeRef = ffi "Fay$$writeRef(%1,%2)" FayNone+writeRef = ffi "Fay$$writeRef(%1,%2)"  -- | Get the referred value from the mutable value. readRef :: Foreign a => Ref a -> Fay a-readRef = ffi "Fay$$readRef(%1)" FayNone+readRef = ffi "Fay$$readRef(%1)"  -------------------------------------------------------------------------------- -- Misc  -- | Alert using window.alert. alert :: Foreign a => a -> Fay ()-alert = ffi "window['alert'](%1)" FayNone+alert = ffi "window['alert'](%1)"  -- | Alert using window.alert. print :: Double -> Fay ()-print = ffi "console['log'](%1)" FayNone+print = ffi "console['log'](%1)"  -- | Alert using window.alert. log :: String -> Fay ()-log = ffi "console['log'](%1)" FayNone+log = ffi "console['log'](%1)"  -- | Alert using window.alert. sin :: Double -> Double-sin = ffi "window.Math['sin'](%1)" FayNone+sin = ffi "window.Math['sin'](%1)"  -- | Alert using window.alert. setInterval :: Fay () -> Double -> Fay ()-setInterval = ffi "window['setInterval'](%1,%2)" FayNone+setInterval = ffi "window['setInterval'](%1,%2)"

@@ -8,5 +8,5 @@ main = print "Hello, World!"  -- | Print using console.log.-print :: Foreign a => a -> Fay ()-print = ffi "console.log(%1)" FayNone+print :: String -> Fay ()+print = ffi "console.log(%1)"

@@ -18,4 +18,4 @@ main = print (show (Foo 123 "abc" Bar))  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -12,16 +12,16 @@ printBody :: Fay () printBody = do   result <- documentGetElements "body"-  print result+  print (show result)  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"  data Element instance Foreign Element  documentGetElements :: String -> Fay [Element]-documentGetElements = ffi "document.getElementsByTagName(%1)" FayArray+documentGetElements = ffi "document.getElementsByTagName(%1)"  addEventListener :: String -> Fay () -> Bool -> Fay ()-addEventListener = ffi "window['addEventListener'](%1,%2,%3)" FayNone+addEventListener = ffi "window['addEventListener'](%1,%2,%3)"

@@ -20,13 +20,13 @@ instance Foreign a => Foreign (Ref a)  newRef :: Foreign a => a -> Fay (Ref a)-newRef = ffi "new Fay$$Ref(%1)" FayNone+newRef = ffi "new Fay$$Ref(%1)"  writeRef :: Foreign a => Ref a -> a -> Fay ()-writeRef = ffi "Fay$$writeRef(%1,%2)" FayNone+writeRef = ffi "Fay$$writeRef(%1,%2)"  readRef :: Foreign a => Ref a -> Fay a-readRef = ffi "Fay$$readRef(%1)" FayNone+readRef = ffi "Fay$$readRef(%1)"  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -28,10 +28,10 @@ sum n acc = sum (n - 1) (acc + n)  getSeconds :: Fay Double-getSeconds = foreignFay "new Date" FayNone+getSeconds = ffi "new Date()"  printD :: Double -> Fay ()-printD = foreignFay "console.log" FayNone+printD = ffi "console.log(%1)"  printS :: String -> Fay ()-printS = foreignFay "console.log" FayNone+printS = ffi "console.log(%1)"

@@ -1,5 +1,5 @@ name:                fay-version:             0.4.0.4+version:             0.5.0.0 synopsis:            A compiler for Fay, a Haskell subset that compiles to JavaScript. description:         Fay is a proper subset of Haskell which can be compiled (type-checked)                      with GHC, and compiled to JavaScript. It is lazy, pure, with a Fay monad,@@ -22,7 +22,7 @@                      .                      /Release Notes/                      .-                     * Added help to the fay compiler executable.+                     * MAJOR FFI RESTRUCTURING. Please see commit d6c346c320245762432928bc83aa8ca98a426138.                      .                      See full history at: <https://github.com/chrisdone/fay/commits> homepage:            http://fay-lang.org/@@ -48,7 +48,8 @@                      tests/23 tests/23.hs tests/24 tests/24.hs tests/25.hs tests/26 tests/26.hs                      tests/2.hs tests/3 tests/3.hs tests/4 tests/4.hs tests/5 tests/5.hs tests/6                      tests/6.hs tests/7 tests/7.hs tests/8 tests/8.hs tests/9 tests/9.hs tests/27-                     tests/27.hs tests/28 tests/28.hs+                     tests/27.hs tests/28 tests/28.hs tests/30.hs tests/29 tests/30 tests/29.hs+                     tests/31.hs tests/31                      -- Documentation files                      docs/beautify.js docs/highlight.pack.js docs/home.css docs/home.js docs/jquery.js                      docs/analytics.js@@ -64,8 +65,6 @@                      docs/snippets/patterns.hs                      docs/snippets/tail.hs                      docs/home.hs-                     -- Misc-                     CHANGELOG  library   hs-source-dirs:    src

@@ -1,19 +1,9 @@-data ArgType-  = DateType-  | FunctionType-  | JsType-  | StringType-  | DoubleType-  | ListType-  | BoolType-  | UnknownType- data Maybe a   = Just a   | Nothing  show :: (Foreign a,Show a) => a -> String-show = ffi "Fay$$encodeShow(%1)" FayString+show = ffi "Fay$$encodeShow(%1)"  -- There is only Double in JS. fromInteger x = x

@@ -2,15 +2,15 @@ var False = false;  /*******************************************************************************-* Thunks.-*/+ * Thunks.+ */  // Force a thunk (if it is a thunk) until WHNF. function _(thunkish,nocache){-  while (thunkish instanceof $) {-    thunkish = thunkish.force(nocache);-  }-  return thunkish;+    while (thunkish instanceof $) {+        thunkish = thunkish.force(nocache);+    }+    return thunkish; }  // Apply a function to arguments (see method2 in Fay.hs).@@ -24,339 +24,410 @@  // Thunk object. function $(value){-  this.forced = false;-  this.value = value;+    this.forced = false;+    this.value = value; }  // Force the thunk. $.prototype.force = function(nocache){-  return nocache-    ? this.value()-    : this.forced-    ? this.value-    : (this.forced = true, this.value = this.value());+    return nocache+        ? this.value()+        : this.forced+        ? this.value+        : (this.forced = true, this.value = this.value()); };  /*******************************************************************************-* Constructors.-*/+ * Constructors.+ */  // A constructor. function Fay$$Constructor(){-  this.name = arguments[0];-  this.fields = Array.prototype.slice.call(arguments,1);+    this.name = arguments[0];+    this.fields = Array.prototype.slice.call(arguments,1); }  // Eval in the context of the Haskell bindings. function Fay$$eval(str){-  return eval(str);+    return eval(str); }  /*******************************************************************************-* Monad.-*/+ * Monad.+ */  function Fay$$Monad(value){-  this.value = value;+    this.value = value; }  // >> function Fay$$then(a){-  return function(b){-    return new $(function(){-      _(a,true);-      return b;-    });-  };+    return function(b){+        return new $(function(){+            _(a,true);+            return b;+        });+    }; }  // >>= function Fay$$bind(m){-  return function(f){-    return new $(function(){-      var monad = _(m,true);-      return f(monad.value);-    });-  };+    return function(f){+        return new $(function(){+            var monad = _(m,true);+            return f(monad.value);+        });+    }; }  var Fay$$unit = null;  // return function Fay$$return(a){-  return new Fay$$Monad(a);+    return new Fay$$Monad(a); }  /*******************************************************************************-* FFI.-*/+ * FFI.+ */  // Serialize a Fay object to JS.-function Fay$$serialize(type,obj){-  type = _(type);-  if(type) type = type[0].name;-  if(type == "JsType"){-    return function(){-      return _(obj,true).value;-    };-  } else {-    obj = _(obj);-    if(type == "StringType" ||-       (obj instanceof Fay$$Cons && typeof obj.car == 'string')){-      var str = "";-      while(obj instanceof Fay$$Cons) {-        str += obj.car;-        obj = _(obj.cdr);-      }-      return str;-    } else if(type == "FunctionType" || typeof obj == 'function'){-      return function(){-        var out = obj;-        for (var len = arguments.length, i = 0; i < len; i++){-          if(typeof out != 'function') {-            throw "Wrong number of arguments for callback: " + arguments.toString();-          }-          out = out(arguments[i]);+function Fay$$serialize(type,fayObj){+    var base = type[0];+    var args = type[1];+    var jsObj;+    switch(base){+    case "action": {+        // A nullary monadic action. Should become a nullary JS function.+        // Fay () -> function(){ return ... }+        jsObj = function(){+            return Fay$$serialize(args[0],_(fayObj,true).value);+        };+        break;+    }+    case "function": {+        // A proper function.+        jsObj = function(){+            var return_type = args[args.length-1];+            var len = args.length;+            // If some arguments.+            if (len > 1) {+                // Apply to all the arguments.+                fayObj = _(fayObj,true);+                for (var i = 0, len = len; i < len - 1; i++) {+                    // Unserialize the JS values to Fay for the Fay callback.+                    fayObj = _(fayObj(Fay$$unserialize(args[i],arguments[i])),true);+                }+                // Finally, serialize the Fay return value back to JS.+                var return_base = return_type[0];+                var return_args = return_type[1];+                // If it's a monadic return value, get the value instead.+                if(return_base == "action") {+                    return Fay$$serialize(return_args[0],fayObj.value);+                }+                // Otherwise just serialize the value direct.+                else {+                    return Fay$$serialize(return_type,fayObj);+                }+            } else {+                throw new Error("Nullary function?");+            }+        };+        break;+    }+    case "string": {+        // Serialize Fay string to JavaScript string.+        var str = "";+        fayObj = _(fayObj);+        while(fayObj instanceof Fay$$Cons) {+            str += fayObj.car;+            fayObj = _(fayObj.cdr);         }-        return _(out,true);-      };-    } else if(type == "ListType" || (obj instanceof Fay$$Cons)){-      var arr = [];-      while(obj instanceof Fay$$Cons) {-        arr.push(Fay$$serialize(null,obj.car));-        obj = _(obj.cdr);-      }-      return arr;-    } // else if(type == "BoolType || obj == _(True) || obj == _(False)) {-    //   return obj == _(True);-    // }-    else {-      return obj;+        jsObj = str;+        break;     }-  }+    case "list": {+        // Serialize Fay list to JavaScript array.+        var arr = [];+        fayObj = _(fayObj);+        while(fayObj instanceof Fay$$Cons) {+            arr.push(Fay$$serialize(args[0],fayObj.car));+            fayObj = _(fayObj.cdr);+        }+        jsObj = arr;+        break;+    }+    case "double": {+        // Serialize double, just force the argument. Doubles are unboxed.+        jsObj = _(fayObj);+        break;+    }+    case "unknown": {+        // Just force unknown values to WHNF.+        jsObj = _(fayObj);+        break;+    }+    case "bool": {+        // Bools are unboxed.+        jsObj = fayObj;+        break;+    }+    default: throw new Error("Unhandled serialize type: " + base);+    }+    return jsObj; } +// Unserialize an object from JS to Fay.+function Fay$$unserialize(type,jsObj){+    var base = type[0];+    var args = type[1];+    var fayObj;+    switch(base){+    case "action": {+        // Unserialize a "monadic" JavaScript return value into a monadic value.+        fayObj = Fay$$return(Fay$$unserialize(args[0],jsObj));+        break;+    }+    case "string": {+        // Unserialize a JS string into Fay list (String).+        fayObj = Fay$$list(jsObj);+        break;+    }+    case "list": {+        // Unserialize a JS array into a Fay list ([a]).+        var serializedList = [];+        for (var i = 0, len = jsObj.length; i < len; i++) {+            // Unserialize each JS value into a Fay value, too.+            serializedList.push(Fay$$unserialize(args[0],jsObj[i]));+        }+        // Pop it all in a Fay list.+        fayObj = Fay$$list(serializedList);+        break;+    }+    case "double": {+        // Doubles are unboxed, so there's nothing to do.+        fayObj = jsObj;+        break;+    }+    case "unknown": {+        // Any unknown values can be left as-is.+        fayObj = jsObj;+        break;+    }+    default: throw new Error("Unhandled unserialize type: " + base);+    }+    return fayObj;+}+ // Encode a value to a Show representation function Fay$$encodeShow(x){-  if (x instanceof $) x = _(x);-  if (x instanceof Array) {-    if (x.length == 0) {-      return "[]";-    } else {-      if (x[0] instanceof Fay$$Constructor) {-        if(x[0].fields.length > 0) {-          var args = x.slice(1);-          var fieldNames = x[0].fields;-          return "(" + x[0].name + " { " + args.map(function(x,i){-            return fieldNames[i] + ' = ' + Fay$$encodeShow(x);-          }).join(", ") + " })";+    if (x instanceof $) x = _(x);+    if (x instanceof Array) {+        if (x.length == 0) {+            return "[]";         } else {-          var args = x.slice(1);-          return "(" + [x[0].name].concat(args.map(Fay$$encodeShow)).join(" ") + ")";+            if (x[0] instanceof Fay$$Constructor) {+                if(x[0].fields.length > 0) {+                    var args = x.slice(1);+                    var fieldNames = x[0].fields;+                    return "(" + x[0].name + " { " + args.map(function(x,i){+                        return fieldNames[i] + ' = ' + Fay$$encodeShow(x);+                    }).join(", ") + " })";+                } else {+                    var args = x.slice(1);+                    return "(" + [x[0].name].concat(args.map(Fay$$encodeShow)).join(" ") + ")";+                }+            } else {+                return "[" + x.map(Fay$$encodeShow).join(",") + "]";+            }         }-      } else {-        return "[" + x.map(Fay$$encodeShow).join(",") + "]";-      }+    } else if (typeof x == 'string') {+        return JSON.stringify(x);+    } else if(x instanceof Fay$$Cons) {+        return Fay$$encodeShow(Fay$$serialize(["list",[["unknown"]]],x));+    } else if(x == null) {+        return '[]';+    } else {+        return x.toString();     }-  } else if (typeof x == 'string') {-    return JSON.stringify(x);-  } else if(x instanceof Fay$$Cons) {-    return Fay$$encodeShow(Fay$$serialize(ListType,x));-  } else if(x == null) {-    return '[]';-  } else {-    return x.toString();-  } } -// Unserialize an object from JS to Fay.-function Fay$$unserialize(typ,obj){-  if(typ == 'string' || typ == 'array' || typ == 'list')-    return Fay$$list(obj);-  else if(typ == 'bool')-    return obj? True : False;-  else if(typ == 'data') {-    alert('Time to unserialize a data record!');-  }-  else return obj;-}- /*******************************************************************************-* Lists.-*/+ * Lists.+ */  // Cons object. function Fay$$Cons(car,cdr){-  this.car = car;-  this.cdr = cdr;+    this.car = car;+    this.cdr = cdr; }  // Make a list. function Fay$$list(xs){-  var out = null;-  for(var i=xs.length-1; i>=0;i--)-    out = new Fay$$Cons(xs[i],out);-  return out;+    var out = null;+    for(var i=xs.length-1; i>=0;i--)+        out = new Fay$$Cons(xs[i],out);+    return out; }  // Built-in list cons. function Fay$$cons(x){-  return function(y){-    return new Fay$$Cons(x,y);-  };+    return function(y){+        return new Fay$$Cons(x,y);+    }; }  // List index. function Fay$$index(index){-  return function(list){-    for(var i = 0; i < index; i++) {-      list = _(list).cdr;-    }-    return list.car;-  };+    return function(list){+        for(var i = 0; i < index; i++) {+            list = _(list).cdr;+        }+        return list.car;+    }; }  /*******************************************************************************-* Numbers.-*/+ * Numbers.+ */  // Built-in *. function Fay$$mult(x){-  return function(y){-    return _(x) * _(y);-  };+    return function(y){+        return _(x) * _(y);+    }; }  // Built-in +. function Fay$$add(x){-  return function(y){-    return _(x) + _(y);-  };+    return function(y){+        return _(x) + _(y);+    }; }  // Built-in -. function Fay$$sub(x){-  return function(y){-    return _(x) - _(y);-  };+    return function(y){+        return _(x) - _(y);+    }; }  // Built-in /. function Fay$$div(x){-  return function(y){-    return _(x) / _(y);-  };+    return function(y){+        return _(x) / _(y);+    }; }  /*******************************************************************************-* Booleans.-*/+ * Booleans.+ */  // Are two values equal? function Fay$$equal(lit1,lit2){-  // Simple case-  lit1 = _(lit1);-  lit2 = _(lit2);-  if(lit1 === lit2) {-    return true;-  }-  // General case-  if(lit1 instanceof Array) {-    if(lit1.length!=lit2.length) return false;-    for(var len = lit1.length, i = 0; i < len; i++) {-      if(!Fay$$equal(lit1[i],lit2[i]))-        return false;+    // Simple case+    lit1 = _(lit1);+    lit2 = _(lit2);+    if(lit1 === lit2) {+        return true;     }-    return true;-  } else if (lit1 instanceof Fay$$Cons) {-    while(lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons && Fay$$equal(lit1.car,lit2.car))-      lit1 = lit1.cdr, lit2 = lit2.cdr;-    return (lit1 === null && lit2 === null);-  } else return false;+    // General case+    if(lit1 instanceof Array) {+        if(lit1.length!=lit2.length) return false;+        for(var len = lit1.length, i = 0; i < len; i++) {+            if(!Fay$$equal(lit1[i],lit2[i]))+                return false;+        }+        return true;+    } else if (lit1 instanceof Fay$$Cons) {+        while(lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons && Fay$$equal(lit1.car,lit2.car))+            lit1 = lit1.cdr, lit2 = lit2.cdr;+        return (lit1 === null && lit2 === null);+    } else return false; }  // Built-in ==. function Fay$$eq(x){-  return function(y){-    return Fay$$equal(x,y);-  };+    return function(y){+        return Fay$$equal(x,y);+    }; }  // Built-in /=. function Fay$$neq(x){-  return function(y){-    return !(Fay$$equal(x,y));-  };+    return function(y){+        return !(Fay$$equal(x,y));+    }; }  // Built-in >. function Fay$$gt(x){-  return function(y){-    return _(x) > _(y);-  };+    return function(y){+        return _(x) > _(y);+    }; }  // Built-in <. function Fay$$lt(x){-  return function(y){-    return _(x) < _(y);-  };+    return function(y){+        return _(x) < _(y);+    }; }  // Built-in >=. function Fay$$gte(x){-  return function(y){-    return _(x) >= _(y);-  };+    return function(y){+        return _(x) >= _(y);+    }; }  // Built-in <=. function Fay$$lte(x){-  return function(y){-    return _(x) <= _(y);-  };+    return function(y){+        return _(x) <= _(y);+    }; }  // Built-in &&. function Fay$$and(x){-  return function(y){-    return _(x) && _(y);-  };+    return function(y){+        return _(x) && _(y);+    }; }  // Built-in ||. function Fay$$or(x){-  return function(y){-    return _(x) || _(y);-  };+    return function(y){+        return _(x) || _(y);+    }; }  /*******************************************************************************-* Mutable references.-*/+ * Mutable references.+ */  // Make a new mutable reference. function Fay$$Ref(x){-  this.value = x;+    this.value = x; }  // Write to the ref. function Fay$$writeRef(ref,x){-  ref.value = x;+    ref.value = x; }  // Get the value from the ref. function Fay$$readRef(ref,x){-  return ref.value;+    return ref.value; }  /*******************************************************************************-* Dates.-*/+ * Dates.+ */ function Fay$$date(str){-  return window.Date.parse(str);+    return window.Date.parse(str); }  /*******************************************************************************-* Application code.-*/+ * Application code.+ */

@@ -159,26 +159,22 @@   case pat of     PatBind _ (PVar ident) Nothing (UnGuardedRhs rhs) (BDecls []) ->       case ffiExp rhs of-        Just (formatstr,typ) -> case sig of-          Just sig -> compileFFI ident formatstr typ sig+        Just formatstr -> case sig of+          Just sig -> compileFFI ident formatstr sig           Nothing  -> throwError (FfiNeedsTypeSig pat)         _ -> compileNormalPatBind toplevel ident rhs     _ -> throwError (UnsupportedDeclaration pat) -  where ffiExp (App (App (Var (UnQual (Ident "ffi")))-                         (Lit (String formatstr)))-                    (Con (UnQual (Ident (reads -> [(typ,"")])))))-          = Just (formatstr,typ)+  where ffiExp (App (Var (UnQual (Ident "ffi"))) (Lit (String formatstr))) = Just formatstr         ffiExp _ = Nothing  -- | Compile an FFI call.-compileFFI :: Name             -- ^ Name of the to-be binding.-           -> String           -- ^ The format string.-           -> FayReturnType    -- ^ The return type.-           -> Type             -- ^ Type signature.+compileFFI :: Name   -- ^ Name of the to-be binding.+           -> String -- ^ The format string.+           -> Type   -- ^ Type signature.            -> Compile [JsStmt]-compileFFI name formatstr returnType sig = do-  inner <- formatFFI formatstr (zip params funcArgTypes)+compileFFI name formatstr sig = do+  inner <- formatFFI formatstr (zip params funcFundamentalTypes)   case JS.parse (printJS (wrapReturn inner)) (prettyPrint name) of     Left err -> throwError (FfiFormatInvalidJavaScript inner err)     Right{}  -> fmap return (bindToplevel True (UnQual name) (body inner))@@ -187,19 +183,18 @@         wrapParam name inner = JsFun [name] [] (Just inner)         params = zipWith const uniqueNames [1..typeArity sig]         wrapReturn inner = thunk $-          case lastMay funcArgTypes of-            -- Fay action:-            Just JsType -> monad (unserialize returnType (JsRawExp inner))+          case lastMay funcFundamentalTypes of             -- Returns a “pure” value;             Just{} -> unserialize returnType (JsRawExp inner)             -- Base case:             Nothing -> JsRawExp inner-        funcArgTypes = functionTypeArgs sig+        funcFundamentalTypes = functionTypeArgs sig+        returnType = last funcFundamentalTypes  -- | Format the FFI format string with the given arguments.-formatFFI :: String              -- ^ The format string.-          -> [(JsParam,ArgType)] -- ^ Arguments.-          -> Compile String      -- ^ The JS code.+formatFFI :: String                      -- ^ The format string.+          -> [(JsParam,FundamentalType)] -- ^ Arguments.+          -> Compile String              -- ^ The JS code. formatFFI formatstr args = go formatstr where   go ('%':'*':xs) = do     these <- mapM inject (zipWith const [1..] args)@@ -227,15 +222,30 @@         return (printJS (serialize typ (JsName arg)))  -- | Serialize a value to native JS, if possible.-serialize :: ArgType -> JsExp -> JsExp+serialize :: FundamentalType -> JsExp -> JsExp serialize typ exp =   case typ of --    UnknownType -> force exp     _ -> JsApp (JsName (hjIdent "serialize"))-               [JsName (fromString (show typ)),exp]+               [typeRep typ,exp] +-- | Get a JS-representation of a fundamental type for encoding/decoding.+typeRep :: FundamentalType -> JsExp+typeRep typ =+  case typ of+    FunctionType xs -> JsList [JsLit $ JsStr "function",JsList (map typeRep xs)]+    JsType x        -> JsList [JsLit $ JsStr "action",JsList [typeRep x]]+    ListType x      -> JsList [JsLit $ JsStr "list",JsList [typeRep x]]+    typ             -> JsList [JsLit $ JsStr nom]+      where nom = case typ of+              StringType -> "string"+              DoubleType -> "double"+              BoolType   -> "bool"+              DateType   -> "date"+              _          -> "unknown"+ -- | Get arg types of a function type.-functionTypeArgs :: Type -> [ArgType]+functionTypeArgs :: Type -> [FundamentalType] functionTypeArgs t =   case t of     TyForall _ _ i -> functionTypeArgs i@@ -244,15 +254,15 @@     r              -> [argType r]  -- | Convert a Haskell type to an internal FFI representation.-argType :: Type -> ArgType+argType :: Type -> FundamentalType argType t =   case t of-    TyApp (TyCon "Fay") _ -> JsType+    TyApp (TyCon "Fay") a -> JsType (argType a)     TyCon "String"        -> StringType     TyCon "Double"        -> DoubleType     TyCon "Bool"          -> BoolType-    TyFun{}               -> FunctionType-    TyList _              -> ListType+    TyFun x xs            -> FunctionType (argType x : functionTypeArgs xs)+    TyList x              -> ListType (argType x)     TyParen st            -> argType st     _                     -> UnknownType @@ -392,8 +402,18 @@ -- | Compile a right-hand-side expression. compileRhs :: Rhs -> Compile JsExp compileRhs (UnGuardedRhs exp) = compileExp exp-compileRhs rhs                = throwError (UnsupportedRhs rhs)+compileRhs (GuardedRhss rhss) = compileGuards rhss +-- | Compile guards+compileGuards :: [GuardedRhs] -> Compile JsExp+compileGuards [] = return . JsThrowExp . JsLit . JsStr $ "Non-exhaustive guards"+compileGuards ((GuardedRhs _ (Qualifier (Var (UnQual (Ident "otherwise"))):_) exp):_) = compileExp exp+compileGuards ((GuardedRhs _ (Qualifier guard:_) exp):rest) =+  JsTernaryIf <$> fmap force (compileExp guard)+              <*> compileExp exp+              <*> compileGuards rest+compileGuards rhss = throwError . UnsupportedRhs . GuardedRhss $ rhss+ -- | Compile a pattern match binding. compileFunMatch :: Bool -> Match -> Compile [JsStmt] compileFunMatch toplevel match =@@ -496,8 +516,10 @@ compileList :: [Exp] -> Compile JsExp compileList xs = do   exps <- mapM compileExp xs-  return (JsApp (JsName (hjIdent "list")) [JsList exps])+  return (makeList exps) +makeList exps = (JsApp (JsName (hjIdent "list")) [JsList exps])+ -- | Compile an if. compileIf :: Exp -> Exp -> Exp -> Compile JsExp compileIf cond conseq alt =@@ -773,18 +795,10 @@ stmtsThunk :: [JsStmt] -> JsExp stmtsThunk stmts = JsNew ":thunk" [JsFun [] stmts Nothing] -unserialize :: FayReturnType -> JsExp -> JsExp+unserialize :: FundamentalType -> JsExp -> JsExp unserialize typ exp =   JsApp (JsName (hjIdent "unserialize"))-        [JsLit (JsStr (showReturnType typ)),exp]--  where showReturnType typ =-          case typ of-            FayArray -> "array"-            FayList -> "list"-            FayString -> "string"-            FayBool -> "bool"-            FayNone -> ""+        [typeRep typ,exp]  -- | Force an expression in a thunk. force :: JsExp -> JsExp

@@ -56,6 +56,7 @@                                               ,"this.$list       = Fay$$list;"                                               ,"this.$encodeShow = Fay$$encodeShow;"                                               ,"this.$eval       = Fay$$eval;"+                                              ,"this.$serialize  = Fay$$serialize;"                                               ]                                  else ""                              ,"};"

@@ -4,7 +4,7 @@  module Language.Fay.FFI where -import           Language.Fay.Types (Fay, FayReturnType(..))+import           Language.Fay.Types (Fay) import           Prelude            (Bool, Char, Double, String, error)  data JsPtr a@@ -40,6 +40,5 @@ ffi   :: Foreign a   => String        -- ^ The foreign value.-  -> FayReturnType -- ^ JS return type (if any).   -> a             -- ^ Bottom. ffi = error "Language.Fay.FFI.foreignFay: Used foreign function not in a JS engine context."

@@ -2,7 +2,6 @@  module Language.Fay.Prelude   (Fay-  ,FayReturnType(..)   ,Char   ,String   ,Integer@@ -34,7 +33,7 @@   where  import           Language.Fay.Stdlib-import           Language.Fay.Types  (Fay, FayReturnType(..))+import           Language.Fay.Types  (Fay)  import           GHC.Real            (Ratio) import           Prelude             (Bool(..), Char, Double, Integer, Maybe(..), Ord, Read(..),

@@ -18,8 +18,7 @@   ,Fay   ,CompileConfig(..)   ,CompileState(..)-  ,FayReturnType(..)-  ,ArgType(..))+  ,FundamentalType(..))   where  import           Control.Applicative@@ -158,13 +157,21 @@   | JsBool Bool   deriving (Show,Eq) -data FayReturnType = FayArray | FayList | FayString | FayBool | FayNone-  deriving (Read,Show,Eq)- -- | These are the data types that are serializable directly to native -- JS data types. Strings, floating points and arrays. The others are: -- actiosn in the JS monad, which are thunks that shouldn't be forced -- when serialized but wrapped up as JS zero-arg functions, and -- unknown types can't be converted but should at least be forced.-data ArgType = FunctionType | JsType | StringType | DoubleType | ListType | BoolType | UnknownType-  deriving (Show,Eq)+data FundamentalType+   -- Recursive types.+ = FunctionType [FundamentalType]+ | JsType FundamentalType+ | ListType FundamentalType+ -- Simple types.+ | DateType+ | StringType+ | DoubleType+ | BoolType+ -- | Unknown.+ | UnknownType+   deriving (Show,Eq)

@@ -37,5 +37,8 @@   ,"  fay [OPTIONS] <hs-input-file> ... "   ,""   ,"OPTIONS"-  ,"  -autorun    automatically call main in generated JavaScript"+  ,"  -autorun       automatically call main in generated JavaScript"+  ,"  -inline-force  inline forcing, adds some speed for numbers, blows up code a bit"+  ,"  -flatten-apps  flatten function application, can be more readable,"+  ,"                 no noticeable speed difference"   ]

@@ -9,4 +9,4 @@ append []     ys = ys  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -1,4 +1,4 @@-main = print (show (take 5 (let ns = 1 : map (\x -> x + 1) ns in ns)))+main = print (showList (take 5 (let ns = 1 : map (\x -> x + 1) ns in ns)))  take 0 _      = [] take n (x:xs) = x : take (n - 1) xs@@ -7,4 +7,7 @@ map f (x:xs) = f x : map f xs  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"++showList :: [Double] -> String+showList = ffi "JSON.stringify(%1)"

@@ -1,4 +1,4 @@-main = print (show (take 5 (let ns = 1 : map (foo 123) ns in ns)))+main = print (showList (take 5 (let ns = 1 : map (foo 123) ns in ns)))  foo x y = x * y / 2 @@ -9,7 +9,7 @@ map f (x:xs) = f x : map f xs  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)" -show :: String -> String-show = ffi "JSON.stringify(%1)" FayString+showList :: [Double] -> String+showList = ffi "JSON.stringify(%1)"

@@ -3,4 +3,4 @@                False -> "Ney!")  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -3,4 +3,4 @@                False -> "Ney!")  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -3,4 +3,4 @@                _    -> "Ney!")  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -4,4 +4,4 @@                 Person "Chris" "Done" 13 -> "Hello!")  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -5,4 +5,4 @@                 _ -> "World!")  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -7,4 +7,4 @@                 _ -> "World!")  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -8,4 +8,4 @@ foo _ = "World!"  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -1,4 +1,4 @@ main = print "Hello," >> print "World!"  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -1,4 +1,4 @@ main = do print "Hello,"; print "World!"  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -3,4 +3,4 @@   print x  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -3,4 +3,4 @@   print "OK."  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -5,4 +5,4 @@   _           -> "Broken.")  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -1,4 +1,4 @@ main = print ((\a 'a' -> "OK.") 0 'b')  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -1,4 +1,4 @@ main = print (5 * 3 / 2)  print :: Double -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -14,7 +14,7 @@ sum n acc = sum (n - 1) (acc + n)  getSeconds :: Fay Double-getSeconds = foreignFay "new Date" FayNone+getSeconds = foreignFay "new Date"  print :: Double -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -5,7 +5,7 @@ import           Language.Fay.Prelude  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"  main :: Fay () main = print $ show $ fromInteger 5

@@ -0,0 +1,3 @@+[[1,2,3],[1,2,3]]+[[1,2,3],1,[2,3]]+[[1,2,3],1,[2,3]]

@@ -0,0 +1,28 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Test where++-- | As pattern matches++import Language.Fay.Prelude+import Language.Fay.FFI++matchSame :: [a] -> ([a],[a])+matchSame x@y = (x,y)++matchSplit :: [a] -> ([a],a,[a])+matchSplit x@(y:z) = (x,y,z)++matchNested :: (a, [b]) -> ([b],b,[b])+matchNested (a,b@(x:xs)) = (b,x,xs)++print :: String -> Fay ()+print = ffi "console.log(%1)"++main :: Fay ()+main = do+  print $ show $ matchSame [1,2,3]+  print $ show $ matchSplit [1,2,3]+  print $ show $ matchNested (1, [1,2,3])++show :: Foreign a => a -> String+show = ffi "JSON.stringify(%1)"

@@ -1,4 +1,4 @@ main = print 1  print :: Double -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -0,0 +1,3 @@+[true,false]+[2,1,0]+[true,false]

@@ -0,0 +1,30 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Test where++-- | As pattern matches++import Language.Fay.Prelude+import Language.Fay.FFI++isPositive :: Double -> Bool+isPositive x | x > 0 = True+             | x <= 0 = False++threeConds x | x > 1 = 2+             | x == 1 = 1+             | x < 1 = 0++withOtherwise x | x > 1 = True+                | otherwise = False++-- Not called, throws "non-exhaustive guard"+nonExhaustive x | x > 1 = True++print :: String -> Fay ()+print = ffi "console.log(%1)"++main :: Fay ()+main = do+  print $ show $ (isPositive 1, isPositive 0)+  print $ show $ (threeConds 3, threeConds 1, threeConds 0)+  print $ show $ (withOtherwise 2, withOtherwise 0)

@@ -0,0 +1,1 @@+Hai!

@@ -0,0 +1,32 @@+-- | Mutable references.++{-# LANGUAGE EmptyDataDecls    #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Ref where++import           Language.Fay.FFI+import           Language.Fay.Prelude++main :: Fay ()+main = do+  ref <- newRef "Hello, World!"+  x <- readRef ref+  writeRef ref "Hai!"+  readRef ref >>= print++data Ref a+instance Show (Ref a)+instance Foreign a => Foreign (Ref a)++newRef :: Foreign a => a -> Fay (Ref a)+newRef = ffi "new Fay$$Ref(%1)"++writeRef :: Foreign a => Ref a -> a -> Fay ()+writeRef = ffi "Fay$$writeRef(%1,%2)"++readRef :: Foreign a => Ref a -> Fay a+readRef = ffi "Fay$$readRef(%1)"++print :: String -> Fay ()+print = ffi "console.log(%1)"

@@ -1,4 +1,4 @@ main = print "Hello, World!"  print :: String -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -1,4 +1,4 @@ main = print (2 * 4 / 2)  print :: Double -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -1,4 +1,4 @@ main = print (10 + (2 * (4 / 2)))  print :: Double -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -1,4 +1,4 @@ main = print True  print :: Double -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"

@@ -3,7 +3,7 @@ main = print (head (fix (\xs -> 123 : xs)))  print :: Double -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"  head (x:xs) = x 

@@ -1,7 +1,7 @@ main = print (head (tail (fix (\xs -> 123 : xs))))  print :: Double -> Fay ()-print = ffi "console.log(%1)" FayNone+print = ffi "console.log(%1)"  head (x:xs) = x