purescript 0.4.18 → 0.4.18.1

raw patch · 24 files changed

+354/−109 lines, 24 filesdep +unordered-containersdep ~cmdthelinedep ~monad-unifyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: unordered-containers

Dependency ranges changed: cmdtheline, monad-unify

API changes (from Hackage documentation)

Files

• purescript.cabal +5/−5
• src/Language/PureScript.hs +1/−2
• src/Language/PureScript/CodeGen/JS.hs +1/−1
• src/Language/PureScript/CodeGen/JS/AST.hs +82/−0
• src/Language/PureScript/Declarations.hs +69/−6
• src/Language/PureScript/Kinds.hs +14/−0
• src/Language/PureScript/Optimizer/Blocks.hs +1/−3
• src/Language/PureScript/Optimizer/Common.hs +12/−13
• src/Language/PureScript/Optimizer/Inliner.hs +11/−13
• src/Language/PureScript/Optimizer/MagicDo.hs +6/−7
• src/Language/PureScript/Optimizer/TCO.hs +6/−8
• src/Language/PureScript/Optimizer/Unused.hs +3/−5
• src/Language/PureScript/Pretty/Kinds.hs +1/−2
• src/Language/PureScript/Pretty/Types.hs +3/−4
• src/Language/PureScript/Sugar.hs +1/−1
• src/Language/PureScript/Sugar/BindingGroups.hs +1/−1
• src/Language/PureScript/Sugar/CaseDeclarations.hs +4/−2
• src/Language/PureScript/Sugar/Names.hs +1/−1
• src/Language/PureScript/Sugar/Operators.hs +5/−2
• src/Language/PureScript/TypeChecker/Kinds.hs +12/−0
• src/Language/PureScript/TypeChecker/Synonyms.hs +3/−7
• src/Language/PureScript/TypeChecker/Types.hs +35/−23
• src/Language/PureScript/Types.hs +77/−2
• tests/Main.hs +0/−1

@@ -1,5 +1,5 @@ name: purescript-version: 0.4.18+version: 0.4.18.1 cabal-version: >=1.8 build-type: Custom license: MIT@@ -18,11 +18,11 @@ data-dir: ""  library-    build-depends: base >=4 && <5, cmdtheline -any, containers -any,+    build-depends: base >=4 && <5, cmdtheline -any, containers -any, unordered-containers -any,                    directory >= 1.2, filepath -any, mtl -any, parsec -any, syb >= 0.4.1 && < 0.5,-                   transformers -any, utf8-string -any, -                   pattern-arrows >= 0.0.2 && < 0.1, -                   monad-unify >= 0.2.1 && < 0.3,+                   transformers -any, utf8-string -any,+                   pattern-arrows >= 0.0.2 && < 0.1,+                   monad-unify >= 0.2.2 && < 0.3,                    xdg-basedir -any, time -any     if (!os(windows))         build-depends: unix -any

@@ -36,7 +36,6 @@ import Data.List (find, sortBy, groupBy, intercalate) import Data.Time.Clock import Data.Function (on)-import Data.Generics (mkQ, everything) import Data.Maybe (fromJust, fromMaybe) import Control.Monad.Error import Control.Monad.State.Lazy@@ -109,7 +108,7 @@    -- Find the type constructors exported from the current module used in a type   findTcons :: Type -> [ProperName]-  findTcons = everything (++) (mkQ [] go)+  findTcons = everythingOnTypes (++) go     where     go (TypeConstructor (Qualified (Just mn') name)) | mn' == mn = [name]     go _ = []

@@ -249,7 +249,7 @@ bindersToJs :: Options -> ModuleName -> Environment -> [CaseAlternative] -> [JS] -> JS bindersToJs opts m e binders vals = runGen (map identToJs (unusedNames (binders, vals))) $ do   valNames <- replicateM (length vals) fresh-  jss <- forM binders $ \(CaseAlternative bs grd result) -> go valNames [JSReturn (valueToJs opts m (bindNames m (binderNames bs) e) result)] bs grd+  jss <- forM binders $ \(CaseAlternative bs grd result) -> go valNames [JSReturn (valueToJs opts m (bindNames m (concatMap binderNames bs) e) result)] bs grd   return $ JSApp (JSFunction Nothing valNames (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))                  vals   where

@@ -233,3 +233,85 @@   -- Raw Javascript (generated when parsing fails for an inline foreign import declaration)   --   | JSRaw String deriving (Show, Eq, Data, Typeable)++--+-- Traversals+--++everywhereOnJS :: (JS -> JS) -> JS -> JS+everywhereOnJS f = go+  where+  go :: JS -> JS+  go (JSUnary op j) = f (JSUnary op (go j))+  go (JSBinary op j1 j2) = f (JSBinary op (go j1) (go j2))+  go (JSArrayLiteral js) = f (JSArrayLiteral (map go js))+  go (JSIndexer j1 j2) = f (JSIndexer (go j1) (go j2))+  go (JSObjectLiteral js) = f (JSObjectLiteral (map (fmap go) js))+  go (JSAccessor prop j) = f (JSAccessor prop (go j))+  go (JSFunction name args j) = f (JSFunction name args (go j))+  go (JSApp j js) = f (JSApp (go j) (map go js))+  go (JSConditional j1 j2 j3) = f (JSConditional (go j1) (go j2) (go j3))+  go (JSBlock js) = f (JSBlock (map go js))+  go (JSVariableIntroduction name j) = f (JSVariableIntroduction name (fmap go j))+  go (JSAssignment j1 j2) = f (JSAssignment (go j1) (go j2))+  go (JSWhile j1 j2) = f (JSWhile (go j1) (go j2))+  go (JSFor name j1 j2 j3) = f (JSFor name (go j1) (go j2) (go j3))+  go (JSForIn name j1 j2) = f (JSForIn name (go j1) (go j2))+  go (JSIfElse j1 j2 j3) = f (JSIfElse (go j1) (go j2) (fmap go j3))+  go (JSReturn js) = f (JSReturn (go js))+  go (JSThrow js) = f (JSThrow (go js))+  go (JSTypeOf js) = f (JSTypeOf (go js))+  go (JSLabel name js) = f (JSLabel name (go js))+  go other = f other++everywhereOnJSTopDown :: (JS -> JS) -> JS -> JS+everywhereOnJSTopDown f = go . f+  where+  go :: JS -> JS+  go (JSUnary op j) = JSUnary op (go (f j))+  go (JSBinary op j1 j2) = JSBinary op (go (f j1)) (go (f j2))+  go (JSArrayLiteral js) = JSArrayLiteral (map (go . f) js)+  go (JSIndexer j1 j2) = JSIndexer (go (f j1)) (go (f j2))+  go (JSObjectLiteral js) = JSObjectLiteral (map (fmap (go . f)) js)+  go (JSAccessor prop j) = JSAccessor prop (go (f j))+  go (JSFunction name args j) = JSFunction name args (go (f j))+  go (JSApp j js) = JSApp (go (f j)) (map (go . f) js)+  go (JSConditional j1 j2 j3) = JSConditional (go (f j1)) (go (f j2)) (go (f j3))+  go (JSBlock js) = JSBlock (map (go . f) js)+  go (JSVariableIntroduction name j) = JSVariableIntroduction name (fmap (go . f) j)+  go (JSAssignment j1 j2) = JSAssignment (go (f j1)) (go (f j2))+  go (JSWhile j1 j2) = JSWhile (go (f j1)) (go (f j2))+  go (JSFor name j1 j2 j3) = JSFor name (go (f j1)) (go (f j2)) (go (f j3))+  go (JSForIn name j1 j2) = JSForIn name (go (f j1)) (go (f j2))+  go (JSIfElse j1 j2 j3) = JSIfElse (go (f j1)) (go (f j2)) (fmap (go . f) j3)+  go (JSReturn j) = JSReturn (go (f j))+  go (JSThrow j) = JSThrow (go (f j))+  go (JSTypeOf j) = JSTypeOf (go (f j))+  go (JSLabel name j) = JSLabel name (go (f j))+  go other = f other++everythingOnJS :: (r -> r -> r) -> (JS -> r) -> JS -> r+everythingOnJS (<>) f = go+  where+  go j@(JSUnary _ j1) = f j <> go j1+  go j@(JSBinary _ j1 j2) = f j <> go j1 <> go j2+  go j@(JSArrayLiteral js) = foldl (<>) (f j) (map go js)+  go j@(JSIndexer j1 j2) = f j <> go j1 <> go j2+  go j@(JSObjectLiteral js) = foldl (<>) (f j) (map (go . snd) js)+  go j@(JSAccessor _ j1) = f j <> go j1+  go j@(JSFunction _ _ j1) = f j <> go j1+  go j@(JSApp j1 js) = foldl (<>) (f j <> go j1) (map go js)+  go j@(JSConditional j1 j2 j3) = f j <> go j1 <> go j2 <> go j3+  go j@(JSBlock js) = foldl (<>) (f j) (map go js)+  go j@(JSVariableIntroduction _ (Just j1)) = f j <> go j1+  go j@(JSAssignment j1 j2) = f j <> go j1 <> go j2+  go j@(JSWhile j1 j2) = f j <> go j1 <> go j2+  go j@(JSFor _ j1 j2 j3) = f j <> go j1 <> go j2 <> go j3+  go j@(JSForIn _ j1 j2) = f j <> go j1 <> go j2+  go j@(JSIfElse j1 j2 Nothing) = f j <> go j1 <> go j2+  go j@(JSIfElse j1 j2 (Just j3)) = f j <> go j1 <> go j2 <> go j3+  go j@(JSReturn j1) = f j <> go j1+  go j@(JSThrow j1) = f j <> go j1+  go j@(JSTypeOf j1) = f j <> go j1+  go j@(JSLabel _ j1) = f j <> go j1+  go other = f other

@@ -24,7 +24,6 @@ import Language.PureScript.Environment  import qualified Data.Data as D-import Data.Generics (mkQ, everything)  -- | -- A precedence level for an infix operator@@ -441,9 +440,73 @@ -- | -- Collect all names introduced in binders in an expression ---binderNames :: (D.Data d) => d -> [Ident]-binderNames = everything (++) (mkQ [] go)+binderNames :: Binder -> [Ident]+binderNames = go []   where-  go (VarBinder ident) = [ident]-  go (NamedBinder ident _) = [ident]-  go _ = []+  go ns (VarBinder name) = name : ns+  go ns (ConstructorBinder _ bs) = foldl go ns bs+  go ns (ObjectBinder bs) = foldl go ns (map snd bs)+  go ns (ArrayBinder bs) = foldl go ns bs+  go ns (ConsBinder b1 b2) = go (go ns b1) b2+  go ns (NamedBinder name b) = go (name : ns) b+  go ns (PositionedBinder _ b) = go ns b+  go ns _ = ns++--+-- Traversals+--++everywhereOnValues :: (Declaration -> Declaration) ->+                      (Value -> Value) ->+                      (Binder -> Binder) ->+                      (Declaration -> Declaration, Value -> Value, Binder -> Binder)+everywhereOnValues f g h = (f', g', h')+  where+  f' :: Declaration -> Declaration+  f' (DataBindingGroupDeclaration ds) = f (DataBindingGroupDeclaration (map f' ds))+  f' (ValueDeclaration name nameKind bs grd val) = f (ValueDeclaration name nameKind (map h' bs) (fmap g' grd) (g' val))+  f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (map (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))+  f' (TypeClassDeclaration name args implies ds) = f (TypeClassDeclaration name args implies (map f' ds))+  f' (TypeInstanceDeclaration name cs className args ds) = f (TypeInstanceDeclaration name cs className args (map f' ds))+  f' (PositionedDeclaration pos d) = f (PositionedDeclaration pos (f' d))+  f' other = f other++  g' :: Value -> Value+  g' (UnaryMinus v) = g (UnaryMinus (g' v))+  g' (BinaryNoParens op v1 v2) = g (BinaryNoParens op (g' v1) (g' v2))+  g' (Parens v) = g (Parens (g' v))+  g' (ArrayLiteral vs) = g (ArrayLiteral (map g' vs))+  g' (ObjectLiteral vs) = g (ObjectLiteral (map (fmap g') vs))+  g' (Accessor prop v) = g (Accessor prop (g' v))+  g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))+  g' (Abs name v) = g (Abs name (g' v))+  g' (App v1 v2) = g (App (g' v1) (g' v2))+  g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3))+  g' (Case vs alts) = g (Case (map g' vs) (map handleCaseAlternative alts))+  g' (TypedValue check v ty) = g (TypedValue check (g' v) ty)+  g' (Let ds v) = g (Let (map f' ds) (g' v))+  g' (Do es) = g (Do (map handleDoNotationElement es))+  g' (PositionedValue pos v) = g (PositionedValue pos (g' v))+  g' other = g other++  h' :: Binder -> Binder+  h' (ConstructorBinder ctor bs) = h (ConstructorBinder ctor (map h' bs))+  h' (ObjectBinder bs) = h (ObjectBinder (map (fmap h') bs))+  h' (ArrayBinder bs) = h (ArrayBinder (map h' bs))+  h' (ConsBinder b1 b2) = h (ConsBinder (h' b1) (h' b2))+  h' (NamedBinder name b) = h (NamedBinder name (h' b))+  h' (PositionedBinder pos b) = h (PositionedBinder pos (h' b))+  h' other = h other++  handleCaseAlternative :: CaseAlternative -> CaseAlternative+  handleCaseAlternative ca =+    ca { caseAlternativeBinders = map h' (caseAlternativeBinders ca)+       , caseAlternativeGuard = fmap g' (caseAlternativeGuard ca)+       , caseAlternativeResult = g' (caseAlternativeResult ca)+       }++  handleDoNotationElement :: DoNotationElement -> DoNotationElement+  handleDoNotationElement (DoNotationValue v) = DoNotationValue (g' v)+  handleDoNotationElement (DoNotationBind b v) = DoNotationBind (h' b) (g' v)+  handleDoNotationElement (DoNotationLet ds) = DoNotationLet (map f' ds)+  handleDoNotationElement (PositionedDoNotationElement pos e) = PositionedDoNotationElement pos (handleDoNotationElement e)

@@ -44,3 +44,17 @@   -- Function kinds   --   | FunKind Kind Kind deriving (Show, Eq, Data, Typeable)++everywhereOnKinds :: (Kind -> Kind) -> Kind -> Kind+everywhereOnKinds f = go+  where+  go (Row k1) = f (Row (go k1))+  go (FunKind k1 k2) = f (FunKind (go k1) (go k2))+  go other = f other++everythingOnKinds :: (r -> r -> r) -> (Kind -> r) -> Kind -> r+everythingOnKinds (<>) f = go+  where+  go k@(Row k1) = f k <> go k1+  go k@(FunKind k1 k2) = f k <> go k1 <> go k2+  go other = f other

@@ -17,15 +17,13 @@   collapseNestedBlocks ) where -import Data.Generics- import Language.PureScript.CodeGen.JS.AST  -- | -- Collapse blocks which appear nested directly below another block -- collapseNestedBlocks :: JS -> JS-collapseNestedBlocks = everywhere (mkT collapse)+collapseNestedBlocks = everywhereOnJS collapse   where   collapse :: JS -> JS   collapse (JSBlock sts) = JSBlock (concatMap go sts)

@@ -16,27 +16,26 @@ module Language.PureScript.Optimizer.Common where  import Data.Maybe (fromMaybe)-import Data.Generics  import Language.PureScript.CodeGen.JS.AST  applyAll :: [a -> a] -> a -> a applyAll = foldl1 (.) -replaceIdent :: (Data d) => String -> JS -> d -> d-replaceIdent var1 js = everywhere (mkT replace)+replaceIdent :: String -> JS -> JS -> JS+replaceIdent var1 js = everywhereOnJS replace   where   replace (JSVar var2) | var1 == var2 = js   replace other = other -replaceIdents :: (Data d) => [(String, JS)] -> d -> d-replaceIdents vars = everywhere (mkT replace)+replaceIdents :: [(String, JS)] -> JS -> JS+replaceIdents vars = everywhereOnJS replace   where   replace v@(JSVar var) = fromMaybe v $ lookup var vars   replace other = other -isReassigned :: (Data d) => String -> d -> Bool-isReassigned var1 = everything (||) (mkQ False check)+isReassigned :: String -> JS -> Bool+isReassigned var1 = everythingOnJS (||) check   where   check :: JS -> Bool   check (JSFunction _ args _) | var1 `elem` args = True@@ -46,14 +45,14 @@   check (JSForIn arg _ _) | var1 == arg = True   check _ = False -isRebound :: (Data d) => JS -> d -> Bool-isRebound js d = any (\v -> isReassigned v d || isUpdated v d) (everything (++) (mkQ [] variablesOf) js)+isRebound :: JS -> JS -> Bool+isRebound js d = any (\v -> isReassigned v d || isUpdated v d) (everythingOnJS (++) variablesOf js)   where   variablesOf (JSVar var) = [var]   variablesOf _ = [] -isUsed :: (Data d) => String -> d -> Bool-isUsed var1 = everything (||) (mkQ False check)+isUsed :: String -> JS -> Bool+isUsed var1 = everythingOnJS (||) check   where   check :: JS -> Bool   check (JSVar var2) | var1 == var2 = True@@ -66,8 +65,8 @@ targetVariable (JSIndexer _ tgt) = targetVariable tgt targetVariable _ = error "Invalid argument to targetVariable" -isUpdated :: (Data d) => String -> d -> Bool-isUpdated var1 = everything (||) (mkQ False check)+isUpdated :: String -> JS -> Bool+isUpdated var1 = everythingOnJS (||) check   where   check :: JS -> Bool   check (JSAssignment target _) | var1 == targetVariable target = True

@@ -22,8 +22,6 @@   evaluateIifes ) where -import Data.Generics- import Language.PureScript.CodeGen.JS.AST import Language.PureScript.CodeGen.Common (identToJs) import Language.PureScript.Optimizer.Common@@ -41,42 +39,42 @@ shouldInline _ = False  etaConvert :: JS -> JS-etaConvert = everywhere (mkT convert)+etaConvert = everywhereOnJS convert   where   convert :: JS -> JS   convert (JSBlock [JSReturn (JSApp (JSFunction Nothing idents block@(JSBlock body)) args)])     | all shouldInline args &&       not (any (`isRebound` block) (map JSVar idents)) &&       not (any (`isRebound` block) args)-      = JSBlock (replaceIdents (zip idents args) body)+      = JSBlock (map (replaceIdents (zip idents args)) body)   convert js = js  unThunk :: JS -> JS-unThunk = everywhere (mkT convert)+unThunk = everywhereOnJS convert   where   convert :: JS -> JS   convert (JSBlock [JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) [])]) = JSBlock body   convert js = js  evaluateIifes :: JS -> JS-evaluateIifes = everywhere (mkT convert)+evaluateIifes = everywhereOnJS convert   where   convert :: JS -> JS   convert (JSApp (JSFunction Nothing [] (JSBlock [JSReturn ret])) []) = ret   convert js = js  inlineVariables :: JS -> JS-inlineVariables = everywhere (mkT $ removeFromBlock go)+inlineVariables = everywhereOnJS $ removeFromBlock go   where   go :: [JS] -> [JS]   go [] = []   go (JSVariableIntroduction var (Just js) : sts)-    | shouldInline js && not (isReassigned var sts) && not (isRebound js sts) && not (isUpdated var sts) =-      go (replaceIdent var js sts)+    | shouldInline js && not (any (isReassigned var) sts) && not (any (isRebound js) sts) && not (any (isUpdated var) sts) =+      go (map (replaceIdent var js) sts)   go (s:sts) = s : go sts  inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS-inlineOperator (m, op) f = everywhere (mkT convert)+inlineOperator (m, op) f = everywhereOnJS convert   where   convert :: JS -> JS   convert (JSApp (JSApp op' [x]) [y]) | isOp op' = f x y@@ -122,7 +120,7 @@   ]   where   binary :: String -> String -> BinaryOperator -> JS -> JS-  binary dictName opString op = everywhere (mkT convert)+  binary dictName opString op = everywhereOnJS convert     where     convert :: JS -> JS     convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y@@ -131,7 +129,7 @@     isOp (JSIndexer (JSStringLiteral op') (JSVar prelude)) = prelude == C.prelude && opString == op'     isOp _ = False   binaryFunction :: String -> String -> BinaryOperator -> JS -> JS-  binaryFunction dictName fnName op = everywhere (mkT convert)+  binaryFunction dictName fnName op = everywhereOnJS convert     where     convert :: JS -> JS     convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y@@ -139,7 +137,7 @@     isOp (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName == fnName'     isOp _ = False   unary :: String -> String -> UnaryOperator -> JS -> JS-  unary dictName fnName op = everywhere (mkT convert)+  unary dictName fnName op = everywhereOnJS convert     where     convert :: JS -> JS     convert (JSApp (JSApp fn [dict]) [x]) | isOp fn && isOpDict dictName dict = JSUnary op x

@@ -20,7 +20,6 @@  import Data.List (nub) import Data.Maybe (fromJust, isJust)-import Data.Generics  import Language.PureScript.Options import Language.PureScript.CodeGen.JS.AST@@ -50,7 +49,7 @@ --  } -- magicDo' :: JS -> JS-magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)+magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert   where   -- The name of the function block which is added to denote a do block   fnName = "__do"@@ -106,7 +105,7 @@ -- Inline functions in the ST module -- inlineST :: JS -> JS-inlineST = everywhere (mkT convertBlock)+inlineST = everywhereOnJS convertBlock   where   -- Look for runST blocks and inline the STRefs there.   -- If all STRefs are used in the scope of the same runST, only using { read, write, modify }STRef then@@ -116,7 +115,7 @@         usages = findAllSTUsagesIn arg         allUsagesAreLocalVars = all (\u -> let v = toVar u in isJust v && fromJust v `elem` refs) usages         localVarsDoNotEscape = all (\r -> length (r `appearingIn` arg) == length (filter (\u -> let v = toVar u in v == Just r) usages)) refs-    in everywhere (mkT $ convert (allUsagesAreLocalVars && localVarsDoNotEscape)) arg+    in everywhereOnJS (convert (allUsagesAreLocalVars && localVarsDoNotEscape)) arg   convertBlock other = other   -- Convert a block in a safe way, preserving object wrappers of references,   -- or in a more aggressive way, turning wrappers into local variables depending on the@@ -138,18 +137,18 @@   isSTFunc name (JSAccessor name' (JSVar st)) = st == C.st && name == name'   isSTFunc _ _ = False   -- Find all ST Refs initialized in this block-  findSTRefsIn = everything (++) (mkQ [] isSTRef)+  findSTRefsIn = everythingOnJS (++) isSTRef     where     isSTRef (JSVariableIntroduction ident (Just (JSApp (JSApp f [_]) []))) | isSTFunc C.newSTRef f = [ident]     isSTRef _ = []   -- Find all STRefs used as arguments to readSTRef, writeSTRef, modifySTRef-  findAllSTUsagesIn = everything (++) (mkQ [] isSTUsage)+  findAllSTUsagesIn = everythingOnJS (++) isSTUsage     where     isSTUsage (JSApp (JSApp f [ref]) []) | isSTFunc C.readSTRef f = [ref]     isSTUsage (JSApp (JSApp (JSApp f [ref]) [_]) []) | isSTFunc C.writeSTRef f || isSTFunc C.modifySTRef f = [ref]     isSTUsage _ = []   -- Find all uses of a variable-  appearingIn ref = everything (++) (mkQ [] isVar)+  appearingIn ref = everythingOnJS (++) isVar     where     isVar e@(JSVar v) | v == ref = [e]     isVar _ = []

@@ -15,8 +15,6 @@  module Language.PureScript.Optimizer.TCO (tco) where -import Data.Generics- import Language.PureScript.Options import Language.PureScript.CodeGen.JS.AST @@ -28,7 +26,7 @@          | otherwise = tco'  tco' :: JS -> JS-tco' = everywhere (mkT convert)+tco' = everywhereOnJS convert   where   tcoLabel :: String   tcoLabel = "tco"@@ -61,9 +59,9 @@   isTailCall :: String -> JS -> Bool   isTailCall ident js =     let-      numSelfCalls = everything (+) (mkQ 0 countSelfCalls) js-      numSelfCallsInTailPosition = everything (+) (mkQ 0 countSelfCallsInTailPosition) js-      numSelfCallsUnderFunctions = everything (+) (mkQ 0 countSelfCallsUnderFunctions) js+      numSelfCalls = everythingOnJS (+) countSelfCalls js+      numSelfCallsInTailPosition = everythingOnJS (+) countSelfCallsInTailPosition js+      numSelfCallsUnderFunctions = everythingOnJS (+) countSelfCallsUnderFunctions js     in       numSelfCalls > 0       && numSelfCalls == numSelfCallsInTailPosition@@ -75,12 +73,12 @@     countSelfCallsInTailPosition :: JS -> Int     countSelfCallsInTailPosition (JSReturn ret) | isSelfCall ident ret = 1     countSelfCallsInTailPosition _ = 0-    countSelfCallsUnderFunctions (JSFunction _ _ js') = everything (+) (mkQ 0 countSelfCalls) js'+    countSelfCallsUnderFunctions (JSFunction _ _ js') = everythingOnJS (+) countSelfCalls js'     countSelfCallsUnderFunctions _ = 0   toLoop :: String -> [String] -> JS -> JS   toLoop ident allArgs js = JSBlock $         map (\arg -> JSVariableIntroduction arg (Just (JSVar (copyVar arg)))) allArgs ++-        [ JSLabel tcoLabel $ JSWhile (JSBooleanLiteral True) (JSBlock [ everywhere (mkT loopify) js ]) ]+        [ JSLabel tcoLabel $ JSWhile (JSBooleanLiteral True) (JSBlock [ everywhereOnJS loopify js ]) ]     where     loopify :: JS -> JS     loopify (JSReturn ret) | isSelfCall ident ret =

@@ -18,23 +18,21 @@   removeCodeAfterReturnStatements ) where -import Data.Generics- import Language.PureScript.CodeGen.JS.AST import Language.PureScript.Optimizer.Common  removeUnusedVariables :: JS -> JS-removeUnusedVariables = everywhere (mkT $ removeFromBlock withBlock)+removeUnusedVariables = everywhereOnJS (removeFromBlock withBlock)   where   withBlock :: [JS] -> [JS]   withBlock sts = go sts sts   go :: [JS] -> [JS] -> [JS]   go _ [] = []-  go sts (JSVariableIntroduction var _ : rest) | not (isUsed var sts) = go sts rest+  go sts (JSVariableIntroduction var _ : rest) | not (any (isUsed var) sts) = go sts rest   go sts (s : rest) = s : go sts rest  removeCodeAfterReturnStatements :: JS -> JS-removeCodeAfterReturnStatements = everywhere (mkT $ removeFromBlock go)+removeCodeAfterReturnStatements = everywhereOnJS (removeFromBlock go)   where   go :: [JS] -> [JS]   go jss | not (any isJSReturn jss) = jss

@@ -21,7 +21,6 @@  import Control.Arrow (ArrowPlus(..)) import Control.PatternArrows-import Control.Monad.Unify  import Language.PureScript.Kinds import Language.PureScript.Pretty.Common@@ -31,7 +30,7 @@   where   match Star = Just "*"   match Bang = Just "!"-  match (KUnknown (Unknown u)) = Just $ 'u' : show u+  match (KUnknown u) = Just $ 'u' : show u   match _ = Nothing  matchRow :: Pattern () Kind ((), Kind)

@@ -21,11 +21,9 @@  import Data.Maybe (fromMaybe) import Data.List (intercalate)-import Data.Generics (mkT, everywhere, everywhere')  import Control.Arrow ((<+>)) import Control.PatternArrows-import Control.Monad.Unify  import Language.PureScript.Types import Language.PureScript.Pretty.Common@@ -38,7 +36,7 @@   match (PrettyPrintObject row) = Just $ "{ " ++ prettyPrintRow row ++ " }"   match (PrettyPrintArray ty) = Just $ "[" ++ prettyPrintType ty ++ "]"   match (TypeConstructor ctor) = Just $ show ctor-  match (TUnknown (Unknown u)) = Just $ 'u' : show u+  match (TUnknown u) = Just $ 'u' : show u   match (Skolem name s _) = Just $ name ++ show s   match (ConstrainedType deps ty) = Just $ "(" ++ intercalate ", " (map (\(pn, ty') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom ty')) deps) ++ ") => " ++ prettyPrintType ty   match (SaturatedTypeSynonym name args) = Just $ show name ++ "<" ++ intercalate "," (map prettyPrintTypeAtom args) ++ ">"@@ -74,7 +72,7 @@   match _ = Nothing  insertPlaceholders :: Type -> Type-insertPlaceholders = everywhere' (mkT convertForAlls) . everywhere (mkT convert)+insertPlaceholders = everywhereOnTypesTopDown convertForAlls . everywhereOnTypes convert   where   convert (TypeApp (TypeApp f arg) ret) | f == tyFunction = PrettyPrintFunction arg ret   convert (TypeApp a el) | a == tyArray = PrettyPrintArray el@@ -118,3 +116,4 @@ -- prettyPrintType :: Type -> String prettyPrintType = fromMaybe (error "Incomplete pattern") . pattern matchType () . insertPlaceholders+

@@ -48,7 +48,7 @@ --  * Qualify any unqualified names and types -- desugar :: [Module] -> Either ErrorStack [Module]-desugar = removeSignedLiterals+desugar = map removeSignedLiterals           >>> desugarDo           >=> desugarCasesModule           >=> desugarTypeDeclarationsModule

@@ -79,7 +79,7 @@ -- Collapse all binding groups to individual declarations -- collapseBindingGroups :: [Declaration] -> [Declaration]-collapseBindingGroups = everywhere (mkT collapseBindingGroupsForValue) . concatMap go+collapseBindingGroups = let (f, _, _) = everywhereOnValues id collapseBindingGroupsForValue id in map f . concatMap go   where   go (DataBindingGroupDeclaration ds) = ds   go (BindingGroupDeclaration ds) = map (\(ident, nameKind, val) -> ValueDeclaration ident nameKind [] Nothing val) ds

@@ -21,7 +21,7 @@  import Data.Monoid ((<>)) import Data.List (groupBy)-import Data.Generics (mkM, mkT, everywhere)+import Data.Generics (mkM) import Data.Generics.Extras  import Control.Applicative@@ -43,8 +43,10 @@     Module name <$> (desugarCases . desugarAbs $ ds) <*> pure exps  desugarAbs :: [Declaration] -> [Declaration]-desugarAbs = everywhere (mkT replace)+desugarAbs = map f   where+  (f, _, _) = everywhereOnValues id replace id+   replace (Abs (Right binder) val) =     let       ident = head $ unusedNames (binder, val)

@@ -215,7 +215,7 @@     bindFunctionArgs pb other = return (pb, other)      bindBinders :: (Maybe SourcePos, [Ident]) -> CaseAlternative -> Either ErrorStack ((Maybe SourcePos, [Ident]), CaseAlternative)-    bindBinders (pos, bound) c@(CaseAlternative bs _ _) = return ((pos, binderNames bs ++ bound), c)+    bindBinders (pos, bound) c@(CaseAlternative bs _ _) = return ((pos, concatMap binderNames bs ++ bound), c)      letBoundVariable :: Declaration -> Maybe Ident     letBoundVariable (ValueDeclaration ident _ _ _ _) = Just ident

@@ -57,9 +57,12 @@   let opTable = customOperatorTable $ map (\(i, _, f) -> (i, f)) fixities   mapM (rebracketModule opTable) ms -removeSignedLiterals :: (D.Data d) => d -> d-removeSignedLiterals = G.everywhere (G.mkT go)++removeSignedLiterals :: Module -> Module+removeSignedLiterals (Module mn ds exts) = Module mn (map f' ds) exts   where+  (f', _, _) = everywhereOnValues id go id+   go (UnaryMinus (NumericLiteral (Left n))) = NumericLiteral (Left $ negate n)   go (UnaryMinus (NumericLiteral (Right n))) = NumericLiteral (Right $ negate n)   go (UnaryMinus val) = App (Var (Qualified (Just (ModuleName [ProperName C.prelude])) (Ident C.negate))) val

@@ -37,12 +37,23 @@ import Control.Applicative  import qualified Data.Map as M+import qualified Data.HashMap.Strict as H import Data.Monoid ((<>))  instance Partial Kind where   unknown = KUnknown   isUnknown (KUnknown u) = Just u   isUnknown _ = Nothing+  unknowns = everythingOnKinds (++) go+    where+    go (KUnknown u) = [u]+    go _ = []+  ($?) sub = everywhereOnKinds go+    where+    go t@(KUnknown u) = case H.lookup u (runSubstitution sub) of+                          Nothing -> t+                          Just t' -> t'+    go other = other  instance Unifiable Check Kind where   KUnknown u1 =?= KUnknown u2 | u1 == u2 = return ()@@ -169,5 +180,6 @@   k =?= Star   return Star infer' _ = error "Invalid argument to infer"+  

@@ -14,7 +14,6 @@ -----------------------------------------------------------------------------  module Language.PureScript.TypeChecker.Synonyms (-    saturateTypeSynonym,     saturateAllTypeSynonyms ) where @@ -23,9 +22,6 @@  import Control.Applicative ((<$>)) import Data.Maybe (fromMaybe)-import Data.Data-import Data.Generics-import Data.Generics.Extras import Control.Monad.Writer import Control.Monad.Error @@ -44,15 +40,15 @@ -- | -- Replace all instances of a specific type synonym with the @SaturatedTypeSynonym@ data constructor ---saturateTypeSynonym :: (Data d) => Qualified ProperName -> Int -> d -> Either String d-saturateTypeSynonym name n = everywhereM' (mkM replace)+saturateTypeSynonym :: Qualified ProperName -> Int -> Type -> Either String Type+saturateTypeSynonym name n = everywhereOnTypesTopDownM replace   where   replace t = fromMaybe t <$> buildTypeSubstitution name n t  -- | -- Replace all type synonyms with the @SaturatedTypeSynonym@ data constructor ---saturateAllTypeSynonyms :: (Data d) => [(Qualified ProperName, Int)] -> d -> Either String d+saturateAllTypeSynonyms :: [(Qualified ProperName, Int)] -> Type -> Either String Type saturateAllTypeSynonyms syns d = foldM (\result (name, n) -> saturateTypeSynonym name n result) d syns  

@@ -43,10 +43,8 @@  import Data.List import Data.Maybe (maybeToList, isNothing, isJust, fromMaybe)-import qualified Data.Data as D import Data.Generics-       (everythingWithContext, mkM, everywhereM,-        everything, mkT, something, everywhere, mkQ)+       (everythingWithContext, mkM, something, mkQ) import Data.Generics.Extras  import Language.PureScript.Declarations@@ -70,6 +68,7 @@ import Control.Arrow (Arrow(..))  import qualified Data.Map as M+import qualified Data.HashMap.Strict as H import Data.Function (on) import Data.Ord (comparing) import Data.Monoid ((<>))@@ -78,6 +77,16 @@   unknown = TUnknown   isUnknown (TUnknown u) = Just u   isUnknown _ = Nothing+  unknowns = everythingOnTypes (++) go+    where+    go (TUnknown u) = [u]+    go _ = []+  ($?) sub = everywhereOnTypes go+    where+    go t@(TUnknown u) = case H.lookup u (runSubstitution sub) of+                          Nothing -> t+                          Just t' -> t'+    go other = other  instance Unifiable Check Type where   (=?=) = unifyTypes@@ -253,7 +262,7 @@ -- Map a function over type annotations appearing inside a value -- overTypes :: (Type -> Type) -> Value -> Value-overTypes f = everywhere (mkT g)+overTypes f = let (_, f', _) = everywhereOnValues id g id in f'   where   g :: Value -> Value   g (TypedValue checkTy val t) = TypedValue checkTy val (f t)@@ -373,7 +382,7 @@ 	    return $ map head grps 	  -- Apply a substitution to a type 	  applySubst :: [(String, Type)] -> Type -> Maybe Type-	  applySubst subst = everywhereM (mkM replace)+	  applySubst subst = everywhereOnTypesM replace 	    where 	    replace (TypeVar v) = lookup v subst 	    replace other = Just other@@ -463,7 +472,7 @@                                       _ -> ([], scos)     where     collectSkolems :: Type -> [SkolemScope]-    collectSkolems = nub . everything (++) (mkQ [] collect)+    collectSkolems = nub . everythingOnTypes (++) collect       where       collect (Skolem _ _ scope) = [scope]       collect _ = []@@ -484,8 +493,8 @@ -- | -- \"Setify\" all rows occuring inside a value ---setifyAll :: (D.Data d) => d -> d-setifyAll = everywhere (mkT setify)+setifyAll :: Type -> Type+setifyAll = everywhereOnTypes setify  -- | -- Replace outermost unsolved unification variables with named type variables@@ -494,11 +503,11 @@ varIfUnknown ty =   let unks = nub $ unknowns ty       toName = (:) 't' . show-      ty' = everywhere (mkT typeToVar) ty+      ty' = everywhereOnTypes typeToVar ty       typeToVar :: Type -> Type-      typeToVar (TUnknown (Unknown u)) = TypeVar (toName u)+      typeToVar (TUnknown u) = TypeVar (toName u)       typeToVar t = t-  in mkForAll (sort . map (toName . runUnknown) $ unks) ty'+  in mkForAll (sort . map toName $ unks) ty'  -- | -- Remove any ForAlls and ConstrainedType constructors in a type by introducing new unknowns@@ -529,14 +538,14 @@ -- Replace fully applied type synonyms with the @SaturatedTypeSynonym@ data constructor, which helps generate -- better error messages during unification. ---replaceAllTypeSynonyms' :: (D.Data d) => Environment -> d -> Either String d+replaceAllTypeSynonyms' :: Environment -> Type -> Either String Type replaceAllTypeSynonyms' env d =   let     syns = map (\(name, (args, _)) -> (name, length args)) . M.toList $ typeSynonyms env   in     saturateAllTypeSynonyms syns d -replaceAllTypeSynonyms :: (Error e, Functor m, Monad m, MonadState CheckState m, MonadError e m) => (D.Data d) => d -> m d+replaceAllTypeSynonyms :: (Error e, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type replaceAllTypeSynonyms d = do   env <- getEnv   either (throwError . strMsg) return $ replaceAllTypeSynonyms' env d@@ -544,8 +553,8 @@ -- | -- \"Desaturate\" @SaturatedTypeSynonym@s ---desaturateAllTypeSynonyms :: (D.Data d) => d -> d-desaturateAllTypeSynonyms = everywhere (mkT replaceSaturatedTypeSynonym)+desaturateAllTypeSynonyms :: Type -> Type+desaturateAllTypeSynonyms = everywhereOnTypes replaceSaturatedTypeSynonym   where   replaceSaturatedTypeSynonym (SaturatedTypeSynonym name args) = foldl TypeApp (TypeConstructor name) args   replaceSaturatedTypeSynonym t = t@@ -566,8 +575,8 @@   env <- getEnv   either (throwError . strMsg) return $ expandTypeSynonym' env name args -expandAllTypeSynonyms :: (Error e, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type-expandAllTypeSynonyms = everywhereM' (mkM go)+expandAllTypeSynonyms :: (Error e, Functor m, Applicative m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type+expandAllTypeSynonyms = everywhereOnTypesTopDownM go   where   go (SaturatedTypeSynonym name args) = expandTypeSynonym name args   go other = return other@@ -677,6 +686,8 @@ inferLetBinding seen [] ret j = (,) seen <$> j ret inferLetBinding seen (ValueDeclaration ident nameKind [] Nothing tv@(TypedValue checkType val ty) : rest) ret j = do   Just moduleName <- checkCurrentModule <$> get+  kind <- liftCheck $ kindOf moduleName ty+  guardWith (strMsg $ "Expected type of kind *, was " ++ prettyPrintKind kind) $ kind == Star   let dict = if isFunction val then M.singleton (moduleName, ident) (ty, nameKind) else M.empty   TypedValue _ val' ty' <- if checkType then bindNames dict (check val ty) else return tv   bindNames (M.singleton (moduleName, ident) (ty', nameKind)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] Nothing (TypedValue checkType val' ty')]) rest ret j@@ -694,7 +705,7 @@     (ident, (val', _)) <- typeForBindingGroupElement moduleName e dict untypedDict     return $ (ident, LocalVariable, val')   bindNames dict $ inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j-inferLetBinding seen (PositionedDeclaration pos d : ds) ret j = do+inferLetBinding seen (PositionedDeclaration pos d : ds) ret j = rethrowWithPosition pos $ do   ((d' : ds'), val') <- inferLetBinding seen (d : ds) ret j   return (PositionedDeclaration pos d' : ds', val') inferLetBinding _ _ _ _ = error "Invalid argument to inferLetBinding"@@ -791,13 +802,13 @@ -- Generate a new skolem constant -- newSkolemConstant :: UnifyT Type Check Int-newSkolemConstant = runUnknown <$> fresh'+newSkolemConstant = fresh'  -- | -- Generate a new skolem scope -- newSkolemScope :: UnifyT Type Check SkolemScope-newSkolemScope = SkolemScope . runUnknown <$> fresh'+newSkolemScope = SkolemScope <$> fresh'  -- | -- Skolemize a type variable by replacing its instances with fresh skolem constants@@ -811,7 +822,7 @@ -- only example of scoped type variables. -- skolemizeTypesInValue :: String -> Int -> SkolemScope -> Value -> Value-skolemizeTypesInValue ident sko scope = everywhere (mkT go)+skolemizeTypesInValue ident sko scope = let (_, f, _) = everywhereOnValues id go id in f   where   go (SuperClassDictionary c ts) = SuperClassDictionary c (map (skolemize ident sko scope) ts)   go other = other@@ -820,7 +831,7 @@ -- Introduce skolem scope at every occurence of a ForAll -- introduceSkolemScope :: Type -> UnifyT Type Check Type-introduceSkolemScope = everywhereM (mkM go)+introduceSkolemScope = everywhereOnTypesM go   where   go (ForAll ident ty Nothing) = ForAll ident ty <$> (Just <$> newSkolemScope)   go other = return other@@ -962,7 +973,7 @@ check' val ty = throwError $ mkErrorStack ("Value does not have type " ++ prettyPrintType ty) (Just (ValueError val))  containsTypeSynonyms :: Type -> Bool-containsTypeSynonyms = everything (||) (mkQ False go) where+containsTypeSynonyms = everythingOnTypes (||) go where   go (SaturatedTypeSynonym _ _) = True   go _ = False @@ -1105,6 +1116,7 @@ subsumes' val ty1 ty2 = do   ty1 =?= ty2   return val+   

@@ -19,10 +19,11 @@  import Data.Data import Data.List (nub)-import Data.Generics (everything, mkQ)  import Control.Monad.Unify import Control.Arrow (second)+import Control.Applicative+import Control.Monad ((<=<))  import Language.PureScript.Names @@ -157,7 +158,7 @@ -- Collect all type variables appearing in a type -- usedTypeVariables :: Type -> [String]-usedTypeVariables = nub . everything (++) (mkQ [] go)+usedTypeVariables = nub . everythingOnTypes (++) go   where   go (TypeVar v) = [v]   go _ = []@@ -199,5 +200,79 @@          [] -> constrained          qs' -> foldl (\ty' (q, sco) -> ForAll q ty' sco) constrained qs' +--+-- Traversals+-- +everywhereOnTypes :: (Type -> Type) -> Type -> Type+everywhereOnTypes f = go+  where+  go (TypeApp t1 t2) = f (TypeApp (go t1) (go t2))+  go (SaturatedTypeSynonym name tys) = f (SaturatedTypeSynonym name (map go tys))+  go (ForAll arg ty sco) = f (ForAll arg (go ty) sco)+  go (ConstrainedType cs ty) = f (ConstrainedType (map (fmap (map go)) cs) (go ty))+  go (RCons name ty rest) = f (RCons name (go ty) (go rest))+  go (PrettyPrintFunction t1 t2) = f (PrettyPrintFunction (go t1) (go t2))+  go (PrettyPrintArray t) = f (PrettyPrintArray (go t))+  go (PrettyPrintObject t) = f (PrettyPrintObject (go t))+  go (PrettyPrintForAll args t) = f (PrettyPrintForAll args (go t))+  go other = f other +everywhereOnTypesTopDown :: (Type -> Type) -> Type -> Type+everywhereOnTypesTopDown f = go . f+  where+  go (TypeApp t1 t2) = TypeApp (go (f t1)) (go (f t2))+  go (SaturatedTypeSynonym name tys) = SaturatedTypeSynonym name (map (go . f) tys)+  go (ForAll arg ty sco) = ForAll arg (go (f ty)) sco+  go (ConstrainedType cs ty) = ConstrainedType (map (fmap (map (go . f))) cs) (go (f ty))+  go (RCons name ty rest) = RCons name (go (f ty)) (go (f rest))+  go (PrettyPrintFunction t1 t2) = PrettyPrintFunction (go (f t1)) (go (f t2))+  go (PrettyPrintArray t) = PrettyPrintArray (go (f t))+  go (PrettyPrintObject t) = PrettyPrintObject (go (f t))+  go (PrettyPrintForAll args t) = PrettyPrintForAll args (go (f t))+  go other = f other++sndM :: (Functor f) => (b -> f c) -> (a, b) -> f (a, c)+sndM f (a, b) = (,) a <$> f b++everywhereOnTypesM :: (Functor m, Applicative m, Monad m) => (Type -> m Type) -> Type -> m Type+everywhereOnTypesM f = go+  where+  go (TypeApp t1 t2) = (TypeApp <$> go t1 <*> go t2) >>= f+  go (SaturatedTypeSynonym name tys) = (SaturatedTypeSynonym name <$> mapM go tys) >>= f+  go (ForAll arg ty sco) = (ForAll arg <$> go ty <*> pure sco) >>= f+  go (ConstrainedType cs ty) = (ConstrainedType <$> mapM (sndM (mapM go)) cs <*> go ty) >>= f+  go (RCons name ty rest) = (RCons name <$> go ty <*> go rest) >>= f+  go (PrettyPrintFunction t1 t2) = (PrettyPrintFunction <$> go t1 <*> go t2) >>= f+  go (PrettyPrintArray t) = (PrettyPrintArray <$> go t) >>= f+  go (PrettyPrintObject t) = (PrettyPrintObject <$> go t) >>= f+  go (PrettyPrintForAll args t) = (PrettyPrintForAll args <$> go t) >>= f+  go other = f other++everywhereOnTypesTopDownM :: (Functor m, Applicative m, Monad m) => (Type -> m Type) -> Type -> m Type+everywhereOnTypesTopDownM f = go <=< f+  where+  go (TypeApp t1 t2) = TypeApp <$> (f t1 >>= go) <*> (f t2 >>= go)+  go (SaturatedTypeSynonym name tys) = SaturatedTypeSynonym name <$> mapM (go <=< f) tys+  go (ForAll arg ty sco) = ForAll arg <$> (f ty >>= go) <*> pure sco+  go (ConstrainedType cs ty) = ConstrainedType <$> mapM (sndM (mapM (go <=< f))) cs <*> (f ty >>= go)+  go (RCons name ty rest) = RCons name <$> (f ty >>= go) <*> (f rest >>= go)+  go (PrettyPrintFunction t1 t2) = PrettyPrintFunction <$> (f t1 >>= go) <*> (f t2 >>= go)+  go (PrettyPrintArray t) = PrettyPrintArray <$> (f t >>= go)+  go (PrettyPrintObject t) = PrettyPrintObject <$> (f t >>= go)+  go (PrettyPrintForAll args t) = PrettyPrintForAll args <$> (f t >>= go)+  go other = f other++everythingOnTypes :: (r -> r -> r) -> (Type -> r) -> Type -> r+everythingOnTypes (<>) f = go+  where+  go t@(TypeApp t1 t2) = f t <> go t1 <> go t2+  go t@(SaturatedTypeSynonym _ tys) = foldl (<>) (f t) (map go tys)+  go t@(ForAll _ ty _) = f t <> go ty+  go t@(ConstrainedType cs ty) = foldl (<>) (f t) (map go $ concatMap snd cs) <> go ty+  go t@(RCons _ ty rest) = f t <> go ty <> go rest+  go t@(PrettyPrintFunction t1 t2) = f t <> go t1 <> go t2+  go t@(PrettyPrintArray t1) = f t <> go t1+  go t@(PrettyPrintObject t1) = f t <> go t1+  go t@(PrettyPrintForAll _ t1) = f t <> go t1+  go other = f other

@@ -60,7 +60,6 @@   let options = P.defaultOptions { P.optionsMain = Just "Main", P.optionsModules = ["Main"], P.optionsCodeGenModules = ["Main"], P.optionsBrowserNamespace = Just "Tests" }   assert preludeExterns options inputFile $ either (return . Just) $ \(js, _, _) -> do     process <- findNodeProcess-    putStrLn $ preludeJs ++ js     result <- traverse (\node -> readProcessWithExitCode node [] (preludeJs ++ js)) process     case result of       Just (ExitSuccess, out, _) -> putStrLn out >> return Nothing