fay 0.18.0.4 → 0.18.0.5
raw patch · 2 files changed
+58/−50 lines, 2 filesdep ~Cabaldep ~HUnitdep ~aeson
Dependency ranges changed: Cabal, HUnit, aeson, attoparsec, base, bytestring, containers, cpphs, data-default, directory, filepath, ghc-paths, haskeline, haskell-packages, haskell-src-exts, language-ecmascript, mtl, pretty-show, process, safe, sourcemap, split, syb, test-framework, test-framework-hunit, test-framework-th, text, time, unordered-containers, utf8-string, vector
Files
- fay.cabal +41/−41
- src/Fay/Compiler/Decl.hs +17/−9
fay.cabal view
@@ -1,5 +1,5 @@ name: fay-version: 0.18.0.4+version: 0.18.0.5 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,@@ -102,44 +102,44 @@ , Fay.Compiler.Typecheck , Paths_fay ghc-options: -O2 -Wall -fno-warn-name-shadowing- build-depends: base >= 4 && < 5- , Cabal- , HUnit- , aeson- , attoparsec- , bytestring- , containers- , cpphs- , data-default- , directory- , filepath- , ghc-paths- , haskell-names >= 0.3.1 && < 0.4- , haskell-packages >= 0.2.3.1- , haskell-src-exts >= 1.14- , language-ecmascript >= 0.15 && < 1.0- , mtl- , pretty-show >= 1.6- , process- , safe- , split- , syb- , test-framework- , test-framework-hunit- , test-framework-th- , text- , time- , unordered-containers- , utf8-string- , vector- , sourcemap+ build-depends: base >= 4 && < 5+ , Cabal < 1.19+ , HUnit < 1.3+ , aeson < 0.7+ , attoparsec < 0.11+ , bytestring < 0.11+ , containers < 0.6+ , cpphs < 1.19+ , data-default < 0.6+ , directory < 1.3+ , filepath < 1.4+ , ghc-paths < 0.2+ , haskell-names >= 0.3.1 && < 0.4+ , haskell-packages >= 0.2.3.1 && < 0.3+ , haskell-src-exts >= 1.14 && < 1.15+ , language-ecmascript >= 0.15 && < 1.0+ , mtl < 2.2+ , pretty-show >= 1.6 && < 1.7+ , process < 1.2+ , 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+ , utf8-string < 0.4+ , vector < 0.11+ , sourcemap < 0.2 executable fay hs-source-dirs: src/main ghc-options: -O2 -Wall ghc-prof-options: -fprof-auto main-is: Main.hs- build-depends: base >= 4 && < 5+ build-depends: base , fay , Cabal , aeson@@ -149,11 +149,11 @@ , directory , filepath , ghc-paths- , haskeline- , haskell-src-exts >= 1.14- , language-ecmascript >= 0.15 && < 1.0+ , haskeline < 0.8+ , haskell-src-exts+ , language-ecmascript , mtl- , optparse-applicative >= 0.6 && < 0.8+ , optparse-applicative >= 0.6 && < 0.8 , process , safe , split@@ -169,7 +169,7 @@ Test.Compile Test.Convert Test.Util- build-depends: base >= 4 && < 5+ build-depends: base , fay , Cabal , HUnit@@ -182,10 +182,10 @@ , directory , filepath , ghc-paths- , haskell-src-exts >= 1.14- , language-ecmascript >= 0.15 && < 1.0+ , haskell-src-exts+ , language-ecmascript , mtl- , pretty-show >= 1.6+ , pretty-show , process , safe , split
src/Fay/Compiler/Decl.hs view
@@ -74,22 +74,30 @@ -- | Compile a top-level pattern bind. compilePatBind :: Bool -> Maybe S.Type -> S.Decl -> Compile [JsStmt]-compilePatBind toplevel sig pat = case pat of+compilePatBind toplevel sig patDecl = case patDecl of PatBind srcloc (PVar _ ident) Nothing (UnGuardedRhs _ rhs) Nothing -> case ffiExp rhs of Just formatstr -> case sig of Just sig -> compileFFI ident formatstr sig- Nothing -> throwError (FfiNeedsTypeSig pat)+ Nothing -> throwError $ FfiNeedsTypeSig patDecl _ -> compileUnguardedRhs toplevel srcloc ident rhs+ -- TODO: Generalize to all patterns PatBind srcloc (PVar _ ident) Nothing (UnGuardedRhs _ rhs) (Just bdecls) -> compileUnguardedRhs toplevel srcloc ident (Let S.noI bdecls rhs)- PatBind _ pat Nothing (UnGuardedRhs _ rhs) _bdecls -> do- exp <- compileExp rhs- name <- withScopedTmpJsName return- [JsIf t b1 []] <- compilePat (JsName name) pat []- let err = [throw ("Irrefutable pattern failed for pattern: " ++ prettyPrint pat) (JsList [])]- return [JsVar name exp, JsIf t b1 err]- _ -> throwError (UnsupportedDeclaration pat)+ PatBind _ pat Nothing (UnGuardedRhs _ rhs) _bdecls -> case pat of+ PList {} -> compilePatBind' pat rhs+ PTuple{} -> compilePatBind' pat rhs+ PApp {} -> compilePatBind' pat rhs+ _ -> throwError $ UnsupportedDeclaration patDecl+ _ -> throwError $ UnsupportedDeclaration patDecl+ where+ compilePatBind' :: S.Pat -> S.Exp -> Compile [JsStmt]+ compilePatBind' pat rhs = do+ exp <- compileExp rhs+ name <- withScopedTmpJsName return+ [JsIf t b1 []] <- compilePat (JsName name) pat []+ let err = [throw ("Irrefutable pattern failed for pattern: " ++ prettyPrint pat) (JsList [])]+ return [JsVar name exp, JsIf t b1 err] -- | Compile a normal simple pattern binding. compileUnguardedRhs :: Bool -> S.X -> S.Name -> S.Exp -> Compile [JsStmt]