fay 0.18.1.1 → 0.18.1.2
raw patch · 6 files changed
+57/−50 lines, 6 filesdep −haskelinedep ~Cabaldep ~HUnitdep ~aeson
Dependencies removed: haskeline
Dependency ranges changed: Cabal, HUnit, aeson, containers, cpphs, directory, filepath, ghc-paths, haskell-src-exts, language-ecmascript, mtl, pretty-show, process, safe, split, syb, test-framework, test-framework-hunit, test-framework-th, unordered-containers, utf8-string, vector
Files
- CHANGELOG.md +4/−0
- fay.cabal +7/−39
- src/Fay/Compiler/Decl.hs +2/−2
- src/Fay/Compiler/Exp.hs +25/−9
- tests/newtypeIndirectApp.hs +17/−0
- tests/newtypeIndirectApp.res +2/−0
CHANGELOG.md view
@@ -4,6 +4,10 @@ **Note: 0.18.0.1 added source mappings returend by `Fay:compileFile` and friends meaning it should have been a major bump. Sorry about this!** +### 0.18.1.2 (2013-11-26)++* Add support for indirect application of newtypes (such as `p = NewType; foo = p x` and `bar = NewType $ y`)+ ### 0.18.1.1 (2013-11-22) * Fix a bug where records with the same name as top level modules wouldn't be initialized correctly.
fay.cabal view
@@ -1,5 +1,5 @@ name: fay-version: 0.18.1.1+version: 0.18.1.2 synopsis: A compiler for Fay, a Haskell subset that compiles to JavaScript. description: Fay is a proper subset of Haskell which is type-checked with GHC, and compiled to JavaScript. It is lazy, pure, has a Fay monad,@@ -15,9 +15,9 @@ . /Release Notes/ .- See <https://github.com/faylang/fay/wiki/Changelog>+ See <https://github.com/faylang/fay/blob/master/CHANGELOG.md> .- See full history at: <https://github.com/faylang/fay/wiki/Changelog>+ See full history at: <https://github.com/faylang/fay/commits> homepage: http://fay-lang.org/ bug-reports: https://github.com/faylang/fay/issues license: BSD3@@ -107,7 +107,6 @@ ghc-options: -O2 -Wall -fno-warn-name-shadowing build-depends: base >= 4 && < 5 , Cabal < 1.19- , HUnit < 1.3 , aeson < 0.7 , attoparsec < 0.11 , bytestring < 0.11@@ -127,9 +126,6 @@ , safe < 0.4 , split < 0.3 , syb < 0.5- , test-framework < 0.9- , test-framework-hunit < 0.4- , test-framework-th < 0.3 , text < 0.12 , time < 1.5 , unordered-containers < 0.3@@ -144,24 +140,9 @@ main-is: Main.hs build-depends: base , fay- , Cabal- , aeson- , containers- , cpphs , data-default- , directory- , filepath- , ghc-paths- , haskeline < 0.8- , haskell-src-exts- , language-ecmascript- , mtl , optparse-applicative >= 0.6 && < 0.8- , process- , safe , split- , syb- , utf8-string executable fay-tests hs-source-dirs: src/tests@@ -174,29 +155,16 @@ Test.Util build-depends: base , fay- , Cabal- , HUnit+ , HUnit < 1.3 , aeson , attoparsec , bytestring- , containers- , cpphs , data-default , directory , filepath- , ghc-paths , haskell-src-exts- , language-ecmascript- , mtl- , pretty-show- , process- , safe- , split- , syb- , test-framework- , test-framework-hunit- , test-framework-th+ , test-framework < 0.9+ , test-framework-hunit < 0.4+ , test-framework-th < 0.3 , text- , unordered-containers , utf8-string- , vector
src/Fay/Compiler/Decl.hs view
@@ -44,9 +44,9 @@ compileDecl toplevel decl = case decl of pat@PatBind{} -> compilePatBind toplevel Nothing pat FunBind _ matches -> compileFunCase toplevel matches- DataDecl _ (DataType _ ) _ head' constructors _ -> compileDataDecl toplevel (mkTyVars head') constructors+ DataDecl _ (DataType _ ) _ (mkTyVars -> tyvars) constructors _ -> compileDataDecl toplevel tyvars constructors GDataDecl _ (DataType _) _l (mkTyVars -> tyvars) _n decls _ -> compileDataDecl toplevel tyvars (map convertGADT decls)- DataDecl _ (NewType _) _ _ _ _ -> return []+ DataDecl _ (NewType _) _ _ _ _ -> return [] -- Just ignore type aliases and signatures. TypeDecl {} -> return [] TypeSig {} -> return []
src/Fay/Compiler/Exp.hs view
@@ -71,11 +71,19 @@ -- | Compile variable. compileVar :: S.QName -> Compile JsExp-compileVar qname = case qname of- Special _ t@TupleCon{} -> shouldBeDesugared t- _ -> do- qname <- unsafeResolveName qname- return (JsName (JsNameVar qname))+compileVar (Special _ t@TupleCon{}) = shouldBeDesugared t+compileVar qname = do+ nc <- lookupNewtypeConst qname+ nd <- lookupNewtypeDest qname+ if (nc /= Nothing || nd /= Nothing)+ then -- variable is either a newtype constructor or newtype destructor,+ -- replace it with identity function+ return idFun+ else do+ qname <- unsafeResolveName qname+ return (JsName (JsNameVar qname))+ where+ idFun = JsFun Nothing [JsTmp 1] [] (Just (JsName $ JsTmp 1)) -- | Compile Haskell literal. compileLit :: S.Literal -> Compile JsExp@@ -138,10 +146,18 @@ -- | Compile an infix application, optimizing the JS cases. compileInfixApp :: S.Exp -> S.QOp -> S.Exp -> Compile JsExp-compileInfixApp exp1 ap exp2 = compileExp (App noI (App noI (Var noI op) exp1) exp2)- where op = getOp ap- getOp (QVarOp _ op) = op- getOp (QConOp _ op) = op+compileInfixApp exp1 ap exp2 = case exp1 of+ Con _ q -> do+ newtypeConst <- lookupNewtypeConst q+ case newtypeConst of+ Just _ -> compileExp exp2+ Nothing -> normalApp+ _ -> normalApp+ where+ normalApp = compileExp (App noI (App noI (Var noI op) exp1) exp2)+ op = getOp ap+ getOp (QVarOp _ op) = op+ getOp (QConOp _ op) = op -- | Compile a let expression. compileLet :: [S.Decl] -> S.Exp -> Compile JsExp
+ tests/newtypeIndirectApp.hs view
@@ -0,0 +1,17 @@+module Main where++import Prelude++newtype Parser a = Parser { runParser :: Char -> Either Char (a, Char) }++pure :: a -> Parser a+pure a = Parser $ \s -> Right (a, s)++p = Parser++pure' a = p (\s -> Right (a, s))++main :: Fay ()+main = do+ print $ runParser (pure 5) '0'+ print $ runParser (pure' 5) '0'
+ tests/newtypeIndirectApp.res view
@@ -0,0 +1,2 @@+{ instance: 'Right', slot1: [ 5, '0' ] }+{ instance: 'Right', slot1: [ 5, '0' ] }