diff --git a/docs/home.js b/docs/home.js deleted file mode 100644 --- a/docs/home.js +++ /dev/null @@ -1,462 +0,0 @@ -/** @constructor -*/ -var Home = function(){ -var True = true; -var False = false; - -/******************************************************************************* - * Thunks. - */ - -// Force a thunk (if it is a thunk) until WHNF. -function _(thunkish,nocache){ - while (thunkish instanceof $) { - thunkish = thunkish.force(nocache); - } - return thunkish; -} - -// Apply a function to arguments (see method2 in Fay.hs). -function __(){ - var f = arguments[0]; - for (var i = 1, len = arguments.length; i < len; i++) { - f = (f instanceof $? _(f) : f)(arguments[i]); - } - return f; -} - -// Thunk object. -function $(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()); -}; - -/******************************************************************************* - * Constructors. - */ - -// A constructor. -function Fay$$Constructor(){ - 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); -} - -/******************************************************************************* - * Monad. - */ - -function Fay$$Monad(value){ - this.value = value; -} - -// >> -function Fay$$then(a){ - 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); - }); - }; -} - -var Fay$$unit = null; - -// return -function Fay$$return(a){ - return new Fay$$Monad(a); -} - -/******************************************************************************* - * FFI. - */ - -// Serialize a Fay object to JS. -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 fayFunc = fayObj; - var return_type = args[args.length-1]; - var len = args.length; - // If some arguments. - if (len > 1) { - // Apply to all the arguments. - fayFunc = _(fayFunc,true); - // TODO: Perhaps we should throw an error when JS - // passes more arguments than Haskell accepts. - for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { - // Unserialize the JS values to Fay for the Fay callback. - fayFunc = _(fayFunc(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],fayFunc.value); - } - // Otherwise just serialize the value direct. - else { - return Fay$$serialize(return_type,fayFunc); - } - } 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); - } - 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; - } - case "bool": { - // Bools are unboxed. - 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(", ") + " })"; - } else { - var args = x.slice(1); - return "(" + [x[0].name].concat(args.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(); - } -} - -/******************************************************************************* - * Lists. - */ - -// Cons object. -function Fay$$Cons(car,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; -} - -// Built-in list cons. -function Fay$$cons(x){ - 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; - }; -} - -/******************************************************************************* - * Numbers. - */ - -// Built-in *. -function Fay$$mult(x){ - return function(y){ - return _(x) * _(y); - }; -} - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return _(x) + _(y); - }; -} - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return _(x) - _(y); - }; -} - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return _(x) / _(y); - }; -} - -/******************************************************************************* - * 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; - } - 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); - }; -} - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return !(Fay$$equal(x,y)); - }; -} - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return _(x) > _(y); - }; -} - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return _(x) < _(y); - }; -} - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return _(x) >= _(y); - }; -} - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return _(x) <= _(y); - }; -} - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return _(x) && _(y); - }; -} - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return _(x) || _(y); - }; -} - -/******************************************************************************* - * Mutable references. - */ - -// Make a new mutable reference. -function Fay$$Ref(x){ - this.value = x; -} - -// Write to the ref. -function Fay$$writeRef(ref,x){ - ref.value = x; -} - -// Get the value from the ref. -function Fay$$readRef(ref,x){ - return ref.value; -} - -/******************************************************************************* - * Dates. - */ -function Fay$$date(str){ - return window.Date.parse(str); -} - -/******************************************************************************* - * Application code. - */ - -var main = new $(function(){return _(_($36$)(_(ready)(_(wrap)(thedocument))))(_(_(Fay$$then)(indentAndHighlight))(_(_(Fay$$then)(setupExpanders))(setupTableOfContents)));});var indentAndHighlight = new $(function(){return _(_(Fay$$bind)(_(query)(Fay$$list(".language-javascript"))))(function($_a){var samples = $_a;return _(_(Fay$$then)(_(_($36$)(_(each)(samples)))(function($_a){var i = $_a;return function($_b){var _$this = $_b;return (function(){var sample = new $(function(){return _(wrap)(_$this);});return _(_(Fay$$bind)(_(getText)(sample)))(function($_a){var text = $_a;return _(_(Fay$$then)(_(_(setText)(sample))(_(_(beautify)(text))(2))))(_(Fay$$return)(true));});})();};})))(_(_(Fay$$then)(_(_(setTabReplace)(hljs))(Fay$$list(" "))))(_(initHighlightingOnLoad)(hljs)));});});var setupExpanders = new $(function(){return _(_(Fay$$bind)(_(_(Fay$$bind)(_(query)(Fay$$list(".wrap"))))(getWidth)))(function($_a){var wrapwidth = $_a;return _(_(Fay$$bind)(_(query)(Fay$$list(".example"))))(function($_a){var examples = $_a;return _(_($36$)(_(each)(examples)))(function($_a){var i = $_a;return function($_b){var _$this = $_b;return _(_(Fay$$bind)(_(_(getFind)(_(wrap)(_$this)))(Fay$$list("tr"))))(function($_a){var tr = $_a;return _(_(Fay$$bind)(_(_(Fay$$bind)(_(_(getFind)(tr))(Fay$$list("td"))))(getFirst)))(function($_a){var left = $_a;return _(_(Fay$$then)(_(_(addClass)(left))(Fay$$list("left"))))(_(_(Fay$$bind)(_(getNext)(left)))(function($_a){var right = $_a;return _(_(Fay$$bind)(_(makeElement)(Fay$$list("Show JavaScript"))))(function($_a){var toggle = $_a;return _(_(Fay$$bind)(_(_($36$)(Fay$$return))(_(_(Fay$$bind)(_(_(getIs)(right))(Fay$$list(":visible"))))(function($_a){var visible = $_a;return _(visible) ? _(_(Fay$$then)(_(_(setText)(toggle))(Fay$$list("Hide JavaScript"))))(_(_(_(swapClasses)(toggle))(Fay$$list("toggle-hide")))(Fay$$list("toggle-show"))) : _(_(Fay$$then)(_(_(setText)(toggle))(Fay$$list("Show JavaScript"))))(_(_(_(swapClasses)(toggle))(Fay$$list("toggle-show")))(Fay$$list("toggle-hide")));}))))(function($_a){var toggleButton = $_a;return _(_(Fay$$then)(_(_($36$)(_(setClick)(toggle)))(_(_($36$)(_(fadeToggle)(right)))(toggleButton))))(_(_(Fay$$bind)(_(getWidth)(tr)))(function($_a){var width = $_a;return _(_(Fay$$then)(_(_($36$)(_(when)(_(width) > _(_(wrapwidth) + _(_(20 * _(wrapwidth)) / 100)))))(_(hide)(right))))(_(_(Fay$$then)(toggleButton))(_(_(Fay$$bind)(_(_(getFind)(left))(Fay$$list(".panel"))))(function($_a){var panel = $_a;return _(_(Fay$$then)(_(_(prepend)(panel))(toggle)))(_(Fay$$return)(true));})));}));});});}));});});};});});});});var setupTableOfContents = new $(function(){return _(_(Fay$$bind)(_(makeElement)(Fay$$list("

Table of Contents

"))))(function($_a){var toc = $_a;return _(_(Fay$$then)(_(_(Fay$$bind)(_(query)(Fay$$list(".subheadline"))))(_(after)(toc))))(_(_(Fay$$bind)(_(_(Fay$$bind)(_(makeElement)(Fay$$list(""))))(_(appendTo)(toc))))(function($_a){var ul = $_a;return _(_(Fay$$bind)(_(query)(Fay$$list("h2"))))(function($_a){var headings = $_a;return _(_($36$)(_(each)(headings)))(function($_a){var i = $_a;return function($_b){var heading = $_b;return (function(){var anchor = new $(function(){return _(_($43$$43$)(Fay$$list("section-")))(_(show)(i));});var h = new $(function(){return _(wrap)(heading);});return _(_(Fay$$then)(_(_(_(attr)(h))(Fay$$list("id")))(anchor)))(_(_(Fay$$bind)(_(_(Fay$$bind)(_(makeElement)(Fay$$list("
  • "))))(_(appendTo)(ul))))(function($_a){var li = $_a;return _(_(Fay$$bind)(_(_(Fay$$bind)(_(makeElement)(Fay$$list(""))))(_(appendTo)(li))))(function($_a){var a = $_a;return _(_(Fay$$then)(_(_(Fay$$bind)(_(getText)(h)))(_(setText)(a))))(_(_(Fay$$then)(_(_(_(attr)(a))(Fay$$list("href")))(_(_($43$$43$)(Fay$$list("#")))(anchor))))(_(_(Fay$$then)(_(_(Fay$$bind)(_(getTagName)(heading)))(_(addClass)(li))))(_(Fay$$return)(true))));});}));})();};});});}));});});var thedocument = new $(function(){return Fay$$unserialize(["unknown"],window.document);});var getTagName = function($_a){return new $(function(){return Fay$$unserialize(["action",[["string"]]],Fay$$serialize(["unknown"],$_a)['tagName']);});};var wrap = function($_a){return new $(function(){return Fay$$unserialize(["unknown"],window['jQuery'](Fay$$serialize(["unknown"],$_a)));});};var ready = function($_a){return function($_b){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['ready'](Fay$$serialize(["action",[["unknown"]]],$_b)));});};};var each = function($_a){return function($_b){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['each'](Fay$$serialize(["function",[["double"],["unknown"],["action",[["bool"]]]]],$_b)));});};};var query = function($_a){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],window['jQuery'](Fay$$serialize(["string"],$_a)));});};var setText = function($_a){return function($_b){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['text'](Fay$$serialize(["string"],$_b)));});};};var attr = function($_a){return function($_b){return function($_c){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['attr'](Fay$$serialize(["string"],$_b),Fay$$serialize(["string"],$_c)));});};};};var setClick = function($_a){return function($_b){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['click'](Fay$$serialize(["action",[["unknown"]]],$_b)));});};};var fadeToggle = function($_a){return function($_b){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['fadeToggle'](Fay$$serialize(["action",[["unknown"]]],$_b)));});};};var hide = function($_a){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['hide']());});};var addClass = function($_a){return function($_b){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['addClass'](Fay$$serialize(["string"],$_b)));});};};var removeClass = function($_a){return function($_b){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['removeClass'](Fay$$serialize(["string"],$_b)));});};};var swapClasses = function($_a){return function($_b){return function($_c){return new $(function(){var removeme = $_c;var addme = $_b;var obj = $_a;return _(_(Fay$$then)(_(_(addClass)(obj))(addme)))(_(_(removeClass)(obj))(removeme));});};};};var getText = function($_a){return new $(function(){return Fay$$unserialize(["action",[["string"]]],Fay$$serialize(["unknown"],$_a)['text']());});};var getIs = function($_a){return function($_b){return new $(function(){return Fay$$unserialize(["action",[["bool"]]],Fay$$serialize(["unknown"],$_a)['is'](Fay$$serialize(["string"],$_b)));});};};var getSize = function($_a){return new $(function(){return Fay$$unserialize(["action",[["double"]]],Fay$$serialize(["unknown"],$_a)['length']);});};var getNext = function($_a){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['next']());});};var getFirst = function($_a){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['first']());});};var getFind = function($_a){return function($_b){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['find'](Fay$$serialize(["string"],$_b)));});};};var prepend = function($_a){return function($_b){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['prepend'](Fay$$serialize(["unknown"],$_b)));});};};var after = function($_a){return function($_b){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_b)['after'](Fay$$serialize(["unknown"],$_a)));});};};var append = function($_a){return function($_b){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['append'](Fay$$serialize(["unknown"],$_b)));});};};var appendTo = function($_a){return function($_b){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_b)['appendTo'](Fay$$serialize(["unknown"],$_a)));});};};var makeElement = function($_a){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],window['jQuery'](Fay$$serialize(["string"],$_a)));});};var getWidth = function($_a){return new $(function(){return Fay$$unserialize(["action",[["double"]]],Fay$$serialize(["unknown"],$_a)['width']());});};var beautify = function($_a){return function($_b){return new $(function(){return Fay$$unserialize(["string"],$jsBeautify(Fay$$serialize(["string"],$_a),Fay$$serialize(["double"],$_b)));});};};var hljs = new $(function(){return Fay$$unserialize(["unknown"],window['hljs']);});var initHighlightingOnLoad = function($_a){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['initHighlightingOnLoad']());});};var setTabReplace = function($_a){return function($_b){return new $(function(){return Fay$$unserialize(["action",[["unknown"]]],Fay$$serialize(["unknown"],$_a)['tabReplace']=Fay$$serialize(["string"],$_b));});};};var Just_RecConstr = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new Just_RecConstr(slot1);});};var Nothing_RecConstr = function(){};var Nothing = new $(function(){return new Nothing_RecConstr();});var show = function($_a){return new $(function(){return Fay$$unserialize(["string"],Fay$$encodeShow(Fay$$serialize(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {var p = $_a;return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {var p = $_a;return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var _$null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var GT_RecConstr = function(){};var GT = new $(function(){return new GT_RecConstr();});var LT_RecConstr = function(){};var LT = new $(function(){return new LT_RecConstr();});var EQ_RecConstr = function(){};var EQ = new $(function(){return new EQ_RecConstr();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof GT_RecConstr) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_(Fay$$then)(m))(_(Fay$$return)(Fay$$unit)) : _(Fay$$return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof Nothing_RecConstr) {var f = $_b;var m = $_a;return m;}if (_($_c) instanceof Just_RecConstr) {var x = _($_c).slot1;var f = $_b;var m = $_a;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;var f = $_a;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;var f = $_a;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$then)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _(Fay$$return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_(Fay$$then)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _(Fay$$return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};}; -// Exports -this.main = main; - -// Built-ins -this.$force = _; -this.$ = $; -this.$list = Fay$$list; -this.$encodeShow = Fay$$encodeShow; -this.$eval = Fay$$eval; -this.$serialize = Fay$$serialize; - -}; -; -var main = new Home(); -main.$force(main.main); - diff --git a/fay.cabal b/fay.cabal --- a/fay.cabal +++ b/fay.cabal @@ -1,5 +1,5 @@ name: fay -version: 0.6.0.0 +version: 0.9.1.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, @@ -12,7 +12,7 @@ . > $ cabal unpack fay > $ cd fay-* - > $ cabal install + > $ cabal install -fdevel > $ dist/build/fay-docs/fay-docs . . @@ -22,37 +22,21 @@ . /Release Notes/ . - * Added Compiler.compileFile to compile a file without writing to disk - . - * abstracted out constructorName function - . - * fix fixed RecConstr - . - * Fix RecConstr to avoid name conflicts. - . - * BREAKING CHANGES, READ THIS COMMIT. - . - * Added the new flags to the cmdline docs - . - * --output=file to specify where the result should be placed - . - * Exporting Language.Fay.Compiler - . - * Added the cmdline flag -include=dir1[,..dirN] which will look in the specified directories for imports + * Infix constructor applications and infix operator constructors. . - * CompileConfig now contains configDirectoryIncludes allowing imports to be located separately from where the base file + * Warn when NoImplicitPrelude isn't specified. . - * Add Paths_fay to cabal. + * Added fay --version. . - * Update docs and fix runtime regressions. + * Html wrapper enhancements. . - * Fix FFI callbacks when too many arguments are provided. + * Initial pass-through to collect record information. This means records can now be used before they're defined. . - * Fix patterns snippet. + * Expose more prelude functions. . - * Fixed a bug where would produce invalid code. And some minor refactorings. + * Fixed doctype typo in HTML wrappers. . - * Records are now stored in CompileState, _fields dropped from record representation + * Basic interactive shell . See full history at: homepage: http://fay-lang.org/ @@ -71,17 +55,73 @@ examples/tailrecursive.hs examples/data.hs examples/canvaswater.hs examples/canvaswater.html examples/haskell.png -- Test cases - tests/10 tests/10.hs tests/11 tests/11.hs tests/12 tests/12.hs tests/13 - tests/13.hs tests/14 tests/14.hs tests/15 tests/15.hs tests/16 tests/16.hs - tests/17 tests/17.hs tests/18 tests/18.hs tests/19 tests/19.hs - tests/2 tests/20 tests/20.hs tests/21 tests/21.hs tests/22 tests/22.hs - 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/30.hs tests/29 tests/30 tests/29.hs - tests/31.hs tests/31 + tests/asPatternMatch tests/caseList.hs + tests/Double2.hs tests/fromInteger tests/List.hs + tests/RecCon tests/recordPatternMatch + tests/String.hs tests/asPatternMatch.hs + tests/caseList.js tests/Double2.js + tests/fromInteger.hs tests/List.js + tests/RecCon.hs tests/recordPatternMatch2 + tests/String.js tests/asPatternMatch.js + tests/caseWildcard tests/Double3 + tests/fromInteger.js tests/Monad tests/RecCon.js + tests/recordPatternMatch2.hs tests/tailRecursion + tests/basicFunctions tests/caseWildcard.hs + tests/Double3.hs + tests/Monad2 tests/RecDecl + tests/recordPatternMatch2.js + tests/tailRecursion.hs tests/basicFunctions.hs + tests/caseWildcard.js tests/Double3.js + tests/HierarchicalImport tests/Monad2.hs + tests/RecDecl.hs tests/recordPatternMatch.hs + tests/tailRecursion.js tests/basicFunctions.js + tests/do tests/Double4 + tests/Monad2.js + tests/RecDecl.js tests/recordPatternMatch.js + tests/then tests/Bool tests/doAssingPatternMatch + tests/Double4.hs tests/HierarchicalImport.hs + tests/Monad.hs + tests/records tests/then.hs tests/Bool.hs + tests/doAssingPatternMatch.hs tests/Double4.js + tests/Monad.js + tests/recordFunctionPatternMatch + tests/records.hs tests/then.js tests/Bool.js + tests/doAssingPatternMatch.js tests/Double.hs + tests/HierarchicalImport.js + tests/mutableReference + tests/recordFunctionPatternMatch.hs + tests/records.js tests/utf8 tests/case + tests/doBindAssign tests/Double.js + tests/infixDataConst tests/mutableReference.hs + tests/recordFunctionPatternMatch.js + tests/recordUseBeforeDefine tests/utf8.hs + tests/case2 tests/doBindAssign.hs + tests/emptyMain tests/infixDataConst.hs + tests/mutableReference.js + tests/RecordImport_Export + tests/recordUseBeforeDefine.hs tests/utf8.js + tests/case2.hs tests/doBindAssign.js + tests/emptyMain.hs tests/infixDataConst.js + tests/patternGuards tests/RecordImport_Export.hs + tests/recordUseBeforeDefine.js tests/where + tests/case2.js tests/do.hs tests/emptyMain.js + tests/List tests/patternGuards.hs + tests/RecordImport_Export.js tests/reservedWords + tests/where.hs tests/case.hs tests/do.js + tests/fix tests/List2 tests/patternGuards.js + tests/RecordImport_Import tests/reservedWords.hs + tests/where.js tests/case.js tests/Double + tests/fix.hs tests/List2.hs + tests/patternMatchFail.hs + tests/RecordImport_Import.hs + tests/reservedWords.js tests/caseList + tests/Double2 tests/fix.js tests/List2.js + tests/patternMatchFail.js + tests/RecordImport_Import.js tests/String + tests/Hierarchical/Export.hs + tests/Hierarchical/RecordDefined.hs -- Documentation files - docs/beautify.js docs/highlight.pack.js docs/home.css docs/home.js docs/jquery.js + docs/beautify.js docs/highlight.pack.js docs/home.css docs/jquery.js docs/analytics.js -- Documentation snippets docs/snippets/conditions.hs @@ -96,72 +136,126 @@ docs/snippets/tail.hs docs/home.hs +Flag devel + Description: Whether to build fay-tests and fay-docs + Default: False + library hs-source-dirs: src - exposed-modules: Language.Fay, Language.Fay.Types, Language.Fay.FFI, Language.Fay.Prelude, Language.Fay.Show, Language.Fay.Compiler + exposed-modules: Language.Fay, Language.Fay.Types, Language.Fay.FFI, Language.Fay.Prelude, Language.Fay.Convert, Language.Fay.Compiler other-modules: Language.Fay.Print, Control.Monad.IO, Language.Fay.Stdlib, System.Process.Extra, Paths_fay - ghc-options: -O2 + ghc-options: -O2 -Wall build-depends: base >= 4 && < 5, mtl, haskell-src-exts, - json, + aeson, + unordered-containers, + attoparsec, + vector, + text, + utf8-string, + bytestring, pretty-show, data-default, safe, - language-javascript, + language-ecmascript, + syb, + process, + filepath, + directory, + groom + if flag(devel) + build-depends: -- Requirements for the executables which -- `cabal-dev ghci' needs. HUnit, - process, - filepath, - directory, blaze-html, blaze-markup, bytestring, - time + time, + options, + test-framework, + test-framework-hunit, + test-framework-th executable fay hs-source-dirs: src - ghc-options: -O2 + ghc-options: -O2 -Wall + ghc-prof-options: -fprof-auto main-is: Main.hs build-depends: base >= 4 && < 5, mtl, haskell-src-exts, - json, + aeson, + unordered-containers, + attoparsec, + vector, + text, + utf8-string, + bytestring, + pretty-show, process, data-default, safe, - language-javascript, + language-ecmascript, directory, - filepath + filepath, + groom, + options, + haskeline executable fay-tests + if !flag(devel) + buildable: False hs-source-dirs: src - ghc-options: -O2 + ghc-options: -O2 -Wall -threaded -with-rtsopts=-N + ghc-prof-options: -fprof-auto main-is: Tests.hs - other-modules: Language.Fay.Compiler - build-depends: base >= 4 && < 5, + other-modules: Language.Fay.Compiler Test.Convert Test.Api Test.CommandLine Test.Util + if flag(devel) + build-depends: base >= 4 && < 5, mtl, haskell-src-exts, - json, + aeson, + unordered-containers, + attoparsec, + vector, + text, + utf8-string, + bytestring, + pretty-show, HUnit, process, filepath, directory, data-default, safe, - language-javascript + language-ecmascript, + groom, + test-framework, + test-framework-hunit, + test-framework-th executable fay-docs + if !flag(devel) + buildable: False hs-source-dirs: src - ghc-options: -O2 + ghc-options: -O2 -Wall main-is: Docs.hs other-modules: Text.Blaze.Extra - build-depends: base >= 4 && < 5, + if flag(devel) + build-depends: base >= 4 && < 5, mtl, haskell-src-exts, - json, + aeson, + unordered-containers, + attoparsec, + vector, + text, + utf8-string, + bytestring, + pretty-show, HUnit, process, filepath, @@ -172,4 +266,5 @@ time, data-default, safe, - language-javascript + language-ecmascript, + groom diff --git a/js/runtime.js b/js/runtime.js --- a/js/runtime.js +++ b/js/runtime.js @@ -52,7 +52,9 @@ } // >> -function Fay$$then(a){ +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ return function(b){ return new $(function(){ _(a,true); @@ -62,7 +64,9 @@ } // >>= -function Fay$$bind(m){ +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ return function(f){ return new $(function(){ var monad = _(m,true); @@ -71,13 +75,13 @@ }; } -var Fay$$unit = null; - -// return -function Fay$$return(a){ +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ return new Fay$$Monad(a); } +var Fay$$unit = null; + /******************************************************************************* * Serialization. * Fay <-> JS. Should be bijective. @@ -157,14 +161,16 @@ jsObj = _(fayObj); break; } - case "unknown": { - // Just force unknown values to WHNF. + case "bool": { + // Bools are unboxed. jsObj = _(fayObj); break; } - case "bool": { - // Bools are unboxed. - jsObj = fayObj; + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); break; } default: throw new Error("Unhandled Fay->JS translation type: " + base); @@ -180,7 +186,7 @@ switch(base){ case "action": { // Unserialize a "monadic" JavaScript return value into a monadic value. - fayObj = Fay$$return(Fay$$jsToFay(args[0],jsObj)); + fayObj = new Fay$$Monad(Fay$$jsToFay(args[0],jsObj)); break; } case "string": { @@ -204,16 +210,20 @@ fayObj = jsObj; break; } - case "unknown": { - // Any unknown values can be left as-is. - fayObj = jsObj; - break; - } case "bool": { // Bools are unboxed. fayObj = jsObj; break; } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } default: throw new Error("Unhandled JS->Fay translation type: " + base); } return fayObj; @@ -291,26 +301,31 @@ */ // Are two values equal? -function Fay$$equal(lit1,lit2){ +function Fay$$equal(lit1, lit2) { // Simple case lit1 = _(lit1); lit2 = _(lit2); - if(lit1 === 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; + 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; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } } // Built-in ==. diff --git a/src/Docs.hs b/src/Docs.hs --- a/src/Docs.hs +++ b/src/Docs.hs @@ -6,18 +6,19 @@ module Main where -import Language.Fay (compileModule, compileViaStr) +import Language.Fay (compileForDocs, compileViaStr) import Language.Fay.Compiler (compileFromTo) +import Language.Fay.Types (CompileConfig (..)) import Control.Exception import Control.Monad import qualified Data.ByteString.Lazy as L import Data.Char import Data.Default -import Data.List (isSuffixOf, sort) + import Data.Time import Prelude hiding (div, head) -import System.Directory + import System.FilePath import Text.Blaze.Extra import Text.Blaze.Html5 as H hiding (contents, map, style) @@ -43,10 +44,10 @@ where compile file = do contents <- readFile file - putStrLn $ "Compiling " ++ file ++ " ..." - result <- compileViaStr def compileModule contents + putStrLn $ "Generating " ++ file ++ " ..." + result <- compileViaStr def { configFlattenApps = True, configTCO = True } compileForDocs contents case result of - Right (javascript,state) -> return javascript + Right (javascript,_) -> return javascript Left err -> throw err titlize = takeWhile (/='.') . upperize . takeFileName where upperize (x:xs) = toUpper x : xs @@ -57,11 +58,11 @@ generateJs = do putStrLn $ "Compiling " ++ inp ++ " to " ++ out ++ " ..." - compileFromTo def True inp out + compileFromTo def { configAutorun = True, configFlattenApps = True } inp out where docs = ("docs" ) - inp = (docs "home.hs") - out = (docs "home.js") + inp = docs "home.hs" + out = docs "home.js" page now analytics examples = do docType @@ -92,7 +93,7 @@ preEscapedToMarkup analytics fork = - a ! href "https://github.com/chrisdone/fay" $ + a ! href "https://github.com/faylang/fay" $ img ! style "position: absolute; top: 0; right: 0; border: 0;" ! src "https://s3.amazonaws.com/github/ribbons/forkme_right_darkblue_121621.png" ! alt "Fork me on GitHub" @@ -227,17 +228,18 @@ pre $ code "$ cabal install fay" h3 "From Github" p "If you want to hack on the compiler, you can download the Git repo: " - pre $ code "$ git clone git://github.com/chrisdone/fay.git" + pre $ code "$ git clone git://github.com/faylang/fay.git" p "And then install from the directory: " pre $ code "$ cabal install" h3 "Running" - p "To check that everything is okay, run the tests (you will need nodejs installed):" + p "If developing, you can run the tests (you will need nodejs installed):" + pre $ code "$ cabal install -fdevel" pre $ code "$ fay-tests" p "To compile a Fay program, run:" - pre $ code "$ fay -autorun foo.hs" - p $ do "The "; code "-autorun"; " flag will make sure that the "; code "main"; " function is called." + pre $ code "$ fay --autorun foo.hs" + p $ do "The "; code "--autorun"; " flag will make sure that the "; code "main"; " function is called." p "You can also install this via cabal-dev, but be sure to run the commands from the cabal-dev bin dir: " - pre $ code "$ cabal-dev install\n$ cabal-dev/bin/fay -autorun foo.hs" + pre $ code "$ cabal-dev install\n$ cabal-dev/bin/fay --autorun foo.hs" h3 "Generate this Documentation" p "This web page is generated by the following call in the project directory:" pre $ code "$ fay-docs" diff --git a/src/Language/Fay.hs b/src/Language/Fay.hs --- a/src/Language/Fay.hs +++ b/src/Language/Fay.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} @@ -11,10 +10,21 @@ -- | The Haskell→Javascript compiler. module Language.Fay - + (compile + ,runCompile + ,compileViaStr + ,compileForDocs + ,compileToAst + ,compileFromStr + ,compileModule + ,compileExp + ,printCompile + ,printTestCompile + ,compileToplevelModule + ,prettyPrintString) where -import Language.Fay.Print () +import Language.Fay.Print (jsEncodeName) import Language.Fay.Types import Control.Applicative @@ -22,34 +32,30 @@ import Control.Monad.IO import Control.Monad.State import Data.Char -import Data.Default (def) +import Data.Default (def) import Data.List import Data.Maybe import Data.String import Language.Haskell.Exts import Safe -import System.FilePath (()) -import System.Directory (doesFileExist) +import System.Directory (doesFileExist, findExecutable) +import System.Exit +import System.FilePath (()) +import System.IO +import System.Process -import qualified Language.JavaScript.Parser as JS -import System.Process.Extra +import qualified Language.ECMAScript3.Parser as JS -------------------------------------------------------------------------------- -- Top level entry points -- | Compile something that compiles to something else. compile :: CompilesTo from to => CompileConfig -> from -> IO (Either CompileError (to,CompileState)) -compile config = runCompile config . compileTo +compile config = runCompile (defaultCompileState config) . compileTo -- | Run the compiler. -runCompile :: CompileConfig -> Compile a -> IO (Either CompileError (a,CompileState)) -runCompile config m = runErrorT (runStateT (unCompile m) state) where - state = CompileState { stateConfig = config - , stateExports = [] - , stateModuleName = "Main" - , stateExportAll = True - , stateRecords = [] - } +runCompile :: CompileState -> Compile a -> IO (Either CompileError (a,CompileState)) +runCompile state m = runErrorT (runStateT (unCompile m) state) where -- | Compile a Haskell source string to a JavaScript source string. compileViaStr :: (Show from,Show to,CompilesTo from to) @@ -58,30 +64,39 @@ -> String -> IO (Either CompileError (String,CompileState)) compileViaStr config with from = - runCompile config + runCompile (defaultCompileState config) (parseResult (throwError . uncurry ParseError) (fmap printJS . with) - (parse from)) + (parseFay from)) -- | Compile a Haskell source string to a JavaScript source string. compileToAst :: (Show from,Show to,CompilesTo from to) - => CompileConfig + => CompileState -> (from -> Compile to) -> String -> IO (Either CompileError (to,CompileState)) -compileToAst config with from = - runCompile config +compileToAst state with from = + runCompile state (parseResult (throwError . uncurry ParseError) with - (parse from)) + (parseFay from)) -- | Compile from a string. compileFromStr :: (Parseable a, MonadError CompileError m) => (a -> m a1) -> String -> m a1 compileFromStr with from = parseResult (throwError . uncurry ParseError) - (with) - (parse from) + with + (parseFay from) +-- | Parse some Fay code. +parseFay :: Parseable ast => String -> ParseResult ast +parseFay = parseWithMode parseMode + +-- | The parse mode for Fay. +parseMode :: ParseMode +parseMode = defaultParseMode { extensions = [GADTs,StandaloneDeriving,EmptyDataDecls,TypeOperators] } + +-- | Compile the given input and print the output out prettily. printCompile :: (Show from,Show to,CompilesTo from to) => CompileConfig -> (from -> Compile to) @@ -90,21 +105,108 @@ printCompile config with from = do result <- compileViaStr config with from case result of - Left err -> putStrLn $ show err - Right (ok,_) -> do writeFile "/tmp/x.js" ok - prettyPrintFile "/tmp/x.js" >>= putStr + Left err -> print err + Right (ok,_) -> prettyPrintString ok >>= putStr -- | Compile a String of Fay and print it as beautified JavaScript. printTestCompile :: String -> IO () -printTestCompile = printCompile def compileModule +printTestCompile = printCompile def compileToplevelModule +-- | Compile the given Fay code for the documentation. This is +-- specialised because the documentation isn't really “real” +-- compilation. +compileForDocs :: Module -> Compile [JsStmt] +compileForDocs mod = do + initialPass mod + compileModule mod +-- | Compile the top-level Fay module. +compileToplevelModule :: Module -> Compile [JsStmt] +compileToplevelModule mod = do + initialPass mod + stmts <- compileModule mod + fay2js <- gets (fayToJsDispatcher . stateFayToJs) + js2fay <- gets (jsToFayDispatcher . stateJsToFay) + return (stmts ++ [fay2js,js2fay]) + -------------------------------------------------------------------------------- +-- Initial pass-through collecting record definitions + +initialPass :: Module -> Compile () +initialPass (Module _ _ _ Nothing _ imports decls) = do + mapM_ initialPass_import imports + mapM_ (initialPass_decl True) decls + +initialPass mod = throwError (UnsupportedModuleSyntax mod) + +initialPass_import :: ImportDecl -> Compile () +initialPass_import (ImportDecl _ (ModuleName name) _ _ _ _ _) + | elem name ["Language.Fay.Prelude","Language.Fay.FFI","Language.Fay.Types"] || name == "Prelude" = return () +initialPass_import (ImportDecl _ (ModuleName name) False _ Nothing Nothing Nothing) = do + dirs <- configDirectoryIncludes <$> gets stateConfig + contents <- io (findImport dirs name) + cs <- gets id + result <- liftIO $ initialPass_records cs initialPass contents + case result of + Right ((),state) -> do + -- Merges the state gotten from passing through an imported + -- module with the current state. We can assume no duplicate + -- records exist since GHC would pick that up. + modify $ \s -> s { stateRecords = stateRecords state ++ stateRecords s } + Left err -> throwError err + + +initialPass_import i = + error $ "Initial pass: Import syntax not supported. " ++ + "The compiler writer was too lazy to support that.\n" ++ + "It was: " ++ show i + +initialPass_records :: (Show from,Parseable from) + => CompileState + -> (from -> Compile ()) + -> String + -> IO (Either CompileError ((),CompileState)) +initialPass_records compileState with from = + runCompile compileState + (parseResult (throwError . uncurry ParseError) + with + (parseFay from)) + +initialPass_decl :: Bool -> Decl -> Compile () +initialPass_decl toplevel decl = + case decl of + DataDecl _ DataType _ _ _ constructors _ -> initialPass_dataDecl toplevel decl constructors + GDataDecl _ DataType _l _i _v _n decls _ -> initialPass_dataDecl toplevel decl (map convertGADT decls) + _ -> return () + +-- | Collect record definitions and store record name and field names. +-- A ConDecl will have fields named slot1..slotN +initialPass_dataDecl :: Bool -> Decl -> [QualConDecl] -> Compile () +initialPass_dataDecl _ decl constructors = + forM_ constructors $ \(QualConDecl _ _ _ condecl) -> + case condecl of + ConDecl (UnQual -> name) types -> do + let fields = map (Ident . ("slot"++) . show . fst) . zip [1 :: Integer ..] $ types + addRecordState name fields + InfixConDecl t1 (UnQual -> name) t2 -> + addRecordState name ["slot1", "slot2"] + RecDecl (UnQual -> name) fields' -> do + let fields = concatMap fst fields' + addRecordState name fields + + where + addRecordState :: QName -> [Name] -> Compile () + addRecordState name fields = modify $ \s -> s { stateRecords = (Ident (qname name), fields) : stateRecords s } + + +-------------------------------------------------------------------------------- -- Compilers + -- | Compile Haskell module. compileModule :: Module -> Compile [JsStmt] -compileModule (Module _ modulename _pragmas Nothing exports imports decls) = do +compileModule (Module _ modulename pragmas Nothing exports imports decls) = do + checkModulePragmas pragmas modify $ \s -> s { stateModuleName = modulename , stateExportAll = isNothing exports } @@ -114,6 +216,15 @@ return (imported ++ current) compileModule mod = throwError (UnsupportedModuleSyntax mod) +checkModulePragmas :: [ModulePragma] -> Compile () +checkModulePragmas pragmas = + when (not $ any noImplicitPrelude pragmas) $ + liftIO $ hPutStrLn stderr "Warning: NoImplicitPrelude not specified" + where + noImplicitPrelude :: ModulePragma -> Bool + noImplicitPrelude (LanguagePragma _ names) = any (== (Ident "NoImplicitPrelude")) names + noImplicitPrelude _ = False + instance CompilesTo Module [JsStmt] where compileTo = compileModule findImport :: [FilePath] -> String -> IO String @@ -135,19 +246,23 @@ compileImport (ImportDecl _ (ModuleName name) False _ Nothing Nothing Nothing) = do dirs <- configDirectoryIncludes <$> gets stateConfig contents <- io (findImport dirs name) - cfg <- config id - result <- liftIO $ compileToAst cfg compileModule contents + state <- gets id + result <- liftIO $ compileToAst state compileModule contents case result of - Right (stmts,_) -> return stmts + Right (stmts,state) -> do + modify $ \s -> s { stateFayToJs = stateFayToJs state ++ stateFayToJs s + , stateJsToFay = stateJsToFay state ++ stateJsToFay s + } + return stmts Left err -> throwError err compileImport i = - error $ "Import syntax not supported. " ++ + error $ "compileImport: Import syntax not supported. " ++ "The compiler writer was too lazy to support that.\n" ++ "It was: " ++ show i -- | Compile Haskell declaration. compileDecls :: Bool -> [Decl] -> Compile [JsStmt] -compileDecls toplevel decls = do +compileDecls toplevel decls = case decls of [] -> return [] (TypeSig _ _ sig:bind@PatBind{}:decls) -> appendM (compilePatBind toplevel (Just sig) bind) @@ -166,17 +281,19 @@ pat@PatBind{} -> compilePatBind toplevel Nothing pat FunBind matches -> compileFunCase toplevel matches DataDecl _ DataType _ _ _ constructors _ -> compileDataDecl toplevel decl constructors + GDataDecl _ DataType _l _i _v _n decls _ -> compileDataDecl toplevel decl (map convertGADT decls) -- Just ignore type aliases and signatures. TypeDecl{} -> return [] TypeSig{} -> return [] InfixDecl{} -> return [] ClassDecl{} -> return [] InstDecl{} -> return [] -- FIXME: Ignore. + DerivDecl{} -> return [] _ -> throwError (UnsupportedDeclaration decl) -- | Compile a top-level pattern bind. compilePatBind :: Bool -> Maybe Type -> Decl -> Compile [JsStmt] -compilePatBind toplevel sig pat = do +compilePatBind toplevel sig pat = case pat of PatBind _ (PVar ident) Nothing (UnGuardedRhs rhs) (BDecls []) -> case ffiExp rhs of @@ -198,8 +315,8 @@ -> Compile [JsStmt] 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) + case JS.parse JS.parseExpression (prettyPrint name) (printJS (wrapReturn inner)) of + Left err -> throwError (FfiFormatInvalidJavaScript inner (show err)) Right{} -> fmap return (bindToplevel True (UnQual name) (body inner)) where body inner = foldr wrapParam (wrapReturn inner) params @@ -227,7 +344,7 @@ rest <- go xs return ('%' : rest) go ['%'] = throwError FfiFormatIncompleteArg - go ('%':(span isDigit -> (op,xs))) = do + go ('%':(span isDigit -> (op,xs))) = case readMay op of Nothing -> throwError (FfiFormatBadChars op) Just n -> do @@ -242,21 +359,25 @@ case listToMaybe (drop (n-1) args) of Nothing -> throwError (FfiFormatNoSuchArg n) Just (arg,typ) -> do - return (printJS (fayToJs typ (JsName arg))) + return (printJS (fayToJs (typeRep typ) (JsName arg))) -- | Translate: Fay → JS. -fayToJs :: FundamentalType -> JsExp -> JsExp +fayToJs :: JsExp -> JsExp -> JsExp fayToJs typ exp = JsApp (JsName (hjIdent "fayToJs")) - [typeRep typ,exp] + [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] + 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]] + UserDefined name xs -> JsList [JsLit $ JsStr "user" + ,JsLit $ JsStr (unname name) + ,JsList (map typeRep xs)] + typ -> JsList [JsLit $ JsStr nom] + where nom = case typ of StringType -> "string" DoubleType -> "double" @@ -277,15 +398,32 @@ argType :: Type -> FundamentalType argType t = case t of - TyApp (TyCon "Fay") a -> JsType (argType a) TyCon "String" -> StringType TyCon "Double" -> DoubleType TyCon "Bool" -> BoolType + TyApp (TyCon "Fay") a -> JsType (argType a) TyFun x xs -> FunctionType (argType x : functionTypeArgs xs) TyList x -> ListType (argType x) TyParen st -> argType st - _ -> UnknownType + TyApp op arg -> userDefined (reverse (arg : expandApp op)) + _ -> + -- No semantic point to this, merely to avoid GHC's broken + -- warning. + case t of + TyCon (UnQual user) -> UserDefined user [] + _ -> UnknownType +-- | Generate a user-defined type. +userDefined :: [Type] -> FundamentalType +userDefined (TyCon (UnQual name):typs) = UserDefined name (map argType typs) +userDefined _ = UnknownType + +-- | Expand a type application. +expandApp :: Type -> [Type] +expandApp (TyParen t) = expandApp t +expandApp (TyApp op arg) = arg : expandApp op +expandApp x = [x] + -- | Get the arity of a type. typeArity :: Type -> Int typeArity t = @@ -302,31 +440,50 @@ bind <- bindToplevel toplevel (UnQual ident) (thunk body) return [bind] +convertGADT :: GadtDecl -> QualConDecl +convertGADT d = + case d of + GadtDecl srcloc name typ -> QualConDecl srcloc tyvars context + (ConDecl name (convertFunc typ)) + where tyvars = [] + context = [] + convertFunc (TyCon _) = [] + convertFunc (TyFun x xs) = UnBangedTy x : convertFunc xs + convertFunc (TyParen x) = convertFunc x + convertFunc _ = [] + -- | Compile a data declaration. compileDataDecl :: Bool -> Decl -> [QualConDecl] -> Compile [JsStmt] -compileDataDecl toplevel decl constructors = do +compileDataDecl toplevel decl constructors = fmap concat $ forM constructors $ \(QualConDecl _ _ _ condecl) -> case condecl of ConDecl (UnQual -> name) types -> do let fields = map (Ident . ("slot"++) . show . fst) . zip [1 :: Integer ..] $ types - addRecordState name fields + fields' = (zip (map return fields) types) cons <- makeConstructor name fields func <- makeFunc name fields + emitFayToJs name fields' + emitJsToFay name fields' return [cons, func] + InfixConDecl t1 (UnQual -> name) t2 -> do + let slots = [Ident "slot1", Ident "slot2"] + fields = zip (map return slots) [t1, t2] + cons <- makeConstructor name slots + func <- makeFunc name slots + emitFayToJs name fields + emitJsToFay name fields + return [cons, func] RecDecl (UnQual -> name) fields' -> do let fields = concatMap fst fields' - addRecordState name fields cons <- makeConstructor name fields func <- makeFunc name fields funs <- makeAccessors fields + emitFayToJs name fields' + emitJsToFay name fields' return (cons : func : funs) - _ -> throwError (UnsupportedDeclaration decl) where - addRecordState :: QName -> [Name] -> Compile () - addRecordState name fields = modify $ \s -> s { stateRecords = (Ident (qname name), fields) : stateRecords s } - -- Creates a constructor R_RecConstr for a Record makeConstructor name fields = do let fieldParams = map (fromString . unname) fields @@ -347,18 +504,104 @@ fieldParams -- Creates getters for a RecDecl's values - makeAccessors fields = do + makeAccessors fields = forM fields $ \(Ident name) -> bindToplevel toplevel (fromString name) (JsFun ["x"] [] - (Just (thunk (JsGetProp (force (JsName "x")) (fromString name))))) + (Just (thunk (JsGetProp (force (JsName "x")) + (fromString name))))) +fayToJsDispatcher :: [JsStmt] -> JsStmt +fayToJsDispatcher cases = + JsVar (hjIdent "fayToJsUserDefined") + (JsFun ["type",transcodingObj] + (decl ++ cases ++ [baseCase]) + Nothing) + + where decl = [JsVar transcodingObjForced + (force (JsName transcodingObj)) + ,JsVar "argTypes" + (JsLookup (JsName "type") + (JsLit (JsInt 2)))] + baseCase = + JsEarlyReturn (JsName transcodingObj) + -- JsThrow (JsNew "Error" + -- [JsLit (JsStr "No handler for translating this Fay value to a JS value.")]) + +-- Make a Fay→JS encoder. +emitFayToJs :: QName -> [([Name], BangType)] -> Compile () +emitFayToJs name (explodeFields -> fieldTypes) = + modify $ \s -> s { stateFayToJs = translator : stateFayToJs s } + + where + translator = JsIf (JsInstanceOf (JsName transcodingObjForced) (constructorName name)) + [JsEarlyReturn (JsObj (("instance",JsLit (JsStr (qname name))) + : zipWith declField [0..] fieldTypes))] + [] + -- Declare/encode Fay→JS field + declField :: Int -> (Name,BangType) -> (String,JsExp) + declField _i (name,typ) = + (unname name + ,fayToJs (case argType (bangType typ) of + known -> typeRep known) + (force (JsGetProp (JsName transcodingObjForced) + (UnQual name)))) + +jsToFayDispatcher :: [JsStmt] -> JsStmt +jsToFayDispatcher cases = + JsVar (hjIdent "jsToFayUserDefined") + (JsFun ["type",transcodingObj] + (cases ++ [baseCase]) + Nothing) + + where baseCase = + JsEarlyReturn (JsName transcodingObj) + -- JsThrow (JsNew "Error" + -- [JsLit (JsStr "No handler for translating this JS value to a Fay value.")]) + +-- Make a JS→Fay decoder +emitJsToFay :: QName -> [([Name], BangType)] -> Compile () +emitJsToFay name (explodeFields -> fieldTypes) = + modify $ \s -> s { stateJsToFay = translator : stateJsToFay s } + + where + translator = + JsIf (JsEq (JsGetPropExtern (JsName transcodingObj) "instance") + (JsLit (JsStr (qname name)))) + [JsEarlyReturn (JsNew (constructorName name) + (map decodeField fieldTypes))] + [] + -- Decode JS→Fay field + decodeField :: (Name,BangType) -> JsExp + decodeField (name,typ) = + jsToFay (argType (bangType typ)) + (JsGetPropExtern (JsName transcodingObj) + (unname name)) + +explodeFields :: [([a], t)] -> [(a, t)] +explodeFields = concatMap $ \(names,typ) -> map (,typ) names + +transcodingObj :: JsName +transcodingObj = "obj" + +transcodingObjForced :: JsName +transcodingObjForced = "_obj" + +-- | Extract the type. +bangType :: BangType -> Type +bangType typ = + case typ of + BangedTy ty -> ty + UnBangedTy ty -> ty + UnpackedTy ty -> ty + -- | Extract the string from a qname. qname :: QName -> String qname (UnQual (Ident str)) = str -qname _ = error "qname: Expected unqualified ident." -- FIXME: +qname (UnQual (Symbol sym)) = jsEncodeName sym +qname i = error $ "qname: Expected unqualified ident, found: " ++ show i -- FIXME: -- | Extra the string from an ident. unname :: Name -> String @@ -366,7 +609,7 @@ unname _ = error "Expected ident from uname." -- FIXME: constructorName :: QName -> QName -constructorName = fromString . (++ "$_") . qname +constructorName = fromString . ("$_" ++) . qname -- | Compile a function which pattern matches (causing a case analysis). compileFunCase :: Bool -> [Match] -> Compile [JsStmt] @@ -377,8 +620,8 @@ unless (noBinds wheres) $ do _ <- throwError (UnsupportedWhereInMatch match) -- TODO: Support `where'. return () exp <- compileRhs rhs - foldM (\inner (arg,pat) -> do - compilePat (JsName arg) pat inner) + foldM (\inner (arg,pat) -> + compilePat (JsName arg) pat inner) [JsEarlyReturn exp] (zip args pats) bind <- bindToplevel toplevel @@ -433,18 +676,22 @@ -- | Expand a forced value into the value. expand :: JsExp -> Maybe [JsExp] -expand (JsApp (JsName (UnQual (Ident "_"))) xs) = do +expand (JsApp (JsName (UnQual (Ident "_"))) xs) = fmap concat (mapM flatten xs) expand _ = Nothing --- | Format a JS file using "js-beautify", or return the JS as-is if --- "js-beautify" is unavailable -prettyPrintFile :: String -> IO String -prettyPrintFile file = - (readAllFromProcess "js-beautify" file) - >>= (either - (\_ -> (readFile file) >>= (\js -> return $ js ++ "\n")) - return) +-- | Format a JS string using "js-beautify", or return the JS as-is if +-- "js-beautify" is unavailable. +prettyPrintString :: String -> IO String +prettyPrintString contents = do + mexe <- findExecutable "js-beautify" + case mexe of + Nothing -> return $ contents ++ "\n" + Just exe -> do + (code,out,_) <- readProcessWithExitCode exe ["--stdin"] contents + case code of + ExitSuccess -> return out + ExitFailure _ -> return $ contents ++ "\n" -- | Compile a right-hand-side expression. compileRhs :: Rhs -> Compile JsExp @@ -455,38 +702,19 @@ 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) = +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 = - case match of - (Match _ name args Nothing (UnGuardedRhs rhs) _) -> do - body <- compileExp rhs - args <- mapM patToArg args - bind <- bindToplevel toplevel - (UnQual name) - (foldr (\arg inner -> JsFun [arg] [] (Just inner)) - (thunk body) - args) - return [bind] - match -> throwError (UnsupportedMatchSyntax match) - - where patToArg (PVar name) = return (UnQual name) - patToArg _ = throwError (UnsupportedMatchSyntax match) - -instance CompilesTo Decl [JsStmt] where compileTo = compileDecl False - -- | Compile Haskell expression. compileExp :: Exp -> Compile JsExp compileExp exp = case exp of Paren exp -> compileExp exp - Var (UnQual (Ident "return")) -> return (JsName (hjIdent "return")) +-- Commented out: See #59 +-- Var (UnQual (Ident "return")) -> return (JsName (hjIdent "return")) Var qname -> return (JsName qname) Lit lit -> compileLit lit App exp1 exp2 -> compileApp exp1 exp2 @@ -599,12 +827,12 @@ exp <- compileExp exp pats <- fmap optimizePatConditions $ mapM (compilePatAlt (JsName (tmpName exp))) alts return $ - (JsApp (JsFun [tmpName exp] - (concat pats) - (if any isWildCardAlt alts - then Nothing - else Just (throwExp "unhandled case" (JsName (tmpName exp))))) - [exp]) + JsApp (JsFun [tmpName exp] + (concat pats) + (if any isWildCardAlt alts + then Nothing + else Just (throwExp "unhandled case" (JsName (tmpName exp))))) + [exp] -- | Compile a do block. compileDoBlock :: [Stmt] -> Compile JsExp @@ -631,11 +859,11 @@ Qualifier exp -> return (Just (InfixApp exp (QVarOp (UnQual (Symbol ">>"))) inner)) - LetStmt{} -> throwError LetUnsupported + LetStmt (BDecls binds) -> return (Just (Let (BDecls binds) inner)) RecStmt{} -> throwError RecursiveDoUnsupported compileGenerator srcloc pat inner exp = do - let body = (Lambda srcloc [pat] inner) + let body = Lambda srcloc [pat] inner return (Just (InfixApp exp (QVarOp (UnQual (Symbol ">>="))) body)) @@ -648,9 +876,9 @@ -- | Compile the given pattern against the given expression. compilePat :: JsExp -> Pat -> [JsStmt] -> Compile [JsStmt] -compilePat exp pat body = do +compilePat exp pat body = case pat of - PVar name -> return ([JsVar (UnQual name) exp] ++ body) + PVar name -> return $ JsVar (UnQual name) exp : body PApp cons pats -> compilePApp cons pats exp body PLit literal -> compilePLit exp literal body PParen pat -> compilePat exp pat body @@ -713,14 +941,16 @@ -- Everything else, generic: _ -> do rf <- lookup (Ident (qname cons)) <$> gets stateRecords - recordFields <- return $ case rf of - Just x -> x - Nothing -> error "Record name was not found in stateRecords, should be impossible" + let recordFields = + fromMaybe + (error $ "Constructor '" ++ qname cons ++ + "' was not found in stateRecords, did you try running this through GHC first?") + rf substmts <- foldM (\body (Ident field,pat) -> compilePat (JsGetProp forcedExp (fromString field)) pat body) body (reverse (zip recordFields pats)) - return [JsIf (forcedExp `JsInstanceOf` (constructorName cons)) + return [JsIf (forcedExp `JsInstanceOf` constructorName cons) substmts []] @@ -730,13 +960,12 @@ return [JsIf (JsEq (force exp) JsNull) body []] compilePList pats body exp = do let forcedExp = force exp - substmts <- foldM (\body (i,pat) -> compilePat (JsApp (JsApp (JsName (hjIdent "index")) - [JsLit (JsInt i)]) - [forcedExp]) - pat body) - body - (reverse (zip [0..] pats)) - return substmts + foldM (\body (i,pat) -> compilePat (JsApp (JsApp (JsName (hjIdent "index")) + [JsLit (JsInt i)]) + [forcedExp]) + pat body) + body + (reverse (zip [0..] pats)) -- | Compile an infix pattern (e.g. cons and tuples.) compileInfixPat :: JsExp -> Pat -> [JsStmt] -> Compile [JsStmt] @@ -744,8 +973,8 @@ case cons of Cons -> do let forcedExp = JsName (tmpName exp) - x = (JsGetProp forcedExp "car") - xs = (JsGetProp forcedExp "cdr") + x = JsGetProp forcedExp "car" + xs = JsGetProp forcedExp "cdr" rightMatch <- compilePat xs right body leftMatch <- compilePat x left rightMatch return [JsVar (tmpName exp) (force exp) @@ -802,7 +1031,7 @@ -- | Optimize pattern matching conditions by merging conditions in common. optimizePatConditions :: [[JsStmt]] -> [[JsStmt]] -optimizePatConditions = concat . map merge . groupBy sameIf where +optimizePatConditions = concatMap merge . groupBy sameIf where sameIf [JsIf cond1 _ _] [JsIf cond2 _ _] = cond1 == cond2 sameIf _ _ = False merge xs@([JsIf cond _ _]:_) = @@ -854,10 +1083,6 @@ _ -> JsNew ":thunk" [JsFun [] [] (Just exp)] -- | Wrap an expression in a thunk. -monad :: JsExp -> JsExp -monad exp = JsNew (hjIdent "Monad") [exp] - --- | Wrap an expression in a thunk. stmtsThunk :: [JsStmt] -> JsExp stmtsThunk stmts = JsNew ":thunk" [JsFun [] stmts Nothing] @@ -899,9 +1124,8 @@ | symbol == "<=" -> return (Var (hjIdent "lte")) | symbol == "&&" -> return (Var (hjIdent "and")) | symbol == "||" -> return (Var (hjIdent "or")) - | symbol == ">>=" -> return (Var (hjIdent "bind")) - | symbol == ">>" -> return (Var (hjIdent "then")) | otherwise -> return (Var (fromString symbol)) + n@(UnQual Ident{}) -> return (Var n) Special Cons -> return (Var (hjIdent "cons")) _ -> throwError (UnsupportedOperator op) @@ -940,3 +1164,5 @@ -- | Get a config option. config :: (CompileConfig -> a) -> Compile a config f = gets (f . stateConfig) + +instance IsString Name where fromString = Ident diff --git a/src/Language/Fay/Compiler.hs b/src/Language/Fay/Compiler.hs --- a/src/Language/Fay/Compiler.hs +++ b/src/Language/Fay/Compiler.hs @@ -1,74 +1,125 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} module Language.Fay.Compiler where -import Control.Exception (throw) -import Language.Fay (compileModule, compileViaStr) -import Language.Fay.Types -import Language.Haskell.Exts.Syntax -import Paths_fay +import Language.Fay (compileToplevelModule,compileViaStr,prettyPrintString) +import Language.Fay.Types +import Control.Monad +import Language.Haskell.Exts.Syntax +import Paths_fay +import System.FilePath +import Text.Groom + +-- | A result of something the compiler writes. +class Writer a where + writeout :: a -> String -> IO () + +-- | Something to feed into the compiler. +class Reader a where + readin :: a -> IO String + +-- | Simple file writer. +instance Writer FilePath where + writeout = writeFile + +-- | Simple file reader. +instance Reader FilePath where + readin = readFile + -- | Compile file program to… -compileFromTo :: CompileConfig -> Bool -> FilePath -> FilePath -> IO () -compileFromTo config autorun filein fileout = do - result <- compileFile config autorun filein +compileFromTo :: CompileConfig -> FilePath -> FilePath -> IO () +compileFromTo config filein fileout = do + result <- compileFile config filein case result of - Right out -> writeFile fileout out - Left err -> throw err + Right out -> do + writeFile fileout out + when (configHtmlWrapper config) $ + writeFile (replaceExtension fileout "html") $ unlines [ + "" + , "" + , " " + , unlines . map (" "++) . map makeScriptTagSrc $ configHtmlJSLibs config + , " " ++ makeScriptTagSrc relativeJsPath + , " " + , " " + , " " + , " " + , ""] + where relativeJsPath = makeRelative (dropFileName fileout) fileout + makeScriptTagSrc :: FilePath -> String + makeScriptTagSrc = \s -> + "" + Left err -> error . groom $ err -compileFile :: CompileConfig -> Bool -> FilePath -> IO (Either CompileError String) -compileFile config autorun filein = do +-- | Compile readable/writable values. +compileReadWrite :: (Reader r, Writer w) => CompileConfig -> r -> w -> IO () +compileReadWrite config reader writer = do + result <- compileFile config reader + case result of + Right out -> do + writeout writer out + Left err -> error . groom $ err + +-- | Compile the given file. +compileFile :: (Reader r) => CompileConfig -> r -> IO (Either CompileError String) +compileFile config filein = do runtime <- getDataFileName "js/runtime.js" stdlibpath <- getDataFileName "hs/stdlib.hs" stdlibpathprelude <- getDataFileName "src/Language/Fay/Stdlib.hs" raw <- readFile runtime stdlib <- readFile stdlibpath stdlibprelude <- readFile stdlibpathprelude - hscode <- readFile filein + hscode <- readin filein compileProgram config - autorun raw - compileModule + compileToplevelModule (hscode ++ "\n" ++ stdlib ++ "\n" ++ strip stdlibprelude) where strip = unlines . dropWhile (/="-- START") . lines -- | Compile the given module to a runnable program. compileProgram :: (Show from,Show to,CompilesTo from to) - => CompileConfig -> Bool -> String -> (from -> Compile to) -> String + => CompileConfig -> String -> (from -> Compile to) -> String -> IO (Either CompileError String) -compileProgram config autorun raw with hscode = do +compileProgram config raw with hscode = do result <- compileViaStr config with hscode case result of Left err -> return (Left err) - Right (jscode,state) -> do - let (ModuleName modulename) = stateModuleName state - exports = stateExports state - return (Right (unlines ["/** @constructor" - ,"*/" - ,"var " ++ modulename ++ " = function(){" - ,raw - ,jscode - ,"// Exports" - ,unlines (map printExport exports) - ,"// Built-ins" - ,"this._ = _;" - ,if configExportBuiltins config - then unlines ["this.$ = $;" - ,"this.$fayToJs = Fay$$fayToJs;" - ,"this.$jsToFay = Fay$$jsToFay;" - ] - else "" - ,"};" - ,if autorun - then unlines [";" - ,"var main = new " ++ modulename ++ "();" - ,"main._(main.main);" - ] - else "" - ])) + Right (jscode,state) -> fmap Right $ + let out = generate jscode (stateExports state) (stateModuleName state) + in if configPrettyPrint config + then prettyPrintString out + else return out + + where generate jscode exports (ModuleName modulename) = unlines + ["/** @constructor" + ,"*/" + ,"var " ++ modulename ++ " = function(){" + ,raw + ,jscode + ,"// Exports" + ,unlines (map printExport exports) + ,"// Built-ins" + ,"this._ = _;" + ,if configExportBuiltins config + then unlines ["this.$ = $;" + ,"this.$fayToJs = Fay$$fayToJs;" + ,"this.$jsToFay = Fay$$jsToFay;" + ] + else "" + ,"};" + ,if configAutorun config + then unlines [";" + ,"var main = new " ++ modulename ++ "();" + ,"main._(main.main);" + ] + else "" + ] -- | Print an this.x = x; export out. printExport :: Name -> String diff --git a/src/Language/Fay/Convert.hs b/src/Language/Fay/Convert.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fay/Convert.hs @@ -0,0 +1,145 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS -fno-warn-type-defaults #-} + +-- | Convert a Haskell value to a (JSON representation of a) Fay value. + +module Language.Fay.Convert + (showToFay + ,readFromFay) + where + +import Control.Applicative +import Control.Arrow +import Control.Monad +import Data.Aeson +import Data.Attoparsec.Number +import Data.Char +import Data.Data +import Data.Function +import qualified Data.HashMap.Strict as Map +import Data.List +import Data.Maybe +import Data.Ord +import qualified Data.Text as Text +import qualified Data.Vector as Vector +import Numeric +import Safe +import qualified Text.Show.Pretty as Show + +-------------------------------------------------------------------------------- +-- The conversion functions. + +-- | Convert a Haskell value to a value representing a Fay value. +showToFay :: Show a => a -> Maybe Value +showToFay = Show.reify >=> convert where + convert value = case value of + -- Special cases + Show.Con "True" _ -> return (Bool True) + Show.Con "False" _ -> return (Bool False) + + -- Objects/records + Show.Con name values -> fmap (Object . Map.fromList . (("instance",string name) :)) + (slots values) + Show.Rec name fields -> fmap (Object . Map.fromList . (("instance",string name) :)) + (mapM (uncurry keyval) fields) + + -- List types + Show.Tuple values -> fmap (Array . Vector.fromList) (mapM convert values) + Show.List values -> fmap (Array . Vector.fromList) (mapM convert values) + + -- Text types + Show.String chars -> fmap string (readMay chars) + Show.Char char -> fmap (string.return) (readMay char) + + -- Numeric types (everything treated as a double) + Show.Neg{} -> double <|> int + Show.Integer{} -> int + Show.Float{} -> double + Show.Ratio{} -> double + where double = convertDouble value + int = convertInt value + + -- Number converters + convertDouble = fmap (Number . D) . parseDouble + convertInt = fmap (Number . I) . parseInt + + -- Number parsers + parseDouble :: Show.Value -> Maybe Double + parseDouble value = case value of + Show.Float str -> getDouble str + Show.Ratio x y -> liftM2 (on (/) fromIntegral) (parseInt x) (parseInt y) + Show.Neg str -> fmap (* (-1)) (parseDouble str) + _ -> Nothing + parseInt value = case value of + Show.Integer str -> getInt str + Show.Neg str -> fmap (* (-1)) (parseInt str) + _ -> Nothing + + -- Number readers + getDouble :: String -> Maybe Double + getDouble = fmap fst . listToMaybe . readFloat + getInt :: String -> Maybe Integer + getInt = fmap fst . listToMaybe . readInt 10 isDigit charToInt + where charToInt c = fromEnum c - fromEnum '0' + + -- Utilities + string = String . Text.pack + slots = zipWithM keyval (map (("slot"++).show) [1::Int ..]) + keyval key val = fmap (Text.pack key,) (convert val) + +-- | Convert a value representing a Fay value to a Haskell value. +readFromFay :: (Data a,Read a) => Value -> Maybe a +readFromFay value = result where + result = (convert >=> readMay) value + convert v = + case v of + Object obj -> do + name <- Map.lookup "instance" obj >>= getText + readRecord name obj <|> readData name obj + Array array -> do + elems <- mapM convert (Vector.toList array) + return $ concat ["[",intercalate "," elems,"]"] + String str -> return (show str) + Number num -> return $ case num of + I integer -> show integer + D double -> show double + Bool bool -> return $ show bool + Null -> Nothing + + getText i = case i of + String s -> return s + _ -> Nothing + + readData name obj = do + fields <- forM assocs $ \(_,v) -> do + cvalue <- convert v + return cvalue + return (intercalate " " (Text.unpack name : fields)) + where assocs = sortBy (comparing fst) + (filter ((/="instance").fst) (Map.toList obj)) + + readRecord name (Map.toList -> assocs) = go (dataTypeConstrs typ) + where go (cons:conses) = + readConstructor name assocs cons <|> go conses + go [] = Nothing + + readConstructor name assocs cons = do + let getField key = + case lookup key (map (first Text.unpack) assocs) of + Just v -> return (key,v) + Nothing -> Nothing + fields <- forM (constrFields cons) $ \field -> do + (key,v) <- getField field + cvalue <- convert v + return (intercalate " " [key,"=",cvalue]) + guard $ not $ null fields + return (Text.unpack name ++ + if null fields + then "" + else " {" ++ intercalate ", " fields ++ "}") + + typ = dataTypeOf $ resType result + resType :: Maybe a -> a + resType = undefined diff --git a/src/Language/Fay/FFI.hs b/src/Language/Fay/FFI.hs --- a/src/Language/Fay/FFI.hs +++ b/src/Language/Fay/FFI.hs @@ -7,6 +7,7 @@ import Language.Fay.Types (Fay) import Prelude (Bool, Char, Double, String, error) +-- | In case you want to distinguish values with a JsPtr. data JsPtr a -- | Contains allowed foreign function types. diff --git a/src/Language/Fay/Prelude.hs b/src/Language/Fay/Prelude.hs --- a/src/Language/Fay/Prelude.hs +++ b/src/Language/Fay/Prelude.hs @@ -10,13 +10,15 @@ ,Show(show) ,Read ,Maybe(..) + ,Typeable(..) + ,Data(..) + ,Monad + ,Eq(..) ,read ,fromInteger ,fromRational ,(>>) ,(>>=) - ,(==) - ,(/=) ,(+) ,(*) ,(-) @@ -32,13 +34,15 @@ ,module Language.Fay.Stdlib) where -import Language.Fay.Stdlib -import Language.Fay.Types (Fay) +import Language.Fay.Stdlib +import Language.Fay.Types (Fay) -import GHC.Real (Ratio) -import Prelude (Bool(..), Char, Double, Integer, Maybe(..), Ord, Read(..), +import Data.Data + +import GHC.Real (Ratio) +import Prelude (Bool(..), Eq(..), Char, Double, Integer, Maybe(..), Ord, Read(..), Show(..), String, error, read, (&&), (*), (+), (-), (/), (/=), (<), - (<=), (==), (>), (>=), (||)) + (<=), (==), (>), (>=), (||),Monad) -- | Just to satisfy GHC. fromInteger :: Integer -> Double diff --git a/src/Language/Fay/Print.hs b/src/Language/Fay/Print.hs --- a/src/Language/Fay/Print.hs +++ b/src/Language/Fay/Print.hs @@ -15,13 +15,14 @@ module Language.Fay.Print where -import Language.Fay.Types +import Language.Fay.Types -import Data.List -import Data.String -import Language.Haskell.Exts.Syntax -import Prelude hiding (exp) -import Text.JSON +import Data.Aeson.Encode +import qualified Data.ByteString.Lazy.UTF8 as UTF8 +import Data.List +import Data.String +import Language.Haskell.Exts.Syntax +import Prelude hiding (exp) -------------------------------------------------------------------------------- -- Printing @@ -29,10 +30,10 @@ -- | Print literals. These need some special encoding for -- JS-format literals. Could use the Text.JSON library. instance Printable JsLit where - printJS (JsChar char) = encode [char] -- FIXME: - printJS (JsStr str) = encode str -- FIXME: - printJS (JsInt int) = show int -- FIXME: - printJS (JsFloating rat) = show rat -- FIXME: + printJS (JsChar char) = UTF8.toString (encode (UTF8.fromString [char])) + printJS (JsStr str) = UTF8.toString (encode (UTF8.fromString str)) + printJS (JsInt int) = show int + printJS (JsFloating rat) = show rat printJS (JsBool b) = if b then "true" else "false" -- | Print (and properly encode to JS) a qualified name. @@ -72,28 +73,30 @@ -- | Print a list of statements. instance Printable [JsStmt] where - printJS = concat . map (printJS) + printJS = concatMap printJS -- | Print a single statement. instance Printable JsStmt where + printJS (JsBlock stmts) = + "{ " ++ unwords (map printJS stmts) ++ "}" printJS (JsVar name expr) = - (unwords ["var",printJS name,"=",printJS expr ++ ";"]) + unwords ["var",printJS name,"=",printJS expr ++ ";"] printJS (JsUpdate name expr) = - (unwords [printJS name,"=",printJS expr ++ ";"]) + unwords [printJS name,"=",printJS expr ++ ";"] printJS (JsSetProp name prop expr) = - (concat [printJS name,".",printJS prop," = ",printJS expr ++ ";"]) + concat [printJS name,".",printJS prop," = ",printJS expr ++ ";"] printJS (JsIf exp thens elses) = concat [("if (" ++ printJS exp ++ ") {") ,printJS thens] ++ - if (length elses > 0) + if length elses > 0 then concat ["} else {" ,printJS elses ++ "}"] else "}" printJS (JsEarlyReturn exp) = - ("return " ++ printJS exp ++ ";") + "return " ++ printJS exp ++ ";" printJS (JsThrow exp) = - ("throw " ++ printJS exp ++ ";") + "throw " ++ printJS exp ++ ";" printJS (JsWhile cond stmts) = unwords ["while (" ++ printJS cond ++ ") {" ,printJS stmts @@ -120,7 +123,7 @@ Nothing -> "}" printJS JsNull = "null" printJS (JsSequence exprs) = - intercalate "," (map (printJS) exprs) + intercalate "," (map printJS exprs) printJS (JsName name) = printJS name printJS (JsApp op args) = printJS (if isFunc op then JsParen op else op) ++ @@ -132,11 +135,11 @@ printJS (JsParen exp) = "(" ++ printJS exp ++ ")" printJS (JsTernaryIf cond conseq alt) = concat [printJS cond ++ " ? " - , (printJS conseq) ++ " : " - , (printJS alt)] + , printJS conseq ++ " : " + , printJS alt] printJS (JsList exps) = "[" ++ - intercalate "," (map (printJS) exps) ++ + intercalate "," (map printJS exps) ++ "]" printJS (JsNew name args) = "new " ++ printJS (JsApp (JsName name) args) @@ -151,36 +154,51 @@ printJS (JsLookup exp1 exp2) = printJS exp1 ++ "[" ++ printJS exp2 ++ "]" printJS (JsUpdateProp name prop expr) = - (concat ["(",printJS name,".",printJS prop," = ",printJS expr,")"]) + concat ["(",printJS name,".",printJS prop," = ",printJS expr,")"] printJS (JsInfix op x y) = printJS x ++ " " ++ op ++ " " ++ printJS y -- Externs: Careful, here be dragons! Or at least warm lizards. printJS (JsGetPropExtern exp prop) = - printJS exp ++ "['" ++ printJS prop ++ "']" + printJS exp ++ "[" ++ printJS (JsLit (JsStr prop)) ++ "]" printJS (JsUpdatePropExtern name prop expr) = - (concat ["(",printJS name,"['",printJS prop,"'] = ",printJS expr,")"]) + concat ["(",printJS name,"['",printJS prop,"'] = ",printJS expr,")"] + printJS (JsObj assoc) = + concat ["{" + ,intercalate "," (map cons assoc) + ,"}"] + where cons (key,value) = "\"" ++ key ++ "\": " ++ printJS value -------------------------------------------------------------------------------- -- Utilities +-- Words reserved in haskell as well are not needed here: +-- case, class, do, else, if, import, in, let +reservedWords :: [String] +reservedWords = [ + "break", "catch", "const", "continue", "debugger", "delete", "enum", "export", + "extends", "finally", "for", "function", "global", "implements", "instanceof", + "interface", "new", "null", "package", "private", "protected", "public", "return", + "static", "super", "switch", "this", "throw", "try", "typeof", "undefined", + "var", "void", "while", "window", "with", "yield"] + -- | Encode a Haskell name to JavaScript. jsEncodeName :: String -> String -- Special symbols: jsEncodeName ":tmp" = "$tmp" jsEncodeName ":thunk" = "$" jsEncodeName ":this" = "this" +-- jsEncodeName ":return" = "return" -- Used keywords: -jsEncodeName "null" = "_$null" -jsEncodeName "this" = "_$this" +jsEncodeName name + | "$_" `isPrefixOf` name = name + | name `elem` reservedWords = "$_" ++ name -- Anything else. jsEncodeName name = - if isPrefixOf "$_" name - then name - else concat . map encode $ name + concatMap encodeChar name where - encode c | elem c allowed = [c] - | otherwise = escapeChar c + encodeChar c | c `elem` allowed = [c] + | otherwise = escapeChar c allowed = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_" escapeChar c = "$" ++ charId c ++ "$" charId c = show (fromEnum c) diff --git a/src/Language/Fay/Show.hs b/src/Language/Fay/Show.hs deleted file mode 100644 --- a/src/Language/Fay/Show.hs +++ /dev/null @@ -1,33 +0,0 @@ --- | Convert a Haskell value to a Fay value. - -module Language.Fay.Show where - -import Data.List -import Text.JSON -import Text.Show.Pretty - --- | Convert a Haskell value to a Fay value. To read this in from JS, --- use Fay.eval() which will evaluate the code in the context of Fay. -showToFay :: Show a => a -> String -showToFay a = case reify a of - Nothing -> error $ "Unable to reify data type: " ++ show a - Just a -> convert a - - where convert a = case a of - Con "Date" [String s] -> "Fay$$date(" ++ encode (read s :: String) ++ ")" - Con name [] -> name - Con name values -> con name values - Rec name [] -> name - Rec name fields -> con name (map snd fields) - Tuple xs -> "Fay$$tuple([" ++ intercalate "," (map convert xs) ++ "])" - List xs -> "Fay$$list([" ++ intercalate "," (map convert xs) ++ "])" - -- Not great: - Neg v -> "-" ++ convert v - Ratio x y -> convert x ++ "/" ++ convert y - Integer x -> x - Float x -> x - Char x -> encode (read x :: Char) - String x -> "Fay$$list(" ++ encode (read x :: String) ++ ")" - - con name values = foldr app name (reverse values) where - app arg rest = rest ++ "(" ++ convert arg ++ ")" diff --git a/src/Language/Fay/Stdlib.hs b/src/Language/Fay/Stdlib.hs --- a/src/Language/Fay/Stdlib.hs +++ b/src/Language/Fay/Stdlib.hs @@ -1,57 +1,72 @@ module Language.Fay.Stdlib (($) - ,snd - ,fst - ,find - ,any - ,filter - ,not - ,null - ,map - ,nub - ,elem + ,(++) + ,(.) ,Ordering(..) - ,sort + ,any ,compare - ,sortBy - ,insertBy + ,concat + ,const + ,elem ,enumFrom - ,zipWith - ,zip + ,enumFromTo + ,filter + ,find ,flip - ,maybe - ,(.) - ,(++) - ,concat - ,foldr ,foldl - ,lookup - ,intersperse - ,prependToAll - ,intercalate + ,foldr ,forM_ + ,fst + ,length + ,mod + ,insertBy + ,intercalate + ,intersperse + ,lookup + ,map ,mapM_ - ,when) + ,maybe + ,not + ,nub + ,null + ,prependToAll + ,snd + ,sort + ,sortBy + ,when + ,zip + ,zipWith + ,max + ,min) where -import Prelude (Bool(..), Maybe(..), Ord, return, (+), (<), (==), (>), (>>), (||)) +import Language.Fay.FFI +import Prelude (Double,Bool(..),Maybe(..),Ord((>),(<)),Eq(..),Monad(..),Num(..),(||)) -- START +snd :: (t, t1) -> t1 snd (_,x) = x + +fst :: (t, t1) -> t fst (x,_) = x +find :: (a -> Bool) -> [a] -> Maybe a find p (x:xs) = if p x then Just x else find p xs -find p [] = Nothing +find _ [] = Nothing +any :: (t -> Bool) -> [t] -> Bool any p (x:xs) = if p x then True else any p xs -any p [] = False +any _ [] = False +filter :: (a -> Bool) -> [a] -> [a] filter p (x:xs) = if p x then x : filter p xs else filter p xs filter _ [] = [] +not :: Bool -> Bool not p = if p then False else True +null :: [t] -> Bool null [] = True null _ = False @@ -59,22 +74,26 @@ map _ [] = [] map f (x:xs) = f x : map f xs +nub :: Eq a => [a] -> [a] nub ls = nub' ls [] +nub' :: Eq a => [a] -> [a] -> [a] nub' [] _ = [] nub' (x:xs) ls = if elem x ls then nub' xs ls else x : nub' xs (x : ls) +elem :: Eq a => a -> [a] -> Bool elem x (y:ys) = x == y || elem x ys elem _ [] = False data Ordering = GT | LT | EQ -sort :: (Ord a) => [a] -> [a] +sort :: Ord a => [a] -> [a] sort = sortBy compare +compare :: Ord a => a -> a -> Ordering compare x y = if x > y then GT @@ -82,21 +101,27 @@ then LT else EQ + +sortBy :: (t -> t -> Ordering) -> [t] -> [t] sortBy cmp = foldr (insertBy cmp) [] insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a] insertBy _ x [] = [x] insertBy cmp x ys = case ys of + [] -> [x] y:ys' -> case cmp x y of GT -> y : insertBy cmp x ys' _ -> x : ys +when :: Monad m => Bool -> m a -> m () when p m = if p then m >> return () else return () +enumFrom :: Num a => a -> [a] enumFrom i = i : enumFrom (i + 1) +enumFromTo :: (Eq t, Num t) => t -> t -> [t] enumFromTo i n = if i == n then [i] @@ -110,16 +135,21 @@ zip (a:as) (b:bs) = (a,b) : zip as bs zip _ _ = [] +flip :: (t1 -> t2 -> t) -> t2 -> t1 -> t flip f x y = f y x -maybe m f Nothing = m -maybe m f (Just x) = f x +maybe :: t -> (t1 -> t) -> Maybe t1 -> t +maybe m _ Nothing = m +maybe _ f (Just x) = f x +(.) :: (t1 -> t) -> (t2 -> t1) -> t2 -> t (f . g) x = f (g x) +(++) :: [a] -> [a] -> [a] x ++ y = conc x y infixr 5 ++ +($) :: (t1 -> t) -> t1 -> t f $ x = f x infixr 0 $ @@ -128,33 +158,55 @@ conc (x:xs) ys = x : conc xs ys conc [] ys = ys +concat :: [[a]] -> [a] concat = foldr conc [] -foldr f z [] = z +foldr :: (t -> t1 -> t1) -> t1 -> [t] -> t1 +foldr _ z [] = z foldr f z (x:xs) = f x (foldr f z xs) -foldl f z [] = z +foldl :: (t1 -> t -> t1) -> t1 -> [t] -> t1 +foldl _ z [] = z foldl f z (x:xs) = foldl f (f z x) xs +lookup :: Eq a1 => a1 -> [(a1, a)] -> Maybe a lookup _key [] = Nothing lookup key ((x,y):xys) = if key == x then Just y else lookup key xys -intersperse :: a -> [a] -> [a] +intersperse :: a -> [a] -> [a] intersperse _ [] = [] intersperse sep (x:xs) = x : prependToAll sep xs -prependToAll :: a -> [a] -> [a] +prependToAll :: a -> [a] -> [a] prependToAll _ [] = [] prependToAll sep (x:xs) = sep : x : prependToAll sep xs intercalate :: [a] -> [[a]] -> [a] intercalate xs xss = concat (intersperse xs xss) +forM_ :: Monad m => [t] -> (t -> m a) -> m () forM_ (x:xs) m = m x >> forM_ xs m forM_ [] _ = return () + +mapM_ :: Monad m => (a -> m b) -> [a] -> m () mapM_ m (x:xs) = m x >> mapM_ m xs mapM_ _ [] = return () + +const :: a -> b -> a +const a _ = a + +length (x:xs) = 1 + length xs +length [] = 0 + +mod :: Double -> Double -> Double +mod = ffi "%1 %% %2" + +min :: Double -> Double -> Double +min = ffi "Math.min(%1,%2)" + +max :: Double -> Double -> Double +max = ffi "Math.max(%1,%2)" diff --git a/src/Language/Fay/Types.hs b/src/Language/Fay/Types.hs --- a/src/Language/Fay/Types.hs +++ b/src/Language/Fay/Types.hs @@ -18,6 +18,7 @@ ,Fay ,CompileConfig(..) ,CompileState(..) + ,defaultCompileState ,FundamentalType(..)) where @@ -40,21 +41,38 @@ , configFlattenApps :: Bool , configExportBuiltins :: Bool , configDirectoryIncludes :: [FilePath] + , configPrettyPrint :: Bool + , configHtmlWrapper :: Bool + , configHtmlJSLibs :: [FilePath] + , configAutorun :: Bool } deriving (Show) -- | Default configuration. instance Default CompileConfig where - def = CompileConfig False False False True [] + def = CompileConfig False False False True [] False False [] False -- | State of the compiler. data CompileState = CompileState - { stateConfig :: CompileConfig - , stateExports :: [Name] - , stateExportAll :: Bool - , stateModuleName :: ModuleName - , stateRecords :: [(Name,[Name])] -- records with field names + { stateConfig :: CompileConfig + , stateExports :: [Name] + , stateExportAll :: Bool + , stateModuleName :: ModuleName + , stateRecords :: [(Name,[Name])] -- records with field names + , stateFayToJs :: [JsStmt] + , stateJsToFay :: [JsStmt] } deriving (Show) +defaultCompileState :: CompileConfig -> CompileState +defaultCompileState config = CompileState { + stateConfig = config + , stateExports = [] + , stateExportAll = True + , stateModuleName = ModuleName "Main" + , stateRecords = [(Ident "Nothing",[]),(Ident "Just",[Ident "slot1"])] + , stateFayToJs = [] + , stateJsToFay = [] + } + -- | Compile monad. newtype Compile a = Compile { unCompile :: StateT CompileState (ErrorT CompileError IO) a } deriving (MonadState CompileState @@ -124,6 +142,7 @@ | JsUpdate JsName JsExp | JsSetProp JsName JsName JsExp | JsContinue + | JsBlock [JsStmt] deriving (Show,Eq) -- | Expression type. @@ -140,7 +159,7 @@ | JsGetProp JsExp JsName | JsLookup JsExp JsExp | JsUpdateProp JsExp JsName JsExp - | JsGetPropExtern JsExp JsName + | JsGetPropExtern JsExp String | JsUpdatePropExtern JsExp JsName JsExp | JsList [JsExp] | JsNew JsName [JsExp] @@ -149,6 +168,7 @@ | JsIndex Int JsExp | JsEq JsExp JsExp | JsInfix String JsExp JsExp -- Used to optimize *, /, +, etc + | JsObj [(String,JsExp)] deriving (Show,Eq) -- | Literal value type. @@ -170,6 +190,7 @@ = FunctionType [FundamentalType] | JsType FundamentalType | ListType FundamentalType + | UserDefined Name [FundamentalType] -- Simple types. | DateType | StringType diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,55 +1,177 @@ - +{-# OPTIONS -fno-warn-orphans #-} +{-# OPTIONS -fno-warn-orphans #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} -- | Main compiler executable. module Main where +import Language.Fay import Language.Fay.Compiler import Language.Fay.Types +import Paths_fay (version) -import Control.Arrow +import qualified Control.Exception as E import Control.Monad +import Control.Monad.Error import Data.Default -import Data.List import Data.Maybe +import Data.Version (showVersion) +import Options +import System.Console.Haskeline import System.Environment +import System.Exit +import System.IO --- | Main entry point. -main :: IO () -main = do - args <- getArgs - let files = filter (not . isPrefixOf "-") args - paramOpts = map ((drop 2 *** drop 1) . break (== '=')) $ filter (isPrefixOf "--") args - opts = map (drop 1) $ filter (\v -> isPrefixOf "-" v && not (isPrefixOf "--" v)) args - if (elem "help" opts) || null files - then putStrLn helpText - else forM_ files $ \file -> do - compileFromTo def { configTCO = elem "tco" opts - , configInlineForce = elem "inline-force" opts - , configFlattenApps = elem "flatten-apps" opts - , configExportBuiltins = not (elem "no-export-builtins" opts) - , configDirectoryIncludes = maybe [] (split ',') (lookup "include" paramOpts) - } - (elem "autorun" opts) - file - (fromMaybe (toJsName file) $ lookup "output" paramOpts) - where - -- | "12,34,5" => ["12","34","5"] - split :: Eq a => a -> [a] -> [[a]] - split _ [] = [] - split a as = takeWhile (/= a) as : split a (drop 1 $ dropWhile (/= a) as) +-- | Options and help. +defineOptions "FayCompilerOptions" $ do -helpText = unlines - ["fay -- compiler from (a proper subset of) Haskell to JavaScript" - ,"" + -- boolOption "optExportBuiltins" "export-builtins" True "" + -- boolOption "optTCO" "tco" False "" + + boolOption "optAutoRun" "autorun" False "automatically call main in generated JavaScript" + boolOption "optInlineForce" "inline-force" False "inline forcing, adds some speed for numbers, blows up code a bit" + boolOption "optFlattenApps" "flatten-apps" False "flatten function applicaton" + + boolOption "optHTMLWrapper" "html-wrapper" False "Create an html file that loads the javascript" + stringsOption "optHTMLJSLibs" "html-js-lib" [] "file1[, ..] javascript files to add to if using option html-wrapper" + + stringsOption "optInclude" "include" [] "dir1[, ..] additional directories for include" + + option "optStdout" (\o -> o + { optionLongFlags = ["stdout"] + , optionShortFlags = ['s'] + , optionDefault = "false" + , optionType = optionTypeBool + , optionDescription = "Output to stdout" + }) + option "optVersion" (\o -> o + { optionLongFlags = ["version"] + , optionShortFlags = ['v'] + , optionDefault = "false" + , optionType = optionTypeBool + , optionDescription = "Output version number" + }) + option "optOutput" (\o -> o + { optionLongFlags = ["output"] + , optionShortFlags = ['o'] + , optionDefault = "" + , optionType = optionTypeMaybe optionTypeString + , optionDescription = "Output to specified file" + }) + option "optPretty" (\o -> o + { optionLongFlags = ["pretty"] + , optionShortFlags = ['p'] + , optionDefault = "false" + , optionType = optionTypeBool + , optionDescription = "Run javascript through js-beautify" + }) + +-- | The basic help text. +helpTxt :: [String] +helpTxt = + ["fay -- The fay compiler from (a proper subset of) Haskell to Javascript" ,"USAGE" - ," fay [OPTIONS] ... " - ,"" - ,"OPTIONS" - ," -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" - ," --include=dir1[, ..]" - ," looks in these additional directories for imports" - ," --output=file places the resulting file in this location" + ," fay [OPTIONS] [- | ...]" + ," fay - takes input on stdin and prints to stdout. Runs through js-beautify if available" + ," fay ... processes each .hs file" ] + +-- | Main entry point. +main :: IO () +main = + runCommandHelp (unlines helpTxt) $ \opts files -> + if optVersion opts + then runCommandVersion + else (do + let config = def { configTCO = False -- optTCO opts + , configInlineForce = optInlineForce opts + , configFlattenApps = optFlattenApps opts + , configExportBuiltins = True -- optExportBuiltins opts + + , configDirectoryIncludes = "." : optInclude opts + , configPrettyPrint = optPretty opts + , configAutorun = optAutoRun opts + , configHtmlWrapper = optHTMLWrapper opts + , configHtmlJSLibs = optHTMLJSLibs opts + } + void $ E.catch (incompatible htmlAndStdout opts "Html wrapping and stdout are incompatible") + errorUsage + + case files of + ["-"] -> do + hGetContents stdin >>= printCompile config compileModule + [] -> runInteractive + _ -> forM_ files $ \file -> do + if optStdout opts + then compileReadWrite config file stdout + else + compileFromTo config file $ outPutFile opts file) + + + where + outPutFile :: FayCompilerOptions -> String -> FilePath + outPutFile opts file = fromMaybe (toJsName file) $ optOutput opts + + errorUsage :: IOError -> IO a + errorUsage e = do + putStrLn $ "ERROR: \n " ++ (show e) + args <- getArgs + usageMsg args $ unlines $ drop 1 helpTxt + +runInteractive :: IO () +runInteractive = + runInputT defaultSettings loop + where + loop = do + minput <- getInputLine "> " + case minput of + Nothing -> return () + Just "" -> loop + Just input -> do + result <- liftIO $ compileViaStr def compileExp input + case result of + Left err -> outputStrLn . show $ err + Right (ok,_) -> liftIO (prettyPrintString ok) >>= outputStr + loop + +runCommandHelp :: (MonadIO m, Options opts) => String -> (opts -> [String] -> m a) -> m a +runCommandHelp help io = do + argv <- liftIO getArgs + let parsed = parseOptions argv + case parsedOptions parsed of + Just opts -> io opts (parsedArguments parsed) + Nothing -> liftIO $ usageMsg argv help + +runCommandVersion :: IO () +runCommandVersion = putStrLn $ "fay " ++ showVersion version + + + +usageMsg :: [String] -> String -> IO a +usageMsg argv help = do + putStrLn help + let parsed = parseOptions argv :: ParsedOptions FayCompilerOptions + case parsedError parsed of + Just err -> do + hPutStrLn stderr (parsedHelp parsed) + hPutStrLn stderr err + exitFailure + Nothing -> do + hPutStr stdout (parsedHelp parsed) + exitSuccess + +htmlAndStdout :: FayCompilerOptions -> Bool +htmlAndStdout opts = optHTMLWrapper opts && optStdout opts + +incompatible :: Monad m => (FayCompilerOptions -> Bool) + -> FayCompilerOptions -> String -> m Bool +incompatible test opts message = case test opts of + True -> E.throw $ userError message + False -> return True + +instance Writer Handle where + writeout = hPutStr + +instance Reader Handle where + readin = hGetContents diff --git a/src/System/Process/Extra.hs b/src/System/Process/Extra.hs --- a/src/System/Process/Extra.hs +++ b/src/System/Process/Extra.hs @@ -2,6 +2,7 @@ module System.Process.Extra where + import System.Exit import System.IO import System.Process @@ -14,3 +15,10 @@ case code of ExitSuccess -> fmap Right (hGetContents out) ExitFailure _ -> fmap Left (hGetContents err) + +readAllFromProcess' :: FilePath -> [String] -> String -> IO (Either String String) +readAllFromProcess' program flags input = do + (code,out,err) <- readProcessWithExitCode program flags input + case code of + ExitSuccess -> return $ Right out + ExitFailure _ -> return $ Left err diff --git a/src/Test/Api.hs b/src/Test/Api.hs new file mode 100644 --- /dev/null +++ b/src/Test/Api.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Test.Api (tests) where + +import Data.Default +import Language.Fay.Compiler +import Language.Fay.Types +import Test.HUnit (Assertion, assertBool) +import Test.Util +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.Framework.TH + +tests :: Test +tests = $testGroupGenerator + +case_imports :: Assertion +case_imports = do + res <- compileFile def { configDirectoryIncludes = ["tests"] } "tests/RecordImport_Import.hs" + assertBool "Could not compile file with imports" (isRight res) diff --git a/src/Test/CommandLine.hs b/src/Test/CommandLine.hs new file mode 100644 --- /dev/null +++ b/src/Test/CommandLine.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Test.CommandLine (tests) where + +import Control.Applicative +import Data.Maybe +import System.Process.Extra +import Test.HUnit (Assertion, assertBool) +import Test.Util +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.Framework.TH + +tests :: Test +tests = $testGroupGenerator + +compileFile :: [String] -> IO (Either String String) +compileFile flags = do + fay <- fromJust <$> fayPath + readAllFromProcess' fay flags "" + +case_executable :: Assertion +case_executable = do + fay <- fayPath + assertBool "Could not find fay executable" (isJust fay) + +case_compile :: Assertion +case_compile = do + res <- compileFile ["--autorun", "--include=tests", "tests/RecordImport_Import.hs"] + assertBool (fromLeft res) (isRight res) diff --git a/src/Test/Convert.hs b/src/Test/Convert.hs new file mode 100644 --- /dev/null +++ b/src/Test/Convert.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ExistentialQuantification #-} + +module Test.Convert (tests) where + +import qualified Data.Aeson.Parser as Aeson +import Data.Attoparsec.ByteString +import qualified Data.ByteString as Bytes +import qualified Data.ByteString.UTF8 as UTF8 +import Data.Data +import Data.Ratio +import Language.Fay.Convert +import Test.HUnit (assertEqual) +import Test.Framework +import Test.Framework.Providers.HUnit + +tests :: Test +tests = testGroup "Test.Convert" [reading, showing] + where reading = testGroup "reading" $ + flip map readTests $ \(ReadTest value) -> + let label = show value + in testCase label $ + assertEqual label (Just value) (showToFay value >>= readFromFay) + showing = testGroup "showing" $ + flip map showTests $ \(Testcase value output) -> + let label = show value + in testCase label $ + assertEqual label + (either error Just $ parseOnly Aeson.value output) + (showToFay value) + + +-------------------------------------------------------------------------------- +-- Test cases + +-- | A test. +data Testcase = forall x. Show x => Testcase x Bytes.ByteString + +-- | A read test. +data ReadTest = forall x. (Data x,Show x,Eq x,Read x) => ReadTest x + + +-- | Tests + +-- | Read tests. +readTests :: [ReadTest] +readTests = + [ReadTest $ NullaryConstructor + ,ReadTest $ NAryConstructor 123 66.6 + ,ReadTest $ LabelledRecord { barInt = 123, barDouble = 66.6 } + ,ReadTest $ LabelledRecord2 { bar = 123, bob = 66.6 } + ,ReadTest $ FooBar "Tinkie Winkie" "Humanzee" Zot + ] + +-- | Test cases. +showTests :: [Testcase] +showTests = + -- Fundamental data types + [(1 :: Int) → "1" + ,(1 :: Double) → "1.0" + ,(1/2 :: Double) → "0.5" + ,(1%2 :: Rational) → "0.5" + ,([1,2] :: [Int]) → "[1,2]" + ,((1,2) :: (Int,Int)) → "[1,2]" + ,"abc" → "\"abc\"" + ,'a' → "\"a\"" + -- Data records + ,NullaryConstructor → "{\"instance\":\"NullaryConstructor\"}" + ,NAryConstructor 123 4.5 → "{\"slot1\":123,\"slot2\":4.5,\"instance\":\"NAryConstructor\"}" + ,LabelledRecord { barInt = 123, barDouble = 4.5 } + → "{\"barDouble\":4.5,\"barInt\":123,\"instance\":\"LabelledRecord\"}" + -- Unicode + ,"¡ ¢ £ ¤ ¥ " → "\"¡ ¢ £ ¤ ¥ \"" + ,"Ā ā Ă ă Ą " → "\"Ā ā Ă ă Ą \"" + ,"ƀ Ɓ Ƃ ƃ Ƅ " → "\"ƀ Ɓ Ƃ ƃ Ƅ \"" + ,"ɐ ɑ ɒ ɓ ɔ " → "\"ɐ ɑ ɒ ɓ ɔ \"" + ,"Ё Ђ Ѓ Є Ѕ " → "\"Ё Ђ Ѓ Є Ѕ \"" + ,"Ա Բ Գ Դ Ե " → "\"Ա Բ Գ Դ Ե \"" + ,"، ؛ ؟ ء آ " → "\"، ؛ ؟ ء آ \"" + ,"ँ ं ः अ आ " → "\"ँ ं ः अ आ \"" + ,"ఁ ం ః అ ఆ " → "\"ఁ ం ః అ ఆ \"" + ,"ก ข ฃ ค ฅ " → "\"ก ข ฃ ค ฅ \"" + ,"ກ ຂ ຄ ງ ຈ " → "\"ກ ຂ ຄ ງ ຈ \"" + ,"ༀ ༁ ༂ ༃ ༄ " → "\"ༀ ༁ ༂ ༃ ༄ \"" + ,"Ⴀ Ⴁ Ⴂ Ⴃ Ⴄ " → "\"Ⴀ Ⴁ Ⴂ Ⴃ Ⴄ \"" + ,"Ḁ ḁ Ḃ ḃ Ḅ " → "\"Ḁ ḁ Ḃ ḃ Ḅ \"" + ,"ぁ あ ぃ い ぅ " → "\"ぁ あ ぃ い ぅ \"" + ,"ァ ア ィ イ ゥ " → "\"ァ ア ィ イ ゥ \"" + ,"ㄅ ㄆ ㄇ ㄈ ㄉ " → "\"ㄅ ㄆ ㄇ ㄈ ㄉ \"" + ,"ㄱ ㄲ ㄳ ㄴ ㄵ " → "\"ㄱ ㄲ ㄳ ㄴ ㄵ \"" + ] + + where x → y = Testcase x (UTF8.fromString y) + +-- | Nullary constructor. +data NullaryConstructor = NullaryConstructor + deriving (Show,Data,Typeable,Read,Eq) + +-- | n-ary labelless constructor. +data NAryConstructor = NAryConstructor Int Double + deriving (Show,Data,Typeable,Read,Eq) + +-- | Labelled record. +data LabelledRecord = LabelledRecord { barInt :: Int, barDouble :: Double } + | LabelledRecord2 { bar :: Int, bob :: Double } + deriving (Show,Data,Typeable,Read,Eq) + +-- | Order matters in unlabelled constructors. +data SomeThing = + FooBar String String Zot + deriving (Read,Data,Typeable,Show,Eq) + +-- | This triggers order difference. Go figure. +data Zot = Zot + deriving (Read,Data,Typeable,Show,Eq) diff --git a/src/Test/Util.hs b/src/Test/Util.hs new file mode 100644 --- /dev/null +++ b/src/Test/Util.hs @@ -0,0 +1,28 @@ +module Test.Util where + +import Control.Applicative +import System.Directory +import System.Process.Extra + +-- Path to the fay executable, looks in cabal-dev, dist, PATH in that order. +fayPath :: IO (Maybe FilePath) +fayPath = do + cabalDev <- doesFileExist cabalDevPath + if cabalDev + then return (Just cabalDevPath) + else do + dist <- doesFileExist distPath + if dist + then return (Just distPath) + else either (const Nothing) (Just . concat . lines) <$> readAllFromProcess' "which" ["fay"] "" + where + cabalDevPath = "./cabal-dev/bin/fay" + distPath = "./dist/build/fay/fay" + +isRight :: Either a b -> Bool +isRight (Right _) = True +isRight (Left _) = False + +fromLeft :: Either a b -> a +fromLeft (Left a) = a +fromLeft (Right _) = error "fromLeft got Right" diff --git a/src/Tests.hs b/src/Tests.hs --- a/src/Tests.hs +++ b/src/Tests.hs @@ -5,40 +5,42 @@ module Main where -import Language.Fay.Compiler - import Data.Default import Data.List +import Language.Fay.Compiler +import Language.Fay.Types import System.Directory -import System.Exit import System.FilePath -import System.IO -import System.Process import System.Process.Extra -import Test.HUnit +import qualified Test.Api as Api +import qualified Test.CommandLine as Cmd +import qualified Test.Convert as C +import Test.HUnit (assertEqual) +import Test.Framework +import Test.Framework.Providers.HUnit -- | Main test runner. main :: IO () -main = runUnitTests >> return () +main = do + compiler <- makeCompilerTests + defaultMain [Api.tests, Cmd.tests, compiler, C.tests] --- | Run the case-by-case unit tests. -runUnitTests :: IO Counts -runUnitTests = do +-- | Make the case-by-case unit tests. +makeCompilerTests :: IO Test +makeCompilerTests = do files <- fmap (map ("tests" ) . sort . filter dotHs) $ getDirectoryContents "tests" - runTestTT (makeTests files) - - where dotHs = isSuffixOf ".hs" - makeTests files = - TestList $ flip map files $ \file -> TestLabel file $ TestCase $ do - let root = (reverse . drop 1 . dropWhile (/='.') . reverse) file - out = toJsName file - outExists <- doesFileExist root - compileFromTo def True file out - result <- runJavaScriptFile out - if outExists - then do output <- readFile root - assertEqual file output (either show id result) - else assertEqual file True (either (const True) (const False) result) + return $ testGroup "Tests" $ flip map files $ \file -> + testCase file $ do + let root = (reverse . drop 1 . dropWhile (/='.') . reverse) file + out = toJsName file + outExists <- doesFileExist root + compileFromTo def { configAutorun = True, configDirectoryIncludes = ["tests/"] } file out + result <- runJavaScriptFile out + if outExists + then do output <- readFile root + assertEqual file output (either show id result) + else assertEqual file True (either (const True) (const False) result) + where dotHs = isSuffixOf ".hs" -- | Run a JS file. runJavaScriptFile :: String -> IO (Either String String) diff --git a/src/Text/Blaze/Extra.hs b/src/Text/Blaze/Extra.hs --- a/src/Text/Blaze/Extra.hs +++ b/src/Text/Blaze/Extra.hs @@ -1,6 +1,5 @@ {-# OPTIONS -fno-warn-orphans #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} {-# OPTIONS -fno-warn-name-shadowing -fno-warn-unused-do-bind #-} module Text.Blaze.Extra where diff --git a/tests/10 b/tests/10 deleted file mode 100644 --- a/tests/10 +++ /dev/null @@ -1,1 +0,0 @@ -Hello, World! diff --git a/tests/10.hs b/tests/10.hs deleted file mode 100644 --- a/tests/10.hs +++ /dev/null @@ -1,12 +0,0 @@ -main = print (concat ["Hello, ","World!"]) - -concat = foldr append [] - -foldr f z [] = z -foldr f z (x:xs) = f x (foldr f z xs) - -append (x:xs) ys = x : append xs ys -append [] ys = ys - -print :: String -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/11 b/tests/11 deleted file mode 100644 --- a/tests/11 +++ /dev/null @@ -1,1 +0,0 @@ -[1,2,3,4,5] diff --git a/tests/11.hs b/tests/11.hs deleted file mode 100644 --- a/tests/11.hs +++ /dev/null @@ -1,13 +0,0 @@ -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 - -map f [] = [] -map f (x:xs) = f x : map f xs - -print :: String -> Fay () -print = ffi "console.log(%1)" - -showList :: [Double] -> String -showList = ffi "JSON.stringify(%1)" diff --git a/tests/12 b/tests/12 deleted file mode 100644 --- a/tests/12 +++ /dev/null @@ -1,1 +0,0 @@ -[1,61.5,3782.25,232608.375,14305415.0625] diff --git a/tests/12.hs b/tests/12.hs deleted file mode 100644 --- a/tests/12.hs +++ /dev/null @@ -1,15 +0,0 @@ -main = print (showList (take 5 (let ns = 1 : map (foo 123) ns in ns))) - -foo x y = x * y / 2 - -take 0 _ = [] -take n (x:xs) = x : take (n - 1) xs - -map f [] = [] -map f (x:xs) = f x : map f xs - -print :: String -> Fay () -print = ffi "console.log(%1)" - -showList :: [Double] -> String -showList = ffi "JSON.stringify(%1)" diff --git a/tests/13 b/tests/13 deleted file mode 100644 --- a/tests/13 +++ /dev/null @@ -1,1 +0,0 @@ -Hello! diff --git a/tests/13.hs b/tests/13.hs deleted file mode 100644 --- a/tests/13.hs +++ /dev/null @@ -1,6 +0,0 @@ -main = print (case True of - True -> "Hello!" - False -> "Ney!") - -print :: String -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/14 b/tests/14 deleted file mode 100644 --- a/tests/14 +++ /dev/null @@ -1,1 +0,0 @@ -Ney! diff --git a/tests/14.hs b/tests/14.hs deleted file mode 100644 --- a/tests/14.hs +++ /dev/null @@ -1,6 +0,0 @@ -main = print (case False of - True -> "Hello!" - False -> "Ney!") - -print :: String -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/15 b/tests/15 deleted file mode 100644 --- a/tests/15 +++ /dev/null @@ -1,1 +0,0 @@ -Ney! diff --git a/tests/15.hs b/tests/15.hs deleted file mode 100644 --- a/tests/15.hs +++ /dev/null @@ -1,6 +0,0 @@ -main = print (case False of - True -> "Hello!" - _ -> "Ney!") - -print :: String -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/16 b/tests/16 deleted file mode 100644 --- a/tests/16 +++ /dev/null @@ -1,4 +0,0 @@ -Hello! -Hello! -Hello! -Hello! diff --git a/tests/16.hs b/tests/16.hs deleted file mode 100644 --- a/tests/16.hs +++ /dev/null @@ -1,17 +0,0 @@ -data Person1 = Person1 String String Int -data Person2 = Person2 { fname :: String, sname :: String, age :: Int } -data Person3 = Person3 { slot3 :: String, slot2 :: String, slot1 :: Int } - -p1 = Person1 "Chris" "Done" 13 -p2 = Person2 "Chris" "Done" 13 -p2a = Person2 { fname = "Chris", sname = "Done", age = 13 } -p3 = Person3 "Chris" "Done" 13 - -main = do - print (case p1 of Person1 "Chris" "Done" 13 -> "Hello!") - print (case p2 of Person2 "Chris" "Done" 13 -> "Hello!") - print (case p2a of Person2 "Chris" "Done" 13 -> "Hello!") - print (case p3 of Person3 "Chris" "Done" 13 -> "Hello!") - -print :: String -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/17 b/tests/17 deleted file mode 100644 --- a/tests/17 +++ /dev/null @@ -1,1 +0,0 @@ -World! diff --git a/tests/17.hs b/tests/17.hs deleted file mode 100644 --- a/tests/17.hs +++ /dev/null @@ -1,8 +0,0 @@ -data Person = Person String String Int - -main = print (case Person "Chris" "Done" 14 of - Person "Chris" "Done" 13 -> "Hello!" - _ -> "World!") - -print :: String -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/18 b/tests/18 deleted file mode 100644 --- a/tests/18 +++ /dev/null @@ -1,1 +0,0 @@ -Hello! diff --git a/tests/18.hs b/tests/18.hs deleted file mode 100644 --- a/tests/18.hs +++ /dev/null @@ -1,10 +0,0 @@ -data Person = Person String String Int - -main = print (case Person "Chris" "Done" 14 of - Person "Chris" "Done" 13 -> "Foo!" - Person "Chris" "Barf" 14 -> "Bar!" - Person "Chris" "Done" 14 -> "Hello!" - _ -> "World!") - -print :: String -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/19 b/tests/19 deleted file mode 100644 --- a/tests/19 +++ /dev/null @@ -1,1 +0,0 @@ -Hello! diff --git a/tests/19.hs b/tests/19.hs deleted file mode 100644 --- a/tests/19.hs +++ /dev/null @@ -1,11 +0,0 @@ -data Person = Person String String Int - -main = print (foo (Person "Chris" "Done" 14)) - -foo (Person "Chris" "Done" 13) = "Foo!" -foo (Person "Chris" "Barf" 14) = "Bar!" -foo (Person "Chris" "Done" 14) = "Hello!" -foo _ = "World!" - -print :: String -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/2 b/tests/2 deleted file mode 100644 --- a/tests/2 +++ /dev/null diff --git a/tests/2.hs b/tests/2.hs deleted file mode 100644 --- a/tests/2.hs +++ /dev/null @@ -1,1 +0,0 @@ -main = return () diff --git a/tests/20 b/tests/20 deleted file mode 100644 --- a/tests/20 +++ /dev/null @@ -1,2 +0,0 @@ -Hello, -World! diff --git a/tests/20.hs b/tests/20.hs deleted file mode 100644 --- a/tests/20.hs +++ /dev/null @@ -1,4 +0,0 @@ -main = print "Hello," >> print "World!" - -print :: String -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/21 b/tests/21 deleted file mode 100644 --- a/tests/21 +++ /dev/null @@ -1,2 +0,0 @@ -Hello, -World! diff --git a/tests/21.hs b/tests/21.hs deleted file mode 100644 --- a/tests/21.hs +++ /dev/null @@ -1,4 +0,0 @@ -main = do print "Hello,"; print "World!" - -print :: String -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/22 b/tests/22 deleted file mode 100644 --- a/tests/22 +++ /dev/null @@ -1,1 +0,0 @@ -Hello, World! diff --git a/tests/22.hs b/tests/22.hs deleted file mode 100644 --- a/tests/22.hs +++ /dev/null @@ -1,6 +0,0 @@ -main = do - x <- return "Hello, World!" >>= return - print x - -print :: String -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/23 b/tests/23 deleted file mode 100644 --- a/tests/23 +++ /dev/null @@ -1,1 +0,0 @@ -OK. diff --git a/tests/23.hs b/tests/23.hs deleted file mode 100644 --- a/tests/23.hs +++ /dev/null @@ -1,6 +0,0 @@ -main = do - [1,2] <- return [1,2] - print "OK." - -print :: String -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/24 b/tests/24 deleted file mode 100644 --- a/tests/24 +++ /dev/null @@ -1,1 +0,0 @@ -OK. diff --git a/tests/24.hs b/tests/24.hs deleted file mode 100644 --- a/tests/24.hs +++ /dev/null @@ -1,8 +0,0 @@ -main = print (case [1,2,3,4,5] of - [1,2,3,4,6] -> "6!" - [1,2,4,2,4] -> "a!" - [1,2,3,4,5] -> "OK." - _ -> "Broken.") - -print :: String -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/25.hs b/tests/25.hs deleted file mode 100644 --- a/tests/25.hs +++ /dev/null @@ -1,4 +0,0 @@ -main = print ((\a 'a' -> "OK.") 0 'b') - -print :: String -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/26 b/tests/26 deleted file mode 100644 --- a/tests/26 +++ /dev/null @@ -1,1 +0,0 @@ -7.5 diff --git a/tests/26.hs b/tests/26.hs deleted file mode 100644 --- a/tests/26.hs +++ /dev/null @@ -1,4 +0,0 @@ -main = print (5 * 3 / 2) - -print :: Double -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/27 b/tests/27 deleted file mode 100644 --- a/tests/27 +++ /dev/null @@ -1,1 +0,0 @@ -5000050000 diff --git a/tests/27.hs b/tests/27.hs deleted file mode 100644 --- a/tests/27.hs +++ /dev/null @@ -1,20 +0,0 @@ --- | This is to test tail-recursive calls are iterative. - -{-# LANGUAGE NoImplicitPrelude #-} - -module Fib where - -import Language.Fay.FFI -import Language.Fay.Prelude - -main = do - print (sum 100000 0 :: Double) - -sum 0 acc = acc -sum n acc = sum (n - 1) (acc + n) - -getSeconds :: Fay Double -getSeconds = foreignFay "new Date" - -print :: Double -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/28 b/tests/28 deleted file mode 100644 --- a/tests/28 +++ /dev/null @@ -1,1 +0,0 @@ -5 diff --git a/tests/28.hs b/tests/28.hs deleted file mode 100644 --- a/tests/28.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -module Test where - -import Language.Fay.FFI -import Language.Fay.Prelude - -print :: String -> Fay () -print = ffi "console.log(%1)" - -main :: Fay () -main = print $ show $ fromInteger 5 diff --git a/tests/29 b/tests/29 deleted file mode 100644 --- a/tests/29 +++ /dev/null @@ -1,3 +0,0 @@ -{"car":{"car":1,"cdr":{"car":2,"cdr":{"car":3,"cdr":null}}},"cdr":{"car":{"car":1,"cdr":{"car":2,"cdr":{"car":3,"cdr":null}}},"cdr":null}} -{"car":{"car":1,"cdr":{"car":2,"cdr":{"car":3,"cdr":null}}},"cdr":{"car":1,"cdr":{"car":{"car":2,"cdr":{"car":3,"cdr":null}},"cdr":null}}} -{"car":{"car":1,"cdr":{"car":2,"cdr":{"car":3,"cdr":null}}},"cdr":{"car":1,"cdr":{"car":{"car":2,"cdr":{"car":3,"cdr":null}},"cdr":null}}} diff --git a/tests/29.hs b/tests/29.hs deleted file mode 100644 --- a/tests/29.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# 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]) diff --git a/tests/3 b/tests/3 deleted file mode 100644 --- a/tests/3 +++ /dev/null @@ -1,1 +0,0 @@ -1 diff --git a/tests/3.hs b/tests/3.hs deleted file mode 100644 --- a/tests/3.hs +++ /dev/null @@ -1,4 +0,0 @@ -main = print 1 - -print :: Double -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/30 b/tests/30 deleted file mode 100644 --- a/tests/30 +++ /dev/null @@ -1,3 +0,0 @@ -[true,false] -[2,1,0] -[true,false] diff --git a/tests/30.hs b/tests/30.hs deleted file mode 100644 --- a/tests/30.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# 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 $ showList $ (isPositive 1, isPositive 0) - print $ showList $ (threeConds 3, threeConds 1, threeConds 0) - print $ showList $ (withOtherwise 2, withOtherwise 0) - -showList :: Foreign a => [a] -> String -showList = ffi "JSON.stringify(%1)" diff --git a/tests/31 b/tests/31 deleted file mode 100644 --- a/tests/31 +++ /dev/null @@ -1,1 +0,0 @@ -Hai! diff --git a/tests/31.hs b/tests/31.hs deleted file mode 100644 --- a/tests/31.hs +++ /dev/null @@ -1,32 +0,0 @@ --- | 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)" diff --git a/tests/4 b/tests/4 deleted file mode 100644 --- a/tests/4 +++ /dev/null @@ -1,1 +0,0 @@ -Hello, World! diff --git a/tests/4.hs b/tests/4.hs deleted file mode 100644 --- a/tests/4.hs +++ /dev/null @@ -1,4 +0,0 @@ -main = print "Hello, World!" - -print :: String -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/5 b/tests/5 deleted file mode 100644 --- a/tests/5 +++ /dev/null @@ -1,1 +0,0 @@ -4 diff --git a/tests/5.hs b/tests/5.hs deleted file mode 100644 --- a/tests/5.hs +++ /dev/null @@ -1,4 +0,0 @@ -main = print (2 * 4 / 2) - -print :: Double -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/6 b/tests/6 deleted file mode 100644 --- a/tests/6 +++ /dev/null @@ -1,1 +0,0 @@ -14 diff --git a/tests/6.hs b/tests/6.hs deleted file mode 100644 --- a/tests/6.hs +++ /dev/null @@ -1,4 +0,0 @@ -main = print (10 + (2 * (4 / 2))) - -print :: Double -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/7 b/tests/7 deleted file mode 100644 --- a/tests/7 +++ /dev/null @@ -1,1 +0,0 @@ -true diff --git a/tests/7.hs b/tests/7.hs deleted file mode 100644 --- a/tests/7.hs +++ /dev/null @@ -1,4 +0,0 @@ -main = print True - -print :: Double -> Fay () -print = ffi "console.log(%1)" diff --git a/tests/8 b/tests/8 deleted file mode 100644 --- a/tests/8 +++ /dev/null @@ -1,1 +0,0 @@ -123 diff --git a/tests/8.hs b/tests/8.hs deleted file mode 100644 --- a/tests/8.hs +++ /dev/null @@ -1,10 +0,0 @@ -data Bool = True | False - -main = print (head (fix (\xs -> 123 : xs))) - -print :: Double -> Fay () -print = ffi "console.log(%1)" - -head (x:xs) = x - -fix f = let x = f x in x diff --git a/tests/9 b/tests/9 deleted file mode 100644 --- a/tests/9 +++ /dev/null @@ -1,1 +0,0 @@ -123 diff --git a/tests/9.hs b/tests/9.hs deleted file mode 100644 --- a/tests/9.hs +++ /dev/null @@ -1,10 +0,0 @@ -main = print (head (tail (fix (\xs -> 123 : xs)))) - -print :: Double -> Fay () -print = ffi "console.log(%1)" - -head (x:xs) = x - -fix f = let x = f x in x - -tail (_:xs) = xs diff --git a/tests/Bool b/tests/Bool new file mode 100644 --- /dev/null +++ b/tests/Bool @@ -0,0 +1,1 @@ +true diff --git a/tests/Bool.hs b/tests/Bool.hs new file mode 100644 --- /dev/null +++ b/tests/Bool.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = print True + +print :: Double -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/Bool.js b/tests/Bool.js new file mode 100644 --- /dev/null +++ b/tests/Bool.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)(true);});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/Double b/tests/Double new file mode 100644 --- /dev/null +++ b/tests/Double @@ -0,0 +1,1 @@ +4 diff --git a/tests/Double.hs b/tests/Double.hs new file mode 100644 --- /dev/null +++ b/tests/Double.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} +main = print (2 * 4 / 2) + +print :: Double -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/Double.js b/tests/Double.js new file mode 100644 --- /dev/null +++ b/tests/Double.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)(_(2 * 4) / 2);});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/Double2 b/tests/Double2 new file mode 100644 --- /dev/null +++ b/tests/Double2 @@ -0,0 +1,1 @@ +14 diff --git a/tests/Double2.hs b/tests/Double2.hs new file mode 100644 --- /dev/null +++ b/tests/Double2.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = print (10 + (2 * (4 / 2))) + +print :: Double -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/Double2.js b/tests/Double2.js new file mode 100644 --- /dev/null +++ b/tests/Double2.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)(10 + _(2 * _(4 / 2)));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/Double3 b/tests/Double3 new file mode 100644 --- /dev/null +++ b/tests/Double3 @@ -0,0 +1,1 @@ +7.5 diff --git a/tests/Double3.hs b/tests/Double3.hs new file mode 100644 --- /dev/null +++ b/tests/Double3.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = print (5 * 3 / 2) + +print :: Double -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/Double3.js b/tests/Double3.js new file mode 100644 --- /dev/null +++ b/tests/Double3.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)(_(5 * 3) / 2);});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/Double4 b/tests/Double4 new file mode 100644 --- /dev/null +++ b/tests/Double4 @@ -0,0 +1,1 @@ +1 diff --git a/tests/Double4.hs b/tests/Double4.hs new file mode 100644 --- /dev/null +++ b/tests/Double4.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = print 1 + +print :: Double -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/Double4.js b/tests/Double4.js new file mode 100644 --- /dev/null +++ b/tests/Double4.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)(1);});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/Hierarchical/Export.hs b/tests/Hierarchical/Export.hs new file mode 100644 --- /dev/null +++ b/tests/Hierarchical/Export.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Hierarchical.Export where + +exported :: String +exported = "exported" diff --git a/tests/Hierarchical/RecordDefined.hs b/tests/Hierarchical/RecordDefined.hs new file mode 100644 --- /dev/null +++ b/tests/Hierarchical/RecordDefined.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module RecordDefined where + +data Callback a = Callback Integer + +g (Callback a) = a diff --git a/tests/HierarchicalImport b/tests/HierarchicalImport new file mode 100644 --- /dev/null +++ b/tests/HierarchicalImport @@ -0,0 +1,1 @@ +exported diff --git a/tests/HierarchicalImport.hs b/tests/HierarchicalImport.hs new file mode 100644 --- /dev/null +++ b/tests/HierarchicalImport.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Main where + +import Hierarchical.Export + +main :: Fay () +main = printS exported + +printS :: String -> Fay () +printS = ffi "console.log(%1)" diff --git a/tests/HierarchicalImport.js b/tests/HierarchicalImport.js new file mode 100644 --- /dev/null +++ b/tests/HierarchicalImport.js @@ -0,0 +1,478 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var exported = new $(function(){return Fay$$list("exported");});var main = new $(function(){return _(printS)(exported);});var printS = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.max = max; +this.min = min; +this.mod = mod; +this.length = length; +this.$_const = $_const; +this.mapM_ = mapM_; +this.forM_ = forM_; +this.intercalate = intercalate; +this.prependToAll = prependToAll; +this.intersperse = intersperse; +this.lookup = lookup; +this.foldl = foldl; +this.foldr = foldr; +this.concat = concat; +this.conc = conc; +this.$36$ = $36$; +this.$43$$43$ = $43$$43$; +this.$46$ = $46$; +this.maybe = maybe; +this.flip = flip; +this.zip = zip; +this.zipWith = zipWith; +this.enumFromTo = enumFromTo; +this.enumFrom = enumFrom; +this.when = when; +this.insertBy = insertBy; +this.sortBy = sortBy; +this.compare = compare; +this.sort = sort; +this.elem = elem; +this.nub$39$ = nub$39$; +this.nub = nub; +this.map = map; +this.$_null = $_null; +this.not = not; +this.filter = filter; +this.any = any; +this.find = find; +this.fst = fst; +this.snd = snd; +this.fromRational = fromRational; +this.fromInteger = fromInteger; +this.show = show; +this.printS = printS; +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/List b/tests/List new file mode 100644 --- /dev/null +++ b/tests/List @@ -0,0 +1,1 @@ +[1,2,3,4,5] diff --git a/tests/List.hs b/tests/List.hs new file mode 100644 --- /dev/null +++ b/tests/List.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +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 + +map f [] = [] +map f (x:xs) = f x : map f xs + +print :: String -> Fay () +print = ffi "console.log(%1)" + +showList :: [Double] -> String +showList = ffi "JSON.stringify(%1)" diff --git a/tests/List.js b/tests/List.js new file mode 100644 --- /dev/null +++ b/tests/List.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)(_(showList)(_(_(take)(5))((function(){var ns = new $(function(){return _(_(Fay$$cons)(1))(_(_(map)(function($_a){var x = $_a;return _(x) + 1;}))(ns));});return ns;})())));});var take = function($_a){return function($_b){return new $(function(){if (_($_a) === 0) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var n = $_a;return _(_(Fay$$cons)(x))(_(_(take)(_(n) - 1))(xs));}throw ["unhandled case in Ident \"take\"",[$_a,$_b]];});};};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var f = $_a;return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var showList = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["list",[["double"]]],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/List2 b/tests/List2 new file mode 100644 --- /dev/null +++ b/tests/List2 @@ -0,0 +1,1 @@ +[1,61.5,3782.25,232608.375,14305415.0625] diff --git a/tests/List2.hs b/tests/List2.hs new file mode 100644 --- /dev/null +++ b/tests/List2.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = print (showList (take 5 (let ns = 1 : map (foo 123) ns in ns))) + +foo x y = x * y / 2 + +take 0 _ = [] +take n (x:xs) = x : take (n - 1) xs + +map f [] = [] +map f (x:xs) = f x : map f xs + +print :: String -> Fay () +print = ffi "console.log(%1)" + +showList :: [Double] -> String +showList = ffi "JSON.stringify(%1)" diff --git a/tests/List2.js b/tests/List2.js new file mode 100644 --- /dev/null +++ b/tests/List2.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)(_(showList)(_(_(take)(5))((function(){var ns = new $(function(){return _(_(Fay$$cons)(1))(_(_(map)(_(foo)(123)))(ns));});return ns;})())));});var foo = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) * _(y)) / 2;});};};var take = function($_a){return function($_b){return new $(function(){if (_($_a) === 0) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var n = $_a;return _(_(Fay$$cons)(x))(_(_(take)(_(n) - 1))(xs));}throw ["unhandled case in Ident \"take\"",[$_a,$_b]];});};};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var f = $_a;return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var showList = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["list",[["double"]]],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/Monad b/tests/Monad new file mode 100644 --- /dev/null +++ b/tests/Monad @@ -0,0 +1,3 @@ +456 +789 +101112 diff --git a/tests/Monad.hs b/tests/Monad.hs new file mode 100644 --- /dev/null +++ b/tests/Monad.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | Monads test. + +module Monads where + +import Language.Fay.FFI +import Language.Fay.Prelude + +main :: Fay () +main = do + 123 <- return 123 + x <- return 456 + print x >> return () + x <- return 666 >>= \_ -> return 789 + y <- return 101112 + print x + print y + +print :: Double -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/Monad.js b/tests/Monad.js new file mode 100644 --- /dev/null +++ b/tests/Monad.js @@ -0,0 +1,478 @@ +/** @constructor +*/ +var Monads = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(_($62$$62$$61$)(_($_return)(123)))(function($_a){if (_($_a) === 123) {return _(_($62$$62$$61$)(_($_return)(456)))(function($_a){var x = $_a;return _(_($62$$62$)(_(_($62$$62$)(_(print)(x)))(_($_return)(Fay$$unit))))(_(_($62$$62$$61$)(_(_($62$$62$$61$)(_($_return)(666)))(function($_a){return _($_return)(789);})))(function($_a){var x = $_a;return _(_($62$$62$$61$)(_($_return)(101112)))(function($_a){var y = $_a;return _(_($62$$62$)(_(print)(x)))(_(print)(y));});}));});}throw ["unhandled case",$_a];});});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.max = max; +this.min = min; +this.mod = mod; +this.length = length; +this.$_const = $_const; +this.mapM_ = mapM_; +this.forM_ = forM_; +this.intercalate = intercalate; +this.prependToAll = prependToAll; +this.intersperse = intersperse; +this.lookup = lookup; +this.foldl = foldl; +this.foldr = foldr; +this.concat = concat; +this.conc = conc; +this.$36$ = $36$; +this.$43$$43$ = $43$$43$; +this.$46$ = $46$; +this.maybe = maybe; +this.flip = flip; +this.zip = zip; +this.zipWith = zipWith; +this.enumFromTo = enumFromTo; +this.enumFrom = enumFrom; +this.when = when; +this.insertBy = insertBy; +this.sortBy = sortBy; +this.compare = compare; +this.sort = sort; +this.elem = elem; +this.nub$39$ = nub$39$; +this.nub = nub; +this.map = map; +this.$_null = $_null; +this.not = not; +this.filter = filter; +this.any = any; +this.find = find; +this.fst = fst; +this.snd = snd; +this.fromRational = fromRational; +this.fromInteger = fromInteger; +this.show = show; +this.print = print; +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Monads(); +main._(main.main); + diff --git a/tests/Monad2 b/tests/Monad2 new file mode 100644 --- /dev/null +++ b/tests/Monad2 @@ -0,0 +1,1 @@ +abc: 123 diff --git a/tests/Monad2.hs b/tests/Monad2.hs new file mode 100644 --- /dev/null +++ b/tests/Monad2.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RankNTypes #-} + +-- | Monads test. + +module Monads where + +import Language.Fay.FFI +import Language.Fay.Prelude + +main :: Fay () +main = do + -- State monad test + return (let result = runState demo 60 in fst result ++ ": " ++ show (snd result)) >>= print + +print :: String -> Fay () +print = ffi "console.log(%1)" + +-------------------------------------------------------------------------------- +-- A monad interface + +data MonadI m = Monad + (forall a. a -> m a) + (forall a b. m a -> (a -> m b) -> m b) + (forall a b. m a -> m b -> m b) + +--------------------------------------------------------------------------------- +-- State monad + +-- Example + +demo = + case stateMonad of + Monad return (>>=) (>>) -> do + n <- get + put (n*2) + n <- get + put (n+3) + return "abc" + +-- Definition + +data State s a = State { runState :: s -> (a, s) } +instance Monad (State a) + +stateMonad = Monad return (>>=) (>>) where + return = \x -> State ( \st -> (x, st) ) + (>>=) = \processor processorGenerator -> + State $ \st -> + case runState processor st of + (x, st') -> runState (processorGenerator x) st' + (>>) = \a b -> a >>= \_ -> b + +put newState = State $ \_ -> ((), newState) + +get = State $ \st -> (st, st) diff --git a/tests/Monad2.js b/tests/Monad2.js new file mode 100644 --- /dev/null +++ b/tests/Monad2.js @@ -0,0 +1,483 @@ +/** @constructor +*/ +var Monads = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(_($62$$62$$61$)(_($_return)((function(){var result = new $(function(){return _(_(runState)(demo))(60);});return _(_($43$$43$)(_(fst)(result)))(_(_($43$$43$)(Fay$$list(": ")))(_(show)(_(snd)(result))));})())))(print);});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Monad = function(slot1,slot2,slot3){this.slot1 = slot1;this.slot2 = slot2;this.slot3 = slot3;};var Monad = function(slot1){return function(slot2){return function(slot3){return new $(function(){return new $_Monad(slot1,slot2,slot3);});};};};var demo = new $(function(){return (function($_stateMonad){if (_($_stateMonad) instanceof $_Monad) {var $_return = _($_stateMonad).slot1;var $62$$62$$61$ = _($_stateMonad).slot2;var $62$$62$ = _($_stateMonad).slot3;return _(_($62$$62$$61$)(get))(function($_a){var n = $_a;return _(_($62$$62$)(_(put)(_(n) * 2)))(_(_($62$$62$$61$)(get))(function($_a){var n = $_a;return _(_($62$$62$)(_(put)(_(n) + 3)))(_($_return)(Fay$$list("abc")));}));});}return (function(){ throw (["unhandled case",$_stateMonad]); })();})(stateMonad);});var $_State = function(runState){this.runState = runState;};var State = function(runState){return new $(function(){return new $_State(runState);});};var runState = function(x){return new $(function(){return _(x).runState;});};var stateMonad = new $(function(){var $_return = new $(function(){return function($_a){var x = $_a;return _(State)(function($_a){var st = $_a;return Fay$$list([x,st]);});};});var $62$$62$$61$ = new $(function(){return function($_a){var processor = $_a;return function($_b){var processorGenerator = $_b;return _(_($36$)(State))(function($_a){var st = $_a;return (function($tmp){var x = Fay$$index(0)(_($tmp));var st$39$ = Fay$$index(1)(_($tmp));return _(_(runState)(_(processorGenerator)(x)))(st$39$);return (function(){ throw (["unhandled case",$tmp]); })();})(_(_(runState)(processor))(st));});};};});var $62$$62$ = new $(function(){return function($_a){var a = $_a;return function($_b){var b = $_b;return _(_($62$$62$$61$)(a))(function($_a){return b;});};};});return _(_(_(Monad)($_return))($62$$62$$61$))($62$$62$);});var put = function($_a){return new $(function(){var newState = $_a;return _(_($36$)(State))(function($_a){return Fay$$list([Fay$$unit,newState]);});});};var get = new $(function(){return _(_($36$)(State))(function($_a){var st = $_a;return Fay$$list([st,st]);});});var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $_State) {return {"instance": "State","runState": Fay$$fayToJs(["function",[["unknown"],["unknown"]]],_(_obj.runState))};}if (_obj instanceof $_Monad) {return {"instance": "Monad","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1)),"slot2": Fay$$fayToJs(["unknown"],_(_obj.slot2)),"slot3": Fay$$fayToJs(["unknown"],_(_obj.slot3))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "State") {return new $_State(Fay$$jsToFay(["function",[["unknown"],["unknown"]]],obj["runState"]));}if (obj["instance"] === "Monad") {return new $_Monad(Fay$$jsToFay(["unknown"],obj["slot1"]),Fay$$jsToFay(["unknown"],obj["slot2"]),Fay$$jsToFay(["unknown"],obj["slot3"]));}return obj;}; +// Exports +this.max = max; +this.min = min; +this.mod = mod; +this.length = length; +this.$_const = $_const; +this.mapM_ = mapM_; +this.forM_ = forM_; +this.intercalate = intercalate; +this.prependToAll = prependToAll; +this.intersperse = intersperse; +this.lookup = lookup; +this.foldl = foldl; +this.foldr = foldr; +this.concat = concat; +this.conc = conc; +this.$36$ = $36$; +this.$43$$43$ = $43$$43$; +this.$46$ = $46$; +this.maybe = maybe; +this.flip = flip; +this.zip = zip; +this.zipWith = zipWith; +this.enumFromTo = enumFromTo; +this.enumFrom = enumFrom; +this.when = when; +this.insertBy = insertBy; +this.sortBy = sortBy; +this.compare = compare; +this.sort = sort; +this.elem = elem; +this.nub$39$ = nub$39$; +this.nub = nub; +this.map = map; +this.$_null = $_null; +this.not = not; +this.filter = filter; +this.any = any; +this.find = find; +this.fst = fst; +this.snd = snd; +this.fromRational = fromRational; +this.fromInteger = fromInteger; +this.show = show; +this.get = get; +this.put = put; +this.stateMonad = stateMonad; +this.runState = runState; +this.demo = demo; +this.print = print; +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Monads(); +main._(main.main); + diff --git a/tests/RecCon b/tests/RecCon new file mode 100644 --- /dev/null +++ b/tests/RecCon @@ -0,0 +1,1 @@ +123 diff --git a/tests/RecCon.hs b/tests/RecCon.hs new file mode 100644 --- /dev/null +++ b/tests/RecCon.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +data Bool = True | False + +main = print (head (fix (\xs -> 123 : xs))) + +print :: Double -> Fay () +print = ffi "console.log(%1)" + +head (x:xs) = x + +fix f = let x = f x in x diff --git a/tests/RecCon.js b/tests/RecCon.js new file mode 100644 --- /dev/null +++ b/tests/RecCon.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var $_True = function(){};var True = new $(function(){return new $_True();});var $_False = function(){};var False = new $(function(){return new $_False();});var main = new $(function(){return _(print)(_(head)(_(fix)(function($_a){var xs = $_a;return _(_(Fay$$cons)(123))(xs);})));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$_a)));});};var head = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return x;}throw ["unhandled case in Ident \"head\"",[$_a]];});};var fix = function($_a){return new $(function(){var f = $_a;return (function(){var x = new $(function(){return _(f)(x);});return x;})();});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $_False) {return {"instance": "False"};}if (_obj instanceof $_True) {return {"instance": "True"};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "False") {return new $_False();}if (obj["instance"] === "True") {return new $_True();}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/RecDecl b/tests/RecDecl new file mode 100644 --- /dev/null +++ b/tests/RecDecl @@ -0,0 +1,9 @@ +{ instance: 'R', i: 1, c: 'a' } +1 +"a" +{ instance: 'R', i: 2, c: 'b' } +{ instance: 'R', i: undefined, c: 'b' } +{ instance: 'R', i: 3, c: 'c' } +{ instance: 'S', slot1: 1, slot2: 'a' } +{ instance: 'X', _x1: 1, _x2: 2 } +{ instance: 'X', _x1: 1, _x2: 2 } diff --git a/tests/RecDecl.hs b/tests/RecDecl.hs new file mode 100644 --- /dev/null +++ b/tests/RecDecl.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +data R = R { i :: Double, c :: Char } +data S = S Double Char + +-- RecDecl +r1 :: R +r1 = R { i = 1, c = 'a' } + +-- RecDecl with fields out of order +r2 :: R +r2 = R { c = 'b', i = 2 } + +-- Partial RecDecl (Produces GHC warning) +r' :: R +r' = R { c = 'b' } + +-- Regular application +r3 :: R +r3 = R 3 'c' + +-- Using regular constructor +s1 :: S +s1 = S 1 'a' + +-- Multiple fields with the same type +data X = X { _x1, _x2 :: Int } +x1 = X 1 2 +x2 = X { _x1 = 1, _x2 = 2 } + +main = do + print r1 + printS (show (i r1)) + printS (show (c r1)) + print r2 + print r' + print r3 + print s1 + print x1 + print x2 + +printS :: String -> Fay () +printS = ffi "console.log(%1)" + +print :: a -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/RecDecl.js b/tests/RecDecl.js new file mode 100644 --- /dev/null +++ b/tests/RecDecl.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var $_R = function(i,c){this.i = i;this.c = c;};var R = function(i){return function(c){return new $(function(){return new $_R(i,c);});};};var i = function(x){return new $(function(){return _(x).i;});};var c = function(x){return new $(function(){return _(x).c;});};var $_S = function(slot1,slot2){this.slot1 = slot1;this.slot2 = slot2;};var S = function(slot1){return function(slot2){return new $(function(){return new $_S(slot1,slot2);});};};var r1 = new $(function(){var r = new $_R();r.i = 1;r.c = "a";return r;});var r2 = new $(function(){var r = new $_R();r.c = "b";r.i = 2;return r;});var r$39$ = new $(function(){var r = new $_R();r.c = "b";return r;});var r3 = new $(function(){return _(_(R)(3))("c");});var s1 = new $(function(){return _(_(S)(1))("a");});var $_X = function(_x1,_x2){this._x1 = _x1;this._x2 = _x2;};var X = function(_x1){return function(_x2){return new $(function(){return new $_X(_x1,_x2);});};};var _x1 = function(x){return new $(function(){return _(x)._x1;});};var _x2 = function(x){return new $(function(){return _(x)._x2;});};var x1 = new $(function(){return _(_(X)(1))(2);});var x2 = new $(function(){var x = new $_X();x._x1 = 1;x._x2 = 2;return x;});var main = new $(function(){return _(_($62$$62$)(_(print)(r1)))(_(_($62$$62$)(_(printS)(_(show)(_(i)(r1)))))(_(_($62$$62$)(_(printS)(_(show)(_(c)(r1)))))(_(_($62$$62$)(_(print)(r2)))(_(_($62$$62$)(_(print)(r$39$)))(_(_($62$$62$)(_(print)(r3)))(_(_($62$$62$)(_(print)(s1)))(_(_($62$$62$)(_(print)(x1)))(_(print)(x2)))))))));});var printS = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["unknown"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $_X) {return {"instance": "X","_x1": Fay$$fayToJs(["user","Int",[]],_(_obj._x1)),"_x2": Fay$$fayToJs(["user","Int",[]],_(_obj._x2))};}if (_obj instanceof $_S) {return {"instance": "S","slot1": Fay$$fayToJs(["double"],_(_obj.slot1)),"slot2": Fay$$fayToJs(["user","Char",[]],_(_obj.slot2))};}if (_obj instanceof $_R) {return {"instance": "R","i": Fay$$fayToJs(["double"],_(_obj.i)),"c": Fay$$fayToJs(["user","Char",[]],_(_obj.c))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "X") {return new $_X(Fay$$jsToFay(["user","Int",[]],obj["_x1"]),Fay$$jsToFay(["user","Int",[]],obj["_x2"]));}if (obj["instance"] === "S") {return new $_S(Fay$$jsToFay(["double"],obj["slot1"]),Fay$$jsToFay(["user","Char",[]],obj["slot2"]));}if (obj["instance"] === "R") {return new $_R(Fay$$jsToFay(["double"],obj["i"]),Fay$$jsToFay(["user","Char",[]],obj["c"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/RecordImport_Export b/tests/RecordImport_Export new file mode 100644 --- /dev/null +++ b/tests/RecordImport_Export diff --git a/tests/RecordImport_Export.hs b/tests/RecordImport_Export.hs new file mode 100644 --- /dev/null +++ b/tests/RecordImport_Export.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module RecordImport_Export where + +data R = R Integer diff --git a/tests/RecordImport_Export.js b/tests/RecordImport_Export.js new file mode 100644 --- /dev/null +++ b/tests/RecordImport_Export.js @@ -0,0 +1,476 @@ +/** @constructor +*/ +var RecordImport_Export = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var $_R = function(slot1){this.slot1 = slot1;};var R = function(slot1){return new $(function(){return new $_R(slot1);});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $_R) {return {"instance": "R","slot1": Fay$$fayToJs(["user","Integer",[]],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "R") {return new $_R(Fay$$jsToFay(["user","Integer",[]],obj["slot1"]));}return obj;}; +// Exports +this.max = max; +this.min = min; +this.mod = mod; +this.length = length; +this.$_const = $_const; +this.mapM_ = mapM_; +this.forM_ = forM_; +this.intercalate = intercalate; +this.prependToAll = prependToAll; +this.intersperse = intersperse; +this.lookup = lookup; +this.foldl = foldl; +this.foldr = foldr; +this.concat = concat; +this.conc = conc; +this.$36$ = $36$; +this.$43$$43$ = $43$$43$; +this.$46$ = $46$; +this.maybe = maybe; +this.flip = flip; +this.zip = zip; +this.zipWith = zipWith; +this.enumFromTo = enumFromTo; +this.enumFrom = enumFrom; +this.when = when; +this.insertBy = insertBy; +this.sortBy = sortBy; +this.compare = compare; +this.sort = sort; +this.elem = elem; +this.nub$39$ = nub$39$; +this.nub = nub; +this.map = map; +this.$_null = $_null; +this.not = not; +this.filter = filter; +this.any = any; +this.find = find; +this.fst = fst; +this.snd = snd; +this.fromRational = fromRational; +this.fromInteger = fromInteger; +this.show = show; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new RecordImport_Export(); +main._(main.main); + diff --git a/tests/RecordImport_Import b/tests/RecordImport_Import new file mode 100644 --- /dev/null +++ b/tests/RecordImport_Import @@ -0,0 +1,1 @@ +R 1 diff --git a/tests/RecordImport_Import.hs b/tests/RecordImport_Import.hs new file mode 100644 --- /dev/null +++ b/tests/RecordImport_Import.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module RecordImport_Import where + +import Language.Fay.FFI +import Language.Fay.Prelude + +import RecordImport_Export + +f :: R -> R +f (R i) = R i + +showR :: R -> String +showR (R i) = "R " ++ show i + +printS :: String -> Fay () +printS = ffi "console.log(%1)" + +main = printS $ showR $ R 1 + diff --git a/tests/RecordImport_Import.js b/tests/RecordImport_Import.js new file mode 100644 --- /dev/null +++ b/tests/RecordImport_Import.js @@ -0,0 +1,480 @@ +/** @constructor +*/ +var RecordImport_Import = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var $_R = function(slot1){this.slot1 = slot1;};var R = function(slot1){return new $(function(){return new $_R(slot1);});};var f = function($_a){return new $(function(){if (_($_a) instanceof $_R) {var i = _($_a).slot1;return _(R)(i);}throw ["unhandled case in Ident \"f\"",[$_a]];});};var showR = function($_a){return new $(function(){if (_($_a) instanceof $_R) {var i = _($_a).slot1;return _(_($43$$43$)(Fay$$list("R ")))(_(show)(i));}throw ["unhandled case in Ident \"showR\"",[$_a]];});};var printS = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var main = new $(function(){return _(_($36$)(printS))(_(_($36$)(showR))(_(R)(1)));});var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $_R) {return {"instance": "R","slot1": Fay$$fayToJs(["user","Integer",[]],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "R") {return new $_R(Fay$$jsToFay(["user","Integer",[]],obj["slot1"]));}return obj;}; +// Exports +this.max = max; +this.min = min; +this.mod = mod; +this.length = length; +this.$_const = $_const; +this.mapM_ = mapM_; +this.forM_ = forM_; +this.intercalate = intercalate; +this.prependToAll = prependToAll; +this.intersperse = intersperse; +this.lookup = lookup; +this.foldl = foldl; +this.foldr = foldr; +this.concat = concat; +this.conc = conc; +this.$36$ = $36$; +this.$43$$43$ = $43$$43$; +this.$46$ = $46$; +this.maybe = maybe; +this.flip = flip; +this.zip = zip; +this.zipWith = zipWith; +this.enumFromTo = enumFromTo; +this.enumFrom = enumFrom; +this.when = when; +this.insertBy = insertBy; +this.sortBy = sortBy; +this.compare = compare; +this.sort = sort; +this.elem = elem; +this.nub$39$ = nub$39$; +this.nub = nub; +this.map = map; +this.$_null = $_null; +this.not = not; +this.filter = filter; +this.any = any; +this.find = find; +this.fst = fst; +this.snd = snd; +this.fromRational = fromRational; +this.fromInteger = fromInteger; +this.show = show; +this.main = main; +this.printS = printS; +this.showR = showR; +this.f = f; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new RecordImport_Import(); +main._(main.main); + diff --git a/tests/String b/tests/String new file mode 100644 --- /dev/null +++ b/tests/String @@ -0,0 +1,1 @@ +Hello, World! diff --git a/tests/String.hs b/tests/String.hs new file mode 100644 --- /dev/null +++ b/tests/String.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = print "Hello, World!" + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/String.js b/tests/String.js new file mode 100644 --- /dev/null +++ b/tests/String.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)(Fay$$list("Hello, World!"));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/asPatternMatch b/tests/asPatternMatch new file mode 100644 --- /dev/null +++ b/tests/asPatternMatch @@ -0,0 +1,3 @@ +{"car":{"car":1,"cdr":{"car":2,"cdr":{"car":3,"cdr":null}}},"cdr":{"car":{"car":1,"cdr":{"car":2,"cdr":{"car":3,"cdr":null}}},"cdr":null}} +{"car":{"car":1,"cdr":{"car":2,"cdr":{"car":3,"cdr":null}}},"cdr":{"car":1,"cdr":{"car":{"car":2,"cdr":{"car":3,"cdr":null}},"cdr":null}}} +{"car":{"car":1,"cdr":{"car":2,"cdr":{"car":3,"cdr":null}}},"cdr":{"car":1,"cdr":{"car":{"car":2,"cdr":{"car":3,"cdr":null}},"cdr":null}}} diff --git a/tests/asPatternMatch.hs b/tests/asPatternMatch.hs new file mode 100644 --- /dev/null +++ b/tests/asPatternMatch.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Test where + +-- | As pattern matches + +import Language.Fay.FFI +import Language.Fay.Prelude + +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]) diff --git a/tests/asPatternMatch.js b/tests/asPatternMatch.js new file mode 100644 --- /dev/null +++ b/tests/asPatternMatch.js @@ -0,0 +1,481 @@ +/** @constructor +*/ +var Test = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var matchSame = function($_a){return new $(function(){var x = $_a;var y = $_a;return Fay$$list([x,y]);return Fay$$list([x,y]);throw ["unhandled case in Ident \"matchSame\"",[$_a]];});};var matchSplit = function($_a){return new $(function(){var x = $_a;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var y = $_$_a.car;var z = $_$_a.cdr;return Fay$$list([x,y,z]);}return Fay$$list([x,y,z]);throw ["unhandled case in Ident \"matchSplit\"",[$_a]];});};var matchNested = function($_a){return new $(function(){var a = Fay$$index(0)(_($_a));var b = Fay$$index(1)(_($_a));var $tmp = _(Fay$$index(1)(_($_a)));if ($tmp instanceof Fay$$Cons) {var x = $tmp.car;var xs = $tmp.cdr;return Fay$$list([b,x,xs]);}return Fay$$list([b,x,xs]);throw ["unhandled case in Ident \"matchNested\"",[$_a]];});};var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var main = new $(function(){return _(_($62$$62$)(_(_($36$)(print))(_(_($36$)(show))(_(matchSame)(Fay$$list([1,2,3]))))))(_(_($62$$62$)(_(_($36$)(print))(_(_($36$)(show))(_(matchSplit)(Fay$$list([1,2,3]))))))(_(_($36$)(print))(_(_($36$)(show))(_(matchNested)(Fay$$list([1,Fay$$list([1,2,3])]))))));});var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.max = max; +this.min = min; +this.mod = mod; +this.length = length; +this.$_const = $_const; +this.mapM_ = mapM_; +this.forM_ = forM_; +this.intercalate = intercalate; +this.prependToAll = prependToAll; +this.intersperse = intersperse; +this.lookup = lookup; +this.foldl = foldl; +this.foldr = foldr; +this.concat = concat; +this.conc = conc; +this.$36$ = $36$; +this.$43$$43$ = $43$$43$; +this.$46$ = $46$; +this.maybe = maybe; +this.flip = flip; +this.zip = zip; +this.zipWith = zipWith; +this.enumFromTo = enumFromTo; +this.enumFrom = enumFrom; +this.when = when; +this.insertBy = insertBy; +this.sortBy = sortBy; +this.compare = compare; +this.sort = sort; +this.elem = elem; +this.nub$39$ = nub$39$; +this.nub = nub; +this.map = map; +this.$_null = $_null; +this.not = not; +this.filter = filter; +this.any = any; +this.find = find; +this.fst = fst; +this.snd = snd; +this.fromRational = fromRational; +this.fromInteger = fromInteger; +this.show = show; +this.main = main; +this.print = print; +this.matchNested = matchNested; +this.matchSplit = matchSplit; +this.matchSame = matchSame; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Test(); +main._(main.main); + diff --git a/tests/basicFunctions b/tests/basicFunctions new file mode 100644 --- /dev/null +++ b/tests/basicFunctions @@ -0,0 +1,1 @@ +Hello, World! diff --git a/tests/basicFunctions.hs b/tests/basicFunctions.hs new file mode 100644 --- /dev/null +++ b/tests/basicFunctions.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = print (concat ["Hello, ","World!"]) + +concat = foldr append [] + +foldr f z [] = z +foldr f z (x:xs) = f x (foldr f z xs) + +append (x:xs) ys = x : append xs ys +append [] ys = ys + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/basicFunctions.js b/tests/basicFunctions.js new file mode 100644 --- /dev/null +++ b/tests/basicFunctions.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)(_(concat)(Fay$$list([Fay$$list("Hello, "),Fay$$list("World!")])));});var concat = new $(function(){return _(_(foldr)(append))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;var f = $_a;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var append = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(append)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"append\"",[$_a,$_b]];});};};var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/case b/tests/case new file mode 100644 --- /dev/null +++ b/tests/case @@ -0,0 +1,1 @@ +Hello! diff --git a/tests/case.hs b/tests/case.hs new file mode 100644 --- /dev/null +++ b/tests/case.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = print (case True of + True -> "Hello!" + False -> "Ney!") + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/case.js b/tests/case.js new file mode 100644 --- /dev/null +++ b/tests/case.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)((function($_true){if (_($_true) === true) {return Fay$$list("Hello!");}if (_($_true) === false) {return Fay$$list("Ney!");}return (function(){ throw (["unhandled case",$_true]); })();})(true));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/case2 b/tests/case2 new file mode 100644 --- /dev/null +++ b/tests/case2 @@ -0,0 +1,1 @@ +Ney! diff --git a/tests/case2.hs b/tests/case2.hs new file mode 100644 --- /dev/null +++ b/tests/case2.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = print (case False of + True -> "Hello!" + False -> "Ney!") + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/case2.js b/tests/case2.js new file mode 100644 --- /dev/null +++ b/tests/case2.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)((function($_false){if (_($_false) === true) {return Fay$$list("Hello!");}if (_($_false) === false) {return Fay$$list("Ney!");}return (function(){ throw (["unhandled case",$_false]); })();})(false));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/caseList b/tests/caseList new file mode 100644 --- /dev/null +++ b/tests/caseList @@ -0,0 +1,1 @@ +OK. diff --git a/tests/caseList.hs b/tests/caseList.hs new file mode 100644 --- /dev/null +++ b/tests/caseList.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = print (case [1,2,3,4,5] of + [1,2,3,4,6] -> "6!" + [1,2,4,2,4] -> "a!" + [1,2,3,4,5] -> "OK." + _ -> "Broken.") + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/caseList.js b/tests/caseList.js new file mode 100644 --- /dev/null +++ b/tests/caseList.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)((function($tmp){if (_(Fay$$index(0)(_($tmp))) === 1) {if (_(Fay$$index(1)(_($tmp))) === 2) {if (_(Fay$$index(2)(_($tmp))) === 3) {if (_(Fay$$index(3)(_($tmp))) === 4) {if (_(Fay$$index(4)(_($tmp))) === 6) {return Fay$$list("6!");}}}if (_(Fay$$index(2)(_($tmp))) === 4) {if (_(Fay$$index(3)(_($tmp))) === 2) {if (_(Fay$$index(4)(_($tmp))) === 4) {return Fay$$list("a!");}}}if (_(Fay$$index(2)(_($tmp))) === 3) {if (_(Fay$$index(3)(_($tmp))) === 4) {if (_(Fay$$index(4)(_($tmp))) === 5) {return Fay$$list("OK.");}}}}}return Fay$$list("Broken.");})(Fay$$list([1,2,3,4,5])));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/caseWildcard b/tests/caseWildcard new file mode 100644 --- /dev/null +++ b/tests/caseWildcard @@ -0,0 +1,1 @@ +Ney! diff --git a/tests/caseWildcard.hs b/tests/caseWildcard.hs new file mode 100644 --- /dev/null +++ b/tests/caseWildcard.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = print (case False of + True -> "Hello!" + _ -> "Ney!") + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/caseWildcard.js b/tests/caseWildcard.js new file mode 100644 --- /dev/null +++ b/tests/caseWildcard.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)((function($_false){if (_($_false) === true) {return Fay$$list("Hello!");}return Fay$$list("Ney!");})(false));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/do b/tests/do new file mode 100644 --- /dev/null +++ b/tests/do @@ -0,0 +1,2 @@ +Hello, +World! diff --git a/tests/do.hs b/tests/do.hs new file mode 100644 --- /dev/null +++ b/tests/do.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = do print "Hello,"; print "World!" + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/do.js b/tests/do.js new file mode 100644 --- /dev/null +++ b/tests/do.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(_($62$$62$)(_(print)(Fay$$list("Hello,"))))(_(print)(Fay$$list("World!")));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/doAssingPatternMatch b/tests/doAssingPatternMatch new file mode 100644 --- /dev/null +++ b/tests/doAssingPatternMatch @@ -0,0 +1,1 @@ +OK. diff --git a/tests/doAssingPatternMatch.hs b/tests/doAssingPatternMatch.hs new file mode 100644 --- /dev/null +++ b/tests/doAssingPatternMatch.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = do + [1,2] <- return [1,2] + print "OK." + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/doAssingPatternMatch.js b/tests/doAssingPatternMatch.js new file mode 100644 --- /dev/null +++ b/tests/doAssingPatternMatch.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(_($62$$62$$61$)(_($_return)(Fay$$list([1,2]))))(function($_a){if (_(Fay$$index(0)(_($_a))) === 1) {if (_(Fay$$index(1)(_($_a))) === 2) {return _(print)(Fay$$list("OK."));}}throw ["unhandled case",$_a];});});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/doBindAssign b/tests/doBindAssign new file mode 100644 --- /dev/null +++ b/tests/doBindAssign @@ -0,0 +1,1 @@ +Hello, World! diff --git a/tests/doBindAssign.hs b/tests/doBindAssign.hs new file mode 100644 --- /dev/null +++ b/tests/doBindAssign.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = do + x <- return "Hello, World!" >>= return + print x + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/doBindAssign.js b/tests/doBindAssign.js new file mode 100644 --- /dev/null +++ b/tests/doBindAssign.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(_($62$$62$$61$)(_(_($62$$62$$61$)(_($_return)(Fay$$list("Hello, World!"))))($_return)))(function($_a){var x = $_a;return _(print)(x);});});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/emptyMain b/tests/emptyMain new file mode 100644 --- /dev/null +++ b/tests/emptyMain diff --git a/tests/emptyMain.hs b/tests/emptyMain.hs new file mode 100644 --- /dev/null +++ b/tests/emptyMain.hs @@ -0,0 +1,3 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = return () diff --git a/tests/emptyMain.js b/tests/emptyMain.js new file mode 100644 --- /dev/null +++ b/tests/emptyMain.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _($_return)(Fay$$unit);});var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/fix b/tests/fix new file mode 100644 --- /dev/null +++ b/tests/fix @@ -0,0 +1,1 @@ +123 diff --git a/tests/fix.hs b/tests/fix.hs new file mode 100644 --- /dev/null +++ b/tests/fix.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = print (head (tail (fix (\xs -> 123 : xs)))) + +print :: Double -> Fay () +print = ffi "console.log(%1)" + +head (x:xs) = x + +fix f = let x = f x in x + +tail (_:xs) = xs diff --git a/tests/fix.js b/tests/fix.js new file mode 100644 --- /dev/null +++ b/tests/fix.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)(_(head)(_(tail)(_(fix)(function($_a){var xs = $_a;return _(_(Fay$$cons)(123))(xs);}))));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$_a)));});};var head = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return x;}throw ["unhandled case in Ident \"head\"",[$_a]];});};var fix = function($_a){return new $(function(){var f = $_a;return (function(){var x = new $(function(){return _(f)(x);});return x;})();});};var tail = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var xs = $_$_a.cdr;return xs;}throw ["unhandled case in Ident \"tail\"",[$_a]];});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/fromInteger b/tests/fromInteger new file mode 100644 --- /dev/null +++ b/tests/fromInteger @@ -0,0 +1,1 @@ +5 diff --git a/tests/fromInteger.hs b/tests/fromInteger.hs new file mode 100644 --- /dev/null +++ b/tests/fromInteger.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Test where + +import Language.Fay.FFI +import Language.Fay.Prelude + +print :: String -> Fay () +print = ffi "console.log(%1)" + +main :: Fay () +main = print $ show $ fromInteger 5 diff --git a/tests/fromInteger.js b/tests/fromInteger.js new file mode 100644 --- /dev/null +++ b/tests/fromInteger.js @@ -0,0 +1,478 @@ +/** @constructor +*/ +var Test = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var main = new $(function(){return _(_($36$)(print))(_(_($36$)(show))(_(fromInteger)(5)));});var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.max = max; +this.min = min; +this.mod = mod; +this.length = length; +this.$_const = $_const; +this.mapM_ = mapM_; +this.forM_ = forM_; +this.intercalate = intercalate; +this.prependToAll = prependToAll; +this.intersperse = intersperse; +this.lookup = lookup; +this.foldl = foldl; +this.foldr = foldr; +this.concat = concat; +this.conc = conc; +this.$36$ = $36$; +this.$43$$43$ = $43$$43$; +this.$46$ = $46$; +this.maybe = maybe; +this.flip = flip; +this.zip = zip; +this.zipWith = zipWith; +this.enumFromTo = enumFromTo; +this.enumFrom = enumFrom; +this.when = when; +this.insertBy = insertBy; +this.sortBy = sortBy; +this.compare = compare; +this.sort = sort; +this.elem = elem; +this.nub$39$ = nub$39$; +this.nub = nub; +this.map = map; +this.$_null = $_null; +this.not = not; +this.filter = filter; +this.any = any; +this.find = find; +this.fst = fst; +this.snd = snd; +this.fromRational = fromRational; +this.fromInteger = fromInteger; +this.show = show; +this.main = main; +this.print = print; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Test(); +main._(main.main); + diff --git a/tests/infixDataConst b/tests/infixDataConst new file mode 100644 --- /dev/null +++ b/tests/infixDataConst @@ -0,0 +1,1 @@ +{"instance":"$58$$61$$62$","slot1":{"instance":"InfixConst1","slot1":123,"slot2":123},"slot2":{"instance":"InfixConst2","slot1":false,"slot2":true}} diff --git a/tests/infixDataConst.hs b/tests/infixDataConst.hs new file mode 100644 --- /dev/null +++ b/tests/infixDataConst.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +import Language.Fay.FFI +import Language.Fay.Prelude + + +data Ty1 = Integer `InfixConst1` Integer + deriving Show + +data Ty2 = Bool `InfixConst2` Bool + deriving Show + +data Ty3 = Ty1 :=> Ty2 + +t = (123 `InfixConst1` 123) :=> (False `InfixConst2` True) + +main = do + print (show t) + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/infixDataConst.js b/tests/infixDataConst.js new file mode 100644 --- /dev/null +++ b/tests/infixDataConst.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var $_InfixConst1 = function(slot1,slot2){this.slot1 = slot1;this.slot2 = slot2;};var InfixConst1 = function(slot1){return function(slot2){return new $(function(){return new $_InfixConst1(slot1,slot2);});};};var $_InfixConst2 = function(slot1,slot2){this.slot1 = slot1;this.slot2 = slot2;};var InfixConst2 = function(slot1){return function(slot2){return new $(function(){return new $_InfixConst2(slot1,slot2);});};};var $_$58$$61$$62$ = function(slot1,slot2){this.slot1 = slot1;this.slot2 = slot2;};var $58$$61$$62$ = function(slot1){return function(slot2){return new $(function(){return new $_$58$$61$$62$(slot1,slot2);});};};var t = new $(function(){return _(_($58$$61$$62$)(_(_(InfixConst1)(123))(123)))(_(_(InfixConst2)(false))(true));});var main = new $(function(){return _(print)(_(show)(t));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $_$58$$61$$62$) {return {"instance": "$58$$61$$62$","slot1": Fay$$fayToJs(["user","Ty1",[]],_(_obj.slot1)),"slot2": Fay$$fayToJs(["user","Ty2",[]],_(_obj.slot2))};}if (_obj instanceof $_InfixConst2) {return {"instance": "InfixConst2","slot1": Fay$$fayToJs(["bool"],_(_obj.slot1)),"slot2": Fay$$fayToJs(["bool"],_(_obj.slot2))};}if (_obj instanceof $_InfixConst1) {return {"instance": "InfixConst1","slot1": Fay$$fayToJs(["user","Integer",[]],_(_obj.slot1)),"slot2": Fay$$fayToJs(["user","Integer",[]],_(_obj.slot2))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "$58$$61$$62$") {return new $_$58$$61$$62$(Fay$$jsToFay(["user","Ty1",[]],obj["slot1"]),Fay$$jsToFay(["user","Ty2",[]],obj["slot2"]));}if (obj["instance"] === "InfixConst2") {return new $_InfixConst2(Fay$$jsToFay(["bool"],obj["slot1"]),Fay$$jsToFay(["bool"],obj["slot2"]));}if (obj["instance"] === "InfixConst1") {return new $_InfixConst1(Fay$$jsToFay(["user","Integer",[]],obj["slot1"]),Fay$$jsToFay(["user","Integer",[]],obj["slot2"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/mutableReference b/tests/mutableReference new file mode 100644 --- /dev/null +++ b/tests/mutableReference @@ -0,0 +1,1 @@ +Hai! diff --git a/tests/mutableReference.hs b/tests/mutableReference.hs new file mode 100644 --- /dev/null +++ b/tests/mutableReference.hs @@ -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)" diff --git a/tests/mutableReference.js b/tests/mutableReference.js new file mode 100644 --- /dev/null +++ b/tests/mutableReference.js @@ -0,0 +1,481 @@ +/** @constructor +*/ +var Ref = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(_($62$$62$$61$)(_(newRef)(Fay$$list("Hello, World!"))))(function($_a){var ref = $_a;return _(_($62$$62$$61$)(_(readRef)(ref)))(function($_a){var x = $_a;return _(_($62$$62$)(_(_(writeRef)(ref))(Fay$$list("Hai!"))))(_(_($62$$62$$61$)(_(readRef)(ref)))(print));});});});var newRef = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["user","Ref",[["unknown"]]]]],new Fay$$Ref(Fay$$fayToJs(["unknown"],$_a)));});};var writeRef = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],Fay$$writeRef(Fay$$fayToJs(["user","Ref",[["unknown"]]],$_a),Fay$$fayToJs(["unknown"],$_b)));});};};var readRef = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],Fay$$readRef(Fay$$fayToJs(["user","Ref",[["unknown"]]],$_a)));});};var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.max = max; +this.min = min; +this.mod = mod; +this.length = length; +this.$_const = $_const; +this.mapM_ = mapM_; +this.forM_ = forM_; +this.intercalate = intercalate; +this.prependToAll = prependToAll; +this.intersperse = intersperse; +this.lookup = lookup; +this.foldl = foldl; +this.foldr = foldr; +this.concat = concat; +this.conc = conc; +this.$36$ = $36$; +this.$43$$43$ = $43$$43$; +this.$46$ = $46$; +this.maybe = maybe; +this.flip = flip; +this.zip = zip; +this.zipWith = zipWith; +this.enumFromTo = enumFromTo; +this.enumFrom = enumFrom; +this.when = when; +this.insertBy = insertBy; +this.sortBy = sortBy; +this.compare = compare; +this.sort = sort; +this.elem = elem; +this.nub$39$ = nub$39$; +this.nub = nub; +this.map = map; +this.$_null = $_null; +this.not = not; +this.filter = filter; +this.any = any; +this.find = find; +this.fst = fst; +this.snd = snd; +this.fromRational = fromRational; +this.fromInteger = fromInteger; +this.show = show; +this.print = print; +this.readRef = readRef; +this.writeRef = writeRef; +this.newRef = newRef; +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Ref(); +main._(main.main); + diff --git a/tests/patternGuards b/tests/patternGuards new file mode 100644 --- /dev/null +++ b/tests/patternGuards @@ -0,0 +1,3 @@ +[true,false] +[2,1,0] +[true,false] diff --git a/tests/patternGuards.hs b/tests/patternGuards.hs new file mode 100644 --- /dev/null +++ b/tests/patternGuards.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Test where + +-- | As pattern matches + +import Language.Fay.FFI +import Language.Fay.Prelude + +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 $ showList $ (isPositive 1, isPositive 0) + print $ showList $ (threeConds 3, threeConds 1, threeConds 0) + print $ showList $ (withOtherwise 2, withOtherwise 0) + +showList :: Foreign a => [a] -> String +showList = ffi "JSON.stringify(%1)" diff --git a/tests/patternGuards.js b/tests/patternGuards.js new file mode 100644 --- /dev/null +++ b/tests/patternGuards.js @@ -0,0 +1,483 @@ +/** @constructor +*/ +var Test = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var isPositive = function($_a){return new $(function(){var x = $_a;return _(_(x) > 0) ? true : _(_(_(Fay$$lte)(x))(0)) ? false : (function(){ throw ("Non-exhaustive guards"); })();});};var threeConds = function($_a){return new $(function(){var x = $_a;return _(_(x) > 1) ? 2 : _(_(_(Fay$$eq)(x))(1)) ? 1 : _(_(x) < 1) ? 0 : (function(){ throw ("Non-exhaustive guards"); })();});};var withOtherwise = function($_a){return new $(function(){var x = $_a;return _(_(x) > 1) ? true : false;});};var nonExhaustive = function($_a){return new $(function(){var x = $_a;return _(_(x) > 1) ? true : (function(){ throw ("Non-exhaustive guards"); })();});};var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var main = new $(function(){return _(_($62$$62$)(_(_($36$)(print))(_(_($36$)(showList))(Fay$$list([_(isPositive)(1),_(isPositive)(0)])))))(_(_($62$$62$)(_(_($36$)(print))(_(_($36$)(showList))(Fay$$list([_(threeConds)(3),_(threeConds)(1),_(threeConds)(0)])))))(_(_($36$)(print))(_(_($36$)(showList))(Fay$$list([_(withOtherwise)(2),_(withOtherwise)(0)])))));});var showList = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["list",[["unknown"]]],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.max = max; +this.min = min; +this.mod = mod; +this.length = length; +this.$_const = $_const; +this.mapM_ = mapM_; +this.forM_ = forM_; +this.intercalate = intercalate; +this.prependToAll = prependToAll; +this.intersperse = intersperse; +this.lookup = lookup; +this.foldl = foldl; +this.foldr = foldr; +this.concat = concat; +this.conc = conc; +this.$36$ = $36$; +this.$43$$43$ = $43$$43$; +this.$46$ = $46$; +this.maybe = maybe; +this.flip = flip; +this.zip = zip; +this.zipWith = zipWith; +this.enumFromTo = enumFromTo; +this.enumFrom = enumFrom; +this.when = when; +this.insertBy = insertBy; +this.sortBy = sortBy; +this.compare = compare; +this.sort = sort; +this.elem = elem; +this.nub$39$ = nub$39$; +this.nub = nub; +this.map = map; +this.$_null = $_null; +this.not = not; +this.filter = filter; +this.any = any; +this.find = find; +this.fst = fst; +this.snd = snd; +this.fromRational = fromRational; +this.fromInteger = fromInteger; +this.show = show; +this.showList = showList; +this.main = main; +this.print = print; +this.nonExhaustive = nonExhaustive; +this.withOtherwise = withOtherwise; +this.threeConds = threeConds; +this.isPositive = isPositive; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Test(); +main._(main.main); + diff --git a/tests/patternMatchFail.hs b/tests/patternMatchFail.hs new file mode 100644 --- /dev/null +++ b/tests/patternMatchFail.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = print ((\a 'a' -> "OK.") 0 'b') + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/patternMatchFail.js b/tests/patternMatchFail.js new file mode 100644 --- /dev/null +++ b/tests/patternMatchFail.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)(_(_(function($_a){var a = $_a;return function($_b){if (_($_b) === "a") {return Fay$$list("OK.");}throw ["unhandled case",$_b];};throw ["unhandled case",$_a];})(0))("b"));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/recordFunctionPatternMatch b/tests/recordFunctionPatternMatch new file mode 100644 --- /dev/null +++ b/tests/recordFunctionPatternMatch @@ -0,0 +1,1 @@ +Hello! diff --git a/tests/recordFunctionPatternMatch.hs b/tests/recordFunctionPatternMatch.hs new file mode 100644 --- /dev/null +++ b/tests/recordFunctionPatternMatch.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +data Person = Person String String Int + +main = print (foo (Person "Chris" "Done" 14)) + +foo (Person "Chris" "Done" 13) = "Foo!" +foo (Person "Chris" "Barf" 14) = "Bar!" +foo (Person "Chris" "Done" 14) = "Hello!" +foo _ = "World!" + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/recordFunctionPatternMatch.js b/tests/recordFunctionPatternMatch.js new file mode 100644 --- /dev/null +++ b/tests/recordFunctionPatternMatch.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var $_Person = function(slot1,slot2,slot3){this.slot1 = slot1;this.slot2 = slot2;this.slot3 = slot3;};var Person = function(slot1){return function(slot2){return function(slot3){return new $(function(){return new $_Person(slot1,slot2,slot3);});};};};var main = new $(function(){return _(print)(_(foo)(_(_(_(Person)(Fay$$list("Chris")))(Fay$$list("Done")))(14)));});var foo = function($_a){return new $(function(){if (_($_a) instanceof $_Person) {if (Fay$$equal(_($_a).slot1,Fay$$list("Chris"))) {if (Fay$$equal(_($_a).slot2,Fay$$list("Done"))) {if (_(_($_a).slot3) === 13) {return Fay$$list("Foo!");}}if (Fay$$equal(_($_a).slot2,Fay$$list("Barf"))) {if (_(_($_a).slot3) === 14) {return Fay$$list("Bar!");}}if (Fay$$equal(_($_a).slot2,Fay$$list("Done"))) {if (_(_($_a).slot3) === 14) {return Fay$$list("Hello!");}}}}return Fay$$list("World!");});};var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $_Person) {return {"instance": "Person","slot1": Fay$$fayToJs(["string"],_(_obj.slot1)),"slot2": Fay$$fayToJs(["string"],_(_obj.slot2)),"slot3": Fay$$fayToJs(["user","Int",[]],_(_obj.slot3))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "Person") {return new $_Person(Fay$$jsToFay(["string"],obj["slot1"]),Fay$$jsToFay(["string"],obj["slot2"]),Fay$$jsToFay(["user","Int",[]],obj["slot3"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/recordPatternMatch b/tests/recordPatternMatch new file mode 100644 --- /dev/null +++ b/tests/recordPatternMatch @@ -0,0 +1,1 @@ +World! diff --git a/tests/recordPatternMatch.hs b/tests/recordPatternMatch.hs new file mode 100644 --- /dev/null +++ b/tests/recordPatternMatch.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +data Person = Person String String Int + +main = print (case Person "Chris" "Done" 14 of + Person "Chris" "Done" 13 -> "Hello!" + _ -> "World!") + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/recordPatternMatch.js b/tests/recordPatternMatch.js new file mode 100644 --- /dev/null +++ b/tests/recordPatternMatch.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var $_Person = function(slot1,slot2,slot3){this.slot1 = slot1;this.slot2 = slot2;this.slot3 = slot3;};var Person = function(slot1){return function(slot2){return function(slot3){return new $(function(){return new $_Person(slot1,slot2,slot3);});};};};var main = new $(function(){return _(print)((function($tmp){if (_($tmp) instanceof $_Person) {if (Fay$$equal(_($tmp).slot1,Fay$$list("Chris"))) {if (Fay$$equal(_($tmp).slot2,Fay$$list("Done"))) {if (_(_($tmp).slot3) === 13) {return Fay$$list("Hello!");}}}}return Fay$$list("World!");})(_(_(_(Person)(Fay$$list("Chris")))(Fay$$list("Done")))(14)));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $_Person) {return {"instance": "Person","slot1": Fay$$fayToJs(["string"],_(_obj.slot1)),"slot2": Fay$$fayToJs(["string"],_(_obj.slot2)),"slot3": Fay$$fayToJs(["user","Int",[]],_(_obj.slot3))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "Person") {return new $_Person(Fay$$jsToFay(["string"],obj["slot1"]),Fay$$jsToFay(["string"],obj["slot2"]),Fay$$jsToFay(["user","Int",[]],obj["slot3"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/recordPatternMatch2 b/tests/recordPatternMatch2 new file mode 100644 --- /dev/null +++ b/tests/recordPatternMatch2 @@ -0,0 +1,1 @@ +Hello! diff --git a/tests/recordPatternMatch2.hs b/tests/recordPatternMatch2.hs new file mode 100644 --- /dev/null +++ b/tests/recordPatternMatch2.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +data Person = Person String String Int + +main = print (case Person "Chris" "Done" 14 of + Person "Chris" "Done" 13 -> "Foo!" + Person "Chris" "Barf" 14 -> "Bar!" + Person "Chris" "Done" 14 -> "Hello!" + _ -> "World!") + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/recordPatternMatch2.js b/tests/recordPatternMatch2.js new file mode 100644 --- /dev/null +++ b/tests/recordPatternMatch2.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var $_Person = function(slot1,slot2,slot3){this.slot1 = slot1;this.slot2 = slot2;this.slot3 = slot3;};var Person = function(slot1){return function(slot2){return function(slot3){return new $(function(){return new $_Person(slot1,slot2,slot3);});};};};var main = new $(function(){return _(print)((function($tmp){if (_($tmp) instanceof $_Person) {if (Fay$$equal(_($tmp).slot1,Fay$$list("Chris"))) {if (Fay$$equal(_($tmp).slot2,Fay$$list("Done"))) {if (_(_($tmp).slot3) === 13) {return Fay$$list("Foo!");}}if (Fay$$equal(_($tmp).slot2,Fay$$list("Barf"))) {if (_(_($tmp).slot3) === 14) {return Fay$$list("Bar!");}}if (Fay$$equal(_($tmp).slot2,Fay$$list("Done"))) {if (_(_($tmp).slot3) === 14) {return Fay$$list("Hello!");}}}}return Fay$$list("World!");})(_(_(_(Person)(Fay$$list("Chris")))(Fay$$list("Done")))(14)));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $_Person) {return {"instance": "Person","slot1": Fay$$fayToJs(["string"],_(_obj.slot1)),"slot2": Fay$$fayToJs(["string"],_(_obj.slot2)),"slot3": Fay$$fayToJs(["user","Int",[]],_(_obj.slot3))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "Person") {return new $_Person(Fay$$jsToFay(["string"],obj["slot1"]),Fay$$jsToFay(["string"],obj["slot2"]),Fay$$jsToFay(["user","Int",[]],obj["slot3"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/recordUseBeforeDefine b/tests/recordUseBeforeDefine new file mode 100644 --- /dev/null +++ b/tests/recordUseBeforeDefine @@ -0,0 +1,2 @@ +1 +1 diff --git a/tests/recordUseBeforeDefine.hs b/tests/recordUseBeforeDefine.hs new file mode 100644 --- /dev/null +++ b/tests/recordUseBeforeDefine.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +import Hierarchical.RecordDefined + +f :: R -> Integer +f (R i) = i + +main = do + print $ f (R 1) + print $ g (Callback 1) + +data R = R Integer + +print :: Double -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/recordUseBeforeDefine.js b/tests/recordUseBeforeDefine.js new file mode 100644 --- /dev/null +++ b/tests/recordUseBeforeDefine.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var $_Callback = function(slot1){this.slot1 = slot1;};var Callback = function(slot1){return new $(function(){return new $_Callback(slot1);});};var g = function($_a){return new $(function(){if (_($_a) instanceof $_Callback) {var a = _($_a).slot1;return a;}throw ["unhandled case in Ident \"g\"",[$_a]];});};var f = function($_a){return new $(function(){if (_($_a) instanceof $_R) {var i = _($_a).slot1;return i;}throw ["unhandled case in Ident \"f\"",[$_a]];});};var main = new $(function(){return _(_($62$$62$)(_(_($36$)(print))(_(f)(_(R)(1)))))(_(_($36$)(print))(_(g)(_(Callback)(1))));});var $_R = function(slot1){this.slot1 = slot1;};var R = function(slot1){return new $(function(){return new $_R(slot1);});};var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $_R) {return {"instance": "R","slot1": Fay$$fayToJs(["user","Integer",[]],_(_obj.slot1))};}if (_obj instanceof $_Callback) {return {"instance": "Callback","slot1": Fay$$fayToJs(["user","Integer",[]],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "R") {return new $_R(Fay$$jsToFay(["user","Integer",[]],obj["slot1"]));}if (obj["instance"] === "Callback") {return new $_Callback(Fay$$jsToFay(["user","Integer",[]],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/records b/tests/records new file mode 100644 --- /dev/null +++ b/tests/records @@ -0,0 +1,4 @@ +Hello! +Hello! +Hello! +Hello! diff --git a/tests/records.hs b/tests/records.hs new file mode 100644 --- /dev/null +++ b/tests/records.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +data Person1 = Person1 String String Int +data Person2 = Person2 { fname :: String, sname :: String, age :: Int } +data Person3 = Person3 { slot3 :: String, slot2 :: String, slot1 :: Int } + +p1 = Person1 "Chris" "Done" 13 +p2 = Person2 "Chris" "Done" 13 +p2a = Person2 { fname = "Chris", sname = "Done", age = 13 } +p3 = Person3 "Chris" "Done" 13 + +main = do + print (case p1 of Person1 "Chris" "Done" 13 -> "Hello!") + print (case p2 of Person2 "Chris" "Done" 13 -> "Hello!") + print (case p2a of Person2 "Chris" "Done" 13 -> "Hello!") + print (case p3 of Person3 "Chris" "Done" 13 -> "Hello!") + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/records.js b/tests/records.js new file mode 100644 --- /dev/null +++ b/tests/records.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var $_Person1 = function(slot1,slot2,slot3){this.slot1 = slot1;this.slot2 = slot2;this.slot3 = slot3;};var Person1 = function(slot1){return function(slot2){return function(slot3){return new $(function(){return new $_Person1(slot1,slot2,slot3);});};};};var $_Person2 = function(fname,sname,age){this.fname = fname;this.sname = sname;this.age = age;};var Person2 = function(fname){return function(sname){return function(age){return new $(function(){return new $_Person2(fname,sname,age);});};};};var fname = function(x){return new $(function(){return _(x).fname;});};var sname = function(x){return new $(function(){return _(x).sname;});};var age = function(x){return new $(function(){return _(x).age;});};var $_Person3 = function(slot3,slot2,slot1){this.slot3 = slot3;this.slot2 = slot2;this.slot1 = slot1;};var Person3 = function(slot3){return function(slot2){return function(slot1){return new $(function(){return new $_Person3(slot3,slot2,slot1);});};};};var slot3 = function(x){return new $(function(){return _(x).slot3;});};var slot2 = function(x){return new $(function(){return _(x).slot2;});};var slot1 = function(x){return new $(function(){return _(x).slot1;});};var p1 = new $(function(){return _(_(_(Person1)(Fay$$list("Chris")))(Fay$$list("Done")))(13);});var p2 = new $(function(){return _(_(_(Person2)(Fay$$list("Chris")))(Fay$$list("Done")))(13);});var p2a = new $(function(){var person2 = new $_Person2();person2.fname = Fay$$list("Chris");person2.sname = Fay$$list("Done");person2.age = 13;return person2;});var p3 = new $(function(){return _(_(_(Person3)(Fay$$list("Chris")))(Fay$$list("Done")))(13);});var main = new $(function(){return _(_($62$$62$)(_(print)((function($_p1){if (_($_p1) instanceof $_Person1) {if (Fay$$equal(_($_p1).slot1,Fay$$list("Chris"))) {if (Fay$$equal(_($_p1).slot2,Fay$$list("Done"))) {if (_(_($_p1).slot3) === 13) {return Fay$$list("Hello!");}}}}return (function(){ throw (["unhandled case",$_p1]); })();})(p1))))(_(_($62$$62$)(_(print)((function($_p2){if (_($_p2) instanceof $_Person2) {if (Fay$$equal(_($_p2).fname,Fay$$list("Chris"))) {if (Fay$$equal(_($_p2).sname,Fay$$list("Done"))) {if (_(_($_p2).age) === 13) {return Fay$$list("Hello!");}}}}return (function(){ throw (["unhandled case",$_p2]); })();})(p2))))(_(_($62$$62$)(_(print)((function($_p2a){if (_($_p2a) instanceof $_Person2) {if (Fay$$equal(_($_p2a).fname,Fay$$list("Chris"))) {if (Fay$$equal(_($_p2a).sname,Fay$$list("Done"))) {if (_(_($_p2a).age) === 13) {return Fay$$list("Hello!");}}}}return (function(){ throw (["unhandled case",$_p2a]); })();})(p2a))))(_(print)((function($_p3){if (_($_p3) instanceof $_Person3) {if (Fay$$equal(_($_p3).slot3,Fay$$list("Chris"))) {if (Fay$$equal(_($_p3).slot2,Fay$$list("Done"))) {if (_(_($_p3).slot1) === 13) {return Fay$$list("Hello!");}}}}return (function(){ throw (["unhandled case",$_p3]); })();})(p3)))));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $_Person3) {return {"instance": "Person3","slot3": Fay$$fayToJs(["string"],_(_obj.slot3)),"slot2": Fay$$fayToJs(["string"],_(_obj.slot2)),"slot1": Fay$$fayToJs(["user","Int",[]],_(_obj.slot1))};}if (_obj instanceof $_Person2) {return {"instance": "Person2","fname": Fay$$fayToJs(["string"],_(_obj.fname)),"sname": Fay$$fayToJs(["string"],_(_obj.sname)),"age": Fay$$fayToJs(["user","Int",[]],_(_obj.age))};}if (_obj instanceof $_Person1) {return {"instance": "Person1","slot1": Fay$$fayToJs(["string"],_(_obj.slot1)),"slot2": Fay$$fayToJs(["string"],_(_obj.slot2)),"slot3": Fay$$fayToJs(["user","Int",[]],_(_obj.slot3))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "Person3") {return new $_Person3(Fay$$jsToFay(["string"],obj["slot3"]),Fay$$jsToFay(["string"],obj["slot2"]),Fay$$jsToFay(["user","Int",[]],obj["slot1"]));}if (obj["instance"] === "Person2") {return new $_Person2(Fay$$jsToFay(["string"],obj["fname"]),Fay$$jsToFay(["string"],obj["sname"]),Fay$$jsToFay(["user","Int",[]],obj["age"]));}if (obj["instance"] === "Person1") {return new $_Person1(Fay$$jsToFay(["string"],obj["slot1"]),Fay$$jsToFay(["string"],obj["slot2"]),Fay$$jsToFay(["user","Int",[]],obj["slot3"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/reservedWords b/tests/reservedWords new file mode 100644 --- /dev/null +++ b/tests/reservedWords @@ -0,0 +1,37 @@ +break +catch +const +continue +debugger +delete +enum +export +extends +finally +for +function +implements +instanceof +interface +new +null +package +private +protected +public +return +static +super +switch +this +throw +try +typeof +undefined +var +void +while +with +yield + +stdconst diff --git a/tests/reservedWords.hs b/tests/reservedWords.hs new file mode 100644 --- /dev/null +++ b/tests/reservedWords.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE NoImplicitPrelude #-} + +import Language.Fay.FFI +import Language.Fay.Prelude + +main = do + -- All reserved words + let break = "break" in printS break + let catch = "catch" in printS catch + let const = "const" in printS const + let continue = "continue" in printS continue + let debugger = "debugger" in printS debugger + let delete = "delete" in printS delete + let enum = "enum" in printS enum + let export = "export" in printS export + let extends = "extends" in printS extends + let finally = "finally" in printS finally + let for = "for" in printS for + let function = "function" in printS function + let implements = "implements" in printS implements + let instanceof = "instanceof" in printS instanceof + let interface = "interface" in printS interface + let new = "new" in printS new + let null = "null" in printS null + let package = "package" in printS package + let private = "private" in printS private + let protected = "protected" in printS protected + let public = "public" in printS public + let return = "return" in printS return + let static = "static" in printS static + let super = "super" in printS super + let switch = "switch" in printS switch + let this = "this" in printS this + let throw = "throw" in printS throw + let try = "try" in printS try + let typeof = "typeof" in printS typeof + let undefined = "undefined" in printS undefined + let var = "var" in printS var + let void = "void" in printS void + let while = "while" in printS while + let with = "with" in printS with + let yield = "yield" in printS yield + + printS "" + -- Stdlib functions that need to be encoded + printS $ const "stdconst" 2 +printS :: String -> Fay () +printS = ffi "console.log(%1)" diff --git a/tests/reservedWords.js b/tests/reservedWords.js new file mode 100644 --- /dev/null +++ b/tests/reservedWords.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(_($62$$62$)((function(){var $_break = new $(function(){return Fay$$list("break");});return _(printS)($_break);})()))(_(_($62$$62$)((function(){var $_catch = new $(function(){return Fay$$list("catch");});return _(printS)($_catch);})()))(_(_($62$$62$)((function(){var $_const = new $(function(){return Fay$$list("const");});return _(printS)($_const);})()))(_(_($62$$62$)((function(){var $_continue = new $(function(){return Fay$$list("continue");});return _(printS)($_continue);})()))(_(_($62$$62$)((function(){var $_debugger = new $(function(){return Fay$$list("debugger");});return _(printS)($_debugger);})()))(_(_($62$$62$)((function(){var $_delete = new $(function(){return Fay$$list("delete");});return _(printS)($_delete);})()))(_(_($62$$62$)((function(){var $_enum = new $(function(){return Fay$$list("enum");});return _(printS)($_enum);})()))(_(_($62$$62$)((function(){var $_export = new $(function(){return Fay$$list("export");});return _(printS)($_export);})()))(_(_($62$$62$)((function(){var $_extends = new $(function(){return Fay$$list("extends");});return _(printS)($_extends);})()))(_(_($62$$62$)((function(){var $_finally = new $(function(){return Fay$$list("finally");});return _(printS)($_finally);})()))(_(_($62$$62$)((function(){var $_for = new $(function(){return Fay$$list("for");});return _(printS)($_for);})()))(_(_($62$$62$)((function(){var $_function = new $(function(){return Fay$$list("function");});return _(printS)($_function);})()))(_(_($62$$62$)((function(){var $_implements = new $(function(){return Fay$$list("implements");});return _(printS)($_implements);})()))(_(_($62$$62$)((function(){var $_instanceof = new $(function(){return Fay$$list("instanceof");});return _(printS)($_instanceof);})()))(_(_($62$$62$)((function(){var $_interface = new $(function(){return Fay$$list("interface");});return _(printS)($_interface);})()))(_(_($62$$62$)((function(){var $_new = new $(function(){return Fay$$list("new");});return _(printS)($_new);})()))(_(_($62$$62$)((function(){var $_null = new $(function(){return Fay$$list("null");});return _(printS)($_null);})()))(_(_($62$$62$)((function(){var $_package = new $(function(){return Fay$$list("package");});return _(printS)($_package);})()))(_(_($62$$62$)((function(){var $_private = new $(function(){return Fay$$list("private");});return _(printS)($_private);})()))(_(_($62$$62$)((function(){var $_protected = new $(function(){return Fay$$list("protected");});return _(printS)($_protected);})()))(_(_($62$$62$)((function(){var $_public = new $(function(){return Fay$$list("public");});return _(printS)($_public);})()))(_(_($62$$62$)((function(){var $_return = new $(function(){return Fay$$list("return");});return _(printS)($_return);})()))(_(_($62$$62$)((function(){var $_static = new $(function(){return Fay$$list("static");});return _(printS)($_static);})()))(_(_($62$$62$)((function(){var $_super = new $(function(){return Fay$$list("super");});return _(printS)($_super);})()))(_(_($62$$62$)((function(){var $_switch = new $(function(){return Fay$$list("switch");});return _(printS)($_switch);})()))(_(_($62$$62$)((function(){var $_this = new $(function(){return Fay$$list("this");});return _(printS)($_this);})()))(_(_($62$$62$)((function(){var $_throw = new $(function(){return Fay$$list("throw");});return _(printS)($_throw);})()))(_(_($62$$62$)((function(){var $_try = new $(function(){return Fay$$list("try");});return _(printS)($_try);})()))(_(_($62$$62$)((function(){var $_typeof = new $(function(){return Fay$$list("typeof");});return _(printS)($_typeof);})()))(_(_($62$$62$)((function(){var $_undefined = new $(function(){return Fay$$list("undefined");});return _(printS)($_undefined);})()))(_(_($62$$62$)((function(){var $_var = new $(function(){return Fay$$list("var");});return _(printS)($_var);})()))(_(_($62$$62$)((function(){var $_void = new $(function(){return Fay$$list("void");});return _(printS)($_void);})()))(_(_($62$$62$)((function(){var $_while = new $(function(){return Fay$$list("while");});return _(printS)($_while);})()))(_(_($62$$62$)((function(){var $_with = new $(function(){return Fay$$list("with");});return _(printS)($_with);})()))(_(_($62$$62$)((function(){var $_yield = new $(function(){return Fay$$list("yield");});return _(printS)($_yield);})()))(_(_($62$$62$)(_(printS)(Fay$$list(""))))(_(_($36$)(printS))(_(_($_const)(Fay$$list("stdconst")))(2))))))))))))))))))))))))))))))))))))));});var printS = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/tailRecursion b/tests/tailRecursion new file mode 100644 --- /dev/null +++ b/tests/tailRecursion @@ -0,0 +1,1 @@ +5000050000 diff --git a/tests/tailRecursion.hs b/tests/tailRecursion.hs new file mode 100644 --- /dev/null +++ b/tests/tailRecursion.hs @@ -0,0 +1,20 @@ +-- | This is to test tail-recursive calls are iterative. + +{-# LANGUAGE NoImplicitPrelude #-} + +module Fib where + +import Language.Fay.FFI +import Language.Fay.Prelude + +main = do + print (sum 100000 0 :: Double) + +sum 0 acc = acc +sum n acc = sum (n - 1) (acc + n) + +getSeconds :: Fay Double +getSeconds = foreignFay "new Date" + +print :: Double -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/tailRecursion.js b/tests/tailRecursion.js new file mode 100644 --- /dev/null +++ b/tests/tailRecursion.js @@ -0,0 +1,480 @@ +/** @constructor +*/ +var Fib = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(print)(_(_(sum)(100000))(0));});var sum = function($_a){return function($_b){return new $(function(){var acc = $_b;if (_($_a) === 0) {return acc;}var acc = $_b;var n = $_a;return _(_(sum)(_(n) - 1))(_(acc) + _(n));});};};var getSeconds = new $(function(){return _(foreignFay)(Fay$$list("new Date"));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.max = max; +this.min = min; +this.mod = mod; +this.length = length; +this.$_const = $_const; +this.mapM_ = mapM_; +this.forM_ = forM_; +this.intercalate = intercalate; +this.prependToAll = prependToAll; +this.intersperse = intersperse; +this.lookup = lookup; +this.foldl = foldl; +this.foldr = foldr; +this.concat = concat; +this.conc = conc; +this.$36$ = $36$; +this.$43$$43$ = $43$$43$; +this.$46$ = $46$; +this.maybe = maybe; +this.flip = flip; +this.zip = zip; +this.zipWith = zipWith; +this.enumFromTo = enumFromTo; +this.enumFrom = enumFrom; +this.when = when; +this.insertBy = insertBy; +this.sortBy = sortBy; +this.compare = compare; +this.sort = sort; +this.elem = elem; +this.nub$39$ = nub$39$; +this.nub = nub; +this.map = map; +this.$_null = $_null; +this.not = not; +this.filter = filter; +this.any = any; +this.find = find; +this.fst = fst; +this.snd = snd; +this.fromRational = fromRational; +this.fromInteger = fromInteger; +this.show = show; +this.print = print; +this.getSeconds = getSeconds; +this.sum = sum; +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Fib(); +main._(main.main); + diff --git a/tests/then b/tests/then new file mode 100644 --- /dev/null +++ b/tests/then @@ -0,0 +1,2 @@ +Hello, +World! diff --git a/tests/then.hs b/tests/then.hs new file mode 100644 --- /dev/null +++ b/tests/then.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = print "Hello," >> print "World!" + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/then.js b/tests/then.js new file mode 100644 --- /dev/null +++ b/tests/then.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(_($62$$62$)(_(print)(Fay$$list("Hello,"))))(_(print)(Fay$$list("World!")));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/utf8 b/tests/utf8 new file mode 100644 --- /dev/null +++ b/tests/utf8 @@ -0,0 +1,63 @@ +¡ ¢ £ ¤ ¥ ¦ § ¨ © ª « ¬ ­ ® ¯ ° ± ² ³ ´ µ ¶ · ¸ ¹ º » ¼ ½ ¾ ¿ À Á Â Ã Ä Å Æ Ç È É Ê Ë Ì Í Î Ï Ð Ñ Ò Ó Ô Õ Ö × Ø Ù Ú Û Ü Ý Þ ß à á â ã ä å æ ç è é ê ë ì í î ï ð ñ ò ó ô õ ö ÷ ø ù ú û ü ý þ ÿ +Ā ā Ă ă Ą ą Ć ć Ĉ ĉ Ċ ċ Č č Ď ď Đ đ Ē ē Ĕ ĕ Ė ė Ę ę Ě ě Ĝ ĝ Ğ ğ Ġ ġ Ģ ģ Ĥ ĥ Ħ ħ Ĩ ĩ Ī ī Ĭ ĭ Į į İ ı IJ ij Ĵ ĵ Ķ ķ ĸ Ĺ ĺ Ļ ļ Ľ ľ Ŀ ŀ Ł ł Ń ń Ņ ņ Ň ň ʼn Ŋ ŋ Ō ō Ŏ ŏ Ő ő Œ œ Ŕ ŕ Ŗ ŗ Ř ř Ś ś Ŝ ŝ Ş ş Š š Ţ ţ Ť ť Ŧ ŧ Ũ ũ Ū ū Ŭ ŭ Ů ů Ű ű Ų ų Ŵ ŵ Ŷ ŷ Ÿ Ź ź Ż ż Ž ž ſ +ƀ Ɓ Ƃ ƃ Ƅ ƅ Ɔ Ƈ ƈ Ɖ Ɗ Ƌ ƌ ƍ Ǝ Ə Ɛ Ƒ ƒ Ɠ Ɣ ƕ Ɩ Ɨ Ƙ ƙ ƚ ƛ Ɯ Ɲ ƞ Ɵ Ơ ơ Ƣ ƣ Ƥ ƥ Ʀ Ƨ ƨ Ʃ ƪ ƫ Ƭ ƭ Ʈ Ư ư Ʊ Ʋ Ƴ ƴ Ƶ ƶ Ʒ Ƹ ƹ ƺ ƻ Ƽ ƽ ƾ ƿ ǀ ǁ ǂ ǃ DŽ Dž dž LJ Lj lj NJ Nj nj Ǎ ǎ Ǐ ǐ Ǒ ǒ Ǔ ǔ Ǖ ǖ Ǘ ǘ Ǚ ǚ Ǜ ǜ ǝ Ǟ ǟ Ǡ ǡ Ǣ ǣ Ǥ ǥ Ǧ ǧ Ǩ ǩ Ǫ ǫ Ǭ ǭ Ǯ ǯ ǰ DZ Dz dz Ǵ ǵ Ǻ ǻ Ǽ ǽ Ǿ ǿ Ȁ ȁ Ȃ ȃ ... +ɐ ɑ ɒ ɓ ɔ ɕ ɖ ɗ ɘ ə ɚ ɛ ɜ ɝ ɞ ɟ ɠ ɡ ɢ ɣ ɤ ɥ ɦ ɧ ɨ ɩ ɪ ɫ ɬ ɭ ɮ ɯ ɰ ɱ ɲ ɳ ɴ ɵ ɶ ɷ ɸ ɹ ɺ ɻ ɼ ɽ ɾ ɿ ʀ ʁ ʂ ʃ ʄ ʅ ʆ ʇ ʈ ʉ ʊ ʋ ʌ ʍ ʎ ʏ ʐ ʑ ʒ ʓ ʔ ʕ ʖ ʗ ʘ ʙ ʚ ʛ ʜ ʝ ʞ ʟ ʠ ʡ ʢ ʣ ʤ ʥ ʦ ʧ ʨ +ʰ ʱ ʲ ʳ ʴ ʵ ʶ ʷ ʸ ʹ ʺ ʻ ʼ ʽ ʾ ʿ ˀ ˁ ˂ ˃ ˄ ˅ ˆ ˇ ˈ ˉ ˊ ˋ ˌ ˍ ˎ ˏ ː ˑ ˒ ˓ ˔ ˕ ˖ ˗ ˘ ˙ ˚ ˛ ˜ ˝ ˞ ˠ ˡ ˢ ˣ ˤ ˥ ˦ ˧ ˨ ˩ +̀ ́ ̂ ̃ ̄ ̅ ̆ ̇ ̈ ̉ ̊ ̋ ̌ ̍ ̎ ̏ ̐ ̑ ̒ ̓ ̔ ̕ ̖ ̗ ̘ ̙ ̚ ̛ ̜ ̝ ̞ ̟ ̠ ̡ ̢ ̣ ̤ ̥ ̦ ̧ ̨ ̩ ̪ ̫ ̬ ̭ ̮ ̯ ̰ ̱ ̲ ̳ ̴ ̵ ̶ ̷ ̸ ̹ ̺ ̻ ̼ ̽ ̾ ̿ ̀ ́ ͂ ̓ ̈́ ͅ ͠ ͡ +ʹ ͵ ͺ ; ΄ ΅ Ά · Έ Ή Ί Ό Ύ Ώ ΐ Α Β Γ Δ Ε Ζ Η Θ Ι Κ Λ Μ Ν Ξ Ο Π Ρ Σ Τ Υ Φ Χ Ψ Ω Ϊ Ϋ ά έ ή ί ΰ α β γ δ ε ζ η θ ι κ λ μ ν ξ ο π ρ ς σ τ υ φ χ ψ ω ϊ ϋ ό ύ ώ ϐ ϑ ϒ ϓ ϔ ϕ ϖ Ϛ Ϝ Ϟ Ϡ Ϣ ϣ Ϥ ϥ Ϧ ϧ Ϩ ϩ Ϫ ϫ Ϭ ϭ Ϯ ϯ ϰ ϱ ϲ ϳ +Ё Ђ Ѓ Є Ѕ І Ї Ј Љ Њ Ћ Ќ Ў Џ А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ъ Ы Ь Э Ю Я а б в г д е ж з и й к л м н о п р с т у ф х ц ч ш щ ъ ы ь э ю я ё ђ ѓ є ѕ і ї ј љ њ ћ ќ ў џ Ѡ ѡ Ѣ ѣ Ѥ ѥ Ѧ ѧ Ѩ ѩ Ѫ ѫ Ѭ ѭ Ѯ ѯ Ѱ ѱ Ѳ ѳ Ѵ ѵ Ѷ ѷ Ѹ ѹ Ѻ ѻ Ѽ ѽ Ѿ ѿ Ҁ ҁ ҂ ҃ ... +Ա Բ Գ Դ Ե Զ Է Ը Թ Ժ Ի Լ Խ Ծ Կ Հ Ձ Ղ Ճ Մ Յ Ն Շ Ո Չ Պ Ջ Ռ Ս Վ Տ Ր Ց Ւ Փ Ք Օ Ֆ ՙ ՚ ՛ ՜ ՝ ՞ ՟ ա բ գ դ ե զ է ը թ ժ ի լ խ ծ կ հ ձ ղ ճ մ յ ն շ ո չ պ ջ ռ ս վ տ ր ց ւ փ ք օ ֆ և ։ +֑ ֒ ֓ ֔ ֕ ֖ ֗ ֘ ֙ ֚ ֛ ֜ ֝ ֞ ֟ ֠ ֡ ֣ ֤ ֥ ֦ ֧ ֨ ֩ ֪ ֫ ֬ ֭ ֮ ֯ ְ ֱ ֲ ֳ ִ ֵ ֶ ַ ָ ֹ ֻ ּ ֽ ־ ֿ ׀ ׁ ׂ ׃ ׄ א ב ג ד ה ו ז ח ט י ך כ ל ם מ ן נ ס ע ף פ ץ צ ק ר ש ת װ ױ ײ ׳ ״ +، ؛ ؟ ء آ أ ؤ إ ئ ا ب ة ت ث ج ح خ د ذ ر ز س ش ص ض ط ظ ع غ ـ ف ق ك ل م ن ه و ى ي ً ٌ ٍ َ ُ ِ ّ ْ ٠ ١ ٢ ٣ ٤ ٥ ٦ ٧ ٨ ٩ ٪ ٫ ٬ ٭ ٰ ٱ ٲ ٳ ٴ ٵ ٶ ٷ ٸ ٹ ٺ ٻ ټ ٽ پ ٿ ڀ ځ ڂ ڃ ڄ څ چ ڇ ڈ ډ ڊ ڋ ڌ ڍ ڎ ڏ ڐ ڑ ڒ ړ ڔ ڕ ږ ڗ ژ ڙ ښ ڛ ڜ ڝ ڞ ڟ ڠ ڡ ڢ ڣ ڤ ڥ ڦ ڧ ڨ ک ڪ ګ ڬ ڭ ڮ گ ڰ ڱ ... +ँ ं ः अ आ इ ई उ ऊ ऋ ऌ ऍ ऎ ए ऐ ऑ ऒ ओ औ क ख ग घ ङ च छ ज झ ञ ट ठ ड ढ ण त थ द ध न ऩ प फ ब भ म य र ऱ ल ळ ऴ व श ष स ह ़ ऽ ा ि ी ु ू ृ ॄ ॅ ॆ े ै ॉ ॊ ो ौ ् ॐ ॑ ॒ ॓ ॔ क़ ख़ ग़ ज़ ड़ ढ़ फ़ य़ ॠ ॡ ॢ ॣ । ॥ ० १ २ ३ ४ ५ ६ ७ ८ ९ ॰ +ঁ ং ঃ অ আ ই ঈ উ ঊ ঋ ঌ এ ঐ ও ঔ ক খ গ ঘ ঙ চ ছ জ ঝ ঞ ট ঠ ড ঢ ণ ত থ দ ধ ন প ফ ব ভ ম য র ল শ ষ স হ ় া ি ী ু ূ ৃ ৄ ে ৈ ো ৌ ্ ৗ ড় ঢ় য় ৠ ৡ ৢ ৣ ০ ১ ২ ৩ ৪ ৫ ৬ ৭ ৮ ৯ ৰ ৱ ৲ ৳ ৴ ৵ ৶ ৷ ৸ ৹ ৺ +ਂ ਅ ਆ ਇ ਈ ਉ ਊ ਏ ਐ ਓ ਔ ਕ ਖ ਗ ਘ ਙ ਚ ਛ ਜ ਝ ਞ ਟ ਠ ਡ ਢ ਣ ਤ ਥ ਦ ਧ ਨ ਪ ਫ ਬ ਭ ਮ ਯ ਰ ਲ ਲ਼ ਵ ਸ਼ ਸ ਹ ਼ ਾ ਿ ੀ ੁ ੂ ੇ ੈ ੋ ੌ ੍ ਖ਼ ਗ਼ ਜ਼ ੜ ਫ਼ ੦ ੧ ੨ ੩ ੪ ੫ ੬ ੭ ੮ ੯ ੰ ੱ ੲ ੳ ੴ +ઁ ં ઃ અ આ ઇ ઈ ઉ ઊ ઋ ઍ એ ઐ ઑ ઓ ઔ ક ખ ગ ઘ ઙ ચ છ જ ઝ ઞ ટ ઠ ડ ઢ ણ ત થ દ ધ ન પ ફ બ ભ મ ય ર લ ળ વ શ ષ સ હ ઼ ઽ ા િ ી ુ ૂ ૃ ૄ ૅ ે ૈ ૉ ો ૌ ્ ૐ ૠ ૦ ૧ ૨ ૩ ૪ ૫ ૬ ૭ ૮ ૯ +ଁ ଂ ଃ ଅ ଆ ଇ ଈ ଉ ଊ ଋ ଌ ଏ ଐ ଓ ଔ କ ଖ ଗ ଘ ଙ ଚ ଛ ଜ ଝ ଞ ଟ ଠ ଡ ଢ ଣ ତ ଥ ଦ ଧ ନ ପ ଫ ବ ଭ ମ ଯ ର ଲ ଳ ଶ ଷ ସ ହ ଼ ଽ ା ି ୀ ୁ ୂ ୃ େ ୈ ୋ ୌ ୍ ୖ ୗ ଡ଼ ଢ଼ ୟ ୠ ୡ ୦ ୧ ୨ ୩ ୪ ୫ ୬ ୭ ୮ ୯ ୰ +ஂ ஃ அ ஆ இ ஈ உ ஊ எ ஏ ஐ ஒ ஓ ஔ க ங ச ஜ ஞ ட ண த ந ன ப ம ய ர ற ல ள ழ வ ஷ ஸ ஹ ா ி ீ ு ூ ெ ே ை ொ ோ ௌ ் ௗ ௧ ௨ ௩ ௪ ௫ ௬ ௭ ௮ ௯ ௰ ௱ ௲ +ఁ ం ః అ ఆ ఇ ఈ ఉ ఊ ఋ ఌ ఎ ఏ ఐ ఒ ఓ ఔ క ఖ గ ఘ ఙ చ ఛ జ ఝ ఞ ట ఠ డ ఢ ణ త థ ద ధ న ప ఫ బ భ మ య ర ఱ ల ళ వ శ ష స హ ా ి ీ ు ూ ృ ౄ ె ే ై ొ ో ౌ ్ ౕ ౖ ౠ ౡ ౦ ౧ ౨ ౩ ౪ ౫ ౬ ౭ ౮ ౯ +ಂ ಃ ಅ ಆ ಇ ಈ ಉ ಊ ಋ ಌ ಎ ಏ ಐ ಒ ಓ ಔ ಕ ಖ ಗ ಘ ಙ ಚ ಛ ಜ ಝ ಞ ಟ ಠ ಡ ಢ ಣ ತ ಥ ದ ಧ ನ ಪ ಫ ಬ ಭ ಮ ಯ ರ ಱ ಲ ಳ ವ ಶ ಷ ಸ ಹ ಾ ಿ ೀ ು ೂ ೃ ೄ ೆ ೇ ೈ ೊ ೋ ೌ ್ ೕ ೖ ೞ ೠ ೡ ೦ ೧ ೨ ೩ ೪ ೫ ೬ ೭ ೮ ೯ +ം ഃ അ ആ ഇ ഈ ഉ ഊ ഋ ഌ എ ഏ ഐ ഒ ഓ ഔ ക ഖ ഗ ഘ ങ ച ഛ ജ ഝ ഞ ട ഠ ഡ ഢ ണ ത ഥ ദ ധ ന പ ഫ ബ ഭ മ യ ര റ ല ള ഴ വ ശ ഷ സ ഹ ാ ി ീ ു ൂ ൃ െ േ ൈ ൊ ോ ൌ ് ൗ ൠ ൡ ൦ ൧ ൨ ൩ ൪ ൫ ൬ ൭ ൮ ൯ +ก ข ฃ ค ฅ ฆ ง จ ฉ ช ซ ฌ ญ ฎ ฏ ฐ ฑ ฒ ณ ด ต ถ ท ธ น บ ป ผ ฝ พ ฟ ภ ม ย ร ฤ ล ฦ ว ศ ษ ส ห ฬ อ ฮ ฯ ะ ั า ำ ิ ี ึ ื ุ ู ฺ ฿ เ แ โ ใ ไ ๅ ๆ ็ ่ ้ ๊ ๋ ์ ํ ๎ ๏ ๐ ๑ ๒ ๓ ๔ ๕ ๖ ๗ ๘ ๙ ๚ ๛ +ກ ຂ ຄ ງ ຈ ຊ ຍ ດ ຕ ຖ ທ ນ ບ ປ ຜ ຝ ພ ຟ ມ ຢ ຣ ລ ວ ສ ຫ ອ ຮ ຯ ະ ັ າ ຳ ິ ີ ຶ ື ຸ ູ ົ ຼ ຽ ເ ແ ໂ ໃ ໄ ໆ ່ ້ ໊ ໋ ໌ ໍ ໐ ໑ ໒ ໓ ໔ ໕ ໖ ໗ ໘ ໙ ໜ ໝ +ༀ ༁ ༂ ༃ ༄ ༅ ༆ ༇ ༈ ༉ ༊ ་ ༌ ། ༎ ༏ ༐ ༑ ༒ ༓ ༔ ༕ ༖ ༗ ༘ ༙ ༚ ༛ ༜ ༝ ༞ ༟ ༠ ༡ ༢ ༣ ༤ ༥ ༦ ༧ ༨ ༩ ༪ ༫ ༬ ༭ ༮ ༯ ༰ ༱ ༲ ༳ ༴ ༵ ༶ ༷ ༸ ༹ ༺ ༻ ༼ ༽ ༾ ༿ ཀ ཁ ག གྷ ང ཅ ཆ ཇ ཉ ཊ ཋ ཌ ཌྷ ཎ ཏ ཐ ད དྷ ན པ ཕ བ བྷ མ ཙ ཚ ཛ ཛྷ ཝ ཞ ཟ འ ཡ ར ལ ཤ ཥ ས ཧ ཨ ཀྵ ཱ ི ཱི ུ ཱུ ྲྀ ཷ ླྀ ཹ ེ ཻ ོ ཽ ཾ ཿ ྀ ཱྀ ྂ ྃ ྄ ྅ ྆ ྇ ... +Ⴀ Ⴁ Ⴂ Ⴃ Ⴄ Ⴅ Ⴆ Ⴇ Ⴈ Ⴉ Ⴊ Ⴋ Ⴌ Ⴍ Ⴎ Ⴏ Ⴐ Ⴑ Ⴒ Ⴓ Ⴔ Ⴕ Ⴖ Ⴗ Ⴘ Ⴙ Ⴚ Ⴛ Ⴜ Ⴝ Ⴞ Ⴟ Ⴠ Ⴡ Ⴢ Ⴣ Ⴤ Ⴥ ა ბ გ დ ე ვ ზ თ ი კ ლ მ ნ ო პ ჟ რ ს ტ უ ფ ქ ღ ყ შ ჩ ც ძ წ ჭ ხ ჯ ჰ ჱ ჲ ჳ ჴ ჵ ჶ ჻ +ᄀ ᄁ ᄂ ᄃ ᄄ ᄅ ᄆ ᄇ ᄈ ᄉ ᄊ ᄋ ᄌ ᄍ ᄎ ᄏ ᄐ ᄑ ᄒ ᄓ ᄔ ᄕ ᄖ ᄗ ᄘ ᄙ ᄚ ᄛ ᄜ ᄝ ᄞ ᄟ ᄠ ᄡ ᄢ ᄣ ᄤ ᄥ ᄦ ᄧ ᄨ ᄩ ᄪ ᄫ ᄬ ᄭ ᄮ ᄯ ᄰ ᄱ ᄲ ᄳ ᄴ ᄵ ᄶ ᄷ ᄸ ᄹ ᄺ ᄻ ᄼ ᄽ ᄾ ᄿ ᅀ ᅁ ᅂ ᅃ ᅄ ᅅ ᅆ ᅇ ᅈ ᅉ ᅊ ᅋ ᅌ ᅍ ᅎ ᅏ ᅐ ᅑ ᅒ ᅓ ᅔ ᅕ ᅖ ᅗ ᅘ ᅙ ᅟ ᅠ ᅡ ᅢ ᅣ ᅤ ᅥ ᅦ ᅧ ᅨ ᅩ ᅪ ᅫ ᅬ ᅭ ᅮ ᅯ ᅰ ᅱ ᅲ ᅳ ᅴ ᅵ ᅶ ᅷ ᅸ ᅹ ᅺ ᅻ ᅼ ᅽ ᅾ ᅿ ᆀ ᆁ ᆂ ᆃ ᆄ ... +Ḁ ḁ Ḃ ḃ Ḅ ḅ Ḇ ḇ Ḉ ḉ Ḋ ḋ Ḍ ḍ Ḏ ḏ Ḑ ḑ Ḓ ḓ Ḕ ḕ Ḗ ḗ Ḙ ḙ Ḛ ḛ Ḝ ḝ Ḟ ḟ Ḡ ḡ Ḣ ḣ Ḥ ḥ Ḧ ḧ Ḩ ḩ Ḫ ḫ Ḭ ḭ Ḯ ḯ Ḱ ḱ Ḳ ḳ Ḵ ḵ Ḷ ḷ Ḹ ḹ Ḻ ḻ Ḽ ḽ Ḿ ḿ Ṁ ṁ Ṃ ṃ Ṅ ṅ Ṇ ṇ Ṉ ṉ Ṋ ṋ Ṍ ṍ Ṏ ṏ Ṑ ṑ Ṓ ṓ Ṕ ṕ Ṗ ṗ Ṙ ṙ Ṛ ṛ Ṝ ṝ Ṟ ṟ Ṡ ṡ Ṣ ṣ Ṥ ṥ Ṧ ṧ Ṩ ṩ Ṫ ṫ Ṭ ṭ Ṯ ṯ Ṱ ṱ Ṳ ṳ Ṵ ṵ Ṷ ṷ Ṹ ṹ Ṻ ṻ Ṽ ṽ Ṿ ṿ ... +ἀ ἁ ἂ ἃ ἄ ἅ ἆ ἇ Ἀ Ἁ Ἂ Ἃ Ἄ Ἅ Ἆ Ἇ ἐ ἑ ἒ ἓ ἔ ἕ Ἐ Ἑ Ἒ Ἓ Ἔ Ἕ ἠ ἡ ἢ ἣ ἤ ἥ ἦ ἧ Ἠ Ἡ Ἢ Ἣ Ἤ Ἥ Ἦ Ἧ ἰ ἱ ἲ ἳ ἴ ἵ ἶ ἷ Ἰ Ἱ Ἲ Ἳ Ἴ Ἵ Ἶ Ἷ ὀ ὁ ὂ ὃ ὄ ὅ Ὀ Ὁ Ὂ Ὃ Ὄ Ὅ ὐ ὑ ὒ ὓ ὔ ὕ ὖ ὗ Ὑ Ὓ Ὕ Ὗ ὠ ὡ ὢ ὣ ὤ ὥ ὦ ὧ Ὠ Ὡ Ὢ Ὣ Ὤ Ὥ Ὦ Ὧ ὰ ά ὲ έ ὴ ή ὶ ί ὸ ό ὺ ύ ὼ ώ ᾀ ᾁ ᾂ ᾃ ᾄ ᾅ ᾆ ᾇ ᾈ ᾉ ᾊ ᾋ ᾌ ᾍ ... +‐ ‑ ‒ – — ― ‖ ‗ ‘ ’ ‚ ‛ “ ” „ ‟ +⁰ ⁴ ⁵ ⁶ ⁷ ⁸ ⁹ ⁺ ⁻ ⁼ ⁽ ⁾ ⁿ ₀ ₁ ₂ ₃ ₄ ₅ ₆ ₇ ₈ ₉ ₊ ₋ ₌ ₍ ₎ +₠ ₡ ₢ ₣ ₤ ₥ ₦ ₧ ₨ ₩ ₪ ₫ +⃐ ⃑ ⃒ ⃓ ⃔ ⃕ ⃖ ⃗ ⃘ ⃙ ⃚ ⃛ ⃜ ⃝ ⃞ ⃟ ⃠ ⃡ +℀ ℁ ℂ ℃ ℄ ℅ ℆ ℇ ℈ ℉ ℊ ℋ ℌ ℍ ℎ ℏ ℐ ℑ ℒ ℓ ℔ ℕ № ℗ ℘ ℙ ℚ ℛ ℜ ℝ ℞ ℟ ℠ ℡ ™ ℣ ℤ ℥ Ω ℧ ℨ ℩ K Å ℬ ℭ ℮ ℯ ℰ ℱ Ⅎ ℳ ℴ ℵ ℶ ℷ ℸ +⅓ ⅔ ⅕ ⅖ ⅗ ⅘ ⅙ ⅚ ⅛ ⅜ ⅝ ⅞ ⅟ Ⅰ Ⅱ Ⅲ Ⅳ Ⅴ Ⅵ Ⅶ Ⅷ Ⅸ Ⅹ Ⅺ Ⅻ Ⅼ Ⅽ Ⅾ Ⅿ ⅰ ⅱ ⅲ ⅳ ⅴ ⅵ ⅶ ⅷ ⅸ ⅹ ⅺ ⅻ ⅼ ⅽ ⅾ ⅿ ↀ ↁ ↂ +← ↑ → ↓ ↔ ↕ ↖ ↗ ↘ ↙ ↚ ↛ ↜ ↝ ↞ ↟ ↠ ↡ ↢ ↣ ↤ ↥ ↦ ↧ ↨ ↩ ↪ ↫ ↬ ↭ ↮ ↯ ↰ ↱ ↲ ↳ ↴ ↵ ↶ ↷ ↸ ↹ ↺ ↻ ↼ ↽ ↾ ↿ ⇀ ⇁ ⇂ ⇃ ⇄ ⇅ ⇆ ⇇ ⇈ ⇉ ⇊ ⇋ ⇌ ⇍ ⇎ ⇏ ⇐ ⇑ ⇒ ⇓ ⇔ ⇕ ⇖ ⇗ ⇘ ⇙ ⇚ ⇛ ⇜ ⇝ ⇞ ⇟ ⇠ ⇡ ⇢ ⇣ ⇤ ⇥ ⇦ ⇧ ⇨ ⇩ ⇪ +∀ ∁ ∂ ∃ ∄ ∅ ∆ ∇ ∈ ∉ ∊ ∋ ∌ ∍ ∎ ∏ ∐ ∑ − ∓ ∔ ∕ ∖ ∗ ∘ ∙ √ ∛ ∜ ∝ ∞ ∟ ∠ ∡ ∢ ∣ ∤ ∥ ∦ ∧ ∨ ∩ ∪ ∫ ∬ ∭ ∮ ∯ ∰ ∱ ∲ ∳ ∴ ∵ ∶ ∷ ∸ ∹ ∺ ∻ ∼ ∽ ∾ ∿ ≀ ≁ ≂ ≃ ≄ ≅ ≆ ≇ ≈ ≉ ≊ ≋ ≌ ≍ ≎ ≏ ≐ ≑ ≒ ≓ ≔ ≕ ≖ ≗ ≘ ≙ ≚ ≛ ≜ ≝ ≞ ≟ ≠ ≡ ≢ ≣ ≤ ≥ ≦ ≧ ≨ ≩ ≪ ≫ ≬ ≭ ≮ ≯ ≰ ≱ ≲ ≳ ≴ ≵ ≶ ≷ ≸ ≹ ≺ ≻ ≼ ≽ ≾ ≿ ... +⌀ ⌂ ⌃ ⌄ ⌅ ⌆ ⌇ ⌈ ⌉ ⌊ ⌋ ⌌ ⌍ ⌎ ⌏ ⌐ ⌑ ⌒ ⌓ ⌔ ⌕ ⌖ ⌗ ⌘ ⌙ ⌚ ⌛ ⌜ ⌝ ⌞ ⌟ ⌠ ⌡ ⌢ ⌣ ⌤ ⌥ ⌦ ⌧ ⌨ 〈 〉 ⌫ ⌬ ⌭ ⌮ ⌯ ⌰ ⌱ ⌲ ⌳ ⌴ ⌵ ⌶ ⌷ ⌸ ⌹ ⌺ ⌻ ⌼ ⌽ ⌾ ⌿ ⍀ ⍁ ⍂ ⍃ ⍄ ⍅ ⍆ ⍇ ⍈ ⍉ ⍊ ⍋ ⍌ ⍍ ⍎ ⍏ ⍐ ⍑ ⍒ ⍓ ⍔ ⍕ ⍖ ⍗ ⍘ ⍙ ⍚ ⍛ ⍜ ⍝ ⍞ ⍟ ⍠ ⍡ ⍢ ⍣ ⍤ ⍥ ⍦ ⍧ ⍨ ⍩ ⍪ ⍫ ⍬ ⍭ ⍮ ⍯ ⍰ ⍱ ⍲ ⍳ ⍴ ⍵ ⍶ ⍷ ⍸ ⍹ ⍺ +␀ ␁ ␂ ␃ ␄ ␅ ␆ ␇ ␈ ␉ ␊ ␋ ␌ ␍ ␎ ␏ ␐ ␑ ␒ ␓ ␔ ␕ ␖ ␗ ␘ ␙ ␚ ␛ ␜ ␝ ␞ ␟ ␠ ␡ ␢ ␣ ␤ +⑀ ⑁ ⑂ ⑃ ⑄ ⑅ ⑆ ⑇ ⑈ ⑉ ⑊ +① ② ③ ④ ⑤ ⑥ ⑦ ⑧ ⑨ ⑩ ⑪ ⑫ ⑬ ⑭ ⑮ ⑯ ⑰ ⑱ ⑲ ⑳ ⑴ ⑵ ⑶ ⑷ ⑸ ⑹ ⑺ ⑻ ⑼ ⑽ ⑾ ⑿ ⒀ ⒁ ⒂ ⒃ ⒄ ⒅ ⒆ ⒇ ⒈ ⒉ ⒊ ⒋ ⒌ ⒍ ⒎ ⒏ ⒐ ⒑ ⒒ ⒓ ⒔ ⒕ ⒖ ⒗ ⒘ ⒙ ⒚ ⒛ ⒜ ⒝ ⒞ ⒟ ⒠ ⒡ ⒢ ⒣ ⒤ ⒥ ⒦ ⒧ ⒨ ⒩ ⒪ ⒫ ⒬ ⒭ ⒮ ⒯ ⒰ ⒱ ⒲ ⒳ ⒴ ⒵ Ⓐ Ⓑ Ⓒ Ⓓ Ⓔ Ⓕ Ⓖ Ⓗ Ⓘ Ⓙ Ⓚ Ⓛ Ⓜ Ⓝ Ⓞ Ⓟ Ⓠ Ⓡ Ⓢ Ⓣ Ⓤ Ⓥ Ⓦ Ⓧ Ⓨ Ⓩ ⓐ ⓑ ⓒ ⓓ ⓔ ⓕ ⓖ ⓗ ⓘ ⓙ ⓚ ⓛ ⓜ ⓝ ⓞ ⓟ ... +─ ━ │ ┃ ┄ ┅ ┆ ┇ ┈ ┉ ┊ ┋ ┌ ┍ ┎ ┏ ┐ ┑ ┒ ┓ └ ┕ ┖ ┗ ┘ ┙ ┚ ┛ ├ ┝ ┞ ┟ ┠ ┡ ┢ ┣ ┤ ┥ ┦ ┧ ┨ ┩ ┪ ┫ ┬ ┭ ┮ ┯ ┰ ┱ ┲ ┳ ┴ ┵ ┶ ┷ ┸ ┹ ┺ ┻ ┼ ┽ ┾ ┿ ╀ ╁ ╂ ╃ ╄ ╅ ╆ ╇ ╈ ╉ ╊ ╋ ╌ ╍ ╎ ╏ ═ ║ ╒ ╓ ╔ ╕ ╖ ╗ ╘ ╙ ╚ ╛ ╜ ╝ ╞ ╟ ╠ ╡ ╢ ╣ ╤ ╥ ╦ ╧ ╨ ╩ ╪ ╫ ╬ ╭ ╮ ╯ ╰ ╱ ╲ ╳ ╴ ╵ ╶ ╷ ╸ ╹ ╺ ╻ ╼ ╽ ╾ ╿ +▀ ▁ ▂ ▃ ▄ ▅ ▆ ▇ █ ▉ ▊ ▋ ▌ ▍ ▎ ▏ ▐ ░ ▒ ▓ ▔ ▕ +■ □ ▢ ▣ ▤ ▥ ▦ ▧ ▨ ▩ ▪ ▫ ▬ ▭ ▮ ▯ ▰ ▱ ▲ △ ▴ ▵ ▶ ▷ ▸ ▹ ► ▻ ▼ ▽ ▾ ▿ ◀ ◁ ◂ ◃ ◄ ◅ ◆ ◇ ◈ ◉ ◊ ○ ◌ ◍ ◎ ● ◐ ◑ ◒ ◓ ◔ ◕ ◖ ◗ ◘ ◙ ◚ ◛ ◜ ◝ ◞ ◟ ◠ ◡ ◢ ◣ ◤ ◥ ◦ ◧ ◨ ◩ ◪ ◫ ◬ ◭ ◮ ◯ +☀ ☁ ☂ ☃ ☄ ★ ☆ ☇ ☈ ☉ ☊ ☋ ☌ ☍ ☎ ☏ ☐ ☑ ☒ ☓ ☚ ☛ ☜ ☝ ☞ ☟ ☠ ☡ ☢ ☣ ☤ ☥ ☦ ☧ ☨ ☩ ☪ ☫ ☬ ☭ ☮ ☯ ☰ ☱ ☲ ☳ ☴ ☵ ☶ ☷ ☸ ☹ ☺ ☻ ☼ ☽ ☾ ☿ ♀ ♁ ♂ ♃ ♄ ♅ ♆ ♇ ♈ ♉ ♊ ♋ ♌ ♍ ♎ ♏ ♐ ♑ ♒ ♓ ♔ ♕ ♖ ♗ ♘ ♙ ♚ ♛ ♜ ♝ ♞ ♟ ♠ ♡ ♢ ♣ ♤ ♥ ♦ ♧ ♨ ♩ ♪ ♫ ♬ ♭ ♮ ♯ +✁ ✂ ✃ ✄ ✆ ✇ ✈ ✉ ✌ ✍ ✎ ✏ ✐ ✑ ✒ ✓ ✔ ✕ ✖ ✗ ✘ ✙ ✚ ✛ ✜ ✝ ✞ ✟ ✠ ✡ ✢ ✣ ✤ ✥ ✦ ✧ ✩ ✪ ✫ ✬ ✭ ✮ ✯ ✰ ✱ ✲ ✳ ✴ ✵ ✶ ✷ ✸ ✹ ✺ ✻ ✼ ✽ ✾ ✿ ❀ ❁ ❂ ❃ ❄ ❅ ❆ ❇ ❈ ❉ ❊ ❋ ❍ ❏ ❐ ❑ ❒ ❖ ❘ ❙ ❚ ❛ ❜ ❝ ❞ ❡ ❢ ❣ ❤ ❥ ❦ ❧ ❶ ❷ ❸ ❹ ❺ ❻ ❼ ❽ ❾ ❿ ➀ ➁ ➂ ➃ ➄ ➅ ➆ ➇ ➈ ➉ ➊ ➋ ➌ ➍ ➎ ➏ ➐ ➑ ➒ ➓ ➔ ➘ ➙ ➚ ➛ ➜ ➝ ... +　 、 。 〃 〄 々 〆 〇 〈 〉 《 》 「 」 『 』 【 】 〒 〓 〔 〕 〖 〗 〘 〙 〚 〛 〜 〝 〞 〟 〠 〡 〢 〣 〤 〥 〦 〧 〨 〩 〪 〫 〬 〭 〮 〯 〰 〱 〲 〳 〴 〵 〶 〷 〿 +ぁ あ ぃ い ぅ う ぇ え ぉ お か が き ぎ く ぐ け げ こ ご さ ざ し じ す ず せ ぜ そ ぞ た だ ち ぢ っ つ づ て で と ど な に ぬ ね の は ば ぱ ひ び ぴ ふ ぶ ぷ へ べ ぺ ほ ぼ ぽ ま み む め も ゃ や ゅ ゆ ょ よ ら り る れ ろ ゎ わ ゐ ゑ を ん ゔ ゙ ゚ ゛ ゜ ゝ ゞ +ァ ア ィ イ ゥ ウ ェ エ ォ オ カ ガ キ ギ ク グ ケ ゲ コ ゴ サ ザ シ ジ ス ズ セ ゼ ソ ゾ タ ダ チ ヂ ッ ツ ヅ テ デ ト ド ナ ニ ヌ ネ ノ ハ バ パ ヒ ビ ピ フ ブ プ ヘ ベ ペ ホ ボ ポ マ ミ ム メ モ ャ ヤ ュ ユ ョ ヨ ラ リ ル レ ロ ヮ ワ ヰ ヱ ヲ ン ヴ ヵ ヶ ヷ ヸ ヹ ヺ ・ ー ヽ ヾ +ㄅ ㄆ ㄇ ㄈ ㄉ ㄊ ㄋ ㄌ ㄍ ㄎ ㄏ ㄐ ㄑ ㄒ ㄓ ㄔ ㄕ ㄖ ㄗ ㄘ ㄙ ㄚ ㄛ ㄜ ㄝ ㄞ ㄟ ㄠ ㄡ ㄢ ㄣ ㄤ ㄥ ㄦ ㄧ ㄨ ㄩ ㄪ ㄫ ㄬ +ㄱ ㄲ ㄳ ㄴ ㄵ ㄶ ㄷ ㄸ ㄹ ㄺ ㄻ ㄼ ㄽ ㄾ ㄿ ㅀ ㅁ ㅂ ㅃ ㅄ ㅅ ㅆ ㅇ ㅈ ㅉ ㅊ ㅋ ㅌ ㅍ ㅎ ㅏ ㅐ ㅑ ㅒ ㅓ ㅔ ㅕ ㅖ ㅗ ㅘ ㅙ ㅚ ㅛ ㅜ ㅝ ㅞ ㅟ ㅠ ㅡ ㅢ ㅣ ㅤ ㅥ ㅦ ㅧ ㅨ ㅩ ㅪ ㅫ ㅬ ㅭ ㅮ ㅯ ㅰ ㅱ ㅲ ㅳ ㅴ ㅵ ㅶ ㅷ ㅸ ㅹ ㅺ ㅻ ㅼ ㅽ ㅾ ㅿ ㆀ ㆁ ㆂ ㆃ ㆄ ㆅ ㆆ ㆇ ㆈ ㆉ ㆊ ㆋ ㆌ ㆍ ㆎ +㆐ ㆑ ㆒ ㆓ ㆔ ㆕ ㆖ ㆗ ㆘ ㆙ ㆚ ㆛ ㆜ ㆝ ㆞ ㆟ +㈀ ㈁ ㈂ ㈃ ㈄ ㈅ ㈆ ㈇ ㈈ ㈉ ㈊ ㈋ ㈌ ㈍ ㈎ ㈏ ㈐ ㈑ ㈒ ㈓ ㈔ ㈕ ㈖ ㈗ ㈘ ㈙ ㈚ ㈛ ㈜ ㈠ ㈡ ㈢ ㈣ ㈤ ㈥ ㈦ ㈧ ㈨ ㈩ ㈪ ㈫ ㈬ ㈭ ㈮ ㈯ ㈰ ㈱ ㈲ ㈳ ㈴ ㈵ ㈶ ㈷ ㈸ ㈹ ㈺ ㈻ ㈼ ㈽ ㈾ ㈿ ㉀ ㉁ ㉂ ㉃ ㉠ ㉡ ㉢ ㉣ ㉤ ㉥ ㉦ ㉧ ㉨ ㉩ ㉪ ㉫ ㉬ ㉭ ㉮ ㉯ ㉰ ㉱ ㉲ ㉳ ㉴ ㉵ ㉶ ㉷ ㉸ ㉹ ㉺ ㉻ ㉿ ㊀ ㊁ ㊂ ㊃ ㊄ ㊅ ㊆ ㊇ ㊈ ㊉ ㊊ ㊋ ㊌ ㊍ ㊎ ㊏ ㊐ ㊑ ㊒ ㊓ ㊔ ㊕ ㊖ ㊗ ㊘ ㊙ ㊚ ㊛ ㊜ ㊝ ㊞ ㊟ ㊠ ㊡ ... +㌀ ㌁ ㌂ ㌃ ㌄ ㌅ ㌆ ㌇ ㌈ ㌉ ㌊ ㌋ ㌌ ㌍ ㌎ ㌏ ㌐ ㌑ ㌒ ㌓ ㌔ ㌕ ㌖ ㌗ ㌘ ㌙ ㌚ ㌛ ㌜ ㌝ ㌞ ㌟ ㌠ ㌡ ㌢ ㌣ ㌤ ㌥ ㌦ ㌧ ㌨ ㌩ ㌪ ㌫ ㌬ ㌭ ㌮ ㌯ ㌰ ㌱ ㌲ ㌳ ㌴ ㌵ ㌶ ㌷ ㌸ ㌹ ㌺ ㌻ ㌼ ㌽ ㌾ ㌿ ㍀ ㍁ ㍂ ㍃ ㍄ ㍅ ㍆ ㍇ ㍈ ㍉ ㍊ ㍋ ㍌ ㍍ ㍎ ㍏ ㍐ ㍑ ㍒ ㍓ ㍔ ㍕ ㍖ ㍗ ㍘ ㍙ ㍚ ㍛ ㍜ ㍝ ㍞ ㍟ ㍠ ㍡ ㍢ ㍣ ㍤ ㍥ ㍦ ㍧ ㍨ ㍩ ㍪ ㍫ ㍬ ㍭ ㍮ ㍯ ㍰ ㍱ ㍲ ㍳ ㍴ ㍵ ㍶ ㍻ ㍼ ㍽ ㍾ ㍿ ㎀ ㎁ ㎂ ㎃ ... +一 丁 丂 七 丄 丅 丆 万 丈 三 上 下 丌 不 与 丏 丐 丑 丒 专 且 丕 世 丗 丘 丙 业 丛 东 丝 丞 丟 丠 両 丢 丣 两 严 並 丧 丨 丩 个 丫 丬 中 丮 丯 丰 丱 串 丳 临 丵 丶 丷 丸 丹 为 主 丼 丽 举 丿 乀 乁 乂 乃 乄 久 乆 乇 么 义 乊 之 乌 乍 乎 乏 乐 乑 乒 乓 乔 乕 乖 乗 乘 乙 乚 乛 乜 九 乞 也 习 乡 乢 乣 乤 乥 书 乧 乨 乩 乪 乫 乬 乭 乮 乯 买 乱 乲 乳 乴 乵 乶 乷 乸 乹 乺 乻 乼 乽 乾 乿 ... +가 각 갂 갃 간 갅 갆 갇 갈 갉 갊 갋 갌 갍 갎 갏 감 갑 값 갓 갔 강 갖 갗 갘 같 갚 갛 개 객 갞 갟 갠 갡 갢 갣 갤 갥 갦 갧 갨 갩 갪 갫 갬 갭 갮 갯 갰 갱 갲 갳 갴 갵 갶 갷 갸 갹 갺 갻 갼 갽 갾 갿 걀 걁 걂 걃 걄 걅 걆 걇 걈 걉 걊 걋 걌 걍 걎 걏 걐 걑 걒 걓 걔 걕 걖 걗 걘 걙 걚 걛 걜 걝 걞 걟 걠 걡 걢 걣 걤 걥 걦 걧 걨 걩 걪 걫 걬 걭 걮 걯 거 걱 걲 걳 건 걵 걶 걷 걸 걹 걺 걻 걼 걽 걾 걿 ... +                                                                                                                                ... +豈 更 車 賈 滑 串 句 龜 龜 契 金 喇 奈 懶 癩 羅 蘿 螺 裸 邏 樂 洛 烙 珞 落 酪 駱 亂 卵 欄 爛 蘭 鸞 嵐 濫 藍 襤 拉 臘 蠟 廊 朗 浪 狼 郎 來 冷 勞 擄 櫓 爐 盧 老 蘆 虜 路 露 魯 鷺 碌 祿 綠 菉 錄 鹿 論 壟 弄 籠 聾 牢 磊 賂 雷 壘 屢 樓 淚 漏 累 縷 陋 勒 肋 凜 凌 稜 綾 菱 陵 讀 拏 樂 諾 丹 寧 怒 率 異 北 磻 便 復 不 泌 數 索 參 塞 省 葉 說 殺 辰 沈 拾 若 掠 略 亮 兩 凉 梁 糧 良 諒 量 勵 ... +ff fi fl ffi ffl ſt st ﬓ ﬔ ﬕ ﬖ ﬗ ﬞ ײַ ﬠ ﬡ ﬢ ﬣ ﬤ ﬥ ﬦ ﬧ ﬨ ﬩ שׁ שׂ שּׁ שּׂ אַ אָ אּ בּ גּ דּ הּ וּ זּ טּ יּ ךּ כּ לּ מּ נּ סּ ףּ פּ צּ קּ רּ שּ תּ וֹ בֿ כֿ פֿ ﭏ +ﭐ ﭑ ﭒ ﭓ ﭔ ﭕ ﭖ ﭗ ﭘ ﭙ ﭚ ﭛ ﭜ ﭝ ﭞ ﭟ ﭠ ﭡ ﭢ ﭣ ﭤ ﭥ ﭦ ﭧ ﭨ ﭩ ﭪ ﭫ ﭬ ﭭ ﭮ ﭯ ﭰ ﭱ ﭲ ﭳ ﭴ ﭵ ﭶ ﭷ ﭸ ﭹ ﭺ ﭻ ﭼ ﭽ ﭾ ﭿ ﮀ ﮁ ﮂ ﮃ ﮄ ﮅ ﮆ ﮇ ﮈ ﮉ ﮊ ﮋ ﮌ ﮍ ﮎ ﮏ ﮐ ﮑ ﮒ ﮓ ﮔ ﮕ ﮖ ﮗ ﮘ ﮙ ﮚ ﮛ ﮜ ﮝ ﮞ ﮟ ﮠ ﮡ ﮢ ﮣ ﮤ ﮥ ﮦ ﮧ ﮨ ﮩ ﮪ ﮫ ﮬ ﮭ ﮮ ﮯ ﮰ ﮱ ﯓ ﯔ ﯕ ﯖ ﯗ ﯘ ﯙ ﯚ ﯛ ﯜ ﯝ ﯞ ﯟ ﯠ ﯡ ﯢ ﯣ ﯤ ﯥ ﯦ ﯧ ﯨ ﯩ ﯪ ﯫ ﯬ ﯭ ﯮ ﯯ ﯰ ... +︠ ︡ ︢ ︣ +︰ ︱ ︲ ︳ ︴ ︵ ︶ ︷ ︸ ︹ ︺ ︻ ︼ ︽ ︾ ︿ ﹀ ﹁ ﹂ ﹃ ﹄ ﹉ ﹊ ﹋ ﹌ ﹍ ﹎ ﹏ +﹐ ﹑ ﹒ ﹔ ﹕ ﹖ ﹗ ﹘ ﹙ ﹚ ﹛ ﹜ ﹝ ﹞ ﹟ ﹠ ﹡ ﹢ ﹣ ﹤ ﹥ ﹦ ﹨ ﹩ ﹪ ﹫ +ﹰ ﹱ ﹲ ﹴ ﹶ ﹷ ﹸ ﹹ ﹺ ﹻ ﹼ ﹽ ﹾ ﹿ ﺀ ﺁ ﺂ ﺃ ﺄ ﺅ ﺆ ﺇ ﺈ ﺉ ﺊ ﺋ ﺌ ﺍ ﺎ ﺏ ﺐ ﺑ ﺒ ﺓ ﺔ ﺕ ﺖ ﺗ ﺘ ﺙ ﺚ ﺛ ﺜ ﺝ ﺞ ﺟ ﺠ ﺡ ﺢ ﺣ ﺤ ﺥ ﺦ ﺧ ﺨ ﺩ ﺪ ﺫ ﺬ ﺭ ﺮ ﺯ ﺰ ﺱ ﺲ ﺳ ﺴ ﺵ ﺶ ﺷ ﺸ ﺹ ﺺ ﺻ ﺼ ﺽ ﺾ ﺿ ﻀ ﻁ ﻂ ﻃ ﻄ ﻅ ﻆ ﻇ ﻈ ﻉ ﻊ ﻋ ﻌ ﻍ ﻎ ﻏ ﻐ ﻑ ﻒ ﻓ ﻔ ﻕ ﻖ ﻗ ﻘ ﻙ ﻚ ﻛ ﻜ ﻝ ﻞ ﻟ ﻠ ﻡ ﻢ ﻣ ﻤ ﻥ ﻦ ﻧ ﻨ ﻩ ﻪ ﻫ ﻬ ﻭ ﻮ ﻯ ﻰ ﻱ ... +！ ＂ ＃ ＄ ％ ＆ ＇ （ ） ＊ ＋ ， － ． ／ ０ １ ２ ３ ４ ５ ６ ７ ８ ９ ： ； ＜ ＝ ＞ ？ ＠ Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ Ｉ Ｊ Ｋ Ｌ Ｍ Ｎ Ｏ Ｐ Ｑ Ｒ Ｓ Ｔ Ｕ Ｖ Ｗ Ｘ Ｙ Ｚ ［ ＼ ］ ＾ ＿ ｀ ａ ｂ ｃ ｄ ｅ ｆ ｇ ｈ ｉ ｊ ｋ ｌ ｍ ｎ ｏ ｐ ｑ ｒ ｓ ｔ ｕ ｖ ｗ ｘ ｙ ｚ ｛ ｜ ｝ ～ ｡ ｢ ｣ ､ ･ ｦ ｧ ｨ ｩ ｪ ｫ ｬ ｭ ｮ ｯ ｰ ｱ ｲ ｳ ｴ ｵ ｶ ｷ ｸ ｹ ｺ ｻ ｼ ｽ ｾ ｿ ﾀ ﾁ ﾂ ... diff --git a/tests/utf8.hs b/tests/utf8.hs new file mode 100644 --- /dev/null +++ b/tests/utf8.hs @@ -0,0 +1,139 @@ +-- | Unicode test. + +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE NoImplicitPrelude #-} + +import Language.Fay.FFI +import Language.Fay.Prelude + +main = do + -- Latin-1 Supplement + printS "¡ ¢ £ ¤ ¥ ¦ § ¨ © ª « ¬ ­ ® ¯ ° ± ² ³ ´ µ ¶ · ¸ ¹ º » ¼ ½ ¾ ¿ À Á Â Ã Ä Å Æ Ç È É Ê Ë Ì Í Î Ï Ð Ñ Ò Ó Ô Õ Ö × Ø Ù Ú Û Ü Ý Þ ß à á â ã ä å æ ç è é ê ë ì í î ï ð ñ ò ó ô õ ö ÷ ø ù ú û ü ý þ ÿ" + + -- Latin Extended-A + printS "Ā ā Ă ă Ą ą Ć ć Ĉ ĉ Ċ ċ Č č Ď ď Đ đ Ē ē Ĕ ĕ Ė ė Ę ę Ě ě Ĝ ĝ Ğ ğ Ġ ġ Ģ ģ Ĥ ĥ Ħ ħ Ĩ ĩ Ī ī Ĭ ĭ Į į İ ı IJ ij Ĵ ĵ Ķ ķ ĸ Ĺ ĺ Ļ ļ Ľ ľ Ŀ ŀ Ł ł Ń ń Ņ ņ Ň ň ʼn Ŋ ŋ Ō ō Ŏ ŏ Ő ő Œ œ Ŕ ŕ Ŗ ŗ Ř ř Ś ś Ŝ ŝ Ş ş Š š Ţ ţ Ť ť Ŧ ŧ Ũ ũ Ū ū Ŭ ŭ Ů ů Ű ű Ų ų Ŵ ŵ Ŷ ŷ Ÿ Ź ź Ż ż Ž ž ſ" + -- Latin Extended-B + printS "ƀ Ɓ Ƃ ƃ Ƅ ƅ Ɔ Ƈ ƈ Ɖ Ɗ Ƌ ƌ ƍ Ǝ Ə Ɛ Ƒ ƒ Ɠ Ɣ ƕ Ɩ Ɨ Ƙ ƙ ƚ ƛ Ɯ Ɲ ƞ Ɵ Ơ ơ Ƣ ƣ Ƥ ƥ Ʀ Ƨ ƨ Ʃ ƪ ƫ Ƭ ƭ Ʈ Ư ư Ʊ Ʋ Ƴ ƴ Ƶ ƶ Ʒ Ƹ ƹ ƺ ƻ Ƽ ƽ ƾ ƿ ǀ ǁ ǂ ǃ DŽ Dž dž LJ Lj lj NJ Nj nj Ǎ ǎ Ǐ ǐ Ǒ ǒ Ǔ ǔ Ǖ ǖ Ǘ ǘ Ǚ ǚ Ǜ ǜ ǝ Ǟ ǟ Ǡ ǡ Ǣ ǣ Ǥ ǥ Ǧ ǧ Ǩ ǩ Ǫ ǫ Ǭ ǭ Ǯ ǯ ǰ DZ Dz dz Ǵ ǵ Ǻ ǻ Ǽ ǽ Ǿ ǿ Ȁ ȁ Ȃ ȃ ..." + -- IPA Extensions + printS "ɐ ɑ ɒ ɓ ɔ ɕ ɖ ɗ ɘ ə ɚ ɛ ɜ ɝ ɞ ɟ ɠ ɡ ɢ ɣ ɤ ɥ ɦ ɧ ɨ ɩ ɪ ɫ ɬ ɭ ɮ ɯ ɰ ɱ ɲ ɳ ɴ ɵ ɶ ɷ ɸ ɹ ɺ ɻ ɼ ɽ ɾ ɿ ʀ ʁ ʂ ʃ ʄ ʅ ʆ ʇ ʈ ʉ ʊ ʋ ʌ ʍ ʎ ʏ ʐ ʑ ʒ ʓ ʔ ʕ ʖ ʗ ʘ ʙ ʚ ʛ ʜ ʝ ʞ ʟ ʠ ʡ ʢ ʣ ʤ ʥ ʦ ʧ ʨ" + -- Spacing Modifier Letters + printS "ʰ ʱ ʲ ʳ ʴ ʵ ʶ ʷ ʸ ʹ ʺ ʻ ʼ ʽ ʾ ʿ ˀ ˁ ˂ ˃ ˄ ˅ ˆ ˇ ˈ ˉ ˊ ˋ ˌ ˍ ˎ ˏ ː ˑ ˒ ˓ ˔ ˕ ˖ ˗ ˘ ˙ ˚ ˛ ˜ ˝ ˞ ˠ ˡ ˢ ˣ ˤ ˥ ˦ ˧ ˨ ˩" + -- Combining Diacritical Marks + printS "̀ ́ ̂ ̃ ̄ ̅ ̆ ̇ ̈ ̉ ̊ ̋ ̌ ̍ ̎ ̏ ̐ ̑ ̒ ̓ ̔ ̕ ̖ ̗ ̘ ̙ ̚ ̛ ̜ ̝ ̞ ̟ ̠ ̡ ̢ ̣ ̤ ̥ ̦ ̧ ̨ ̩ ̪ ̫ ̬ ̭ ̮ ̯ ̰ ̱ ̲ ̳ ̴ ̵ ̶ ̷ ̸ ̹ ̺ ̻ ̼ ̽ ̾ ̿ ̀ ́ ͂ ̓ ̈́ ͅ ͠ ͡" + -- Greek + printS "ʹ ͵ ͺ ; ΄ ΅ Ά · Έ Ή Ί Ό Ύ Ώ ΐ Α Β Γ Δ Ε Ζ Η Θ Ι Κ Λ Μ Ν Ξ Ο Π Ρ Σ Τ Υ Φ Χ Ψ Ω Ϊ Ϋ ά έ ή ί ΰ α β γ δ ε ζ η θ ι κ λ μ ν ξ ο π ρ ς σ τ υ φ χ ψ ω ϊ ϋ ό ύ ώ ϐ ϑ ϒ ϓ ϔ ϕ ϖ Ϛ Ϝ Ϟ Ϡ Ϣ ϣ Ϥ ϥ Ϧ ϧ Ϩ ϩ Ϫ ϫ Ϭ ϭ Ϯ ϯ ϰ ϱ ϲ ϳ" + -- Cyrillic + printS "Ё Ђ Ѓ Є Ѕ І Ї Ј Љ Њ Ћ Ќ Ў Џ А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ъ Ы Ь Э Ю Я а б в г д е ж з и й к л м н о п р с т у ф х ц ч ш щ ъ ы ь э ю я ё ђ ѓ є ѕ і ї ј љ њ ћ ќ ў џ Ѡ ѡ Ѣ ѣ Ѥ ѥ Ѧ ѧ Ѩ ѩ Ѫ ѫ Ѭ ѭ Ѯ ѯ Ѱ ѱ Ѳ ѳ Ѵ ѵ Ѷ ѷ Ѹ ѹ Ѻ ѻ Ѽ ѽ Ѿ ѿ Ҁ ҁ ҂ ҃ ..." + -- Armenian + printS "Ա Բ Գ Դ Ե Զ Է Ը Թ Ժ Ի Լ Խ Ծ Կ Հ Ձ Ղ Ճ Մ Յ Ն Շ Ո Չ Պ Ջ Ռ Ս Վ Տ Ր Ց Ւ Փ Ք Օ Ֆ ՙ ՚ ՛ ՜ ՝ ՞ ՟ ա բ գ դ ե զ է ը թ ժ ի լ խ ծ կ հ ձ ղ ճ մ յ ն շ ո չ պ ջ ռ ս վ տ ր ց ւ փ ք օ ֆ և ։" + -- Hebrew + printS "֑ ֒ ֓ ֔ ֕ ֖ ֗ ֘ ֙ ֚ ֛ ֜ ֝ ֞ ֟ ֠ ֡ ֣ ֤ ֥ ֦ ֧ ֨ ֩ ֪ ֫ ֬ ֭ ֮ ֯ ְ ֱ ֲ ֳ ִ ֵ ֶ ַ ָ ֹ ֻ ּ ֽ ־ ֿ ׀ ׁ ׂ ׃ ׄ א ב ג ד ה ו ז ח ט י ך כ ל ם מ ן נ ס ע ף פ ץ צ ק ר ש ת װ ױ ײ ׳ ״" + -- Arabic + printS "، ؛ ؟ ء آ أ ؤ إ ئ ا ب ة ت ث ج ح خ د ذ ر ز س ش ص ض ط ظ ع غ ـ ف ق ك ل م ن ه و ى ي ً ٌ ٍ َ ُ ِ ّ ْ ٠ ١ ٢ ٣ ٤ ٥ ٦ ٧ ٨ ٩ ٪ ٫ ٬ ٭ ٰ ٱ ٲ ٳ ٴ ٵ ٶ ٷ ٸ ٹ ٺ ٻ ټ ٽ پ ٿ ڀ ځ ڂ ڃ ڄ څ چ ڇ ڈ ډ ڊ ڋ ڌ ڍ ڎ ڏ ڐ ڑ ڒ ړ ڔ ڕ ږ ڗ ژ ڙ ښ ڛ ڜ ڝ ڞ ڟ ڠ ڡ ڢ ڣ ڤ ڥ ڦ ڧ ڨ ک ڪ ګ ڬ ڭ ڮ گ ڰ ڱ ..." + -- Devanagari + printS "ँ ं ः अ आ इ ई उ ऊ ऋ ऌ ऍ ऎ ए ऐ ऑ ऒ ओ औ क ख ग घ ङ च छ ज झ ञ ट ठ ड ढ ण त थ द ध न ऩ प फ ब भ म य र ऱ ल ळ ऴ व श ष स ह ़ ऽ ा ि ी ु ू ृ ॄ ॅ ॆ े ै ॉ ॊ ो ौ ् ॐ ॑ ॒ ॓ ॔ क़ ख़ ग़ ज़ ड़ ढ़ फ़ य़ ॠ ॡ ॢ ॣ । ॥ ० १ २ ३ ४ ५ ६ ७ ८ ९ ॰" + -- Bengali + printS "ঁ ং ঃ অ আ ই ঈ উ ঊ ঋ ঌ এ ঐ ও ঔ ক খ গ ঘ ঙ চ ছ জ ঝ ঞ ট ঠ ড ঢ ণ ত থ দ ধ ন প ফ ব ভ ম য র ল শ ষ স হ ় া ি ী ু ূ ৃ ৄ ে ৈ ো ৌ ্ ৗ ড় ঢ় য় ৠ ৡ ৢ ৣ ০ ১ ২ ৩ ৪ ৫ ৬ ৭ ৮ ৯ ৰ ৱ ৲ ৳ ৴ ৵ ৶ ৷ ৸ ৹ ৺" + -- Gurmukhi + printS "ਂ ਅ ਆ ਇ ਈ ਉ ਊ ਏ ਐ ਓ ਔ ਕ ਖ ਗ ਘ ਙ ਚ ਛ ਜ ਝ ਞ ਟ ਠ ਡ ਢ ਣ ਤ ਥ ਦ ਧ ਨ ਪ ਫ ਬ ਭ ਮ ਯ ਰ ਲ ਲ਼ ਵ ਸ਼ ਸ ਹ ਼ ਾ ਿ ੀ ੁ ੂ ੇ ੈ ੋ ੌ ੍ ਖ਼ ਗ਼ ਜ਼ ੜ ਫ਼ ੦ ੧ ੨ ੩ ੪ ੫ ੬ ੭ ੮ ੯ ੰ ੱ ੲ ੳ ੴ" + -- Gujarati + printS "ઁ ં ઃ અ આ ઇ ઈ ઉ ઊ ઋ ઍ એ ઐ ઑ ઓ ઔ ક ખ ગ ઘ ઙ ચ છ જ ઝ ઞ ટ ઠ ડ ઢ ણ ત થ દ ધ ન પ ફ બ ભ મ ય ર લ ળ વ શ ષ સ હ ઼ ઽ ા િ ી ુ ૂ ૃ ૄ ૅ ે ૈ ૉ ો ૌ ્ ૐ ૠ ૦ ૧ ૨ ૩ ૪ ૫ ૬ ૭ ૮ ૯" + -- Oriya + printS "ଁ ଂ ଃ ଅ ଆ ଇ ଈ ଉ ଊ ଋ ଌ ଏ ଐ ଓ ଔ କ ଖ ଗ ଘ ଙ ଚ ଛ ଜ ଝ ଞ ଟ ଠ ଡ ଢ ଣ ତ ଥ ଦ ଧ ନ ପ ଫ ବ ଭ ମ ଯ ର ଲ ଳ ଶ ଷ ସ ହ ଼ ଽ ା ି ୀ ୁ ୂ ୃ େ ୈ ୋ ୌ ୍ ୖ ୗ ଡ଼ ଢ଼ ୟ ୠ ୡ ୦ ୧ ୨ ୩ ୪ ୫ ୬ ୭ ୮ ୯ ୰" + -- Tamil + printS "ஂ ஃ அ ஆ இ ஈ உ ஊ எ ஏ ஐ ஒ ஓ ஔ க ங ச ஜ ஞ ட ண த ந ன ப ம ய ர ற ல ள ழ வ ஷ ஸ ஹ ா ி ீ ு ூ ெ ே ை ொ ோ ௌ ் ௗ ௧ ௨ ௩ ௪ ௫ ௬ ௭ ௮ ௯ ௰ ௱ ௲" + -- Telugu + printS "ఁ ం ః అ ఆ ఇ ఈ ఉ ఊ ఋ ఌ ఎ ఏ ఐ ఒ ఓ ఔ క ఖ గ ఘ ఙ చ ఛ జ ఝ ఞ ట ఠ డ ఢ ణ త థ ద ధ న ప ఫ బ భ మ య ర ఱ ల ళ వ శ ష స హ ా ి ీ ు ూ ృ ౄ ె ే ై ొ ో ౌ ్ ౕ ౖ ౠ ౡ ౦ ౧ ౨ ౩ ౪ ౫ ౬ ౭ ౮ ౯" + -- Kannada + printS "ಂ ಃ ಅ ಆ ಇ ಈ ಉ ಊ ಋ ಌ ಎ ಏ ಐ ಒ ಓ ಔ ಕ ಖ ಗ ಘ ಙ ಚ ಛ ಜ ಝ ಞ ಟ ಠ ಡ ಢ ಣ ತ ಥ ದ ಧ ನ ಪ ಫ ಬ ಭ ಮ ಯ ರ ಱ ಲ ಳ ವ ಶ ಷ ಸ ಹ ಾ ಿ ೀ ು ೂ ೃ ೄ ೆ ೇ ೈ ೊ ೋ ೌ ್ ೕ ೖ ೞ ೠ ೡ ೦ ೧ ೨ ೩ ೪ ೫ ೬ ೭ ೮ ೯" + -- Malayalam + printS "ം ഃ അ ആ ഇ ഈ ഉ ഊ ഋ ഌ എ ഏ ഐ ഒ ഓ ഔ ക ഖ ഗ ഘ ങ ച ഛ ജ ഝ ഞ ട ഠ ഡ ഢ ണ ത ഥ ദ ധ ന പ ഫ ബ ഭ മ യ ര റ ല ള ഴ വ ശ ഷ സ ഹ ാ ി ീ ു ൂ ൃ െ േ ൈ ൊ ോ ൌ ് ൗ ൠ ൡ ൦ ൧ ൨ ൩ ൪ ൫ ൬ ൭ ൮ ൯" + -- Thai + printS "ก ข ฃ ค ฅ ฆ ง จ ฉ ช ซ ฌ ญ ฎ ฏ ฐ ฑ ฒ ณ ด ต ถ ท ธ น บ ป ผ ฝ พ ฟ ภ ม ย ร ฤ ล ฦ ว ศ ษ ส ห ฬ อ ฮ ฯ ะ ั า ำ ิ ี ึ ื ุ ู ฺ ฿ เ แ โ ใ ไ ๅ ๆ ็ ่ ้ ๊ ๋ ์ ํ ๎ ๏ ๐ ๑ ๒ ๓ ๔ ๕ ๖ ๗ ๘ ๙ ๚ ๛" + -- Lao + printS "ກ ຂ ຄ ງ ຈ ຊ ຍ ດ ຕ ຖ ທ ນ ບ ປ ຜ ຝ ພ ຟ ມ ຢ ຣ ລ ວ ສ ຫ ອ ຮ ຯ ະ ັ າ ຳ ິ ີ ຶ ື ຸ ູ ົ ຼ ຽ ເ ແ ໂ ໃ ໄ ໆ ່ ້ ໊ ໋ ໌ ໍ ໐ ໑ ໒ ໓ ໔ ໕ ໖ ໗ ໘ ໙ ໜ ໝ" + -- Tibetan + printS "ༀ ༁ ༂ ༃ ༄ ༅ ༆ ༇ ༈ ༉ ༊ ་ ༌ ། ༎ ༏ ༐ ༑ ༒ ༓ ༔ ༕ ༖ ༗ ༘ ༙ ༚ ༛ ༜ ༝ ༞ ༟ ༠ ༡ ༢ ༣ ༤ ༥ ༦ ༧ ༨ ༩ ༪ ༫ ༬ ༭ ༮ ༯ ༰ ༱ ༲ ༳ ༴ ༵ ༶ ༷ ༸ ༹ ༺ ༻ ༼ ༽ ༾ ༿ ཀ ཁ ག གྷ ང ཅ ཆ ཇ ཉ ཊ ཋ ཌ ཌྷ ཎ ཏ ཐ ད དྷ ན པ ཕ བ བྷ མ ཙ ཚ ཛ ཛྷ ཝ ཞ ཟ འ ཡ ར ལ ཤ ཥ ས ཧ ཨ ཀྵ ཱ ི ཱི ུ ཱུ ྲྀ ཷ ླྀ ཹ ེ ཻ ོ ཽ ཾ ཿ ྀ ཱྀ ྂ ྃ ྄ ྅ ྆ ྇ ..." + -- Georgian + printS "Ⴀ Ⴁ Ⴂ Ⴃ Ⴄ Ⴅ Ⴆ Ⴇ Ⴈ Ⴉ Ⴊ Ⴋ Ⴌ Ⴍ Ⴎ Ⴏ Ⴐ Ⴑ Ⴒ Ⴓ Ⴔ Ⴕ Ⴖ Ⴗ Ⴘ Ⴙ Ⴚ Ⴛ Ⴜ Ⴝ Ⴞ Ⴟ Ⴠ Ⴡ Ⴢ Ⴣ Ⴤ Ⴥ ა ბ გ დ ე ვ ზ თ ი კ ლ მ ნ ო პ ჟ რ ს ტ უ ფ ქ ღ ყ შ ჩ ც ძ წ ჭ ხ ჯ ჰ ჱ ჲ ჳ ჴ ჵ ჶ ჻" + -- Hangul Jamo + printS "ᄀ ᄁ ᄂ ᄃ ᄄ ᄅ ᄆ ᄇ ᄈ ᄉ ᄊ ᄋ ᄌ ᄍ ᄎ ᄏ ᄐ ᄑ ᄒ ᄓ ᄔ ᄕ ᄖ ᄗ ᄘ ᄙ ᄚ ᄛ ᄜ ᄝ ᄞ ᄟ ᄠ ᄡ ᄢ ᄣ ᄤ ᄥ ᄦ ᄧ ᄨ ᄩ ᄪ ᄫ ᄬ ᄭ ᄮ ᄯ ᄰ ᄱ ᄲ ᄳ ᄴ ᄵ ᄶ ᄷ ᄸ ᄹ ᄺ ᄻ ᄼ ᄽ ᄾ ᄿ ᅀ ᅁ ᅂ ᅃ ᅄ ᅅ ᅆ ᅇ ᅈ ᅉ ᅊ ᅋ ᅌ ᅍ ᅎ ᅏ ᅐ ᅑ ᅒ ᅓ ᅔ ᅕ ᅖ ᅗ ᅘ ᅙ ᅟ ᅠ ᅡ ᅢ ᅣ ᅤ ᅥ ᅦ ᅧ ᅨ ᅩ ᅪ ᅫ ᅬ ᅭ ᅮ ᅯ ᅰ ᅱ ᅲ ᅳ ᅴ ᅵ ᅶ ᅷ ᅸ ᅹ ᅺ ᅻ ᅼ ᅽ ᅾ ᅿ ᆀ ᆁ ᆂ ᆃ ᆄ ..." + -- Latin Extended Additional + printS "Ḁ ḁ Ḃ ḃ Ḅ ḅ Ḇ ḇ Ḉ ḉ Ḋ ḋ Ḍ ḍ Ḏ ḏ Ḑ ḑ Ḓ ḓ Ḕ ḕ Ḗ ḗ Ḙ ḙ Ḛ ḛ Ḝ ḝ Ḟ ḟ Ḡ ḡ Ḣ ḣ Ḥ ḥ Ḧ ḧ Ḩ ḩ Ḫ ḫ Ḭ ḭ Ḯ ḯ Ḱ ḱ Ḳ ḳ Ḵ ḵ Ḷ ḷ Ḹ ḹ Ḻ ḻ Ḽ ḽ Ḿ ḿ Ṁ ṁ Ṃ ṃ Ṅ ṅ Ṇ ṇ Ṉ ṉ Ṋ ṋ Ṍ ṍ Ṏ ṏ Ṑ ṑ Ṓ ṓ Ṕ ṕ Ṗ ṗ Ṙ ṙ Ṛ ṛ Ṝ ṝ Ṟ ṟ Ṡ ṡ Ṣ ṣ Ṥ ṥ Ṧ ṧ Ṩ ṩ Ṫ ṫ Ṭ ṭ Ṯ ṯ Ṱ ṱ Ṳ ṳ Ṵ ṵ Ṷ ṷ Ṹ ṹ Ṻ ṻ Ṽ ṽ Ṿ ṿ ..." + -- Greek Extended + printS "ἀ ἁ ἂ ἃ ἄ ἅ ἆ ἇ Ἀ Ἁ Ἂ Ἃ Ἄ Ἅ Ἆ Ἇ ἐ ἑ ἒ ἓ ἔ ἕ Ἐ Ἑ Ἒ Ἓ Ἔ Ἕ ἠ ἡ ἢ ἣ ἤ ἥ ἦ ἧ Ἠ Ἡ Ἢ Ἣ Ἤ Ἥ Ἦ Ἧ ἰ ἱ ἲ ἳ ἴ ἵ ἶ ἷ Ἰ Ἱ Ἲ Ἳ Ἴ Ἵ Ἶ Ἷ ὀ ὁ ὂ ὃ ὄ ὅ Ὀ Ὁ Ὂ Ὃ Ὄ Ὅ ὐ ὑ ὒ ὓ ὔ ὕ ὖ ὗ Ὑ Ὓ Ὕ Ὗ ὠ ὡ ὢ ὣ ὤ ὥ ὦ ὧ Ὠ Ὡ Ὢ Ὣ Ὤ Ὥ Ὦ Ὧ ὰ ά ὲ έ ὴ ή ὶ ί ὸ ό ὺ ύ ὼ ώ ᾀ ᾁ ᾂ ᾃ ᾄ ᾅ ᾆ ᾇ ᾈ ᾉ ᾊ ᾋ ᾌ ᾍ ..." + -- General Punctuation + printS "‐ ‑ ‒ – — ― ‖ ‗ ‘ ’ ‚ ‛ “ ” „ ‟" + -- Superscripts and Subscripts + printS "⁰ ⁴ ⁵ ⁶ ⁷ ⁸ ⁹ ⁺ ⁻ ⁼ ⁽ ⁾ ⁿ ₀ ₁ ₂ ₃ ₄ ₅ ₆ ₇ ₈ ₉ ₊ ₋ ₌ ₍ ₎" + -- Currency Symbols + printS "₠ ₡ ₢ ₣ ₤ ₥ ₦ ₧ ₨ ₩ ₪ ₫" + -- Combining Marks for Symbols + printS "⃐ ⃑ ⃒ ⃓ ⃔ ⃕ ⃖ ⃗ ⃘ ⃙ ⃚ ⃛ ⃜ ⃝ ⃞ ⃟ ⃠ ⃡" + -- Letterlike Symbols + printS "℀ ℁ ℂ ℃ ℄ ℅ ℆ ℇ ℈ ℉ ℊ ℋ ℌ ℍ ℎ ℏ ℐ ℑ ℒ ℓ ℔ ℕ № ℗ ℘ ℙ ℚ ℛ ℜ ℝ ℞ ℟ ℠ ℡ ™ ℣ ℤ ℥ Ω ℧ ℨ ℩ K Å ℬ ℭ ℮ ℯ ℰ ℱ Ⅎ ℳ ℴ ℵ ℶ ℷ ℸ" + -- Number Forms + printS "⅓ ⅔ ⅕ ⅖ ⅗ ⅘ ⅙ ⅚ ⅛ ⅜ ⅝ ⅞ ⅟ Ⅰ Ⅱ Ⅲ Ⅳ Ⅴ Ⅵ Ⅶ Ⅷ Ⅸ Ⅹ Ⅺ Ⅻ Ⅼ Ⅽ Ⅾ Ⅿ ⅰ ⅱ ⅲ ⅳ ⅴ ⅵ ⅶ ⅷ ⅸ ⅹ ⅺ ⅻ ⅼ ⅽ ⅾ ⅿ ↀ ↁ ↂ" + -- Arrows + printS "← ↑ → ↓ ↔ ↕ ↖ ↗ ↘ ↙ ↚ ↛ ↜ ↝ ↞ ↟ ↠ ↡ ↢ ↣ ↤ ↥ ↦ ↧ ↨ ↩ ↪ ↫ ↬ ↭ ↮ ↯ ↰ ↱ ↲ ↳ ↴ ↵ ↶ ↷ ↸ ↹ ↺ ↻ ↼ ↽ ↾ ↿ ⇀ ⇁ ⇂ ⇃ ⇄ ⇅ ⇆ ⇇ ⇈ ⇉ ⇊ ⇋ ⇌ ⇍ ⇎ ⇏ ⇐ ⇑ ⇒ ⇓ ⇔ ⇕ ⇖ ⇗ ⇘ ⇙ ⇚ ⇛ ⇜ ⇝ ⇞ ⇟ ⇠ ⇡ ⇢ ⇣ ⇤ ⇥ ⇦ ⇧ ⇨ ⇩ ⇪" + -- Mathematical Operators + printS "∀ ∁ ∂ ∃ ∄ ∅ ∆ ∇ ∈ ∉ ∊ ∋ ∌ ∍ ∎ ∏ ∐ ∑ − ∓ ∔ ∕ ∖ ∗ ∘ ∙ √ ∛ ∜ ∝ ∞ ∟ ∠ ∡ ∢ ∣ ∤ ∥ ∦ ∧ ∨ ∩ ∪ ∫ ∬ ∭ ∮ ∯ ∰ ∱ ∲ ∳ ∴ ∵ ∶ ∷ ∸ ∹ ∺ ∻ ∼ ∽ ∾ ∿ ≀ ≁ ≂ ≃ ≄ ≅ ≆ ≇ ≈ ≉ ≊ ≋ ≌ ≍ ≎ ≏ ≐ ≑ ≒ ≓ ≔ ≕ ≖ ≗ ≘ ≙ ≚ ≛ ≜ ≝ ≞ ≟ ≠ ≡ ≢ ≣ ≤ ≥ ≦ ≧ ≨ ≩ ≪ ≫ ≬ ≭ ≮ ≯ ≰ ≱ ≲ ≳ ≴ ≵ ≶ ≷ ≸ ≹ ≺ ≻ ≼ ≽ ≾ ≿ ..." + -- Miscellaneous Technical + printS "⌀ ⌂ ⌃ ⌄ ⌅ ⌆ ⌇ ⌈ ⌉ ⌊ ⌋ ⌌ ⌍ ⌎ ⌏ ⌐ ⌑ ⌒ ⌓ ⌔ ⌕ ⌖ ⌗ ⌘ ⌙ ⌚ ⌛ ⌜ ⌝ ⌞ ⌟ ⌠ ⌡ ⌢ ⌣ ⌤ ⌥ ⌦ ⌧ ⌨ 〈 〉 ⌫ ⌬ ⌭ ⌮ ⌯ ⌰ ⌱ ⌲ ⌳ ⌴ ⌵ ⌶ ⌷ ⌸ ⌹ ⌺ ⌻ ⌼ ⌽ ⌾ ⌿ ⍀ ⍁ ⍂ ⍃ ⍄ ⍅ ⍆ ⍇ ⍈ ⍉ ⍊ ⍋ ⍌ ⍍ ⍎ ⍏ ⍐ ⍑ ⍒ ⍓ ⍔ ⍕ ⍖ ⍗ ⍘ ⍙ ⍚ ⍛ ⍜ ⍝ ⍞ ⍟ ⍠ ⍡ ⍢ ⍣ ⍤ ⍥ ⍦ ⍧ ⍨ ⍩ ⍪ ⍫ ⍬ ⍭ ⍮ ⍯ ⍰ ⍱ ⍲ ⍳ ⍴ ⍵ ⍶ ⍷ ⍸ ⍹ ⍺" + -- Control Pictures + printS "␀ ␁ ␂ ␃ ␄ ␅ ␆ ␇ ␈ ␉ ␊ ␋ ␌ ␍ ␎ ␏ ␐ ␑ ␒ ␓ ␔ ␕ ␖ ␗ ␘ ␙ ␚ ␛ ␜ ␝ ␞ ␟ ␠ ␡ ␢ ␣ ␤" + -- Optical Character Recognition + printS "⑀ ⑁ ⑂ ⑃ ⑄ ⑅ ⑆ ⑇ ⑈ ⑉ ⑊" + -- -- Enclosed Alphanumerics + printS "① ② ③ ④ ⑤ ⑥ ⑦ ⑧ ⑨ ⑩ ⑪ ⑫ ⑬ ⑭ ⑮ ⑯ ⑰ ⑱ ⑲ ⑳ ⑴ ⑵ ⑶ ⑷ ⑸ ⑹ ⑺ ⑻ ⑼ ⑽ ⑾ ⑿ ⒀ ⒁ ⒂ ⒃ ⒄ ⒅ ⒆ ⒇ ⒈ ⒉ ⒊ ⒋ ⒌ ⒍ ⒎ ⒏ ⒐ ⒑ ⒒ ⒓ ⒔ ⒕ ⒖ ⒗ ⒘ ⒙ ⒚ ⒛ ⒜ ⒝ ⒞ ⒟ ⒠ ⒡ ⒢ ⒣ ⒤ ⒥ ⒦ ⒧ ⒨ ⒩ ⒪ ⒫ ⒬ ⒭ ⒮ ⒯ ⒰ ⒱ ⒲ ⒳ ⒴ ⒵ Ⓐ Ⓑ Ⓒ Ⓓ Ⓔ Ⓕ Ⓖ Ⓗ Ⓘ Ⓙ Ⓚ Ⓛ Ⓜ Ⓝ Ⓞ Ⓟ Ⓠ Ⓡ Ⓢ Ⓣ Ⓤ Ⓥ Ⓦ Ⓧ Ⓨ Ⓩ ⓐ ⓑ ⓒ ⓓ ⓔ ⓕ ⓖ ⓗ ⓘ ⓙ ⓚ ⓛ ⓜ ⓝ ⓞ ⓟ ..." + -- Box Drawing + printS "─ ━ │ ┃ ┄ ┅ ┆ ┇ ┈ ┉ ┊ ┋ ┌ ┍ ┎ ┏ ┐ ┑ ┒ ┓ └ ┕ ┖ ┗ ┘ ┙ ┚ ┛ ├ ┝ ┞ ┟ ┠ ┡ ┢ ┣ ┤ ┥ ┦ ┧ ┨ ┩ ┪ ┫ ┬ ┭ ┮ ┯ ┰ ┱ ┲ ┳ ┴ ┵ ┶ ┷ ┸ ┹ ┺ ┻ ┼ ┽ ┾ ┿ ╀ ╁ ╂ ╃ ╄ ╅ ╆ ╇ ╈ ╉ ╊ ╋ ╌ ╍ ╎ ╏ ═ ║ ╒ ╓ ╔ ╕ ╖ ╗ ╘ ╙ ╚ ╛ ╜ ╝ ╞ ╟ ╠ ╡ ╢ ╣ ╤ ╥ ╦ ╧ ╨ ╩ ╪ ╫ ╬ ╭ ╮ ╯ ╰ ╱ ╲ ╳ ╴ ╵ ╶ ╷ ╸ ╹ ╺ ╻ ╼ ╽ ╾ ╿" + -- Block Elements + printS "▀ ▁ ▂ ▃ ▄ ▅ ▆ ▇ █ ▉ ▊ ▋ ▌ ▍ ▎ ▏ ▐ ░ ▒ ▓ ▔ ▕" + -- Geometric Shapes + printS "■ □ ▢ ▣ ▤ ▥ ▦ ▧ ▨ ▩ ▪ ▫ ▬ ▭ ▮ ▯ ▰ ▱ ▲ △ ▴ ▵ ▶ ▷ ▸ ▹ ► ▻ ▼ ▽ ▾ ▿ ◀ ◁ ◂ ◃ ◄ ◅ ◆ ◇ ◈ ◉ ◊ ○ ◌ ◍ ◎ ● ◐ ◑ ◒ ◓ ◔ ◕ ◖ ◗ ◘ ◙ ◚ ◛ ◜ ◝ ◞ ◟ ◠ ◡ ◢ ◣ ◤ ◥ ◦ ◧ ◨ ◩ ◪ ◫ ◬ ◭ ◮ ◯" + -- Miscellaneous Symbols + printS "☀ ☁ ☂ ☃ ☄ ★ ☆ ☇ ☈ ☉ ☊ ☋ ☌ ☍ ☎ ☏ ☐ ☑ ☒ ☓ ☚ ☛ ☜ ☝ ☞ ☟ ☠ ☡ ☢ ☣ ☤ ☥ ☦ ☧ ☨ ☩ ☪ ☫ ☬ ☭ ☮ ☯ ☰ ☱ ☲ ☳ ☴ ☵ ☶ ☷ ☸ ☹ ☺ ☻ ☼ ☽ ☾ ☿ ♀ ♁ ♂ ♃ ♄ ♅ ♆ ♇ ♈ ♉ ♊ ♋ ♌ ♍ ♎ ♏ ♐ ♑ ♒ ♓ ♔ ♕ ♖ ♗ ♘ ♙ ♚ ♛ ♜ ♝ ♞ ♟ ♠ ♡ ♢ ♣ ♤ ♥ ♦ ♧ ♨ ♩ ♪ ♫ ♬ ♭ ♮ ♯" + -- Dingbats + printS "✁ ✂ ✃ ✄ ✆ ✇ ✈ ✉ ✌ ✍ ✎ ✏ ✐ ✑ ✒ ✓ ✔ ✕ ✖ ✗ ✘ ✙ ✚ ✛ ✜ ✝ ✞ ✟ ✠ ✡ ✢ ✣ ✤ ✥ ✦ ✧ ✩ ✪ ✫ ✬ ✭ ✮ ✯ ✰ ✱ ✲ ✳ ✴ ✵ ✶ ✷ ✸ ✹ ✺ ✻ ✼ ✽ ✾ ✿ ❀ ❁ ❂ ❃ ❄ ❅ ❆ ❇ ❈ ❉ ❊ ❋ ❍ ❏ ❐ ❑ ❒ ❖ ❘ ❙ ❚ ❛ ❜ ❝ ❞ ❡ ❢ ❣ ❤ ❥ ❦ ❧ ❶ ❷ ❸ ❹ ❺ ❻ ❼ ❽ ❾ ❿ ➀ ➁ ➂ ➃ ➄ ➅ ➆ ➇ ➈ ➉ ➊ ➋ ➌ ➍ ➎ ➏ ➐ ➑ ➒ ➓ ➔ ➘ ➙ ➚ ➛ ➜ ➝ ..." + -- CJK Symbols and Punctuation + printS "　 、 。 〃 〄 々 〆 〇 〈 〉 《 》 「 」 『 』 【 】 〒 〓 〔 〕 〖 〗 〘 〙 〚 〛 〜 〝 〞 〟 〠 〡 〢 〣 〤 〥 〦 〧 〨 〩 〪 〫 〬 〭 〮 〯 〰 〱 〲 〳 〴 〵 〶 〷 〿" + -- Hiragana + printS "ぁ あ ぃ い ぅ う ぇ え ぉ お か が き ぎ く ぐ け げ こ ご さ ざ し じ す ず せ ぜ そ ぞ た だ ち ぢ っ つ づ て で と ど な に ぬ ね の は ば ぱ ひ び ぴ ふ ぶ ぷ へ べ ぺ ほ ぼ ぽ ま み む め も ゃ や ゅ ゆ ょ よ ら り る れ ろ ゎ わ ゐ ゑ を ん ゔ ゙ ゚ ゛ ゜ ゝ ゞ" + -- Katakana + printS "ァ ア ィ イ ゥ ウ ェ エ ォ オ カ ガ キ ギ ク グ ケ ゲ コ ゴ サ ザ シ ジ ス ズ セ ゼ ソ ゾ タ ダ チ ヂ ッ ツ ヅ テ デ ト ド ナ ニ ヌ ネ ノ ハ バ パ ヒ ビ ピ フ ブ プ ヘ ベ ペ ホ ボ ポ マ ミ ム メ モ ャ ヤ ュ ユ ョ ヨ ラ リ ル レ ロ ヮ ワ ヰ ヱ ヲ ン ヴ ヵ ヶ ヷ ヸ ヹ ヺ ・ ー ヽ ヾ" + -- Bopomofo + printS "ㄅ ㄆ ㄇ ㄈ ㄉ ㄊ ㄋ ㄌ ㄍ ㄎ ㄏ ㄐ ㄑ ㄒ ㄓ ㄔ ㄕ ㄖ ㄗ ㄘ ㄙ ㄚ ㄛ ㄜ ㄝ ㄞ ㄟ ㄠ ㄡ ㄢ ㄣ ㄤ ㄥ ㄦ ㄧ ㄨ ㄩ ㄪ ㄫ ㄬ" + -- Hangul Compatibility Jamo + printS "ㄱ ㄲ ㄳ ㄴ ㄵ ㄶ ㄷ ㄸ ㄹ ㄺ ㄻ ㄼ ㄽ ㄾ ㄿ ㅀ ㅁ ㅂ ㅃ ㅄ ㅅ ㅆ ㅇ ㅈ ㅉ ㅊ ㅋ ㅌ ㅍ ㅎ ㅏ ㅐ ㅑ ㅒ ㅓ ㅔ ㅕ ㅖ ㅗ ㅘ ㅙ ㅚ ㅛ ㅜ ㅝ ㅞ ㅟ ㅠ ㅡ ㅢ ㅣ ㅤ ㅥ ㅦ ㅧ ㅨ ㅩ ㅪ ㅫ ㅬ ㅭ ㅮ ㅯ ㅰ ㅱ ㅲ ㅳ ㅴ ㅵ ㅶ ㅷ ㅸ ㅹ ㅺ ㅻ ㅼ ㅽ ㅾ ㅿ ㆀ ㆁ ㆂ ㆃ ㆄ ㆅ ㆆ ㆇ ㆈ ㆉ ㆊ ㆋ ㆌ ㆍ ㆎ" + -- Kanbun + printS "㆐ ㆑ ㆒ ㆓ ㆔ ㆕ ㆖ ㆗ ㆘ ㆙ ㆚ ㆛ ㆜ ㆝ ㆞ ㆟" + -- Enclosed CJK Letters and Months + printS "㈀ ㈁ ㈂ ㈃ ㈄ ㈅ ㈆ ㈇ ㈈ ㈉ ㈊ ㈋ ㈌ ㈍ ㈎ ㈏ ㈐ ㈑ ㈒ ㈓ ㈔ ㈕ ㈖ ㈗ ㈘ ㈙ ㈚ ㈛ ㈜ ㈠ ㈡ ㈢ ㈣ ㈤ ㈥ ㈦ ㈧ ㈨ ㈩ ㈪ ㈫ ㈬ ㈭ ㈮ ㈯ ㈰ ㈱ ㈲ ㈳ ㈴ ㈵ ㈶ ㈷ ㈸ ㈹ ㈺ ㈻ ㈼ ㈽ ㈾ ㈿ ㉀ ㉁ ㉂ ㉃ ㉠ ㉡ ㉢ ㉣ ㉤ ㉥ ㉦ ㉧ ㉨ ㉩ ㉪ ㉫ ㉬ ㉭ ㉮ ㉯ ㉰ ㉱ ㉲ ㉳ ㉴ ㉵ ㉶ ㉷ ㉸ ㉹ ㉺ ㉻ ㉿ ㊀ ㊁ ㊂ ㊃ ㊄ ㊅ ㊆ ㊇ ㊈ ㊉ ㊊ ㊋ ㊌ ㊍ ㊎ ㊏ ㊐ ㊑ ㊒ ㊓ ㊔ ㊕ ㊖ ㊗ ㊘ ㊙ ㊚ ㊛ ㊜ ㊝ ㊞ ㊟ ㊠ ㊡ ..." + -- CJK Compatibility + printS "㌀ ㌁ ㌂ ㌃ ㌄ ㌅ ㌆ ㌇ ㌈ ㌉ ㌊ ㌋ ㌌ ㌍ ㌎ ㌏ ㌐ ㌑ ㌒ ㌓ ㌔ ㌕ ㌖ ㌗ ㌘ ㌙ ㌚ ㌛ ㌜ ㌝ ㌞ ㌟ ㌠ ㌡ ㌢ ㌣ ㌤ ㌥ ㌦ ㌧ ㌨ ㌩ ㌪ ㌫ ㌬ ㌭ ㌮ ㌯ ㌰ ㌱ ㌲ ㌳ ㌴ ㌵ ㌶ ㌷ ㌸ ㌹ ㌺ ㌻ ㌼ ㌽ ㌾ ㌿ ㍀ ㍁ ㍂ ㍃ ㍄ ㍅ ㍆ ㍇ ㍈ ㍉ ㍊ ㍋ ㍌ ㍍ ㍎ ㍏ ㍐ ㍑ ㍒ ㍓ ㍔ ㍕ ㍖ ㍗ ㍘ ㍙ ㍚ ㍛ ㍜ ㍝ ㍞ ㍟ ㍠ ㍡ ㍢ ㍣ ㍤ ㍥ ㍦ ㍧ ㍨ ㍩ ㍪ ㍫ ㍬ ㍭ ㍮ ㍯ ㍰ ㍱ ㍲ ㍳ ㍴ ㍵ ㍶ ㍻ ㍼ ㍽ ㍾ ㍿ ㎀ ㎁ ㎂ ㎃ ..." + -- CJK Unified Ideographs + printS "一 丁 丂 七 丄 丅 丆 万 丈 三 上 下 丌 不 与 丏 丐 丑 丒 专 且 丕 世 丗 丘 丙 业 丛 东 丝 丞 丟 丠 両 丢 丣 两 严 並 丧 丨 丩 个 丫 丬 中 丮 丯 丰 丱 串 丳 临 丵 丶 丷 丸 丹 为 主 丼 丽 举 丿 乀 乁 乂 乃 乄 久 乆 乇 么 义 乊 之 乌 乍 乎 乏 乐 乑 乒 乓 乔 乕 乖 乗 乘 乙 乚 乛 乜 九 乞 也 习 乡 乢 乣 乤 乥 书 乧 乨 乩 乪 乫 乬 乭 乮 乯 买 乱 乲 乳 乴 乵 乶 乷 乸 乹 乺 乻 乼 乽 乾 乿 ..." + -- Hangul Syllables + printS "가 각 갂 갃 간 갅 갆 갇 갈 갉 갊 갋 갌 갍 갎 갏 감 갑 값 갓 갔 강 갖 갗 갘 같 갚 갛 개 객 갞 갟 갠 갡 갢 갣 갤 갥 갦 갧 갨 갩 갪 갫 갬 갭 갮 갯 갰 갱 갲 갳 갴 갵 갶 갷 갸 갹 갺 갻 갼 갽 갾 갿 걀 걁 걂 걃 걄 걅 걆 걇 걈 걉 걊 걋 걌 걍 걎 걏 걐 걑 걒 걓 걔 걕 걖 걗 걘 걙 걚 걛 걜 걝 걞 걟 걠 걡 걢 걣 걤 걥 걦 걧 걨 걩 걪 걫 걬 걭 걮 걯 거 걱 걲 걳 건 걵 걶 걷 걸 걹 걺 걻 걼 걽 걾 걿 ..." + -- Private Use + printS "                                                                                                                                ..." + -- CJK Compatibility Ideographs + printS "豈 更 車 賈 滑 串 句 龜 龜 契 金 喇 奈 懶 癩 羅 蘿 螺 裸 邏 樂 洛 烙 珞 落 酪 駱 亂 卵 欄 爛 蘭 鸞 嵐 濫 藍 襤 拉 臘 蠟 廊 朗 浪 狼 郎 來 冷 勞 擄 櫓 爐 盧 老 蘆 虜 路 露 魯 鷺 碌 祿 綠 菉 錄 鹿 論 壟 弄 籠 聾 牢 磊 賂 雷 壘 屢 樓 淚 漏 累 縷 陋 勒 肋 凜 凌 稜 綾 菱 陵 讀 拏 樂 諾 丹 寧 怒 率 異 北 磻 便 復 不 泌 數 索 參 塞 省 葉 說 殺 辰 沈 拾 若 掠 略 亮 兩 凉 梁 糧 良 諒 量 勵 ..." + -- Alphabetic Presentation Forms + printS "ff fi fl ffi ffl ſt st ﬓ ﬔ ﬕ ﬖ ﬗ ﬞ ײַ ﬠ ﬡ ﬢ ﬣ ﬤ ﬥ ﬦ ﬧ ﬨ ﬩ שׁ שׂ שּׁ שּׂ אַ אָ אּ בּ גּ דּ הּ וּ זּ טּ יּ ךּ כּ לּ מּ נּ סּ ףּ פּ צּ קּ רּ שּ תּ וֹ בֿ כֿ פֿ ﭏ" + -- Arabic Presentation Forms-A + printS "ﭐ ﭑ ﭒ ﭓ ﭔ ﭕ ﭖ ﭗ ﭘ ﭙ ﭚ ﭛ ﭜ ﭝ ﭞ ﭟ ﭠ ﭡ ﭢ ﭣ ﭤ ﭥ ﭦ ﭧ ﭨ ﭩ ﭪ ﭫ ﭬ ﭭ ﭮ ﭯ ﭰ ﭱ ﭲ ﭳ ﭴ ﭵ ﭶ ﭷ ﭸ ﭹ ﭺ ﭻ ﭼ ﭽ ﭾ ﭿ ﮀ ﮁ ﮂ ﮃ ﮄ ﮅ ﮆ ﮇ ﮈ ﮉ ﮊ ﮋ ﮌ ﮍ ﮎ ﮏ ﮐ ﮑ ﮒ ﮓ ﮔ ﮕ ﮖ ﮗ ﮘ ﮙ ﮚ ﮛ ﮜ ﮝ ﮞ ﮟ ﮠ ﮡ ﮢ ﮣ ﮤ ﮥ ﮦ ﮧ ﮨ ﮩ ﮪ ﮫ ﮬ ﮭ ﮮ ﮯ ﮰ ﮱ ﯓ ﯔ ﯕ ﯖ ﯗ ﯘ ﯙ ﯚ ﯛ ﯜ ﯝ ﯞ ﯟ ﯠ ﯡ ﯢ ﯣ ﯤ ﯥ ﯦ ﯧ ﯨ ﯩ ﯪ ﯫ ﯬ ﯭ ﯮ ﯯ ﯰ ..." + -- Combining Half Marks + printS "︠ ︡ ︢ ︣" + -- CJK Compatibility Forms + printS "︰ ︱ ︲ ︳ ︴ ︵ ︶ ︷ ︸ ︹ ︺ ︻ ︼ ︽ ︾ ︿ ﹀ ﹁ ﹂ ﹃ ﹄ ﹉ ﹊ ﹋ ﹌ ﹍ ﹎ ﹏" + -- Small Form Variants + printS "﹐ ﹑ ﹒ ﹔ ﹕ ﹖ ﹗ ﹘ ﹙ ﹚ ﹛ ﹜ ﹝ ﹞ ﹟ ﹠ ﹡ ﹢ ﹣ ﹤ ﹥ ﹦ ﹨ ﹩ ﹪ ﹫" + -- Arabic Presentation Forms-B + printS "ﹰ ﹱ ﹲ ﹴ ﹶ ﹷ ﹸ ﹹ ﹺ ﹻ ﹼ ﹽ ﹾ ﹿ ﺀ ﺁ ﺂ ﺃ ﺄ ﺅ ﺆ ﺇ ﺈ ﺉ ﺊ ﺋ ﺌ ﺍ ﺎ ﺏ ﺐ ﺑ ﺒ ﺓ ﺔ ﺕ ﺖ ﺗ ﺘ ﺙ ﺚ ﺛ ﺜ ﺝ ﺞ ﺟ ﺠ ﺡ ﺢ ﺣ ﺤ ﺥ ﺦ ﺧ ﺨ ﺩ ﺪ ﺫ ﺬ ﺭ ﺮ ﺯ ﺰ ﺱ ﺲ ﺳ ﺴ ﺵ ﺶ ﺷ ﺸ ﺹ ﺺ ﺻ ﺼ ﺽ ﺾ ﺿ ﻀ ﻁ ﻂ ﻃ ﻄ ﻅ ﻆ ﻇ ﻈ ﻉ ﻊ ﻋ ﻌ ﻍ ﻎ ﻏ ﻐ ﻑ ﻒ ﻓ ﻔ ﻕ ﻖ ﻗ ﻘ ﻙ ﻚ ﻛ ﻜ ﻝ ﻞ ﻟ ﻠ ﻡ ﻢ ﻣ ﻤ ﻥ ﻦ ﻧ ﻨ ﻩ ﻪ ﻫ ﻬ ﻭ ﻮ ﻯ ﻰ ﻱ ..." + -- Halfwidth and Fullwidth Forms + printS "！ ＂ ＃ ＄ ％ ＆ ＇ （ ） ＊ ＋ ， － ． ／ ０ １ ２ ３ ４ ５ ６ ７ ８ ９ ： ； ＜ ＝ ＞ ？ ＠ Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ Ｉ Ｊ Ｋ Ｌ Ｍ Ｎ Ｏ Ｐ Ｑ Ｒ Ｓ Ｔ Ｕ Ｖ Ｗ Ｘ Ｙ Ｚ ［ ＼ ］ ＾ ＿ ｀ ａ ｂ ｃ ｄ ｅ ｆ ｇ ｈ ｉ ｊ ｋ ｌ ｍ ｎ ｏ ｐ ｑ ｒ ｓ ｔ ｕ ｖ ｗ ｘ ｙ ｚ ｛ ｜ ｝ ～ ｡ ｢ ｣ ､ ･ ｦ ｧ ｨ ｩ ｪ ｫ ｬ ｭ ｮ ｯ ｰ ｱ ｲ ｳ ｴ ｵ ｶ ｷ ｸ ｹ ｺ ｻ ｼ ｽ ｾ ｿ ﾀ ﾁ ﾂ ..." + +printS :: String -> Fay () +printS = ffi "console.log(%1)" diff --git a/tests/utf8.js b/tests/utf8.js new file mode 100644 --- /dev/null +++ b/tests/utf8.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){return _(_($62$$62$)(_(printS)(Fay$$list("¡ ¢ £ ¤ ¥ ¦ § ¨ © ª « ¬ ­ ® ¯ ° ± ² ³ ´ µ ¶ · ¸ ¹ º » ¼ ½ ¾ ¿ À Á Â Ã Ä Å Æ Ç È É Ê Ë Ì Í Î Ï Ð Ñ Ò Ó Ô Õ Ö × Ø Ù Ú Û Ü Ý Þ ß à á â ã ä å æ ç è é ê ë ì í î ï ð ñ ò ó ô õ ö ÷ ø ù ú û ü ý þ ÿ"))))(_(_($62$$62$)(_(printS)(Fay$$list("Ā ā Ă ă Ą ą Ć ć Ĉ ĉ Ċ ċ Č č Ď ď Đ đ Ē ē Ĕ ĕ Ė ė Ę ę Ě ě Ĝ ĝ Ğ ğ Ġ ġ Ģ ģ Ĥ ĥ Ħ ħ Ĩ ĩ Ī ī Ĭ ĭ Į į İ ı IJ ij Ĵ ĵ Ķ ķ ĸ Ĺ ĺ Ļ ļ Ľ ľ Ŀ ŀ Ł ł Ń ń Ņ ņ Ň ň ʼn Ŋ ŋ Ō ō Ŏ ŏ Ő ő Œ œ Ŕ ŕ Ŗ ŗ Ř ř Ś ś Ŝ ŝ Ş ş Š š Ţ ţ Ť ť Ŧ ŧ Ũ ũ Ū ū Ŭ ŭ Ů ů Ű ű Ų ų Ŵ ŵ Ŷ ŷ Ÿ Ź ź Ż ż Ž ž ſ"))))(_(_($62$$62$)(_(printS)(Fay$$list("ƀ Ɓ Ƃ ƃ Ƅ ƅ Ɔ Ƈ ƈ Ɖ Ɗ Ƌ ƌ ƍ Ǝ Ə Ɛ Ƒ ƒ Ɠ Ɣ ƕ Ɩ Ɨ Ƙ ƙ ƚ ƛ Ɯ Ɲ ƞ Ɵ Ơ ơ Ƣ ƣ Ƥ ƥ Ʀ Ƨ ƨ Ʃ ƪ ƫ Ƭ ƭ Ʈ Ư ư Ʊ Ʋ Ƴ ƴ Ƶ ƶ Ʒ Ƹ ƹ ƺ ƻ Ƽ ƽ ƾ ƿ ǀ ǁ ǂ ǃ DŽ Dž dž LJ Lj lj NJ Nj nj Ǎ ǎ Ǐ ǐ Ǒ ǒ Ǔ ǔ Ǖ ǖ Ǘ ǘ Ǚ ǚ Ǜ ǜ ǝ Ǟ ǟ Ǡ ǡ Ǣ ǣ Ǥ ǥ Ǧ ǧ Ǩ ǩ Ǫ ǫ Ǭ ǭ Ǯ ǯ ǰ DZ Dz dz Ǵ ǵ Ǻ ǻ Ǽ ǽ Ǿ ǿ Ȁ ȁ Ȃ ȃ ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("ɐ ɑ ɒ ɓ ɔ ɕ ɖ ɗ ɘ ə ɚ ɛ ɜ ɝ ɞ ɟ ɠ ɡ ɢ ɣ ɤ ɥ ɦ ɧ ɨ ɩ ɪ ɫ ɬ ɭ ɮ ɯ ɰ ɱ ɲ ɳ ɴ ɵ ɶ ɷ ɸ ɹ ɺ ɻ ɼ ɽ ɾ ɿ ʀ ʁ ʂ ʃ ʄ ʅ ʆ ʇ ʈ ʉ ʊ ʋ ʌ ʍ ʎ ʏ ʐ ʑ ʒ ʓ ʔ ʕ ʖ ʗ ʘ ʙ ʚ ʛ ʜ ʝ ʞ ʟ ʠ ʡ ʢ ʣ ʤ ʥ ʦ ʧ ʨ"))))(_(_($62$$62$)(_(printS)(Fay$$list("ʰ ʱ ʲ ʳ ʴ ʵ ʶ ʷ ʸ ʹ ʺ ʻ ʼ ʽ ʾ ʿ ˀ ˁ ˂ ˃ ˄ ˅ ˆ ˇ ˈ ˉ ˊ ˋ ˌ ˍ ˎ ˏ ː ˑ ˒ ˓ ˔ ˕ ˖ ˗ ˘ ˙ ˚ ˛ ˜ ˝ ˞ ˠ ˡ ˢ ˣ ˤ ˥ ˦ ˧ ˨ ˩"))))(_(_($62$$62$)(_(printS)(Fay$$list("̀ ́ ̂ ̃ ̄ ̅ ̆ ̇ ̈ ̉ ̊ ̋ ̌ ̍ ̎ ̏ ̐ ̑ ̒ ̓ ̔ ̕ ̖ ̗ ̘ ̙ ̚ ̛ ̜ ̝ ̞ ̟ ̠ ̡ ̢ ̣ ̤ ̥ ̦ ̧ ̨ ̩ ̪ ̫ ̬ ̭ ̮ ̯ ̰ ̱ ̲ ̳ ̴ ̵ ̶ ̷ ̸ ̹ ̺ ̻ ̼ ̽ ̾ ̿ ̀ ́ ͂ ̓ ̈́ ͅ ͠ ͡"))))(_(_($62$$62$)(_(printS)(Fay$$list("ʹ ͵ ͺ ; ΄ ΅ Ά · Έ Ή Ί Ό Ύ Ώ ΐ Α Β Γ Δ Ε Ζ Η Θ Ι Κ Λ Μ Ν Ξ Ο Π Ρ Σ Τ Υ Φ Χ Ψ Ω Ϊ Ϋ ά έ ή ί ΰ α β γ δ ε ζ η θ ι κ λ μ ν ξ ο π ρ ς σ τ υ φ χ ψ ω ϊ ϋ ό ύ ώ ϐ ϑ ϒ ϓ ϔ ϕ ϖ Ϛ Ϝ Ϟ Ϡ Ϣ ϣ Ϥ ϥ Ϧ ϧ Ϩ ϩ Ϫ ϫ Ϭ ϭ Ϯ ϯ ϰ ϱ ϲ ϳ"))))(_(_($62$$62$)(_(printS)(Fay$$list("Ё Ђ Ѓ Є Ѕ І Ї Ј Љ Њ Ћ Ќ Ў Џ А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ъ Ы Ь Э Ю Я а б в г д е ж з и й к л м н о п р с т у ф х ц ч ш щ ъ ы ь э ю я ё ђ ѓ є ѕ і ї ј љ њ ћ ќ ў џ Ѡ ѡ Ѣ ѣ Ѥ ѥ Ѧ ѧ Ѩ ѩ Ѫ ѫ Ѭ ѭ Ѯ ѯ Ѱ ѱ Ѳ ѳ Ѵ ѵ Ѷ ѷ Ѹ ѹ Ѻ ѻ Ѽ ѽ Ѿ ѿ Ҁ ҁ ҂ ҃ ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("Ա Բ Գ Դ Ե Զ Է Ը Թ Ժ Ի Լ Խ Ծ Կ Հ Ձ Ղ Ճ Մ Յ Ն Շ Ո Չ Պ Ջ Ռ Ս Վ Տ Ր Ց Ւ Փ Ք Օ Ֆ ՙ ՚ ՛ ՜ ՝ ՞ ՟ ա բ գ դ ե զ է ը թ ժ ի լ խ ծ կ հ ձ ղ ճ մ յ ն շ ո չ պ ջ ռ ս վ տ ր ց ւ փ ք օ ֆ և ։"))))(_(_($62$$62$)(_(printS)(Fay$$list("֑ ֒ ֓ ֔ ֕ ֖ ֗ ֘ ֙ ֚ ֛ ֜ ֝ ֞ ֟ ֠ ֡ ֣ ֤ ֥ ֦ ֧ ֨ ֩ ֪ ֫ ֬ ֭ ֮ ֯ ְ ֱ ֲ ֳ ִ ֵ ֶ ַ ָ ֹ ֻ ּ ֽ ־ ֿ ׀ ׁ ׂ ׃ ׄ א ב ג ד ה ו ז ח ט י ך כ ל ם מ ן נ ס ע ף פ ץ צ ק ר ש ת װ ױ ײ ׳ ״"))))(_(_($62$$62$)(_(printS)(Fay$$list("، ؛ ؟ ء آ أ ؤ إ ئ ا ب ة ت ث ج ح خ د ذ ر ز س ش ص ض ط ظ ع غ ـ ف ق ك ل م ن ه و ى ي ً ٌ ٍ َ ُ ِ ّ ْ ٠ ١ ٢ ٣ ٤ ٥ ٦ ٧ ٨ ٩ ٪ ٫ ٬ ٭ ٰ ٱ ٲ ٳ ٴ ٵ ٶ ٷ ٸ ٹ ٺ ٻ ټ ٽ پ ٿ ڀ ځ ڂ ڃ ڄ څ چ ڇ ڈ ډ ڊ ڋ ڌ ڍ ڎ ڏ ڐ ڑ ڒ ړ ڔ ڕ ږ ڗ ژ ڙ ښ ڛ ڜ ڝ ڞ ڟ ڠ ڡ ڢ ڣ ڤ ڥ ڦ ڧ ڨ ک ڪ ګ ڬ ڭ ڮ گ ڰ ڱ ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("ँ ं ः अ आ इ ई उ ऊ ऋ ऌ ऍ ऎ ए ऐ ऑ ऒ ओ औ क ख ग घ ङ च छ ज झ ञ ट ठ ड ढ ण त थ द ध न ऩ प फ ब भ म य र ऱ ल ळ ऴ व श ष स ह ़ ऽ ा ि ी ु ू ृ ॄ ॅ ॆ े ै ॉ ॊ ो ौ ् ॐ ॑ ॒ ॓ ॔ क़ ख़ ग़ ज़ ड़ ढ़ फ़ य़ ॠ ॡ ॢ ॣ । ॥ ० १ २ ३ ४ ५ ६ ७ ८ ९ ॰"))))(_(_($62$$62$)(_(printS)(Fay$$list("ঁ ং ঃ অ আ ই ঈ উ ঊ ঋ ঌ এ ঐ ও ঔ ক খ গ ঘ ঙ চ ছ জ ঝ ঞ ট ঠ ড ঢ ণ ত থ দ ধ ন প ফ ব ভ ম য র ল শ ষ স হ ় া ি ী ু ূ ৃ ৄ ে ৈ ো ৌ ্ ৗ ড় ঢ় য় ৠ ৡ ৢ ৣ ০ ১ ২ ৩ ৪ ৫ ৬ ৭ ৮ ৯ ৰ ৱ ৲ ৳ ৴ ৵ ৶ ৷ ৸ ৹ ৺"))))(_(_($62$$62$)(_(printS)(Fay$$list("ਂ ਅ ਆ ਇ ਈ ਉ ਊ ਏ ਐ ਓ ਔ ਕ ਖ ਗ ਘ ਙ ਚ ਛ ਜ ਝ ਞ ਟ ਠ ਡ ਢ ਣ ਤ ਥ ਦ ਧ ਨ ਪ ਫ ਬ ਭ ਮ ਯ ਰ ਲ ਲ਼ ਵ ਸ਼ ਸ ਹ ਼ ਾ ਿ ੀ ੁ ੂ ੇ ੈ ੋ ੌ ੍ ਖ਼ ਗ਼ ਜ਼ ੜ ਫ਼ ੦ ੧ ੨ ੩ ੪ ੫ ੬ ੭ ੮ ੯ ੰ ੱ ੲ ੳ ੴ"))))(_(_($62$$62$)(_(printS)(Fay$$list("ઁ ં ઃ અ આ ઇ ઈ ઉ ઊ ઋ ઍ એ ઐ ઑ ઓ ઔ ક ખ ગ ઘ ઙ ચ છ જ ઝ ઞ ટ ઠ ડ ઢ ણ ત થ દ ધ ન પ ફ બ ભ મ ય ર લ ળ વ શ ષ સ હ ઼ ઽ ા િ ી ુ ૂ ૃ ૄ ૅ ે ૈ ૉ ો ૌ ્ ૐ ૠ ૦ ૧ ૨ ૩ ૪ ૫ ૬ ૭ ૮ ૯"))))(_(_($62$$62$)(_(printS)(Fay$$list("ଁ ଂ ଃ ଅ ଆ ଇ ଈ ଉ ଊ ଋ ଌ ଏ ଐ ଓ ଔ କ ଖ ଗ ଘ ଙ ଚ ଛ ଜ ଝ ଞ ଟ ଠ ଡ ଢ ଣ ତ ଥ ଦ ଧ ନ ପ ଫ ବ ଭ ମ ଯ ର ଲ ଳ ଶ ଷ ସ ହ ଼ ଽ ା ି ୀ ୁ ୂ ୃ େ ୈ ୋ ୌ ୍ ୖ ୗ ଡ଼ ଢ଼ ୟ ୠ ୡ ୦ ୧ ୨ ୩ ୪ ୫ ୬ ୭ ୮ ୯ ୰"))))(_(_($62$$62$)(_(printS)(Fay$$list("ஂ ஃ அ ஆ இ ஈ உ ஊ எ ஏ ஐ ஒ ஓ ஔ க ங ச ஜ ஞ ட ண த ந ன ப ம ய ர ற ல ள ழ வ ஷ ஸ ஹ ா ி ீ ு ூ ெ ே ை ொ ோ ௌ ் ௗ ௧ ௨ ௩ ௪ ௫ ௬ ௭ ௮ ௯ ௰ ௱ ௲"))))(_(_($62$$62$)(_(printS)(Fay$$list("ఁ ం ః అ ఆ ఇ ఈ ఉ ఊ ఋ ఌ ఎ ఏ ఐ ఒ ఓ ఔ క ఖ గ ఘ ఙ చ ఛ జ ఝ ఞ ట ఠ డ ఢ ణ త థ ద ధ న ప ఫ బ భ మ య ర ఱ ల ళ వ శ ష స హ ా ి ీ ు ూ ృ ౄ ె ే ై ొ ో ౌ ్ ౕ ౖ ౠ ౡ ౦ ౧ ౨ ౩ ౪ ౫ ౬ ౭ ౮ ౯"))))(_(_($62$$62$)(_(printS)(Fay$$list("ಂ ಃ ಅ ಆ ಇ ಈ ಉ ಊ ಋ ಌ ಎ ಏ ಐ ಒ ಓ ಔ ಕ ಖ ಗ ಘ ಙ ಚ ಛ ಜ ಝ ಞ ಟ ಠ ಡ ಢ ಣ ತ ಥ ದ ಧ ನ ಪ ಫ ಬ ಭ ಮ ಯ ರ ಱ ಲ ಳ ವ ಶ ಷ ಸ ಹ ಾ ಿ ೀ ು ೂ ೃ ೄ ೆ ೇ ೈ ೊ ೋ ೌ ್ ೕ ೖ ೞ ೠ ೡ ೦ ೧ ೨ ೩ ೪ ೫ ೬ ೭ ೮ ೯"))))(_(_($62$$62$)(_(printS)(Fay$$list("ം ഃ അ ആ ഇ ഈ ഉ ഊ ഋ ഌ എ ഏ ഐ ഒ ഓ ഔ ക ഖ ഗ ഘ ങ ച ഛ ജ ഝ ഞ ട ഠ ഡ ഢ ണ ത ഥ ദ ധ ന പ ഫ ബ ഭ മ യ ര റ ല ള ഴ വ ശ ഷ സ ഹ ാ ി ീ ു ൂ ൃ െ േ ൈ ൊ ോ ൌ ് ൗ ൠ ൡ ൦ ൧ ൨ ൩ ൪ ൫ ൬ ൭ ൮ ൯"))))(_(_($62$$62$)(_(printS)(Fay$$list("ก ข ฃ ค ฅ ฆ ง จ ฉ ช ซ ฌ ญ ฎ ฏ ฐ ฑ ฒ ณ ด ต ถ ท ธ น บ ป ผ ฝ พ ฟ ภ ม ย ร ฤ ล ฦ ว ศ ษ ส ห ฬ อ ฮ ฯ ะ ั า ำ ิ ี ึ ื ุ ู ฺ ฿ เ แ โ ใ ไ ๅ ๆ ็ ่ ้ ๊ ๋ ์ ํ ๎ ๏ ๐ ๑ ๒ ๓ ๔ ๕ ๖ ๗ ๘ ๙ ๚ ๛"))))(_(_($62$$62$)(_(printS)(Fay$$list("ກ ຂ ຄ ງ ຈ ຊ ຍ ດ ຕ ຖ ທ ນ ບ ປ ຜ ຝ ພ ຟ ມ ຢ ຣ ລ ວ ສ ຫ ອ ຮ ຯ ະ ັ າ ຳ ິ ີ ຶ ື ຸ ູ ົ ຼ ຽ ເ ແ ໂ ໃ ໄ ໆ ່ ້ ໊ ໋ ໌ ໍ ໐ ໑ ໒ ໓ ໔ ໕ ໖ ໗ ໘ ໙ ໜ ໝ"))))(_(_($62$$62$)(_(printS)(Fay$$list("ༀ ༁ ༂ ༃ ༄ ༅ ༆ ༇ ༈ ༉ ༊ ་ ༌ ། ༎ ༏ ༐ ༑ ༒ ༓ ༔ ༕ ༖ ༗ ༘ ༙ ༚ ༛ ༜ ༝ ༞ ༟ ༠ ༡ ༢ ༣ ༤ ༥ ༦ ༧ ༨ ༩ ༪ ༫ ༬ ༭ ༮ ༯ ༰ ༱ ༲ ༳ ༴ ༵ ༶ ༷ ༸ ༹ ༺ ༻ ༼ ༽ ༾ ༿ ཀ ཁ ག གྷ ང ཅ ཆ ཇ ཉ ཊ ཋ ཌ ཌྷ ཎ ཏ ཐ ད དྷ ན པ ཕ བ བྷ མ ཙ ཚ ཛ ཛྷ ཝ ཞ ཟ འ ཡ ར ལ ཤ ཥ ས ཧ ཨ ཀྵ ཱ ི ཱི ུ ཱུ ྲྀ ཷ ླྀ ཹ ེ ཻ ོ ཽ ཾ ཿ ྀ ཱྀ ྂ ྃ ྄ ྅ ྆ ྇ ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("Ⴀ Ⴁ Ⴂ Ⴃ Ⴄ Ⴅ Ⴆ Ⴇ Ⴈ Ⴉ Ⴊ Ⴋ Ⴌ Ⴍ Ⴎ Ⴏ Ⴐ Ⴑ Ⴒ Ⴓ Ⴔ Ⴕ Ⴖ Ⴗ Ⴘ Ⴙ Ⴚ Ⴛ Ⴜ Ⴝ Ⴞ Ⴟ Ⴠ Ⴡ Ⴢ Ⴣ Ⴤ Ⴥ ა ბ გ დ ე ვ ზ თ ი კ ლ მ ნ ო პ ჟ რ ს ტ უ ფ ქ ღ ყ შ ჩ ც ძ წ ჭ ხ ჯ ჰ ჱ ჲ ჳ ჴ ჵ ჶ ჻"))))(_(_($62$$62$)(_(printS)(Fay$$list("ᄀ ᄁ ᄂ ᄃ ᄄ ᄅ ᄆ ᄇ ᄈ ᄉ ᄊ ᄋ ᄌ ᄍ ᄎ ᄏ ᄐ ᄑ ᄒ ᄓ ᄔ ᄕ ᄖ ᄗ ᄘ ᄙ ᄚ ᄛ ᄜ ᄝ ᄞ ᄟ ᄠ ᄡ ᄢ ᄣ ᄤ ᄥ ᄦ ᄧ ᄨ ᄩ ᄪ ᄫ ᄬ ᄭ ᄮ ᄯ ᄰ ᄱ ᄲ ᄳ ᄴ ᄵ ᄶ ᄷ ᄸ ᄹ ᄺ ᄻ ᄼ ᄽ ᄾ ᄿ ᅀ ᅁ ᅂ ᅃ ᅄ ᅅ ᅆ ᅇ ᅈ ᅉ ᅊ ᅋ ᅌ ᅍ ᅎ ᅏ ᅐ ᅑ ᅒ ᅓ ᅔ ᅕ ᅖ ᅗ ᅘ ᅙ ᅟ ᅠ ᅡ ᅢ ᅣ ᅤ ᅥ ᅦ ᅧ ᅨ ᅩ ᅪ ᅫ ᅬ ᅭ ᅮ ᅯ ᅰ ᅱ ᅲ ᅳ ᅴ ᅵ ᅶ ᅷ ᅸ ᅹ ᅺ ᅻ ᅼ ᅽ ᅾ ᅿ ᆀ ᆁ ᆂ ᆃ ᆄ ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("Ḁ ḁ Ḃ ḃ Ḅ ḅ Ḇ ḇ Ḉ ḉ Ḋ ḋ Ḍ ḍ Ḏ ḏ Ḑ ḑ Ḓ ḓ Ḕ ḕ Ḗ ḗ Ḙ ḙ Ḛ ḛ Ḝ ḝ Ḟ ḟ Ḡ ḡ Ḣ ḣ Ḥ ḥ Ḧ ḧ Ḩ ḩ Ḫ ḫ Ḭ ḭ Ḯ ḯ Ḱ ḱ Ḳ ḳ Ḵ ḵ Ḷ ḷ Ḹ ḹ Ḻ ḻ Ḽ ḽ Ḿ ḿ Ṁ ṁ Ṃ ṃ Ṅ ṅ Ṇ ṇ Ṉ ṉ Ṋ ṋ Ṍ ṍ Ṏ ṏ Ṑ ṑ Ṓ ṓ Ṕ ṕ Ṗ ṗ Ṙ ṙ Ṛ ṛ Ṝ ṝ Ṟ ṟ Ṡ ṡ Ṣ ṣ Ṥ ṥ Ṧ ṧ Ṩ ṩ Ṫ ṫ Ṭ ṭ Ṯ ṯ Ṱ ṱ Ṳ ṳ Ṵ ṵ Ṷ ṷ Ṹ ṹ Ṻ ṻ Ṽ ṽ Ṿ ṿ ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("ἀ ἁ ἂ ἃ ἄ ἅ ἆ ἇ Ἀ Ἁ Ἂ Ἃ Ἄ Ἅ Ἆ Ἇ ἐ ἑ ἒ ἓ ἔ ἕ Ἐ Ἑ Ἒ Ἓ Ἔ Ἕ ἠ ἡ ἢ ἣ ἤ ἥ ἦ ἧ Ἠ Ἡ Ἢ Ἣ Ἤ Ἥ Ἦ Ἧ ἰ ἱ ἲ ἳ ἴ ἵ ἶ ἷ Ἰ Ἱ Ἲ Ἳ Ἴ Ἵ Ἶ Ἷ ὀ ὁ ὂ ὃ ὄ ὅ Ὀ Ὁ Ὂ Ὃ Ὄ Ὅ ὐ ὑ ὒ ὓ ὔ ὕ ὖ ὗ Ὑ Ὓ Ὕ Ὗ ὠ ὡ ὢ ὣ ὤ ὥ ὦ ὧ Ὠ Ὡ Ὢ Ὣ Ὤ Ὥ Ὦ Ὧ ὰ ά ὲ έ ὴ ή ὶ ί ὸ ό ὺ ύ ὼ ώ ᾀ ᾁ ᾂ ᾃ ᾄ ᾅ ᾆ ᾇ ᾈ ᾉ ᾊ ᾋ ᾌ ᾍ ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("‐ ‑ ‒ – — ― ‖ ‗ ‘ ’ ‚ ‛ “ ” „ ‟"))))(_(_($62$$62$)(_(printS)(Fay$$list("⁰ ⁴ ⁵ ⁶ ⁷ ⁸ ⁹ ⁺ ⁻ ⁼ ⁽ ⁾ ⁿ ₀ ₁ ₂ ₃ ₄ ₅ ₆ ₇ ₈ ₉ ₊ ₋ ₌ ₍ ₎"))))(_(_($62$$62$)(_(printS)(Fay$$list("₠ ₡ ₢ ₣ ₤ ₥ ₦ ₧ ₨ ₩ ₪ ₫"))))(_(_($62$$62$)(_(printS)(Fay$$list("⃐ ⃑ ⃒ ⃓ ⃔ ⃕ ⃖ ⃗ ⃘ ⃙ ⃚ ⃛ ⃜ ⃝ ⃞ ⃟ ⃠ ⃡"))))(_(_($62$$62$)(_(printS)(Fay$$list("℀ ℁ ℂ ℃ ℄ ℅ ℆ ℇ ℈ ℉ ℊ ℋ ℌ ℍ ℎ ℏ ℐ ℑ ℒ ℓ ℔ ℕ № ℗ ℘ ℙ ℚ ℛ ℜ ℝ ℞ ℟ ℠ ℡ ™ ℣ ℤ ℥ Ω ℧ ℨ ℩ K Å ℬ ℭ ℮ ℯ ℰ ℱ Ⅎ ℳ ℴ ℵ ℶ ℷ ℸ"))))(_(_($62$$62$)(_(printS)(Fay$$list("⅓ ⅔ ⅕ ⅖ ⅗ ⅘ ⅙ ⅚ ⅛ ⅜ ⅝ ⅞ ⅟ Ⅰ Ⅱ Ⅲ Ⅳ Ⅴ Ⅵ Ⅶ Ⅷ Ⅸ Ⅹ Ⅺ Ⅻ Ⅼ Ⅽ Ⅾ Ⅿ ⅰ ⅱ ⅲ ⅳ ⅴ ⅵ ⅶ ⅷ ⅸ ⅹ ⅺ ⅻ ⅼ ⅽ ⅾ ⅿ ↀ ↁ ↂ"))))(_(_($62$$62$)(_(printS)(Fay$$list("← ↑ → ↓ ↔ ↕ ↖ ↗ ↘ ↙ ↚ ↛ ↜ ↝ ↞ ↟ ↠ ↡ ↢ ↣ ↤ ↥ ↦ ↧ ↨ ↩ ↪ ↫ ↬ ↭ ↮ ↯ ↰ ↱ ↲ ↳ ↴ ↵ ↶ ↷ ↸ ↹ ↺ ↻ ↼ ↽ ↾ ↿ ⇀ ⇁ ⇂ ⇃ ⇄ ⇅ ⇆ ⇇ ⇈ ⇉ ⇊ ⇋ ⇌ ⇍ ⇎ ⇏ ⇐ ⇑ ⇒ ⇓ ⇔ ⇕ ⇖ ⇗ ⇘ ⇙ ⇚ ⇛ ⇜ ⇝ ⇞ ⇟ ⇠ ⇡ ⇢ ⇣ ⇤ ⇥ ⇦ ⇧ ⇨ ⇩ ⇪"))))(_(_($62$$62$)(_(printS)(Fay$$list("∀ ∁ ∂ ∃ ∄ ∅ ∆ ∇ ∈ ∉ ∊ ∋ ∌ ∍ ∎ ∏ ∐ ∑ − ∓ ∔ ∕ ∖ ∗ ∘ ∙ √ ∛ ∜ ∝ ∞ ∟ ∠ ∡ ∢ ∣ ∤ ∥ ∦ ∧ ∨ ∩ ∪ ∫ ∬ ∭ ∮ ∯ ∰ ∱ ∲ ∳ ∴ ∵ ∶ ∷ ∸ ∹ ∺ ∻ ∼ ∽ ∾ ∿ ≀ ≁ ≂ ≃ ≄ ≅ ≆ ≇ ≈ ≉ ≊ ≋ ≌ ≍ ≎ ≏ ≐ ≑ ≒ ≓ ≔ ≕ ≖ ≗ ≘ ≙ ≚ ≛ ≜ ≝ ≞ ≟ ≠ ≡ ≢ ≣ ≤ ≥ ≦ ≧ ≨ ≩ ≪ ≫ ≬ ≭ ≮ ≯ ≰ ≱ ≲ ≳ ≴ ≵ ≶ ≷ ≸ ≹ ≺ ≻ ≼ ≽ ≾ ≿ ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("⌀ ⌂ ⌃ ⌄ ⌅ ⌆ ⌇ ⌈ ⌉ ⌊ ⌋ ⌌ ⌍ ⌎ ⌏ ⌐ ⌑ ⌒ ⌓ ⌔ ⌕ ⌖ ⌗ ⌘ ⌙ ⌚ ⌛ ⌜ ⌝ ⌞ ⌟ ⌠ ⌡ ⌢ ⌣ ⌤ ⌥ ⌦ ⌧ ⌨ 〈 〉 ⌫ ⌬ ⌭ ⌮ ⌯ ⌰ ⌱ ⌲ ⌳ ⌴ ⌵ ⌶ ⌷ ⌸ ⌹ ⌺ ⌻ ⌼ ⌽ ⌾ ⌿ ⍀ ⍁ ⍂ ⍃ ⍄ ⍅ ⍆ ⍇ ⍈ ⍉ ⍊ ⍋ ⍌ ⍍ ⍎ ⍏ ⍐ ⍑ ⍒ ⍓ ⍔ ⍕ ⍖ ⍗ ⍘ ⍙ ⍚ ⍛ ⍜ ⍝ ⍞ ⍟ ⍠ ⍡ ⍢ ⍣ ⍤ ⍥ ⍦ ⍧ ⍨ ⍩ ⍪ ⍫ ⍬ ⍭ ⍮ ⍯ ⍰ ⍱ ⍲ ⍳ ⍴ ⍵ ⍶ ⍷ ⍸ ⍹ ⍺"))))(_(_($62$$62$)(_(printS)(Fay$$list("␀ ␁ ␂ ␃ ␄ ␅ ␆ ␇ ␈ ␉ ␊ ␋ ␌ ␍ ␎ ␏ ␐ ␑ ␒ ␓ ␔ ␕ ␖ ␗ ␘ ␙ ␚ ␛ ␜ ␝ ␞ ␟ ␠ ␡ ␢ ␣ ␤"))))(_(_($62$$62$)(_(printS)(Fay$$list("⑀ ⑁ ⑂ ⑃ ⑄ ⑅ ⑆ ⑇ ⑈ ⑉ ⑊"))))(_(_($62$$62$)(_(printS)(Fay$$list("① ② ③ ④ ⑤ ⑥ ⑦ ⑧ ⑨ ⑩ ⑪ ⑫ ⑬ ⑭ ⑮ ⑯ ⑰ ⑱ ⑲ ⑳ ⑴ ⑵ ⑶ ⑷ ⑸ ⑹ ⑺ ⑻ ⑼ ⑽ ⑾ ⑿ ⒀ ⒁ ⒂ ⒃ ⒄ ⒅ ⒆ ⒇ ⒈ ⒉ ⒊ ⒋ ⒌ ⒍ ⒎ ⒏ ⒐ ⒑ ⒒ ⒓ ⒔ ⒕ ⒖ ⒗ ⒘ ⒙ ⒚ ⒛ ⒜ ⒝ ⒞ ⒟ ⒠ ⒡ ⒢ ⒣ ⒤ ⒥ ⒦ ⒧ ⒨ ⒩ ⒪ ⒫ ⒬ ⒭ ⒮ ⒯ ⒰ ⒱ ⒲ ⒳ ⒴ ⒵ Ⓐ Ⓑ Ⓒ Ⓓ Ⓔ Ⓕ Ⓖ Ⓗ Ⓘ Ⓙ Ⓚ Ⓛ Ⓜ Ⓝ Ⓞ Ⓟ Ⓠ Ⓡ Ⓢ Ⓣ Ⓤ Ⓥ Ⓦ Ⓧ Ⓨ Ⓩ ⓐ ⓑ ⓒ ⓓ ⓔ ⓕ ⓖ ⓗ ⓘ ⓙ ⓚ ⓛ ⓜ ⓝ ⓞ ⓟ ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("─ ━ │ ┃ ┄ ┅ ┆ ┇ ┈ ┉ ┊ ┋ ┌ ┍ ┎ ┏ ┐ ┑ ┒ ┓ └ ┕ ┖ ┗ ┘ ┙ ┚ ┛ ├ ┝ ┞ ┟ ┠ ┡ ┢ ┣ ┤ ┥ ┦ ┧ ┨ ┩ ┪ ┫ ┬ ┭ ┮ ┯ ┰ ┱ ┲ ┳ ┴ ┵ ┶ ┷ ┸ ┹ ┺ ┻ ┼ ┽ ┾ ┿ ╀ ╁ ╂ ╃ ╄ ╅ ╆ ╇ ╈ ╉ ╊ ╋ ╌ ╍ ╎ ╏ ═ ║ ╒ ╓ ╔ ╕ ╖ ╗ ╘ ╙ ╚ ╛ ╜ ╝ ╞ ╟ ╠ ╡ ╢ ╣ ╤ ╥ ╦ ╧ ╨ ╩ ╪ ╫ ╬ ╭ ╮ ╯ ╰ ╱ ╲ ╳ ╴ ╵ ╶ ╷ ╸ ╹ ╺ ╻ ╼ ╽ ╾ ╿"))))(_(_($62$$62$)(_(printS)(Fay$$list("▀ ▁ ▂ ▃ ▄ ▅ ▆ ▇ █ ▉ ▊ ▋ ▌ ▍ ▎ ▏ ▐ ░ ▒ ▓ ▔ ▕"))))(_(_($62$$62$)(_(printS)(Fay$$list("■ □ ▢ ▣ ▤ ▥ ▦ ▧ ▨ ▩ ▪ ▫ ▬ ▭ ▮ ▯ ▰ ▱ ▲ △ ▴ ▵ ▶ ▷ ▸ ▹ ► ▻ ▼ ▽ ▾ ▿ ◀ ◁ ◂ ◃ ◄ ◅ ◆ ◇ ◈ ◉ ◊ ○ ◌ ◍ ◎ ● ◐ ◑ ◒ ◓ ◔ ◕ ◖ ◗ ◘ ◙ ◚ ◛ ◜ ◝ ◞ ◟ ◠ ◡ ◢ ◣ ◤ ◥ ◦ ◧ ◨ ◩ ◪ ◫ ◬ ◭ ◮ ◯"))))(_(_($62$$62$)(_(printS)(Fay$$list("☀ ☁ ☂ ☃ ☄ ★ ☆ ☇ ☈ ☉ ☊ ☋ ☌ ☍ ☎ ☏ ☐ ☑ ☒ ☓ ☚ ☛ ☜ ☝ ☞ ☟ ☠ ☡ ☢ ☣ ☤ ☥ ☦ ☧ ☨ ☩ ☪ ☫ ☬ ☭ ☮ ☯ ☰ ☱ ☲ ☳ ☴ ☵ ☶ ☷ ☸ ☹ ☺ ☻ ☼ ☽ ☾ ☿ ♀ ♁ ♂ ♃ ♄ ♅ ♆ ♇ ♈ ♉ ♊ ♋ ♌ ♍ ♎ ♏ ♐ ♑ ♒ ♓ ♔ ♕ ♖ ♗ ♘ ♙ ♚ ♛ ♜ ♝ ♞ ♟ ♠ ♡ ♢ ♣ ♤ ♥ ♦ ♧ ♨ ♩ ♪ ♫ ♬ ♭ ♮ ♯"))))(_(_($62$$62$)(_(printS)(Fay$$list("✁ ✂ ✃ ✄ ✆ ✇ ✈ ✉ ✌ ✍ ✎ ✏ ✐ ✑ ✒ ✓ ✔ ✕ ✖ ✗ ✘ ✙ ✚ ✛ ✜ ✝ ✞ ✟ ✠ ✡ ✢ ✣ ✤ ✥ ✦ ✧ ✩ ✪ ✫ ✬ ✭ ✮ ✯ ✰ ✱ ✲ ✳ ✴ ✵ ✶ ✷ ✸ ✹ ✺ ✻ ✼ ✽ ✾ ✿ ❀ ❁ ❂ ❃ ❄ ❅ ❆ ❇ ❈ ❉ ❊ ❋ ❍ ❏ ❐ ❑ ❒ ❖ ❘ ❙ ❚ ❛ ❜ ❝ ❞ ❡ ❢ ❣ ❤ ❥ ❦ ❧ ❶ ❷ ❸ ❹ ❺ ❻ ❼ ❽ ❾ ❿ ➀ ➁ ➂ ➃ ➄ ➅ ➆ ➇ ➈ ➉ ➊ ➋ ➌ ➍ ➎ ➏ ➐ ➑ ➒ ➓ ➔ ➘ ➙ ➚ ➛ ➜ ➝ ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("　 、 。 〃 〄 々 〆 〇 〈 〉 《 》 「 」 『 』 【 】 〒 〓 〔 〕 〖 〗 〘 〙 〚 〛 〜 〝 〞 〟 〠 〡 〢 〣 〤 〥 〦 〧 〨 〩 〪 〫 〬 〭 〮 〯 〰 〱 〲 〳 〴 〵 〶 〷 〿"))))(_(_($62$$62$)(_(printS)(Fay$$list("ぁ あ ぃ い ぅ う ぇ え ぉ お か が き ぎ く ぐ け げ こ ご さ ざ し じ す ず せ ぜ そ ぞ た だ ち ぢ っ つ づ て で と ど な に ぬ ね の は ば ぱ ひ び ぴ ふ ぶ ぷ へ べ ぺ ほ ぼ ぽ ま み む め も ゃ や ゅ ゆ ょ よ ら り る れ ろ ゎ わ ゐ ゑ を ん ゔ ゙ ゚ ゛ ゜ ゝ ゞ"))))(_(_($62$$62$)(_(printS)(Fay$$list("ァ ア ィ イ ゥ ウ ェ エ ォ オ カ ガ キ ギ ク グ ケ ゲ コ ゴ サ ザ シ ジ ス ズ セ ゼ ソ ゾ タ ダ チ ヂ ッ ツ ヅ テ デ ト ド ナ ニ ヌ ネ ノ ハ バ パ ヒ ビ ピ フ ブ プ ヘ ベ ペ ホ ボ ポ マ ミ ム メ モ ャ ヤ ュ ユ ョ ヨ ラ リ ル レ ロ ヮ ワ ヰ ヱ ヲ ン ヴ ヵ ヶ ヷ ヸ ヹ ヺ ・ ー ヽ ヾ"))))(_(_($62$$62$)(_(printS)(Fay$$list("ㄅ ㄆ ㄇ ㄈ ㄉ ㄊ ㄋ ㄌ ㄍ ㄎ ㄏ ㄐ ㄑ ㄒ ㄓ ㄔ ㄕ ㄖ ㄗ ㄘ ㄙ ㄚ ㄛ ㄜ ㄝ ㄞ ㄟ ㄠ ㄡ ㄢ ㄣ ㄤ ㄥ ㄦ ㄧ ㄨ ㄩ ㄪ ㄫ ㄬ"))))(_(_($62$$62$)(_(printS)(Fay$$list("ㄱ ㄲ ㄳ ㄴ ㄵ ㄶ ㄷ ㄸ ㄹ ㄺ ㄻ ㄼ ㄽ ㄾ ㄿ ㅀ ㅁ ㅂ ㅃ ㅄ ㅅ ㅆ ㅇ ㅈ ㅉ ㅊ ㅋ ㅌ ㅍ ㅎ ㅏ ㅐ ㅑ ㅒ ㅓ ㅔ ㅕ ㅖ ㅗ ㅘ ㅙ ㅚ ㅛ ㅜ ㅝ ㅞ ㅟ ㅠ ㅡ ㅢ ㅣ ㅤ ㅥ ㅦ ㅧ ㅨ ㅩ ㅪ ㅫ ㅬ ㅭ ㅮ ㅯ ㅰ ㅱ ㅲ ㅳ ㅴ ㅵ ㅶ ㅷ ㅸ ㅹ ㅺ ㅻ ㅼ ㅽ ㅾ ㅿ ㆀ ㆁ ㆂ ㆃ ㆄ ㆅ ㆆ ㆇ ㆈ ㆉ ㆊ ㆋ ㆌ ㆍ ㆎ"))))(_(_($62$$62$)(_(printS)(Fay$$list("㆐ ㆑ ㆒ ㆓ ㆔ ㆕ ㆖ ㆗ ㆘ ㆙ ㆚ ㆛ ㆜ ㆝ ㆞ ㆟"))))(_(_($62$$62$)(_(printS)(Fay$$list("㈀ ㈁ ㈂ ㈃ ㈄ ㈅ ㈆ ㈇ ㈈ ㈉ ㈊ ㈋ ㈌ ㈍ ㈎ ㈏ ㈐ ㈑ ㈒ ㈓ ㈔ ㈕ ㈖ ㈗ ㈘ ㈙ ㈚ ㈛ ㈜ ㈠ ㈡ ㈢ ㈣ ㈤ ㈥ ㈦ ㈧ ㈨ ㈩ ㈪ ㈫ ㈬ ㈭ ㈮ ㈯ ㈰ ㈱ ㈲ ㈳ ㈴ ㈵ ㈶ ㈷ ㈸ ㈹ ㈺ ㈻ ㈼ ㈽ ㈾ ㈿ ㉀ ㉁ ㉂ ㉃ ㉠ ㉡ ㉢ ㉣ ㉤ ㉥ ㉦ ㉧ ㉨ ㉩ ㉪ ㉫ ㉬ ㉭ ㉮ ㉯ ㉰ ㉱ ㉲ ㉳ ㉴ ㉵ ㉶ ㉷ ㉸ ㉹ ㉺ ㉻ ㉿ ㊀ ㊁ ㊂ ㊃ ㊄ ㊅ ㊆ ㊇ ㊈ ㊉ ㊊ ㊋ ㊌ ㊍ ㊎ ㊏ ㊐ ㊑ ㊒ ㊓ ㊔ ㊕ ㊖ ㊗ ㊘ ㊙ ㊚ ㊛ ㊜ ㊝ ㊞ ㊟ ㊠ ㊡ ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("㌀ ㌁ ㌂ ㌃ ㌄ ㌅ ㌆ ㌇ ㌈ ㌉ ㌊ ㌋ ㌌ ㌍ ㌎ ㌏ ㌐ ㌑ ㌒ ㌓ ㌔ ㌕ ㌖ ㌗ ㌘ ㌙ ㌚ ㌛ ㌜ ㌝ ㌞ ㌟ ㌠ ㌡ ㌢ ㌣ ㌤ ㌥ ㌦ ㌧ ㌨ ㌩ ㌪ ㌫ ㌬ ㌭ ㌮ ㌯ ㌰ ㌱ ㌲ ㌳ ㌴ ㌵ ㌶ ㌷ ㌸ ㌹ ㌺ ㌻ ㌼ ㌽ ㌾ ㌿ ㍀ ㍁ ㍂ ㍃ ㍄ ㍅ ㍆ ㍇ ㍈ ㍉ ㍊ ㍋ ㍌ ㍍ ㍎ ㍏ ㍐ ㍑ ㍒ ㍓ ㍔ ㍕ ㍖ ㍗ ㍘ ㍙ ㍚ ㍛ ㍜ ㍝ ㍞ ㍟ ㍠ ㍡ ㍢ ㍣ ㍤ ㍥ ㍦ ㍧ ㍨ ㍩ ㍪ ㍫ ㍬ ㍭ ㍮ ㍯ ㍰ ㍱ ㍲ ㍳ ㍴ ㍵ ㍶ ㍻ ㍼ ㍽ ㍾ ㍿ ㎀ ㎁ ㎂ ㎃ ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("一 丁 丂 七 丄 丅 丆 万 丈 三 上 下 丌 不 与 丏 丐 丑 丒 专 且 丕 世 丗 丘 丙 业 丛 东 丝 丞 丟 丠 両 丢 丣 两 严 並 丧 丨 丩 个 丫 丬 中 丮 丯 丰 丱 串 丳 临 丵 丶 丷 丸 丹 为 主 丼 丽 举 丿 乀 乁 乂 乃 乄 久 乆 乇 么 义 乊 之 乌 乍 乎 乏 乐 乑 乒 乓 乔 乕 乖 乗 乘 乙 乚 乛 乜 九 乞 也 习 乡 乢 乣 乤 乥 书 乧 乨 乩 乪 乫 乬 乭 乮 乯 买 乱 乲 乳 乴 乵 乶 乷 乸 乹 乺 乻 乼 乽 乾 乿 ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("가 각 갂 갃 간 갅 갆 갇 갈 갉 갊 갋 갌 갍 갎 갏 감 갑 값 갓 갔 강 갖 갗 갘 같 갚 갛 개 객 갞 갟 갠 갡 갢 갣 갤 갥 갦 갧 갨 갩 갪 갫 갬 갭 갮 갯 갰 갱 갲 갳 갴 갵 갶 갷 갸 갹 갺 갻 갼 갽 갾 갿 걀 걁 걂 걃 걄 걅 걆 걇 걈 걉 걊 걋 걌 걍 걎 걏 걐 걑 걒 걓 걔 걕 걖 걗 걘 걙 걚 걛 걜 걝 걞 걟 걠 걡 걢 걣 걤 걥 걦 걧 걨 걩 걪 걫 걬 걭 걮 걯 거 걱 걲 걳 건 걵 걶 걷 걸 걹 걺 걻 걼 걽 걾 걿 ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("                                                                                                                                ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("豈 更 車 賈 滑 串 句 龜 龜 契 金 喇 奈 懶 癩 羅 蘿 螺 裸 邏 樂 洛 烙 珞 落 酪 駱 亂 卵 欄 爛 蘭 鸞 嵐 濫 藍 襤 拉 臘 蠟 廊 朗 浪 狼 郎 來 冷 勞 擄 櫓 爐 盧 老 蘆 虜 路 露 魯 鷺 碌 祿 綠 菉 錄 鹿 論 壟 弄 籠 聾 牢 磊 賂 雷 壘 屢 樓 淚 漏 累 縷 陋 勒 肋 凜 凌 稜 綾 菱 陵 讀 拏 樂 諾 丹 寧 怒 率 異 北 磻 便 復 不 泌 數 索 參 塞 省 葉 說 殺 辰 沈 拾 若 掠 略 亮 兩 凉 梁 糧 良 諒 量 勵 ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("ff fi fl ffi ffl ſt st ﬓ ﬔ ﬕ ﬖ ﬗ ﬞ ײַ ﬠ ﬡ ﬢ ﬣ ﬤ ﬥ ﬦ ﬧ ﬨ ﬩ שׁ שׂ שּׁ שּׂ אַ אָ אּ בּ גּ דּ הּ וּ זּ טּ יּ ךּ כּ לּ מּ נּ סּ ףּ פּ צּ קּ רּ שּ תּ וֹ בֿ כֿ פֿ ﭏ"))))(_(_($62$$62$)(_(printS)(Fay$$list("ﭐ ﭑ ﭒ ﭓ ﭔ ﭕ ﭖ ﭗ ﭘ ﭙ ﭚ ﭛ ﭜ ﭝ ﭞ ﭟ ﭠ ﭡ ﭢ ﭣ ﭤ ﭥ ﭦ ﭧ ﭨ ﭩ ﭪ ﭫ ﭬ ﭭ ﭮ ﭯ ﭰ ﭱ ﭲ ﭳ ﭴ ﭵ ﭶ ﭷ ﭸ ﭹ ﭺ ﭻ ﭼ ﭽ ﭾ ﭿ ﮀ ﮁ ﮂ ﮃ ﮄ ﮅ ﮆ ﮇ ﮈ ﮉ ﮊ ﮋ ﮌ ﮍ ﮎ ﮏ ﮐ ﮑ ﮒ ﮓ ﮔ ﮕ ﮖ ﮗ ﮘ ﮙ ﮚ ﮛ ﮜ ﮝ ﮞ ﮟ ﮠ ﮡ ﮢ ﮣ ﮤ ﮥ ﮦ ﮧ ﮨ ﮩ ﮪ ﮫ ﮬ ﮭ ﮮ ﮯ ﮰ ﮱ ﯓ ﯔ ﯕ ﯖ ﯗ ﯘ ﯙ ﯚ ﯛ ﯜ ﯝ ﯞ ﯟ ﯠ ﯡ ﯢ ﯣ ﯤ ﯥ ﯦ ﯧ ﯨ ﯩ ﯪ ﯫ ﯬ ﯭ ﯮ ﯯ ﯰ ..."))))(_(_($62$$62$)(_(printS)(Fay$$list("︠ ︡ ︢ ︣"))))(_(_($62$$62$)(_(printS)(Fay$$list("︰ ︱ ︲ ︳ ︴ ︵ ︶ ︷ ︸ ︹ ︺ ︻ ︼ ︽ ︾ ︿ ﹀ ﹁ ﹂ ﹃ ﹄ ﹉ ﹊ ﹋ ﹌ ﹍ ﹎ ﹏"))))(_(_($62$$62$)(_(printS)(Fay$$list("﹐ ﹑ ﹒ ﹔ ﹕ ﹖ ﹗ ﹘ ﹙ ﹚ ﹛ ﹜ ﹝ ﹞ ﹟ ﹠ ﹡ ﹢ ﹣ ﹤ ﹥ ﹦ ﹨ ﹩ ﹪ ﹫"))))(_(_($62$$62$)(_(printS)(Fay$$list("ﹰ ﹱ ﹲ ﹴ ﹶ ﹷ ﹸ ﹹ ﹺ ﹻ ﹼ ﹽ ﹾ ﹿ ﺀ ﺁ ﺂ ﺃ ﺄ ﺅ ﺆ ﺇ ﺈ ﺉ ﺊ ﺋ ﺌ ﺍ ﺎ ﺏ ﺐ ﺑ ﺒ ﺓ ﺔ ﺕ ﺖ ﺗ ﺘ ﺙ ﺚ ﺛ ﺜ ﺝ ﺞ ﺟ ﺠ ﺡ ﺢ ﺣ ﺤ ﺥ ﺦ ﺧ ﺨ ﺩ ﺪ ﺫ ﺬ ﺭ ﺮ ﺯ ﺰ ﺱ ﺲ ﺳ ﺴ ﺵ ﺶ ﺷ ﺸ ﺹ ﺺ ﺻ ﺼ ﺽ ﺾ ﺿ ﻀ ﻁ ﻂ ﻃ ﻄ ﻅ ﻆ ﻇ ﻈ ﻉ ﻊ ﻋ ﻌ ﻍ ﻎ ﻏ ﻐ ﻑ ﻒ ﻓ ﻔ ﻕ ﻖ ﻗ ﻘ ﻙ ﻚ ﻛ ﻜ ﻝ ﻞ ﻟ ﻠ ﻡ ﻢ ﻣ ﻤ ﻥ ﻦ ﻧ ﻨ ﻩ ﻪ ﻫ ﻬ ﻭ ﻮ ﻯ ﻰ ﻱ ..."))))(_(printS)(Fay$$list("！ ＂ ＃ ＄ ％ ＆ ＇ （ ） ＊ ＋ ， － ． ／ ０ １ ２ ３ ４ ５ ６ ７ ８ ９ ： ； ＜ ＝ ＞ ？ ＠ Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ Ｉ Ｊ Ｋ Ｌ Ｍ Ｎ Ｏ Ｐ Ｑ Ｒ Ｓ Ｔ Ｕ Ｖ Ｗ Ｘ Ｙ Ｚ ［ ＼ ］ ＾ ＿ ｀ ａ ｂ ｃ ｄ ｅ ｆ ｇ ｈ ｉ ｊ ｋ ｌ ｍ ｎ ｏ ｐ ｑ ｒ ｓ ｔ ｕ ｖ ｗ ｘ ｙ ｚ ｛ ｜ ｝ ～ ｡ ｢ ｣ ､ ･ ｦ ｧ ｨ ｩ ｪ ｫ ｬ ｭ ｮ ｯ ｰ ｱ ｲ ｳ ｴ ｵ ｶ ｷ ｸ ｹ ｺ ｻ ｼ ｽ ｾ ｿ ﾀ ﾁ ﾂ ..."))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))));});var printS = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); + diff --git a/tests/where b/tests/where new file mode 100644 --- /dev/null +++ b/tests/where @@ -0,0 +1,1 @@ +Hello my friends and family diff --git a/tests/where.hs b/tests/where.hs new file mode 100644 --- /dev/null +++ b/tests/where.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +main = print $ "Hello " ++ friends ++ family + where friends = "my friends" + family = " and family" + +print :: String -> Fay () +print = ffi "console.log(%1)" diff --git a/tests/where.js b/tests/where.js new file mode 100644 --- /dev/null +++ b/tests/where.js @@ -0,0 +1,434 @@ +/** @constructor +*/ +var Main = function(){ +var True = true; +var False = false; + +/******************************************************************************* + * Thunks. + */ + +// Force a thunk (if it is a thunk) until WHNF. +function _(thunkish,nocache){ + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; +} + +// Apply a function to arguments (see method2 in Fay.hs). +function __(){ + var f = arguments[0]; + for (var i = 1, len = arguments.length; i < len; i++) { + f = (f instanceof $? _(f) : f)(arguments[i]); + } + return f; +} + +// Thunk object. +function $(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()); +}; + + +// Eval in the context of the Haskell bindings. +function Fay$$eval(str){ + return eval(str); +} + +/******************************************************************************* + * Monad. + */ + +function Fay$$Monad(value){ + this.value = value; +} + +// >> +// encode_fay_to_js(">>=") → $62$$62$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$(a){ + return function(b){ + return new $(function(){ + _(a,true); + return b; + }); + }; +} + +// >>= +// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. +function $62$$62$$61$(m){ + return function(f){ + return new $(function(){ + var monad = _(m,true); + return f(monad.value); + }); + }; +} + +// This is used directly from Fay, but can be rebound or shadowed. +function $_return(a){ + return new Fay$$Monad(a); +} + +var Fay$$unit = null; + +/******************************************************************************* + * Serialization. + * Fay <-> JS. Should be bijective. + */ + +// Serialize a Fay object to JS. +function Fay$$fayToJs(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$$fayToJs(args[0],_(fayObj,true).value); + }; + break; + } + case "function": { + // A proper function. + jsObj = function(){ + var fayFunc = fayObj; + var return_type = args[args.length-1]; + var len = args.length; + // If some arguments. + if (len > 1) { + // Apply to all the arguments. + fayFunc = _(fayFunc,true); + // TODO: Perhaps we should throw an error when JS + // passes more arguments than Haskell accepts. + for (var i = 0, len = len; i < len - 1 && fayFunc instanceof Function; i++) { + // Unserialize the JS values to Fay for the Fay callback. + fayFunc = _(fayFunc(Fay$$jsToFay(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$$fayToJs(return_args[0],fayFunc.value); + } + // Otherwise just serialize the value direct. + else { + return Fay$$fayToJs(return_type,fayFunc); + } + } 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); + } + jsObj = str; + break; + } + case "list": { + // Serialize Fay list to JavaScript array. + var arr = []; + fayObj = _(fayObj); + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(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 "bool": { + // Bools are unboxed. + jsObj = _(fayObj); + break; + } + case "unknown": + case "user": { + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; + } + default: throw new Error("Unhandled Fay->JS translation type: " + base); + } + return jsObj; +} + +// Unserialize an object from JS to Fay. +function Fay$$jsToFay(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 = new Fay$$Monad(Fay$$jsToFay(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$$jsToFay(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 "bool": { + // Bools are unboxed. + fayObj = jsObj; + break; + } + case "unknown": + case "user": { + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; + } + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; +} + +/******************************************************************************* + * Lists. + */ + +// Cons object. +function Fay$$Cons(car,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; +} + +// Built-in list cons. +function Fay$$cons(x){ + 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; + }; +} + +/******************************************************************************* + * Numbers. + */ + +// Built-in *. +function Fay$$mult(x){ + return function(y){ + return _(x) * _(y); + }; +} + +// Built-in +. +function Fay$$add(x){ + return function(y){ + return _(x) + _(y); + }; +} + +// Built-in -. +function Fay$$sub(x){ + return function(y){ + return _(x) - _(y); + }; +} + +// Built-in /. +function Fay$$div(x){ + return function(y){ + return _(x) / _(y); + }; +} + +/******************************************************************************* + * 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; + } + return true; + } else if (lit1 instanceof Fay$$Cons && lit2 instanceof Fay$$Cons) { + do { + if (!Fay$$equal(lit1.car,lit2.car)) + return false; + lit1 = _(lit1.cdr), lit2 = _(lit2.cdr); + if (lit1 === null || lit2 === null) + return lit1 === lit2; + } while (true); + } else { + return false; + } +} + +// Built-in ==. +function Fay$$eq(x){ + return function(y){ + return Fay$$equal(x,y); + }; +} + +// Built-in /=. +function Fay$$neq(x){ + return function(y){ + return !(Fay$$equal(x,y)); + }; +} + +// Built-in >. +function Fay$$gt(x){ + return function(y){ + return _(x) > _(y); + }; +} + +// Built-in <. +function Fay$$lt(x){ + return function(y){ + return _(x) < _(y); + }; +} + +// Built-in >=. +function Fay$$gte(x){ + return function(y){ + return _(x) >= _(y); + }; +} + +// Built-in <=. +function Fay$$lte(x){ + return function(y){ + return _(x) <= _(y); + }; +} + +// Built-in &&. +function Fay$$and(x){ + return function(y){ + return _(x) && _(y); + }; +} + +// Built-in ||. +function Fay$$or(x){ + return function(y){ + return _(x) || _(y); + }; +} + +/******************************************************************************* + * Mutable references. + */ + +// Make a new mutable reference. +function Fay$$Ref(x){ + this.value = x; +} + +// Write to the ref. +function Fay$$writeRef(ref,x){ + ref.value = x; +} + +// Get the value from the ref. +function Fay$$readRef(ref,x){ + return ref.value; +} + +/******************************************************************************* + * Dates. + */ +function Fay$$date(str){ + return window.Date.parse(str); +} + +/******************************************************************************* + * Application code. + */ + +var main = new $(function(){var friends = new $(function(){return Fay$$list("my friends");});var family = new $(function(){return Fay$$list(" and family");});return _(_($36$)(print))(_(_($43$$43$)(Fay$$list("Hello ")))(_(_($43$$43$)(friends))(family)));});var print = function($_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$_a)));});};var $_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $_Just(slot1);});};var $_Nothing = function(){};var Nothing = new $(function(){return new $_Nothing();});var show = function($_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$_a)));});};var fromInteger = function($_a){return new $(function(){var x = $_a;return x;});};var fromRational = function($_a){return new $(function(){var x = $_a;return x;});};var snd = function($_a){return new $(function(){var x = Fay$$index(1)(_($_a));return x;throw ["unhandled case in Ident \"snd\"",[$_a]];});};var fst = function($_a){return new $(function(){var x = Fay$$index(0)(_($_a));return x;throw ["unhandled case in Ident \"fst\"",[$_a]];});};var find = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$_a,$_b]];});};};var any = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$_a,$_b]];});};};var filter = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var p = $_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$_a,$_b]];});};};var not = function($_a){return new $(function(){var p = $_a;return _(p) ? false : true;});};var $_null = function($_a){return new $(function(){if (_($_a) === null) {return true;}return false;});};var map = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$_a,$_b]];});};};var nub = function($_a){return new $(function(){var ls = $_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($_a){return function($_b){return new $(function(){if (_($_a) === null) {return null;}var ls = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(_(elem)(x))(ls)) ? _(_(nub$39$)(xs))(ls) : _(_(Fay$$cons)(x))(_(_(nub$39$)(xs))(_(_(Fay$$cons)(x))(ls)));}throw ["unhandled case in Ident \"nub'\"",[$_a,$_b]];});};};var elem = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var y = $_$_b.car;var ys = $_$_b.cdr;var x = $_a;return _(_(_(Fay$$eq)(x))(y)) || _(_(_(elem)(x))(ys));}if (_($_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$_a,$_b]];});};};var $_GT = function(){};var GT = new $(function(){return new $_GT();});var $_LT = function(){};var LT = new $(function(){return new $_LT();});var $_EQ = function(){};var EQ = new $(function(){return new $_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(x) > _(y)) ? GT : _(_(x) < _(y)) ? LT : EQ;});};};var sortBy = function($_a){return new $(function(){var cmp = $_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var x = $_b;return Fay$$list([x]);}var ys = $_c;var x = $_b;var cmp = $_a;return (function($_ys){if (_($_ys) === null) {return Fay$$list([x]);}var $_$_ys = _($_ys);if ($_$_ys instanceof Fay$$Cons) {var y = $_$_ys.car;var ys$39$ = $_$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$_ys]); })();})(ys);});};};};var when = function($_a){return function($_b){return new $(function(){var m = $_b;var p = $_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($_a){return new $(function(){var i = $_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(i) + 1));});};var enumFromTo = function($_a){return function($_b){return new $(function(){var n = $_b;var i = $_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(i) + 1))(n));});};};var zipWith = function($_a){return function($_b){return function($_c){return new $(function(){var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var b = $_$_c.car;var bs = $_$_c.cdr;var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var a = $_$_b.car;var as = $_$_b.cdr;var f = $_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var b = $_$_b.car;var bs = $_$_b.cdr;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var a = $_$_a.car;var as = $_$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($_a){return function($_b){return function($_c){return new $(function(){var y = $_c;var x = $_b;var f = $_a;return _(_(f)(y))(x);});};};};var maybe = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) instanceof $_Nothing) {var m = $_a;return m;}if (_($_c) instanceof $_Just) {var x = _($_c).slot1;var f = $_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$_a,$_b,$_c]];});};};};var $46$ = function($_a){return function($_b){return function($_c){return new $(function(){var x = $_c;var g = $_b;var f = $_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($_a){return function($_b){return new $(function(){var y = $_b;var x = $_a;return _(_(conc)(x))(y);});};};var $36$ = function($_a){return function($_b){return new $(function(){var x = $_b;var f = $_a;return _(f)(x);});};};var conc = function($_a){return function($_b){return new $(function(){var ys = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $_b;if (_($_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$_a,$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$_a,$_b,$_c]];});};};};var foldl = function($_a){return function($_b){return function($_c){return new $(function(){if (_($_c) === null) {var z = $_b;return z;}var $_$_c = _($_c);if ($_$_c instanceof Fay$$Cons) {var x = $_$_c.car;var xs = $_$_c.cdr;var z = $_b;var f = $_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$_a,$_b,$_c]];});};};};var lookup = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {var _key = $_a;return Nothing;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($_$_b.car));var y = Fay$$index(1)(_($_$_b.car));var xys = $_$_b.cdr;var key = $_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$_a,$_b]];});};};var intersperse = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$_a,$_b]];});};};var prependToAll = function($_a){return function($_b){return new $(function(){if (_($_b) === null) {return null;}var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var sep = $_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$_a,$_b]];});};};var intercalate = function($_a){return function($_b){return new $(function(){var xss = $_b;var xs = $_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($_a){return function($_b){return new $(function(){var m = $_b;var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$_a,$_b]];});};};var mapM_ = function($_a){return function($_b){return new $(function(){var $_$_b = _($_b);if ($_$_b instanceof Fay$$Cons) {var x = $_$_b.car;var xs = $_$_b.cdr;var m = $_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$_a,$_b]];});};};var $_const = function($_a){return function($_b){return new $(function(){var a = $_a;return a;});};};var length = function($_a){return new $(function(){var $_$_a = _($_a);if ($_$_a instanceof Fay$$Cons) {var x = $_$_a.car;var xs = $_$_a.cdr;return 1 + _(_(length)(xs));}if (_($_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$_a]];});};var mod = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$_a) % Fay$$fayToJs(["double"],$_b));});};};var min = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var max = function($_a){return function($_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$_a),Fay$$fayToJs(["double"],$_b)));});};};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $_EQ) {return {"instance": "EQ"};}if (_obj instanceof $_LT) {return {"instance": "LT"};}if (_obj instanceof $_GT) {return {"instance": "GT"};}if (_obj instanceof $_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $_EQ();}if (obj["instance"] === "LT") {return new $_LT();}if (obj["instance"] === "GT") {return new $_GT();}if (obj["instance"] === "Nothing") {return new $_Nothing();}if (obj["instance"] === "Just") {return new $_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; +// Exports +this.main = main; + +// Built-ins +this._ = _; +this.$ = $; +this.$fayToJs = Fay$$fayToJs; +this.$jsToFay = Fay$$jsToFay; + +}; +; +var main = new Main(); +main._(main.main); +