git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Move type declarations desugaring into its own module
commit88779132d4207de208fbc5acdbb62a19a779a65d authorPhil Freeman <paf31@cantab.net> dateThu 26 Dec 2013, 16:16 (13 years ago) parentfe0c18b
5 files changed+64−10
compare with golang
unifiedsplit
purescript.cabal+6−5 src/Language/PureScript.hs+3−1 src/Language/PureScript/BindingGroups.hs+22 src/Language/PureScript/TypeChecker.hs+1−4 src/Language/PureScript/TypeDeclarations.hs+32
purescript.cabal+6−5
@@ -1,5 +1,5 @@
11name: purescript
2−version: 0.2.1.2
2+version: 0.2.2
33cabal-version: >=1.8
44build-type: Simple
55license: MIT
@@ -17,10 +17,11 @@ library
1717 build-depends: base >=4 && <5, cmdtheline -any, containers -any,
1818 directory -any, filepath -any, mtl -any, parsec -any, syb -any,
1919 transformers -any, utf8-string -any
20− exposed-modules: Language.PureScript.Scope Data.Generics.Extras
21− Language.PureScript Language.PureScript.CodeGen
22− Language.PureScript.CodeGen.Externs Language.PureScript.CodeGen.JS
23− Language.PureScript.CodeGen.JS.AST
20+ exposed-modules: Language.PureScript.TypeDeclarations
21+ Language.PureScript.BindingGroups Language.PureScript.Scope
22+ Data.Generics.Extras Language.PureScript
23+ Language.PureScript.CodeGen Language.PureScript.CodeGen.Externs
24+ Language.PureScript.CodeGen.JS Language.PureScript.CodeGen.JS.AST
2425 Language.PureScript.CodeGen.Monad Language.PureScript.Declarations
2526 Language.PureScript.Kinds Language.PureScript.Names
2627 Language.PureScript.Operators Language.PureScript.Optimize
src/Language/PureScript.hs+3−1
@@ -26,14 +26,16 @@ import Language.PureScript.Pretty as P
2626import Language.PureScript.Optimize as P
2727import Language.PureScript.Operators as P
2828import Language.PureScript.CaseDeclarations as P
29+import Language.PureScript.TypeDeclarations as P
2930
3031import Data.List (intercalate)
3132import Data.Maybe (mapMaybe)
33+import Control.Monad ((>=>))
3234
3335compile :: [Declaration] -> Either String (String, String, Environment)
3436compile decls = do
3537 bracketted <- rebracket decls
36− desugared <- desugarCases bracketted
38+ desugared <- desugarCases >=> desugarTypeDeclarations $ bracketted
3739 (_, env) <- runCheck (typeCheckAll desugared)
3840 let js = prettyPrintJS . map optimize . concat . mapMaybe (\decl -> declToJs Nothing global decl env) $ desugared
3941 let exts = intercalate "\n" . mapMaybe (externToPs 0 global env) $ desugared
src/Language/PureScript/BindingGroups.hsnew file+22
@@ -0,0 +1,22 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.BindingGroups
4+-- Copyright : (c) Phil Freeman 2013
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.PureScript.BindingGroups (
16+ bindingGroups
17+) where
18+
19+import Language.PureScript.Declarations
20+
21+bindingGroups :: [Declaration] -> [[Declaration]]
22+bindingGroups = undefined
src/Language/PureScript/TypeChecker.hs+1−4
@@ -27,7 +27,6 @@ import Language.PureScript.TypeChecker.Synonyms as T
2727import Data.Maybe
2828import qualified Data.Map as M
2929
30−import Language.PureScript.Values
3130import Language.PureScript.Types
3231import Language.PureScript.Names
3332import Language.PureScript.Kinds
@@ -63,9 +62,7 @@ typeCheckAll (TypeSynonymDeclaration name args ty : rest) = do
6362 putEnv $ env { types = M.insert (modulePath, name) (kind, TypeSynonym) (types env)
6463 , typeSynonyms = M.insert (modulePath, name) (args, ty) (typeSynonyms env) }
6564 typeCheckAll rest
66−typeCheckAll (TypeDeclaration name ty : ValueDeclaration name' [] Nothing val : rest) | name == name' =
67− typeCheckAll (ValueDeclaration name [] Nothing (TypedValue val ty) : rest)
68−typeCheckAll (TypeDeclaration name _ : _) = throwError $ "Orphan type declaration for " ++ show name
65+typeCheckAll (TypeDeclaration _ _ : _) = error "Type declarations should have been removed"
6966typeCheckAll (ValueDeclaration name [] Nothing val : rest) = do
7067 rethrow (("Error in declaration " ++ show name ++ ":\n") ++) $ do
7168 env <- getEnv
src/Language/PureScript/TypeDeclarations.hsnew file+32
@@ -0,0 +1,32 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.TypeDeclarations
4+-- Copyright : (c) Phil Freeman 2013
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.PureScript.TypeDeclarations (
16+ desugarTypeDeclarations
17+) where
18+
19+import Control.Applicative
20+import Control.Monad.Error.Class
21+
22+import Language.PureScript.Declarations
23+import Language.PureScript.Values
24+
25+desugarTypeDeclarations :: [Declaration] -> Either String [Declaration]
26+desugarTypeDeclarations (TypeDeclaration name ty : ValueDeclaration name' [] Nothing val : rest) | name == name' =
27+ desugarTypeDeclarations (ValueDeclaration name [] Nothing (TypedValue val ty) : rest)
28+desugarTypeDeclarations (TypeDeclaration name _ : _) = throwError $ "Orphan type declaration for " ++ show name
29+desugarTypeDeclarations (ModuleDeclaration name ds:ds') = (:) <$> (ModuleDeclaration name <$> desugarTypeDeclarations ds)
30+ <*> desugarTypeDeclarations ds'
31+desugarTypeDeclarations (d:ds) = (:) d <$> desugarTypeDeclarations ds
32+desugarTypeDeclarations [] = return []