diff --git a/docs/home.css b/docs/home.css --- a/docs/home.css +++ b/docs/home.css @@ -25,6 +25,7 @@ font-size: 2em; margin-bottom:0; padding-bottom:0; + margin-top:0; color: #F40095 } h2 { @@ -36,6 +37,18 @@ color: #948091; font-style: italic; } +.head { + margin-top: 2em; +} +.head-logo { + height: 50px; + margin-top:5px; + float: left; + margin-right:1em +} +.head-text { + margin-left: 1em; +} .subheadline { font-size: 20px; margin-bottom: 1em; @@ -44,7 +57,7 @@ /* Syntax highlighting */ .example { } -.example pre { margin-top:0; +.example pre { margin-top:0; word-wrap: break-word; } .example pre .diff { color:#555 } .example pre code .title { color:#333 } diff --git a/examples/alert.hs b/examples/alert.hs --- a/examples/alert.hs +++ b/examples/alert.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Alert where diff --git a/examples/canvaswater.hs b/examples/canvaswater.hs --- a/examples/canvaswater.hs +++ b/examples/canvaswater.hs @@ -1,7 +1,7 @@ -- | Compile with: fay examples/canvaswater.hs {-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE NoImplicitPrelude #-} + -- | A demonstration of Fay using the canvas element to display a -- simple effect. diff --git a/examples/console.hs b/examples/console.hs --- a/examples/console.hs +++ b/examples/console.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Console where diff --git a/examples/data.hs b/examples/data.hs --- a/examples/data.hs +++ b/examples/data.hs @@ -4,7 +4,7 @@ -- $ node examples/data.js -- (Foo { x = 123, y = "abc", z = (Bar) }) -{-# LANGUAGE NoImplicitPrelude #-} + module Data where diff --git a/examples/dom.hs b/examples/dom.hs --- a/examples/dom.hs +++ b/examples/dom.hs @@ -1,5 +1,5 @@ {-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE NoImplicitPrelude #-} + module Dom where diff --git a/examples/ref.hs b/examples/ref.hs --- a/examples/ref.hs +++ b/examples/ref.hs @@ -1,7 +1,7 @@ -- | Mutable references. {-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE NoImplicitPrelude #-} + module Ref where diff --git a/examples/tailrecursive.hs b/examples/tailrecursive.hs --- a/examples/tailrecursive.hs +++ b/examples/tailrecursive.hs @@ -4,25 +4,40 @@ -- See the ticket about optimizing tail-recursive functions for future -- work -{-# LANGUAGE NoImplicitPrelude #-} + module Tailrecursive where import Language.Fay.FFI import Language.Fay.Prelude main = do - benchmark - benchmark - benchmark - benchmark + benchmark $ printI (map (\x -> x+1) fibs !! 10) + benchmark $ printI (fibs !! 80) + benchmark $ printD (sum 1000000 0) + benchmark $ printD (sum 1000000 0) + benchmark $ printD (sum 1000000 0) + benchmark $ printD (sum 1000000 0) -benchmark = do +fibs = 0 : 1 : zipWith (+) fibs (tail fibs) + +tail (_:xs) = xs + +xs !! k = go 0 xs where + go n (x:xs) | n == k = x + | otherwise = go (n+1) xs + +benchmark m = do start <- getSeconds - printD (sum 1000000 0 :: Double) + m end <- getSeconds printS (show (end-start) ++ "ms") +length' :: [a] -> Int +length' = go 0 where + go acc (_:xs) = go (acc+1) xs + go acc [] = acc + -- tail recursive sum 0 acc = acc sum n acc = sum (n - 1) (acc + n) @@ -32,6 +47,9 @@ printD :: Double -> Fay () printD = ffi "console.log(%1)" + +printI :: Int -> Fay () +printI = ffi "console.log(%1)" printS :: String -> Fay () printS = ffi "console.log(%1)" diff --git a/fay.cabal b/fay.cabal --- a/fay.cabal +++ b/fay.cabal @@ -1,5 +1,5 @@ name: fay -version: 0.9.2.0 +version: 0.10.0.0 synopsis: A compiler for Fay, a Haskell subset that compiles to JavaScript. description: Fay is a proper subset of Haskell which can be compiled (type-checked) with GHC, and compiled to JavaScript. It is lazy, pure, with a Fay monad, @@ -22,50 +22,45 @@ . /Release Notes/ . - * Fix name encoding. - . - * Add content-type to HTML generation. - . - * Add calculator example. - . - * Support built-in operators as (+), (*), etc. - . - * Fix self-referential thunks (see #89). - . - * Don't import modules twice. + * Add TCO optimization. . - * Handle where bindings in function definitions. + * Added uncurrying optimization for non-partial applications. . - * Support record updates. + * Add simple benchmarking program. . - * Move to GHC type-checking (with --no-ghc). + * Add SVG logo. . - * Remove invalid chars from UTF-8 tests. + * Added Defined type and appropriate serialization. . - * Remove --autorun, now it's the default. + * Treat Maybe as a nullable value in conversions. . - * Fix nullary constructor comparison. + * Added oscillator example. . - * Replace . with $ in module name generation. + * Add optimization flag. + + * Support tuple serialization. + * Fix list length in pats (closes #145). . - * Reverse -fdevel flag. + * Name resolution and some export list support. + + * Add codeworld space invaders example. . - * Skip type declarations in where. + * NoImplicitPrelude is now passed automatically to GHC. Does not break code that uses the pragma (see #134). . - * Add true/false to keywords. + * Add support for list comprehensions using desugaring from Haskell report. See #40 and #132. . - * Add laziness back to infix operators. + * Make error messages a tiny bit friendlier, and some general house-keeping. . - * Switch to applicative parsing of options. + * Support negation expressions (see #116). . - * Fix parens in conversion functions. + * Rewrite readFromFay using only Data, no Read/Show requirements (see #112). . - See full history at: + See full history at: homepage: http://fay-lang.org/ license: BSD3 license-file: LICENSE -author: Chris Done -maintainer: chrisdone@gmail.com +author: Chris Done, Adam Bergmark +maintainer: chrisdone@gmail.com, adam@edea.se copyright: 2012 Chris Done category: Development build-type: Custom @@ -77,72 +72,44 @@ examples/tailrecursive.hs examples/data.hs examples/canvaswater.hs examples/canvaswater.html examples/haskell.png -- Test cases - tests/ints.hs tests/ints - 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 + tests/ints.hs tests/ints tests/asPatternMatch + tests/caseList.hs tests/Double2.hs + tests/fromInteger tests/List.hs tests/RecCon + tests/recordPatternMatch tests/String.hs + tests/asPatternMatch.hs tests/fromInteger.hs + tests/RecCon.hs tests/recordPatternMatch2 + tests/caseWildcard tests/Double3 tests/Monad + tests/recordPatternMatch2.hs tests/tailRecursion + tests/basicFunctions tests/caseWildcard.hs + tests/Double3.hs tests/Monad2 tests/RecDecl + tests/tailRecursion.hs tests/basicFunctions.hs + tests/HierarchicalImport tests/Monad2.hs + tests/RecDecl.hs tests/recordPatternMatch.hs + tests/do tests/Double4 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/recordFunctionPatternMatch tests/records.hs + tests/Double.hs tests/mutableReference + tests/recordFunctionPatternMatch.hs tests/utf8 + tests/case tests/doBindAssign + tests/infixDataConst tests/mutableReference.hs + tests/recordUseBeforeDefine tests/utf8.hs + tests/case2 tests/doBindAssign.hs tests/emptyMain + tests/infixDataConst.hs tests/RecordImport_Export + tests/recordUseBeforeDefine.hs tests/case2.hs + tests/emptyMain.hs tests/patternGuards + tests/RecordImport_Export.hs tests/where + tests/do.hs tests/List tests/patternGuards.hs + tests/reservedWords tests/where.hs tests/case.hs + tests/fix tests/List2 tests/RecordImport_Import + tests/reservedWords.hs tests/Double tests/fix.hs + tests/List2.hs tests/patternMatchFail.hs + tests/RecordImport_Import.hs tests/caseList + tests/Double2 tests/String + tests/Hierarchical/Export.hs + tests/Hierarchical/RecordDefined.hs -- Documentation files docs/beautify.js docs/highlight.pack.js docs/home.css docs/jquery.js docs/analytics.js @@ -165,14 +132,15 @@ library hs-source-dirs: src - 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 + exposed-modules: Language.Fay, Language.Fay.Types, Language.Fay.FFI, Language.Fay.Prelude, Language.Fay.Convert, Language.Fay.Compiler, Language.Fay.Compiler.Misc, Language.Fay.Compiler.FFI, Language.Fay.Compiler.Optimizer + other-modules: Language.Fay.Print, Control.Monad.IO, Language.Fay.Stdlib, System.Process.Extra, Data.List.Extra, Paths_fay ghc-options: -O2 -Wall build-depends: base >= 4 && < 5, mtl, haskell-src-exts, aeson, unordered-containers, + containers, attoparsec, vector, text, @@ -186,9 +154,10 @@ process, filepath, directory, - groom + groom, + random - if flag(devel) + if !flag(devel) build-depends: -- Requirements for the executables which -- `cabal-dev ghci' needs. @@ -212,7 +181,9 @@ mtl, haskell-src-exts, aeson, + syb, unordered-containers, + containers, attoparsec, vector, text, @@ -226,6 +197,7 @@ directory, filepath, groom, + random, optparse-applicative, split, haskeline @@ -242,7 +214,9 @@ mtl, haskell-src-exts, aeson, + syb, unordered-containers, + containers, attoparsec, vector, text, @@ -257,6 +231,7 @@ safe, language-ecmascript, groom, + random, test-framework, test-framework-hunit, test-framework-th @@ -272,7 +247,9 @@ mtl, haskell-src-exts, aeson, + syb, unordered-containers, + containers, attoparsec, vector, text, @@ -290,4 +267,5 @@ data-default, safe, language-ecmascript, - groom + groom, + random diff --git a/hs/stdlib.hs b/hs/stdlib.hs --- a/hs/stdlib.hs +++ b/hs/stdlib.hs @@ -1,10 +1,3 @@ data Maybe a = Just a | Nothing - -show :: (Foreign a,Show a) => a -> String -show = ffi "JSON.stringify(%1)" - --- There is only Double in JS. -fromInteger x = x -fromRational x = x diff --git a/js/runtime.js b/js/runtime.js --- a/js/runtime.js +++ b/js/runtime.js @@ -7,25 +7,25 @@ // Force a thunk (if it is a thunk) until WHNF. function _(thunkish,nocache){ - while (thunkish instanceof $) { - thunkish = thunkish.force(nocache); - } - return thunkish; + while (thunkish instanceof $) { + thunkish = thunkish.force(nocache); + } + return thunkish; } // Apply a function to arguments (see method2 in Fay.hs). function __(){ - var f = arguments[0]; - for (var i = 1, len = arguments.length; i < len; i++) { - f = (f instanceof $? _(f) : f)(arguments[i]); - } - return f; + 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; + this.forced = false; + this.value = value; } // Force the thunk. @@ -42,38 +42,66 @@ */ function Fay$$Monad(value){ - this.value = value; + this.value = value; } +// This is used directly from Fay, but can be rebound or shadowed. See primOps in Types.hs. // >> -// 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; - }); - }; +function Fay$$then(a){ + return function(b){ + return Fay$$bind(a)(function(_){ + return b; + }); + }; } +// This is used directly from Fay, but can be rebound or shadowed. See primOps in Types.hs. +// >> +function Fay$$then$36$uncurried(a,b){ + return Fay$$bind$36$uncurried(a,function(_){ return b; }); +} + // >>= -// encode_fay_to_js(">>=") → $62$$62$$61$ +// This is used directly from Fay, but can be rebound or shadowed. See primOps in Types.hs. +function Fay$$bind(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. See primOps in Types.hs. +function Fay$$bind$36$uncurried(m,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 $62$$62$$61$(m){ - return function(f){ - return new $(function(){ - var monad = _(m,true); - return f(monad.value); - }); - }; +function Fay$$$_return(a){ + return new Fay$$Monad(a); } +// Allow the programmer to access thunk forcing directly. +function Fay$$force(thunk){ + return function(type){ + return new $(function(){ + _(thunk,type); + return new Fay$$Monad(Fay$$unit); + }) + } +} + // This is used directly from Fay, but can be rebound or shadowed. -function $_return(a){ - return new Fay$$Monad(a); +function Fay$$return$36$uncurried(a){ + return new Fay$$Monad(a); } +// Unit: (). var Fay$$unit = null; /******************************************************************************* @@ -83,94 +111,115 @@ // Serialize a Fay object to JS. function Fay$$fayToJs(type,fayObj){ - var base = type[0]; - var args = type[1]; - var jsObj; - switch(base){ + 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; + // 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; + // 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; + // 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; + // 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 "tuple": { + // Serialize Fay tuple to JavaScript array. + var arr = []; + fayObj = _(fayObj); + var i = 0; + while(fayObj instanceof Fay$$Cons) { + arr.push(Fay$$fayToJs(args[i++],fayObj.car)); + fayObj = _(fayObj.cdr); + } + jsObj = arr; + break; + } + case "defined": { + fayObj = _(fayObj); + if (fayObj instanceof $_Language$Fay$Stdlib$Undefined) { + jsObj = undefined; + } else { + jsObj = Fay$$fayToJs(args[0],fayObj["slot1"]); + } + break; + } case "double": { - // Serialize double, just force the argument. Doubles are unboxed. - jsObj = _(fayObj); - break; + // Serialize double, just force the argument. Doubles are unboxed. + jsObj = _(fayObj); + break; } case "int": { - // Serialize int, just force the argument. Ints are unboxed. - jsObj = _(fayObj); - break; + // Serialize int, just force the argument. Ints are unboxed. + jsObj = _(fayObj); + break; } case "bool": { - // Bools are unboxed. - jsObj = _(fayObj); - break; + // Bools are unboxed. + jsObj = _(fayObj); + break; } case "unknown": case "user": { - if(fayObj instanceof $) - fayObj = _(fayObj); - jsObj = Fay$$fayToJsUserDefined(type,fayObj); - break; + if(fayObj instanceof $) + fayObj = _(fayObj); + jsObj = Fay$$fayToJsUserDefined(type,fayObj); + break; } default: throw new Error("Unhandled Fay->JS translation type: " + base); } @@ -179,61 +228,80 @@ // Unserialize an object from JS to Fay. function Fay$$jsToFay(type,jsObj){ - var base = type[0]; - var args = type[1]; - var fayObj; - switch(base){ + 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; + // 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; + // 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; + // 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 "tuple": { + // Unserialize a JS array into a Fay tuple ((a,b,c,...)). + var serializedTuple = []; + for (var i = 0, len = jsObj.length; i < len; i++) { + // Unserialize each JS value into a Fay value, too. + serializedTuple.push(Fay$$jsToFay(args[i],jsObj[i])); + } + // Pop it all in a Fay list. + fayObj = Fay$$list(serializedTuple); + break; + } + case "defined": { + if (jsObj === undefined) { + fayObj = new $_Language$Fay$Stdlib$Undefined(); + } else { + fayObj = new $_Language$Fay$Stdlib$Defined(Fay$$jsToFay(args[0],jsObj)); + } + break; + } case "double": { - // Doubles are unboxed, so there's nothing to do. - fayObj = jsObj; - break; + // Doubles are unboxed, so there's nothing to do. + fayObj = jsObj; + break; } case "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - break; + // Int are unboxed, so there's no forcing to do. + // But we can do validation that the int has no decimal places. + // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" + fayObj = Math.round(jsObj); + if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; + break; } case "bool": { - // Bools are unboxed. - fayObj = jsObj; - break; + // 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); + if (jsObj && jsObj['instance']) { + fayObj = Fay$$jsToFayUserDefined(type,jsObj); + } + else + fayObj = jsObj; + break; } - return fayObj; + default: throw new Error("Unhandled JS->Fay translation type: " + base); + } + return fayObj; } /******************************************************************************* @@ -242,223 +310,326 @@ // Cons object. function Fay$$Cons(car,cdr){ - this.car = car; - this.cdr = cdr; + this.car = car; + this.cdr = cdr; } // Make a list. function Fay$$list(xs){ - var out = null; - for(var i=xs.length-1; i>=0;i--) - out = new Fay$$Cons(xs[i],out); - return out; + var out = null; + for(var i=xs.length-1; i>=0;i--) + out = new Fay$$Cons(xs[i],out); + return out; } // Built-in list cons. function Fay$$cons(x){ - return function(y){ - return new Fay$$Cons(x,y); - }; + return function(y){ + return new Fay$$Cons(x,y); + }; } // List index. function Fay$$index(index){ - return function(list){ - for(var i = 0; i < index; i++) { - list = _(list).cdr; - } - return list.car; - }; + return function(list){ + for(var i = 0; i < index; i++) { + list = _(list).cdr; + } + return list.car; + }; } +// List length. +function Fay$$listLen(list,max){ + for(var i = 0; list !== null && i < max + 1; i++) { + list = _(list).cdr; + } + return i == max; +} + /******************************************************************************* * Numbers. */ // Built-in *. function Fay$$mult(x){ - return function(y){ - return new $(function(){ - return _(x) * _(y); - }); - }; + return function(y){ + return new $(function(){ + return _(x) * _(y); + }); + }; } -var $42$ = Fay$$mult; +function Fay$$mult$36$uncurried(x,y){ + + return new $(function(){ + return _(x) * _(y); + }); + +} + // Built-in +. function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; + return function(y){ + return new $(function(){ + return _(x) + _(y); + }); + }; } -var $43$ = Fay$$add; +// Built-in +. +function Fay$$add$36$uncurried(x,y){ + + return new $(function(){ + return _(x) + _(y); + }); + +} + // Built-in -. function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; + return function(y){ + return new $(function(){ + return _(x) - _(y); + }); + }; } -var $45$ = Fay$$sub; +// Built-in -. +function Fay$$sub$36$uncurried(x,y){ + return new $(function(){ + return _(x) - _(y); + }); + +} + // Built-in /. function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; + return function(y){ + return new $(function(){ + return _(x) / _(y); + }); + }; } -var $47$ = Fay$$div; +// Built-in /. +function Fay$$div$36$uncurried(x,y){ + + return new $(function(){ + return _(x) / _(y); + }); + +} + /******************************************************************************* * Booleans. */ // Are two values equal? function Fay$$equal(lit1, lit2) { - // Simple case - lit1 = _(lit1); - lit2 = _(lit2); - if (lit1 === lit2) { - return true; + // 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; } - // 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && + lit1.constructor === lit2.constructor) { + for(var x in lit1) { + if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && + Fay$$equal(lit1[x],lit2[x]))) + return false; } + return true; + } else { + return false; + } } // Built-in ==. function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; + return function(y){ + return new $(function(){ + return Fay$$equal(x,y); + }); + }; } -var $61$$61$ = Fay$$eq; +function Fay$$eq$36$uncurried(x,y){ + + return new $(function(){ + return Fay$$equal(x,y); + }); + +} + // Built-in /=. function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; + return function(y){ + return new $(function(){ + return !(Fay$$equal(x,y)); + }); + }; } -var $47$$61$ = Fay$$neq; +// Built-in /=. +function Fay$$neq$36$uncurried(x,y){ + + return new $(function(){ + return !(Fay$$equal(x,y)); + }); + +} + // Built-in >. function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; + return function(y){ + return new $(function(){ + return _(x) > _(y); + }); + }; } -var $62$ = Fay$$gt; +// Built-in >. +function Fay$$gt$36$uncurried(x,y){ + + return new $(function(){ + return _(x) > _(y); + }); + +} + // Built-in <. function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; + return function(y){ + return new $(function(){ + return _(x) < _(y); + }); + }; } -var $60$ = Fay$$lt; + +// Built-in <. +function Fay$$lt$36$uncurried(x,y){ + + return new $(function(){ + return _(x) < _(y); + }); + +} + + // Built-in >=. function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; + return function(y){ + return new $(function(){ + return _(x) >= _(y); + }); + }; } -var $62$$61$ = Fay$$gte; +// Built-in >=. +function Fay$$gte$36$uncurried(x,y){ + + return new $(function(){ + return _(x) >= _(y); + }); + +} + // Built-in <=. function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; + return function(y){ + return new $(function(){ + return _(x) <= _(y); + }); + }; } -var $60$$61$ = Fay$$lte; +// Built-in <=. +function Fay$$lte$36$uncurried(x,y){ + + return new $(function(){ + return _(x) <= _(y); + }); + +} + // Built-in &&. function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; + return function(y){ + return new $(function(){ + return _(x) && _(y); + }); + }; } -var $38$$38$ = Fay$$and; +// Built-in &&. +function Fay$$and$36$uncurried(x,y){ + + return new $(function(){ + return _(x) && _(y); + }); + ; +} + // Built-in ||. function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; + return function(y){ + return new $(function(){ + return _(x) || _(y); + }); + }; } -var $124$$124$ = Fay$$or; +// Built-in ||. +function Fay$$or$36$uncurried(x,y){ + + return new $(function(){ + return _(x) || _(y); + }); + +} + /******************************************************************************* * Mutable references. */ // Make a new mutable reference. function Fay$$Ref(x){ - this.value = x; + this.value = x; } // Write to the ref. function Fay$$writeRef(ref,x){ - ref.value = x; + ref.value = x; } // Get the value from the ref. function Fay$$readRef(ref,x){ - return ref.value; + return ref.value; } /******************************************************************************* * Dates. */ function Fay$$date(str){ - return window.Date.parse(str); + return window.Date.parse(str); } /******************************************************************************* diff --git a/src/Data/List/Extra.hs b/src/Data/List/Extra.hs new file mode 100644 --- /dev/null +++ b/src/Data/List/Extra.hs @@ -0,0 +1,10 @@ +module Data.List.Extra where + +import Data.List hiding (map) +import Prelude hiding (map) + +unionOf :: (Eq a) => [[a]] -> [a] +unionOf = foldr union [] + +for :: (Functor f) => f a -> (a -> b) -> f b +for = flip fmap diff --git a/src/Docs.hs b/src/Docs.hs --- a/src/Docs.hs +++ b/src/Docs.hs @@ -1,21 +1,22 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# OPTIONS -fno-warn-missing-signatures -fno-warn-unused-do-bind #-} -- | Generate documentation for Fay. module Main where -import Language.Fay (compileForDocs, compileViaStr) -import Language.Fay.Compiler (compileFromTo) -import Language.Fay.Types (CompileConfig(..)) - - import Control.Monad import qualified Data.ByteString.Lazy as L import Data.Char import Data.Default import Data.Time +import Language.Fay (compileFromTo) +import Language.Fay.Compiler (compileForDocs, compileViaStr) +import Language.Fay.Types (CompileConfig (..), + PrintState (..)) + import Prelude hiding (div, head) import System.FilePath import Text.Blaze.Extra @@ -23,6 +24,7 @@ import Text.Blaze.Html5.Attributes as A hiding (title) import Text.Blaze.Renderer.Utf8 (renderMarkup) + -- | Main entry point. main :: IO () main = do @@ -43,12 +45,13 @@ where compile file = do contents <- readFile file putStrLn $ "Generating " ++ file ++ " ..." - result <- compileViaStr def { configFlattenApps = True - , configTCO = True + result <- compileViaStr file + def { configFlattenApps = True + , configOptimize = True , configTypecheck = False } compileForDocs contents case result of - Right (javascript,_) -> return javascript + Right (PrintState{..},_) -> return (concat (reverse psOutput)) Left err -> error (show err) titlize = takeWhile (/='.') . upperize . takeFileName where upperize (x:xs) = toUpper x : xs @@ -59,7 +62,7 @@ generateJs = do putStrLn $ "Compiling " ++ inp ++ " to " ++ out ++ " ..." - compileFromTo def { configFlattenApps = True, configTypecheck = False } inp out + compileFromTo def { configFlattenApps = True, configTypecheck = False } inp (Just out) where docs = ("docs" ) inp = docs "home.hs" @@ -85,6 +88,7 @@ div !. "wrap" $ do theheading theintro + thelinks thesetup thejsproblem thecomparisons @@ -100,8 +104,11 @@ ! alt "Fork me on GitHub" theheading = do - h1 "Fay programming language" - div !. "subheadline" $ "A proper subset of Haskell that compiles to JavaScript" + div !. "head" $ do + img !. "head-logo" ! src "logo-large.png" + div !. "head-text" $ do + h1 "Fay programming language" + div !. "subheadline" $ "A proper subset of Haskell that compiles to JavaScript" theexamples examples = do a ! name "examples" $ return () @@ -247,3 +254,47 @@ "For now it is best to simply try and see if you get an “Unsupported X” compile error or not. " "It will not accept things that it doesn't support, apart from class and instance declarations, " "which it ignores entirely. Inspect the compiler source if you are unsure, it is rather simple." + +thelinks = do + h2 "Fay in the Wild" + ul $ do + li $ do + "Yesod Blog: " + a ! href + "http://www.yesodweb.com/blog/2012/10/yesod-fay-js" $ + "Yesod, AngularJS and Fay" + li $ do + "Happstack Blog: " + a ! href + "http://www.happstack.com/c/view-page-slug/15/happstack-fay-acid-state-shared-datatypes-are-awesome" $ + "Happstack, Fay, & Acid-State: Shared Datatypes are Awesome" + li $ do + a ! href + "http://www.skybluetrades.net/blog/posts/2012/11/13/fay-ring-oscillator/index.html" $ + "Fun with Fay - A Ring Oscillator" + li $ do + a ! href + "http://cdsmith.wordpress.com/2012/11/18/codeworld-and-the-future/" $ + "CodeWorld and the Future" + li $ do + a ! href + "http://ide.fay-lang.org/" $ + "A Fay IDE written in Fay" + ": " + a ! href "https://github.com/faylang/fay-server" $ "github" + li $ do + "happstack-fay: " + a ! href "http://hackage.haskell.org/package/happstack-fay" $ "hackage" + li $ do + H.span $ "snaplet-fay: " + a ! href "https://github.com/faylang/snaplet-fay" $ "github" + ", " + a ! href "http://hackage.haskell.org/package/snaplet-fay" $ "hackage" + li $ do + "yesod-fay: " + a ! href "https://github.com/snoyberg/yesod-fay" $ "github" + ", " + a ! href "http://hackage.haskell.org/package/yesod-fay" $ "hackage" + li $ do + "fay-jquery: " + a ! href "https://github.com/faylang/fay-jquery" $ "hackage" diff --git a/src/Language/Fay.hs b/src/Language/Fay.hs --- a/src/Language/Fay.hs +++ b/src/Language/Fay.hs @@ -1,1232 +1,169 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} -{-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-orphans #-} - --- | The Haskell→Javascript compiler. - -module Language.Fay - (compile - ,runCompile - ,compileViaStr - ,compileForDocs - ,compileToAst - ,compileFromStr - ,compileModule - ,compileExp - ,printCompile - ,printTestCompile - ,compileToplevelModule - ,prettyPrintString) - where - -import Language.Fay.Print (jsEncodeName, printJSString) -import Language.Fay.Types -import System.Process.Extra - -import Control.Applicative -import Control.Monad.Error -import Control.Monad.IO -import Control.Monad.State -import Data.Char -import Data.Default (def) -import Data.List -import Data.Maybe -import Data.String -import qualified Language.ECMAScript3.Parser as JS -import Language.Haskell.Exts - -import Safe -import System.Directory (doesFileExist, findExecutable) -import System.Exit -import System.FilePath (()) -import System.IO -import System.Process - --------------------------------------------------------------------------------- --- 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 (defaultCompileState config) . compileTo - --- | Run the compiler. -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) - => CompileConfig - -> (from -> Compile to) - -> String - -> IO (Either CompileError (String,CompileState)) -compileViaStr config with from = - runCompile (defaultCompileState config) - (parseResult (throwError . uncurry ParseError) - (fmap printJSString . with) - (parseFay from)) - --- | Compile a Haskell source string to a JavaScript source string. -compileToAst :: (Show from,Show to,CompilesTo from to) - => CompileState - -> (from -> Compile to) - -> String - -> IO (Either CompileError (to,CompileState)) -compileToAst state with from = - runCompile state - (parseResult (throwError . uncurry ParseError) - with - (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 - (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) - -> String - -> IO () -printCompile config with from = do - result <- compileViaStr config with from - case result of - 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 { configWarn = False } compileModule - --- | 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@(Module _ (ModuleName modulename) _ _ _ _ _) = do - cfg <- gets stateConfig - when (configTypecheck cfg) $ - typecheck (configDirectoryIncludes cfg) [] (configWall cfg) $ - fromMaybe modulename $ configFilePath cfg - initialPass mod - modify $ \s -> s { stateImported = stateImported (defaultCompileState def) } - 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) False _ Nothing Nothing Nothing) = do - void $ unlessImported name $ 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 - , stateImported = stateImported state - } - Left err -> throwError err - return [] - -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 } - --------------------------------------------------------------------------------- --- Typechecking - -typecheck :: [FilePath] -> [String] -> Bool -> String -> Compile () -typecheck includeDirs ghcFlags wall fp = do - res <- liftIO $ readAllFromProcess' "ghc" ( - ["-fno-code", "-package fay", fp] ++ map ("-i" ++) includeDirs ++ ghcFlags ++ wallF) "" - either error (warn . fst) res - where - wallF | wall = ["-Wall"] - | otherwise = [] - --------------------------------------------------------------------------------- --- Compilers - - --- | Compile Haskell module. -compileModule :: Module -> Compile [JsStmt] -compileModule (Module _ modulename pragmas Nothing exports imports decls) = do - checkModulePragmas pragmas - modify $ \s -> s { stateModuleName = modulename - , stateExportAll = isNothing exports - } - mapM_ emitExport (fromMaybe [] exports) - imported <- fmap concat (mapM compileImport imports) - current <- compileDecls True decls - return (imported ++ current) -compileModule mod = throwError (UnsupportedModuleSyntax mod) - -warn :: String -> Compile () -warn "" = return () -warn w = do - shouldWarn <- configWarn <$> gets stateConfig - when shouldWarn . liftIO . hPutStrLn stderr $ "Warning: " ++ w - -checkModulePragmas :: [ModulePragma] -> Compile () -checkModulePragmas pragmas = - when (not $ any noImplicitPrelude pragmas) $ - warn "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 -findImport (dir:dirs) name = do - exists <- doesFileExist path - if exists - then readFile path - else findImport dirs name - where - path = dir replace '.' '/' name ++ ".hs" - replace c r = map (\x -> if x == c then r else x) -findImport [] name = - error $ "Could not find import: " ++ name - --- | Compile the given import. -compileImport :: ImportDecl -> Compile [JsStmt] -compileImport (ImportDecl _ (ModuleName name) False _ Nothing Nothing Nothing) = do - unlessImported name $ do - dirs <- configDirectoryIncludes <$> gets stateConfig - contents <- io (findImport dirs name) - state <- gets id - result <- liftIO $ compileToAst state compileModule contents - case result of - Right (stmts,state) -> do - modify $ \s -> s { stateFayToJs = stateFayToJs state - , stateJsToFay = stateJsToFay state - , stateImported = stateImported state - } - return stmts - Left err -> throwError err -compileImport i = - error $ "compileImport: Import syntax not supported. " ++ - "The compiler writer was too lazy to support that.\n" ++ - "It was: " ++ show i - --- | Don't re-import the same modules. -unlessImported :: String -> Compile [JsStmt] -> Compile [JsStmt] -unlessImported name importIt = do - imported <- gets stateImported - if elem name imported - then return [] - else do - modify $ \s -> s { stateImported = name : imported } - importIt - --- | Compile Haskell declaration. -compileDecls :: Bool -> [Decl] -> Compile [JsStmt] -compileDecls toplevel decls = - case decls of - [] -> return [] - (TypeSig _ _ sig:bind@PatBind{}:decls) -> appendM (compilePatBind toplevel (Just sig) bind) - (compileDecls toplevel decls) - (decl:decls) -> appendM (compileDecl toplevel decl) - (compileDecls toplevel decls) - - where appendM m n = do x <- m - xs <- n - return (x ++ xs) - --- | Compile a declaration. -compileDecl :: Bool -> Decl -> Compile [JsStmt] -compileDecl toplevel decl = - case decl of - 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 = - case pat of - PatBind srcloc (PVar ident) Nothing (UnGuardedRhs rhs) (BDecls []) -> - case ffiExp rhs of - Just formatstr -> case sig of - Just sig -> compileFFI srcloc ident formatstr sig - Nothing -> throwError (FfiNeedsTypeSig pat) - _ -> compileUnguardedRhs srcloc toplevel ident rhs - PatBind srcloc (PVar ident) Nothing (UnGuardedRhs rhs) bdecls -> - compileUnguardedRhs srcloc toplevel ident (Let bdecls rhs) - _ -> throwError (UnsupportedDeclaration pat) - - where ffiExp (App (Var (UnQual (Ident "ffi"))) (Lit (String formatstr))) = Just formatstr - ffiExp _ = Nothing - --- | Compile an FFI call. -compileFFI :: SrcLoc -- ^ Location of the original FFI decl. - -> Name -- ^ Name of the to-be binding. - -> String -- ^ The format string. - -> Type -- ^ Type signature. - -> Compile [JsStmt] -compileFFI srcloc name formatstr sig = do - inner <- formatFFI formatstr (zip params funcFundamentalTypes) - case JS.parse JS.parseExpression (prettyPrint name) (printJSString (wrapReturn inner)) of - Left err -> throwError (FfiFormatInvalidJavaScript inner (show err)) - Right{} -> fmap return (bindToplevel srcloc True (UnQual name) (body inner)) - - where body inner = foldr wrapParam (wrapReturn inner) params - wrapParam name inner = JsFun [name] [] (Just inner) - params = zipWith const uniqueNames [1..typeArity sig] - wrapReturn inner = thunk $ - case lastMay funcFundamentalTypes of - -- Returns a “pure” value; - Just{} -> jsToFay returnType (JsRawExp inner) - -- Base case: - Nothing -> JsRawExp inner - funcFundamentalTypes = functionTypeArgs sig - returnType = last funcFundamentalTypes - --- | Format the FFI format string with the given arguments. -formatFFI :: String -- ^ The format string. - -> [(JsParam,FundamentalType)] -- ^ Arguments. - -> Compile String -- ^ The JS code. -formatFFI formatstr args = go formatstr where - go ('%':'*':xs) = do - these <- mapM inject (zipWith const [1..] args) - rest <- go xs - return (intercalate "," these ++ rest) - go ('%':'%':xs) = do - rest <- go xs - return ('%' : rest) - go ['%'] = throwError FfiFormatIncompleteArg - go ('%':(span isDigit -> (op,xs))) = - case readMay op of - Nothing -> throwError (FfiFormatBadChars op) - Just n -> do - this <- inject n - rest <- go xs - return (this ++ rest) - go (x:xs) = do rest <- go xs - return (x : rest) - go [] = return [] - - inject n = - case listToMaybe (drop (n-1) args) of - Nothing -> throwError (FfiFormatNoSuchArg n) - Just (arg,typ) -> do - return (printJSString (fayToJs (typeRep typ) (JsName arg))) - --- | Translate: Fay → JS. -fayToJs :: JsExp -> JsExp -> JsExp -fayToJs typ exp = JsApp (JsName (hjIdent "fayToJs")) - [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]] - 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" - IntType -> "int" - BoolType -> "bool" - DateType -> "date" - _ -> "unknown" - --- | Get arg types of a function type. -functionTypeArgs :: Type -> [FundamentalType] -functionTypeArgs t = - case t of - TyForall _ _ i -> functionTypeArgs i - TyFun a b -> argType a : functionTypeArgs b - TyParen st -> functionTypeArgs st - r -> [argType r] - --- | Convert a Haskell type to an internal FFI representation. -argType :: Type -> FundamentalType -argType t = - case t of - TyCon "String" -> StringType - TyCon "Double" -> DoubleType - TyCon "Int" -> IntType - 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 - 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 = - case t of - TyForall _ _ i -> typeArity i - TyFun _ b -> 1 + typeArity b - TyParen st -> typeArity st - _ -> 0 - --- | Compile a normal simple pattern binding. -compileUnguardedRhs :: SrcLoc -> Bool -> Name -> Exp -> Compile [JsStmt] -compileUnguardedRhs srcloc toplevel ident rhs = do - body <- compileExp rhs - bind <- bindToplevel srcloc 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 = - fmap concat $ - forM constructors $ \(QualConDecl srcloc _ _ condecl) -> - case condecl of - ConDecl (UnQual -> name) types -> do - let fields = map (Ident . ("slot"++) . show . fst) . zip [1 :: Integer ..] $ types - 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' - cons <- makeConstructor name fields - func <- makeFunc name fields - funs <- makeAccessors srcloc fields - emitFayToJs name fields' - emitJsToFay name fields' - return (cons : func : funs) - - where - -- Creates a constructor R_RecConstr for a Record - makeConstructor name fields = do - let fieldParams = map (fromString . unname) fields - return $ - JsVar (constructorName name) $ - JsFun fieldParams - (flip map fields $ \field@(Ident s) -> - JsSetProp (fromString ":this") (UnQual field) (JsName (fromString s))) - Nothing - - -- Creates a function to initialize the record by regular application - makeFunc name fields = do - let fieldParams = map (\(Ident s) -> fromString s) fields - let fieldExps = map (JsName . UnQual) fields - return $ JsVar name $ - foldr (\slot inner -> JsFun [slot] [] (Just inner)) - (thunk $ JsNew (constructorName name) fieldExps) - fieldParams - - -- Creates getters for a RecDecl's values - makeAccessors srcloc fields = - forM fields $ \(Ident name) -> - bindToplevel srcloc - toplevel - (fromString name) - (JsFun ["x"] - [] - (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 (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 -unname (Ident str) = str -unname _ = error "Expected ident from uname." -- FIXME: - -constructorName :: QName -> QName -constructorName = fromString . ("$_" ++) . qname - --- | Compile a function which pattern matches (causing a case analysis). -compileFunCase :: Bool -> [Match] -> Compile [JsStmt] -compileFunCase _toplevel [] = return [] -compileFunCase toplevel matches@(Match srcloc name argslen _ _ _:_) = do - tco <- config configTCO - pats <- fmap optimizePatConditions (mapM compileCase matches) - bind <- bindToplevel srcloc - toplevel - (UnQual name) - (foldr (\arg inner -> JsFun [arg] [] (Just inner)) - (stmtsThunk (let stmts = (concat pats ++ basecase) - in if tco - then optimizeTailCalls args name stmts - else stmts)) - args) - return [bind] - where args = zipWith const uniqueNames argslen - - isWildCardMatch (Match _ _ pats _ _ _) = all isWildCardPat pats - - compileCase :: Match -> Compile [JsStmt] - compileCase match@(Match _ _ pats _ rhs _) = do - whereDecls' <- whereDecls match - exp <- compileRhs rhs - body <- if null whereDecls' - then return exp - else do - binds <- mapM compileLetDecl whereDecls' - return (JsApp (JsFun [] (concat binds) (Just exp)) []) - foldM (\inner (arg,pat) -> - compilePat (JsName arg) pat inner) - [JsEarlyReturn body] - (zip args pats) - - whereDecls :: Match -> Compile [Decl] - whereDecls (Match _ _ _ _ _ (BDecls decls)) = return decls - whereDecls match = throwError (UnsupportedWhereInMatch match) - - basecase :: [JsStmt] - basecase = if any isWildCardMatch matches - then [] - else [throw ("unhandled case in " ++ show name) - (JsList (map JsName args))] - --- | Optimize functions in tail-call form. -optimizeTailCalls :: [JsParam] -- ^ The function parameters. - -> Name -- ^ The function name. - -> [JsStmt] -- ^ The body of the function. - -> [JsStmt] -- ^ A new optimized function body. -optimizeTailCalls params name stmts = abandonIfNoChange $ - JsWhile (JsLit (JsBool True)) - (concatMap replaceTailStmt - (reverse (zip (reverse stmts) [0::Integer ..]))) - - where replaceTailStmt (JsIf cond sothen orelse,i) = [JsIf cond (concatMap (replaceTailStmt . (,i)) sothen) - (concatMap (replaceTailStmt . (,i)) orelse)] - replaceTailStmt (JsEarlyReturn exp,i) = expTailReplace i exp - replaceTailStmt (x,_) = [x] - expTailReplace i (flatten -> Just (JsName (UnQual call):args@(_:_))) - | call == name = updateParamsInstead i args - expTailReplace _i original = [JsEarlyReturn original] - updateParamsInstead i args = zipWith JsUpdate params args ++ - [JsContinue | i /= 0] - abandonIfNoChange (JsWhile _ newstmts) - | newstmts == stmts = stmts - abandonIfNoChange new = [new] - --- | Flatten an application expression into function : arg : arg : [] -flatten :: JsExp -> Maybe [JsExp] -flatten (JsApp op@JsApp{} arg) = do - inner <- expand op - return (inner ++ arg) -flatten name@JsName{} = return [name] -flatten _ = Nothing - --- | Expand a forced value into the value. -expand :: JsExp -> Maybe [JsExp] -expand (JsApp (JsName (UnQual (Ident "_"))) xs) = - fmap concat (mapM flatten xs) -expand _ = Nothing - --- | 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 -compileRhs (UnGuardedRhs exp) = compileExp exp -compileRhs (GuardedRhss rhss) = compileGuards rhss - --- | Compile guards -compileGuards :: [GuardedRhs] -> Compile JsExp -compileGuards [] = return . JsThrowExp . JsLit . JsStr $ "Non-exhaustive guards" -compileGuards ((GuardedRhs _ (Qualifier (Var (UnQual (Ident "otherwise"))):_) exp):_) = compileExp exp -compileGuards (GuardedRhs _ (Qualifier guard:_) exp : rest) = - JsTernaryIf <$> fmap force (compileExp guard) - <*> compileExp exp - <*> compileGuards rest -compileGuards rhss = throwError . UnsupportedRhs . GuardedRhss $ rhss - --- | Compile Haskell expression. -compileExp :: Exp -> Compile JsExp -compileExp exp = - case exp of - Paren exp -> compileExp exp --- 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 - InfixApp exp1 op exp2 -> compileInfixApp exp1 op exp2 - Let (BDecls decls) exp -> compileLet decls exp - List [] -> return JsNull - List xs -> compileList xs - Tuple xs -> compileList xs - If cond conseq alt -> compileIf cond conseq alt - Case exp alts -> compileCase exp alts - Con (UnQual (Ident "True")) -> return (JsLit (JsBool True)) - Con (UnQual (Ident "False")) -> return (JsLit (JsBool False)) - Con exp -> return (JsName exp) - Do stmts -> compileDoBlock stmts - Lambda _ pats exp -> compileLambda pats exp - EnumFrom i -> do e <- compileExp i - return (JsApp (JsName "enumFrom") [e]) - EnumFromTo i i' -> do f <- compileExp i - t <- compileExp i' - return (JsApp (JsApp (JsName "enumFromTo") [f]) - [t]) - RecConstr name fieldUpdates -> compileRecConstr name fieldUpdates - RecUpdate rec fieldUpdates -> updateRec rec fieldUpdates - ExpTypeSig _ e _ -> compileExp e - - exp -> throwError (UnsupportedExpression exp) - -instance CompilesTo Exp JsExp where compileTo = compileExp - - --- | Compile simple application. -compileApp :: Exp -> Exp -> Compile JsExp -compileApp exp1 exp2 = do - flattenApps <- config configFlattenApps - if flattenApps then method2 else method1 - where - -- Method 1: - -- In this approach code ends up looking like this: - -- a(a(a(a(a(a(a(a(a(a(L)(c))(b))(0))(0))(y))(t))(a(a(F)(3*a(a(d)+a(a(f)/20))))*a(a(f)/2)))(140+a(f)))(y))(t)}) - -- Which might be OK for speed, but increases the JS stack a fair bit. - method1 = - JsApp <$> (forceFlatName <$> compileExp exp1) - <*> fmap return (compileExp exp2) - forceFlatName name = JsApp (JsName "_") [name] - - -- Method 2: - -- In this approach code ends up looking like this: - -- d(O,a,b,0,0,B,w,e(d(I,3*e(e(c)+e(e(g)/20))))*e(e(g)/2),140+e(g),B,w)}),d(K,g,e(c)+0.05)) - -- Which should be much better for the stack and readability, but probably not great for speed. - method2 = fmap flatten $ - JsApp <$> compileExp exp1 - <*> fmap return (compileExp exp2) - flatten (JsApp op args) = - case op of - JsApp l r -> JsApp l (r ++ args) - _ -> JsApp (JsName "__") (op : args) - flatten x = x - --- | Compile an infix application, optimizing the JS cases. -compileInfixApp :: Exp -> QOp -> Exp -> Compile JsExp -compileInfixApp exp1 op exp2 = do - config <- config id - case getOp op of - UnQual (Symbol symbol) - | symbol `elem` words "* + - / < > || &&" -> do - e1 <- compileExp exp1 - e2 <- compileExp exp2 - fn <- resolveOpToVar >=> compileExp $ op - return $ JsApp (JsApp (force fn) [(forceInlinable config e1)]) [(forceInlinable config e2)] - _ -> do - var <- resolveOpToVar op - compileExp (App (App var exp1) exp2) - - where getOp (QVarOp op) = op - getOp (QConOp op) = op - --- | Compile a list expression. -compileList :: [Exp] -> Compile JsExp -compileList xs = do - exps <- mapM compileExp xs - return (makeList exps) - -makeList :: [JsExp] -> JsExp -makeList exps = (JsApp (JsName (hjIdent "list")) [JsList exps]) - --- | Compile an if. -compileIf :: Exp -> Exp -> Exp -> Compile JsExp -compileIf cond conseq alt = - JsTernaryIf <$> fmap force (compileExp cond) - <*> compileExp conseq - <*> compileExp alt - --- | Compile a lambda. -compileLambda :: [Pat] -> Exp -> Compile JsExp -compileLambda pats exp = do - exp <- compileExp exp - stmts <- foldM (\inner (param,pat) -> do - stmts <- compilePat (JsName param) pat inner - return [JsEarlyReturn (JsFun [param] (stmts ++ [unhandledcase param | not allfree]) Nothing)]) - [JsEarlyReturn exp] - (reverse (zip uniqueNames pats)) - case stmts of - [JsEarlyReturn fun@JsFun{}] -> return fun - _ -> error "Unexpected statements in compileLambda" - - where unhandledcase = throw "unhandled case" . JsName - allfree = all isWildCardPat pats - --- | Compile case expressions. -compileCase :: Exp -> [Alt] -> Compile JsExp -compileCase exp alts = do - 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] - --- | Compile a do block. -compileDoBlock :: [Stmt] -> Compile JsExp -compileDoBlock stmts = do - doblock <- foldM compileStmt Nothing (reverse stmts) - maybe (throwError EmptyDoBlock) compileExp doblock - --- | Compile a statement of a do block. -compileStmt :: Maybe Exp -> Stmt -> Compile (Maybe Exp) -compileStmt inner stmt = - case inner of - Nothing -> initStmt - Just inner -> subsequentStmt inner - - where initStmt = - case stmt of - Qualifier exp -> return (Just exp) - LetStmt{} -> throwError LetUnsupported - _ -> throwError InvalidDoBlock - - subsequentStmt inner = - case stmt of - Generator loc pat exp -> compileGenerator loc pat inner exp - Qualifier exp -> return (Just (InfixApp exp - (QVarOp (UnQual (Symbol ">>"))) - inner)) - LetStmt (BDecls binds) -> return (Just (Let (BDecls binds) inner)) - LetStmt _ -> throwError LetUnsupported - RecStmt{} -> throwError RecursiveDoUnsupported - - compileGenerator srcloc pat inner exp = do - let body = Lambda srcloc [pat] inner - return (Just (InfixApp exp - (QVarOp (UnQual (Symbol ">>="))) - body)) - --- | Compile the given pattern against the given expression. -compilePatAlt :: JsExp -> Alt -> Compile [JsStmt] -compilePatAlt exp (Alt _ pat rhs _) = do - alt <- compileGuardedAlt rhs - compilePat exp pat [JsEarlyReturn alt] - --- | Compile the given pattern against the given expression. -compilePat :: JsExp -> Pat -> [JsStmt] -> Compile [JsStmt] -compilePat exp pat body = - case pat of - 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 - PWildCard -> return body - pat@PInfixApp{} -> compileInfixPat exp pat body - PList pats -> compilePList pats body exp - PTuple pats -> compilePList pats body exp - PAsPat name pat -> compilePAsPat exp name pat body - pat -> throwError (UnsupportedPattern pat) - --- | Compile a literal value from a pattern match. -compilePLit :: JsExp -> Literal -> [JsStmt] -> Compile [JsStmt] -compilePLit exp literal body = do - lit <- compileLit literal - return [JsIf (equalExps exp lit) - body - []] - --- | Compile as binding in pattern match -compilePAsPat :: JsExp -> Name -> Pat -> [JsStmt] -> Compile [JsStmt] -compilePAsPat exp name pat body = do - x <- compilePat exp pat body - return ([JsVar (UnQual name) exp] ++ x ++ body) - --- | Compile a record construction with named fields --- | GHC will warn on uninitialized fields, they will be undefined in JS. -compileRecConstr :: QName -> [FieldUpdate] -> Compile JsExp -compileRecConstr name fieldUpdates = do - let o = UnQual (Ident (map toLower (qname name))) - -- var obj = new $_Type() - let record = JsVar o (JsNew (constructorName name) []) - setFields <- forM fieldUpdates $ - -- obj.field = value - \(FieldUpdate (UnQual field) value) -> JsSetProp o (UnQual field) <$> compileExp value - return $ JsApp (JsFun [] (record:setFields) (Just (JsName o))) [] - -updateRec :: Exp -> [FieldUpdate] -> Compile JsExp -updateRec rec fieldUpdates = do - record <- force <$> compileExp rec - let copyName = UnQual (Ident "$_record_to_update") - copy = JsVar copyName - (JsRawExp ("Object.create(" ++ printJSString record ++ ")")) - setFields <- forM fieldUpdates $ - \(FieldUpdate (UnQual field) value) -> - JsSetProp copyName (UnQual field) <$> compileExp value - return $ JsApp (JsFun [] (copy:setFields) (Just (JsName copyName))) [] - --- | Equality test for two expressions, with some optimizations. -equalExps :: JsExp -> JsExp -> JsExp -equalExps a b - | isConstant a && isConstant b = JsEq a b - | isConstant a = JsEq a (force b) - | isConstant b = JsEq (force a) b - | otherwise = - JsApp (JsName (hjIdent "equal")) [a,b] - --- | Is a JS expression a literal (constant)? -isConstant :: JsExp -> Bool -isConstant JsLit{} = True -isConstant _ = False - --- | Compile a pattern application. -compilePApp :: QName -> [Pat] -> JsExp -> [JsStmt] -> Compile [JsStmt] -compilePApp cons pats exp body = do - let forcedExp = force exp - let boolIf b = return [JsIf (JsEq forcedExp (JsLit (JsBool b))) body []] - case cons of - -- Special-casing on the booleans. - "True" -> boolIf True - "False" -> boolIf False - -- Everything else, generic: - _ -> do - rf <- lookup (Ident (qname cons)) <$> gets stateRecords - 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) - substmts - []] - --- | Compile a pattern list. -compilePList :: [Pat] -> [JsStmt] -> JsExp -> Compile [JsStmt] -compilePList [] body exp = - return [JsIf (JsEq (force exp) JsNull) body []] -compilePList pats body exp = do - let forcedExp = force exp - 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] -compileInfixPat exp pat@(PInfixApp left (Special cons) right) body = - case cons of - Cons -> do - let forcedExp = JsName (tmpName exp) - x = JsGetProp forcedExp "car" - xs = JsGetProp forcedExp "cdr" - rightMatch <- compilePat xs right body - leftMatch <- compilePat x left rightMatch - return [JsVar (tmpName exp) (force exp) - ,JsIf (JsInstanceOf forcedExp (hjIdent "Cons")) - leftMatch - []] - _ -> throwError (UnsupportedPattern pat) -compileInfixPat _ pat _ = throwError (UnsupportedPattern pat) - --- | Compile a guarded alt. -compileGuardedAlt :: GuardedAlts -> Compile JsExp -compileGuardedAlt alt = - case alt of - UnGuardedAlt exp -> compileExp exp - alt -> throwError (UnsupportedGuardedAlts alt) - --- | Compile a let expression. -compileLet :: [Decl] -> Exp -> Compile JsExp -compileLet decls exp = do - body <- compileExp exp - binds <- mapM compileLetDecl decls - return (JsApp (JsFun [] (concat binds) (Just body)) []) - --- | Compile let declaration. -compileLetDecl :: Decl -> Compile [JsStmt] -compileLetDecl decl = - case decl of - decl@PatBind{} -> compileDecls False [decl] - decl@FunBind{} -> compileDecls False [decl] - TypeSig{} -> return [] - _ -> throwError (UnsupportedLetBinding decl) - --- | Compile Haskell literal. -compileLit :: Literal -> Compile JsExp -compileLit lit = - case lit of - Char ch -> return (JsLit (JsChar ch)) - Int integer -> return (JsLit (JsInt (fromIntegral integer))) -- FIXME: - Frac rational -> return (JsLit (JsFloating (fromRational rational))) - -- TODO: Use real JS strings instead of array, probably it will - -- lead to the same result. - String string -> return (JsApp (JsName (hjIdent "list")) - [JsLit (JsStr string)]) - lit -> throwError (UnsupportedLiteral lit) - --------------------------------------------------------------------------------- --- Compilation utilities - --- | Generate unique names. -uniqueNames :: [JsParam] -uniqueNames = map (fromString . ("$_" ++)) - $ map return "abcxyz" ++ - zipWith (:) (cycle "v") - (map show [1 :: Integer ..]) - --- | Optimize pattern matching conditions by merging conditions in common. -optimizePatConditions :: [[JsStmt]] -> [[JsStmt]] -optimizePatConditions = concatMap merge . groupBy sameIf where - sameIf [JsIf cond1 _ _] [JsIf cond2 _ _] = cond1 == cond2 - sameIf _ _ = False - merge xs@([JsIf cond _ _]:_) = - [[JsIf cond (concat (optimizePatConditions (map getIfConsequent xs))) []]] - merge noifs = noifs - getIfConsequent [JsIf _ cons _] = cons - getIfConsequent other = other - --- | Throw a JS exception. -throw :: String -> JsExp -> JsStmt -throw msg exp = JsThrow (JsList [JsLit (JsStr msg),exp]) - --- | Throw a JS exception (in an expression). -throwExp :: String -> JsExp -> JsExp -throwExp msg exp = JsThrowExp (JsList [JsLit (JsStr msg),exp]) - --- | Is an alt a wildcard? -isWildCardAlt :: Alt -> Bool -isWildCardAlt (Alt _ pat _ _) = isWildCardPat pat - --- | Is a pattern a wildcard? -isWildCardPat :: Pat -> Bool -isWildCardPat PWildCard{} = True -isWildCardPat PVar{} = True -isWildCardPat _ = False - --- | A temporary name for testing conditions and such. -tmpName :: JsExp -> JsName -tmpName exp = - fromString $ - case exp of - JsName (qname -> x) -> "$_" ++ x - _ -> ":tmp" - --- | Wrap an expression in a thunk. -thunk :: JsExp -> JsExp --- thunk exp = JsNew (hjIdent "Thunk") [JsFun [] [] (Just exp)] -thunk exp = - case exp of - -- JS constants don't need to be in thunks, they're already strict. - JsLit{} -> exp - JsName "true" -> exp - JsName "false" -> exp - -- Functions (e.g. lets) used for introducing a new lexical scope - -- aren't necessary inside a thunk. This is a simple aesthetic - -- optimization. - JsApp fun@JsFun{} [] -> JsNew ":thunk" [fun] - -- Otherwise make a regular thunk. - _ -> JsNew ":thunk" [JsFun [] [] (Just exp)] - --- | Wrap an expression in a thunk. -stmtsThunk :: [JsStmt] -> JsExp -stmtsThunk stmts = JsNew ":thunk" [JsFun [] stmts Nothing] - --- | Translate: JS → Fay. -jsToFay :: FundamentalType -> JsExp -> JsExp -jsToFay typ exp = JsApp (JsName (hjIdent "jsToFay")) - [typeRep typ,exp] - --- | Force an expression in a thunk. -force :: JsExp -> JsExp -force exp - | isConstant exp = exp - | otherwise = JsApp (JsName "_") [exp] - --- | Force an expression in a thunk. -forceInlinable :: CompileConfig -> JsExp -> JsExp -forceInlinable config exp - | isConstant exp = exp - | configInlineForce config = - JsParen (JsTernaryIf (exp `JsInstanceOf` ":thunk") - (JsApp (JsName "_") [exp]) - exp) - | otherwise = JsApp (JsName "_") [exp] - --- | Resolve operators to only built-in (for now) functions. -resolveOpToVar :: QOp -> Compile Exp -resolveOpToVar op = - case getOp op of - UnQual (Symbol symbol) - | symbol == "*" -> return (Var (hjIdent "mult")) - | symbol == "+" -> return (Var (hjIdent "add")) - | symbol == "-" -> return (Var (hjIdent "sub")) - | symbol == "/" -> return (Var (hjIdent "div")) - | symbol == "==" -> return (Var (hjIdent "eq")) - | symbol == "/=" -> return (Var (hjIdent "neq")) - | symbol == ">" -> return (Var (hjIdent "gt")) - | symbol == "<" -> return (Var (hjIdent "lt")) - | symbol == ">=" -> return (Var (hjIdent "gte")) - | symbol == "<=" -> return (Var (hjIdent "lte")) - | symbol == "&&" -> return (Var (hjIdent "and")) - | symbol == "||" -> return (Var (hjIdent "or")) - | otherwise -> return (Var (fromString symbol)) - n@(UnQual Ident{}) -> return (Var n) - Special Cons -> return (Var (hjIdent "cons")) - _ -> throwError (UnsupportedOperator op) - - where getOp (QVarOp op) = op - getOp (QConOp op) = op - --- | Make an identifier from the built-in HJ module. -hjIdent :: String -> QName -hjIdent = Qual (ModuleName "Fay") . Ident - --- | Make a top-level binding. -bindToplevel :: SrcLoc -> Bool -> QName -> JsExp -> Compile JsStmt -bindToplevel srcloc toplevel name exp = do - exportAll <- gets stateExportAll - when (toplevel && exportAll) $ emitExport (EVar name) - return (JsMappedVar srcloc name exp) - --- | Emit exported names. -emitExport :: ExportSpec -> Compile () -emitExport spec = - case spec of - EVar (UnQual name) -> modify $ \s -> s { stateExports = name : stateExports s } - EVar _ -> error "Emitted a qualifed export, not supported." - _ -> throwError (UnsupportedExportSpec spec) - --------------------------------------------------------------------------------- --- Utilities - --- | Parse result. -parseResult :: ((SrcLoc,String) -> b) -> (a -> b) -> ParseResult a -> b -parseResult fail ok result = - case result of - ParseOk a -> ok a - ParseFailed srcloc msg -> fail (srcloc,msg) - --- | Get a config option. -config :: (CompileConfig -> a) -> Compile a -config f = gets (f . stateConfig) - -instance IsString Name where fromString = Ident +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE ViewPatterns #-} + +module Language.Fay + (module Language.Fay.Types + ,compileFile + ,compileFromTo + ,compileFromToAndGenerateHtml + ,toJsName + ,showCompileError) + where + +import Language.Fay.Compiler (compileToplevelModule, + compileViaStr) +import Language.Fay.Print +import Language.Fay.Types + +import Control.Monad +import Data.List +import Language.Haskell.Exts (prettyPrint) +import Language.Haskell.Exts.Syntax +import Paths_fay +import System.FilePath + +-- | Compile the given file and write the output to the given path, or +-- if nothing given, stdout. +compileFromTo :: CompileConfig -> FilePath -> Maybe FilePath -> IO () +compileFromTo config filein fileout = do + result <- maybe (compileFile config filein) + (compileFromToAndGenerateHtml config filein) + fileout + case result of + Right out -> maybe (putStrLn out) (flip writeFile out) fileout + Left err -> error $ showCompileError $ err + +-- | Compile the given file and write to the output, also generate any HTML. +compileFromToAndGenerateHtml :: CompileConfig -> FilePath -> FilePath -> IO (Either CompileError String) +compileFromToAndGenerateHtml config filein fileout = do + result <- compileFile config { configFilePath = Just filein } filein + case result of + Right out -> do + when (configHtmlWrapper config) $ + writeFile (replaceExtension fileout "html") $ unlines [ + "" + , "" + , " " + ," " + , unlines . map (" "++) . map makeScriptTagSrc $ configHtmlJSLibs config + , " " ++ makeScriptTagSrc relativeJsPath + , " " + , " " + , " " + , " " + , ""] + return (Right out) + where relativeJsPath = makeRelative (dropFileName fileout) fileout + makeScriptTagSrc :: FilePath -> String + makeScriptTagSrc = \s -> + "" + Left err -> return (Left err) + +-- | Compile the given file. +compileFile :: CompileConfig -> FilePath -> IO (Either CompileError String) +compileFile config filein = do + runtime <- getDataFileName "js/runtime.js" + srcdir <- fmap (takeDirectory . takeDirectory . takeDirectory) (getDataFileName "src/Language/Fay/Stdlib.hs") + raw <- readFile runtime + hscode <- readFile filein + compileToModule filein + config { configDirectoryIncludes = configDirectoryIncludes config ++ [srcdir] + } + raw + compileToplevelModule + hscode + +-- | Compile the given module to a runnable module. +compileToModule :: (Show from,Show to,CompilesTo from to) + => FilePath + -> CompileConfig -> String -> (from -> Compile to) -> String + -> IO (Either CompileError String) +compileToModule filepath config raw with hscode = do + result <- compileViaStr filepath config with hscode + case result of + Left err -> return (Left err) + Right (PrintState{..},state) -> + return $ Right $ (generate (concat (reverse psOutput)) + (stateExports state) + (stateModuleName state)) + + where generate jscode exports (ModuleName (clean -> 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 not (configLibrary config) + then unlines [";" + ,"var main = new " ++ modulename ++ "();" + ,"main._(main." ++ modulename ++ "$main);" + ] + else "" + ] + clean ('.':cs) = '$' : clean cs + clean (c:cs) = c : clean cs + clean [] = [] + +-- | Print an this.x = x; export out. +printExport :: QName -> String +printExport name = + printJSString (JsSetProp JsThis + (JsNameVar name) + (JsName (JsNameVar name))) + +-- | Convert a Haskell filename to a JS filename. +toJsName :: String -> String +toJsName x = case reverse x of + ('s':'h':'.': (reverse -> file)) -> file ++ ".js" + _ -> x + +-- | Print a compile error for human consumption. +showCompileError :: CompileError -> String +showCompileError e = + case e of + ParseError _ err -> err + UnsupportedDeclaration d -> "unsupported declaration: " ++ prettyPrint d + UnsupportedExportSpec es -> "unsupported export specification: " ++ prettyPrint es + UnsupportedMatchSyntax m -> "unsupported match/binding syntax: " ++ prettyPrint m + UnsupportedWhereInMatch m -> "unsupported `where' syntax: " ++ prettyPrint m + UnsupportedExpression expr -> "unsupported expression syntax: " ++ prettyPrint expr + UnsupportedQualStmt stmt -> "unsupported list qualifier: " ++ prettyPrint stmt + UnsupportedLiteral lit -> "unsupported literal syntax: " ++ prettyPrint lit + UnsupportedLetBinding d -> "unsupported let binding: " ++ prettyPrint d + UnsupportedOperator qop -> "unsupported operator syntax: " ++ prettyPrint qop + UnsupportedPattern pat -> "unsupported pattern syntax: " ++ prettyPrint pat + UnsupportedRhs rhs -> "unsupported right-hand side syntax: " ++ prettyPrint rhs + UnsupportedGuardedAlts ga -> "unsupported guarded alts: " ++ prettyPrint ga + EmptyDoBlock -> "empty `do' block" + UnsupportedModuleSyntax{} -> "unsupported module syntax (may be supported later)" + LetUnsupported -> "let not supported here" + InvalidDoBlock -> "invalid `do' block" + RecursiveDoUnsupported -> "recursive `do' isn't supported" + FfiNeedsTypeSig d -> "your FFI declaration needs a type signature: " ++ prettyPrint d + FfiFormatBadChars cs -> "invalid characters for FFI format string: " ++ show cs + FfiFormatNoSuchArg i -> "no such argument in FFI format string: " ++ show i + FfiFormatIncompleteArg -> "incomplete `%' syntax in FFI format string" + FfiFormatInvalidJavaScript code err -> "invalid JavaScript code in FFI format string:\n" + ++ err ++ "\nin " ++ code + UnsupportedFieldPattern p -> "unsupported field pattern: " ++ prettyPrint p + UnsupportedImport i -> "unsupported import syntax, we're too lazy: " ++ prettyPrint i + Couldn'tFindImport i places -> + "could not find an import in the path: " ++ prettyPrint i ++ ", \n" ++ + "searched in these places: " ++ intercalate ", " places + UnableResolveUnqualified name -> "unable to resolve unqualified name " ++ prettyPrint name + UnableResolveQualified qname -> "unable to resolve qualified names " ++ prettyPrint qname 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,149 +1,950 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE ViewPatterns #-} - -module Language.Fay.Compiler where - -import Language.Fay (compileToplevelModule, compileViaStr, prettyPrintString) -import Language.Fay.Types -import Language.Fay.Print - -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 -> FilePath -> FilePath -> IO () -compileFromTo config filein fileout = do - result <- compileFromToReturningStatus config filein fileout - case result of - Right () -> return () - Left err -> error . groom $ err - --- | Compile file program to… -compileFromToReturningStatus :: CompileConfig -> FilePath -> FilePath -> IO (Either CompileError ()) -compileFromToReturningStatus config filein fileout = do - result <- compileFile config { configFilePath = Just filein } filein - case result of - Right out -> do - writeFile fileout out - when (configHtmlWrapper config) $ - writeFile (replaceExtension fileout "html") $ unlines [ - "" - , "" - , " " - ," " - , unlines . map (" "++) . map makeScriptTagSrc $ configHtmlJSLibs config - , " " ++ makeScriptTagSrc relativeJsPath - , " " - , " " - , " " - , " " - , ""] - return (Right ()) - where relativeJsPath = makeRelative (dropFileName fileout) fileout - makeScriptTagSrc :: FilePath -> String - makeScriptTagSrc = \s -> - "" - Left err -> return (Left err) - --- | 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 <- readin filein - compileProgram config - raw - 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 -> String -> (from -> Compile to) -> String - -> IO (Either CompileError String) -compileProgram config raw with hscode = do - result <- compileViaStr config with hscode - case result of - Left err -> return (Left err) - 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 (clean -> 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 not (configLibrary config) - then unlines [";" - ,"var main = new " ++ modulename ++ "();" - ,"main._(main.main);" - ] - else "" - ] - clean ('.':cs) = '$' : clean cs - clean (c:cs) = c : clean cs - clean [] = [] - --- | Print an this.x = x; export out. -printExport :: Name -> String -printExport name = - printJSString (JsSetProp ":this" - (UnQual name) - (JsName (UnQual name))) - --- | Convert a Haskell filename to a JS filename. -toJsName :: String -> String -toJsName x = case reverse x of - ('s':'h':'.': (reverse -> file)) -> file ++ ".js" - _ -> x +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-orphans #-} + +-- | The Haskell→Javascript compiler. + +module Language.Fay.Compiler + (runCompile + ,compileViaStr + ,compileForDocs + ,compileToAst + ,compileModule + ,compileExp + ,compileDecl + ,printCompile + ,printTestCompile + ,compileToplevelModule) + where + +import Language.Fay.Compiler.FFI +import Language.Fay.Compiler.Optimizer +import Language.Fay.Compiler.Misc +import Language.Fay.Print (printJSString) +import Language.Fay.Types + +import Control.Applicative +import Control.Monad.Error +import Control.Monad.IO +import Control.Monad.State +import Data.Default (def) +import Data.List +import Data.List.Extra +import Data.Map (Map) +import qualified Data.Map as M +import Data.Maybe +import Language.Haskell.Exts +import System.Directory (doesFileExist) +import System.FilePath (()) +import System.IO +import System.Process.Extra + +-------------------------------------------------------------------------------- +-- Top level entry points + +-- | Run the compiler. +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) + => FilePath + -> CompileConfig + -> (from -> Compile to) + -> String + -> IO (Either CompileError (PrintState,CompileState)) +compileViaStr filepath config with from = do + cs <- defaultCompileState config + runCompile (cs { stateFilePath = filepath }) + (parseResult (throwError . uncurry ParseError) + (fmap (\x -> execState (runPrinter (printJS x)) printConfig) . with) + (parseFay filepath from)) + + where printConfig = def { psPretty = configPrettyPrint config } + +-- | Compile a Haskell source string to a JavaScript source string. +compileToAst :: (Show from,Show to,CompilesTo from to) + => FilePath + -> CompileState + -> (from -> Compile to) + -> String + -> IO (Either CompileError (to,CompileState)) +compileToAst filepath state with from = + runCompile state + (parseResult (throwError . uncurry ParseError) + with + (parseFay filepath from)) + +-- | Parse some Fay code. +parseFay :: Parseable ast => FilePath -> String -> ParseResult ast +parseFay filepath = parseWithMode parseMode { parseFilename = filepath } + +-- | The parse mode for Fay. +parseMode :: ParseMode +parseMode = defaultParseMode { extensions = + [GADTs,StandaloneDeriving,EmptyDataDecls,TypeOperators,RecordWildCards,NamedFieldPuns] } + +-- | Compile the given input and print the output out prettily. +printCompile :: (Show from,Show to,CompilesTo from to) + => CompileConfig + -> (from -> Compile to) + -> String + -> IO () +printCompile config with from = do + result <- compileViaStr "" config { configPrettyPrint = True } with from + case result of + Left err -> print err + Right (PrintState{..},_) -> do + putStrLn (concat (reverse (psOutput))) + +-- | Compile a String of Fay and print it as beautified JavaScript. +printTestCompile :: String -> IO () +printTestCompile = printCompile def { configWarn = False, + configDirectoryIncludes = [] } compileModule + +-- | 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@(Module _ (ModuleName modulename) _ _ _ _ _) = do + cfg <- gets stateConfig + when (configTypecheck cfg) $ + typecheck (configDirectoryIncludes cfg) [] (configWall cfg) $ + fromMaybe modulename $ configFilePath cfg + initialPass mod + cs <- liftIO $ defaultCompileState def + modify $ \s -> s { stateImported = stateImported cs } + stmts <- compileModule mod + fay2js <- do syms <- gets stateFayToJs + return $ if null syms then [] else [fayToJsDispatcher syms] + js2fay <- do syms <- gets stateJsToFay + return $ if null syms then [] else [jsToFayDispatcher syms] + let maybeOptimize = if configOptimize cfg then runOptimizer optimizeToplevel else id + return (maybeOptimize (stmts ++ fay2js ++ js2fay)) + +-------------------------------------------------------------------------------- +-- Initial pass-through collecting record definitions + +initialPass :: Module -> Compile () +initialPass (Module _ _ _ Nothing _ imports decls) = do + mapM_ initialPass_import (map translateModuleName imports) + mapM_ (initialPass_decl True) decls + +initialPass mod = throwError (UnsupportedModuleSyntax mod) + +initialPass_import :: ImportDecl -> Compile () +initialPass_import (ImportDecl _ "Prelude" _ _ _ _ _) = return () +initialPass_import (ImportDecl _ name False _ Nothing Nothing Nothing) = do + void $ unlessImported name $ \filepath contents -> do + state <- gets id + result <- liftIO $ initialPass_records filepath state initialPass contents + case result of + Right ((),st) -> 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 st + , stateImported = stateImported st + } + Left err -> throwError err + return [] + +initialPass_import i = throwError $ UnsupportedImport i + +initialPass_records :: (Show from,Parseable from) + => FilePath + -> CompileState + -> (from -> Compile ()) + -> String + -> IO (Either CompileError ((),CompileState)) +initialPass_records filepath compileState with from = + runCompile compileState + (parseResult (throwError . uncurry ParseError) + with + (parseFay filepath 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 name types -> do + let fields = map (Ident . ("slot"++) . show . fst) . zip [1 :: Integer ..] $ types + addRecordState name fields + InfixConDecl _t1 name _t2 -> + addRecordState name ["slot1", "slot2"] + RecDecl name fields' -> do + let fields = concatMap fst fields' + addRecordState name fields + + where + addRecordState :: Name -> [Name] -> Compile () + addRecordState name fields = modify $ \s -> s + { stateRecords = (UnQual name,map UnQual fields) : stateRecords s } + +-------------------------------------------------------------------------------- +-- Typechecking + +typecheck :: [FilePath] -> [String] -> Bool -> String -> Compile () +typecheck includeDirs ghcFlags wall fp = do + res <- liftIO $ readAllFromProcess' "ghc" ( + ["-fno-code", "-package fay", "-XNoImplicitPrelude", fp] ++ map ("-i" ++) includeDirs ++ ghcFlags ++ wallF) "" + either error (warn . fst) res + where + wallF | wall = ["-Wall"] + | otherwise = [] + +-------------------------------------------------------------------------------- +-- Compilers + +-- | Compile Haskell module. +compileModule :: Module -> Compile [JsStmt] +compileModule (Module _ modulename _pragmas Nothing exports imports decls) = do + modify $ \s -> s { stateModuleName = modulename + , stateExportAll = isNothing exports + , stateExports = [] + } + imported <- fmap concat (mapM (compileImport . translateModuleName) imports) + current <- compileDecls True decls + -- If an export list is given we populate it beforehand, + -- if not then bindToplevel will export each declaration when it's visited. + mapM_ emitExport (fromMaybe [] exports) + return (imported ++ current) +compileModule mod = throwError (UnsupportedModuleSyntax mod) + +translateModuleName :: ImportDecl -> ImportDecl +-- The *.Prelude module doesn't contain actual code, but code to +-- appease GHC. The real code is in Stdlib, which could also be +-- imported directly, but it seems nicer to use Prelude. And maybe we +-- can fix this in the future so that Prelude contains the real +-- code. Doubt it, but it could happen. +translateModuleName (ImportDecl a (ModuleName "Language.Fay.Prelude") b c d e f) = + (ImportDecl a (ModuleName "Language.Fay.Stdlib") b c d e f) +translateModuleName x = x + +warn :: String -> Compile () +warn "" = return () +warn w = do + shouldWarn <- configWarn <$> gets stateConfig + when shouldWarn . liftIO . hPutStrLn stderr $ "Warning: " ++ w + +instance CompilesTo Module [JsStmt] where compileTo = compileModule + +findImport :: [FilePath] -> ModuleName -> Compile (FilePath,String) +findImport alldirs mname = go alldirs mname where + go (dir:dirs) name = do + exists <- io (doesFileExist path) + if exists + then fmap (path,) (fmap stdlibHack (io (readFile path))) + else go dirs name + where + path = dir replace '.' '/' (prettyPrint name) ++ ".hs" + replace c r = map (\x -> if x == c then r else x) + go [] name = + throwError $ Couldn'tFindImport name alldirs + + stdlibHack + | mname == ModuleName "Language.Fay.Stdlib" = \s -> s ++ "\n\ndata Maybe a = Just a | Nothing" + | otherwise = id + +-- | Compile the given import. +compileImport :: ImportDecl -> Compile [JsStmt] +compileImport (ImportDecl _ "Prelude" _ _ _ _ _) = return [] +compileImport (ImportDecl _ name False _ Nothing Nothing Nothing) = do + unlessImported name $ \filepath contents -> do + state <- gets id + result <- liftIO $ compileToAst filepath state compileModule contents + case result of + Right (stmts,state) -> do + modify $ \s -> s { stateFayToJs = stateFayToJs state + , stateJsToFay = stateJsToFay state + , stateImported = stateImported state + , stateScope = mergeScopes (addExportsToScope (stateExports state) (stateScope s)) + (stateScope state) + } + return stmts + Left err -> throwError err +compileImport i = throwError $ UnsupportedImport i + +-- | Add the new scopes to the old one, stripping out local bindings. +mergeScopes :: Map Name [NameScope] -> Map Name [NameScope] -> Map Name [NameScope] +mergeScopes old new = + M.map (filter (/=ScopeBinding)) + (foldr (\(key,val) -> M.insertWith (++) key val) old (M.assocs new)) + +-- | Add +addExportsToScope :: [QName] -> Map Name [NameScope] -> Map Name [NameScope] +addExportsToScope exports mapping = foldr copy mapping exports where + copy e = + case e of + Qual modname name -> M.insertWith (++) name [ScopeImported modname Nothing] + UnQual name -> error $ "Exports should not be unqualified: " ++ prettyPrint name + Special{} -> error $ "Don't be silly." + +-- | Don't re-import the same modules. +unlessImported :: ModuleName -> (FilePath -> String -> Compile [JsStmt]) -> Compile [JsStmt] +unlessImported name importIt = do + imported <- gets stateImported + case lookup name imported of + Just _ -> return [] + Nothing -> do + dirs <- configDirectoryIncludes <$> gets stateConfig + (filepath,contents) <- findImport dirs name + modify $ \s -> s { stateImported = (name,filepath) : imported } + importIt filepath contents + +-- | Compile Haskell declaration. +compileDecls :: Bool -> [Decl] -> Compile [JsStmt] +compileDecls toplevel decls = + case decls of + [] -> return [] + (TypeSig _ _ sig:bind@PatBind{}:decls) -> appendM (scoped (compilePatBind toplevel (Just sig) bind)) + (compileDecls toplevel decls) + (decl:decls) -> appendM (scoped (compileDecl toplevel decl)) + (compileDecls toplevel decls) + + where appendM m n = do x <- m + xs <- n + return (x ++ xs) + scoped = if toplevel then withScope else id + +-- | Compile a declaration. +compileDecl :: Bool -> Decl -> Compile [JsStmt] +compileDecl toplevel decl = + case decl of + 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) + +instance CompilesTo Decl [JsStmt] where compileTo = compileDecl True + +-- | Compile a top-level pattern bind. +compilePatBind :: Bool -> Maybe Type -> Decl -> Compile [JsStmt] +compilePatBind toplevel sig pat = + case pat of + PatBind srcloc (PVar ident) Nothing (UnGuardedRhs rhs) (BDecls []) -> + case ffiExp rhs of + Just formatstr -> case sig of + Just sig -> compileFFI srcloc ident formatstr sig + Nothing -> throwError (FfiNeedsTypeSig pat) + _ -> compileUnguardedRhs srcloc toplevel ident rhs + PatBind srcloc (PVar ident) Nothing (UnGuardedRhs rhs) bdecls -> do + compileUnguardedRhs srcloc toplevel ident (Let bdecls rhs) + _ -> throwError (UnsupportedDeclaration pat) + + where ffiExp (App (Var (UnQual (Ident "ffi"))) (Lit (String formatstr))) = Just formatstr + ffiExp _ = Nothing + +-- | Compile a normal simple pattern binding. +compileUnguardedRhs :: SrcLoc -> Bool -> Name -> Exp -> Compile [JsStmt] +compileUnguardedRhs srcloc toplevel ident rhs = do + bindVar ident + withScope $ do + body <- compileExp rhs + bind <- bindToplevel srcloc toplevel 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 = + fmap concat $ + forM constructors $ \(QualConDecl srcloc _ _ condecl) -> + case condecl of + ConDecl name types -> do + let fields = map (Ident . ("slot"++) . show . fst) . zip [1 :: Integer ..] $ types + 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 name t2 -> do + let slots = ["slot1","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 name fields' -> do + let fields = concatMap fst fields' + cons <- makeConstructor name fields + func <- makeFunc name fields + funs <- makeAccessors srcloc fields + emitFayToJs name fields' + emitJsToFay name fields' + return (cons : func : funs) + + where + -- Creates a constructor R_RecConstr for a Record + makeConstructor :: Name -> [Name] -> Compile JsStmt + makeConstructor name (map (JsNameVar . UnQual) -> fields) = do + qname <- qualify name + emitExport (EVar qname) + return $ + JsVar (JsConstructor qname) $ + JsFun fields (for fields $ \field -> JsSetProp JsThis field (JsName field)) + Nothing + + -- Creates a function to initialize the record by regular application + makeFunc :: Name -> [Name] -> Compile JsStmt + makeFunc name (map (JsNameVar . UnQual) -> fields) = do + let fieldExps = map JsName fields + qname <- qualify name + return $ JsVar (JsNameVar qname) $ + foldr (\slot inner -> JsFun [slot] [] (Just inner)) + (thunk $ JsNew (JsConstructor qname) fieldExps) + fields + + -- Creates getters for a RecDecl's values + makeAccessors :: SrcLoc -> [Name] -> Compile [JsStmt] + makeAccessors srcloc fields = + forM fields $ \name -> + bindToplevel srcloc + toplevel + name + (JsFun [JsNameVar "x"] + [] + (Just (thunk (JsGetProp (force (JsName (JsNameVar "x"))) + (JsNameVar (UnQual name)))))) + +-- | Compile a function which pattern matches (causing a case analysis). +compileFunCase :: Bool -> [Match] -> Compile [JsStmt] +compileFunCase _toplevel [] = return [] +compileFunCase toplevel matches@(Match srcloc name argslen _ _ _:_) = do + pats <- fmap optimizePatConditions (mapM compileCase matches) + bindVar name + bind <- bindToplevel srcloc + toplevel + name + (foldr (\arg inner -> JsFun [arg] [] (Just inner)) + (stmtsThunk (concat pats ++ basecase)) + args) + return [bind] + where args = zipWith const uniqueNames argslen + + isWildCardMatch (Match _ _ pats _ _ _) = all isWildCardPat pats + + compileCase :: Match -> Compile [JsStmt] + compileCase match@(Match _ _ pats _ rhs _) = do + withScope $ do + whereDecls' <- whereDecls match + generateScope $ mapM (\(arg,pat) -> compilePat (JsName arg) pat []) (zip args pats) + generateScope $ mapM compileLetDecl whereDecls' + rhsform <- compileRhs rhs + body <- if null whereDecls' + then return $ either id JsEarlyReturn rhsform + else do + binds <- mapM compileLetDecl whereDecls' + return $ case rhsform of + Right exp -> + (JsEarlyReturn (JsApp (JsFun [] (concat binds) (Just exp)) [])) + Left stmt -> + (JsEarlyReturn (JsApp (JsFun [] (concat binds ++ [stmt]) Nothing) [])) + foldM (\inner (arg,pat) -> + compilePat (JsName arg) pat inner) + [body] + (zip args pats) + + whereDecls :: Match -> Compile [Decl] + whereDecls (Match _ _ _ _ _ (BDecls decls)) = return decls + whereDecls match = throwError (UnsupportedWhereInMatch match) + + basecase :: [JsStmt] + basecase = if any isWildCardMatch matches + then [] + else [throw ("unhandled case in " ++ prettyPrint name) + (JsList (map JsName args))] + +-- | Compile a right-hand-side expression. +compileRhs :: Rhs -> Compile (Either JsStmt JsExp) +compileRhs (UnGuardedRhs exp) = Right <$> compileExp exp +compileRhs (GuardedRhss rhss) = Left <$> compileGuards rhss + +-- | Compile guards +compileGuards :: [GuardedRhs] -> Compile JsStmt +compileGuards ((GuardedRhs _ (Qualifier (Var (UnQual (Ident "otherwise"))):_) exp):_) = + (\e -> JsIf (JsLit (JsBool True)) [JsEarlyReturn e] []) <$> compileExp exp +compileGuards (GuardedRhs _ (Qualifier guard:_) exp : rest) = + makeIf <$> fmap force (compileExp guard) + <*> compileExp exp + <*> if null rest then (return []) else do + gs' <- compileGuards rest + return [gs'] + where makeIf gs e gss = JsIf gs [JsEarlyReturn e] gss + +compileGuards rhss = throwError . UnsupportedRhs . GuardedRhss $ rhss + +-- | Compile Haskell expression. +compileExp :: Exp -> Compile JsExp +compileExp exp = + case exp of + Paren exp -> compileExp exp + Var qname -> compileVar qname + Lit lit -> compileLit lit + App exp1 exp2 -> compileApp exp1 exp2 + NegApp exp -> compileNegApp exp + InfixApp exp1 op exp2 -> compileInfixApp exp1 op exp2 + Let (BDecls decls) exp -> compileLet decls exp + List [] -> return JsNull + List xs -> compileList xs + Tuple xs -> compileList xs + If cond conseq alt -> compileIf cond conseq alt + Case exp alts -> compileCase exp alts + Con (UnQual (Ident "True")) -> return (JsLit (JsBool True)) + Con (UnQual (Ident "False")) -> return (JsLit (JsBool False)) + Con qname -> compileVar qname + Do stmts -> compileDoBlock stmts + Lambda _ pats exp -> compileLambda pats exp + EnumFrom i -> do e <- compileExp i + name <- resolveName "enumFrom" + return (JsApp (JsName (JsNameVar name)) [e]) + EnumFromTo i i' -> do f <- compileExp i + t <- compileExp i' + name <- resolveName "enumFromTo" + return (JsApp (JsApp (JsName (JsNameVar name)) [f]) + [t]) + RecConstr name fieldUpdates -> compileRecConstr name fieldUpdates + RecUpdate rec fieldUpdates -> updateRec rec fieldUpdates + ListComp exp stmts -> compileExp =<< desugarListComp exp stmts + ExpTypeSig _ e _ -> compileExp e + + exp -> throwError (UnsupportedExpression exp) + +instance CompilesTo Exp JsExp where compileTo = compileExp + +compileVar :: QName -> Compile JsExp +compileVar qname = do + qname <- resolveName qname + return (JsName (JsNameVar qname)) + +-- | Compile simple application. +compileApp :: Exp -> Exp -> Compile JsExp +compileApp exp1 exp2 = do + flattenApps <- config configFlattenApps + if flattenApps then method2 else method1 + where + -- Method 1: + -- In this approach code ends up looking like this: + -- a(a(a(a(a(a(a(a(a(a(L)(c))(b))(0))(0))(y))(t))(a(a(F)(3*a(a(d)+a(a(f)/20))))*a(a(f)/2)))(140+a(f)))(y))(t)}) + -- Which might be OK for speed, but increases the JS stack a fair bit. + method1 = + JsApp <$> (forceFlatName <$> compileExp exp1) + <*> fmap return (compileExp exp2) + forceFlatName name = JsApp (JsName JsForce) [name] + + -- Method 2: + -- In this approach code ends up looking like this: + -- d(O,a,b,0,0,B,w,e(d(I,3*e(e(c)+e(e(g)/20))))*e(e(g)/2),140+e(g),B,w)}),d(K,g,e(c)+0.05)) + -- Which should be much better for the stack and readability, but probably not great for speed. + method2 = fmap flatten $ + JsApp <$> compileExp exp1 + <*> fmap return (compileExp exp2) + flatten (JsApp op args) = + case op of + JsApp l r -> JsApp l (r ++ args) + _ -> JsApp (JsName JsApply) (op : args) + flatten x = x + +-- | Compile a negate application +compileNegApp :: Exp -> Compile JsExp +compileNegApp e = JsNegApp . force <$> compileExp e + +-- | Compile an infix application, optimizing the JS cases. +compileInfixApp :: Exp -> QOp -> Exp -> Compile JsExp +compileInfixApp exp1 ap exp2 = do + qname <- resolveName op + case qname of + -- We can optimize prim ops. :-) + Qual "Fay$" _ + | prettyPrint ap `elem` words "* + - / < > || &&" -> do + e1 <- compileExp exp1 + e2 <- compileExp exp2 + fn <- compileExp (Var op) + return $ JsApp (JsApp (force fn) [force e1]) [force e2] + _ -> compileExp (App (App (Var qname) exp1) exp2) + + where op = getOp ap + getOp (QVarOp op) = op + getOp (QConOp op) = op + +-- | Compile a list expression. +compileList :: [Exp] -> Compile JsExp +compileList xs = do + exps <- mapM compileExp xs + return (makeList exps) + +makeList :: [JsExp] -> JsExp +makeList exps = (JsApp (JsName (JsBuiltIn "list")) [JsList exps]) + +-- | Compile an if. +compileIf :: Exp -> Exp -> Exp -> Compile JsExp +compileIf cond conseq alt = + JsTernaryIf <$> fmap force (compileExp cond) + <*> compileExp conseq + <*> compileExp alt + +-- | Compile a lambda. +compileLambda :: [Pat] -> Exp -> Compile JsExp +compileLambda pats exp = do + withScope $ do + generateScope $ generateStatements JsNull + exp <- compileExp exp + stmts <- generateStatements exp + case stmts of + [JsEarlyReturn fun@JsFun{}] -> return fun + _ -> error "Unexpected statements in compileLambda" + + where unhandledcase = throw "unhandled case" . JsName + allfree = all isWildCardPat pats + generateStatements exp = + foldM (\inner (param,pat) -> do + stmts <- compilePat (JsName param) pat inner + return [JsEarlyReturn (JsFun [param] (stmts ++ [unhandledcase param | not allfree]) Nothing)]) + [JsEarlyReturn exp] + (reverse (zip uniqueNames pats)) + +-- | Compile list comprehensions. +desugarListComp :: Exp -> [QualStmt] -> Compile Exp +desugarListComp e [] = + return (List [ e ]) +desugarListComp e (QualStmt (Generator loc p e2) : stmts) = do + nested <- desugarListComp e stmts + withScopedTmpName $ \f -> + return (Let (BDecls [ FunBind [ + Match loc f [ p ] Nothing (UnGuardedRhs nested) (BDecls []), + Match loc f [ PWildCard ] Nothing (UnGuardedRhs (List [])) (BDecls []) + ]]) (App (App (Var (UnQual (Ident "concatMap"))) (Var (UnQual f))) e2)) +desugarListComp e (QualStmt (Qualifier e2) : stmts) = do + nested <- desugarListComp e stmts + return (If e2 nested (List [])) +desugarListComp e (QualStmt (LetStmt bs) : stmts) = do + nested <- desugarListComp e stmts + return (Let bs nested) +desugarListComp _ (s : _ ) = + throwError (UnsupportedQualStmt s) + +-- | Compile case expressions. +compileCase :: Exp -> [Alt] -> Compile JsExp +compileCase exp alts = do + exp <- compileExp exp + withScopedTmpJsName $ \tmpName -> do + pats <- fmap optimizePatConditions $ mapM (compilePatAlt (JsName tmpName)) alts + return $ + JsApp (JsFun [tmpName] + (concat pats) + (if any isWildCardAlt alts + then Nothing + else Just (throwExp "unhandled case" (JsName tmpName)))) + [exp] + +-- | Compile a do block. +compileDoBlock :: [Stmt] -> Compile JsExp +compileDoBlock stmts = do + doblock <- foldM compileStmt Nothing (reverse stmts) + maybe (throwError EmptyDoBlock) compileExp doblock + +-- | Compile a statement of a do block. +compileStmt :: Maybe Exp -> Stmt -> Compile (Maybe Exp) +compileStmt inner stmt = + case inner of + Nothing -> initStmt + Just inner -> subsequentStmt inner + + where initStmt = + case stmt of + Qualifier exp -> return (Just exp) + LetStmt{} -> throwError LetUnsupported + _ -> throwError InvalidDoBlock + + subsequentStmt inner = + case stmt of + Generator loc pat exp -> compileGenerator loc pat inner exp + Qualifier exp -> return (Just (InfixApp exp + (QVarOp (UnQual (Symbol ">>"))) + inner)) + LetStmt (BDecls binds) -> return (Just (Let (BDecls binds) inner)) + LetStmt _ -> throwError LetUnsupported + RecStmt{} -> throwError RecursiveDoUnsupported + + compileGenerator srcloc pat inner exp = do + let body = Lambda srcloc [pat] inner + return (Just (InfixApp exp + (QVarOp (UnQual (Symbol ">>="))) + body)) + +-- | Compile the given pattern against the given expression. +compilePatAlt :: JsExp -> Alt -> Compile [JsStmt] +compilePatAlt exp (Alt _ pat rhs _) = do + withScope $ do + generateScope $ compilePat exp pat [] + alt <- compileGuardedAlt rhs + compilePat exp pat [JsEarlyReturn alt] + +-- | Compile the given pattern against the given expression. +compilePat :: JsExp -> Pat -> [JsStmt] -> Compile [JsStmt] +compilePat exp pat body = + case pat of + PVar name -> compilePVar name exp body + PApp cons pats -> compilePApp cons pats exp body + PLit literal -> compilePLit exp literal body + PParen pat -> compilePat exp pat body + PWildCard -> return body + pat@PInfixApp{} -> compileInfixPat exp pat body + PList pats -> compilePList pats body exp + PTuple pats -> compilePList pats body exp + PAsPat name pat -> compilePAsPat exp name pat body + PRec name pats -> compilePatFields exp name pats body + pat -> throwError (UnsupportedPattern pat) + +-- | Compile a pattern variable e.g. x. +compilePVar :: Name -> JsExp -> [JsStmt] -> Compile [JsStmt] +compilePVar name exp body = do + bindVar name + return $ JsVar (JsNameVar (UnQual name)) exp : body + +-- | Compile a record field pattern. +compilePatFields :: JsExp -> QName -> [PatField] -> [JsStmt] -> Compile [JsStmt] +compilePatFields exp name pats body = do + c <- liftM (++ body) (compilePats' [] pats) + qname <- resolveName name + return [JsIf (force exp `JsInstanceOf` JsConstructor qname) c []] + where -- compilePats' collects field names that had already been matched so that + -- wildcard generates code for the rest of the fields. + compilePats' :: [QName] -> [PatField] -> Compile [JsStmt] + compilePats' names (PFieldPun name:xs) = + compilePats' names (PFieldPat (UnQual name) (PVar name):xs) + + compilePats' names (PFieldPat fieldname (PVar varName):xs) = do + r <- compilePats' (fieldname : names) xs + bindVar varName + return $ JsVar (JsNameVar (UnQual varName)) + (JsGetProp (force exp) (JsNameVar fieldname)) + : r -- TODO: think about this force call + + compilePats' names (PFieldWildcard:xs) = do + records <- liftM stateRecords get + let fields = fromJust (lookup name records) + fields' = fields \\ names + f <- mapM (\fieldName -> do bindVar (unQual fieldName) + return (JsVar (JsNameVar fieldName) + (JsGetProp (force exp) (JsNameVar fieldName)))) + fields' + r <- compilePats' names xs + return $ f ++ r + + compilePats' _ [] = return [] + + compilePats' _ (pat:_) = throwError (UnsupportedFieldPattern pat) + + unQual (Qual _ n) = n + unQual (UnQual n) = n + unQual Special{} = error "Trying to unqualify a Special..." + +-- | Compile a literal value from a pattern match. +compilePLit :: JsExp -> Literal -> [JsStmt] -> Compile [JsStmt] +compilePLit exp literal body = do + lit <- compileLit literal + return [JsIf (equalExps exp lit) + body + []] + + where -- Equality test for two expressions, with some optimizations. + equalExps :: JsExp -> JsExp -> JsExp + equalExps a b + | isConstant a && isConstant b = JsEq a b + | isConstant a = JsEq a (force b) + | isConstant b = JsEq (force a) b + | otherwise = + JsApp (JsName (JsBuiltIn "equal")) [a,b] + +-- | Compile as binding in pattern match +compilePAsPat :: JsExp -> Name -> Pat -> [JsStmt] -> Compile [JsStmt] +compilePAsPat exp name pat body = do + bindVar name + x <- compilePat exp pat body + return ([JsVar (JsNameVar (UnQual name)) exp] ++ x ++ body) + +-- | Compile a record construction with named fields +-- | GHC will warn on uninitialized fields, they will be undefined in JS. +compileRecConstr :: QName -> [FieldUpdate] -> Compile JsExp +compileRecConstr name fieldUpdates = do + -- var obj = new $_Type() + qname <- resolveName name + let record = JsVar (JsNameVar name) (JsNew (JsConstructor qname) []) + setFields <- liftM concat (forM fieldUpdates (updateStmt name)) + return $ JsApp (JsFun [] (record:setFields) (Just (JsName (JsNameVar name)))) [] + where updateStmt :: QName -> FieldUpdate -> Compile [JsStmt] + updateStmt o (FieldUpdate field value) = do + exp <- compileExp value + return [JsSetProp (JsNameVar o) (JsNameVar field) exp] + updateStmt name FieldWildcard = do + records <- liftM stateRecords get + let fields = fromJust (lookup name records) + return (map (\fieldName -> JsSetProp (JsNameVar name) + (JsNameVar fieldName) + (JsName (JsNameVar fieldName))) + fields) + -- TODO: FieldPun + -- I couldn't find a code that generates (FieldUpdate (FieldPun ..)) + updateStmt _ u = error ("updateStmt: " ++ show u) + +updateRec :: Exp -> [FieldUpdate] -> Compile JsExp +updateRec rec fieldUpdates = do + record <- force <$> compileExp rec + let copyName = UnQual (Ident "$_record_to_update") + copy = JsVar (JsNameVar copyName) + (JsRawExp ("Object.create(" ++ printJSString record ++ ")")) + setFields <- forM fieldUpdates (updateExp copyName) + return $ JsApp (JsFun [] (copy:setFields) (Just (JsName (JsNameVar copyName)))) [] + where updateExp :: QName -> FieldUpdate -> Compile JsStmt + updateExp copyName (FieldUpdate field value) = + JsSetProp (JsNameVar copyName) (JsNameVar field) <$> compileExp value + updateExp copyName (FieldPun name) = + -- let a = 1 in C {a} + return $ JsSetProp (JsNameVar copyName) + (JsNameVar (UnQual name)) + (JsName (JsNameVar (UnQual name))) + -- TODO: FieldWildcard + -- I also couldn't find a code that generates (FieldUpdate FieldWildCard) + updateExp _ FieldWildcard = error "unsupported update: FieldWildcard" + +-- | Compile a pattern application. +compilePApp :: QName -> [Pat] -> JsExp -> [JsStmt] -> Compile [JsStmt] +compilePApp cons pats exp body = do + let forcedExp = force exp + let boolIf b = return [JsIf (JsEq forcedExp (JsLit (JsBool b))) body []] + case cons of + -- Special-casing on the booleans. + "True" -> boolIf True + "False" -> boolIf False + -- Everything else, generic: + _ -> do + rf <- fmap (lookup cons) (gets stateRecords) + let recordFields = + fromMaybe + (error $ "Constructor '" ++ prettyPrint cons ++ + "' was not found in stateRecords, did you try running this through GHC first?") + rf + substmts <- foldM (\body (field,pat) -> + compilePat (JsGetProp forcedExp (JsNameVar field)) pat body) + body + (reverse (zip recordFields pats)) + qcons <- resolveName cons + return [JsIf (forcedExp `JsInstanceOf` JsConstructor qcons) + substmts + []] + +-- | Compile a pattern list. +compilePList :: [Pat] -> [JsStmt] -> JsExp -> Compile [JsStmt] +compilePList [] body exp = + return [JsIf (JsEq (force exp) JsNull) body []] +compilePList pats body exp = do + let forcedExp = force exp + stmts <- foldM (\body (i,pat) -> compilePat (JsApp (JsApp (JsName (JsBuiltIn "index")) + [JsLit (JsInt i)]) + [forcedExp]) + pat body) + body + (reverse (zip [0..] pats)) + let patsLen = JsLit (JsInt (length pats)) + return [JsIf (JsApp (JsName (JsBuiltIn "listLen")) [forcedExp,patsLen]) + stmts + []] + +-- | Compile an infix pattern (e.g. cons and tuples.) +compileInfixPat :: JsExp -> Pat -> [JsStmt] -> Compile [JsStmt] +compileInfixPat exp pat@(PInfixApp left (Special cons) right) body = + case cons of + Cons -> do + withScopedTmpJsName $ \tmpName -> do + let forcedExp = JsName tmpName + x = JsGetProp forcedExp (JsNameVar "car") + xs = JsGetProp forcedExp (JsNameVar "cdr") + rightMatch <- compilePat xs right body + leftMatch <- compilePat x left rightMatch + return [JsVar tmpName (force exp) + ,JsIf (JsInstanceOf forcedExp (JsBuiltIn "Cons")) + leftMatch + []] + _ -> throwError (UnsupportedPattern pat) +compileInfixPat _ pat _ = throwError (UnsupportedPattern pat) + +-- | Compile a guarded alt. +compileGuardedAlt :: GuardedAlts -> Compile JsExp +compileGuardedAlt alt = + case alt of + UnGuardedAlt exp -> compileExp exp + alt -> throwError (UnsupportedGuardedAlts alt) + +-- | Compile a let expression. +compileLet :: [Decl] -> Exp -> Compile JsExp +compileLet decls exp = do + withScope $ do + generateScope $ mapM compileLetDecl decls + binds <- mapM compileLetDecl decls + body <- compileExp exp + return (JsApp (JsFun [] (concat binds) (Just body)) []) + +-- | Compile let declaration. +compileLetDecl :: Decl -> Compile [JsStmt] +compileLetDecl decl = do + v <- case decl of + decl@PatBind{} -> compileDecls False [decl] + decl@FunBind{} -> compileDecls False [decl] + TypeSig{} -> return [] + _ -> throwError (UnsupportedLetBinding decl) + return v + +-- | Compile Haskell literal. +compileLit :: Literal -> Compile JsExp +compileLit lit = + case lit of + Char ch -> return (JsLit (JsChar ch)) + Int integer -> return (JsLit (JsInt (fromIntegral integer))) -- FIXME: + Frac rational -> return (JsLit (JsFloating (fromRational rational))) + -- TODO: Use real JS strings instead of array, probably it will + -- lead to the same result. + String string -> return (JsApp (JsName (JsBuiltIn "list")) + [JsLit (JsStr string)]) + lit -> throwError (UnsupportedLiteral lit) diff --git a/src/Language/Fay/Compiler/FFI.hs b/src/Language/Fay/Compiler/FFI.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fay/Compiler/FFI.hs @@ -0,0 +1,271 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS -Wall #-} + +-- | Compiling the FFI support. + +module Language.Fay.Compiler.FFI + (emitFayToJs + ,emitJsToFay + ,compileFFI + ,jsToFayDispatcher + ,fayToJsDispatcher) + where + +import Language.Fay.Compiler.Misc +import Language.Fay.Print (printJSString) +import Language.Fay.Types + +import Control.Monad.Error +import Control.Monad.State +import Data.Char +import Data.List +import Data.Maybe +import qualified Language.ECMAScript3.Parser as JS +import Language.Haskell.Exts (prettyPrint) +import Language.Haskell.Exts.Syntax +import Prelude hiding (exp) +import Safe + +-- | Compile an FFI call. +compileFFI :: SrcLoc -- ^ Location of the original FFI decl. + -> Name -- ^ Name of the to-be binding. + -> String -- ^ The format string. + -> Type -- ^ Type signature. + -> Compile [JsStmt] +compileFFI srcloc name formatstr sig = do + inner <- formatFFI formatstr (zip params funcFundamentalTypes) + case JS.parse JS.parseExpression (prettyPrint name) (printJSString (wrapReturn inner)) of + Left err -> throwError (FfiFormatInvalidJavaScript inner (show err)) + Right{} -> fmap return (bindToplevel srcloc True name (body inner)) + + where body inner = foldr wrapParam (wrapReturn inner) params + wrapParam pname inner = JsFun [pname] [] (Just inner) + params = zipWith const uniqueNames [1..typeArity sig] + wrapReturn inner = thunk $ + case lastMay funcFundamentalTypes of + -- Returns a “pure” value; + Just{} -> jsToFay returnType (JsRawExp inner) + -- Base case: + Nothing -> JsRawExp inner + funcFundamentalTypes = functionTypeArgs sig + returnType = last funcFundamentalTypes + +-- Make a Fay→JS encoder. +emitFayToJs :: Name -> [([Name],BangType)] -> Compile () +emitFayToJs name (explodeFields -> fieldTypes) = do + qname <- qualify name + modify $ \s -> s { stateFayToJs = translator qname : stateFayToJs s } + + where + translator qname = + JsIf (JsInstanceOf (JsName transcodingObjForced) (JsConstructor qname)) + (obj : fieldStmts fieldTypes ++ [ret]) + [] + + obj :: JsStmt + obj = JsVar obj_ $ + JsObj [("instance",JsLit (JsStr (printJSString name)))] + + fieldStmts :: [(Name,BangType)] -> [JsStmt] + fieldStmts [] = [] + fieldStmts (fieldType:fts) = + (JsVar obj_v field) : + (JsIf (JsNeq JsUndefined (JsName obj_v)) + [JsSetProp obj_ decl (JsName obj_v)] + []) : + fieldStmts fts + where + obj_v = JsNameVar (UnQual (Ident $ "obj_" ++ d)) + decl = JsNameVar (UnQual (Ident d)) + (d, field) = declField fieldType + + obj_ = JsNameVar (UnQual (Ident "obj_")) + + ret :: JsStmt + ret = JsEarlyReturn (JsName obj_) + + -- Declare/encode Fay→JS field + declField :: (Name,BangType) -> (String,JsExp) + declField (fname,typ) = + (prettyPrint fname + ,fayToJs (case argType (bangType typ) of + known -> typeRep known) + (force (JsGetProp (JsName transcodingObjForced) + (JsNameVar (UnQual fname))))) + +transcodingObj :: JsName +transcodingObj = JsNameVar "obj" + +transcodingObjForced :: JsName +transcodingObjForced = JsNameVar "_obj" + +-- | Get arg types of a function type. +functionTypeArgs :: Type -> [FundamentalType] +functionTypeArgs t = + case t of + TyForall _ _ i -> functionTypeArgs i + TyFun a b -> argType a : functionTypeArgs b + TyParen st -> functionTypeArgs st + r -> [argType r] + +-- | Convert a Haskell type to an internal FFI representation. +argType :: Type -> FundamentalType +argType t = + case t of + TyCon "String" -> StringType + TyCon "Double" -> DoubleType + TyCon "Int" -> IntType + TyCon "Bool" -> BoolType + TyApp (TyCon "Defined") a -> Defined (argType a) + TyApp (TyCon "Fay") a -> JsType (argType a) + TyFun x xs -> FunctionType (argType x : functionTypeArgs xs) + TyList x -> ListType (argType x) + TyTuple _ xs -> TupleType (map argType xs) + TyParen st -> argType st + 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 + +-- | Extract the type. +bangType :: BangType -> Type +bangType typ = + case typ of + BangedTy ty -> ty + UnBangedTy ty -> ty + UnpackedTy ty -> ty + +-- | Expand a type application. +expandApp :: Type -> [Type] +expandApp (TyParen t) = expandApp t +expandApp (TyApp op arg) = arg : expandApp op +expandApp x = [x] + +-- | Generate a user-defined type. +userDefined :: [Type] -> FundamentalType +userDefined (TyCon (UnQual name):typs) = UserDefined name (map argType typs) +userDefined _ = UnknownType + +-- | Translate: JS → Fay. +jsToFay :: FundamentalType -> JsExp -> JsExp +jsToFay typ exp = JsApp (JsName (JsBuiltIn "jsToFay")) + [typeRep typ,exp] + +-- | Translate: Fay → JS. +fayToJs :: JsExp -> JsExp -> JsExp +fayToJs typ exp = JsApp (JsName (JsBuiltIn "fayToJs")) + [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]] + TupleType xs -> JsList [JsLit $ JsStr "tuple",JsList (map typeRep xs)] + UserDefined name xs -> JsList [JsLit $ JsStr "user" + ,JsLit $ JsStr (unname name) + ,JsList (map typeRep xs)] + Defined x -> JsList [JsLit $ JsStr "defined",JsList [typeRep x]] + _ -> JsList [JsLit $ JsStr nom] + + where nom = case typ of + StringType -> "string" + DoubleType -> "double" + IntType -> "int" + BoolType -> "bool" + DateType -> "date" + _ -> "unknown" + +-- | Get the arity of a type. +typeArity :: Type -> Int +typeArity t = + case t of + TyForall _ _ i -> typeArity i + TyFun _ b -> 1 + typeArity b + TyParen st -> typeArity st + _ -> 0 + +-- | Format the FFI format string with the given arguments. +formatFFI :: String -- ^ The format string. + -> [(JsName,FundamentalType)] -- ^ Arguments. + -> Compile String -- ^ The JS code. +formatFFI formatstr args = go formatstr where + go ('%':'*':xs) = do + these <- mapM inject (zipWith const [1..] args) + rest <- go xs + return (intercalate "," these ++ rest) + go ('%':'%':xs) = do + rest <- go xs + return ('%' : rest) + go ['%'] = throwError FfiFormatIncompleteArg + go ('%':(span isDigit -> (op,xs))) = + case readMay op of + Nothing -> throwError (FfiFormatBadChars op) + Just n -> do + this <- inject n + rest <- go xs + return (this ++ rest) + go (x:xs) = do rest <- go xs + return (x : rest) + go [] = return [] + + inject n = + case listToMaybe (drop (n-1) args) of + Nothing -> throwError (FfiFormatNoSuchArg n) + Just (arg,typ) -> do + return (printJSString (fayToJs (typeRep typ) (JsName arg))) + +explodeFields :: [([a], t)] -> [(a, t)] +explodeFields = concatMap $ \(names,typ) -> map (,typ) names + +fayToJsDispatcher :: [JsStmt] -> JsStmt +fayToJsDispatcher cases = + JsVar (JsBuiltIn "fayToJsUserDefined") + (JsFun [JsNameVar "type",transcodingObj] + (decl ++ cases ++ [baseCase]) + Nothing) + + where decl = [JsVar transcodingObjForced + (force (JsName transcodingObj)) + ,JsVar (JsNameVar "argTypes") + (JsLookup (JsName (JsNameVar "type")) + (JsLit (JsInt 2)))] + baseCase = + JsEarlyReturn (JsName transcodingObj) + +jsToFayDispatcher :: [JsStmt] -> JsStmt +jsToFayDispatcher cases = + JsVar (JsBuiltIn "jsToFayUserDefined") + (JsFun [JsNameVar "type",transcodingObj] + (cases ++ [baseCase]) + Nothing) + + where baseCase = + JsEarlyReturn (JsName transcodingObj) + +-- Make a JS→Fay decoder +emitJsToFay :: Name -> [([Name], BangType)] -> Compile () +emitJsToFay name (explodeFields -> fieldTypes) = do + qname <- qualify name + modify $ \s -> s { stateJsToFay = translator qname : stateJsToFay s } + + where + translator qname = + JsIf (JsEq (JsGetPropExtern (JsName transcodingObj) "instance") + (JsLit (JsStr (printJSString name)))) + [JsEarlyReturn (JsNew (JsConstructor qname) + (map decodeField fieldTypes))] + [] + -- Decode JS→Fay field + decodeField :: (Name,BangType) -> JsExp + decodeField (fname,typ) = + jsToFay (argType (bangType typ)) + (JsGetPropExtern (JsName transcodingObj) + (prettyPrint fname)) diff --git a/src/Language/Fay/Compiler/Misc.hs b/src/Language/Fay/Compiler/Misc.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fay/Compiler/Misc.hs @@ -0,0 +1,234 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS -Wall -fno-warn-orphans #-} + +-- | Miscellaneous functions used throughout the compiler. + +module Language.Fay.Compiler.Misc where + +import Language.Fay.Types + +import Control.Applicative +import Control.Monad.Error +import Control.Monad.State +import Data.List +import qualified Data.Map as M +import Data.Maybe +import Data.String +import Language.Haskell.Exts (ParseResult(..)) +import Language.Haskell.Exts.Syntax +import Prelude hiding (exp) + +-- | Extra the string from an ident. +unname :: Name -> String +unname (Ident str) = str +unname _ = error "Expected ident from uname." -- FIXME: + +-- | Make an identifier from the built-in HJ module. +fayBuiltin :: String -> QName +fayBuiltin = Qual (ModuleName "Fay$") . Ident + +-- | Wrap an expression in a thunk. +thunk :: JsExp -> JsExp +-- thunk exp = JsNew (fayBuiltin "Thunk") [JsFun [] [] (Just exp)] +thunk expr = + case expr of + -- JS constants don't need to be in thunks, they're already strict. + JsLit{} -> expr + -- Functions (e.g. lets) used for introducing a new lexical scope + -- aren't necessary inside a thunk. This is a simple aesthetic + -- optimization. + JsApp fun@JsFun{} [] -> JsNew JsThunk [fun] + -- Otherwise make a regular thunk. + _ -> JsNew JsThunk [JsFun [] [] (Just expr)] + +-- | Wrap an expression in a thunk. +stmtsThunk :: [JsStmt] -> JsExp +stmtsThunk stmts = JsNew JsThunk [JsFun [] stmts Nothing] + +-- | Generate unique names. +uniqueNames :: [JsName] +uniqueNames = map JsParam [1::Integer ..] + +-- | Resolve a given maybe-qualified name to a fully qualifed name. +resolveName :: QName -> Compile QName +resolveName special@Special{} = return special +resolveName (UnQual name) = do +-- let echo = io . putStrLn +-- echo $ "Resolving name " ++ prettyPrint name + names <- gets stateScope +-- echo $ "Names are: " ++ show names + case M.lookup name names of + -- Unqualified and not imported? Current module. + Nothing -> qualify name + Just scopes -> case find localBinding scopes of + Just ScopeBinding -> return (UnQual name) + _ -> + case find simpleImport scopes of + Just (ScopeImported modulename replacement) -> return (Qual modulename (fromMaybe name replacement)) + _ -> case find asImport scopes of + Just (ScopeImportedAs _ modulename _) -> return (Qual modulename name) + _ -> throwError $ UnableResolveUnqualified name + + where asImport ScopeImportedAs{} = True + asImport _ = False + + localBinding ScopeBinding = True + localBinding _ = False + +resolveName (Qual modulename name) = do + names <- gets stateScope + case M.lookup name names of + -- Qualified and not imported? It's correct, leave it as-is. + Nothing -> return (Qual modulename name) + Just scopes -> case find simpleImport scopes of + Just (ScopeImported _ replacement) -> return (Qual modulename (fromMaybe name replacement)) + _ -> case find asMatch scopes of + Just (ScopeImported realname replacement) -> return (Qual realname (fromMaybe name replacement)) + _ -> throwError $ UnableResolveQualified (Qual modulename name) + + where asMatch i = case i of + ScopeImported{} -> True + ScopeImportedAs _ _ qmodulename -> qmodulename == moduleToName modulename + ScopeBinding -> False + where moduleToName (ModuleName n) = Ident n + +-- | Do have have a simple "import X" import on our hands? +simpleImport :: NameScope -> Bool +simpleImport ScopeImported{} = True +simpleImport _ = False + +-- | Qualify a name for the current module. +qualify :: Name -> Compile QName +qualify name = do + modulename <- gets stateModuleName + return (Qual modulename name) + +-- | Make a top-level binding. +bindToplevel :: SrcLoc -> Bool -> Name -> JsExp -> Compile JsStmt +bindToplevel srcloc toplevel name expr = do + qname <- (if toplevel then qualify else return . UnQual) name + exportAll <- gets stateExportAll + -- If exportAll is set this declaration has not been added to stateExports yet. + when (toplevel && exportAll) $ emitExport (EVar qname) + return (JsMappedVar srcloc (JsNameVar qname) expr) + +-- | Create a temporary scope and discard it after the given computation. +withScope :: Compile a -> Compile a +withScope m = do + scope <- gets stateScope + value <- m + modify $ \s -> s { stateScope = scope } + return value + +-- | Run a compiler and just get the scope information. +generateScope :: Compile a -> Compile () +generateScope m = do + st <- get + _ <- m + scope <- gets stateScope + put st { stateScope = scope } + +-- | Bind a variable in the current scope. +bindVar :: Name -> Compile () +bindVar name = do + modify $ \s -> s { stateScope = M.insertWith (++) name [ScopeBinding] (stateScope s) } + +-- | Emit exported names. +emitExport :: ExportSpec -> Compile () +emitExport spec = + case spec of + EVar (UnQual name) -> emitVar (UnQual name) + EVar name@Qual{} -> modify $ \s -> s { stateExports = name : stateExports s } + EThingAll (UnQual name) -> do + emitVar (UnQual name) + r <- lookup (UnQual name) <$> gets stateRecords + maybe (return ()) (mapM_ emitVar) r + EThingWith (UnQual name) ns -> do + emitVar (UnQual name) + mapM_ emitCName ns + EAbs _ -> return () -- Type only, skip + _ -> do + name <- gets stateModuleName + unless (name == "Language.Fay.Stdlib") $ + throwError (UnsupportedExportSpec spec) + where + emitVar n = resolveName n >>= emitExport . EVar + emitCName (VarName n) = emitVar (UnQual n) + emitCName (ConName n) = emitVar (UnQual n) + +-- | Force an expression in a thunk. +force :: JsExp -> JsExp +force expr + | isConstant expr = expr + | otherwise = JsApp (JsName JsForce) [expr] + +-- | Is a JS expression a literal (constant)? +isConstant :: JsExp -> Bool +isConstant JsLit{} = True +isConstant _ = False + +-- | Extract the string from a qname. +-- qname :: QName -> String +-- qname (UnQual (Ident str)) = str +-- qname (UnQual (Symbol sym)) = jsEncodeName sym +-- qname i = error $ "qname: Expected unqualified ident, found: " ++ show i -- FIXME: + +-- | Deconstruct a parse result (a la maybe, foldr, either). +parseResult :: ((SrcLoc,String) -> b) -> (a -> b) -> ParseResult a -> b +parseResult die ok result = + case result of + ParseOk a -> ok a + ParseFailed srcloc msg -> die (srcloc,msg) + +-- | Get a config option. +config :: (CompileConfig -> a) -> Compile a +config f = gets (f . stateConfig) + +-- | Optimize pattern matching conditions by merging conditions in common. +optimizePatConditions :: [[JsStmt]] -> [[JsStmt]] +optimizePatConditions = concatMap merge . groupBy sameIf where + sameIf [JsIf cond1 _ _] [JsIf cond2 _ _] = cond1 == cond2 + sameIf _ _ = False + merge xs@([JsIf cond _ _]:_) = + [[JsIf cond (concat (optimizePatConditions (map getIfConsequent xs))) []]] + merge noifs = noifs + getIfConsequent [JsIf _ cons _] = cons + getIfConsequent other = other + +-- | Throw a JS exception. +throw :: String -> JsExp -> JsStmt +throw msg expr = JsThrow (JsList [JsLit (JsStr msg),expr]) + +-- | Throw a JS exception (in an expression). +throwExp :: String -> JsExp -> JsExp +throwExp msg expr = JsThrowExp (JsList [JsLit (JsStr msg),expr]) + +-- | Is an alt a wildcard? +isWildCardAlt :: Alt -> Bool +isWildCardAlt (Alt _ pat _ _) = isWildCardPat pat + +-- | Is a pattern a wildcard? +isWildCardPat :: Pat -> Bool +isWildCardPat PWildCard{} = True +isWildCardPat PVar{} = True +isWildCardPat _ = False + +-- | Generate a temporary, SCOPED name for testing conditions and +-- such. +withScopedTmpJsName :: (JsName -> Compile a) -> Compile a +withScopedTmpJsName withName = do + depth <- gets stateNameDepth + modify $ \s -> s { stateNameDepth = depth + 1 } + ret <- withName $ JsTmp depth + modify $ \s -> s { stateNameDepth = depth } + return ret + +-- | Generate a temporary, SCOPED name for testing conditions and +-- such. We don't have name tracking yet, so instead we use this. +withScopedTmpName :: (Name -> Compile a) -> Compile a +withScopedTmpName withName = do + depth <- gets stateNameDepth + modify $ \s -> s { stateNameDepth = depth + 1 } + ret <- withName $ Ident $ "$gen" ++ show depth + modify $ \s -> s { stateNameDepth = depth } + return ret diff --git a/src/Language/Fay/Compiler/Optimizer.hs b/src/Language/Fay/Compiler/Optimizer.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fay/Compiler/Optimizer.hs @@ -0,0 +1,213 @@ +{-# OPTIONS -fno-warn-orphans #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE PatternGuards #-} + +module Language.Fay.Compiler.Optimizer where + +import Control.Applicative +import Control.Arrow (first) +import Control.Monad.Error +import Control.Monad.Writer +import Control.Monad.State +import Data.List +import Data.Maybe +import Language.Fay.Print +import Language.Fay.Types +import Language.Haskell.Exts (QName(..),ModuleName(..),Name(..)) +import Language.Haskell.Exts (SrcLoc(..)) +import Prelude hiding (exp) + +-- | The arity of a function. Arity here is defined to be the number +-- of arguments that can be directly uncurried from a curried lambda +-- abstraction. So \x y z -> if x then (\a -> a) else (\a -> a) has an +-- arity of 3, not 4. +type FuncArity = (QName,Int) + +-- | Optimize monad. +type Optimize = State OptState + +-- | State. +data OptState = OptState + { optStmts :: [JsStmt] + , optUncurry :: [QName] + } + +-- | Run an optimizer, which may output additional statements. +runOptimizer :: ([JsStmt] -> Optimize [JsStmt]) -> [JsStmt] -> [JsStmt] +runOptimizer optimizer stmts = + let (newstmts,OptState _ uncurried) = flip runState st $ optimizer stmts + in (newstmts ++ (tco (catMaybes (map (uncurryBinding newstmts) uncurried)))) + where st = OptState stmts [] + +-- | Perform any top-level cross-module optimizations and GO DEEP to +-- optimize further. +optimizeToplevel :: [JsStmt] -> Optimize [JsStmt] +optimizeToplevel = stripAndUncurry + +-- | Perform tail-call optimization. +tco :: [JsStmt] -> [JsStmt] +tco = map inStmt where + inStmt stmt = + case stmt of + JsMappedVar srcloc name exp -> JsMappedVar srcloc name (inject name exp) + JsVar name exp -> JsVar name (inject name exp) + e -> e + inject name exp = + case exp of + JsFun params [] (Just (JsNew JsThunk [JsFun [] stmts ret])) -> + JsFun params + [] + (Just + (JsNew JsThunk + [JsFun [] + (optimize params name (stmts ++ [ JsEarlyReturn e | Just e <- [ret] ])) + Nothing])) + _ -> exp + optimize params name stmts = result where + result = let (newstmts,w) = runWriter makeWhile + in if null w + then stmts + else newstmts + makeWhile = do + newstmts <- fmap concat (mapM swap stmts) + return [JsWhile (JsLit (JsBool True)) newstmts] + swap stmt = + case stmt of + JsEarlyReturn e + | tailCall e -> do tell [()] + return (rebind e ++ [JsContinue]) + | otherwise -> return [stmt] + JsIf p ithen ielse -> do + newithen <- fmap concat (mapM swap ithen) + newielse <- fmap concat (mapM swap ielse) + return [JsIf p newithen newielse] + e -> return [e] + tailCall (JsApp (JsName cname) _) = cname == name + tailCall _ = False + rebind (JsApp _ args) = zipWith go args params where + go arg param = JsUpdate param arg + rebind e = error . show $ e + +-- | Strip redundant forcing from the whole generated code. +stripAndUncurry :: [JsStmt] -> Optimize [JsStmt] +stripAndUncurry = applyToExpsInStmts stripFuncForces where + stripFuncForces arities exp = + case exp of + JsApp (JsName JsForce) [JsName (JsNameVar f)] + | Just _ <- lookup f arities -> return (JsName (JsNameVar f)) + JsFun ps stmts body -> do substmts <- mapM stripInStmt stmts + sbody <- maybe (return Nothing) (fmap Just . go) body + return (JsFun ps substmts sbody) + JsApp a b -> do + result <- walkAndStripForces arities exp + case result of + Just strippedExp -> go strippedExp + Nothing -> JsApp <$> go a <*> mapM go b + JsNegApp e -> JsNegApp <$> go e + JsTernaryIf a b c -> JsTernaryIf <$> go a <*> go b <*> go c + JsParen e -> JsParen <$> go e + JsUpdateProp e n a -> JsUpdateProp <$> go e <*> pure n <*> go a + JsList xs -> JsList <$> mapM go xs + JsEq a b -> JsEq <$> go a <*> go b + JsInfix op a b -> JsInfix op <$> go a <*> go b + JsObj xs -> JsObj <$> mapM (\(x,y) -> (x,) <$> go y) xs + JsNew name xs -> JsNew name <$> mapM go xs + e -> return e + + where go = stripFuncForces arities + stripInStmt = applyToExpsInStmt arities stripFuncForces + +-- | Strip redundant forcing from an application if possible. +walkAndStripForces :: [FuncArity] -> JsExp -> Optimize (Maybe JsExp) +walkAndStripForces arities = go True [] where + go frst args app = case app of + JsApp (JsName JsForce) [e] -> if frst + then do result <- go False args e + case result of + Nothing -> return Nothing + Just ex -> return (Just (JsApp (JsName JsForce) [ex])) + else go False args e + JsApp op [arg] -> go False (arg:args) op + JsName (JsNameVar f) + | Just arity <- lookup f arities, length args == arity -> do + modify $ \s -> s { optUncurry = f : optUncurry s } + return (Just (JsApp (JsName (JsNameVar (renameUncurried f))) args)) + _ -> return Nothing + +-- | Apply the given function to the top-level expressions in the +-- given statements. +applyToExpsInStmts :: ([FuncArity] -> JsExp -> Optimize JsExp) -> [JsStmt] -> Optimize [JsStmt] +applyToExpsInStmts f stmts = mapM (applyToExpsInStmt (collectFuncs stmts) f) stmts + +-- | Apply the given function to the top-level expressions in the +-- given statement. +applyToExpsInStmt :: [FuncArity] -> ([FuncArity] -> JsExp -> Optimize JsExp) -> JsStmt -> Optimize JsStmt +applyToExpsInStmt funcs f stmts = uncurryInStmt stmts where + transform = f funcs + uncurryInStmt stmt = + case stmt of + JsMappedVar srcloc name exp -> JsMappedVar srcloc name <$> transform exp + JsVar name exp -> JsVar name <$> transform exp + JsEarlyReturn exp -> JsEarlyReturn <$> transform exp + JsIf op ithen ielse -> JsIf <$> transform op + <*> mapM uncurryInStmt ithen + <*> mapM uncurryInStmt ielse + s -> pure s + +-- | Collect functions and their arity from the whole codeset. +collectFuncs :: [JsStmt] -> [FuncArity] +collectFuncs = (++ prim) . concat . map collectFunc where + collectFunc (JsMappedVar _ name exp) = collectFunc (JsVar name exp) + collectFunc (JsVar (JsNameVar name) exp) | arity > 0 = [(name,arity)] + where arity = expArity exp + collectFunc _ = [] + prim = map (first (Qual (ModuleName "Fay$"))) (unary ++ binary) + unary = map (,1) [Ident "return"] + binary = map ((,2) . Ident) + ["then","bind","mult","mult","add","sub","div" + ,"eq","neq","gt","lt","gte","lte","and","or"] + +-- | Get the arity of an expression. +expArity :: JsExp -> Int +expArity (JsFun _ _ mexp) = 1 + maybe 0 expArity mexp +expArity _ = 0 + +test :: IO () +test = do + let (newstmts,OptState _ uncurried) = flip runState st $ optimizeToplevel stmts + putStrLn $ printJSPretty newstmts + putStrLn $ printJSPretty (catMaybes (map (uncurryBinding newstmts) uncurried)) + + where + st = OptState stmts [] + stmts = [JsMappedVar (SrcLoc {srcFilename = "", srcLine = 1, srcColumn = 1}) (JsNameVar (Qual (ModuleName "Main") (Ident "sum$uncurried"))) (JsFun [JsParam 1,JsParam 2] [] (Just (JsNew JsThunk [JsFun [] [JsVar (JsNameVar (UnQual (Ident "acc"))) (JsName (JsParam 2)),JsIf (JsEq (JsApp (JsName JsForce) [JsName (JsParam 1)]) (JsLit (JsInt 0))) [JsEarlyReturn (JsName (JsNameVar (UnQual (Ident "acc"))))] [],JsVar (JsNameVar (UnQual (Ident "acc"))) (JsName (JsParam 2)),JsVar (JsNameVar (UnQual (Ident "n"))) (JsName (JsParam 1)),JsEarlyReturn (JsApp (JsName (JsNameVar (Qual (ModuleName "Main") (Ident "sum$uncurried")))) [JsApp (JsName (JsNameVar (Qual (ModuleName "Fay$") (Ident "sub$uncurried")))) [JsApp (JsName JsForce) [JsName (JsNameVar (UnQual (Ident "n")))],JsLit (JsInt 1)],JsApp (JsName (JsNameVar (Qual (ModuleName "Fay$") (Ident "add$uncurried")))) [JsApp (JsName JsForce) [JsName (JsNameVar (UnQual (Ident "acc")))],JsApp (JsName JsForce) [JsName (JsNameVar (UnQual (Ident "n")))]]])] Nothing])))] + +uncurryBinding :: [JsStmt] -> QName -> Maybe JsStmt +uncurryBinding stmts qname = listToMaybe (mapMaybe funBinding stmts) + + where funBinding stmt = + case stmt of + JsMappedVar srcloc (JsNameVar name) body + | name == qname -> JsMappedVar srcloc (JsNameVar (renameUncurried name)) <$> uncurryIt body + JsVar (JsNameVar name) body + | name == qname -> JsVar (JsNameVar (renameUncurried name)) <$> uncurryIt body + _ -> Nothing + + uncurryIt = Just . go [] where + go args exp = + case exp of + JsFun [arg] [] (Just body) -> go (arg : args) body + inner -> JsFun (reverse args) [] (Just inner) + +-- | Rename an uncurried copy of a curried function. +renameUncurried :: QName -> QName +renameUncurried q = + case q of + Qual m n -> Qual m (renameUnQual n) + UnQual n -> UnQual (renameUnQual n) + s -> s + where renameUnQual n = + case n of + Ident nom -> Ident (nom ++ postfix) + Symbol nom -> Symbol (nom ++ postfix) + postfix = "$uncurried" diff --git a/src/Language/Fay/Convert.hs b/src/Language/Fay/Convert.hs --- a/src/Language/Fay/Convert.hs +++ b/src/Language/Fay/Convert.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} {-# OPTIONS -fno-warn-type-defaults #-} -- | Convert a Haskell value to a (JSON representation of a) Fay value. @@ -11,18 +11,18 @@ where import Control.Applicative -import Control.Arrow import Control.Monad +import Control.Monad.State import Data.Aeson import Data.Attoparsec.Number - import Data.Char import Data.Data import Data.Function +import Data.Generics.Aliases +import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as Map -import Data.List import Data.Maybe -import Data.Ord +import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Vector as Vector import Numeric @@ -40,6 +40,11 @@ Show.Con "True" _ -> return (Bool True) Show.Con "False" _ -> return (Bool False) + -- Just x => x + Show.Con "Just" [v] -> convert v + -- Nothing -> null + Show.Con "Nothing" [] -> return Null + -- Objects/records Show.Con name values -> fmap (Object . Map.fromList . (("instance",string name) :)) (slots values) @@ -63,19 +68,19 @@ int = convertInt value -- Number converters - convertDouble = fmap (Number . D) . parseDouble - convertInt = fmap (Number . I) . parseInt + convertDouble = fmap (Number . D) . pDouble + convertInt = fmap (Number . I) . pInt -- Number parsers - parseDouble :: Show.Value -> Maybe Double - parseDouble value = case value of + pDouble :: Show.Value -> Maybe Double + pDouble 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) + Show.Ratio x y -> liftM2 (on (/) fromIntegral) (pInt x) (pInt y) + Show.Neg str -> fmap (* (-1)) (pDouble str) _ -> Nothing - parseInt value = case value of + pInt value = case value of Show.Integer str -> getInt str - Show.Neg str -> fmap (* (-1)) (parseInt str) + Show.Neg str -> fmap (* (-1)) (pInt str) _ -> Nothing -- Number readers @@ -91,57 +96,108 @@ 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 - fmap parens (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 +readFromFay :: Data a => Value -> Maybe a +readFromFay value = do + parseData value + `ext1R` parseMaybe value + `ext1R` parseArray value + `extR` parseDouble value + `extR` parseInt value + `extR` parseBool value + `extR` parseString value - 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)) +-- | Parse a data type or record. +parseData :: Data a => Value -> Maybe a +parseData value = result where + result = getObject value >>= parseObject typ + typ = dataTypeOf (fromJust result) + getObject x = + case x of + Object obj -> return obj + _ -> mzero - readRecord name (Map.toList -> assocs) = go (dataTypeConstrs typ) - where go (cons:conses) = - readConstructor name assocs cons <|> go conses - go [] = Nothing +-- | Parse a data constructor from an object. +parseObject :: Data a => DataType -> HashMap Text Value -> Maybe a +parseObject typ obj = listToMaybe (catMaybes choices) where + choices = map makeConstructor constructors + constructors = dataTypeConstrs typ + makeConstructor cons = do + name <- Map.lookup (Text.pack "instance") obj >>= parseString + guard (showConstr cons == name) + if null fields + then makeSimple obj cons + else makeRecord obj cons fields - 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 (unwords [key,"=",cvalue]) - guard $ not $ null fields - return (Text.unpack name ++ - if null fields - then "" - else " {" ++ intercalate ", " fields ++ "}") + where fields = constrFields cons - typ = dataTypeOf $ resType result - resType :: Maybe a -> a - resType = undefined - parens x = "(" ++ x ++ ")" +-- | Make a simple ADT constructor from an object: { "slot1": 1, "slot2": 2} -> Foo 1 2 +makeSimple :: Data a => HashMap Text Value -> Constr -> Maybe a +makeSimple obj cons = + evalStateT (fromConstrM (do i:next <- get + put next + value <- lift (Map.lookup (Text.pack ("slot" ++ show i)) obj) + lift (readFromFay value)) + cons) + [1..] + +-- | Make a record from a key-value: { "x": 1 } -> Foo { x = 1 } +makeRecord :: Data a => HashMap Text Value -> Constr -> [String] -> Maybe a +makeRecord obj cons fields = + evalStateT (fromConstrM (do key:next <- get + put next + value <- lift (Map.lookup (Text.pack key) obj) + lift (readFromFay value)) + cons) + fields + +-- | Parse a double. +parseDouble :: Value -> Maybe Double +parseDouble value = do + number <- parseNumber value + case number of + D n -> return n + _ -> mzero + +-- | Parse an int. +parseInt :: Value -> Maybe Int +parseInt value = do + number <- parseNumber value + case number of + I n -> return (fromIntegral n) + _ -> mzero + +-- | Parse a number. +parseNumber :: Value -> Maybe Number +parseNumber value = + case value of + Number n -> return n + _ -> mzero + +-- | Parse a bool. +parseBool :: Value -> Maybe Bool +parseBool value = + case value of + Bool n -> return n + _ -> mzero + +-- | Parse a string. +parseString :: Value -> Maybe String +parseString value = + case value of + String s -> return (Text.unpack s) + _ -> mzero + +-- | Parse an array. +parseArray :: Data a => Value -> Maybe [a] +parseArray value = + case value of + Array xs -> mapM readFromFay (Vector.toList xs) + _ -> mzero + +-- | Parse a nullable value to Maybe. +parseMaybe :: Data a => Value -> Maybe (Maybe a) +parseMaybe value = + case value of + Null -> Just Nothing + v -> fmap Just (readFromFay v) 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 @@ -5,10 +5,7 @@ module Language.Fay.FFI where import Language.Fay.Types (Fay) -import Prelude (Bool, Char, Double, String, Int, error) - --- | In case you want to distinguish values with a JsPtr. -data JsPtr a +import Prelude (Bool, Char, Double, String, Int, Maybe, error) -- | Contains allowed foreign function types. class Foreign a @@ -31,14 +28,25 @@ -- | Lists → arrays are OK. instance Foreign a => Foreign [a] --- | Pointers to arbitrary objects are OK. -instance Foreign (JsPtr a) +-- | Tuples → arrays are OK. +instance (Foreign a, Foreign b) => Foreign (a,b) +instance (Foreign a, Foreign b, Foreign c) => Foreign (a,b,c) +instance (Foreign a, Foreign b, Foreign c, Foreign d) => Foreign (a,b,c,d) +instance (Foreign a, Foreign b, Foreign c, Foreign d, + Foreign e) => Foreign (a,b,c,d,e) +instance (Foreign a, Foreign b, Foreign c, Foreign d, + Foreign e, Foreign f) => Foreign (a,b,c,d,e,f) +instance (Foreign a, Foreign b, Foreign c, Foreign d, + Foreign e, Foreign f, Foreign g) => Foreign (a,b,c,d,e,f,g) -- | JS values are foreignable. instance Foreign a => Foreign (Fay a) -- | Functions are foreignable. instance (Foreign a,Foreign b) => Foreign (a -> b) + +-- | Maybes are pretty common. +instance Foreign a => Foreign (Maybe a) -- | Declare a foreign action. ffi 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 @@ -8,7 +8,7 @@ ,Double ,Int ,Bool(..) - ,Show(show) + ,Show ,Read ,Maybe(..) ,Typeable(..) @@ -16,8 +16,6 @@ ,Monad ,Eq(..) ,read - ,fromInteger - ,fromRational ,(>>) ,(>>=) ,(+) @@ -32,27 +30,17 @@ ,(&&) ,fail ,return + ,force ,module Language.Fay.Stdlib) where import Language.Fay.Stdlib import Language.Fay.Types (Fay) - import Data.Data - -import GHC.Real (Ratio) import Prelude (Bool(..), Char, Double, Eq(..), Int, Integer, Maybe(..), Monad, - Ord, Read(..), Show(..), String, error, read, (&&), (*), (+), (-), + Ord, Read(..), Show(), String, error, read, (&&), (*), (+), (-), (/), (/=), (<), (<=), (==), (>), (>=), (||)) --- | Just to satisfy GHC. -fromInteger :: Integer -> Double -fromInteger = error "Language.Fay.Prelude.fromInteger: Used fromInteger outside JS." - --- | Just to satisfy GHC. -fromRational :: Ratio Integer -> Double -fromRational = error "Language.Fay.Prelude.fromRational Used fromRational outside JS." - (>>) :: Fay a -> Fay b -> Fay b (>>) = error "Language.Fay.Prelude.(>>): Used (>>) outside JS." infixl 1 >> @@ -66,3 +54,6 @@ return :: a -> Fay a return = error "Language.Fay.Prelude.return: Used return outside JS." + +force :: a -> Bool -> Fay a +force = error "Language.Fay.Prelude.force: Used force outside JS." 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 @@ -1,7 +1,6 @@ {-# OPTIONS -fno-warn-orphans #-} {-# OPTIONS -fno-warn-unused-do-bind #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -21,11 +20,12 @@ import Control.Monad import Control.Monad.State import Data.Aeson.Encode -import qualified Data.ByteString.Lazy.UTF8 as UTF8 +import qualified Data.ByteString.Lazy.UTF8 as UTF8 import Data.Default import Data.List import Data.String import Language.Haskell.Exts.Syntax + import Prelude hiding (exp) -------------------------------------------------------------------------------- @@ -34,6 +34,9 @@ printJSString :: Printable a => a -> String printJSString x = concat $ reverse $ psOutput $ execState (runPrinter (printJS x)) def +printJSPretty :: Printable a => a -> String +printJSPretty x = concat $ reverse $ psOutput $ execState (runPrinter (printJS x)) def { psPretty = True } + -- | Print literals. These need some special encoding for -- JS-format literals. Could use the Text.JSON library. instance Printable JsLit where @@ -50,38 +53,35 @@ instance Printable QName where printJS qname = case qname of - Qual moduleName name -> do printJS moduleName - "$$" - printJS name + Qual moduleName name -> moduleName +> "$" +> name UnQual name -> printJS name Special con -> printJS con +-- | Print module name. +instance Printable ModuleName where + printJS (ModuleName "Fay$") = + write "Fay$" + printJS (ModuleName moduleName) = write $ go moduleName + + where go ('.':xs) = '$' : go xs + go (x:xs) = normalizeName [x] ++ go xs + go [] = [] + -- | Print special constructors (tuples, list, etc.) instance Printable SpecialCon where printJS specialCon = - printJS $ (Qual "Fay" . Ident) $ + printJS $ (Qual (ModuleName "Fay$") . Ident) $ case specialCon of - UnitCon -> "unit" - ListCon -> "emptyList" - FunCon -> "funCon" - TupleCon boxed n -> (if boxed == Boxed - then "boxed" - else "unboxed" ++ - "TupleOf" ++ show n) - Cons -> "cons" - UnboxedSingleCon -> "unboxedSingleCon" - --- | Print module name. -instance Printable ModuleName where - printJS (ModuleName moduleName) = - write $ jsEncodeName moduleName + UnitCon -> "unit" + Cons -> "cons" + _ -> error $ "Special constructor not supported: " ++ show specialCon -- | Print (and properly encode) a name. instance Printable Name where printJS name = write $ case name of - Ident ident -> jsEncodeName ident - Symbol sym -> jsEncodeName sym + Ident ident -> encodeName ident + Symbol sym -> encodeName sym -- | Print a list of statements. instance Printable [JsStmt] where @@ -89,76 +89,116 @@ -- | Print a single statement. instance Printable JsStmt where - printJS (JsBlock stmts) = do - "{ "; mapM printJS stmts; "}" - printJS (JsVar name expr) = do "var "; printJS name; " = "; printJS expr; ";" - printJS (JsUpdate name expr) = do printJS name; " = "; printJS expr; ";" - printJS (JsSetProp name prop expr) = do - printJS name; "."; printJS prop; " = "; printJS expr; ";" - printJS (JsIf exp thens elses) = do - "if ("; printJS exp; ") {" - printJS thens - "}" - when (length elses > 0) $ do - " else {" - printJS elses - "}" - printJS (JsEarlyReturn exp) = do - "return "; printJS exp; ";" + printJS (JsBlock stmts) = + "{ " +> stmts +> "}" + printJS (JsVar name expr) = + "var " +> name +> " = " +> expr +> ";" +> newline + printJS (JsUpdate name expr) = + name +> " = " +> expr +> ";" +> newline + printJS (JsSetProp name prop expr) = + name +> "." +> prop +> " = " +> expr +> ";" +> newline + printJS (JsIf exp thens elses) = + "if (" +> exp +> ") {" +> newline +> + indented (printJS thens) +> + "}" +> + (when (length elses > 0) $ " else {" +> + indented (printJS elses) +> + "}") +> newline + printJS (JsEarlyReturn exp) = + "return " +> exp +> ";" +> newline printJS (JsThrow exp) = do - "throw "; printJS exp; ";" - printJS (JsWhile cond stmts) = do - "while ("; printJS cond; ") {" - printJS stmts - "}" - printJS JsContinue = "continue;" - printJS (JsMappedVar _ name expr) = do "var "; printJS name; " = "; printJS expr; ";" + "throw " +> exp +> ";" +> newline + printJS (JsWhile cond stmts) = + "while (" +> cond +> ") {" +> newline +> + indented (printJS stmts) +> + "}" +> newline + printJS JsContinue = + printJS "continue;" +> newline + printJS (JsMappedVar _ name expr) = + "var " +> name +> " = " +> expr +> ";" +> newline -- | Print an expression. instance Printable JsExp where - printJS (JsRawExp name) = write name - printJS (JsThrowExp exp) = do "(function(){ throw ("; printJS exp; "); })()" - printJS JsNull = "null" + printJS (JsRawExp e) = write e printJS (JsName name) = printJS name - printJS (JsLit lit) = printJS lit - printJS (JsParen exp) = do "("; printJS exp; ")" - printJS (JsList exps) = do "["; intercalateM "," (map printJS exps); "]" - printJS (JsNew name args) = do "new "; printJS (JsApp (JsName name) args) - printJS (JsIndex i exp) = do "("; printJS exp; ")["; write (show i); "]" - printJS (JsEq exp1 exp2) = do printJS exp1; " === "; printJS exp2 - printJS (JsGetProp exp prop) = do printJS exp; "."; printJS prop - printJS (JsLookup exp1 exp2) = do printJS exp1; "["; printJS exp2; "]" - printJS (JsUpdateProp name prop expr) = do - "("; printJS name; "."; printJS prop; " = "; printJS expr; ")" - printJS (JsInfix op x y) = do printJS x; " "; write op; " "; printJS y - printJS (JsGetPropExtern exp prop) = do - printJS exp; "["; printJS (JsLit (JsStr prop)); "]" - printJS (JsUpdatePropExtern name prop expr) = do - "("; printJS name; "['"; printJS prop; "'] = "; printJS expr; ")" - printJS (JsTernaryIf cond conseq alt) = do - printJS cond; " ? "; printJS conseq; " : "; printJS alt - printJS (JsInstanceOf exp classname) = do - printJS exp; " instanceof "; printJS classname - printJS (JsObj assoc) = do "{"; intercalateM "," (map cons assoc); "}" - where cons (key,value) = do "\""; write key; "\": "; printJS value - printJS (JsFun params stmts ret) = do + printJS (JsThrowExp exp) = + "(function(){ throw (" +> exp +> "); })()" + printJS JsNull = + printJS "null" + printJS JsUndefined = + printJS "undefined" + printJS (JsLit lit) = + printJS lit + printJS (JsParen exp) = + "(" +> exp +> ")" + printJS (JsList exps) = + "[" +> intercalateM "," (map printJS exps) +> printJS "]" + printJS (JsNew name args) = + "new " +> (JsApp (JsName name) args) + printJS (JsIndex i exp) = + "(" +> exp +> ")[" +> show i +> "]" + printJS (JsEq exp1 exp2) = + exp1 +> " === " +> exp2 + printJS (JsNeq exp1 exp2) = + exp1 +> " !== " +> exp2 + printJS (JsGetProp exp prop) = exp +> "." +> prop + printJS (JsLookup exp1 exp2) = + exp1 +> "[" +> exp2 +> "]" + printJS (JsUpdateProp name prop expr) = + "(" +> name +> "." +> prop +> " = " +> expr +> ")" + printJS (JsInfix op x y) = + x +> " " +> op +> " " +> y + printJS (JsGetPropExtern exp prop) = + exp +> "[" +> (JsLit . JsStr) prop +> "]" + printJS (JsUpdatePropExtern name prop expr) = + "(" +> name +> "['" +> prop +> "'] = " +> expr +> ")" + printJS (JsTernaryIf cond conseq alt) = + cond +> " ? " +> conseq +> " : " +> alt + printJS (JsInstanceOf exp classname) = + exp +> " instanceof " +> classname + printJS (JsObj assoc) = + "{" +> (intercalateM "," (map cons assoc)) +> "}" + where cons (key,value) = "\"" +> key +> "\": " +> value + printJS (JsFun params stmts ret) = "function(" - intercalateM "," (map printJS params) - "){" - printJS stmts - case ret of - Just ret' -> do "return "; printJS ret'; ";" - Nothing -> return () - "}" - printJS (JsApp op args) = do - printJS (if isFunc op then JsParen op else op) - "(" - intercalateM "," (map (printJS) args) - ")" + +> (intercalateM "," (map printJS params)) + +> "){" +> newline + +> indented (stmts +> + case ret of + Just ret' -> "return " +> ret' +> ";" +> newline + Nothing -> return ()) + +> "}" + printJS (JsApp op args) = + (if isFunc op then JsParen op else op) + +> "(" + +> (intercalateM "," (map printJS args)) + +> ")" where isFunc JsFun{..} = True; isFunc _ = False + printJS (JsNegApp args) = + "(-(" +> printJS args +> "))" +-- | Print one of the kinds of names. +instance Printable JsName where + printJS name = + case name of + JsNameVar qname -> printJS qname + JsThis -> write "this" + JsThunk -> write "$" + JsForce -> write "_" + JsApply -> write "__" + JsParam i -> write ("$p" ++ show i) + JsTmp i -> write ("$tmp" ++ show i) + JsConstructor qname -> "$_" +> printJS qname + JsBuiltIn qname -> "Fay$$" +> printJS qname + +instance Printable String where + printJS = write + +instance Printable (Printer ()) where + printJS = id + -------------------------------------------------------------------------------- --- Utilities +-- Name encoding -- Words reserved in haskell as well are not needed here: -- case, class, do, else, if, import, in, let @@ -171,38 +211,66 @@ "var", "void", "while", "window", "with", "yield","true","false"] -- | Encode a Haskell name to JavaScript. --- TODO: Fix this hack. -jsEncodeName :: String -> String --- Special symbols: -jsEncodeName ":tmp" = "$tmp" -jsEncodeName ":thunk" = "$" -jsEncodeName ":this" = "this" --- jsEncodeName ":return" = "return" --- Used keywords: -jsEncodeName name - | "$_" `isPrefixOf` name = normalize name - | name `elem` reservedWords = "$_" ++ normalize name --- Anything else. -jsEncodeName name = normalize name +encodeName :: String -> String +-- | This is a hack for names generated in the Haskell AST. Should be +-- removed once it's no longer needed. +encodeName ('$':'g':'e':'n':name) = "$gen_" ++ normalizeName name +encodeName name + | name `elem` reservedWords = "$_" ++ normalizeName name + | otherwise = normalizeName name -- | Normalize the given name to JavaScript-valid names. -normalize :: [Char] -> [Char] -normalize name = +normalizeName :: [Char] -> [Char] +normalizeName name = concatMap encodeChar name where encodeChar c | c `elem` allowed = [c] - | otherwise = escapeChar c + | otherwise = escapeChar c allowed = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_" escapeChar c = "$" ++ charId c ++ "$" charId c = show (fromEnum c) --- | -write :: String -> Printer a +-------------------------------------------------------------------------------- +-- Printing + + +-- | Print the given printer indented. +indented :: Printer a -> Printer () +indented p = do + PrintState{..} <- get + if psPretty + then do modify $ \s -> s { psIndentLevel = psIndentLevel + 1 } + p + modify $ \s -> s { psIndentLevel = psIndentLevel } + else p >> return () + +-- | Output a newline. +newline :: Printer () +newline = do + PrintState{..} <- get + when psPretty $ do + write "\n" + modify $ \s -> s { psNewline = True } + +-- | Write out a string, updating the current position information. +write :: String -> Printer () write x = do - modify $ \s -> s { psOutput = x : psOutput s } + PrintState{..} <- get + let out = if psNewline then replicate (2*psIndentLevel) ' ' ++ x else x + modify $ \s -> s { psOutput = out : psOutput + , psLine = psLine + additionalLines + , psColumn = if additionalLines > 0 + then length (concat (take 1 (reverse srclines))) + else psColumn + length x + , psNewline = False + } return (error "Nothing to return for writer string.") + where srclines = lines x + additionalLines = length (filter (=='\n') x) + +-- | Intercalate monadic action. intercalateM :: String -> [Printer a] -> Printer () intercalateM _ [] = return () intercalateM _ [x] = x >> return () @@ -211,15 +279,6 @@ write str intercalateM str xs - --- | Helpful for writing qualified symbols (Fay.*). -instance IsString ModuleName where - fromString = ModuleName - --- | Helpful for writing variable names. -instance IsString JsName where - fromString = UnQual . Ident - --- | For the pretty printer convenience. -instance IsString (Printer a) where - fromString = write +-- | Concatenate two printables. +(+>) :: (Printable a, Printable b) => a -> b -> Printer () +pa +> pb = printJS pa >> printJS pb 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,11 +1,18 @@ +{-# LANGUAGE NoImplicitPrelude #-} module Language.Fay.Stdlib (($) ,(++) ,(.) + ,(=<<) + ,Defined(..) ,Ordering(..) + ,show + ,fromInteger + ,fromRational ,any ,compare ,concat + ,concatMap ,const ,elem ,enumFrom @@ -33,6 +40,7 @@ ,otherwise ,prependToAll ,reverse + ,sequence ,snd ,sort ,sortBy @@ -44,11 +52,23 @@ where import Language.Fay.FFI -import Prelude (Bool(..), Double, Eq(..), Int, Maybe(..), Monad(..), Num(..), - Ord((>), (<)), (||)) +import Prelude (Bool (..), Double, Eq (..), Fractional, Int, + Integer, Maybe (..), Monad (..), Num ((+)), + Ord ((>), (<)), Rational, Show, String, (||)) --- START +show :: (Foreign a,Show a) => a -> String +show = ffi "JSON.stringify(%1)" +data Defined a = Undefined | Defined a +instance Foreign a => Foreign (Defined a) + +-- There is only Double in JS. +fromInteger :: a -> a +fromInteger x = x + +fromRational :: a -> a +fromRational x = x + snd :: (t, t1) -> t1 snd (_,x) = x @@ -165,6 +185,9 @@ concat :: [[a]] -> [a] concat = foldr conc [] +concatMap :: (a -> [b]) -> [a] -> [b] +concatMap f = foldr ((++) . f) [] + foldr :: (t -> t1 -> t1) -> t1 -> [t] -> t1 foldr _ z [] = z foldr f z (x:xs) = f x (foldr f z xs) @@ -203,9 +226,11 @@ const a _ = a length :: [a] -> Int -length (_:xs) = 1 + length xs -length [] = 0 +length xs = length' 0 xs +length' acc (_:xs) = length' (acc+1) xs +length' acc _ = acc + mod :: Double -> Double -> Double mod = ffi "%1 %% %2" @@ -224,3 +249,15 @@ reverse :: [a] -> [a] reverse (x:xs) = reverse xs ++ [x] reverse [] = [] + +(=<<) :: Monad m => (a -> m b) -> m a -> m b +f =<< x = x >>= f +infixl 1 =<< + +-- | Evaluate each action in the sequence from left to right, +-- and collect the results. +-- sequence :: [Fay a] -> Fay [a] +sequence :: (Monad m) => [m a] -> m [a] +sequence ms = foldr k (return []) ms + where + k m m' = do { x <- m; xs <- m'; return (x:xs) } 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 @@ -1,7 +1,9 @@ +{-# OPTIONS -fno-warn-orphans #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} -- | All Fay types and instances. @@ -9,8 +11,7 @@ (JsStmt(..) ,JsExp(..) ,JsLit(..) - ,JsParam - ,JsName + ,JsName(..) ,CompileError(..) ,Compile(..) ,CompilesTo(..) @@ -21,25 +22,28 @@ ,defaultCompileState ,FundamentalType(..) ,PrintState(..) - ,Printer(..)) + ,Printer(..) + ,NameScope(..) + ,Mapping(..)) where import Control.Applicative - import Control.Monad.Error (Error, ErrorT, MonadError) import Control.Monad.Identity (Identity) import Control.Monad.State - import Data.Default +import Data.Map as M +import Data.String import Language.Haskell.Exts +import Paths_fay + -------------------------------------------------------------------------------- -- Compiler types -- | Configuration of the compiler. data CompileConfig = CompileConfig - { configTCO :: Bool - , configInlineForce :: Bool + { configOptimize :: Bool , configFlattenApps :: Bool , configExportBuiltins :: Bool , configDirectoryIncludes :: [FilePath] @@ -51,36 +55,85 @@ , configFilePath :: Maybe FilePath , configTypecheck :: Bool , configWall :: Bool - } + } deriving (Show) -- | Default configuration. instance Default CompileConfig where - def = CompileConfig False False False True [] False False [] False True Nothing True False + def = CompileConfig False False True [] False False [] False True Nothing True False -- | State of the compiler. data CompileState = CompileState { stateConfig :: CompileConfig - , stateExports :: [Name] + , stateExports :: [QName] , stateExportAll :: Bool , stateModuleName :: ModuleName - , stateRecords :: [(Name,[Name])] -- records with field names + , stateFilePath :: FilePath + , stateRecords :: [(QName,[QName])] , stateFayToJs :: [JsStmt] , stateJsToFay :: [JsStmt] - , stateImported :: [String] -- ^ Names of imported modules so far. -} + , stateImported :: [(ModuleName,FilePath)] + , stateNameDepth :: Integer + , stateScope :: Map Name [NameScope] +} deriving (Show) -defaultCompileState :: CompileConfig -> CompileState -defaultCompileState config = CompileState { +-- | A name's scope, either imported or bound locally. +data NameScope = ScopeImported ModuleName (Maybe Name) + | ScopeImportedAs Bool ModuleName Name + | ScopeBinding + + deriving (Show,Eq) + +-- | The default compiler state. +defaultCompileState :: CompileConfig -> IO CompileState +defaultCompileState config = do + ffi <- getDataFileName "src/Language/Fay/Stdlib.hs" + types <- getDataFileName "src/Language/Fay/Types.hs" + prelude <- getDataFileName "src/Language/Fay/Prelude.hs" + return $ CompileState { stateConfig = config , stateExports = [] , stateExportAll = True , stateModuleName = ModuleName "Main" - , stateRecords = [(Ident "Nothing",[]),(Ident "Just",[Ident "slot1"])] + , stateRecords = [("Nothing",[]),("Just",["slot1"])] , stateFayToJs = [] , stateJsToFay = [] - , stateImported = ["Language.Fay.Prelude","Language.Fay.FFI","Language.Fay.Types","Prelude"] + , stateImported = [("Language.Fay.FFI",ffi),("Language.Fay.Types",types),("Prelude",prelude)] + , stateNameDepth = 1 + , stateFilePath = "" + , stateScope = M.fromList primOps } +-- | The built-in operations that aren't actually compiled from +-- anywhere, they come from runtime.js. +-- +-- They're in the names list so that they can be overriden by the user +-- in e.g. let a * b = a - b in 1 * 2. +-- +-- So we resolve them to Fay$, i.e. the prefix used for the runtime +-- support. $ is not allowed in Haskell module names, so there will be +-- no conflicts if a user decicdes to use a module named Fay. +-- +-- So e.g. will compile to (*) Fay$$mult, which is in runtime.js. +primOps :: [(Name, [NameScope])] +primOps = + [(Symbol ">>",[ScopeImported "Fay$" (Just "then")]) + ,(Symbol ">>=",[ScopeImported "Fay$" (Just "bind")]) + ,(Ident "return",[ScopeImported "Fay$" (Just "return")]) + ,(Ident "force",[ScopeImported "Fay$" (Just "force")]) + ,(Symbol "*",[ScopeImported "Fay$" (Just "mult")]) + ,(Symbol "*",[ScopeImported "Fay$" (Just "mult")]) + ,(Symbol "+",[ScopeImported "Fay$" (Just "add")]) + ,(Symbol "-",[ScopeImported "Fay$" (Just "sub")]) + ,(Symbol "/",[ScopeImported "Fay$" (Just "div")]) + ,(Symbol "==",[ScopeImported "Fay$" (Just "eq")]) + ,(Symbol "/=",[ScopeImported "Fay$" (Just "neq")]) + ,(Symbol ">",[ScopeImported "Fay$" (Just "gt")]) + ,(Symbol "<",[ScopeImported "Fay$" (Just "lt")]) + ,(Symbol ">=",[ScopeImported "Fay$" (Just "gte")]) + ,(Symbol "<=",[ScopeImported "Fay$" (Just "lte")]) + ,(Symbol "&&",[ScopeImported "Fay$" (Just "and")]) + ,(Symbol "||",[ScopeImported "Fay$" (Just "or")])] + -- | Compile monad. newtype Compile a = Compile { unCompile :: StateT CompileState (ErrorT CompileError IO) a } deriving (MonadState CompileState @@ -90,27 +143,29 @@ ,Functor ,Applicative) --- | Convenience type for function parameters. -type JsParam = JsName - --- | To be used to force name sanitization eventually. -type JsName = QName -- FIXME: Force sanitization at this point. - -- | Just a convenience class to generalize the parsing/printing of -- various types of syntax. class (Parseable from,Printable to) => CompilesTo from to | from -> to where compileTo :: from -> Compile to +data Mapping = Mapping + { mappingName :: String + , mappingFrom :: SrcLoc + , mappingTo :: SrcLoc + } deriving (Show) + data PrintState = PrintState - { psLine :: Int + { psPretty :: Bool + , psLine :: Int , psColumn :: Int - , psMapping :: [(SrcLoc,SrcLoc)] + , psMapping :: [Mapping] , psIndentLevel :: Int , psOutput :: [String] + , psNewline :: Bool } instance Default PrintState where - def = PrintState 0 0 [] 0 [] + def = PrintState False 0 0 [] 0 [] False newtype Printer a = Printer { runPrinter :: State PrintState a } deriving (Monad,Functor,MonadState PrintState) @@ -131,18 +186,24 @@ | UnsupportedLetBinding Decl | UnsupportedOperator QOp | UnsupportedPattern Pat + | UnsupportedFieldPattern PatField | UnsupportedRhs Rhs | UnsupportedGuardedAlts GuardedAlts + | UnsupportedImport ImportDecl + | UnsupportedQualStmt QualStmt | EmptyDoBlock | UnsupportedModuleSyntax Module | LetUnsupported | InvalidDoBlock | RecursiveDoUnsupported + | Couldn'tFindImport ModuleName [FilePath] | FfiNeedsTypeSig Decl | FfiFormatBadChars String | FfiFormatNoSuchArg Int | FfiFormatIncompleteArg | FfiFormatInvalidJavaScript String String + | UnableResolveUnqualified Name + | UnableResolveQualified QName deriving (Show) instance Error CompileError @@ -171,9 +232,10 @@ data JsExp = JsName JsName | JsRawExp String - | JsFun [JsParam] [JsStmt] (Maybe JsExp) + | JsFun [JsName] [JsStmt] (Maybe JsExp) | JsLit JsLit | JsApp JsExp [JsExp] + | JsNegApp JsExp | JsTernaryIf JsExp JsExp JsExp | JsNull | JsParen JsExp @@ -188,10 +250,25 @@ | JsInstanceOf JsExp JsName | JsIndex Int JsExp | JsEq JsExp JsExp + | JsNeq JsExp JsExp | JsInfix String JsExp JsExp -- Used to optimize *, /, +, etc | JsObj [(String,JsExp)] + | JsUndefined deriving (Show,Eq) +-- | A name of some kind. +data JsName + = JsNameVar QName + | JsThis + | JsThunk + | JsForce + | JsApply + | JsParam Integer + | JsTmp Integer + | JsConstructor QName + | JsBuiltIn Name + deriving (Eq,Show) + -- | Literal value type. data JsLit = JsChar Char @@ -203,7 +280,7 @@ -- | These are the data types that are serializable directly to native -- JS data types. Strings, floating points and arrays. The others are: --- actiosn in the JS monad, which are thunks that shouldn't be forced +-- actions in the JS monad, which are thunks that shouldn't be forced -- when serialized but wrapped up as JS zero-arg functions, and -- unknown types can't be converted but should at least be forced. data FundamentalType @@ -211,7 +288,9 @@ = FunctionType [FundamentalType] | JsType FundamentalType | ListType FundamentalType + | TupleType [FundamentalType] | UserDefined Name [FundamentalType] + | Defined FundamentalType -- Simple types. | DateType | StringType @@ -221,3 +300,15 @@ -- | Unknown. | UnknownType deriving (Show) + +-- | Helpful for some things. +instance IsString Name where + fromString = Ident + +-- | Helpful for some things. +instance IsString QName where + fromString = UnQual . Ident + +-- | Helpful for writing qualified symbols (Fay.*). +instance IsString ModuleName where + fromString = ModuleName diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} {-# OPTIONS -fno-warn-orphans #-} {-# OPTIONS -fno-warn-orphans #-} {-# LANGUAGE FlexibleContexts #-} @@ -7,9 +8,8 @@ import Language.Fay import Language.Fay.Compiler -import Language.Fay.Types -import Paths_fay (version) +import Paths_fay (version) import qualified Control.Exception as E import Control.Monad import Control.Monad.Error @@ -24,7 +24,6 @@ -- | Options and help. data FayCompilerOptions = FayCompilerOptions { optLibrary :: Bool - , optInlineForce :: Bool , optFlattenApps :: Bool , optHTMLWrapper :: Bool , optHTMLJSLibs :: [String] @@ -36,32 +35,73 @@ , optOutput :: Maybe String , optPretty :: Bool , optFiles :: [String] + , optOptimize :: Bool } +-- | Main entry point. +main :: IO () +main = do + opts <- execParser parser + if optVersion opts + then runCommandVersion + else do let config = def + { configOptimize = optOptimize opts + , configFlattenApps = optFlattenApps opts + , configExportBuiltins = True + , configDirectoryIncludes = "." : optInclude opts + , configPrettyPrint = optPretty opts + , configLibrary = optLibrary opts + , configHtmlWrapper = optHTMLWrapper opts + , configHtmlJSLibs = optHTMLJSLibs opts + , configTypecheck = not $ optNoGHC opts + , configWall = optWall opts + } + void $ incompatible htmlAndStdout opts "Html wrapping and stdout are incompatible" + case optFiles opts of + ["-"] -> do + hGetContents stdin >>= printCompile config compileModule + [] -> runInteractive + files -> forM_ files $ \file -> do + if optStdout opts + then compileFromTo config file Nothing + else compileFromTo config file (Just (outPutFile opts file)) + + where + parser = info (helper <*> options) (fullDesc & header helpTxt) + + outPutFile :: FayCompilerOptions -> String -> FilePath + outPutFile opts file = fromMaybe (toJsName file) $ optOutput opts + +-- | All Fay's command-line options. options :: Parser FayCompilerOptions options = FayCompilerOptions <$> switch (long "library" & help "Don't automatically call main in generated JavaScript") - <*> switch (long "inline-force" & help "inline forcing, adds some speed for numbers, blows up code a bit") <*> switch (long "flatten-apps" & help "flatten function applicaton") - <*> switch (long "html-wrapper" & help "Create an html file that loads the javascript") - <*> strsOption (long "html-js-lib" & metavar "file1[, ..]" & help "javascript files to add to if using option html-wrapper") - - <*> strsOption (long "include" & metavar "dir1[, ..]" & help "additional directories for include") - + <*> strsOption (long "html-js-lib" & metavar "file1[, ..]" + & help "javascript files to add to if using option html-wrapper") + <*> strsOption (long "include" & metavar "dir1[, ..]" + & help "additional directories for include") <*> switch (long "Wall" & help "Typecheck with -Wall") <*> switch (long "no-ghc" & help "Don't typecheck, specify when not working with files") - <*> switch (long "stdout" & short 's' & help "Output to stdout") <*> switch (long "version" & help "Output version number") - <*> nullOption (long "output" & short 'o' & reader (Just . Just) & value Nothing & help "Output to specified file") + <*> nullOption (long "output" & short 'o' & reader (Just . Just) & value Nothing + & help "Output to specified file") <*> switch (long "pretty" & short 'p' & help "Pretty print the output") - <*> arguments Just (metavar "- | ...") + <*> switch (long "optimize" & short 'O' & help "Apply optimizations to generated code") - where - strsOption m = nullOption (m & reader (Just . wordsBy (== ',')) & value []) + where strsOption m = + nullOption (m & reader (Just . wordsBy (== ',')) & value []) +-- | Make incompatible options. +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 + -- | The basic help text. helpTxt :: String helpTxt = concat @@ -72,77 +112,34 @@ ," fay ... processes each .hs file" ] --- | Main entry point. -main :: IO () -main = do - opts <- execParser parser - 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 - , configLibrary = optLibrary opts - , configHtmlWrapper = optHTMLWrapper opts - , configHtmlJSLibs = optHTMLJSLibs opts - , configTypecheck = not $ optNoGHC opts - , configWall = optWall opts - } - void $ incompatible htmlAndStdout opts "Html wrapping and stdout are incompatible" - - case optFiles opts of - ["-"] -> do - hGetContents stdin >>= printCompile config compileModule - [] -> runInteractive - files -> forM_ files $ \file -> do - if optStdout opts - then compileReadWrite config file stdout - else - compileFromTo config file $ outPutFile opts file) - - - where - parser = info (helper <*> options) (fullDesc & header helpTxt) - - outPutFile :: FayCompilerOptions -> String -> FilePath - outPutFile opts file = fromMaybe (toJsName file) $ optOutput opts - -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 - +-- | Print the command version. runCommandVersion :: IO () runCommandVersion = putStrLn $ "fay " ++ showVersion version - - +-- | Incompatible options. 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 +-- | Run interactively. +runInteractive :: IO () +runInteractive = runInputT defaultSettings loop where + loop = do + minput <- getInputLine "> " + case minput of + Nothing -> return () + Just "" -> loop + Just input -> do + result <- liftIO $ compileViaStr "" config compileExp input + case result of + Left err -> do + -- an error occured, maybe input was not an expression, + -- but a declaration, try compiling the input as a declaration + outputStrLn ("can't parse input as expression: " ++ show err) + result' <- liftIO $ compileViaStr "" config (compileDecl True) input + case result' of + Right (PrintState{..},_) -> outputStr (concat (reverse psOutput)) + Left err' -> + outputStrLn ("can't parse input as declaration: " ++ show err') + Right (PrintState{..},_) -> outputStr (concat (reverse psOutput)) + loop + config = def { configPrettyPrint = True } diff --git a/src/Test/Api.hs b/src/Test/Api.hs --- a/src/Test/Api.hs +++ b/src/Test/Api.hs @@ -1,10 +1,16 @@ +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} module Test.Api (tests) where -import Data.Default +import Language.Fay hiding (compileFile) import Language.Fay.Compiler -import Language.Fay.Types +import Paths_fay + +import Data.Default +import Data.Maybe +import Language.Haskell.Exts.Syntax +import System.FilePath import Test.Framework import Test.Framework.Providers.HUnit import Test.Framework.TH @@ -16,5 +22,28 @@ case_imports :: Assertion case_imports = do - res <- compileFile def { configTypecheck = False, configDirectoryIncludes = ["tests"] } "tests/RecordImport_Import.hs" + res <- compileFile defConf fp assertBool "Could not compile file with imports" (isRight res) + +case_importedList :: Assertion +case_importedList = do + res <- compileFile defConf fp + case res of + Left err -> error (show err) + Right r -> assertBool "RecordImport_Export was not added to stateImported" $ + isJust $ lookup (ModuleName "RecordImport_Export") (stateImported r) + +fp :: FilePath +fp = "tests/RecordImport_Import.hs" + +defConf :: CompileConfig +defConf = def { configTypecheck = False, configDirectoryIncludes = ["tests"] } + +compileFile :: CompileConfig -> FilePath -> IO (Either CompileError CompileState) +compileFile config filein = do + srcdir <- fmap (takeDirectory . takeDirectory . takeDirectory) (getDataFileName "src/Language/Fay/Stdlib.hs") + hscode <- readFile filein + result <- compileViaStr filein + (config { configDirectoryIncludes = configDirectoryIncludes config ++ [srcdir] }) + compileToplevelModule hscode + return $ either Left (Right . snd) result diff --git a/src/Test/Convert.hs b/src/Test/Convert.hs --- a/src/Test/Convert.hs +++ b/src/Test/Convert.hs @@ -51,6 +51,12 @@ ,ReadTest $ LabelledRecord2 { bar = 123, bob = 66.6 } ,ReadTest $ FooBar "Tinkie Winkie" "Humanzee" Zot ,ReadTest $ Bar $ Foo "one" "two" + ,ReadTest $ StepcutFoo 123 + ,ReadTest $ StepcutBar (StepcutFoo 456) + ,ReadTest $ StepcutFoo' 789 + ,ReadTest $ Baz (StepcutFoo' 10112) + ,ReadTest $ (Just 1 :: Maybe Double) + ,ReadTest $ (Nothing :: Maybe Double) ] -- | Test cases. @@ -65,6 +71,9 @@ ,((1,2) :: (Int,Int)) → "[1,2]" ,"abc" → "\"abc\"" ,'a' → "\"a\"" + -- Special cases + , Just (1 :: Double) → "1.0" + , (Nothing :: Maybe Double) → "null" -- Data records ,NullaryConstructor → "{\"instance\":\"NullaryConstructor\"}" ,NAryConstructor 123 4.5 → "{\"slot1\":123,\"slot2\":4.5,\"instance\":\"NAryConstructor\"}" @@ -120,3 +129,15 @@ -- | This triggers order difference. Go figure. data Zot = Zot deriving (Read,Data,Typeable,Show,Eq) + +data StepcutFoo = StepcutFoo { _unStepcutFoo :: Int } + deriving (Eq, Show, Read, Typeable, Data) + +data StepcutBar = StepcutBar StepcutFoo + deriving (Eq, Show, Read, Typeable, Data) + +data StepcutFoo' = StepcutFoo' Int + deriving (Eq, Show, Read, Typeable, Data) + +data Baz = Baz StepcutFoo' + deriving (Eq, Show, Read, Typeable, Data) diff --git a/src/Tests.hs b/src/Tests.hs --- a/src/Tests.hs +++ b/src/Tests.hs @@ -7,8 +7,7 @@ import Data.Default import Data.List -import Language.Fay.Compiler -import Language.Fay.Types +import Language.Fay import System.Directory import System.FilePath import System.Process.Extra @@ -34,7 +33,7 @@ let root = (reverse . drop 1 . dropWhile (/='.') . reverse) file out = toJsName file outExists <- doesFileExist root - compileFromTo def { configTypecheck = False, configDirectoryIncludes = ["tests/"] } file out + compileFromTo def { configTypecheck = False, configDirectoryIncludes = ["tests/"] } file (Just out) result <- runJavaScriptFile out if outExists then do output <- readFile root diff --git a/tests/Bool.hs b/tests/Bool.hs --- a/tests/Bool.hs +++ b/tests/Bool.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Bool where diff --git a/tests/Bool.js b/tests/Bool.js deleted file mode 100644 --- a/tests/Bool.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var Bool = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["bool"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 Bool(); -main._(main.main); - diff --git a/tests/Double.hs b/tests/Double.hs --- a/tests/Double.hs +++ b/tests/Double.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Double where diff --git a/tests/Double.js b/tests/Double.js deleted file mode 100644 --- a/tests/Double.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var Double = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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$$div)(_(_(Fay$$mult)(2)(4)))(2));});var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 Double(); -main._(main.main); - diff --git a/tests/Double2.hs b/tests/Double2.hs --- a/tests/Double2.hs +++ b/tests/Double2.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Double2 where diff --git a/tests/Double2.js b/tests/Double2.js deleted file mode 100644 --- a/tests/Double2.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var Double2 = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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$$add)(10)(_(_(Fay$$mult)(2)(_(_(Fay$$div)(4)(2))))));});var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 Double2(); -main._(main.main); - diff --git a/tests/Double3.hs b/tests/Double3.hs --- a/tests/Double3.hs +++ b/tests/Double3.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Double3 where diff --git a/tests/Double3.js b/tests/Double3.js deleted file mode 100644 --- a/tests/Double3.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var Double3 = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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$$div)(_(_(Fay$$mult)(5)(3)))(2));});var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 Double3(); -main._(main.main); - diff --git a/tests/Double4.hs b/tests/Double4.hs --- a/tests/Double4.hs +++ b/tests/Double4.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Double4 where diff --git a/tests/Double4.js b/tests/Double4.js deleted file mode 100644 --- a/tests/Double4.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var Double4 = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 Double4(); -main._(main.main); - diff --git a/tests/Hierarchical/Export.hs b/tests/Hierarchical/Export.hs --- a/tests/Hierarchical/Export.hs +++ b/tests/Hierarchical/Export.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Hierarchical.Export where diff --git a/tests/Hierarchical/RecordDefined.hs b/tests/Hierarchical/RecordDefined.hs --- a/tests/Hierarchical/RecordDefined.hs +++ b/tests/Hierarchical/RecordDefined.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Hierarchical.RecordDefined where diff --git a/tests/HierarchicalImport.hs b/tests/HierarchicalImport.hs --- a/tests/HierarchicalImport.hs +++ b/tests/HierarchicalImport.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module HierarchicalImport where diff --git a/tests/HierarchicalImport.js b/tests/HierarchicalImport.js deleted file mode 100644 --- a/tests/HierarchicalImport.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var HierarchicalImport = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 HierarchicalImport(); -main._(main.main); - diff --git a/tests/List.hs b/tests/List.hs --- a/tests/List.hs +++ b/tests/List.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module List where diff --git a/tests/List.js b/tests/List.js deleted file mode 100644 --- a/tests/List.js +++ /dev/null @@ -1,535 +0,0 @@ -/** @constructor -*/ -var List = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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$39$)(function($36$_a){var x = $36$_a;return _(Fay$$add)(_(x))(1);}))(ns));});return ns;})())));});var take = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === 0) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var n = $36$_a;return _(_(Fay$$cons)(x))(_(_(take)(_(Fay$$sub)(_(n))(1)))(xs));}throw ["unhandled case in Ident \"take\"",[$36$_a,$36$_b]];});};};var map$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var f = $36$_a;return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map$39$)(f))(xs));}throw ["unhandled case in Ident \"map'\"",[$36$_a,$36$_b]];});};};var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var showList = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["list",[["double"]]],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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.print = print; -this.map$39$ = map$39$; -this.take = take; -this.main = main; - -// Built-ins -this._ = _; -this.$ = $; -this.$fayToJs = Fay$$fayToJs; -this.$jsToFay = Fay$$jsToFay; - -}; -; -var main = new List(); -main._(main.main); - diff --git a/tests/List2.hs b/tests/List2.hs --- a/tests/List2.hs +++ b/tests/List2.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module List2 where diff --git a/tests/List2.js b/tests/List2.js deleted file mode 100644 --- a/tests/List2.js +++ /dev/null @@ -1,536 +0,0 @@ -/** @constructor -*/ -var List2 = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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$39$)(_(foo)(123)))(ns));});return ns;})())));});var foo = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(Fay$$div)(_(_(Fay$$mult)(_(x))(_(y))))(2);});};};var take = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === 0) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var n = $36$_a;return _(_(Fay$$cons)(x))(_(_(take)(_(Fay$$sub)(_(n))(1)))(xs));}throw ["unhandled case in Ident \"take\"",[$36$_a,$36$_b]];});};};var map$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var f = $36$_a;return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map$39$)(f))(xs));}throw ["unhandled case in Ident \"map'\"",[$36$_a,$36$_b]];});};};var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var showList = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["list",[["double"]]],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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.print = print; -this.map$39$ = map$39$; -this.take = take; -this.foo = foo; -this.main = main; - -// Built-ins -this._ = _; -this.$ = $; -this.$fayToJs = Fay$$fayToJs; -this.$jsToFay = Fay$$jsToFay; - -}; -; -var main = new List2(); -main._(main.main); - diff --git a/tests/Monad.hs b/tests/Monad.hs --- a/tests/Monad.hs +++ b/tests/Monad.hs @@ -1,5 +1,5 @@ {-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE NoImplicitPrelude #-} + -- | Monads test. diff --git a/tests/Monad.js b/tests/Monad.js deleted file mode 100644 --- a/tests/Monad.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var Monad = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){if (_($36$_a) === 123) {return _(_($62$$62$$61$)(_($_return)(456)))(function($36$_a){var x = $36$_a;return _(_($62$$62$)(_(_($62$$62$)(_(print)(x)))(_($_return)(Fay$$unit))))(_(_($62$$62$$61$)(_(_($62$$62$$61$)(_($_return)(666)))(function($36$_a){return _($_return)(789);})))(function($36$_a){var x = $36$_a;return _(_($62$$62$$61$)(_($_return)(101112)))(function($36$_a){var y = $36$_a;return _(_($62$$62$)(_(print)(x)))(_(print)(y));});}));});}throw ["unhandled case",$36$_a];});});var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 Monad(); -main._(main.main); - diff --git a/tests/Monad2.hs b/tests/Monad2.hs --- a/tests/Monad2.hs +++ b/tests/Monad2.hs @@ -1,5 +1,5 @@ {-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE NoImplicitPrelude #-} + {-# LANGUAGE RankNTypes #-} -- | Monads test. diff --git a/tests/Monad2.js b/tests/Monad2.js deleted file mode 100644 --- a/tests/Monad2.js +++ /dev/null @@ -1,537 +0,0 @@ -/** @constructor -*/ -var Monad2 = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_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 $36$_Monad(slot1,slot2,slot3);});};};};var demo = new $(function(){return (function($36$_stateMonad){if (_($36$_stateMonad) instanceof $36$_Monad) {var $_return = _($36$_stateMonad).slot1;var $62$$62$$61$ = _($36$_stateMonad).slot2;var $62$$62$ = _($36$_stateMonad).slot3;return _(_($62$$62$$61$)(get))(function($36$_a){var n = $36$_a;return _(_($62$$62$)(_(put)(_(Fay$$mult)(_(n))(2))))(_(_($62$$62$$61$)(get))(function($36$_a){var n = $36$_a;return _(_($62$$62$)(_(put)(_(Fay$$add)(_(n))(3))))(_($_return)(Fay$$list("abc")));}));});}return (function(){ throw (["unhandled case",$36$_stateMonad]); })();})(stateMonad);});var $36$_State = function(runState){this.runState = runState;};var State = function(runState){return new $(function(){return new $36$_State(runState);});};var runState = function(x){return new $(function(){return _(x).runState;});};var stateMonad = new $(function(){var $_return = new $(function(){return function($36$_a){var x = $36$_a;return _(State)(function($36$_a){var st = $36$_a;return Fay$$list([x,st]);});};});var $62$$62$$61$ = new $(function(){return function($36$_a){var processor = $36$_a;return function($36$_b){var processorGenerator = $36$_b;return _(_($36$)(State))(function($36$_a){var st = $36$_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($36$_a){var a = $36$_a;return function($36$_b){var b = $36$_b;return _(_($62$$62$$61$)(a))(function($36$_a){return b;});};};});return _(_(_(Monad)($_return))($62$$62$$61$))($62$$62$);});var put = function($36$_a){return new $(function(){var newState = $36$_a;return _(_($36$)(State))(function($36$_a){return Fay$$list([Fay$$unit,newState]);});});};var get = new $(function(){return _(_($36$)(State))(function($36$_a){var st = $36$_a;return Fay$$list([st,st]);});});var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $36$_State) {return {"instance": "State","runState": Fay$$fayToJs(["function",[["unknown"],["unknown"]]],_(_obj.runState))};}if (_obj instanceof $36$_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 $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "State") {return new $36$_State(Fay$$jsToFay(["function",[["unknown"],["unknown"]]],obj["runState"]));}if (obj["instance"] === "Monad") {return new $36$_Monad(Fay$$jsToFay(["unknown"],obj["slot1"]),Fay$$jsToFay(["unknown"],obj["slot2"]),Fay$$jsToFay(["unknown"],obj["slot3"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 Monad2(); -main._(main.main); - diff --git a/tests/RecCon.hs b/tests/RecCon.hs --- a/tests/RecCon.hs +++ b/tests/RecCon.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module RecCon where diff --git a/tests/RecCon.js b/tests/RecCon.js deleted file mode 100644 --- a/tests/RecCon.js +++ /dev/null @@ -1,534 +0,0 @@ -/** @constructor -*/ -var RecCon = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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 $36$_True = function(){};var True = new $(function(){return new $36$_True();});var $36$_False = function(){};var False = new $(function(){return new $36$_False();});var main = new $(function(){return _(print)(_(head)(_(fix)(function($36$_a){var xs = $36$_a;return _(_(Fay$$cons)(123))(xs);})));});var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$36$_a)));});};var head = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return x;}throw ["unhandled case in Ident \"head\"",[$36$_a]];});};var fix = function($36$_a){return new $(function(){var f = $36$_a;return (function(){var x = new $(function(){return _(f)(x);});return x;})();});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $36$_False) {return {"instance": "False"};}if (_obj instanceof $36$_True) {return {"instance": "True"};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "False") {return new $36$_False();}if (obj["instance"] === "True") {return new $36$_True();}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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.fix = fix; -this.head = head; -this.print = print; -this.main = main; - -// Built-ins -this._ = _; -this.$ = $; -this.$fayToJs = Fay$$fayToJs; -this.$jsToFay = Fay$$jsToFay; - -}; -; -var main = new RecCon(); -main._(main.main); - diff --git a/tests/RecDecl b/tests/RecDecl --- a/tests/RecDecl +++ b/tests/RecDecl @@ -5,7 +5,7 @@ 1 "a" { instance: 'R', i: 2, c: 'b' } -{ instance: 'R', i: undefined, c: 'b' } +{ instance: 'R', c: 'b' } { instance: 'R', i: 3, c: 'c' } { instance: 'S', slot1: 1, slot2: 'a' } { instance: 'X', _x1: 1, _x2: 2 } diff --git a/tests/RecDecl.hs b/tests/RecDecl.hs --- a/tests/RecDecl.hs +++ b/tests/RecDecl.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module RecDecl where diff --git a/tests/RecDecl.js b/tests/RecDecl.js deleted file mode 100644 --- a/tests/RecDecl.js +++ /dev/null @@ -1,547 +0,0 @@ -/** @constructor -*/ -var RecDecl = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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 $36$_R = function(i,c){this.i = i;this.c = c;};var R = function(i){return function(c){return new $(function(){return new $36$_R(i,c);});};};var i = function(x){return new $(function(){return _(x).i;});};var c = function(x){return new $(function(){return _(x).c;});};var $36$_S = function(slot1,slot2){this.slot1 = slot1;this.slot2 = slot2;};var S = function(slot1){return function(slot2){return new $(function(){return new $36$_S(slot1,slot2);});};};var r1 = new $(function(){var r = new $36$_R();r.i = 1;r.c = "a";return r;});var r2 = new $(function(){var r = new $36$_R();r.c = "b";r.i = 2;return r;});var r$39$ = new $(function(){var r = new $36$_R();r.c = "b";return r;});var r3 = new $(function(){return _(_(R)(3))("c");});var s1 = new $(function(){return _(_(S)(1))("a");});var $36$_X = function(_x1,_x2){this._x1 = _x1;this._x2 = _x2;};var X = function(_x1){return function(_x2){return new $(function(){return new $36$_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 $36$_X();x._x1 = 1;x._x2 = 2;return x;});var r1$39$ = new $(function(){var $36$_record_to_update = Object.create(_(r1));$36$_record_to_update.i = 10;return $36$_record_to_update;});var r2$39$ = new $(function(){var $36$_record_to_update = Object.create(_(r2));$36$_record_to_update.c = "a";$36$_record_to_update.i = 20;return $36$_record_to_update;});var r$39$$39$ = new $(function(){var $36$_record_to_update = Object.create(_(r$39$));$36$_record_to_update.i = 123;return $36$_record_to_update;});var main = new $(function(){return _(_($62$$62$)(_(print)(r1$39$)))(_(_($62$$62$)(_(print)(r2$39$)))(_(_($62$$62$)(_(print)(r$39$$39$)))(_(_($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($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["unknown"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $36$_X) {return {"instance": "X","_x1": Fay$$fayToJs(["int"],_(_obj._x1)),"_x2": Fay$$fayToJs(["int"],_(_obj._x2))};}if (_obj instanceof $36$_S) {return {"instance": "S","slot1": Fay$$fayToJs(["double"],_(_obj.slot1)),"slot2": Fay$$fayToJs(["user","Char",[]],_(_obj.slot2))};}if (_obj instanceof $36$_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 $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "X") {return new $36$_X(Fay$$jsToFay(["int"],obj["_x1"]),Fay$$jsToFay(["int"],obj["_x2"]));}if (obj["instance"] === "S") {return new $36$_S(Fay$$jsToFay(["double"],obj["slot1"]),Fay$$jsToFay(["user","Char",[]],obj["slot2"]));}if (obj["instance"] === "R") {return new $36$_R(Fay$$jsToFay(["double"],obj["i"]),Fay$$jsToFay(["user","Char",[]],obj["c"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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.printS = printS; -this.main = main; -this.r$39$$39$ = r$39$$39$; -this.r2$39$ = r2$39$; -this.r1$39$ = r1$39$; -this.x2 = x2; -this.x1 = x1; -this._x2 = _x2; -this._x1 = _x1; -this.s1 = s1; -this.r3 = r3; -this.r$39$ = r$39$; -this.r2 = r2; -this.r1 = r1; -this.c = c; -this.i = i; - -// Built-ins -this._ = _; -this.$ = $; -this.$fayToJs = Fay$$fayToJs; -this.$jsToFay = Fay$$jsToFay; - -}; -; -var main = new RecDecl(); -main._(main.main); - diff --git a/tests/RecordImport_Export.hs b/tests/RecordImport_Export.hs --- a/tests/RecordImport_Export.hs +++ b/tests/RecordImport_Export.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module RecordImport_Export where import Language.Fay.Prelude data R = R Integer +data Fields = Fields { fieldFoo :: Integer, fieldBar :: Integer } diff --git a/tests/RecordImport_Export.js b/tests/RecordImport_Export.js deleted file mode 100644 --- a/tests/RecordImport_Export.js +++ /dev/null @@ -1,530 +0,0 @@ -/** @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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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 $36$_R = function(slot1){this.slot1 = slot1;};var R = function(slot1){return new $(function(){return new $36$_R(slot1);});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $36$_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 $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "R") {return new $36$_R(Fay$$jsToFay(["user","Integer",[]],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 --- a/tests/RecordImport_Import +++ b/tests/RecordImport_Import @@ -1,1 +1,2 @@ R 1 +Fields 2 3 diff --git a/tests/RecordImport_Import.hs b/tests/RecordImport_Import.hs --- a/tests/RecordImport_Import.hs +++ b/tests/RecordImport_Import.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module RecordImport_Import where import Language.Fay.FFI @@ -10,11 +10,20 @@ f :: R -> R f (R i) = R i +g :: Fields -> Fields +g Fields { fieldFoo = a, fieldBar = b } = + Fields { fieldFoo = a, fieldBar = b } + showR :: R -> String showR (R i) = "R " ++ show i +showFields :: Fields -> String +showFields (Fields a b) = "Fields " ++ show a ++ " " ++ show b + printS :: String -> Fay () printS = ffi "console.log(%1)" -main = printS $ showR $ R 1 +main = do + printS $ showR $ R 1 + printS $ showFields $ Fields { fieldFoo = 2, fieldBar = 3 } diff --git a/tests/RecordImport_Import.js b/tests/RecordImport_Import.js deleted file mode 100644 --- a/tests/RecordImport_Import.js +++ /dev/null @@ -1,534 +0,0 @@ -/** @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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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 $36$_R = function(slot1){this.slot1 = slot1;};var R = function(slot1){return new $(function(){return new $36$_R(slot1);});};var f = function($36$_a){return new $(function(){if (_($36$_a) instanceof $36$_R) {var i = _($36$_a).slot1;return _(R)(i);}throw ["unhandled case in Ident \"f\"",[$36$_a]];});};var showR = function($36$_a){return new $(function(){if (_($36$_a) instanceof $36$_R) {var i = _($36$_a).slot1;return _(_($43$$43$)(Fay$$list("R ")))(_(show)(i));}throw ["unhandled case in Ident \"showR\"",[$36$_a]];});};var printS = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var main = new $(function(){return _(_($36$)(printS))(_(_($36$)(showR))(_(R)(1)));});var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $36$_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 $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "R") {return new $36$_R(Fay$$jsToFay(["user","Integer",[]],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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.hs b/tests/String.hs --- a/tests/String.hs +++ b/tests/String.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module String where diff --git a/tests/String.js b/tests/String.js deleted file mode 100644 --- a/tests/String.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var String = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 String(); -main._(main.main); - diff --git a/tests/asPatternMatch.hs b/tests/asPatternMatch.hs --- a/tests/asPatternMatch.hs +++ b/tests/asPatternMatch.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module AsPatternMatch where diff --git a/tests/asPatternMatch.js b/tests/asPatternMatch.js deleted file mode 100644 --- a/tests/asPatternMatch.js +++ /dev/null @@ -1,535 +0,0 @@ -/** @constructor -*/ -var AsPatternMatch = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){return new $(function(){var x = $36$_a;var y = $36$_a;return Fay$$list([x,y]);return Fay$$list([x,y]);throw ["unhandled case in Ident \"matchSame\"",[$36$_a]];});};var matchSplit = function($36$_a){return new $(function(){var x = $36$_a;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var y = $36$_$36$_a.car;var z = $36$_$36$_a.cdr;return Fay$$list([x,y,z]);}return Fay$$list([x,y,z]);throw ["unhandled case in Ident \"matchSplit\"",[$36$_a]];});};var matchNested = function($36$_a){return new $(function(){var a = Fay$$index(0)(_($36$_a));var b = Fay$$index(1)(_($36$_a));var $tmp = _(Fay$$index(1)(_($36$_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\"",[$36$_a]];});};var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_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 $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 AsPatternMatch(); -main._(main.main); - diff --git a/tests/basicFunctions.hs b/tests/basicFunctions.hs --- a/tests/basicFunctions.hs +++ b/tests/basicFunctions.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module BasicFunctions where diff --git a/tests/basicFunctions.js b/tests/basicFunctions.js deleted file mode 100644 --- a/tests/basicFunctions.js +++ /dev/null @@ -1,535 +0,0 @@ -/** @constructor -*/ -var BasicFunctions = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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$39$)(Fay$$list([Fay$$list("Hello, "),Fay$$list("World!")])));});var concat$39$ = new $(function(){return _(_(foldr$39$)(append))(null);});var foldr$39$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;var f = $36$_a;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr'\"",[$36$_a,$36$_b,$36$_c]];});};};};var append = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(append)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"append\"",[$36$_a,$36$_b]];});};};var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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.append = append; -this.foldr$39$ = foldr$39$; -this.concat$39$ = concat$39$; -this.main = main; - -// Built-ins -this._ = _; -this.$ = $; -this.$fayToJs = Fay$$fayToJs; -this.$jsToFay = Fay$$jsToFay; - -}; -; -var main = new BasicFunctions(); -main._(main.main); - diff --git a/tests/case.hs b/tests/case.hs --- a/tests/case.hs +++ b/tests/case.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Case where diff --git a/tests/case.js b/tests/case.js deleted file mode 100644 --- a/tests/case.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var Case = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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 (_($tmp) === true) {return Fay$$list("Hello!");}if (_($tmp) === false) {return Fay$$list("Ney!");}return (function(){ throw (["unhandled case",$tmp]); })();})(true));});var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 Case(); -main._(main.main); - diff --git a/tests/case2.hs b/tests/case2.hs --- a/tests/case2.hs +++ b/tests/case2.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Case2 where diff --git a/tests/case2.js b/tests/case2.js deleted file mode 100644 --- a/tests/case2.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var Case2 = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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 (_($tmp) === true) {return Fay$$list("Hello!");}if (_($tmp) === false) {return Fay$$list("Ney!");}return (function(){ throw (["unhandled case",$tmp]); })();})(false));});var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 Case2(); -main._(main.main); - diff --git a/tests/caseList.hs b/tests/caseList.hs --- a/tests/caseList.hs +++ b/tests/caseList.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module CaseList where diff --git a/tests/caseList.js b/tests/caseList.js deleted file mode 100644 --- a/tests/caseList.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var CaseList = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 CaseList(); -main._(main.main); - diff --git a/tests/caseWildcard.hs b/tests/caseWildcard.hs --- a/tests/caseWildcard.hs +++ b/tests/caseWildcard.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module CaseWildCard where diff --git a/tests/caseWildcard.js b/tests/caseWildcard.js deleted file mode 100644 --- a/tests/caseWildcard.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var CaseWildCard = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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 (_($tmp) === true) {return Fay$$list("Hello!");}return Fay$$list("Ney!");})(false));});var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 CaseWildCard(); -main._(main.main); - diff --git a/tests/do.hs b/tests/do.hs --- a/tests/do.hs +++ b/tests/do.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Do where diff --git a/tests/do.js b/tests/do.js deleted file mode 100644 --- a/tests/do.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var Do = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 Do(); -main._(main.main); - diff --git a/tests/doAssingPatternMatch.hs b/tests/doAssingPatternMatch.hs --- a/tests/doAssingPatternMatch.hs +++ b/tests/doAssingPatternMatch.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module DoAssignPatternMatch where diff --git a/tests/doAssingPatternMatch.js b/tests/doAssingPatternMatch.js deleted file mode 100644 --- a/tests/doAssingPatternMatch.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var DoAssignPatternMatch = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){if (_(Fay$$index(0)(_($36$_a))) === 1) {if (_(Fay$$index(1)(_($36$_a))) === 2) {return _(print)(Fay$$list("OK."));}}throw ["unhandled case",$36$_a];});});var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 DoAssignPatternMatch(); -main._(main.main); - diff --git a/tests/doBindAssign.hs b/tests/doBindAssign.hs --- a/tests/doBindAssign.hs +++ b/tests/doBindAssign.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module DoBindAssign where diff --git a/tests/doBindAssign.js b/tests/doBindAssign.js deleted file mode 100644 --- a/tests/doBindAssign.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var DoBindAssign = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){var x = $36$_a;return _(print)(x);});});var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 DoBindAssign(); -main._(main.main); - diff --git a/tests/emptyMain.hs b/tests/emptyMain.hs --- a/tests/emptyMain.hs +++ b/tests/emptyMain.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module EmptyMain where diff --git a/tests/emptyMain.js b/tests/emptyMain.js deleted file mode 100644 --- a/tests/emptyMain.js +++ /dev/null @@ -1,531 +0,0 @@ -/** @constructor -*/ -var EmptyMain = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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 $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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; - -// Built-ins -this._ = _; -this.$ = $; -this.$fayToJs = Fay$$fayToJs; -this.$jsToFay = Fay$$jsToFay; - -}; -; -var main = new EmptyMain(); -main._(main.main); - diff --git a/tests/fix.hs b/tests/fix.hs --- a/tests/fix.hs +++ b/tests/fix.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Fix where diff --git a/tests/fix.js b/tests/fix.js deleted file mode 100644 --- a/tests/fix.js +++ /dev/null @@ -1,535 +0,0 @@ -/** @constructor -*/ -var Fix = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){var xs = $36$_a;return _(_(Fay$$cons)(123))(xs);}))));});var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$36$_a)));});};var head = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return x;}throw ["unhandled case in Ident \"head\"",[$36$_a]];});};var fix = function($36$_a){return new $(function(){var f = $36$_a;return (function(){var x = new $(function(){return _(f)(x);});return x;})();});};var tail = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return xs;}throw ["unhandled case in Ident \"tail\"",[$36$_a]];});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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.tail = tail; -this.fix = fix; -this.head = head; -this.print = print; -this.main = main; - -// Built-ins -this._ = _; -this.$ = $; -this.$fayToJs = Fay$$fayToJs; -this.$jsToFay = Fay$$jsToFay; - -}; -; -var main = new Fix(); -main._(main.main); - diff --git a/tests/fromInteger.hs b/tests/fromInteger.hs --- a/tests/fromInteger.hs +++ b/tests/fromInteger.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module FromInteger where diff --git a/tests/fromInteger.js b/tests/fromInteger.js deleted file mode 100644 --- a/tests/fromInteger.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var FromInteger = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var main = new $(function(){return _(_($36$)(print))(_(_($36$)(show))(_(fromInteger)(5)));});var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 FromInteger(); -main._(main.main); - diff --git a/tests/infixDataConst.hs b/tests/infixDataConst.hs --- a/tests/infixDataConst.hs +++ b/tests/infixDataConst.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Test where diff --git a/tests/infixDataConst.js b/tests/infixDataConst.js deleted file mode 100644 --- a/tests/infixDataConst.js +++ /dev/null @@ -1,533 +0,0 @@ -/** @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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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 $36$_InfixConst1 = function(slot1,slot2){this.slot1 = slot1;this.slot2 = slot2;};var InfixConst1 = function(slot1){return function(slot2){return new $(function(){return new $36$_InfixConst1(slot1,slot2);});};};var $36$_InfixConst2 = function(slot1,slot2){this.slot1 = slot1;this.slot2 = slot2;};var InfixConst2 = function(slot1){return function(slot2){return new $(function(){return new $36$_InfixConst2(slot1,slot2);});};};var $36$_$36$58$36$$36$61$36$$36$62$36$ = function(slot1,slot2){this.slot1 = slot1;this.slot2 = slot2;};var $58$$61$$62$ = function(slot1){return function(slot2){return new $(function(){return new $36$_$36$58$36$$36$61$36$$36$62$36$(slot1,slot2);});};};var t = new $(function(){return _(_($58$$61$$62$)(_(_(InfixConst1)(123))(123)))(_(_(InfixConst2)(false))(true));});var main = new $(function(){return _(print)(t);});var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["user","Ty3",[]],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $36$_$36$58$36$$36$61$36$$36$62$36$) {return {"instance": "$58$$61$$62$","slot1": Fay$$fayToJs(["user","Ty1",[]],_(_obj.slot1)),"slot2": Fay$$fayToJs(["user","Ty2",[]],_(_obj.slot2))};}if (_obj instanceof $36$_InfixConst2) {return {"instance": "InfixConst2","slot1": Fay$$fayToJs(["bool"],_(_obj.slot1)),"slot2": Fay$$fayToJs(["bool"],_(_obj.slot2))};}if (_obj instanceof $36$_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 $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "$58$$61$$62$") {return new $36$_$36$58$36$$36$61$36$$36$62$36$(Fay$$jsToFay(["user","Ty1",[]],obj["slot1"]),Fay$$jsToFay(["user","Ty2",[]],obj["slot2"]));}if (obj["instance"] === "InfixConst2") {return new $36$_InfixConst2(Fay$$jsToFay(["bool"],obj["slot1"]),Fay$$jsToFay(["bool"],obj["slot2"]));}if (obj["instance"] === "InfixConst1") {return new $36$_InfixConst1(Fay$$jsToFay(["user","Integer",[]],obj["slot1"]),Fay$$jsToFay(["user","Integer",[]],obj["slot2"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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; -this.t = t; - -// Built-ins -this._ = _; -this.$ = $; -this.$fayToJs = Fay$$fayToJs; -this.$jsToFay = Fay$$jsToFay; - -}; -; -var main = new Test(); -main._(main.main); - diff --git a/tests/ints.hs b/tests/ints.hs --- a/tests/ints.hs +++ b/tests/ints.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Ints where diff --git a/tests/mutableReference.hs b/tests/mutableReference.hs --- a/tests/mutableReference.hs +++ b/tests/mutableReference.hs @@ -1,7 +1,7 @@ -- | Mutable references. {-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE NoImplicitPrelude #-} + module MutableReference where diff --git a/tests/mutableReference.js b/tests/mutableReference.js deleted file mode 100644 --- a/tests/mutableReference.js +++ /dev/null @@ -1,535 +0,0 @@ -/** @constructor -*/ -var MutableReference = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){var ref = $36$_a;return _(_($62$$62$$61$)(_(readRef)(ref)))(function($36$_a){var x = $36$_a;return _(_($62$$62$)(_(_(writeRef)(ref))(Fay$$list("Hai!"))))(_(_($62$$62$$61$)(_(readRef)(ref)))(print));});});});var newRef = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["user","Ref",[["unknown"]]]]],new Fay$$Ref(Fay$$fayToJs(["unknown"],$36$_a)));});};var writeRef = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],Fay$$writeRef(Fay$$fayToJs(["user","Ref",[["unknown"]]],$36$_a),Fay$$fayToJs(["unknown"],$36$_b)));});};};var readRef = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],Fay$$readRef(Fay$$fayToJs(["user","Ref",[["unknown"]]],$36$_a)));});};var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 MutableReference(); -main._(main.main); - diff --git a/tests/patternGuards.hs b/tests/patternGuards.hs --- a/tests/patternGuards.hs +++ b/tests/patternGuards.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE NoImplicitPrelude #-} + module PatternGuards where diff --git a/tests/patternGuards.js b/tests/patternGuards.js deleted file mode 100644 --- a/tests/patternGuards.js +++ /dev/null @@ -1,537 +0,0 @@ -/** @constructor -*/ -var PatternGuards = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){return new $(function(){var x = $36$_a;return _(_(Fay$$gt)(_(x))(0)) ? true : _(_(_(Fay$$lte)(x))(0)) ? false : (function(){ throw ("Non-exhaustive guards"); })();});};var threeConds = function($36$_a){return new $(function(){var x = $36$_a;return _(_(Fay$$gt)(_(x))(1)) ? 2 : _(_(_(Fay$$eq)(x))(1)) ? 1 : _(_(Fay$$lt)(_(x))(1)) ? 0 : (function(){ throw ("Non-exhaustive guards"); })();});};var withOtherwise = function($36$_a){return new $(function(){var x = $36$_a;return _(_(Fay$$gt)(_(x))(1)) ? true : false;});};var nonExhaustive = function($36$_a){return new $(function(){var x = $36$_a;return _(_(Fay$$gt)(_(x))(1)) ? true : (function(){ throw ("Non-exhaustive guards"); })();});};var printD = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["list",[["double"]]],$36$_a)));});};var printB = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["list",[["bool"]]],$36$_a)));});};var main = new $(function(){return _(_($62$$62$)(_(printB)(Fay$$list([_(isPositive)(1),_(isPositive)(0)]))))(_(_($62$$62$)(_(printD)(Fay$$list([_(threeConds)(3),_(threeConds)(1),_(threeConds)(0)]))))(_(printB)(Fay$$list([_(withOtherwise)(2),_(withOtherwise)(0)]))));});var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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.printB = printB; -this.printD = printD; -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 PatternGuards(); -main._(main.main); - diff --git a/tests/patternMatchFail.hs b/tests/patternMatchFail.hs --- a/tests/patternMatchFail.hs +++ b/tests/patternMatchFail.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module PatternMatchFail where diff --git a/tests/patternMatchFail.js b/tests/patternMatchFail.js deleted file mode 100644 --- a/tests/patternMatchFail.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var PatternMatchFail = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){var a = $36$_a;return function($36$_b){if (_($36$_b) === "a") {return Fay$$list("OK.");}throw ["unhandled case",$36$_b];};throw ["unhandled case",$36$_a];})(0))("b"));});var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 PatternMatchFail(); -main._(main.main); - diff --git a/tests/recordFunctionPatternMatch.hs b/tests/recordFunctionPatternMatch.hs --- a/tests/recordFunctionPatternMatch.hs +++ b/tests/recordFunctionPatternMatch.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module RecordFunctionPatternMatch where diff --git a/tests/recordFunctionPatternMatch.js b/tests/recordFunctionPatternMatch.js deleted file mode 100644 --- a/tests/recordFunctionPatternMatch.js +++ /dev/null @@ -1,533 +0,0 @@ -/** @constructor -*/ -var RecordFunctionPatternMatch = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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 $36$_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 $36$_Person(slot1,slot2,slot3);});};};};var main = new $(function(){return _(print)(_(foo)(_(_(_(Person)(Fay$$list("Chris")))(Fay$$list("Done")))(14)));});var foo = function($36$_a){return new $(function(){if (_($36$_a) instanceof $36$_Person) {if (Fay$$equal(_($36$_a).slot1,Fay$$list("Chris"))) {if (Fay$$equal(_($36$_a).slot2,Fay$$list("Done"))) {if (_(_($36$_a).slot3) === 13) {return Fay$$list("Foo!");}}if (Fay$$equal(_($36$_a).slot2,Fay$$list("Barf"))) {if (_(_($36$_a).slot3) === 14) {return Fay$$list("Bar!");}}if (Fay$$equal(_($36$_a).slot2,Fay$$list("Done"))) {if (_(_($36$_a).slot3) === 14) {return Fay$$list("Hello!");}}}}return Fay$$list("World!");});};var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $36$_Person) {return {"instance": "Person","slot1": Fay$$fayToJs(["string"],_(_obj.slot1)),"slot2": Fay$$fayToJs(["string"],_(_obj.slot2)),"slot3": Fay$$fayToJs(["int"],_(_obj.slot3))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "Person") {return new $36$_Person(Fay$$jsToFay(["string"],obj["slot1"]),Fay$$jsToFay(["string"],obj["slot2"]),Fay$$jsToFay(["int"],obj["slot3"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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.foo = foo; -this.main = main; - -// Built-ins -this._ = _; -this.$ = $; -this.$fayToJs = Fay$$fayToJs; -this.$jsToFay = Fay$$jsToFay; - -}; -; -var main = new RecordFunctionPatternMatch(); -main._(main.main); - diff --git a/tests/recordPatternMatch.hs b/tests/recordPatternMatch.hs --- a/tests/recordPatternMatch.hs +++ b/tests/recordPatternMatch.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module RecordPatternMatch where diff --git a/tests/recordPatternMatch.js b/tests/recordPatternMatch.js deleted file mode 100644 --- a/tests/recordPatternMatch.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var RecordPatternMatch = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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 $36$_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 $36$_Person(slot1,slot2,slot3);});};};};var main = new $(function(){return _(print)((function($tmp){if (_($tmp) instanceof $36$_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($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $36$_Person) {return {"instance": "Person","slot1": Fay$$fayToJs(["string"],_(_obj.slot1)),"slot2": Fay$$fayToJs(["string"],_(_obj.slot2)),"slot3": Fay$$fayToJs(["int"],_(_obj.slot3))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "Person") {return new $36$_Person(Fay$$jsToFay(["string"],obj["slot1"]),Fay$$jsToFay(["string"],obj["slot2"]),Fay$$jsToFay(["int"],obj["slot3"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 RecordPatternMatch(); -main._(main.main); - diff --git a/tests/recordPatternMatch2.hs b/tests/recordPatternMatch2.hs --- a/tests/recordPatternMatch2.hs +++ b/tests/recordPatternMatch2.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module RecordPatternMatch2 where diff --git a/tests/recordPatternMatch2.js b/tests/recordPatternMatch2.js deleted file mode 100644 --- a/tests/recordPatternMatch2.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var RecordPatternMatch2 = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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 $36$_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 $36$_Person(slot1,slot2,slot3);});};};};var main = new $(function(){return _(print)((function($tmp){if (_($tmp) instanceof $36$_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($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $36$_Person) {return {"instance": "Person","slot1": Fay$$fayToJs(["string"],_(_obj.slot1)),"slot2": Fay$$fayToJs(["string"],_(_obj.slot2)),"slot3": Fay$$fayToJs(["int"],_(_obj.slot3))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "Person") {return new $36$_Person(Fay$$jsToFay(["string"],obj["slot1"]),Fay$$jsToFay(["string"],obj["slot2"]),Fay$$jsToFay(["int"],obj["slot3"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 RecordPatternMatch2(); -main._(main.main); - diff --git a/tests/recordUseBeforeDefine.hs b/tests/recordUseBeforeDefine.hs --- a/tests/recordUseBeforeDefine.hs +++ b/tests/recordUseBeforeDefine.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module RecordUseBeforeDefine where diff --git a/tests/recordUseBeforeDefine.js b/tests/recordUseBeforeDefine.js deleted file mode 100644 --- a/tests/recordUseBeforeDefine.js +++ /dev/null @@ -1,533 +0,0 @@ -/** @constructor -*/ -var RecordUseBeforeDefine = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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 $36$_Callback = function(slot1){this.slot1 = slot1;};var Callback = function(slot1){return new $(function(){return new $36$_Callback(slot1);});};var g = function($36$_a){return new $(function(){if (_($36$_a) instanceof $36$_Callback) {var a = _($36$_a).slot1;return a;}throw ["unhandled case in Ident \"g\"",[$36$_a]];});};var f = function($36$_a){return new $(function(){if (_($36$_a) instanceof $36$_R) {var i = _($36$_a).slot1;return i;}throw ["unhandled case in Ident \"f\"",[$36$_a]];});};var main = new $(function(){return _(_($62$$62$)(_(_($36$)(print))(_(f)(_(R)(1)))))(_(_($36$)(print))(_(g)(_(Callback)(1))));});var $36$_R = function(slot1){this.slot1 = slot1;};var R = function(slot1){return new $(function(){return new $36$_R(slot1);});};var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $36$_R) {return {"instance": "R","slot1": Fay$$fayToJs(["double"],_(_obj.slot1))};}if (_obj instanceof $36$_Callback) {return {"instance": "Callback","slot1": Fay$$fayToJs(["double"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "R") {return new $36$_R(Fay$$jsToFay(["double"],obj["slot1"]));}if (obj["instance"] === "Callback") {return new $36$_Callback(Fay$$jsToFay(["double"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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; -this.f = f; - -// Built-ins -this._ = _; -this.$ = $; -this.$fayToJs = Fay$$fayToJs; -this.$jsToFay = Fay$$jsToFay; - -}; -; -var main = new RecordUseBeforeDefine(); -main._(main.main); - diff --git a/tests/records.hs b/tests/records.hs --- a/tests/records.hs +++ b/tests/records.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Records where diff --git a/tests/records.js b/tests/records.js deleted file mode 100644 --- a/tests/records.js +++ /dev/null @@ -1,542 +0,0 @@ -/** @constructor -*/ -var Records = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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 $36$_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 $36$_Person1(slot1,slot2,slot3);});};};};var $36$_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 $36$_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 $36$_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 $36$_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 $36$_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($36$_p1){if (_($36$_p1) instanceof $36$_Person1) {if (Fay$$equal(_($36$_p1).slot1,Fay$$list("Chris"))) {if (Fay$$equal(_($36$_p1).slot2,Fay$$list("Done"))) {if (_(_($36$_p1).slot3) === 13) {return Fay$$list("Hello!");}}}}return (function(){ throw (["unhandled case",$36$_p1]); })();})(p1))))(_(_($62$$62$)(_(print)((function($36$_p2){if (_($36$_p2) instanceof $36$_Person2) {if (Fay$$equal(_($36$_p2).fname,Fay$$list("Chris"))) {if (Fay$$equal(_($36$_p2).sname,Fay$$list("Done"))) {if (_(_($36$_p2).age) === 13) {return Fay$$list("Hello!");}}}}return (function(){ throw (["unhandled case",$36$_p2]); })();})(p2))))(_(_($62$$62$)(_(print)((function($36$_p2a){if (_($36$_p2a) instanceof $36$_Person2) {if (Fay$$equal(_($36$_p2a).fname,Fay$$list("Chris"))) {if (Fay$$equal(_($36$_p2a).sname,Fay$$list("Done"))) {if (_(_($36$_p2a).age) === 13) {return Fay$$list("Hello!");}}}}return (function(){ throw (["unhandled case",$36$_p2a]); })();})(p2a))))(_(print)((function($36$_p3){if (_($36$_p3) instanceof $36$_Person3) {if (Fay$$equal(_($36$_p3).slot3,Fay$$list("Chris"))) {if (Fay$$equal(_($36$_p3).slot2,Fay$$list("Done"))) {if (_(_($36$_p3).slot1) === 13) {return Fay$$list("Hello!");}}}}return (function(){ throw (["unhandled case",$36$_p3]); })();})(p3)))));});var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}if (_obj instanceof $36$_Person3) {return {"instance": "Person3","slot3": Fay$$fayToJs(["string"],_(_obj.slot3)),"slot2": Fay$$fayToJs(["string"],_(_obj.slot2)),"slot1": Fay$$fayToJs(["int"],_(_obj.slot1))};}if (_obj instanceof $36$_Person2) {return {"instance": "Person2","fname": Fay$$fayToJs(["string"],_(_obj.fname)),"sname": Fay$$fayToJs(["string"],_(_obj.sname)),"age": Fay$$fayToJs(["int"],_(_obj.age))};}if (_obj instanceof $36$_Person1) {return {"instance": "Person1","slot1": Fay$$fayToJs(["string"],_(_obj.slot1)),"slot2": Fay$$fayToJs(["string"],_(_obj.slot2)),"slot3": Fay$$fayToJs(["int"],_(_obj.slot3))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}if (obj["instance"] === "Person3") {return new $36$_Person3(Fay$$jsToFay(["string"],obj["slot3"]),Fay$$jsToFay(["string"],obj["slot2"]),Fay$$jsToFay(["int"],obj["slot1"]));}if (obj["instance"] === "Person2") {return new $36$_Person2(Fay$$jsToFay(["string"],obj["fname"]),Fay$$jsToFay(["string"],obj["sname"]),Fay$$jsToFay(["int"],obj["age"]));}if (obj["instance"] === "Person1") {return new $36$_Person1(Fay$$jsToFay(["string"],obj["slot1"]),Fay$$jsToFay(["string"],obj["slot2"]),Fay$$jsToFay(["int"],obj["slot3"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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; -this.p3 = p3; -this.p2a = p2a; -this.p2 = p2; -this.p1 = p1; -this.slot1 = slot1; -this.slot2 = slot2; -this.slot3 = slot3; -this.age = age; -this.sname = sname; -this.fname = fname; - -// Built-ins -this._ = _; -this.$ = $; -this.$fayToJs = Fay$$fayToJs; -this.$jsToFay = Fay$$jsToFay; - -}; -; -var main = new Records(); -main._(main.main); - diff --git a/tests/reservedWords.hs b/tests/reservedWords.hs --- a/tests/reservedWords.hs +++ b/tests/reservedWords.hs @@ -1,5 +1,5 @@ {-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE NoImplicitPrelude #-} + module ReservedWords where diff --git a/tests/reservedWords.js b/tests/reservedWords.js deleted file mode 100644 --- a/tests/reservedWords.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var ReservedWords = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 ReservedWords(); -main._(main.main); - diff --git a/tests/tailRecursion.hs b/tests/tailRecursion.hs --- a/tests/tailRecursion.hs +++ b/tests/tailRecursion.hs @@ -1,9 +1,9 @@ -- | This is to test tail-recursive calls are iterative. -{-# LANGUAGE NoImplicitPrelude #-} -module Fib where +module Tail where + import Language.Fay.FFI import Language.Fay.Prelude @@ -12,9 +12,6 @@ sum 0 acc = acc sum n acc = sum (n - 1) (acc + n) - -getSeconds :: Fay Double -getSeconds = ffi "new Date" print :: Double -> Fay () print = ffi "console.log(%1)" diff --git a/tests/tailRecursion.js b/tests/tailRecursion.js deleted file mode 100644 --- a/tests/tailRecursion.js +++ /dev/null @@ -1,534 +0,0 @@ -/** @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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){return function($36$_b){return new $(function(){var acc = $36$_b;if (_($36$_a) === 0) {return acc;}var acc = $36$_b;var n = $36$_a;return _(_(sum)(_(Fay$$sub)(_(n))(1)))(_(Fay$$add)(_(acc))(_(n)));});};};var getSeconds = new $(function(){return Fay$$jsToFay(["action",[["double"]]],new Date);});var print = function($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["double"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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.hs b/tests/then.hs --- a/tests/then.hs +++ b/tests/then.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Then where diff --git a/tests/then.js b/tests/then.js deleted file mode 100644 --- a/tests/then.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var Then = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 Then(); -main._(main.main); - diff --git a/tests/utf8.hs b/tests/utf8.hs --- a/tests/utf8.hs +++ b/tests/utf8.hs @@ -1,5 +1,5 @@ {-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE NoImplicitPrelude #-} + -- | Unicode test. module Utf8 where diff --git a/tests/utf8.js b/tests/utf8.js deleted file mode 100644 --- a/tests/utf8.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var Utf8 = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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("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($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 Utf8(); -main._(main.main); - diff --git a/tests/where.hs b/tests/where.hs --- a/tests/where.hs +++ b/tests/where.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude #-} + module Where where diff --git a/tests/where.js b/tests/where.js deleted file mode 100644 --- a/tests/where.js +++ /dev/null @@ -1,532 +0,0 @@ -/** @constructor -*/ -var Where = 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.value = this.value(), this.forced = true, this.value)); -}; - -/******************************************************************************* - * 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 "int": { - // Serialize int, just force the argument. Ints 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 "int": { - // Int are unboxed, so there's no forcing to do. - // But we can do validation that the int has no decimal places. - // E.g. Math.round(x)!=x? throw "NOT AN INTEGER, GET OUT!" - fayObj = Math.round(jsObj); - if(fayObj!==jsObj) throw "Argument " + jsObj + " is not an integer!"; - 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 new $(function(){ - return _(x) * _(y); - }); - }; -} -var $42$ = Fay$$mult; - -// Built-in +. -function Fay$$add(x){ - return function(y){ - return new $(function(){ - return _(x) + _(y); - }); - }; -} -var $43$ = Fay$$add; - -// Built-in -. -function Fay$$sub(x){ - return function(y){ - return new $(function(){ - return _(x) - _(y); - }); - }; -} -var $45$ = Fay$$sub; - -// Built-in /. -function Fay$$div(x){ - return function(y){ - return new $(function(){ - return _(x) / _(y); - }); - }; -} -var $47$ = Fay$$div; - -/******************************************************************************* - * 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 if (typeof lit1 == 'object' && typeof lit2 == 'object' && lit1 && lit2 && - lit1.constructor === lit2.constructor) { - for(var x in lit1) { - if(!(lit1.hasOwnProperty(x) && lit2.hasOwnProperty(x) && - Fay$$equal(lit1[x],lit2[x]))) - return false; - } - return true; - } else { - return false; - } -} - -// Built-in ==. -function Fay$$eq(x){ - return function(y){ - return new $(function(){ - return Fay$$equal(x,y); - }); - }; -} -var $61$$61$ = Fay$$eq; - -// Built-in /=. -function Fay$$neq(x){ - return function(y){ - return new $(function(){ - return !(Fay$$equal(x,y)); - }); - }; -} -var $47$$61$ = Fay$$neq; - -// Built-in >. -function Fay$$gt(x){ - return function(y){ - return new $(function(){ - return _(x) > _(y); - }); - }; -} -var $62$ = Fay$$gt; - -// Built-in <. -function Fay$$lt(x){ - return function(y){ - return new $(function(){ - return _(x) < _(y); - }); - }; -} -var $60$ = Fay$$lt; - -// Built-in >=. -function Fay$$gte(x){ - return function(y){ - return new $(function(){ - return _(x) >= _(y); - }); - }; -} -var $62$$61$ = Fay$$gte; - -// Built-in <=. -function Fay$$lte(x){ - return function(y){ - return new $(function(){ - return _(x) <= _(y); - }); - }; -} -var $60$$61$ = Fay$$lte; - -// Built-in &&. -function Fay$$and(x){ - return function(y){ - return new $(function(){ - return _(x) && _(y); - }); - }; -} -var $38$$38$ = Fay$$and; - -// Built-in ||. -function Fay$$or(x){ - return function(y){ - return new $(function(){ - return _(x) || _(y); - }); - }; -} -var $124$$124$ = Fay$$or; - -/******************************************************************************* - * 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($36$_a){return new $(function(){return Fay$$jsToFay(["action",[["unknown"]]],console.log(Fay$$fayToJs(["string"],$36$_a)));});};var $36$_Just = function(slot1){this.slot1 = slot1;};var Just = function(slot1){return new $(function(){return new $36$_Just(slot1);});};var $36$_Nothing = function(){};var Nothing = new $(function(){return new $36$_Nothing();});var show = function($36$_a){return new $(function(){return Fay$$jsToFay(["string"],JSON.stringify(Fay$$fayToJs(["unknown"],$36$_a)));});};var fromInteger = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var fromRational = function($36$_a){return new $(function(){var x = $36$_a;return x;});};var snd = function($36$_a){return new $(function(){var x = Fay$$index(1)(_($36$_a));return x;throw ["unhandled case in Ident \"snd\"",[$36$_a]];});};var fst = function($36$_a){return new $(function(){var x = Fay$$index(0)(_($36$_a));return x;throw ["unhandled case in Ident \"fst\"",[$36$_a]];});};var find = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(Just)(x) : _(_(find)(p))(xs);}if (_($36$_b) === null) {return Nothing;}throw ["unhandled case in Ident \"find\"",[$36$_a,$36$_b]];});};};var any = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? true : _(_(any)(p))(xs);}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"any\"",[$36$_a,$36$_b]];});};};var filter = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var p = $36$_a;return _(_(p)(x)) ? _(_(Fay$$cons)(x))(_(_(filter)(p))(xs)) : _(_(filter)(p))(xs);}if (_($36$_b) === null) {return null;}throw ["unhandled case in Ident \"filter\"",[$36$_a,$36$_b]];});};};var not = function($36$_a){return new $(function(){var p = $36$_a;return _(p) ? false : true;});};var $_null = function($36$_a){return new $(function(){if (_($36$_a) === null) {return true;}return false;});};var map = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(f)(x)))(_(_(map)(f))(xs));}throw ["unhandled case in Ident \"map\"",[$36$_a,$36$_b]];});};};var nub = function($36$_a){return new $(function(){var ls = $36$_a;return _(_(nub$39$)(ls))(null);});};var nub$39$ = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_a) === null) {return null;}var ls = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_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'\"",[$36$_a,$36$_b]];});};};var elem = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var y = $36$_$36$_b.car;var ys = $36$_$36$_b.cdr;var x = $36$_a;return _(Fay$$or)(_(_(_(Fay$$eq)(x))(y)))(_(_(_(elem)(x))(ys)));}if (_($36$_b) === null) {return false;}throw ["unhandled case in Ident \"elem\"",[$36$_a,$36$_b]];});};};var $36$_GT = function(){};var GT = new $(function(){return new $36$_GT();});var $36$_LT = function(){};var LT = new $(function(){return new $36$_LT();});var $36$_EQ = function(){};var EQ = new $(function(){return new $36$_EQ();});var sort = new $(function(){return _(sortBy)(compare);});var compare = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(Fay$$gt)(_(x))(_(y))) ? GT : _(_(Fay$$lt)(_(x))(_(y))) ? LT : EQ;});};};var sortBy = function($36$_a){return new $(function(){var cmp = $36$_a;return _(_(foldr)(_(insertBy)(cmp)))(null);});};var insertBy = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var x = $36$_b;return Fay$$list([x]);}var ys = $36$_c;var x = $36$_b;var cmp = $36$_a;return (function($36$_ys){if (_($36$_ys) === null) {return Fay$$list([x]);}var $36$_$36$_ys = _($36$_ys);if ($36$_$36$_ys instanceof Fay$$Cons) {var y = $36$_$36$_ys.car;var ys$39$ = $36$_$36$_ys.cdr;return (function($tmp){if (_($tmp) instanceof $36$_GT) {return _(_(Fay$$cons)(y))(_(_(_(insertBy)(cmp))(x))(ys$39$));}return _(_(Fay$$cons)(x))(ys);})(_(_(cmp)(x))(y));}return (function(){ throw (["unhandled case",$36$_ys]); })();})(ys);});};};};var when = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var p = $36$_a;return _(p) ? _(_($62$$62$)(m))(_($_return)(Fay$$unit)) : _($_return)(Fay$$unit);});};};var enumFrom = function($36$_a){return new $(function(){var i = $36$_a;return _(_(Fay$$cons)(i))(_(enumFrom)(_(Fay$$add)(_(i))(1)));});};var enumFromTo = function($36$_a){return function($36$_b){return new $(function(){var n = $36$_b;var i = $36$_a;return _(_(_(Fay$$eq)(i))(n)) ? Fay$$list([i]) : _(_(Fay$$cons)(i))(_(_(enumFromTo)(_(Fay$$add)(_(i))(1)))(n));});};};var zipWith = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var b = $36$_$36$_c.car;var bs = $36$_$36$_c.cdr;var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var a = $36$_$36$_b.car;var as = $36$_$36$_b.cdr;var f = $36$_a;return _(_(Fay$$cons)(_(_(f)(a))(b)))(_(_(_(zipWith)(f))(as))(bs));}}return null;});};};};var zip = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var b = $36$_$36$_b.car;var bs = $36$_$36$_b.cdr;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var a = $36$_$36$_a.car;var as = $36$_$36$_a.cdr;return _(_(Fay$$cons)(Fay$$list([a,b])))(_(_(zip)(as))(bs));}}return null;});};};var flip = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var y = $36$_c;var x = $36$_b;var f = $36$_a;return _(_(f)(y))(x);});};};};var maybe = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) instanceof $36$_Nothing) {var m = $36$_a;return m;}if (_($36$_c) instanceof $36$_Just) {var x = _($36$_c).slot1;var f = $36$_b;return _(f)(x);}throw ["unhandled case in Ident \"maybe\"",[$36$_a,$36$_b,$36$_c]];});};};};var $46$ = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){var x = $36$_c;var g = $36$_b;var f = $36$_a;return _(f)(_(g)(x));});};};};var $43$$43$ = function($36$_a){return function($36$_b){return new $(function(){var y = $36$_b;var x = $36$_a;return _(_(conc)(x))(y);});};};var $36$ = function($36$_a){return function($36$_b){return new $(function(){var x = $36$_b;var f = $36$_a;return _(f)(x);});};};var conc = function($36$_a){return function($36$_b){return new $(function(){var ys = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_(Fay$$cons)(x))(_(_(conc)(xs))(ys));}var ys = $36$_b;if (_($36$_a) === null) {return ys;}throw ["unhandled case in Ident \"conc\"",[$36$_a,$36$_b]];});};};var concat = new $(function(){return _(_(foldr)(conc))(null);});var foldr = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(f)(x))(_(_(_(foldr)(f))(z))(xs));}throw ["unhandled case in Ident \"foldr\"",[$36$_a,$36$_b,$36$_c]];});};};};var foldl = function($36$_a){return function($36$_b){return function($36$_c){return new $(function(){if (_($36$_c) === null) {var z = $36$_b;return z;}var $36$_$36$_c = _($36$_c);if ($36$_$36$_c instanceof Fay$$Cons) {var x = $36$_$36$_c.car;var xs = $36$_$36$_c.cdr;var z = $36$_b;var f = $36$_a;return _(_(_(foldl)(f))(_(_(f)(z))(x)))(xs);}throw ["unhandled case in Ident \"foldl\"",[$36$_a,$36$_b,$36$_c]];});};};};var lookup = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {var _key = $36$_a;return Nothing;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = Fay$$index(0)(_($36$_$36$_b.car));var y = Fay$$index(1)(_($36$_$36$_b.car));var xys = $36$_$36$_b.cdr;var key = $36$_a;return _(_(_(Fay$$eq)(key))(x)) ? _(Just)(y) : _(_(lookup)(key))(xys);}throw ["unhandled case in Ident \"lookup\"",[$36$_a,$36$_b]];});};};var intersperse = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs));}throw ["unhandled case in Ident \"intersperse\"",[$36$_a,$36$_b]];});};};var prependToAll = function($36$_a){return function($36$_b){return new $(function(){if (_($36$_b) === null) {return null;}var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var sep = $36$_a;return _(_(Fay$$cons)(sep))(_(_(Fay$$cons)(x))(_(_(prependToAll)(sep))(xs)));}throw ["unhandled case in Ident \"prependToAll\"",[$36$_a,$36$_b]];});};};var intercalate = function($36$_a){return function($36$_b){return new $(function(){var xss = $36$_b;var xs = $36$_a;return _(concat)(_(_(intersperse)(xs))(xss));});};};var forM_ = function($36$_a){return function($36$_b){return new $(function(){var m = $36$_b;var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($62$$62$)(_(m)(x)))(_(_(forM_)(xs))(m));}if (_($36$_a) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"forM_\"",[$36$_a,$36$_b]];});};};var mapM_ = function($36$_a){return function($36$_b){return new $(function(){var $36$_$36$_b = _($36$_b);if ($36$_$36$_b instanceof Fay$$Cons) {var x = $36$_$36$_b.car;var xs = $36$_$36$_b.cdr;var m = $36$_a;return _(_($62$$62$)(_(m)(x)))(_(_(mapM_)(m))(xs));}if (_($36$_b) === null) {return _($_return)(Fay$$unit);}throw ["unhandled case in Ident \"mapM_\"",[$36$_a,$36$_b]];});};};var $_const = function($36$_a){return function($36$_b){return new $(function(){var a = $36$_a;return a;});};};var length = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var xs = $36$_$36$_a.cdr;return _(Fay$$add)(1)(_(_(length)(xs)));}if (_($36$_a) === null) {return 0;}throw ["unhandled case in Ident \"length\"",[$36$_a]];});};var mod = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["double"],$36$_a) % Fay$$fayToJs(["double"],$36$_b));});};};var min = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.min(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var max = function($36$_a){return function($36$_b){return new $(function(){return Fay$$jsToFay(["double"],Math.max(Fay$$fayToJs(["double"],$36$_a),Fay$$fayToJs(["double"],$36$_b)));});};};var fromIntegral = function($36$_a){return new $(function(){return Fay$$jsToFay(["double"],Fay$$fayToJs(["int"],$36$_a));});};var otherwise = true;var reverse = function($36$_a){return new $(function(){var $36$_$36$_a = _($36$_a);if ($36$_$36$_a instanceof Fay$$Cons) {var x = $36$_$36$_a.car;var xs = $36$_$36$_a.cdr;return _(_($43$$43$)(_(reverse)(xs)))(Fay$$list([x]));}if (_($36$_a) === null) {return null;}throw ["unhandled case in Ident \"reverse\"",[$36$_a]];});};var Fay$$fayToJsUserDefined = function(type,obj){var _obj = _(obj);var argTypes = type[2];if (_obj instanceof $36$_EQ) {return {"instance": "EQ"};}if (_obj instanceof $36$_LT) {return {"instance": "LT"};}if (_obj instanceof $36$_GT) {return {"instance": "GT"};}if (_obj instanceof $36$_Nothing) {return {"instance": "Nothing"};}if (_obj instanceof $36$_Just) {return {"instance": "Just","slot1": Fay$$fayToJs(["unknown"],_(_obj.slot1))};}return obj;};var Fay$$jsToFayUserDefined = function(type,obj){if (obj["instance"] === "EQ") {return new $36$_EQ();}if (obj["instance"] === "LT") {return new $36$_LT();}if (obj["instance"] === "GT") {return new $36$_GT();}if (obj["instance"] === "Nothing") {return new $36$_Nothing();}if (obj["instance"] === "Just") {return new $36$_Just(Fay$$jsToFay(["unknown"],obj["slot1"]));}return obj;}; -// Exports -this.reverse = reverse; -this.otherwise = otherwise; -this.fromIntegral = fromIntegral; -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 Where(); -main._(main.main); -