uuagc 0.9.50 → 0.9.50.1
raw patch · 17 files changed
+973/−730 lines, 17 filesdep ~uuagc
Dependency ranges changed: uuagc
Files
- src-ag/Code.ag +2/−0
- src-ag/DefaultRules.ag +9/−7
- src-ag/GenerateCode.ag +21/−2
- src-ag/PrintCleanCode.ag +4/−0
- src-ag/PrintCode.ag +4/−0
- src-ag/PrintOcamlCode.ag +2/−0
- src-generated/Code.hs +6/−1
- src-generated/DefaultRules.hs +109/−108
- src-generated/GenerateCode.hs +280/−261
- src-generated/PrintCleanCode.hs +227/−149
- src-generated/PrintCode.hs +197/−137
- src-generated/PrintOcamlCode.hs +94/−54
- src/Ag.hs +2/−1
- src/HsTokenScanner.hs +4/−1
- src/Parser.hs +8/−5
- src/Scanner.hs +2/−2
- uuagc.cabal +2/−2
src-ag/Code.ag view
@@ -130,6 +130,8 @@ | TMap key : Type value : Type | TIntMap value : Type+ | TSet tp : Type+ | TIntSet DATA Lhs | Pattern3 pat3 : Pattern | Pattern3SM pat3 : Pattern
src-ag/DefaultRules.ag view
@@ -328,7 +328,7 @@ | otherwise = "(" ++ op ++ " " ++ l ++ " " ++ r ++ ")" -- associates to the right str = foldr1 opExpr (map (flip attrName n) elems) - in makeRule (_LHS,n)+ in makeRule (_LOC,n) (Expression noPos tks) ("use rule " ++ pos) False@@ -435,11 +435,11 @@ (selfAttrs, normalAttrs) = Map.partitionWithKey (\k _ -> maybe False isSELFNonterminal $ Map.lookup k @lhs.synOrig) @lhs.syn - (_,undefAttrs)- = removeDefined @rules.definedAttrs (_LHS, normalAttrs)-- (useAttrs,others)- = splitAttrs @lhs.useMap undefAttrs+ others = snd $ removeDefined @rules.definedAttrs (_LHS, normalAttrs)+ + -- Generate use attrs as local+ useAttrs = fst $ splitAttrs @lhs.useMap $ + snd $ removeDefined @rules.definedAttrs (_LOC, normalAttrs) (rules1, errors1) = concatRE $ map (copyRule @lhs.options @lhs.wrappers @lhs.nt @con @lhs.cr locals)@@ -447,6 +447,8 @@ uRules = map (useRule @lhs.options locals @children.outputs) useAttrs+ uLocals+ = Set.fromList $ map fst useAttrs -- creates a loc.xxx if there is a synthesized attr xxx of type SELF and no -- loc.xxx exists yet. If there exists a terminal yyy and a local loc.yyy, then@@ -481,7 +483,7 @@ @lhs.nt @con @lhs.cr- locals+ (locals `Set.union` uLocals) (lhs_env, (_LHS, others)) in (uRules++selfLocRules++selfRules++rules5++rules1, errors1><errs5)
src-ag/GenerateCode.ag view
@@ -790,6 +790,7 @@ TEither l r -> TEither (chase l) (chase r) TMap k v -> TMap (chase k) (chase v) TIntMap v -> TIntMap (chase v)+ TSet m -> TSet (chase m) _ -> t replaceTok t@@ -1011,7 +1012,8 @@ CommonTypes.IntMap t -> TIntMap $ typeToCodeType (Just @nt) params' t CommonTypes.List t -> Code.List $ typeToCodeType (Just @nt) params' t CommonTypes.Tuple ts -> Code.TupleType [typeToCodeType (Just @nt) params' t | (_,t) <- ts ]- tp' -> error $ show tp' ++ " not supported"+ CommonTypes.OrdSet t -> TSet $ typeToCodeType (Just @nt) params' t+ CommonTypes.IntSet -> TIntSet in Code.Type (getName @nt) params' (idEvalType @lhs.options theType) derivings = maybe [] (map getName . Set.toList) (Map.lookup @nt @lhs.derivings) dataDef = Data (getName @nt) (map getName @params) @prods.dataAlts (maybe False id @lhs.o_data) derivings@@ -1124,8 +1126,25 @@ lhs = Fun (cataname @lhs.prefix @nt) [TupleExpr (map fst tps')] rhs = App con rargs+ in [Decl lhs rhs Set.empty Set.empty] + CommonTypes.OrdSet tp ->+ let entry = SimpleExpr (semname @lhs.prefix @nt (identifier "Entry"))+ nil = SimpleExpr (semname @lhs.prefix @nt (identifier "Nil" ))+ arg = SimpleExpr "set"+ rentry = case tp of+ NT t _ _ -> let t' = maybe t id (deforestedNt t)+ in App "(.)" [entry, SimpleExpr $ cataname @lhs.prefix t']+ _ -> entry+ lhs = Fun (cataname @lhs.prefix @nt) [arg]+ rhs = (App "Data.Set.foldr" [rentry,nil,arg]) in [Decl lhs rhs Set.empty Set.empty]- _ -> error "TODO"+ CommonTypes.IntSet ->+ let entry = SimpleExpr (semname @lhs.prefix @nt (identifier "Entry"))+ nil = SimpleExpr (semname @lhs.prefix @nt (identifier "Nil" ))+ arg = SimpleExpr "set"+ lhs = Fun (cataname @lhs.prefix @nt) [arg]+ rhs = (App "Data.IntSet.foldr" [entry,nil,arg])+ in [Decl lhs rhs Set.empty Set.empty] in Comment "cata" : (if @lhs.o_sig then [tSig] else []) ++ maybe @prods.cataAlts special (lookup @nt @lhs.typeSyns)
src-ag/PrintCleanCode.ag view
@@ -313,6 +313,10 @@ lhs.pp = text "'Data.Map'.Map" >#< pp_parens @key.pp >#< pp_parens @value.pp | TIntMap lhs.prec = 5 lhs.pp = text "'Data.IntMap'.IntMap" >#< pp_parens @value.pp+ | TSet lhs.prec = 5+ lhs.pp = text "'Data.Set'.Set" >#< pp_parens @tp.pp+ | TIntSet lhs.prec = 5+ lhs.pp = text "'Data.IntSet'.IntSet" {
src-ag/PrintCode.ag view
@@ -294,6 +294,10 @@ lhs.pp = text "Data.Map.Map" >#< pp_parens @key.pp >#< pp_parens @value.pp | TIntMap lhs.prec = 5 lhs.pp = text "Data.IntMap.IntMap" >#< pp_parens @value.pp+ | TSet lhs.prec = 5+ lhs.pp = text "Data.Set.Set" >#< pp_parens @tp.pp+ | TIntSet lhs.prec = 5+ lhs.pp = text "Data.IntSet.IntSet" {
src-ag/PrintOcamlCode.ag view
@@ -171,6 +171,8 @@ | TEither lhs.pp = error "pp of Type.TEither is not supported" | TMap lhs.pp = error "pp of Type.TMap is not supported" | TIntMap lhs.pp = error "pp of Type.TIntMap is not supported"+ | TSet lhs.pp = error "pp of Type.TSet is not supported"+ | TIntSet lhs.pp = error "pp of Type.TIntSet is not supported" { toOcamlTC :: String -> String
src-generated/Code.hs view
@@ -10,7 +10,7 @@ import Data.Map(Map) import qualified Data.Map as Map {-# LINE 13 "dist/build/Code.hs" #-}-{-# LINE 144 "./src-ag/Code.ag" #-}+{-# LINE 146 "./src-ag/Code.ag" #-} -- Unboxed tuples -- unbox Whether unboxed tuples are wanted or not@@ -325,6 +325,9 @@ child value : Type alternative TIntMap: child value : Type + alternative TSet:+ child tp : Type + alternative TIntSet: -} data Type = Arr (Type) (Type) | CtxApp (([(String, [String])])) (Type)@@ -339,6 +342,8 @@ | TEither (Type) (Type) | TMap (Type) (Type) | TIntMap (Type)+ | TSet (Type)+ | TIntSet deriving ( Show) -- Types ------------------------------------------------------- {-
src-generated/DefaultRules.hs view
@@ -234,7 +234,7 @@ | otherwise = "(" ++ op ++ " " ++ l ++ " " ++ r ++ ")" -- associates to the right str = foldr1 opExpr (map (flip attrName n) elems) - in makeRule (_LHS,n)+ in makeRule (_LOC,n) (Expression noPos tks) ("use rule " ++ pos) False@@ -309,7 +309,7 @@ deprChild = maybe False (== _ACHILD) sel {-# LINE 311 "dist/build/DefaultRules.hs" #-} -{-# LINE 488 "./src-ag/DefaultRules.ag" #-}+{-# LINE 490 "./src-ag/DefaultRules.ag" #-} buildTuple fs = "(" ++ concat (intersperse "," fs) ++ ")" @@ -378,7 +378,7 @@ childLoc = Ident (show target ++ "_merge") (getPos target) {-# LINE 380 "dist/build/DefaultRules.hs" #-} -{-# LINE 606 "./src-ag/DefaultRules.ag" #-}+{-# LINE 608 "./src-ag/DefaultRules.ag" #-} elimSelfId :: NontermIdent -> [Identifier] -> Type -> Type elimSelfId nt args Self = NT nt (map getName args) False@@ -389,7 +389,7 @@ elimSelfStr _ _ tp = tp {-# LINE 391 "dist/build/DefaultRules.hs" #-} -{-# LINE 658 "./src-ag/DefaultRules.ag" #-}+{-# LINE 660 "./src-ag/DefaultRules.ag" #-} -- When a rule has a name, create an alias for a rule -- and a modified rule that refers to the alias@@ -404,13 +404,13 @@ r' = Rule Nothing pat expr' owrt origin False True identity Nothing False {-# LINE 406 "dist/build/DefaultRules.hs" #-} -{-# LINE 675 "./src-ag/DefaultRules.ag" #-}+{-# LINE 677 "./src-ag/DefaultRules.ag" #-} needsMultiRules :: Options -> Bool needsMultiRules opts = (visit opts || withCycle opts) && not (kennedyWarren opts) {-# LINE 412 "dist/build/DefaultRules.hs" #-} -{-# LINE 680 "./src-ag/DefaultRules.ag" #-}+{-# LINE 682 "./src-ag/DefaultRules.ag" #-} {- multiRule replaces@@ -632,36 +632,36 @@ else _syn1 {-# LINE 634 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule6 #-}- {-# LINE 574 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 576 "./src-ag/DefaultRules.ag" #-} rule6 = \ !kind_ !name_ !tp_ ->- {-# LINE 574 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 576 "./src-ag/DefaultRules.ag" #-} (name_,tp_,kind_) {-# LINE 640 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule7 #-}- {-# LINE 596 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 598 "./src-ag/DefaultRules.ag" #-} rule7 = \ !name_ !tp_ ->- {-# LINE 596 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 598 "./src-ag/DefaultRules.ag" #-} case tp_ of NT nt params _ -> (nt, params) Self -> error ("The type of child " ++ show name_ ++ " should not be a Self type.") Haskell t -> (identifier t, []) {-# LINE 649 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule8 #-}- {-# LINE 600 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 602 "./src-ag/DefaultRules.ag" #-} rule8 = \ !_inh !_nt !_params ->- {-# LINE 600 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 602 "./src-ag/DefaultRules.ag" #-} Map.map (elimSelfStr _nt _params ) _inh {-# LINE 655 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule9 #-}- {-# LINE 601 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 603 "./src-ag/DefaultRules.ag" #-} rule9 = \ !_nt !_params !_syn ->- {-# LINE 601 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 603 "./src-ag/DefaultRules.ag" #-} Map.map (elimSelfStr _nt _params ) _syn {-# LINE 661 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule10 #-}- {-# LINE 642 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 644 "./src-ag/DefaultRules.ag" #-} rule10 = \ !kind_ !name_ !tp_ ->- {-# LINE 642 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 644 "./src-ag/DefaultRules.ag" #-} Child name_ tp_ kind_ {-# LINE 667 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule11 #-}@@ -823,9 +823,9 @@ (_hdIname, _hdIsynthesized) : _tlIoutputs {-# LINE 825 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule15 #-}- {-# LINE 570 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 572 "./src-ag/DefaultRules.ag" #-} rule15 = \ ((!_hdIfield) :: (Identifier,Type,ChildKind) ) ((!_tlIfields) :: [(Identifier,Type,ChildKind)]) ->- {-# LINE 570 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 572 "./src-ag/DefaultRules.ag" #-} _hdIfield : _tlIfields {-# LINE 831 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule16 #-}@@ -931,9 +931,9 @@ [] {-# LINE 933 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule35 #-}- {-# LINE 571 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 573 "./src-ag/DefaultRules.ag" #-} rule35 = \ (_ :: ()) ->- {-# LINE 571 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 573 "./src-ag/DefaultRules.ag" #-} [] {-# LINE 939 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule36 #-}@@ -1051,33 +1051,33 @@ typeSyns_ {-# LINE 1053 "dist/build/DefaultRules.hs"#-} {-# INLINE rule47 #-}- {-# LINE 623 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 625 "./src-ag/DefaultRules.ag" #-} rule47 = \ (_ :: ()) ->- {-# LINE 623 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 625 "./src-ag/DefaultRules.ag" #-} 1 {-# LINE 1059 "dist/build/DefaultRules.hs"#-} {-# INLINE rule48 #-}- {-# LINE 737 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 739 "./src-ag/DefaultRules.ag" #-} rule48 = \ !manualAttrOrderMap_ ->- {-# LINE 737 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 739 "./src-ag/DefaultRules.ag" #-} manualAttrOrderMap_ {-# LINE 1065 "dist/build/DefaultRules.hs"#-} {-# INLINE rule49 #-}- {-# LINE 803 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 805 "./src-ag/DefaultRules.ag" #-} rule49 = \ !augmentsMap_ ->- {-# LINE 803 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 805 "./src-ag/DefaultRules.ag" #-} augmentsMap_ {-# LINE 1071 "dist/build/DefaultRules.hs"#-} {-# INLINE rule50 #-}- {-# LINE 810 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 812 "./src-ag/DefaultRules.ag" #-} rule50 = \ !aroundsMap_ ->- {-# LINE 810 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 812 "./src-ag/DefaultRules.ag" #-} aroundsMap_ {-# LINE 1077 "dist/build/DefaultRules.hs"#-} {-# INLINE rule51 #-}- {-# LINE 818 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 820 "./src-ag/DefaultRules.ag" #-} rule51 = \ !mergeMap_ ->- {-# LINE 818 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 820 "./src-ag/DefaultRules.ag" #-} mergeMap_ {-# LINE 1083 "dist/build/DefaultRules.hs"#-} {-# INLINE rule52 #-}@@ -1463,39 +1463,39 @@ nt_ {-# LINE 1465 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule67 #-}- {-# LINE 592 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 594 "./src-ag/DefaultRules.ag" #-} rule67 = \ !inh_ !nt_ !params_ ->- {-# LINE 592 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 594 "./src-ag/DefaultRules.ag" #-} Map.map (elimSelfId nt_ params_) inh_ {-# LINE 1471 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule68 #-}- {-# LINE 593 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 595 "./src-ag/DefaultRules.ag" #-} rule68 = \ !nt_ !params_ !syn_ ->- {-# LINE 593 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 595 "./src-ag/DefaultRules.ag" #-} Map.map (elimSelfId nt_ params_) syn_ {-# LINE 1477 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule69 #-}- {-# LINE 632 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 634 "./src-ag/DefaultRules.ag" #-} rule69 = \ !_inh1 ((!_prodsIoutput) :: Productions) !_syn1 !nt_ !params_ ->- {-# LINE 632 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 634 "./src-ag/DefaultRules.ag" #-} Nonterminal nt_ params_ _inh1 _syn1 _prodsIoutput {-# LINE 1483 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule70 #-}- {-# LINE 804 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 806 "./src-ag/DefaultRules.ag" #-} rule70 = \ ((!_lhsIaugmentsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !nt_ ->- {-# LINE 804 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 806 "./src-ag/DefaultRules.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIaugmentsIn {-# LINE 1489 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule71 #-}- {-# LINE 811 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 813 "./src-ag/DefaultRules.ag" #-} rule71 = \ ((!_lhsIaroundsIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier [Expression]))) !nt_ ->- {-# LINE 811 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 813 "./src-ag/DefaultRules.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIaroundsIn {-# LINE 1495 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule72 #-}- {-# LINE 819 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 821 "./src-ag/DefaultRules.ag" #-} rule72 = \ ((!_lhsImergesIn) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression)))) !nt_ ->- {-# LINE 819 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 821 "./src-ag/DefaultRules.ag" #-} Map.findWithDefault Map.empty nt_ _lhsImergesIn {-# LINE 1501 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule73 #-}@@ -2606,23 +2606,23 @@ in __result_ ) in C_Pattern_s55 k55 {-# NOINLINE rule154 #-}- {-# LINE 564 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 566 "./src-ag/DefaultRules.ag" #-} rule154 = \ ((!_patIdefinedAttrs) :: Set (Identifier,Identifier)) !attr_ !field_ ->- {-# LINE 564 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 566 "./src-ag/DefaultRules.ag" #-} Set.insert (field_,attr_) _patIdefinedAttrs {-# LINE 2614 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule155 #-}- {-# LINE 565 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 567 "./src-ag/DefaultRules.ag" #-} rule155 = \ ((!_patIlocals) :: Set Identifier) !attr_ !field_ ->- {-# LINE 565 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 567 "./src-ag/DefaultRules.ag" #-} if field_ == _LOC then Set.insert attr_ _patIlocals else _patIlocals {-# LINE 2622 "dist/build/DefaultRules.hs"#-} {-# NOINLINE rule156 #-}- {-# LINE 582 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 584 "./src-ag/DefaultRules.ag" #-} rule156 = \ (_ :: ()) ->- {-# LINE 582 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 584 "./src-ag/DefaultRules.ag" #-} True {-# LINE 2628 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule157 #-}@@ -3545,15 +3545,16 @@ lhs_env = last envs (selfAttrs, normalAttrs) = Map.partitionWithKey (\k _ -> maybe False isSELFNonterminal $ Map.lookup k _lhsIsynOrig) _lhsIsyn- (_,undefAttrs)- = removeDefined _rulesIdefinedAttrs (_LHS, normalAttrs)- (useAttrs,others)- = splitAttrs _lhsIuseMap undefAttrs+ others = snd $ removeDefined _rulesIdefinedAttrs (_LHS, normalAttrs)+ useAttrs = fst $ splitAttrs _lhsIuseMap $+ snd $ removeDefined _rulesIdefinedAttrs (_LOC, normalAttrs) (rules1, errors1) = concatRE $ map (copyRule _lhsIoptions _lhsIwrappers _lhsInt con_ _lhsIcr locals) (zip envs (map (removeDefined _rulesIdefinedAttrs) _childrenIinputs)) uRules = map (useRule _lhsIoptions locals _childrenIoutputs) useAttrs+ uLocals+ = Set.fromList $ map fst useAttrs selfLocRules = [ selfRule False attr $ lexTokens _lhsIoptions noPos $@@ -3581,44 +3582,44 @@ _lhsInt con_ _lhsIcr- locals+ (locals `Set.union` uLocals) (lhs_env, (_LHS, others)) in (uRules++selfLocRules++selfRules++rules5++rules1, errors1><errs5)- {-# LINE 3588 "dist/build/DefaultRules.hs"#-}+ {-# LINE 3589 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule206 #-}- {-# LINE 636 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 638 "./src-ag/DefaultRules.ag" #-} rule206 = \ !_augmentsIn !_newRls ((!_rulesIoutput) :: Rules) ->- {-# LINE 636 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 638 "./src-ag/DefaultRules.ag" #-} foldr addAugments (_rulesIoutput ++ _newRls) (Map.assocs _augmentsIn )- {-# LINE 3594 "dist/build/DefaultRules.hs"#-}+ {-# LINE 3595 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule207 #-}- {-# LINE 637 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 639 "./src-ag/DefaultRules.ag" #-} rule207 = \ !_aroundsIn !_extra1 ->- {-# LINE 637 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 639 "./src-ag/DefaultRules.ag" #-} foldr addArounds _extra1 (Map.assocs _aroundsIn )- {-# LINE 3600 "dist/build/DefaultRules.hs"#-}+ {-# LINE 3601 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule208 #-}- {-# LINE 638 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 640 "./src-ag/DefaultRules.ag" #-} rule208 = \ !_extra2 !_mergesIn ->- {-# LINE 638 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 640 "./src-ag/DefaultRules.ag" #-} foldr addMerges _extra2 (Map.assocs _mergesIn )- {-# LINE 3606 "dist/build/DefaultRules.hs"#-}+ {-# LINE 3607 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule209 #-}- {-# LINE 639 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 641 "./src-ag/DefaultRules.ag" #-} rule209 = \ ((!_childrenIoutput) :: Children) !_extra3 ((!_typeSigsIoutput) :: TypeSigs) !con_ !constraints_ !macro_ !params_ ->- {-# LINE 639 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 641 "./src-ag/DefaultRules.ag" #-} Production con_ params_ constraints_ _childrenIoutput _extra3 _typeSigsIoutput macro_- {-# LINE 3612 "dist/build/DefaultRules.hs"#-}+ {-# LINE 3613 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule210 #-}- {-# LINE 747 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 749 "./src-ag/DefaultRules.ag" #-} rule210 = \ ((!_lhsImanualAttrOrderMap) :: AttrOrderMap) ((!_lhsInt) :: NontermIdent) !con_ ->- {-# LINE 747 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 749 "./src-ag/DefaultRules.ag" #-} Set.toList $ Map.findWithDefault Set.empty con_ $ Map.findWithDefault Map.empty _lhsInt _lhsImanualAttrOrderMap- {-# LINE 3618 "dist/build/DefaultRules.hs"#-}+ {-# LINE 3619 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule211 #-}- {-# LINE 750 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 752 "./src-ag/DefaultRules.ag" #-} rule211 = \ ((!_childrenIinputs) :: [(Identifier, Attributes)]) ((!_childrenIoutputs) :: [(Identifier, Attributes)]) ((!_lhsIinh) :: Attributes) ((!_lhsInt) :: NontermIdent) ((!_lhsIsyn) :: Attributes) !_orderDeps ((!_rulesIlocals) :: Set Identifier) ((!_rulesIruleNames) :: Set Identifier) !con_ ->- {-# LINE 750 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 752 "./src-ag/DefaultRules.ag" #-} let chldOutMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIoutputs ] chldInMap = Map.fromList [ (k, Map.keysSet s) | (k,s) <- _childrenIinputs ] isInAttribute :: Identifier -> Identifier -> [Error]@@ -3654,31 +3655,31 @@ [ checkIn occA ++ checkOut occB | (Dependency occA occB) <- _orderDeps ]- {-# LINE 3658 "dist/build/DefaultRules.hs"#-}+ {-# LINE 3659 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule212 #-}- {-# LINE 805 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 807 "./src-ag/DefaultRules.ag" #-} rule212 = \ ((!_lhsIaugmentsIn) :: Map ConstructorIdent (Map Identifier [Expression])) !con_ ->- {-# LINE 805 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 807 "./src-ag/DefaultRules.ag" #-} Map.findWithDefault Map.empty con_ _lhsIaugmentsIn- {-# LINE 3664 "dist/build/DefaultRules.hs"#-}+ {-# LINE 3665 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule213 #-}- {-# LINE 812 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 814 "./src-ag/DefaultRules.ag" #-} rule213 = \ ((!_lhsIaroundsIn) :: Map ConstructorIdent (Map Identifier [Expression])) !con_ ->- {-# LINE 812 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 814 "./src-ag/DefaultRules.ag" #-} Map.findWithDefault Map.empty con_ _lhsIaroundsIn- {-# LINE 3670 "dist/build/DefaultRules.hs"#-}+ {-# LINE 3671 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule214 #-}- {-# LINE 820 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 822 "./src-ag/DefaultRules.ag" #-} rule214 = \ ((!_lhsImergesIn) :: Map ConstructorIdent (Map Identifier (Identifier,[Identifier],Expression))) !con_ ->- {-# LINE 820 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 822 "./src-ag/DefaultRules.ag" #-} Map.findWithDefault Map.empty con_ _lhsImergesIn- {-# LINE 3676 "dist/build/DefaultRules.hs"#-}+ {-# LINE 3677 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule215 #-}- {-# LINE 821 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 823 "./src-ag/DefaultRules.ag" #-} rule215 = \ !_mergesIn ->- {-# LINE 821 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 823 "./src-ag/DefaultRules.ag" #-} Set.fromList [ c | (_,cs,_) <- Map.elems _mergesIn , c <- cs ]- {-# LINE 3682 "dist/build/DefaultRules.hs"#-}+ {-# LINE 3683 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule217 #-} rule217 = \ ((!_rulesIuniq) :: Int) -> _rulesIuniq@@ -4263,39 +4264,39 @@ in __result_ ) in C_Rule_s51 v44 {-# NOINLINE[1] rule280 #-}- {-# LINE 585 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 587 "./src-ag/DefaultRules.ag" #-} rule280 = \ !pure_ ->- {-# LINE 585 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 587 "./src-ag/DefaultRules.ag" #-} pure_- {-# LINE 4271 "dist/build/DefaultRules.hs"#-}+ {-# LINE 4272 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule281 #-}- {-# LINE 652 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 654 "./src-ag/DefaultRules.ag" #-} rule281 = \ !_output ->- {-# LINE 652 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 654 "./src-ag/DefaultRules.ag" #-} mkRuleAlias _output- {-# LINE 4277 "dist/build/DefaultRules.hs"#-}+ {-# LINE 4278 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule282 #-}- {-# LINE 653 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 655 "./src-ag/DefaultRules.ag" #-} rule282 = \ ((!_lhsIoptions) :: Options) ((!_lhsIuniq) :: Int) !_output1 ->- {-# LINE 653 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 655 "./src-ag/DefaultRules.ag" #-} if needsMultiRules _lhsIoptions then multiRule _output1 _lhsIuniq else ([_output1 ], _lhsIuniq)- {-# LINE 4285 "dist/build/DefaultRules.hs"#-}+ {-# LINE 4286 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule283 #-}- {-# LINE 656 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 658 "./src-ag/DefaultRules.ag" #-} rule283 = \ !_mbAlias !_outputs ->- {-# LINE 656 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 658 "./src-ag/DefaultRules.ag" #-} maybe [] return _mbAlias ++ _outputs- {-# LINE 4291 "dist/build/DefaultRules.hs"#-}+ {-# LINE 4292 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule284 #-}- {-# LINE 741 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 743 "./src-ag/DefaultRules.ag" #-} rule284 = \ !mbName_ ->- {-# LINE 741 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 743 "./src-ag/DefaultRules.ag" #-} case mbName_ of Nothing -> Set.empty Just nm -> Set.singleton nm- {-# LINE 4299 "dist/build/DefaultRules.hs"#-}+ {-# LINE 4300 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule285 #-} rule285 = \ ((!_patternIcontainsVars) :: Bool) -> _patternIcontainsVars@@ -4457,11 +4458,11 @@ in __result_ ) in C_Rules_s42 v31 {-# NOINLINE[1] rule293 #-}- {-# LINE 648 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 650 "./src-ag/DefaultRules.ag" #-} rule293 = \ ((!_hdIcontainsVars) :: Bool) ((!_hdIisPure) :: Bool) ((!_hdIoutputs) :: Rules) ((!_tlIoutput) :: Rules) ->- {-# LINE 648 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 650 "./src-ag/DefaultRules.ag" #-} if _hdIcontainsVars && _hdIisPure then _hdIoutputs ++ _tlIoutput else _tlIoutput- {-# LINE 4465 "dist/build/DefaultRules.hs"#-}+ {-# LINE 4466 "dist/build/DefaultRules.hs"#-} {-# NOINLINE[1] rule294 #-} rule294 = \ ((!_hdIdefinedAttrs) :: Set (Identifier,Identifier)) ((!_tlIdefinedAttrs) :: Set (Identifier,Identifier)) -> _hdIdefinedAttrs `Set.union` _tlIdefinedAttrs@@ -4624,17 +4625,17 @@ in __result_ ) in C_TypeSig_s22 v11 {-# INLINE rule317 #-}- {-# LINE 604 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 606 "./src-ag/DefaultRules.ag" #-} rule317 = \ ((!_lhsInt) :: NontermIdent) ((!_lhsIparams) :: [Identifier]) !tp_ ->- {-# LINE 604 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 606 "./src-ag/DefaultRules.ag" #-} elimSelfId _lhsInt _lhsIparams tp_- {-# LINE 4632 "dist/build/DefaultRules.hs"#-}+ {-# LINE 4633 "dist/build/DefaultRules.hs"#-} {-# INLINE rule318 #-}- {-# LINE 645 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 647 "./src-ag/DefaultRules.ag" #-} rule318 = \ !_tp1 !name_ ->- {-# LINE 645 "./src-ag/DefaultRules.ag" #-}+ {-# LINE 647 "./src-ag/DefaultRules.ag" #-} TypeSig name_ _tp1- {-# LINE 4638 "dist/build/DefaultRules.hs"#-}+ {-# LINE 4639 "dist/build/DefaultRules.hs"#-} -- TypeSigs ---------------------------------------------------- -- wrapper
src-generated/GenerateCode.hs view
@@ -176,6 +176,7 @@ TEither l r -> TEither (chase l) (chase r) TMap k v -> TMap (chase k) (chase v) TIntMap v -> TIntMap (chase v)+ TSet m -> TSet (chase m) _ -> t replaceTok t@@ -185,18 +186,18 @@ idEvalType :: Options -> Code.Type -> Code.Type idEvalType options = evalType options id-{-# LINE 189 "dist/build/GenerateCode.hs" #-}+{-# LINE 190 "dist/build/GenerateCode.hs" #-} -{-# LINE 891 "./src-ag/GenerateCode.ag" #-}+{-# LINE 892 "./src-ag/GenerateCode.ag" #-} -- for a virtual child that already existed as a child, returns isFirstOrder :: ChildKind -> Type -> Maybe Type isFirstOrder ChildSyntax tp = Just tp isFirstOrder ChildAttr _ = Nothing isFirstOrder (ChildReplace tp) _ = Just tp-{-# LINE 198 "dist/build/GenerateCode.hs" #-}+{-# LINE 199 "dist/build/GenerateCode.hs" #-} -{-# LINE 912 "./src-ag/GenerateCode.ag" #-}+{-# LINE 913 "./src-ag/GenerateCode.ag" #-} makeLocalComment :: Int -> String -> Identifier -> Maybe Type -> String makeLocalComment width what name tp = let x = getName name@@ -206,9 +207,9 @@ Self -> error "Self type not allowed here.") tp in ( what ++ " " ++ x ++ replicate ((width - length x) `max` 0) ' ' ++ " : " ++ y ) -{-# LINE 210 "dist/build/GenerateCode.hs" #-}+{-# LINE 211 "dist/build/GenerateCode.hs" #-} -{-# LINE 946 "./src-ag/GenerateCode.ag" #-}+{-# LINE 947 "./src-ag/GenerateCode.ag" #-} -- Lets or nested Cases? -- or even a do-expression?@@ -253,15 +254,15 @@ -- Gives the name of a visit function visitname :: String -> NontermIdent -> Int -> String visitname pre nt n = pre ++ getName nt ++ "_" ++ show n-{-# LINE 257 "dist/build/GenerateCode.hs" #-}+{-# LINE 258 "dist/build/GenerateCode.hs" #-} -{-# LINE 1036 "./src-ag/GenerateCode.ag" #-}+{-# LINE 1038 "./src-ag/GenerateCode.ag" #-} toNamedType :: Bool -> NontermIdent -> ConstructorIdent -> Identifier -> Code.Type -> Code.NamedType toNamedType genStrict nt con nm tp = Code.Named genStrict strNm tp where strNm = recordFieldname nt con nm-{-# LINE 265 "dist/build/GenerateCode.hs" #-}+{-# LINE 266 "dist/build/GenerateCode.hs" #-} -- CGrammar ---------------------------------------------------- -- wrapper data Inh_CGrammar = Inh_CGrammar { options_Inh_CGrammar :: (Options) }@@ -347,151 +348,151 @@ rule0 = \ ((_lhsIoptions) :: Options) -> {-# LINE 52 "./src-ag/GenerateCode.ag" #-} typeSigs _lhsIoptions- {-# LINE 351 "dist/build/GenerateCode.hs"#-}+ {-# LINE 352 "dist/build/GenerateCode.hs"#-} {-# INLINE rule1 #-} {-# LINE 53 "./src-ag/GenerateCode.ag" #-} rule1 = \ ((_lhsIoptions) :: Options) -> {-# LINE 53 "./src-ag/GenerateCode.ag" #-} folds _lhsIoptions- {-# LINE 357 "dist/build/GenerateCode.hs"#-}+ {-# LINE 358 "dist/build/GenerateCode.hs"#-} {-# INLINE rule2 #-} {-# LINE 54 "./src-ag/GenerateCode.ag" #-} rule2 = \ ((_lhsIoptions) :: Options) -> {-# LINE 54 "./src-ag/GenerateCode.ag" #-} semfuns _lhsIoptions- {-# LINE 363 "dist/build/GenerateCode.hs"#-}+ {-# LINE 364 "dist/build/GenerateCode.hs"#-} {-# INLINE rule3 #-} {-# LINE 55 "./src-ag/GenerateCode.ag" #-} rule3 = \ ((_lhsIoptions) :: Options) -> {-# LINE 55 "./src-ag/GenerateCode.ag" #-} newtypes _lhsIoptions- {-# LINE 369 "dist/build/GenerateCode.hs"#-}+ {-# LINE 370 "dist/build/GenerateCode.hs"#-} {-# INLINE rule4 #-} {-# LINE 56 "./src-ag/GenerateCode.ag" #-} rule4 = \ ((_lhsIoptions) :: Options) -> {-# LINE 56 "./src-ag/GenerateCode.ag" #-} unbox _lhsIoptions- {-# LINE 375 "dist/build/GenerateCode.hs"#-}+ {-# LINE 376 "dist/build/GenerateCode.hs"#-} {-# INLINE rule5 #-} {-# LINE 57 "./src-ag/GenerateCode.ag" #-} rule5 = \ ((_lhsIoptions) :: Options) -> {-# LINE 57 "./src-ag/GenerateCode.ag" #-} cases _lhsIoptions- {-# LINE 381 "dist/build/GenerateCode.hs"#-}+ {-# LINE 382 "dist/build/GenerateCode.hs"#-} {-# INLINE rule6 #-} {-# LINE 58 "./src-ag/GenerateCode.ag" #-} rule6 = \ ((_lhsIoptions) :: Options) -> {-# LINE 58 "./src-ag/GenerateCode.ag" #-} attrInfo _lhsIoptions- {-# LINE 387 "dist/build/GenerateCode.hs"#-}+ {-# LINE 388 "dist/build/GenerateCode.hs"#-} {-# INLINE rule7 #-} {-# LINE 59 "./src-ag/GenerateCode.ag" #-} rule7 = \ ((_lhsIoptions) :: Options) -> {-# LINE 59 "./src-ag/GenerateCode.ag" #-} rename _lhsIoptions- {-# LINE 393 "dist/build/GenerateCode.hs"#-}+ {-# LINE 394 "dist/build/GenerateCode.hs"#-} {-# INLINE rule8 #-} {-# LINE 60 "./src-ag/GenerateCode.ag" #-} rule8 = \ ((_lhsIoptions) :: Options) -> {-# LINE 60 "./src-ag/GenerateCode.ag" #-} strictWrap _lhsIoptions- {-# LINE 399 "dist/build/GenerateCode.hs"#-}+ {-# LINE 400 "dist/build/GenerateCode.hs"#-} {-# INLINE rule9 #-} {-# LINE 61 "./src-ag/GenerateCode.ag" #-} rule9 = \ ((_lhsIoptions) :: Options) -> {-# LINE 61 "./src-ag/GenerateCode.ag" #-} splitSems _lhsIoptions- {-# LINE 405 "dist/build/GenerateCode.hs"#-}+ {-# LINE 406 "dist/build/GenerateCode.hs"#-} {-# INLINE rule10 #-} {-# LINE 62 "./src-ag/GenerateCode.ag" #-} rule10 = \ ((_lhsIoptions) :: Options) -> {-# LINE 62 "./src-ag/GenerateCode.ag" #-} if dataTypes _lhsIoptions then Just (strictData _lhsIoptions) else Nothing- {-# LINE 411 "dist/build/GenerateCode.hs"#-}+ {-# LINE 412 "dist/build/GenerateCode.hs"#-} {-# INLINE rule11 #-} {-# LINE 63 "./src-ag/GenerateCode.ag" #-} rule11 = \ ((_lhsIoptions) :: Options) -> {-# LINE 63 "./src-ag/GenerateCode.ag" #-} prefix _lhsIoptions- {-# LINE 417 "dist/build/GenerateCode.hs"#-}+ {-# LINE 418 "dist/build/GenerateCode.hs"#-} {-# INLINE rule12 #-} {-# LINE 64 "./src-ag/GenerateCode.ag" #-} rule12 = \ ((_lhsIoptions) :: Options) -> {-# LINE 64 "./src-ag/GenerateCode.ag" #-} genTraces _lhsIoptions- {-# LINE 423 "dist/build/GenerateCode.hs"#-}+ {-# LINE 424 "dist/build/GenerateCode.hs"#-} {-# INLINE rule13 #-} {-# LINE 65 "./src-ag/GenerateCode.ag" #-} rule13 = \ ((_lhsIoptions) :: Options) -> {-# LINE 65 "./src-ag/GenerateCode.ag" #-} genCostCentres _lhsIoptions- {-# LINE 429 "dist/build/GenerateCode.hs"#-}+ {-# LINE 430 "dist/build/GenerateCode.hs"#-} {-# INLINE rule14 #-} {-# LINE 66 "./src-ag/GenerateCode.ag" #-} rule14 = \ ((_lhsIoptions) :: Options) -> {-# LINE 66 "./src-ag/GenerateCode.ag" #-} genLinePragmas _lhsIoptions- {-# LINE 435 "dist/build/GenerateCode.hs"#-}+ {-# LINE 436 "dist/build/GenerateCode.hs"#-} {-# INLINE rule15 #-} {-# LINE 67 "./src-ag/GenerateCode.ag" #-} rule15 = \ ((_lhsIoptions) :: Options) -> {-# LINE 67 "./src-ag/GenerateCode.ag" #-} monadic _lhsIoptions- {-# LINE 441 "dist/build/GenerateCode.hs"#-}+ {-# LINE 442 "dist/build/GenerateCode.hs"#-} {-# INLINE rule16 #-} {-# LINE 68 "./src-ag/GenerateCode.ag" #-} rule16 = \ ((_lhsIoptions) :: Options) -> {-# LINE 68 "./src-ag/GenerateCode.ag" #-} clean _lhsIoptions- {-# LINE 447 "dist/build/GenerateCode.hs"#-}+ {-# LINE 448 "dist/build/GenerateCode.hs"#-} {-# INLINE rule17 #-} {-# LINE 71 "./src-ag/GenerateCode.ag" #-} rule17 = \ ((_lhsIoptions) :: Options) multivisit_ -> {-# LINE 71 "./src-ag/GenerateCode.ag" #-} _lhsIoptions { breadthFirst = breadthFirst _lhsIoptions && visit _lhsIoptions && cases _lhsIoptions && multivisit_ }- {-# LINE 453 "dist/build/GenerateCode.hs"#-}+ {-# LINE 454 "dist/build/GenerateCode.hs"#-} {-# INLINE rule18 #-} {-# LINE 76 "./src-ag/GenerateCode.ag" #-} rule18 = \ pragmas_ -> {-# LINE 76 "./src-ag/GenerateCode.ag" #-} pragmas_- {-# LINE 459 "dist/build/GenerateCode.hs"#-}+ {-# LINE 460 "dist/build/GenerateCode.hs"#-} {-# INLINE rule19 #-} {-# LINE 98 "./src-ag/GenerateCode.ag" #-} rule19 = \ paramMap_ -> {-# LINE 98 "./src-ag/GenerateCode.ag" #-} paramMap_- {-# LINE 465 "dist/build/GenerateCode.hs"#-}+ {-# LINE 466 "dist/build/GenerateCode.hs"#-} {-# INLINE rule20 #-} {-# LINE 120 "./src-ag/GenerateCode.ag" #-} rule20 = \ contextMap_ -> {-# LINE 120 "./src-ag/GenerateCode.ag" #-} contextMap_- {-# LINE 471 "dist/build/GenerateCode.hs"#-}+ {-# LINE 472 "dist/build/GenerateCode.hs"#-} {-# INLINE rule21 #-} {-# LINE 121 "./src-ag/GenerateCode.ag" #-} rule21 = \ quantMap_ -> {-# LINE 121 "./src-ag/GenerateCode.ag" #-} quantMap_- {-# LINE 477 "dist/build/GenerateCode.hs"#-}+ {-# LINE 478 "dist/build/GenerateCode.hs"#-} {-# INLINE rule22 #-} {-# LINE 137 "./src-ag/GenerateCode.ag" #-} rule22 = \ ((_nontsIgathNts) :: Set NontermIdent) -> {-# LINE 137 "./src-ag/GenerateCode.ag" #-} _nontsIgathNts- {-# LINE 483 "dist/build/GenerateCode.hs"#-}+ {-# LINE 484 "dist/build/GenerateCode.hs"#-} {-# INLINE rule23 #-} {-# LINE 587 "./src-ag/GenerateCode.ag" #-} rule23 = \ aroundsMap_ -> {-# LINE 587 "./src-ag/GenerateCode.ag" #-} aroundsMap_- {-# LINE 489 "dist/build/GenerateCode.hs"#-}+ {-# LINE 490 "dist/build/GenerateCode.hs"#-} {-# INLINE rule24 #-} {-# LINE 603 "./src-ag/GenerateCode.ag" #-} rule24 = \ mergeMap_ -> {-# LINE 603 "./src-ag/GenerateCode.ag" #-} mergeMap_- {-# LINE 495 "dist/build/GenerateCode.hs"#-}+ {-# LINE 496 "dist/build/GenerateCode.hs"#-} {-# INLINE rule25 #-} {-# LINE 760 "./src-ag/GenerateCode.ag" #-} rule25 = \ ((_lhsIoptions) :: Options) ((_nontsIsemDomUnfoldGath) :: Map (NontermIdent, Int) ([String], Code.Type)) ->@@ -501,43 +502,43 @@ replMap = Map.fromList (zip params repl) replace k = Map.findWithDefault ('@':k) k replMap in evalType _lhsIoptions replace tp- {-# LINE 505 "dist/build/GenerateCode.hs"#-}+ {-# LINE 506 "dist/build/GenerateCode.hs"#-} {-# INLINE rule26 #-}- {-# LINE 860 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 861 "./src-ag/GenerateCode.ag" #-} rule26 = \ ((_lhsIoptions) :: Options) ->- {-# LINE 860 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 861 "./src-ag/GenerateCode.ag" #-} typeSigs _lhsIoptions- {-# LINE 511 "dist/build/GenerateCode.hs"#-}+ {-# LINE 512 "dist/build/GenerateCode.hs"#-} {-# INLINE rule27 #-}- {-# LINE 863 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 864 "./src-ag/GenerateCode.ag" #-} rule27 = \ (_ :: ()) ->- {-# LINE 863 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 864 "./src-ag/GenerateCode.ag" #-} Seq.empty- {-# LINE 517 "dist/build/GenerateCode.hs"#-}+ {-# LINE 518 "dist/build/GenerateCode.hs"#-} {-# INLINE rule28 #-}- {-# LINE 932 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 933 "./src-ag/GenerateCode.ag" #-} rule28 = \ ((_nontsIchunks) :: Chunks) multivisit_ ->- {-# LINE 932 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 933 "./src-ag/GenerateCode.ag" #-} Program _nontsIchunks multivisit_- {-# LINE 523 "dist/build/GenerateCode.hs"#-}+ {-# LINE 524 "dist/build/GenerateCode.hs"#-} {-# INLINE rule29 #-}- {-# LINE 1000 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1001 "./src-ag/GenerateCode.ag" #-} rule29 = \ typeSyns_ ->- {-# LINE 1000 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1001 "./src-ag/GenerateCode.ag" #-} typeSyns_- {-# LINE 529 "dist/build/GenerateCode.hs"#-}+ {-# LINE 530 "dist/build/GenerateCode.hs"#-} {-# INLINE rule30 #-}- {-# LINE 1001 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1002 "./src-ag/GenerateCode.ag" #-} rule30 = \ derivings_ ->- {-# LINE 1001 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1002 "./src-ag/GenerateCode.ag" #-} derivings_- {-# LINE 535 "dist/build/GenerateCode.hs"#-}+ {-# LINE 536 "dist/build/GenerateCode.hs"#-} {-# INLINE rule31 #-}- {-# LINE 1002 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1003 "./src-ag/GenerateCode.ag" #-} rule31 = \ wrappers_ ->- {-# LINE 1002 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1003 "./src-ag/GenerateCode.ag" #-} wrappers_- {-# LINE 541 "dist/build/GenerateCode.hs"#-}+ {-# LINE 542 "dist/build/GenerateCode.hs"#-} {-# INLINE rule32 #-} rule32 = \ _aroundMap -> _aroundMap@@ -629,13 +630,13 @@ rule36 = \ (_ :: ()) -> {-# LINE 286 "./src-ag/GenerateCode.ag" #-} 0- {-# LINE 633 "dist/build/GenerateCode.hs"#-}+ {-# LINE 634 "dist/build/GenerateCode.hs"#-} {-# INLINE rule37 #-} {-# LINE 717 "./src-ag/GenerateCode.ag" #-} rule37 = \ ((_segIsemDom) :: [Decl]) -> {-# LINE 717 "./src-ag/GenerateCode.ag" #-} Comment "semantic domain" : _segIsemDom- {-# LINE 639 "dist/build/GenerateCode.hs"#-}+ {-# LINE 640 "dist/build/GenerateCode.hs"#-} {-# INLINE rule38 #-} rule38 = \ ((_segIcomments) :: [String]) -> _segIcomments@@ -823,35 +824,35 @@ rule63 = \ inh_ nt_ syn_ -> {-# LINE 86 "./src-ag/GenerateCode.ag" #-} (inh_,syn_,nt_)- {-# LINE 827 "dist/build/GenerateCode.hs"#-}+ {-# LINE 828 "dist/build/GenerateCode.hs"#-} {-# INLINE rule64 #-} {-# LINE 87 "./src-ag/GenerateCode.ag" #-} rule64 = \ inh_ nt_ syn_ -> {-# LINE 87 "./src-ag/GenerateCode.ag" #-} (inh_,syn_,nt_)- {-# LINE 833 "dist/build/GenerateCode.hs"#-}+ {-# LINE 834 "dist/build/GenerateCode.hs"#-} {-# INLINE rule65 #-} {-# LINE 143 "./src-ag/GenerateCode.ag" #-} rule65 = \ nt_ -> {-# LINE 143 "./src-ag/GenerateCode.ag" #-} Set.singleton nt_- {-# LINE 839 "dist/build/GenerateCode.hs"#-}+ {-# LINE 840 "dist/build/GenerateCode.hs"#-} {-# INLINE rule66 #-} {-# LINE 588 "./src-ag/GenerateCode.ag" #-} rule66 = \ ((_lhsIaroundMap) :: Map NontermIdent (Map ConstructorIdent (Set Identifier))) nt_ -> {-# LINE 588 "./src-ag/GenerateCode.ag" #-} Map.findWithDefault Map.empty nt_ _lhsIaroundMap- {-# LINE 845 "dist/build/GenerateCode.hs"#-}+ {-# LINE 846 "dist/build/GenerateCode.hs"#-} {-# INLINE rule67 #-} {-# LINE 604 "./src-ag/GenerateCode.ag" #-} rule67 = \ ((_lhsImergeMap) :: Map NontermIdent (Map ConstructorIdent (Map Identifier (Identifier, [Identifier])))) nt_ -> {-# LINE 604 "./src-ag/GenerateCode.ag" #-} Map.findWithDefault Map.empty nt_ _lhsImergeMap- {-# LINE 851 "dist/build/GenerateCode.hs"#-}+ {-# LINE 852 "dist/build/GenerateCode.hs"#-} {-# INLINE rule68 #-}- {-# LINE 809 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 810 "./src-ag/GenerateCode.ag" #-} rule68 = \ ((_interIwrapDecls) :: Decls) ((_lhsIo_newtypes) :: Bool) ((_lhsIo_strictwrap) :: Bool) ((_lhsIoptions) :: Options) inh_ nt_ params_ syn_ ->- {-# LINE 809 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 810 "./src-ag/GenerateCode.ag" #-} let params' = map getName params_ inhAttrs = Map.toList inh_ synAttrs = Map.toList syn_@@ -876,17 +877,17 @@ (Let _interIwrapDecls (App synNT synVars)) Set.empty Set.empty ]- {-# LINE 880 "dist/build/GenerateCode.hs"#-}+ {-# LINE 881 "dist/build/GenerateCode.hs"#-} {-# INLINE rule69 #-}- {-# LINE 870 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 871 "./src-ag/GenerateCode.ag" #-} rule69 = \ ((_interIcomments) :: [String]) ((_prodsIcomments) :: [String]) ->- {-# LINE 870 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 871 "./src-ag/GenerateCode.ag" #-} Comment . unlines . map ind $ ( _interIcomments ++ ("alternatives:" : map ind _prodsIcomments) )- {-# LINE 886 "dist/build/GenerateCode.hs"#-}+ {-# LINE 887 "dist/build/GenerateCode.hs"#-} {-# INLINE rule70 #-}- {-# LINE 935 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 936 "./src-ag/GenerateCode.ag" #-} rule70 = \ _cataFun _comment _dataDef _genCata ((_interIsemDom) :: [Decl]) ((_lhsIo_cata) :: Bool) ((_lhsIo_data) :: Maybe Bool) ((_lhsIo_pretty) :: Bool) ((_lhsIo_sem) :: Bool) ((_lhsIo_sig) :: Bool) ((_lhsIwrappers) :: Set NontermIdent) ((_prodsIdecls) :: Decls) ((_prodsIsemNames) :: [String]) _semWrapper nt_ ->- {-# LINE 935 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 936 "./src-ag/GenerateCode.ag" #-} [ Chunk (getName nt_) (Comment (getName nt_ ++ " " ++ replicate (60 - length (getName nt_)) '-')) (if _lhsIo_pretty then [_comment ] else [])@@ -897,11 +898,11 @@ (if _lhsIo_sem then _prodsIdecls else []) (if _lhsIo_sem then _prodsIsemNames else []) ]- {-# LINE 901 "dist/build/GenerateCode.hs"#-}+ {-# LINE 902 "dist/build/GenerateCode.hs"#-} {-# INLINE rule71 #-}- {-# LINE 1005 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1006 "./src-ag/GenerateCode.ag" #-} rule71 = \ ((_lhsIderivings) :: Derivings) ((_lhsIo_data) :: Maybe Bool) ((_lhsIoptions) :: Options) ((_lhsItypeSyns) :: TypeSyns) ((_prodsIdataAlts) :: DataAlts) nt_ params_ ->- {-# LINE 1005 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1006 "./src-ag/GenerateCode.ag" #-} let params' = map getName params_ typeSyn tp = let theType = case tp of@@ -911,22 +912,23 @@ CommonTypes.IntMap t -> TIntMap $ typeToCodeType (Just nt_) params' t CommonTypes.List t -> Code.List $ typeToCodeType (Just nt_) params' t CommonTypes.Tuple ts -> Code.TupleType [typeToCodeType (Just nt_) params' t | (_,t) <- ts ]- tp' -> error $ show tp' ++ " not supported"+ CommonTypes.OrdSet t -> TSet $ typeToCodeType (Just nt_) params' t+ CommonTypes.IntSet -> TIntSet in Code.Type (getName nt_) params' (idEvalType _lhsIoptions theType) derivings = maybe [] (map getName . Set.toList) (Map.lookup nt_ _lhsIderivings) dataDef = Data (getName nt_) (map getName params_) _prodsIdataAlts (maybe False id _lhsIo_data) derivings in maybe dataDef typeSyn $ lookup nt_ _lhsItypeSyns- {-# LINE 920 "dist/build/GenerateCode.hs"#-}+ {-# LINE 922 "dist/build/GenerateCode.hs"#-} {-# INLINE rule72 #-}- {-# LINE 1048 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1050 "./src-ag/GenerateCode.ag" #-} rule72 = \ ((_lhsIoptions) :: Options) nt_ ->- {-# LINE 1048 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1050 "./src-ag/GenerateCode.ag" #-} not (nt_ `Set.member` nocatas _lhsIoptions)- {-# LINE 926 "dist/build/GenerateCode.hs"#-}+ {-# LINE 928 "dist/build/GenerateCode.hs"#-} {-# INLINE rule73 #-}- {-# LINE 1049 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1051 "./src-ag/GenerateCode.ag" #-} rule73 = \ ((_lhsIcontextMap) :: ContextMap) ((_lhsIo_sig) :: Bool) ((_lhsIoptions) :: Options) ((_lhsIprefix) :: String) ((_lhsIquantMap) :: QuantMap) ((_lhsItypeSyns) :: TypeSyns) ((_prodsIcataAlts) :: Decls) nt_ params_ ->- {-# LINE 1049 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1051 "./src-ag/GenerateCode.ag" #-} let appParams nm = TypeApp (SimpleType nm) (map SimpleType (map getName params_)) evalTp | null params_ = id | otherwise = idEvalType _lhsIoptions@@ -1005,11 +1007,28 @@ lhs = Fun (cataname _lhsIprefix nt_) [TupleExpr (map fst tps')] rhs = App con rargs in [Decl lhs rhs Set.empty Set.empty]- _ -> error "TODO"+ CommonTypes.OrdSet tp ->+ let entry = SimpleExpr (semname _lhsIprefix nt_ (identifier "Entry"))+ nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil" ))+ arg = SimpleExpr "set"+ rentry = case tp of+ NT t _ _ -> let t' = maybe t id (deforestedNt t)+ in App "(.)" [entry, SimpleExpr $ cataname _lhsIprefix t']+ _ -> entry+ lhs = Fun (cataname _lhsIprefix nt_) [arg]+ rhs = (App "Data.Set.foldr" [rentry,nil,arg])+ in [Decl lhs rhs Set.empty Set.empty]+ CommonTypes.IntSet ->+ let entry = SimpleExpr (semname _lhsIprefix nt_ (identifier "Entry"))+ nil = SimpleExpr (semname _lhsIprefix nt_ (identifier "Nil" ))+ arg = SimpleExpr "set"+ lhs = Fun (cataname _lhsIprefix nt_) [arg]+ rhs = (App "Data.IntSet.foldr" [entry,nil,arg])+ in [Decl lhs rhs Set.empty Set.empty] in Comment "cata" : (if _lhsIo_sig then [tSig] else []) ++ maybe _prodsIcataAlts special (lookup nt_ _lhsItypeSyns)- {-# LINE 1013 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1032 "dist/build/GenerateCode.hs"#-} {-# INLINE rule74 #-} rule74 = \ ((_interIsemDomUnfoldGath) :: Map (NontermIdent, Int) ([String], Code.Type)) -> _interIsemDomUnfoldGath@@ -1580,91 +1599,91 @@ rule188 = \ con_ -> {-# LINE 92 "./src-ag/GenerateCode.ag" #-} con_- {-# LINE 1584 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1603 "dist/build/GenerateCode.hs"#-} {-# INLINE rule189 #-} {-# LINE 93 "./src-ag/GenerateCode.ag" #-} rule189 = \ terminals_ -> {-# LINE 93 "./src-ag/GenerateCode.ag" #-} terminals_- {-# LINE 1590 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1609 "dist/build/GenerateCode.hs"#-} {-# INLINE rule190 #-} {-# LINE 105 "./src-ag/GenerateCode.ag" #-} rule190 = \ ((_lhsIoptions) :: Options) children_ -> {-# LINE 105 "./src-ag/GenerateCode.ag" #-} Map.fromList [(nm, (extractNonterminal tp, tps)) | (nm,tp,_) <- children_, let tps = map (cleanupArg _lhsIoptions) $ nontermArgs tp, not (null tps) ]- {-# LINE 1596 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1615 "dist/build/GenerateCode.hs"#-} {-# INLINE rule191 #-} {-# LINE 147 "./src-ag/GenerateCode.ag" #-} rule191 = \ (_ :: ()) -> {-# LINE 147 "./src-ag/GenerateCode.ag" #-} Set.empty- {-# LINE 1602 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1621 "dist/build/GenerateCode.hs"#-} {-# INLINE rule192 #-} {-# LINE 282 "./src-ag/GenerateCode.ag" #-} rule192 = \ (_ :: ()) -> {-# LINE 282 "./src-ag/GenerateCode.ag" #-} 0- {-# LINE 1608 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1627 "dist/build/GenerateCode.hs"#-} {-# INLINE rule193 #-} {-# LINE 414 "./src-ag/GenerateCode.ag" #-} rule193 = \ children_ -> {-# LINE 414 "./src-ag/GenerateCode.ag" #-} children_- {-# LINE 1614 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1633 "dist/build/GenerateCode.hs"#-} {-# INLINE rule194 #-} {-# LINE 569 "./src-ag/GenerateCode.ag" #-} rule194 = \ ((_visitsIgatherInstVisitNrs) :: Map Identifier Int) -> {-# LINE 569 "./src-ag/GenerateCode.ag" #-} _visitsIgatherInstVisitNrs- {-# LINE 1620 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1639 "dist/build/GenerateCode.hs"#-} {-# INLINE rule195 #-} {-# LINE 589 "./src-ag/GenerateCode.ag" #-} rule195 = \ ((_lhsIaroundMap) :: Map ConstructorIdent (Set Identifier)) con_ -> {-# LINE 589 "./src-ag/GenerateCode.ag" #-} Map.findWithDefault Set.empty con_ _lhsIaroundMap- {-# LINE 1626 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1645 "dist/build/GenerateCode.hs"#-} {-# INLINE rule196 #-} {-# LINE 605 "./src-ag/GenerateCode.ag" #-} rule196 = \ ((_lhsImergeMap) :: Map ConstructorIdent (Map Identifier (Identifier, [Identifier]))) con_ -> {-# LINE 605 "./src-ag/GenerateCode.ag" #-} Map.findWithDefault Map.empty con_ _lhsImergeMap- {-# LINE 1632 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1651 "dist/build/GenerateCode.hs"#-} {-# INLINE rule197 #-}- {-# LINE 885 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 886 "./src-ag/GenerateCode.ag" #-} rule197 = \ children_ ->- {-# LINE 885 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 886 "./src-ag/GenerateCode.ag" #-} [ (nm,fromJust mb,virt) | (nm,tp,virt) <- children_, let mb = isFirstOrder virt tp, isJust mb ]- {-# LINE 1638 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1657 "dist/build/GenerateCode.hs"#-} {-# INLINE rule198 #-}- {-# LINE 886 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 887 "./src-ag/GenerateCode.ag" #-} rule198 = \ _firstOrderChildren ((_visitsIcomments) :: [String]) con_ ->- {-# LINE 886 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 887 "./src-ag/GenerateCode.ag" #-} ("alternative " ++ getName con_ ++ ":") : map ind ( map (\(x,y,_) -> makeLocalComment 14 "child" x (Just y)) _firstOrderChildren ++ _visitsIcomments )- {-# LINE 1647 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1666 "dist/build/GenerateCode.hs"#-} {-# INLINE rule199 #-}- {-# LINE 1028 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1030 "./src-ag/GenerateCode.ag" #-} rule199 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) ->- {-# LINE 1028 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1030 "./src-ag/GenerateCode.ag" #-} map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap- {-# LINE 1653 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1672 "dist/build/GenerateCode.hs"#-} {-# INLINE rule200 #-}- {-# LINE 1029 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1031 "./src-ag/GenerateCode.ag" #-} rule200 = \ _firstOrderChildren ((_lhsInt) :: NontermIdent) ((_lhsIo_rename) :: Bool) ((_lhsIoptions) :: Options) _params con_ ->- {-# LINE 1029 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1031 "./src-ag/GenerateCode.ag" #-} let conNm = conname _lhsIo_rename _lhsInt con_ mkFields :: (NontermIdent -> ConstructorIdent -> Identifier -> Code.Type -> a) -> [a] mkFields f = map (\(nm,t,_) -> f _lhsInt con_ nm (typeToCodeType (Just _lhsInt) _params $ removeDeforested t)) _firstOrderChildren in if dataRecords _lhsIoptions then Record conNm $ mkFields $ toNamedType (strictData _lhsIoptions) else DataAlt conNm $ mkFields $ \_ _ _ t -> t- {-# LINE 1664 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1683 "dist/build/GenerateCode.hs"#-} {-# INLINE rule201 #-}- {-# LINE 1142 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1161 "./src-ag/GenerateCode.ag" #-} rule201 = \ _firstOrderChildren ((_lhsInt) :: NontermIdent) ((_lhsIo_rename) :: Bool) ((_lhsIoptions) :: Options) ((_lhsIprefix) :: String) con_ ->- {-# LINE 1142 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1161 "./src-ag/GenerateCode.ag" #-} let lhs = Fun (cataname _lhsIprefix _lhsInt) [lhs_pat] lhs_pat = App (conname _lhsIo_rename _lhsInt con_) (map (\(n,_,_) -> SimpleExpr $ locname _lhsIoptions $ n) _firstOrderChildren )@@ -1674,7 +1693,7 @@ [SimpleExpr (locname _lhsIoptions nm)] argument (nm, _,_) = SimpleExpr (locname _lhsIoptions nm) in Decl lhs rhs Set.empty Set.empty- {-# LINE 1678 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1697 "dist/build/GenerateCode.hs"#-} {-# INLINE rule202 #-} rule202 = \ ((_visitsIdecls) :: Decls) -> _visitsIdecls@@ -1895,17 +1914,17 @@ in __result_ ) in C_CProductions_s17 v16 {-# INLINE rule236 #-}- {-# LINE 1024 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1026 "./src-ag/GenerateCode.ag" #-} rule236 = \ ((_hdIdataAlt) :: DataAlt) ((_tlIdataAlts) :: DataAlts) ->- {-# LINE 1024 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1026 "./src-ag/GenerateCode.ag" #-} _hdIdataAlt : _tlIdataAlts- {-# LINE 1903 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1922 "dist/build/GenerateCode.hs"#-} {-# INLINE rule237 #-}- {-# LINE 1138 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1157 "./src-ag/GenerateCode.ag" #-} rule237 = \ ((_hdIcataAlt) :: Decl) ((_tlIcataAlts) :: Decls) ->- {-# LINE 1138 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1157 "./src-ag/GenerateCode.ag" #-} _hdIcataAlt : _tlIcataAlts- {-# LINE 1909 "dist/build/GenerateCode.hs"#-}+ {-# LINE 1928 "dist/build/GenerateCode.hs"#-} {-# INLINE rule238 #-} rule238 = \ ((_hdIcomments) :: [String]) ((_tlIcomments) :: [String]) -> _hdIcomments ++ _tlIcomments@@ -2122,17 +2141,17 @@ in __result_ ) in C_CProductions_s17 v16 {-# INLINE rule303 #-}- {-# LINE 1025 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1027 "./src-ag/GenerateCode.ag" #-} rule303 = \ (_ :: ()) ->- {-# LINE 1025 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1027 "./src-ag/GenerateCode.ag" #-} []- {-# LINE 2130 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2149 "dist/build/GenerateCode.hs"#-} {-# INLINE rule304 #-}- {-# LINE 1139 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1158 "./src-ag/GenerateCode.ag" #-} rule304 = \ (_ :: ()) ->- {-# LINE 1139 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1158 "./src-ag/GenerateCode.ag" #-} []- {-# LINE 2136 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2155 "dist/build/GenerateCode.hs"#-} {-# INLINE rule305 #-} rule305 = \ (_ :: ()) -> []@@ -2227,7 +2246,7 @@ rule308 = \ ((_lhsIchildren) :: [(Identifier,Type,ChildKind)]) -> {-# LINE 158 "./src-ag/GenerateCode.ag" #-} [ (n, (t, mb, for)) | (n, NT t _ for, mb) <- _lhsIchildren ]- {-# LINE 2231 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2250 "dist/build/GenerateCode.hs"#-} {-# INLINE rule309 #-} {-# LINE 159 "./src-ag/GenerateCode.ag" #-} rule309 = \ ((_lhsIo_pretty) :: Bool) origin_ ->@@ -2235,7 +2254,7 @@ if _lhsIo_pretty then (Comment origin_:) else id- {-# LINE 2239 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2258 "dist/build/GenerateCode.hs"#-} {-# INLINE rule310 #-} {-# LINE 162 "./src-ag/GenerateCode.ag" #-} rule310 = \ _definedInsts _instTypes ((_lhsIo_monadic) :: Bool) ((_lhsIo_newtypes) :: Bool) ((_lhsIoptions) :: Options) ((_lhsIprefix) :: String) ->@@ -2257,7 +2276,7 @@ , let instLocFieldName = attrname _lhsIoptions True _INST inst instSemFieldName = attrname _lhsIoptions False _INST' inst ]- {-# LINE 2261 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2280 "dist/build/GenerateCode.hs"#-} {-# INLINE rule311 #-} {-# LINE 179 "./src-ag/GenerateCode.ag" #-} rule311 = \ ((_patternIpatternAttributes) :: [(Identifier, Identifier)]) isIn_ ->@@ -2265,13 +2284,13 @@ if isIn_ then "_" else concat $ intersperse "," (map (\(f,a) -> show f ++ "." ++ show a) _patternIpatternAttributes)- {-# LINE 2269 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2288 "dist/build/GenerateCode.hs"#-} {-# INLINE rule312 #-} {-# LINE 182 "./src-ag/GenerateCode.ag" #-} rule312 = \ _patDescr con_ mbNamed_ nt_ -> {-# LINE 182 "./src-ag/GenerateCode.ag" #-} (maybe "" (\nm -> show nm ++ ":") mbNamed_) ++ show nt_ ++ " :: " ++ show con_ ++ " :: " ++ _patDescr- {-# LINE 2275 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2294 "dist/build/GenerateCode.hs"#-} {-# INLINE rule313 #-} {-# LINE 184 "./src-ag/GenerateCode.ag" #-} rule313 = \ ((_lhsIo_traces) :: Bool) _traceDescr ->@@ -2279,13 +2298,13 @@ \v -> if _lhsIo_traces then Trace _traceDescr v else v- {-# LINE 2283 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2302 "dist/build/GenerateCode.hs"#-} {-# INLINE rule314 #-} {-# LINE 187 "./src-ag/GenerateCode.ag" #-} rule314 = \ _patDescr con_ nt_ -> {-# LINE 187 "./src-ag/GenerateCode.ag" #-} show nt_ ++ ":" ++ show con_ ++ ":" ++ _patDescr- {-# LINE 2289 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2308 "dist/build/GenerateCode.hs"#-} {-# INLINE rule315 #-} {-# LINE 188 "./src-ag/GenerateCode.ag" #-} rule315 = \ _costCentreDescr ((_lhsIo_costcentre) :: Bool) ->@@ -2293,7 +2312,7 @@ \v -> if _lhsIo_costcentre then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v else v- {-# LINE 2297 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2316 "dist/build/GenerateCode.hs"#-} {-# INLINE rule316 #-} {-# LINE 191 "./src-ag/GenerateCode.ag" #-} rule316 = \ ((_lhsIo_linePragmas) :: Bool) name_ ->@@ -2305,7 +2324,7 @@ $ LineExpr $ v else v- {-# LINE 2309 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2328 "dist/build/GenerateCode.hs"#-} {-# INLINE rule317 #-} {-# LINE 198 "./src-ag/GenerateCode.ag" #-} rule317 = \ _addCostCentre _addLinePragma _addTrace _instDecls ((_lhsIo_monadic) :: Bool) ((_lhsIoptions) :: Options) _originComment ((_patternIcopy) :: Pattern) defines_ explicit_ hasCode_ rhs_ uses_ ->@@ -2316,13 +2335,13 @@ (Set.fromList [attrname _lhsIoptions True fld nm | (fld,nm) <- Set.toList uses_]) : _instDecls ) else _instDecls- {-# LINE 2320 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2339 "dist/build/GenerateCode.hs"#-} {-# INLINE rule318 #-} {-# LINE 268 "./src-ag/GenerateCode.ag" #-} rule318 = \ ((_patternIdefinedInsts) :: [Identifier]) isIn_ -> {-# LINE 268 "./src-ag/GenerateCode.ag" #-} if isIn_ then [] else _patternIdefinedInsts- {-# LINE 2326 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2345 "dist/build/GenerateCode.hs"#-} {-# INLINE rule319 #-} {-# LINE 338 "./src-ag/GenerateCode.ag" #-} rule319 = \ ((_lhsIoptions) :: Options) ((_lhsIterminals) :: [Identifier]) field_ isIn_ name_ ->@@ -2330,25 +2349,25 @@ if field_ == _LOC && name_ `elem` _lhsIterminals then funname name_ 0 else attrname _lhsIoptions isIn_ field_ name_- {-# LINE 2334 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2353 "dist/build/GenerateCode.hs"#-} {-# INLINE rule320 #-} {-# LINE 341 "./src-ag/GenerateCode.ag" #-} rule320 = \ _rulename -> {-# LINE 341 "./src-ag/GenerateCode.ag" #-} [SimpleExpr _rulename ]- {-# LINE 2340 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2359 "dist/build/GenerateCode.hs"#-} {-# INLINE rule321 #-} {-# LINE 357 "./src-ag/GenerateCode.ag" #-} rule321 = \ _rulename -> {-# LINE 357 "./src-ag/GenerateCode.ag" #-} Set.singleton _rulename- {-# LINE 2346 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2365 "dist/build/GenerateCode.hs"#-} {-# INLINE rule322 #-} {-# LINE 367 "./src-ag/GenerateCode.ag" #-} rule322 = \ ((_lhsInt) :: NontermIdent) _orgParams -> {-# LINE 367 "./src-ag/GenerateCode.ag" #-} typeToCodeType (Just _lhsInt) _orgParams- {-# LINE 2352 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2371 "dist/build/GenerateCode.hs"#-} {-# INLINE rule323 #-} {-# LINE 368 "./src-ag/GenerateCode.ag" #-} rule323 = \ _evalTp ((_lhsIchildren) :: [(Identifier,Type,ChildKind)]) ((_lhsIoptions) :: Options) _mkTp defines_ ->@@ -2367,13 +2386,13 @@ _ -> Nothing | otherwise = findOrigType nm r ]- {-# LINE 2371 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2390 "dist/build/GenerateCode.hs"#-} {-# INLINE rule324 #-} {-# LINE 383 "./src-ag/GenerateCode.ag" #-} rule324 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) -> {-# LINE 383 "./src-ag/GenerateCode.ag" #-} map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap- {-# LINE 2377 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2396 "dist/build/GenerateCode.hs"#-} {-# INLINE rule325 #-} {-# LINE 385 "./src-ag/GenerateCode.ag" #-} rule325 = \ ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) ((_lhsIparamInstMap) :: Map Identifier (NontermIdent, [String])) ((_lhsIparamMap) :: ParamMap) _orgParams ->@@ -2387,32 +2406,32 @@ then tp else idEvalType _lhsIoptions tp else evalType _lhsIoptions replace tp- {-# LINE 2391 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2410 "dist/build/GenerateCode.hs"#-} {-# INLINE rule326 #-} {-# LINE 420 "./src-ag/GenerateCode.ag" #-} rule326 = \ tp_ -> {-# LINE 420 "./src-ag/GenerateCode.ag" #-} maybe ([],False) (\tp -> ([tp],True)) tp_- {-# LINE 2397 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2416 "dist/build/GenerateCode.hs"#-} {-# INLINE rule327 #-} {-# LINE 621 "./src-ag/GenerateCode.ag" #-} rule327 = \ _decls ((_lhsIdeclsAbove) :: [Decl]) -> {-# LINE 621 "./src-ag/GenerateCode.ag" #-} _lhsIdeclsAbove ++ _decls- {-# LINE 2403 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2422 "dist/build/GenerateCode.hs"#-} {-# INLINE rule328 #-} {-# LINE 634 "./src-ag/GenerateCode.ag" #-} rule328 = \ (_ :: ()) -> {-# LINE 634 "./src-ag/GenerateCode.ag" #-} id- {-# LINE 2409 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2428 "dist/build/GenerateCode.hs"#-} {-# INLINE rule329 #-}- {-# LINE 909 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 910 "./src-ag/GenerateCode.ag" #-} rule329 = \ ((_lhsIwhat) :: String) defines_ ->- {-# LINE 909 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 910 "./src-ag/GenerateCode.ag" #-} [ makeLocalComment 11 _lhsIwhat name tp | (field,name,tp) <- Map.elems defines_, field == _LOC ] ++ [ makeLocalComment 11 "inst " name tp | (field,name,tp) <- Map.elems defines_, field == _INST ]- {-# LINE 2416 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2435 "dist/build/GenerateCode.hs"#-} {-# INLINE rule330 #-} rule330 = \ _decls -> _decls@@ -2473,13 +2492,13 @@ rule333 = \ ((_lhsIvisitedSet) :: Set Identifier) name_ -> {-# LINE 148 "./src-ag/GenerateCode.ag" #-} Set.insert name_ _lhsIvisitedSet- {-# LINE 2477 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2496 "dist/build/GenerateCode.hs"#-} {-# INLINE rule334 #-} {-# LINE 204 "./src-ag/GenerateCode.ag" #-} rule334 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) name_ nr_ nt_ -> {-# LINE 204 "./src-ag/GenerateCode.ag" #-} show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show name_ ++ ":" ++ show nt_ ++ ":" ++ show nr_- {-# LINE 2483 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2502 "dist/build/GenerateCode.hs"#-} {-# INLINE rule335 #-} {-# LINE 205 "./src-ag/GenerateCode.ag" #-} rule335 = \ _costCentreDescr ((_lhsIo_costcentre) :: Bool) ->@@ -2487,7 +2506,7 @@ \v -> if _lhsIo_costcentre then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v else v- {-# LINE 2491 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2510 "dist/build/GenerateCode.hs"#-} {-# INLINE rule336 #-} {-# LINE 208 "./src-ag/GenerateCode.ag" #-} rule336 = \ _addCostCentre ((_lhsIaroundMap) :: Set Identifier) ((_lhsIchildren) :: [(Identifier,Type,ChildKind)]) ((_lhsImergeMap) :: Map Identifier (Identifier, [Identifier])) ((_lhsIo_monadic) :: Bool) ((_lhsIo_newtypes) :: Bool) ((_lhsIo_unbox) :: Bool) ((_lhsIoptions) :: Options) _visitedSet inh_ isLast_ name_ nr_ nt_ syn_ ->@@ -2530,13 +2549,13 @@ in [Resume _lhsIo_monadic (typeName nt_ nr_) tuple' rhs'] in (outDecls ++ outMerged)- {-# LINE 2534 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2553 "dist/build/GenerateCode.hs"#-} {-# INLINE rule337 #-} {-# LINE 330 "./src-ag/GenerateCode.ag" #-} rule337 = \ ((_lhsIinstVisitNrs) :: Map Identifier Int) ((_lhsInr) :: Int) name_ -> {-# LINE 330 "./src-ag/GenerateCode.ag" #-} _lhsInr <= Map.findWithDefault (-1) name_ _lhsIinstVisitNrs- {-# LINE 2540 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2559 "dist/build/GenerateCode.hs"#-} {-# INLINE rule338 #-} {-# LINE 343 "./src-ag/GenerateCode.ag" #-} rule338 = \ _isSuperfluousHigherOrderIntra name_ nr_ ->@@ -2544,7 +2563,7 @@ if _isSuperfluousHigherOrderIntra then [] else [funname name_ (nr_+1)]- {-# LINE 2548 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2567 "dist/build/GenerateCode.hs"#-} {-# INLINE rule339 #-} {-# LINE 347 "./src-ag/GenerateCode.ag" #-} rule339 = \ _instParams ((_lhsIo_newtypes) :: Bool) ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) _names nr_ nt_ ->@@ -2553,67 +2572,67 @@ addType expr | null _instParams = expr | otherwise = TypedExpr expr (_lhsIunfoldSemDom nt_ (nr_+1) _instParams ) in map (wrap . addType . SimpleExpr) _names- {-# LINE 2557 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2576 "dist/build/GenerateCode.hs"#-} {-# INLINE rule340 #-} {-# LINE 359 "./src-ag/GenerateCode.ag" #-} rule340 = \ _names -> {-# LINE 359 "./src-ag/GenerateCode.ag" #-} Set.fromList _names- {-# LINE 2563 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2582 "dist/build/GenerateCode.hs"#-} {-# INLINE rule341 #-} {-# LINE 395 "./src-ag/GenerateCode.ag" #-} rule341 = \ _evalTp _orgParams nt_ -> {-# LINE 395 "./src-ag/GenerateCode.ag" #-} _evalTp . typeToCodeType (Just nt_) _orgParams- {-# LINE 2569 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2588 "dist/build/GenerateCode.hs"#-} {-# INLINE rule342 #-} {-# LINE 396 "./src-ag/GenerateCode.ag" #-} rule342 = \ ((_lhsIoptions) :: Options) _mkTp name_ syn_ -> {-# LINE 396 "./src-ag/GenerateCode.ag" #-} [ TSig (attrname _lhsIoptions True name_ a) (_mkTp tp) | (a,tp) <- Map.toList syn_ ]- {-# LINE 2575 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2594 "dist/build/GenerateCode.hs"#-} {-# INLINE rule343 #-} {-# LINE 397 "./src-ag/GenerateCode.ag" #-} rule343 = \ nr_ nt_ -> {-# LINE 397 "./src-ag/GenerateCode.ag" #-} typeName nt_ (nr_+1)- {-# LINE 2581 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2600 "dist/build/GenerateCode.hs"#-} {-# INLINE rule344 #-} {-# LINE 398 "./src-ag/GenerateCode.ag" #-} rule344 = \ _definedTps _instParams _nextTp isLast_ name_ nr_ -> {-# LINE 398 "./src-ag/GenerateCode.ag" #-} (if isLast_ then id else (TSig (funname name_ (nr_+1)) (TypeApp (SimpleType _nextTp) (map SimpleType _instParams )) :)) _definedTps- {-# LINE 2587 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2606 "dist/build/GenerateCode.hs"#-} {-# INLINE rule345 #-} {-# LINE 400 "./src-ag/GenerateCode.ag" #-} rule345 = \ ((_lhsIparamMap) :: ParamMap) nt_ -> {-# LINE 400 "./src-ag/GenerateCode.ag" #-} map getName $ Map.findWithDefault [] nt_ _lhsIparamMap- {-# LINE 2593 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2612 "dist/build/GenerateCode.hs"#-} {-# INLINE rule346 #-} {-# LINE 401 "./src-ag/GenerateCode.ag" #-} rule346 = \ ((_lhsIparamInstMap) :: Map Identifier (NontermIdent, [String])) name_ nt_ -> {-# LINE 401 "./src-ag/GenerateCode.ag" #-} snd $ Map.findWithDefault (nt_,[]) name_ _lhsIparamInstMap- {-# LINE 2599 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2618 "dist/build/GenerateCode.hs"#-} {-# INLINE rule347 #-} {-# LINE 402 "./src-ag/GenerateCode.ag" #-} rule347 = \ _instParams _orgParams -> {-# LINE 402 "./src-ag/GenerateCode.ag" #-} Map.fromList (zip _orgParams _instParams )- {-# LINE 2605 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2624 "dist/build/GenerateCode.hs"#-} {-# INLINE rule348 #-} {-# LINE 403 "./src-ag/GenerateCode.ag" #-} rule348 = \ _replParamMap -> {-# LINE 403 "./src-ag/GenerateCode.ag" #-} \k -> Map.findWithDefault k k _replParamMap- {-# LINE 2611 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2630 "dist/build/GenerateCode.hs"#-} {-# INLINE rule349 #-} {-# LINE 404 "./src-ag/GenerateCode.ag" #-} rule349 = \ ((_lhsIoptions) :: Options) _orgParams _replace -> {-# LINE 404 "./src-ag/GenerateCode.ag" #-} if null _orgParams then id else evalType _lhsIoptions _replace- {-# LINE 2617 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2636 "dist/build/GenerateCode.hs"#-} {-# INLINE rule350 #-} {-# LINE 421 "./src-ag/GenerateCode.ag" #-} rule350 = \ _instParams _isSuperfluousHigherOrderIntra nr_ nt_ ->@@ -2621,19 +2640,19 @@ if _isSuperfluousHigherOrderIntra then [] else [NT (ntOfVisit nt_ (nr_+1)) _instParams False]- {-# LINE 2625 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2644 "dist/build/GenerateCode.hs"#-} {-# INLINE rule351 #-} {-# LINE 623 "./src-ag/GenerateCode.ag" #-} rule351 = \ (_ :: ()) -> {-# LINE 623 "./src-ag/GenerateCode.ag" #-} []- {-# LINE 2631 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2650 "dist/build/GenerateCode.hs"#-} {-# INLINE rule352 #-} {-# LINE 636 "./src-ag/GenerateCode.ag" #-} rule352 = \ _decls ((_lhsIdeclsAbove) :: [Decl]) -> {-# LINE 636 "./src-ag/GenerateCode.ag" #-} DeclBlock _lhsIdeclsAbove (head _decls )- {-# LINE 2637 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2656 "dist/build/GenerateCode.hs"#-} {-# INLINE rule353 #-} rule353 = \ (_ :: ()) -> True@@ -2718,7 +2737,7 @@ rule358 = \ ((_lhsIoptions) :: Options) -> {-# LINE 720 "./src-ag/GenerateCode.ag" #-} breadthFirst _lhsIoptions- {-# LINE 2722 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2741 "dist/build/GenerateCode.hs"#-} {-# INLINE rule359 #-} {-# LINE 721 "./src-ag/GenerateCode.ag" #-} rule359 = \ _altSemForm _indexExpr _inhTps _synTps ->@@ -2726,73 +2745,73 @@ if _altSemForm then TypeApp (SimpleType "Child") [SimpleType "EvalInfo", _indexExpr ] else foldr Arr _synTps _inhTps- {-# LINE 2730 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2749 "dist/build/GenerateCode.hs"#-} {-# INLINE rule360 #-} {-# LINE 724 "./src-ag/GenerateCode.ag" #-} rule360 = \ ((_lhsInt) :: NontermIdent) _params inh_ -> {-# LINE 724 "./src-ag/GenerateCode.ag" #-} [typeToCodeType (Just _lhsInt) _params tp | tp <- Map.elems inh_]- {-# LINE 2736 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2755 "dist/build/GenerateCode.hs"#-} {-# INLINE rule361 #-} {-# LINE 725 "./src-ag/GenerateCode.ag" #-} rule361 = \ _inhTps ((_lhsIo_unbox) :: Bool) -> {-# LINE 725 "./src-ag/GenerateCode.ag" #-} mkTupleType _lhsIo_unbox (null _inhTps ) _inhTps- {-# LINE 2742 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2761 "dist/build/GenerateCode.hs"#-} {-# INLINE rule362 #-} {-# LINE 726 "./src-ag/GenerateCode.ag" #-} rule362 = \ _continuation _inhTps ((_lhsInt) :: NontermIdent) ((_lhsIo_unbox) :: Bool) _params syn_ -> {-# LINE 726 "./src-ag/GenerateCode.ag" #-} mkTupleType _lhsIo_unbox (null _inhTps ) ([typeToCodeType (Just _lhsInt) _params tp | tp <- Map.elems syn_] ++ _continuation )- {-# LINE 2748 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2767 "dist/build/GenerateCode.hs"#-} {-# INLINE rule363 #-} {-# LINE 727 "./src-ag/GenerateCode.ag" #-} rule363 = \ ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) -> {-# LINE 727 "./src-ag/GenerateCode.ag" #-} typeName _lhsInt _lhsInr- {-# LINE 2754 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2773 "dist/build/GenerateCode.hs"#-} {-# INLINE rule364 #-} {-# LINE 728 "./src-ag/GenerateCode.ag" #-} rule364 = \ ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) -> {-# LINE 728 "./src-ag/GenerateCode.ag" #-} typeName _lhsInt (_lhsInr + 1)- {-# LINE 2760 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2779 "dist/build/GenerateCode.hs"#-} {-# INLINE rule365 #-} {-# LINE 729 "./src-ag/GenerateCode.ag" #-} rule365 = \ _curTypeName -> {-# LINE 729 "./src-ag/GenerateCode.ag" #-} "I_" ++ _curTypeName- {-# LINE 2766 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2785 "dist/build/GenerateCode.hs"#-} {-# INLINE rule366 #-} {-# LINE 730 "./src-ag/GenerateCode.ag" #-} rule366 = \ _indexName _params -> {-# LINE 730 "./src-ag/GenerateCode.ag" #-} Code.Data _indexName _params [DataAlt _indexName []] False []- {-# LINE 2772 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2791 "dist/build/GenerateCode.hs"#-} {-# INLINE rule367 #-} {-# LINE 731 "./src-ag/GenerateCode.ag" #-} rule367 = \ _indexName _params -> {-# LINE 731 "./src-ag/GenerateCode.ag" #-} TypeApp (SimpleType _indexName ) (map (SimpleType . ('@':)) _params )- {-# LINE 2778 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2797 "dist/build/GenerateCode.hs"#-} {-# INLINE rule368 #-} {-# LINE 732 "./src-ag/GenerateCode.ag" #-} rule368 = \ _indexName _params -> {-# LINE 732 "./src-ag/GenerateCode.ag" #-} "(" ++ _indexName ++ concatMap (\p -> " " ++ p) _params ++ ")"- {-# LINE 2784 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2803 "dist/build/GenerateCode.hs"#-} {-# INLINE rule369 #-} {-# LINE 733 "./src-ag/GenerateCode.ag" #-} rule369 = \ _indexStr _inhTup ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) -> {-# LINE 733 "./src-ag/GenerateCode.ag" #-} Code.Data "instance Inh" [_indexStr ] [DataAlt (typeName _lhsInt _lhsInr ++ "_Inh") [_inhTup ] ] False []- {-# LINE 2790 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2809 "dist/build/GenerateCode.hs"#-} {-# INLINE rule370 #-} {-# LINE 734 "./src-ag/GenerateCode.ag" #-} rule370 = \ _indexStr ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) _synTps -> {-# LINE 734 "./src-ag/GenerateCode.ag" #-} Code.Data "instance Syn" [_indexStr ] [DataAlt (typeName _lhsInt _lhsInr ++ "_Syn") [_synTps ] ] False []- {-# LINE 2796 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2815 "dist/build/GenerateCode.hs"#-} {-# INLINE rule371 #-} {-# LINE 735 "./src-ag/GenerateCode.ag" #-} rule371 = \ ((_lhsIisLast) :: Bool) _nextTypeName _params ->@@ -2800,13 +2819,13 @@ if _lhsIisLast then [] else [TypeApp (SimpleType _nextTypeName ) (map (SimpleType . ('@':)) _params )]- {-# LINE 2804 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2823 "dist/build/GenerateCode.hs"#-} {-# INLINE rule372 #-} {-# LINE 738 "./src-ag/GenerateCode.ag" #-} rule372 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) -> {-# LINE 738 "./src-ag/GenerateCode.ag" #-} map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap- {-# LINE 2810 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2829 "dist/build/GenerateCode.hs"#-} {-# INLINE rule373 #-} {-# LINE 739 "./src-ag/GenerateCode.ag" #-} rule373 = \ _altSemForm _dataIndex _inhInstance ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIo_newtypes) :: Bool) ((_lhsIoptions) :: Options) _params _synInstance _tp ->@@ -2820,17 +2839,17 @@ ++ ( if _altSemForm then [_dataIndex , _inhInstance , _synInstance ] else [] )- {-# LINE 2824 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2843 "dist/build/GenerateCode.hs"#-} {-# INLINE rule374 #-} {-# LINE 753 "./src-ag/GenerateCode.ag" #-} rule374 = \ ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) _params _tp -> {-# LINE 753 "./src-ag/GenerateCode.ag" #-} Map.singleton (_lhsInt, _lhsInr) (_params , _tp )- {-# LINE 2830 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2849 "dist/build/GenerateCode.hs"#-} {-# INLINE rule375 #-}- {-# LINE 837 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 838 "./src-ag/GenerateCode.ag" #-} rule375 = \ ((_lhsIisLast) :: Bool) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIo_newtypes) :: Bool) ((_lhsIo_unbox) :: Bool) ((_lhsIoptions) :: Options) inh_ syn_ ->- {-# LINE 837 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 838 "./src-ag/GenerateCode.ag" #-} let lhsVars = map (lhsname _lhsIoptions False) (Map.keys syn_) ++ if _lhsIisLast then [] else [unwrap ++ sem (_lhsInr+1)] rhsVars = map (lhsname _lhsIoptions True) (Map.keys inh_)@@ -2841,16 +2860,16 @@ sem n = var ++ "_" ++ show n ntt = typeName _lhsInt _lhsInr in [ EvalDecl ntt (mkTupleLhs _lhsIo_unbox (null $ Map.keys inh_) lhsVars) (InvokeExpr ntt (SimpleExpr $ sem _lhsInr) rhs) ]- {-# LINE 2845 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2864 "dist/build/GenerateCode.hs"#-} {-# INLINE rule376 #-}- {-# LINE 879 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 880 "./src-ag/GenerateCode.ag" #-} rule376 = \ ((_lhsInr) :: Int) inh_ syn_ ->- {-# LINE 879 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 880 "./src-ag/GenerateCode.ag" #-} let body = map ind (showsSegment (CSegment inh_ syn_)) in if null body then [] else ("visit " ++ show _lhsInr ++ ":") : body- {-# LINE 2854 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2873 "dist/build/GenerateCode.hs"#-} -- CSegments --------------------------------------------------- -- wrapper@@ -2958,19 +2977,19 @@ rule377 = \ ((_lhsInr) :: Int) -> {-# LINE 288 "./src-ag/GenerateCode.ag" #-} _lhsInr + 1- {-# LINE 2962 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2981 "dist/build/GenerateCode.hs"#-} {-# INLINE rule378 #-} {-# LINE 301 "./src-ag/GenerateCode.ag" #-} rule378 = \ (_ :: ()) -> {-# LINE 301 "./src-ag/GenerateCode.ag" #-} False- {-# LINE 2968 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2987 "dist/build/GenerateCode.hs"#-} {-# INLINE rule379 #-} {-# LINE 302 "./src-ag/GenerateCode.ag" #-} rule379 = \ ((_tlIisNil) :: Bool) -> {-# LINE 302 "./src-ag/GenerateCode.ag" #-} _tlIisNil- {-# LINE 2974 "dist/build/GenerateCode.hs"#-}+ {-# LINE 2993 "dist/build/GenerateCode.hs"#-} {-# INLINE rule380 #-} rule380 = \ ((_hdIcomments) :: [String]) ((_tlIcomments) :: [String]) -> _hdIcomments ++ _tlIcomments@@ -3143,7 +3162,7 @@ rule429 = \ (_ :: ()) -> {-# LINE 303 "./src-ag/GenerateCode.ag" #-} True- {-# LINE 3147 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3166 "dist/build/GenerateCode.hs"#-} {-# INLINE rule430 #-} rule430 = \ (_ :: ()) -> []@@ -3314,37 +3333,37 @@ rule434 = \ ((_intraIexprs) :: Exprs) -> {-# LINE 312 "./src-ag/GenerateCode.ag" #-} _intraIexprs- {-# LINE 3318 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3337 "dist/build/GenerateCode.hs"#-} {-# INLINE rule435 #-} {-# LINE 313 "./src-ag/GenerateCode.ag" #-} rule435 = \ ((_intraIusedVars) :: Set String) -> {-# LINE 313 "./src-ag/GenerateCode.ag" #-} _intraIusedVars- {-# LINE 3324 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3343 "dist/build/GenerateCode.hs"#-} {-# INLINE rule436 #-} {-# LINE 443 "./src-ag/GenerateCode.ag" #-} rule436 = \ ((_lhsIchildren) :: [(Identifier,Type, ChildKind)]) -> {-# LINE 443 "./src-ag/GenerateCode.ag" #-} partition (\(_,_,virt) -> isHigherOrder virt) _lhsIchildren- {-# LINE 3330 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3349 "dist/build/GenerateCode.hs"#-} {-# INLINE rule437 #-} {-# LINE 444 "./src-ag/GenerateCode.ag" #-} rule437 = \ _firstOrderChildren -> {-# LINE 444 "./src-ag/GenerateCode.ag" #-} map pickOrigType _firstOrderChildren- {-# LINE 3336 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3355 "dist/build/GenerateCode.hs"#-} {-# INLINE rule438 #-} {-# LINE 445 "./src-ag/GenerateCode.ag" #-} rule438 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIprefix) :: String) -> {-# LINE 445 "./src-ag/GenerateCode.ag" #-} seqSemname _lhsIprefix _lhsInt _lhsIcon _lhsInr- {-# LINE 3342 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3361 "dist/build/GenerateCode.hs"#-} {-# INLINE rule439 #-} {-# LINE 446 "./src-ag/GenerateCode.ag" #-} rule439 = \ ((_lhsIisLast) :: Bool) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIprefix) :: String) -> {-# LINE 446 "./src-ag/GenerateCode.ag" #-} if _lhsIisLast then [] else [visitname _lhsIprefix _lhsInt (_lhsInr+1)]- {-# LINE 3348 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3367 "dist/build/GenerateCode.hs"#-} {-# INLINE rule440 #-} {-# LINE 447 "./src-ag/GenerateCode.ag" #-} rule440 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsIdecls) :: Decls) ((_lhsIisLast) :: Bool) ((_lhsInextIntraVars) :: Set String) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIprefix) :: String) _nextVisitName ->@@ -3355,19 +3374,19 @@ in if _lhsIisLast then [] else [Decl lhs rhs (Set.fromList _nextVisitName) _lhsInextIntraVars]- {-# LINE 3359 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3378 "dist/build/GenerateCode.hs"#-} {-# INLINE rule441 #-} {-# LINE 454 "./src-ag/GenerateCode.ag" #-} rule441 = \ ((_lhsIisLast) :: Bool) ((_lhsInr) :: Int) -> {-# LINE 454 "./src-ag/GenerateCode.ag" #-} _lhsIisLast && _lhsInr == 0- {-# LINE 3365 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3384 "dist/build/GenerateCode.hs"#-} {-# INLINE rule442 #-} {-# LINE 455 "./src-ag/GenerateCode.ag" #-} rule442 = \ ((_lhsInt) :: NontermIdent) ((_lhsIwrappers) :: Set NontermIdent) -> {-# LINE 455 "./src-ag/GenerateCode.ag" #-} _lhsInt `Set.member` _lhsIwrappers- {-# LINE 3371 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3390 "dist/build/GenerateCode.hs"#-} {-# INLINE rule443 #-} {-# LINE 456 "./src-ag/GenerateCode.ag" #-} rule443 = \ _hasWrappers _isOneVisit ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) syn_ ->@@ -3380,7 +3399,7 @@ lhs = Fun "___node" [] in [Decl lhs rhs Set.empty Set.empty] else []- {-# LINE 3384 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3403 "dist/build/GenerateCode.hs"#-} {-# INLINE rule444 #-} {-# LINE 464 "./src-ag/GenerateCode.ag" #-} rule444 = \ ((_lhsIo_clean) :: Bool) _nextVisitDecl _refDecls _typeSigs ((_vssIdecls) :: Decls) ->@@ -3388,37 +3407,37 @@ if _lhsIo_clean then _vssIdecls ++ _nextVisitDecl ++ _refDecls else _typeSigs ++ _vssIdecls ++ _nextVisitDecl ++ _refDecls- {-# LINE 3392 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3411 "dist/build/GenerateCode.hs"#-} {-# INLINE rule445 #-} {-# LINE 467 "./src-ag/GenerateCode.ag" #-} rule445 = \ ((_lhsIo_unbox) :: Bool) ((_lhsIoptions) :: Options) _nextVisitName inh_ syn_ -> {-# LINE 467 "./src-ag/GenerateCode.ag" #-} mkTupleExpr _lhsIo_unbox (null $ Map.keys inh_) $ map (SimpleExpr . lhsname _lhsIoptions False) (Map.keys syn_) ++ map SimpleExpr _nextVisitName- {-# LINE 3398 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3417 "dist/build/GenerateCode.hs"#-} {-# INLINE rule446 #-} {-# LINE 468 "./src-ag/GenerateCode.ag" #-} rule446 = \ (_ :: ()) -> {-# LINE 468 "./src-ag/GenerateCode.ag" #-} error "lastExpr: not used here"- {-# LINE 3404 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3423 "dist/build/GenerateCode.hs"#-} {-# INLINE rule447 #-} {-# LINE 469 "./src-ag/GenerateCode.ag" #-} rule447 = \ ((_lhsIoptions) :: Options) _nextVisitName syn_ -> {-# LINE 469 "./src-ag/GenerateCode.ag" #-} map (lhsname _lhsIoptions False) (Map.keys syn_) ++ _nextVisitName- {-# LINE 3410 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3429 "dist/build/GenerateCode.hs"#-} {-# INLINE rule448 #-} {-# LINE 470 "./src-ag/GenerateCode.ag" #-} rule448 = \ _funcname _lastExprVars _nextVisitDecl _o_case ((_vssIblockDecls) :: DeclBlocks) -> {-# LINE 470 "./src-ag/GenerateCode.ag" #-} mkPartitionedFunction _funcname _o_case _nextVisitDecl _lastExprVars _vssIblockDecls- {-# LINE 3416 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3435 "dist/build/GenerateCode.hs"#-} {-# INLINE rule449 #-} {-# LINE 472 "./src-ag/GenerateCode.ag" #-} rule449 = \ ((_lhsIcon) :: ConstructorIdent) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) -> {-# LINE 472 "./src-ag/GenerateCode.ag" #-} "b" ++ ":" ++ show _lhsInt ++ ":" ++ show _lhsIcon ++ ":" ++ show _lhsInr- {-# LINE 3422 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3441 "dist/build/GenerateCode.hs"#-} {-# INLINE rule450 #-} {-# LINE 473 "./src-ag/GenerateCode.ag" #-} rule450 = \ _costCentreDescr ((_lhsIo_costcentre) :: Bool) ->@@ -3426,13 +3445,13 @@ \v -> if _lhsIo_costcentre then PragmaExpr True False ("SCC \"" ++ _costCentreDescr ++ "\"") v else v- {-# LINE 3430 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3449 "dist/build/GenerateCode.hs"#-} {-# INLINE rule451 #-} {-# LINE 477 "./src-ag/GenerateCode.ag" #-} rule451 = \ ((_lhsInt) :: NontermIdent) ((_lhsIparamMap) :: ParamMap) -> {-# LINE 477 "./src-ag/GenerateCode.ag" #-} map getName $ Map.findWithDefault [] _lhsInt _lhsIparamMap- {-# LINE 3436 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3455 "dist/build/GenerateCode.hs"#-} {-# INLINE rule452 #-} {-# LINE 478 "./src-ag/GenerateCode.ag" #-} rule452 = \ _addCostCentre _blockFirstFunCall _decls _declsType _firstOrderOrig _funcname ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIo_newtypes) :: Bool) ((_lhsIo_unbox) :: Bool) ((_lhsIoptions) :: Options) ((_lhsIunfoldSemDom) :: NontermIdent -> Int -> [String] -> Code.Type) _nextVisitName _o_splitsems _params inh_ ordered_ syn_ ->@@ -3463,13 +3482,13 @@ then \x -> App (typeName _lhsInt _lhsInr) [x] else id in Decl lhs rhs Set.empty Set.empty- {-# LINE 3467 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3486 "dist/build/GenerateCode.hs"#-} {-# INLINE rule453 #-} {-# LINE 509 "./src-ag/GenerateCode.ag" #-} rule453 = \ _funcname _semType -> {-# LINE 509 "./src-ag/GenerateCode.ag" #-} TSig _funcname _semType- {-# LINE 3473 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3492 "dist/build/GenerateCode.hs"#-} {-# INLINE rule454 #-} {-# LINE 510 "./src-ag/GenerateCode.ag" #-} rule454 = \ _firstOrderOrig ((_lhsIcontextMap) :: ContextMap) ((_lhsInr) :: Int) ((_lhsInt) :: NontermIdent) ((_lhsIoptions) :: Options) ((_lhsIquantMap) :: QuantMap) _params ->@@ -3484,7 +3503,7 @@ if _lhsInr == 0 then foldr argType (typeAppStrs (sdtype _lhsInt ) _params ) (map (\(_,t,_) -> t) _firstOrderOrig ) else foldr argType (typeAppStrs (typeName _lhsInt _lhsInr) _params ) []- {-# LINE 3488 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3507 "dist/build/GenerateCode.hs"#-} {-# INLINE rule455 #-} {-# LINE 521 "./src-ag/GenerateCode.ag" #-} rule455 = \ _blockFunDecls ((_lhsIwith_sig) :: Bool) _o_splitsems _semFun _tsig ordered_ ->@@ -3497,7 +3516,7 @@ then _blockFunDecls else [] )- {-# LINE 3501 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3520 "dist/build/GenerateCode.hs"#-} {-# INLINE rule456 #-} {-# LINE 529 "./src-ag/GenerateCode.ag" #-} rule456 = \ ((_lhsIo_sig) :: Bool) _o_case ((_vssItSigs) :: [Decl]) ->@@ -3505,19 +3524,19 @@ if _lhsIo_sig && not _o_case then _vssItSigs else []- {-# LINE 3509 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3528 "dist/build/GenerateCode.hs"#-} {-# INLINE rule457 #-} {-# LINE 532 "./src-ag/GenerateCode.ag" #-} rule457 = \ ((_lhsIo_monadic) :: Bool) ordered_ -> {-# LINE 532 "./src-ag/GenerateCode.ag" #-} ordered_ && _lhsIo_monadic- {-# LINE 3515 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3534 "dist/build/GenerateCode.hs"#-} {-# INLINE rule458 #-} {-# LINE 533 "./src-ag/GenerateCode.ag" #-} rule458 = \ ((_lhsIallPragmas) :: PragmaMap) ((_lhsIcon) :: ConstructorIdent) ((_lhsInt) :: NontermIdent) ((_lhsIo_case) :: Bool) _o_do ordered_ -> {-# LINE 533 "./src-ag/GenerateCode.ag" #-} not _o_do && _lhsIo_case && ordered_ && not (hasPragma _lhsIallPragmas _lhsInt _lhsIcon _NOCASE)- {-# LINE 3521 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3540 "dist/build/GenerateCode.hs"#-} {-# INLINE rule459 #-} {-# LINE 534 "./src-ag/GenerateCode.ag" #-} rule459 = \ _o_case _o_do ->@@ -3527,58 +3546,58 @@ else if _o_case then DeclsCase else DeclsLet- {-# LINE 3531 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3550 "dist/build/GenerateCode.hs"#-} {-# INLINE rule460 #-} {-# LINE 539 "./src-ag/GenerateCode.ag" #-} rule460 = \ ((_lhsIo_splitsems) :: Bool) ordered_ -> {-# LINE 539 "./src-ag/GenerateCode.ag" #-} ordered_ && _lhsIo_splitsems- {-# LINE 3537 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3556 "dist/build/GenerateCode.hs"#-} {-# INLINE rule461 #-} {-# LINE 573 "./src-ag/GenerateCode.ag" #-} rule461 = \ ((_lhsInr) :: Int) ((_vssIdefinedInsts) :: [Identifier]) -> {-# LINE 573 "./src-ag/GenerateCode.ag" #-} Map.fromList [(i,_lhsInr) | i <- _vssIdefinedInsts]- {-# LINE 3543 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3562 "dist/build/GenerateCode.hs"#-} {-# INLINE rule462 #-} {-# LINE 616 "./src-ag/GenerateCode.ag" #-} rule462 = \ (_ :: ()) -> {-# LINE 616 "./src-ag/GenerateCode.ag" #-} []- {-# LINE 3549 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3568 "dist/build/GenerateCode.hs"#-} {-# INLINE rule463 #-} {-# LINE 617 "./src-ag/GenerateCode.ag" #-} rule463 = \ (_ :: ()) -> {-# LINE 617 "./src-ag/GenerateCode.ag" #-} error "declsAbove: not used here"- {-# LINE 3555 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3574 "dist/build/GenerateCode.hs"#-} {-# INLINE rule464 #-}- {-# LINE 900 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 901 "./src-ag/GenerateCode.ag" #-} rule464 = \ ((_intraIcomments) :: [String]) ((_lhsInr) :: Int) ((_vssIcomments) :: [String]) ->- {-# LINE 900 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 901 "./src-ag/GenerateCode.ag" #-} let body = map ind (_vssIcomments ++ _intraIcomments) in if null body then [] else ("visit " ++ show _lhsInr ++ ":") : body- {-# LINE 3564 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3583 "dist/build/GenerateCode.hs"#-} {-# INLINE rule465 #-}- {-# LINE 904 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 905 "./src-ag/GenerateCode.ag" #-} rule465 = \ (_ :: ()) ->- {-# LINE 904 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 905 "./src-ag/GenerateCode.ag" #-} "local"- {-# LINE 3570 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3589 "dist/build/GenerateCode.hs"#-} {-# INLINE rule466 #-}- {-# LINE 905 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 906 "./src-ag/GenerateCode.ag" #-} rule466 = \ (_ :: ()) ->- {-# LINE 905 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 906 "./src-ag/GenerateCode.ag" #-} "intra"- {-# LINE 3576 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3595 "dist/build/GenerateCode.hs"#-} {-# INLINE rule467 #-}- {-# LINE 1167 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1186 "./src-ag/GenerateCode.ag" #-} rule467 = \ _funcname ->- {-# LINE 1167 "./src-ag/GenerateCode.ag" #-}+ {-# LINE 1186 "./src-ag/GenerateCode.ag" #-} [_funcname ]- {-# LINE 3582 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3601 "dist/build/GenerateCode.hs"#-} {-# INLINE rule468 #-} rule468 = \ ((_intraIvisitedSet) :: Set Identifier) -> _intraIvisitedSet@@ -3926,55 +3945,55 @@ rule535 = \ ((_lhsInr) :: Int) -> {-# LINE 284 "./src-ag/GenerateCode.ag" #-} _lhsInr + 1- {-# LINE 3930 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3949 "dist/build/GenerateCode.hs"#-} {-# INLINE rule536 #-} {-# LINE 297 "./src-ag/GenerateCode.ag" #-} rule536 = \ (_ :: ()) -> {-# LINE 297 "./src-ag/GenerateCode.ag" #-} False- {-# LINE 3936 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3955 "dist/build/GenerateCode.hs"#-} {-# INLINE rule537 #-} {-# LINE 298 "./src-ag/GenerateCode.ag" #-} rule537 = \ ((_tlIisNil) :: Bool) -> {-# LINE 298 "./src-ag/GenerateCode.ag" #-} _tlIisNil- {-# LINE 3942 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3961 "dist/build/GenerateCode.hs"#-} {-# INLINE rule538 #-} {-# LINE 315 "./src-ag/GenerateCode.ag" #-} rule538 = \ ((_tlIintra) :: Exprs) -> {-# LINE 315 "./src-ag/GenerateCode.ag" #-} _tlIintra- {-# LINE 3948 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3967 "dist/build/GenerateCode.hs"#-} {-# INLINE rule539 #-} {-# LINE 316 "./src-ag/GenerateCode.ag" #-} rule539 = \ ((_tlIintraVars) :: Set String) -> {-# LINE 316 "./src-ag/GenerateCode.ag" #-} _tlIintraVars- {-# LINE 3954 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3973 "dist/build/GenerateCode.hs"#-} {-# INLINE rule540 #-} {-# LINE 317 "./src-ag/GenerateCode.ag" #-} rule540 = \ ((_hdIintra) :: Exprs) -> {-# LINE 317 "./src-ag/GenerateCode.ag" #-} _hdIintra- {-# LINE 3960 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3979 "dist/build/GenerateCode.hs"#-} {-# INLINE rule541 #-} {-# LINE 318 "./src-ag/GenerateCode.ag" #-} rule541 = \ ((_hdIintraVars) :: Set String) -> {-# LINE 318 "./src-ag/GenerateCode.ag" #-} _hdIintraVars- {-# LINE 3966 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3985 "dist/build/GenerateCode.hs"#-} {-# INLINE rule542 #-} {-# LINE 433 "./src-ag/GenerateCode.ag" #-} rule542 = \ ((_hdIdecls) :: Decls) -> {-# LINE 433 "./src-ag/GenerateCode.ag" #-} _hdIdecls- {-# LINE 3972 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3991 "dist/build/GenerateCode.hs"#-} {-# INLINE rule543 #-} {-# LINE 434 "./src-ag/GenerateCode.ag" #-} rule543 = \ ((_tlIdecls) :: Decls) -> {-# LINE 434 "./src-ag/GenerateCode.ag" #-} _tlIdecls- {-# LINE 3978 "dist/build/GenerateCode.hs"#-}+ {-# LINE 3997 "dist/build/GenerateCode.hs"#-} {-# INLINE rule544 #-} rule544 = \ ((_hdIcomments) :: [String]) ((_tlIcomments) :: [String]) -> _hdIcomments ++ _tlIcomments@@ -4243,25 +4262,25 @@ rule623 = \ (_ :: ()) -> {-# LINE 299 "./src-ag/GenerateCode.ag" #-} True- {-# LINE 4247 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4266 "dist/build/GenerateCode.hs"#-} {-# INLINE rule624 #-} {-# LINE 319 "./src-ag/GenerateCode.ag" #-} rule624 = \ (_ :: ()) -> {-# LINE 319 "./src-ag/GenerateCode.ag" #-} []- {-# LINE 4253 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4272 "dist/build/GenerateCode.hs"#-} {-# INLINE rule625 #-} {-# LINE 320 "./src-ag/GenerateCode.ag" #-} rule625 = \ (_ :: ()) -> {-# LINE 320 "./src-ag/GenerateCode.ag" #-} Set.empty- {-# LINE 4259 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4278 "dist/build/GenerateCode.hs"#-} {-# INLINE rule626 #-} {-# LINE 432 "./src-ag/GenerateCode.ag" #-} rule626 = \ (_ :: ()) -> {-# LINE 432 "./src-ag/GenerateCode.ag" #-} []- {-# LINE 4265 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4284 "dist/build/GenerateCode.hs"#-} {-# INLINE rule627 #-} rule627 = \ (_ :: ()) -> []@@ -4338,43 +4357,43 @@ rule631 = \ ((_lhsIblockNr) :: Int) -> {-# LINE 667 "./src-ag/GenerateCode.ag" #-} _lhsIblockNr + 1- {-# LINE 4342 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4361 "dist/build/GenerateCode.hs"#-} {-# INLINE rule632 #-} {-# LINE 672 "./src-ag/GenerateCode.ag" #-} rule632 = \ ((_lhsIblockNr) :: Int) ((_lhsIprefix) :: String) -> {-# LINE 672 "./src-ag/GenerateCode.ag" #-} _lhsIprefix ++ "_block" ++ show _lhsIblockNr- {-# LINE 4348 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4367 "dist/build/GenerateCode.hs"#-} {-# INLINE rule633 #-} {-# LINE 673 "./src-ag/GenerateCode.ag" #-} rule633 = \ _lambdaName -> {-# LINE 673 "./src-ag/GenerateCode.ag" #-} PragmaDecl ("NOINLINE " ++ _lambdaName )- {-# LINE 4354 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4373 "dist/build/GenerateCode.hs"#-} {-# INLINE rule634 #-} {-# LINE 674 "./src-ag/GenerateCode.ag" #-} rule634 = \ _freeVars _lambdaName -> {-# LINE 674 "./src-ag/GenerateCode.ag" #-} App _lambdaName (map SimpleExpr _freeVars )- {-# LINE 4360 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4379 "dist/build/GenerateCode.hs"#-} {-# INLINE rule635 #-} {-# LINE 678 "./src-ag/GenerateCode.ag" #-} rule635 = \ ((_nextIfreeVars) :: [String]) defs_ visit_ -> {-# LINE 678 "./src-ag/GenerateCode.ag" #-} freevars _nextIfreeVars (visit_ : defs_)- {-# LINE 4366 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4385 "dist/build/GenerateCode.hs"#-} {-# INLINE rule636 #-} {-# LINE 685 "./src-ag/GenerateCode.ag" #-} rule636 = \ _freeVars _lambdaName ((_lhsIoptCase) :: Bool) ((_nextIcallExpr) :: Expr) defs_ visit_ -> {-# LINE 685 "./src-ag/GenerateCode.ag" #-} mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ [visit_]) _nextIcallExpr- {-# LINE 4372 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4391 "dist/build/GenerateCode.hs"#-} {-# INLINE rule637 #-} {-# LINE 686 "./src-ag/GenerateCode.ag" #-} rule637 = \ _decl ((_lhsIblockNr) :: Int) ((_nextIdecls) :: [Decl]) _pragmaDecl -> {-# LINE 686 "./src-ag/GenerateCode.ag" #-} (if _lhsIblockNr > 1 then [_pragmaDecl ] else []) ++ [_decl ] ++ _nextIdecls- {-# LINE 4378 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4397 "dist/build/GenerateCode.hs"#-} {-# INLINE rule638 #-} rule638 = \ _freeVars -> _freeVars@@ -4414,31 +4433,31 @@ rule643 = \ ((_lhsIblockNr) :: Int) ((_lhsIprefix) :: String) -> {-# LINE 672 "./src-ag/GenerateCode.ag" #-} _lhsIprefix ++ "_block" ++ show _lhsIblockNr- {-# LINE 4418 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4437 "dist/build/GenerateCode.hs"#-} {-# INLINE rule644 #-} {-# LINE 673 "./src-ag/GenerateCode.ag" #-} rule644 = \ _lambdaName -> {-# LINE 673 "./src-ag/GenerateCode.ag" #-} PragmaDecl ("NOINLINE " ++ _lambdaName )- {-# LINE 4424 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4443 "dist/build/GenerateCode.hs"#-} {-# INLINE rule645 #-} {-# LINE 674 "./src-ag/GenerateCode.ag" #-} rule645 = \ _freeVars _lambdaName -> {-# LINE 674 "./src-ag/GenerateCode.ag" #-} App _lambdaName (map SimpleExpr _freeVars )- {-# LINE 4430 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4449 "dist/build/GenerateCode.hs"#-} {-# INLINE rule646 #-} {-# LINE 676 "./src-ag/GenerateCode.ag" #-} rule646 = \ ((_lhsIlastExprVars) :: [String]) ((_lhsInextVisitDecls) :: [Decl]) defs_ -> {-# LINE 676 "./src-ag/GenerateCode.ag" #-} freevars _lhsIlastExprVars (defs_ ++ _lhsInextVisitDecls)- {-# LINE 4436 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4455 "dist/build/GenerateCode.hs"#-} {-# INLINE rule647 #-} {-# LINE 683 "./src-ag/GenerateCode.ag" #-} rule647 = \ _freeVars _lambdaName ((_lhsInextVisitDecls) :: [Decl]) ((_lhsIoptCase) :: Bool) defs_ result_ -> {-# LINE 683 "./src-ag/GenerateCode.ag" #-} [ mkBlockLambda _lhsIoptCase _lambdaName _freeVars (defs_ ++ _lhsInextVisitDecls) result_ ]- {-# LINE 4442 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4461 "dist/build/GenerateCode.hs"#-} {-# INLINE rule648 #-} rule648 = \ _freeVars -> _freeVars@@ -4499,19 +4518,19 @@ rule649 = \ ((_blocksIdecls) :: [Decl]) -> {-# LINE 658 "./src-ag/GenerateCode.ag" #-} _blocksIdecls- {-# LINE 4503 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4522 "dist/build/GenerateCode.hs"#-} {-# INLINE rule650 #-} {-# LINE 659 "./src-ag/GenerateCode.ag" #-} rule650 = \ ((_blocksIcallExpr) :: Expr) -> {-# LINE 659 "./src-ag/GenerateCode.ag" #-} _blocksIcallExpr- {-# LINE 4509 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4528 "dist/build/GenerateCode.hs"#-} {-# INLINE rule651 #-} {-# LINE 664 "./src-ag/GenerateCode.ag" #-} rule651 = \ (_ :: ()) -> {-# LINE 664 "./src-ag/GenerateCode.ag" #-} 1- {-# LINE 4515 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4534 "dist/build/GenerateCode.hs"#-} {-# INLINE rule652 #-} rule652 = \ ((_lhsIlastExprVars) :: [String]) -> _lhsIlastExprVars@@ -4645,13 +4664,13 @@ rule664 = \ ((_patIdefinedInsts) :: [Identifier]) attr_ field_ -> {-# LINE 265 "./src-ag/GenerateCode.ag" #-} (if field_ == _INST then [attr_] else []) ++ _patIdefinedInsts- {-# LINE 4649 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4668 "dist/build/GenerateCode.hs"#-} {-# INLINE rule665 #-} {-# LINE 273 "./src-ag/GenerateCode.ag" #-} rule665 = \ ((_patIpatternAttributes) :: [(Identifier, Identifier)]) attr_ field_ -> {-# LINE 273 "./src-ag/GenerateCode.ag" #-} (field_,attr_) : _patIpatternAttributes- {-# LINE 4655 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4674 "dist/build/GenerateCode.hs"#-} {-# INLINE rule666 #-} rule666 = \ ((_patIcopy) :: Pattern) attr_ field_ -> Alias field_ attr_ _patIcopy@@ -4954,7 +4973,7 @@ rule684 = \ ((_hdIbldBlocksFun) :: DeclBlocks -> DeclBlocks) ((_tlIblockDecls) :: DeclBlocks) -> {-# LINE 627 "./src-ag/GenerateCode.ag" #-} _hdIbldBlocksFun _tlIblockDecls- {-# LINE 4958 "dist/build/GenerateCode.hs"#-}+ {-# LINE 4977 "dist/build/GenerateCode.hs"#-} {-# INLINE rule685 #-} rule685 = \ ((_hdIallTpsFound) :: Bool) ((_tlIallTpsFound) :: Bool) -> _hdIallTpsFound && _tlIallTpsFound@@ -5235,7 +5254,7 @@ rule766 = \ ((_lhsIdeclsAbove) :: [Decl]) ((_lhsIlastExpr) :: Expr) -> {-# LINE 629 "./src-ag/GenerateCode.ag" #-} DeclTerminator _lhsIdeclsAbove _lhsIlastExpr- {-# LINE 5239 "dist/build/GenerateCode.hs"#-}+ {-# LINE 5258 "dist/build/GenerateCode.hs"#-} {-# INLINE rule767 #-} rule767 = \ (_ :: ()) -> True
src-generated/PrintCleanCode.hs view
@@ -34,7 +34,7 @@ {-# LINE 35 "dist/build/PrintCleanCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity-{-# LINE 144 "./src-ag/Code.ag" #-}+{-# LINE 146 "./src-ag/Code.ag" #-} -- Unboxed tuples -- unbox Whether unboxed tuples are wanted or not@@ -71,7 +71,7 @@ = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs {-# LINE 73 "dist/build/PrintCleanCode.hs" #-} -{-# LINE 318 "./src-ag/PrintCleanCode.ag" #-}+{-# LINE 322 "./src-ag/PrintCleanCode.ag" #-} reallySimple :: String -> Bool@@ -88,19 +88,19 @@ {-# LINE 90 "dist/build/PrintCleanCode.hs" #-} -{-# LINE 421 "./src-ag/PrintCleanCode.ag" #-}+{-# LINE 425 "./src-ag/PrintCleanCode.ag" #-} locname' :: Identifier -> [Char] locname' n = "_loc_" ++ getName n {-# LINE 96 "dist/build/PrintCleanCode.hs" #-} -{-# LINE 496 "./src-ag/PrintCleanCode.ag" #-}+{-# LINE 500 "./src-ag/PrintCleanCode.ag" #-} renderDocs :: [PP_Doc] -> String renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) "" {-# LINE 102 "dist/build/PrintCleanCode.hs" #-} -{-# LINE 544 "./src-ag/PrintCleanCode.ag" #-}+{-# LINE 548 "./src-ag/PrintCleanCode.ag" #-} writeModule :: FilePath -> [PP_Doc] -> IO () writeModule path docs@@ -176,9 +176,9 @@ ["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"] {-# LINE 178 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule1 #-}- {-# LINE 445 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 449 "./src-ag/PrintCleanCode.ag" #-} rule1 = \ (_ :: ()) ->- {-# LINE 445 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 449 "./src-ag/PrintCleanCode.ag" #-} False {-# LINE 184 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule2 #-}@@ -411,15 +411,15 @@ ++ [Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap] {-# LINE 413 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule18 #-}- {-# LINE 504 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 508 "./src-ag/PrintCleanCode.ag" #-} rule18 = \ ((_lhsImainName) :: String) name_ ->- {-# LINE 504 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 508 "./src-ag/PrintCleanCode.ag" #-} ["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"] {-# LINE 419 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule19 #-}- {-# LINE 511 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 515 "./src-ag/PrintCleanCode.ag" #-} rule19 = \ ((_commentIpp) :: PP_Doc) ((_dataDefIpps) :: PP_Docs) ((_lhsIoptions) :: Options) ((_semDomIpps) :: PP_Docs) ((_semWrapperIpps) :: PP_Docs) ->- {-# LINE 511 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 515 "./src-ag/PrintCleanCode.ag" #-} [ [_commentIpp] , _dataDefIpps , _semDomIpps@@ -427,18 +427,18 @@ ] {-# LINE 429 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule20 #-}- {-# LINE 517 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 521 "./src-ag/PrintCleanCode.ag" #-} rule20 = \ ((_cataFunIpps) :: PP_Docs) ((_commentIpp) :: PP_Doc) ((_lhsIoptions) :: Options) ((_semWrapperIpps) :: PP_Docs) ->- {-# LINE 517 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 521 "./src-ag/PrintCleanCode.ag" #-} [ [_commentIpp] , _cataFunIpps , if reference _lhsIoptions then [] else _semWrapperIpps ] {-# LINE 438 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule21 #-}- {-# LINE 527 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 531 "./src-ag/PrintCleanCode.ag" #-} rule21 = \ ((_commentIpp) :: PP_Doc) _exports ((_infoIpps) :: PP_Docs) ((_lhsImainName) :: String) ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIoptionsLine) :: String) ((_lhsIpragmaBlocks) :: String) ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) _outputfile ((_semFunctionsIpps) :: PP_Docs) name_ ->- {-# LINE 527 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 531 "./src-ag/PrintCleanCode.ag" #-} writeModule _outputfile [ pp $ _lhsIpragmaBlocks , pp $ Map.findWithDefault empty (BlockPragma, Just $ identifier name_) _lhsItextBlockMap@@ -453,9 +453,9 @@ ] {-# LINE 455 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule22 #-}- {-# LINE 542 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 546 "./src-ag/PrintCleanCode.ag" #-} rule22 = \ semNames_ ->- {-# LINE 542 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 546 "./src-ag/PrintCleanCode.ag" #-} concat $ intersperse "," semNames_ {-# LINE 461 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule23 #-}@@ -1184,9 +1184,9 @@ >-< foldr (>-<) empty _altsIppas {-# LINE 1186 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule125 #-}- {-# LINE 342 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 346 "./src-ag/PrintCleanCode.ag" #-} rule125 = \ strict_ ->- {-# LINE 342 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 346 "./src-ag/PrintCleanCode.ag" #-} if strict_ then pp "!" else empty {-# LINE 1192 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule126 #-}@@ -1638,9 +1638,9 @@ ) {-# LINE 1640 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule171 #-}- {-# LINE 437 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 441 "./src-ag/PrintCleanCode.ag" #-} rule171 = \ (_ :: ()) ->- {-# LINE 437 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 441 "./src-ag/PrintCleanCode.ag" #-} True {-# LINE 1646 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule172 #-}@@ -1741,9 +1741,9 @@ ) {-# LINE 1743 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule186 #-}- {-# LINE 439 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 443 "./src-ag/PrintCleanCode.ag" #-} rule186 = \ (_ :: ()) ->- {-# LINE 439 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 443 "./src-ag/PrintCleanCode.ag" #-} False {-# LINE 1749 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule187 #-}@@ -2239,9 +2239,9 @@ ) {-# LINE 2241 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule245 #-}- {-# LINE 441 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 445 "./src-ag/PrintCleanCode.ag" #-} rule245 = \ (_ :: ()) ->- {-# LINE 441 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 445 "./src-ag/PrintCleanCode.ag" #-} False {-# LINE 2247 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule246 #-}@@ -2520,9 +2520,9 @@ _addStrictGuard _pat3Ipp {-# LINE 2522 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule276 #-}- {-# LINE 402 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 406 "./src-ag/PrintCleanCode.ag" #-} rule276 = \ (_ :: ()) ->- {-# LINE 402 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 406 "./src-ag/PrintCleanCode.ag" #-} False {-# LINE 2528 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule277 #-}@@ -2555,9 +2555,9 @@ _pat3Ipp' {-# LINE 2557 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule280 #-}- {-# LINE 402 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 406 "./src-ag/PrintCleanCode.ag" #-} rule280 = \ (_ :: ()) ->- {-# LINE 402 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 406 "./src-ag/PrintCleanCode.ag" #-} False {-# LINE 2563 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule281 #-}@@ -2987,29 +2987,29 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule315 #-}- {-# LINE 374 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 378 "./src-ag/PrintCleanCode.ag" #-} rule315 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) ->- {-# LINE 374 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 378 "./src-ag/PrintCleanCode.ag" #-} if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable then \p -> "!" >|< p else id {-# LINE 2997 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule316 #-}- {-# LINE 379 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 383 "./src-ag/PrintCleanCode.ag" #-} rule316 = \ _addBang ((_patsIpps) :: [PP_Doc]) name_ ->- {-# LINE 379 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 383 "./src-ag/PrintCleanCode.ag" #-} _addBang $ pp_parens $ name_ >#< hv_sp _patsIpps {-# LINE 3003 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule317 #-}- {-# LINE 390 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 394 "./src-ag/PrintCleanCode.ag" #-} rule317 = \ (_ :: ()) ->- {-# LINE 390 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 394 "./src-ag/PrintCleanCode.ag" #-} False {-# LINE 3009 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule318 #-}- {-# LINE 413 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 417 "./src-ag/PrintCleanCode.ag" #-} rule318 = \ ((_patsIpps') :: [PP_Doc]) name_ ->- {-# LINE 413 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 417 "./src-ag/PrintCleanCode.ag" #-} pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps') {-# LINE 3015 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule319 #-}@@ -3058,29 +3058,29 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule325 #-}- {-# LINE 374 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 378 "./src-ag/PrintCleanCode.ag" #-} rule325 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) ->- {-# LINE 374 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 378 "./src-ag/PrintCleanCode.ag" #-} if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable then \p -> "!" >|< p else id {-# LINE 3068 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule326 #-}- {-# LINE 380 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 384 "./src-ag/PrintCleanCode.ag" #-} rule326 = \ _addBang ((_patsIpps) :: [PP_Doc]) ->- {-# LINE 380 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 384 "./src-ag/PrintCleanCode.ag" #-} _addBang $ pp_block "(" ")" "," _patsIpps {-# LINE 3074 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule327 #-}- {-# LINE 391 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 395 "./src-ag/PrintCleanCode.ag" #-} rule327 = \ (_ :: ()) ->- {-# LINE 391 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 395 "./src-ag/PrintCleanCode.ag" #-} False {-# LINE 3080 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule328 #-}- {-# LINE 414 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 418 "./src-ag/PrintCleanCode.ag" #-} rule328 = \ ((_patsIpps') :: [PP_Doc]) ->- {-# LINE 414 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 418 "./src-ag/PrintCleanCode.ag" #-} pp_block "(" ")" "," _patsIpps' {-# LINE 3086 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule329 #-}@@ -3133,65 +3133,65 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule335 #-}- {-# LINE 352 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 356 "./src-ag/PrintCleanCode.ag" #-} rule335 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) _ppVar ->- {-# LINE 352 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 356 "./src-ag/PrintCleanCode.ag" #-} if strictCases _lhsIoptions && not _lhsIisDeclOfLet then [_ppVar ] else [] {-# LINE 3143 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule336 #-}- {-# LINE 356 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 360 "./src-ag/PrintCleanCode.ag" #-} rule336 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) ((_patIstrictVars) :: [PP_Doc]) ->- {-# LINE 356 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 360 "./src-ag/PrintCleanCode.ag" #-} if stricterCases _lhsIoptions && not _lhsIisDeclOfLet then _patIstrictVars else [] {-# LINE 3151 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule337 #-}- {-# LINE 360 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 364 "./src-ag/PrintCleanCode.ag" #-} rule337 = \ _strictPatVars _strictVar ->- {-# LINE 360 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 364 "./src-ag/PrintCleanCode.ag" #-} _strictVar ++ _strictPatVars {-# LINE 3157 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule338 #-}- {-# LINE 374 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 378 "./src-ag/PrintCleanCode.ag" #-} rule338 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) ->- {-# LINE 374 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 378 "./src-ag/PrintCleanCode.ag" #-} if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable then \p -> "!" >|< p else id {-# LINE 3165 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule339 #-}- {-# LINE 381 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 385 "./src-ag/PrintCleanCode.ag" #-} rule339 = \ ((_lhsIoptions) :: Options) attr_ field_ ->- {-# LINE 381 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 385 "./src-ag/PrintCleanCode.ag" #-} pp (attrname _lhsIoptions False field_ attr_) {-# LINE 3171 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule340 #-}- {-# LINE 382 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 386 "./src-ag/PrintCleanCode.ag" #-} rule340 = \ _addBang _ppVar ->- {-# LINE 382 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 386 "./src-ag/PrintCleanCode.ag" #-} _addBang $ _ppVar {-# LINE 3177 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule341 #-}- {-# LINE 383 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 387 "./src-ag/PrintCleanCode.ag" #-} rule341 = \ ((_patIisUnderscore) :: Bool) ((_patIpp) :: PP_Doc) _ppVarBang ->- {-# LINE 383 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 387 "./src-ag/PrintCleanCode.ag" #-} if _patIisUnderscore then _ppVarBang else _ppVarBang >|< "@" >|< _patIpp {-# LINE 3185 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule342 #-}- {-# LINE 392 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 396 "./src-ag/PrintCleanCode.ag" #-} rule342 = \ (_ :: ()) ->- {-# LINE 392 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 396 "./src-ag/PrintCleanCode.ag" #-} False {-# LINE 3191 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule343 #-}- {-# LINE 415 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 419 "./src-ag/PrintCleanCode.ag" #-} rule343 = \ ((_lhsIoptions) :: Options) ((_patIpp') :: PP_Doc) attr_ field_ ->- {-# LINE 415 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 419 "./src-ag/PrintCleanCode.ag" #-} let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_ | otherwise = attrname _lhsIoptions False field_ attr_ in attribute >|< "@" >|< _patIpp'@@ -3238,27 +3238,27 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule349 #-}- {-# LINE 362 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 366 "./src-ag/PrintCleanCode.ag" #-} rule349 = \ (_ :: ()) ->- {-# LINE 362 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 366 "./src-ag/PrintCleanCode.ag" #-} [] {-# LINE 3246 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule350 #-}- {-# LINE 386 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 390 "./src-ag/PrintCleanCode.ag" #-} rule350 = \ ((_patIpp) :: PP_Doc) ->- {-# LINE 386 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 390 "./src-ag/PrintCleanCode.ag" #-} text "~" >|< pp_parens _patIpp {-# LINE 3252 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule351 #-}- {-# LINE 398 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 402 "./src-ag/PrintCleanCode.ag" #-} rule351 = \ (_ :: ()) ->- {-# LINE 398 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 402 "./src-ag/PrintCleanCode.ag" #-} True {-# LINE 3258 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule352 #-}- {-# LINE 418 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 422 "./src-ag/PrintCleanCode.ag" #-} rule352 = \ ((_patIpp) :: PP_Doc) ->- {-# LINE 418 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 422 "./src-ag/PrintCleanCode.ag" #-} text "~" >|< pp_parens _patIpp {-# LINE 3264 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule353 #-}@@ -3298,21 +3298,21 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule358 #-}- {-# LINE 387 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 391 "./src-ag/PrintCleanCode.ag" #-} rule358 = \ (_ :: ()) ->- {-# LINE 387 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 391 "./src-ag/PrintCleanCode.ag" #-} text "_" {-# LINE 3306 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule359 #-}- {-# LINE 393 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 397 "./src-ag/PrintCleanCode.ag" #-} rule359 = \ (_ :: ()) ->- {-# LINE 393 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 397 "./src-ag/PrintCleanCode.ag" #-} True {-# LINE 3312 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule360 #-}- {-# LINE 419 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 423 "./src-ag/PrintCleanCode.ag" #-} rule360 = \ (_ :: ()) ->- {-# LINE 419 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 423 "./src-ag/PrintCleanCode.ag" #-} text "_" {-# LINE 3318 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule361 #-}@@ -3385,15 +3385,15 @@ in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule364 #-}- {-# LINE 369 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 373 "./src-ag/PrintCleanCode.ag" #-} rule364 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: [PP_Doc]) ->- {-# LINE 369 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 373 "./src-ag/PrintCleanCode.ag" #-} _hdIpp : _tlIpps {-# LINE 3393 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule365 #-}- {-# LINE 409 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 413 "./src-ag/PrintCleanCode.ag" #-} rule365 = \ ((_hdIpp') :: PP_Doc) ((_tlIpps') :: [PP_Doc]) ->- {-# LINE 409 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 413 "./src-ag/PrintCleanCode.ag" #-} _hdIpp' : _tlIpps' {-# LINE 3399 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule366 #-}@@ -3443,15 +3443,15 @@ in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule375 #-}- {-# LINE 370 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 374 "./src-ag/PrintCleanCode.ag" #-} rule375 = \ (_ :: ()) ->- {-# LINE 370 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 374 "./src-ag/PrintCleanCode.ag" #-} [] {-# LINE 3451 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule376 #-}- {-# LINE 410 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 414 "./src-ag/PrintCleanCode.ag" #-} rule376 = \ (_ :: ()) ->- {-# LINE 410 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 414 "./src-ag/PrintCleanCode.ag" #-} [] {-# LINE 3457 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule377 #-}@@ -3545,21 +3545,21 @@ _chunksIpps {-# LINE 3547 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule383 #-}- {-# LINE 433 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 437 "./src-ag/PrintCleanCode.ag" #-} rule383 = \ (_ :: ()) ->- {-# LINE 433 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 437 "./src-ag/PrintCleanCode.ag" #-} False {-# LINE 3553 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule384 #-}- {-# LINE 467 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 471 "./src-ag/PrintCleanCode.ag" #-} rule384 = \ ((_lhsImainFile) :: String) ->- {-# LINE 467 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 471 "./src-ag/PrintCleanCode.ag" #-} _lhsImainFile {-# LINE 3559 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule385 #-}- {-# LINE 469 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 473 "./src-ag/PrintCleanCode.ag" #-} rule385 = \ ((_chunksIappendMain) :: [[PP_Doc]]) ((_chunksIimports) :: [String]) ((_lhsImainBlocksDoc) :: PP_Doc) ((_lhsImainName) :: String) ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIoptionsLine) :: String) ((_lhsIpragmaBlocks) :: String) _mainModuleFile ->- {-# LINE 469 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 473 "./src-ag/PrintCleanCode.ag" #-} writeModule _mainModuleFile ( [ pp $ _lhsIpragmaBlocks , pp $ _lhsIoptionsLine@@ -3572,15 +3572,15 @@ ) {-# LINE 3574 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule386 #-}- {-# LINE 480 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 484 "./src-ag/PrintCleanCode.ag" #-} rule386 = \ ((_lhsImainFile) :: String) ->- {-# LINE 480 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 484 "./src-ag/PrintCleanCode.ag" #-} replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ "_common") {-# LINE 3580 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule387 #-}- {-# LINE 482 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 486 "./src-ag/PrintCleanCode.ag" #-} rule387 = \ ((_chunksIappendCommon) :: [[PP_Doc]]) _commonFile ((_lhsIimportBlocks) :: PP_Doc) ((_lhsImainName) :: String) ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIoptionsLine) :: String) ((_lhsIpragmaBlocks) :: String) ((_lhsItextBlocks) :: PP_Doc) ->- {-# LINE 482 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 486 "./src-ag/PrintCleanCode.ag" #-} writeModule _commonFile ( [ pp $ _lhsIpragmaBlocks , pp $ _lhsIoptionsLine@@ -3592,9 +3592,9 @@ ) {-# LINE 3594 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule388 #-}- {-# LINE 492 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 496 "./src-ag/PrintCleanCode.ag" #-} rule388 = \ ((_chunksIgenSems) :: IO ()) _genCommonModule _genMainModule ->- {-# LINE 492 "./src-ag/PrintCleanCode.ag" #-}+ {-# LINE 496 "./src-ag/PrintCleanCode.ag" #-} do _genMainModule _genCommonModule _chunksIgenSems@@ -3657,6 +3657,8 @@ sem_Type ( TEither left_ right_ ) = sem_Type_TEither ( sem_Type left_ ) ( sem_Type right_ ) sem_Type ( TMap key_ value_ ) = sem_Type_TMap ( sem_Type key_ ) ( sem_Type value_ ) sem_Type ( TIntMap value_ ) = sem_Type_TIntMap ( sem_Type value_ )+sem_Type ( TSet tp_ ) = sem_Type_TSet ( sem_Type tp_ )+sem_Type ( TIntSet ) = sem_Type_TIntSet -- semantic domain newtype T_Type = T_Type {@@ -3699,7 +3701,7 @@ rule398 = \ (_ :: ()) -> {-# LINE 276 "./src-ag/PrintCleanCode.ag" #-} 2- {-# LINE 3703 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 3705 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule399 #-} {-# LINE 277 "./src-ag/PrintCleanCode.ag" #-} rule399 = \ _l _r ((_rightIcopy) :: Type) ->@@ -3707,19 +3709,19 @@ case _rightIcopy of Arr{} -> _l >-< _r _ -> _l >#< "->" >-< _r- {-# LINE 3711 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 3713 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule400 #-} {-# LINE 280 "./src-ag/PrintCleanCode.ag" #-} rule400 = \ ((_leftIpp) :: PP_Doc) ((_leftIprec) :: Int) -> {-# LINE 280 "./src-ag/PrintCleanCode.ag" #-} if _leftIprec <= 2 then pp_parens _leftIpp else _leftIpp- {-# LINE 3717 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 3719 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule401 #-} {-# LINE 281 "./src-ag/PrintCleanCode.ag" #-} rule401 = \ ((_rightIpp) :: PP_Doc) ((_rightIprec) :: Int) -> {-# LINE 281 "./src-ag/PrintCleanCode.ag" #-} if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp- {-# LINE 3723 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 3725 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule402 #-} rule402 = \ ((_leftIcopy) :: Type) ((_rightIcopy) :: Type) -> Arr _leftIcopy _rightIcopy@@ -3757,7 +3759,7 @@ rule406 = \ ((_rightIpp) :: PP_Doc) left_ -> {-# LINE 287 "./src-ag/PrintCleanCode.ag" #-} _rightIpp >#< " | " >#< (pp_block "" "" "&" $ map (\(n,ns) -> hv_sp $ map pp (n:ns)) left_)- {-# LINE 3761 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 3763 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule407 #-} rule407 = \ ((_rightIcopy) :: Type) left_ -> CtxApp left_ _rightIcopy@@ -3795,7 +3797,7 @@ rule411 = \ ((_rightIpp) :: PP_Doc) left_ -> {-# LINE 289 "./src-ag/PrintCleanCode.ag" #-} left_ >#< _rightIpp- {-# LINE 3799 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 3801 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule412 #-} rule412 = \ ((_rightIcopy) :: Type) left_ -> QuantApp left_ _rightIcopy@@ -3836,7 +3838,7 @@ rule416 = \ ((_argsIpps) :: PP_Docs) ((_funcIpp) :: PP_Doc) -> {-# LINE 284 "./src-ag/PrintCleanCode.ag" #-} pp "(" >#< hv_sp (_funcIpp : _argsIpps) >#< pp ")"- {-# LINE 3840 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 3842 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule417 #-} rule417 = \ ((_argsIcopy) :: Types) ((_funcIcopy) :: Type) -> TypeApp _funcIcopy _argsIcopy@@ -3877,13 +3879,13 @@ rule422 = \ (_ :: ()) -> {-# LINE 291 "./src-ag/PrintCleanCode.ag" #-} 5- {-# LINE 3881 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 3883 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule423 #-} {-# LINE 292 "./src-ag/PrintCleanCode.ag" #-} rule423 = \ ((_lhsInested) :: Bool) ((_tpsIpps) :: PP_Docs) -> {-# LINE 292 "./src-ag/PrintCleanCode.ag" #-} ppTuple _lhsInested _tpsIpps- {-# LINE 3887 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 3889 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule424 #-} rule424 = \ ((_tpsIcopy) :: Types) -> TupleType _tpsIcopy@@ -3918,13 +3920,13 @@ rule427 = \ (_ :: ()) -> {-# LINE 294 "./src-ag/PrintCleanCode.ag" #-} 5- {-# LINE 3922 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 3924 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule428 #-} {-# LINE 295 "./src-ag/PrintCleanCode.ag" #-} rule428 = \ ((_lhsInested) :: Bool) ((_tpsIpps) :: PP_Docs) -> {-# LINE 295 "./src-ag/PrintCleanCode.ag" #-} ppUnboxedTuple _lhsInested _tpsIpps- {-# LINE 3928 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 3930 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule429 #-} rule429 = \ ((_tpsIcopy) :: Types) -> UnboxedTupleType _tpsIcopy@@ -3959,13 +3961,13 @@ rule432 = \ (_ :: ()) -> {-# LINE 297 "./src-ag/PrintCleanCode.ag" #-} 5- {-# LINE 3963 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 3965 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule433 #-} {-# LINE 298 "./src-ag/PrintCleanCode.ag" #-} rule433 = \ ((_tpIpp) :: PP_Doc) -> {-# LINE 298 "./src-ag/PrintCleanCode.ag" #-} "[" >|< _tpIpp >|< "]"- {-# LINE 3969 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 3971 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule434 #-} rule434 = \ ((_tpIcopy) :: Type) -> List _tpIcopy@@ -3997,13 +3999,13 @@ rule437 = \ (_ :: ()) -> {-# LINE 300 "./src-ag/PrintCleanCode.ag" #-} 5- {-# LINE 4001 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 4003 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule438 #-} {-# LINE 301 "./src-ag/PrintCleanCode.ag" #-} rule438 = \ txt_ -> {-# LINE 301 "./src-ag/PrintCleanCode.ag" #-} if reallySimple txt_ then text txt_ else pp_parens (text txt_)- {-# LINE 4007 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 4009 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule439 #-} rule439 = \ txt_ -> SimpleType txt_@@ -4033,13 +4035,13 @@ rule441 = \ (_ :: ()) -> {-# LINE 303 "./src-ag/PrintCleanCode.ag" #-} 5- {-# LINE 4037 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 4039 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule442 #-} {-# LINE 304 "./src-ag/PrintCleanCode.ag" #-} rule442 = \ _prefix name_ params_ -> {-# LINE 304 "./src-ag/PrintCleanCode.ag" #-} _prefix >|< text name_ >#< hv_sp params_- {-# LINE 4043 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 4045 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule443 #-} {-# LINE 305 "./src-ag/PrintCleanCode.ag" #-} rule443 = \ deforested_ ->@@ -4047,7 +4049,7 @@ if deforested_ then text "T_" else empty- {-# LINE 4051 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 4053 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule444 #-} rule444 = \ deforested_ name_ params_ -> NontermType name_ params_ deforested_@@ -4079,13 +4081,13 @@ rule446 = \ (_ :: ()) -> {-# LINE 308 "./src-ag/PrintCleanCode.ag" #-} 5- {-# LINE 4083 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 4085 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule447 #-} {-# LINE 309 "./src-ag/PrintCleanCode.ag" #-} rule447 = \ ((_tpIpp) :: PP_Doc) -> {-# LINE 309 "./src-ag/PrintCleanCode.ag" #-} text "Maybe" >#< pp_parens _tpIpp- {-# LINE 4089 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 4091 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule448 #-} rule448 = \ ((_tpIcopy) :: Type) -> TMaybe _tpIcopy@@ -4123,13 +4125,13 @@ rule451 = \ (_ :: ()) -> {-# LINE 310 "./src-ag/PrintCleanCode.ag" #-} 5- {-# LINE 4127 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 4129 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule452 #-} {-# LINE 311 "./src-ag/PrintCleanCode.ag" #-} rule452 = \ ((_leftIpp) :: PP_Doc) ((_rightIpp) :: PP_Doc) -> {-# LINE 311 "./src-ag/PrintCleanCode.ag" #-} text "Either" >#< pp_parens _leftIpp >#< pp_parens _rightIpp- {-# LINE 4133 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 4135 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule453 #-} rule453 = \ ((_leftIcopy) :: Type) ((_rightIcopy) :: Type) -> TEither _leftIcopy _rightIcopy@@ -4170,13 +4172,13 @@ rule457 = \ (_ :: ()) -> {-# LINE 312 "./src-ag/PrintCleanCode.ag" #-} 5- {-# LINE 4174 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 4176 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule458 #-} {-# LINE 313 "./src-ag/PrintCleanCode.ag" #-} rule458 = \ ((_keyIpp) :: PP_Doc) ((_valueIpp) :: PP_Doc) -> {-# LINE 313 "./src-ag/PrintCleanCode.ag" #-} text "'Data.Map'.Map" >#< pp_parens _keyIpp >#< pp_parens _valueIpp- {-# LINE 4180 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 4182 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule459 #-} rule459 = \ ((_keyIcopy) :: Type) ((_valueIcopy) :: Type) -> TMap _keyIcopy _valueIcopy@@ -4214,13 +4216,13 @@ rule463 = \ (_ :: ()) -> {-# LINE 314 "./src-ag/PrintCleanCode.ag" #-} 5- {-# LINE 4218 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 4220 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule464 #-} {-# LINE 315 "./src-ag/PrintCleanCode.ag" #-} rule464 = \ ((_valueIpp) :: PP_Doc) -> {-# LINE 315 "./src-ag/PrintCleanCode.ag" #-} text "'Data.IntMap'.IntMap" >#< pp_parens _valueIpp- {-# LINE 4224 "dist/build/PrintCleanCode.hs"#-}+ {-# LINE 4226 "dist/build/PrintCleanCode.hs"#-} {-# INLINE rule465 #-} rule465 = \ ((_valueIcopy) :: Type) -> TIntMap _valueIcopy@@ -4230,6 +4232,82 @@ {-# INLINE rule467 #-} rule467 = \ ((_lhsInested) :: Bool) -> _lhsInested+{-# NOINLINE sem_Type_TSet #-}+sem_Type_TSet :: T_Type -> T_Type +sem_Type_TSet arg_tp_ = T_Type (return st50) where+ {-# NOINLINE st50 #-}+ !st50 = let+ v49 :: T_Type_v49 + v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let+ _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_))+ (T_Type_vOut49 _tpIcopy _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested)+ _lhsOprec :: Int+ _lhsOprec = rule468 ()+ _lhsOpp :: PP_Doc+ _lhsOpp = rule469 _tpIpp+ _copy = rule470 _tpIcopy+ _lhsOcopy :: Type+ _lhsOcopy = rule471 _copy+ _tpOnested = rule472 _lhsInested+ !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec+ in __result_ )+ in C_Type_s50 v49+ {-# INLINE rule468 #-}+ {-# LINE 316 "./src-ag/PrintCleanCode.ag" #-}+ rule468 = \ (_ :: ()) ->+ {-# LINE 316 "./src-ag/PrintCleanCode.ag" #-}+ 5+ {-# LINE 4261 "dist/build/PrintCleanCode.hs"#-}+ {-# INLINE rule469 #-}+ {-# LINE 317 "./src-ag/PrintCleanCode.ag" #-}+ rule469 = \ ((_tpIpp) :: PP_Doc) ->+ {-# LINE 317 "./src-ag/PrintCleanCode.ag" #-}+ text "'Data.Set'.Set" >#< pp_parens _tpIpp+ {-# LINE 4267 "dist/build/PrintCleanCode.hs"#-}+ {-# INLINE rule470 #-}+ rule470 = \ ((_tpIcopy) :: Type) ->+ TSet _tpIcopy+ {-# INLINE rule471 #-}+ rule471 = \ _copy ->+ _copy+ {-# INLINE rule472 #-}+ rule472 = \ ((_lhsInested) :: Bool) ->+ _lhsInested+{-# NOINLINE sem_Type_TIntSet #-}+sem_Type_TIntSet :: T_Type +sem_Type_TIntSet = T_Type (return st50) where+ {-# NOINLINE st50 #-}+ !st50 = let+ v49 :: T_Type_v49 + v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let+ _lhsOprec :: Int+ _lhsOprec = rule473 ()+ _lhsOpp :: PP_Doc+ _lhsOpp = rule474 ()+ _copy = rule475 ()+ _lhsOcopy :: Type+ _lhsOcopy = rule476 _copy+ !__result_ = T_Type_vOut49 _lhsOcopy _lhsOpp _lhsOprec+ in __result_ )+ in C_Type_s50 v49+ {-# INLINE rule473 #-}+ {-# LINE 318 "./src-ag/PrintCleanCode.ag" #-}+ rule473 = \ (_ :: ()) ->+ {-# LINE 318 "./src-ag/PrintCleanCode.ag" #-}+ 5+ {-# LINE 4299 "dist/build/PrintCleanCode.hs"#-}+ {-# INLINE rule474 #-}+ {-# LINE 319 "./src-ag/PrintCleanCode.ag" #-}+ rule474 = \ (_ :: ()) ->+ {-# LINE 319 "./src-ag/PrintCleanCode.ag" #-}+ text "'Data.IntSet'.IntSet"+ {-# LINE 4305 "dist/build/PrintCleanCode.hs"#-}+ {-# INLINE rule475 #-}+ rule475 = \ (_ :: ()) ->+ TIntSet+ {-# INLINE rule476 #-}+ rule476 = \ _copy ->+ _copy -- Types ------------------------------------------------------- -- wrapper@@ -4273,32 +4351,32 @@ (T_Type_vOut49 _hdIcopy _hdIpp _hdIprec) = inv_Type_s50 _hdX50 (T_Type_vIn49 _hdOnested) (T_Types_vOut52 _tlIcopy _tlIpps) = inv_Types_s53 _tlX53 (T_Types_vIn52 _tlOnested) _lhsOpps :: PP_Docs- _lhsOpps = rule468 _hdIpp _tlIpps- _copy = rule469 _hdIcopy _tlIcopy+ _lhsOpps = rule477 _hdIpp _tlIpps+ _copy = rule478 _hdIcopy _tlIcopy _lhsOcopy :: Types- _lhsOcopy = rule470 _copy- _hdOnested = rule471 _lhsInested- _tlOnested = rule472 _lhsInested+ _lhsOcopy = rule479 _copy+ _hdOnested = rule480 _lhsInested+ _tlOnested = rule481 _lhsInested !__result_ = T_Types_vOut52 _lhsOcopy _lhsOpps in __result_ ) in C_Types_s53 v52- {-# INLINE rule468 #-}+ {-# INLINE rule477 #-} {-# LINE 82 "./src-ag/PrintCleanCode.ag" #-}- rule468 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) ->+ rule477 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 82 "./src-ag/PrintCleanCode.ag" #-} _hdIpp : _tlIpps- {-# LINE 4291 "dist/build/PrintCleanCode.hs"#-}- {-# INLINE rule469 #-}- rule469 = \ ((_hdIcopy) :: Type) ((_tlIcopy) :: Types) ->+ {-# LINE 4369 "dist/build/PrintCleanCode.hs"#-}+ {-# INLINE rule478 #-}+ rule478 = \ ((_hdIcopy) :: Type) ((_tlIcopy) :: Types) -> (:) _hdIcopy _tlIcopy- {-# INLINE rule470 #-}- rule470 = \ _copy ->+ {-# INLINE rule479 #-}+ rule479 = \ _copy -> _copy- {-# INLINE rule471 #-}- rule471 = \ ((_lhsInested) :: Bool) ->+ {-# INLINE rule480 #-}+ rule480 = \ ((_lhsInested) :: Bool) -> _lhsInested- {-# INLINE rule472 #-}- rule472 = \ ((_lhsInested) :: Bool) ->+ {-# INLINE rule481 #-}+ rule481 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Types_Nil #-} sem_Types_Nil :: T_Types @@ -4308,22 +4386,22 @@ v52 :: T_Types_v52 v52 = \ !(T_Types_vIn52 _lhsInested) -> ( let _lhsOpps :: PP_Docs- _lhsOpps = rule473 ()- _copy = rule474 ()+ _lhsOpps = rule482 ()+ _copy = rule483 () _lhsOcopy :: Types- _lhsOcopy = rule475 _copy+ _lhsOcopy = rule484 _copy !__result_ = T_Types_vOut52 _lhsOcopy _lhsOpps in __result_ ) in C_Types_s53 v52- {-# INLINE rule473 #-}+ {-# INLINE rule482 #-} {-# LINE 83 "./src-ag/PrintCleanCode.ag" #-}- rule473 = \ (_ :: ()) ->+ rule482 = \ (_ :: ()) -> {-# LINE 83 "./src-ag/PrintCleanCode.ag" #-} []- {-# LINE 4324 "dist/build/PrintCleanCode.hs"#-}- {-# INLINE rule474 #-}- rule474 = \ (_ :: ()) ->+ {-# LINE 4402 "dist/build/PrintCleanCode.hs"#-}+ {-# INLINE rule483 #-}+ rule483 = \ (_ :: ()) -> []- {-# INLINE rule475 #-}- rule475 = \ _copy ->+ {-# INLINE rule484 #-}+ rule484 = \ _copy -> _copy
src-generated/PrintCode.hs view
@@ -34,7 +34,7 @@ {-# LINE 35 "dist/build/PrintCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity-{-# LINE 144 "./src-ag/Code.ag" #-}+{-# LINE 146 "./src-ag/Code.ag" #-} -- Unboxed tuples -- unbox Whether unboxed tuples are wanted or not@@ -71,7 +71,7 @@ = foldr (\v r -> (v >#< "`seq`") `next` pp_parens r) expr strictArgs {-# LINE 73 "dist/build/PrintCode.hs" #-} -{-# LINE 299 "./src-ag/PrintCode.ag" #-}+{-# LINE 303 "./src-ag/PrintCode.ag" #-} reallySimple :: String -> Bool@@ -86,19 +86,19 @@ {-# LINE 88 "dist/build/PrintCode.hs" #-} -{-# LINE 400 "./src-ag/PrintCode.ag" #-}+{-# LINE 404 "./src-ag/PrintCode.ag" #-} locname' :: Identifier -> [Char] locname' n = "_loc_" ++ getName n {-# LINE 94 "dist/build/PrintCode.hs" #-} -{-# LINE 475 "./src-ag/PrintCode.ag" #-}+{-# LINE 479 "./src-ag/PrintCode.ag" #-} renderDocs :: [PP_Doc] -> String renderDocs pps = foldr (.) id (map (\d -> (disp d 50000) . ( '\n':) ) pps) "" {-# LINE 100 "dist/build/PrintCode.hs" #-} -{-# LINE 523 "./src-ag/PrintCode.ag" #-}+{-# LINE 527 "./src-ag/PrintCode.ag" #-} writeModule :: FilePath -> [PP_Doc] -> IO () writeModule path docs@@ -174,9 +174,9 @@ ["{" >#< _leftIpp >#< "->", _exprIpp >#< "}"] {-# LINE 176 "dist/build/PrintCode.hs"#-} {-# INLINE rule1 #-}- {-# LINE 424 "./src-ag/PrintCode.ag" #-}+ {-# LINE 428 "./src-ag/PrintCode.ag" #-} rule1 = \ (_ :: ()) ->- {-# LINE 424 "./src-ag/PrintCode.ag" #-}+ {-# LINE 428 "./src-ag/PrintCode.ag" #-} False {-# LINE 182 "dist/build/PrintCode.hs"#-} {-# INLINE rule2 #-}@@ -409,15 +409,15 @@ ++ [Map.findWithDefault empty (BlockOther, Just $ identifier name_) _lhsItextBlockMap] {-# LINE 411 "dist/build/PrintCode.hs"#-} {-# INLINE rule18 #-}- {-# LINE 483 "./src-ag/PrintCode.ag" #-}+ {-# LINE 487 "./src-ag/PrintCode.ag" #-} rule18 = \ ((_lhsImainName) :: String) name_ ->- {-# LINE 483 "./src-ag/PrintCode.ag" #-}+ {-# LINE 487 "./src-ag/PrintCode.ag" #-} ["import " ++ _lhsImainName ++ "_" ++ name_ ++ "\n"] {-# LINE 417 "dist/build/PrintCode.hs"#-} {-# INLINE rule19 #-}- {-# LINE 490 "./src-ag/PrintCode.ag" #-}+ {-# LINE 494 "./src-ag/PrintCode.ag" #-} rule19 = \ ((_commentIpp) :: PP_Doc) ((_dataDefIpps) :: PP_Docs) ((_lhsIoptions) :: Options) ((_semDomIpps) :: PP_Docs) ((_semWrapperIpps) :: PP_Docs) ->- {-# LINE 490 "./src-ag/PrintCode.ag" #-}+ {-# LINE 494 "./src-ag/PrintCode.ag" #-} [ [_commentIpp] , _dataDefIpps , _semDomIpps@@ -425,18 +425,18 @@ ] {-# LINE 427 "dist/build/PrintCode.hs"#-} {-# INLINE rule20 #-}- {-# LINE 496 "./src-ag/PrintCode.ag" #-}+ {-# LINE 500 "./src-ag/PrintCode.ag" #-} rule20 = \ ((_cataFunIpps) :: PP_Docs) ((_commentIpp) :: PP_Doc) ((_lhsIoptions) :: Options) ((_semWrapperIpps) :: PP_Docs) ->- {-# LINE 496 "./src-ag/PrintCode.ag" #-}+ {-# LINE 500 "./src-ag/PrintCode.ag" #-} [ [_commentIpp] , _cataFunIpps , if reference _lhsIoptions then [] else _semWrapperIpps ] {-# LINE 436 "dist/build/PrintCode.hs"#-} {-# INLINE rule21 #-}- {-# LINE 506 "./src-ag/PrintCode.ag" #-}+ {-# LINE 510 "./src-ag/PrintCode.ag" #-} rule21 = \ ((_commentIpp) :: PP_Doc) _exports ((_infoIpps) :: PP_Docs) ((_lhsImainName) :: String) ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIoptionsLine) :: String) ((_lhsIpragmaBlocks) :: String) ((_lhsItextBlockMap) :: Map BlockInfo PP_Doc) _outputfile ((_semFunctionsIpps) :: PP_Docs) name_ ->- {-# LINE 506 "./src-ag/PrintCode.ag" #-}+ {-# LINE 510 "./src-ag/PrintCode.ag" #-} writeModule _outputfile [ pp $ _lhsIpragmaBlocks , pp $ Map.findWithDefault empty (BlockPragma, Just $ identifier name_) _lhsItextBlockMap@@ -451,9 +451,9 @@ ] {-# LINE 453 "dist/build/PrintCode.hs"#-} {-# INLINE rule22 #-}- {-# LINE 521 "./src-ag/PrintCode.ag" #-}+ {-# LINE 525 "./src-ag/PrintCode.ag" #-} rule22 = \ semNames_ ->- {-# LINE 521 "./src-ag/PrintCode.ag" #-}+ {-# LINE 525 "./src-ag/PrintCode.ag" #-} concat $ intersperse "," semNames_ {-# LINE 459 "dist/build/PrintCode.hs"#-} {-# INLINE rule23 #-}@@ -1129,9 +1129,9 @@ ) {-# LINE 1131 "dist/build/PrintCode.hs"#-} {-# INLINE rule118 #-}- {-# LINE 321 "./src-ag/PrintCode.ag" #-}+ {-# LINE 325 "./src-ag/PrintCode.ag" #-} rule118 = \ strict_ ->- {-# LINE 321 "./src-ag/PrintCode.ag" #-}+ {-# LINE 325 "./src-ag/PrintCode.ag" #-} if strict_ then pp "!" else empty {-# LINE 1137 "dist/build/PrintCode.hs"#-} {-# INLINE rule119 #-}@@ -1545,9 +1545,9 @@ ) {-# LINE 1547 "dist/build/PrintCode.hs"#-} {-# INLINE rule156 #-}- {-# LINE 416 "./src-ag/PrintCode.ag" #-}+ {-# LINE 420 "./src-ag/PrintCode.ag" #-} rule156 = \ (_ :: ()) ->- {-# LINE 416 "./src-ag/PrintCode.ag" #-}+ {-# LINE 420 "./src-ag/PrintCode.ag" #-} True {-# LINE 1553 "dist/build/PrintCode.hs"#-} {-# INLINE rule157 #-}@@ -1648,9 +1648,9 @@ ) {-# LINE 1650 "dist/build/PrintCode.hs"#-} {-# INLINE rule171 #-}- {-# LINE 418 "./src-ag/PrintCode.ag" #-}+ {-# LINE 422 "./src-ag/PrintCode.ag" #-} rule171 = \ (_ :: ()) ->- {-# LINE 418 "./src-ag/PrintCode.ag" #-}+ {-# LINE 422 "./src-ag/PrintCode.ag" #-} False {-# LINE 1656 "dist/build/PrintCode.hs"#-} {-# INLINE rule172 #-}@@ -2146,9 +2146,9 @@ ) {-# LINE 2148 "dist/build/PrintCode.hs"#-} {-# INLINE rule230 #-}- {-# LINE 420 "./src-ag/PrintCode.ag" #-}+ {-# LINE 424 "./src-ag/PrintCode.ag" #-} rule230 = \ (_ :: ()) ->- {-# LINE 420 "./src-ag/PrintCode.ag" #-}+ {-# LINE 424 "./src-ag/PrintCode.ag" #-} False {-# LINE 2154 "dist/build/PrintCode.hs"#-} {-# INLINE rule231 #-}@@ -2427,9 +2427,9 @@ _addStrictGuard _pat3Ipp {-# LINE 2429 "dist/build/PrintCode.hs"#-} {-# INLINE rule261 #-}- {-# LINE 381 "./src-ag/PrintCode.ag" #-}+ {-# LINE 385 "./src-ag/PrintCode.ag" #-} rule261 = \ (_ :: ()) ->- {-# LINE 381 "./src-ag/PrintCode.ag" #-}+ {-# LINE 385 "./src-ag/PrintCode.ag" #-} False {-# LINE 2435 "dist/build/PrintCode.hs"#-} {-# INLINE rule262 #-}@@ -2462,9 +2462,9 @@ _pat3Ipp' {-# LINE 2464 "dist/build/PrintCode.hs"#-} {-# INLINE rule265 #-}- {-# LINE 381 "./src-ag/PrintCode.ag" #-}+ {-# LINE 385 "./src-ag/PrintCode.ag" #-} rule265 = \ (_ :: ()) ->- {-# LINE 381 "./src-ag/PrintCode.ag" #-}+ {-# LINE 385 "./src-ag/PrintCode.ag" #-} False {-# LINE 2470 "dist/build/PrintCode.hs"#-} {-# INLINE rule266 #-}@@ -2870,29 +2870,29 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule297 #-}- {-# LINE 353 "./src-ag/PrintCode.ag" #-}+ {-# LINE 357 "./src-ag/PrintCode.ag" #-} rule297 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) ->- {-# LINE 353 "./src-ag/PrintCode.ag" #-}+ {-# LINE 357 "./src-ag/PrintCode.ag" #-} if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable then \p -> "!" >|< p else id {-# LINE 2880 "dist/build/PrintCode.hs"#-} {-# INLINE rule298 #-}- {-# LINE 358 "./src-ag/PrintCode.ag" #-}+ {-# LINE 362 "./src-ag/PrintCode.ag" #-} rule298 = \ _addBang ((_patsIpps) :: [PP_Doc]) name_ ->- {-# LINE 358 "./src-ag/PrintCode.ag" #-}+ {-# LINE 362 "./src-ag/PrintCode.ag" #-} _addBang $ pp_parens $ name_ >#< hv_sp _patsIpps {-# LINE 2886 "dist/build/PrintCode.hs"#-} {-# INLINE rule299 #-}- {-# LINE 369 "./src-ag/PrintCode.ag" #-}+ {-# LINE 373 "./src-ag/PrintCode.ag" #-} rule299 = \ (_ :: ()) ->- {-# LINE 369 "./src-ag/PrintCode.ag" #-}+ {-# LINE 373 "./src-ag/PrintCode.ag" #-} False {-# LINE 2892 "dist/build/PrintCode.hs"#-} {-# INLINE rule300 #-}- {-# LINE 392 "./src-ag/PrintCode.ag" #-}+ {-# LINE 396 "./src-ag/PrintCode.ag" #-} rule300 = \ ((_patsIpps') :: [PP_Doc]) name_ ->- {-# LINE 392 "./src-ag/PrintCode.ag" #-}+ {-# LINE 396 "./src-ag/PrintCode.ag" #-} pp_parens $ name_ >#< hv_sp (map pp_parens _patsIpps') {-# LINE 2898 "dist/build/PrintCode.hs"#-} {-# INLINE rule301 #-}@@ -2941,29 +2941,29 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule307 #-}- {-# LINE 353 "./src-ag/PrintCode.ag" #-}+ {-# LINE 357 "./src-ag/PrintCode.ag" #-} rule307 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) ->- {-# LINE 353 "./src-ag/PrintCode.ag" #-}+ {-# LINE 357 "./src-ag/PrintCode.ag" #-} if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable then \p -> "!" >|< p else id {-# LINE 2951 "dist/build/PrintCode.hs"#-} {-# INLINE rule308 #-}- {-# LINE 359 "./src-ag/PrintCode.ag" #-}+ {-# LINE 363 "./src-ag/PrintCode.ag" #-} rule308 = \ _addBang ((_patsIpps) :: [PP_Doc]) ->- {-# LINE 359 "./src-ag/PrintCode.ag" #-}+ {-# LINE 363 "./src-ag/PrintCode.ag" #-} _addBang $ pp_block "(" ")" "," _patsIpps {-# LINE 2957 "dist/build/PrintCode.hs"#-} {-# INLINE rule309 #-}- {-# LINE 370 "./src-ag/PrintCode.ag" #-}+ {-# LINE 374 "./src-ag/PrintCode.ag" #-} rule309 = \ (_ :: ()) ->- {-# LINE 370 "./src-ag/PrintCode.ag" #-}+ {-# LINE 374 "./src-ag/PrintCode.ag" #-} False {-# LINE 2963 "dist/build/PrintCode.hs"#-} {-# INLINE rule310 #-}- {-# LINE 393 "./src-ag/PrintCode.ag" #-}+ {-# LINE 397 "./src-ag/PrintCode.ag" #-} rule310 = \ ((_patsIpps') :: [PP_Doc]) ->- {-# LINE 393 "./src-ag/PrintCode.ag" #-}+ {-# LINE 397 "./src-ag/PrintCode.ag" #-} pp_block "(" ")" "," _patsIpps' {-# LINE 2969 "dist/build/PrintCode.hs"#-} {-# INLINE rule311 #-}@@ -3016,65 +3016,65 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule317 #-}- {-# LINE 331 "./src-ag/PrintCode.ag" #-}+ {-# LINE 335 "./src-ag/PrintCode.ag" #-} rule317 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) _ppVar ->- {-# LINE 331 "./src-ag/PrintCode.ag" #-}+ {-# LINE 335 "./src-ag/PrintCode.ag" #-} if strictCases _lhsIoptions && not _lhsIisDeclOfLet then [_ppVar ] else [] {-# LINE 3026 "dist/build/PrintCode.hs"#-} {-# INLINE rule318 #-}- {-# LINE 335 "./src-ag/PrintCode.ag" #-}+ {-# LINE 339 "./src-ag/PrintCode.ag" #-} rule318 = \ ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) ((_patIstrictVars) :: [PP_Doc]) ->- {-# LINE 335 "./src-ag/PrintCode.ag" #-}+ {-# LINE 339 "./src-ag/PrintCode.ag" #-} if stricterCases _lhsIoptions && not _lhsIisDeclOfLet then _patIstrictVars else [] {-# LINE 3034 "dist/build/PrintCode.hs"#-} {-# INLINE rule319 #-}- {-# LINE 339 "./src-ag/PrintCode.ag" #-}+ {-# LINE 343 "./src-ag/PrintCode.ag" #-} rule319 = \ _strictPatVars _strictVar ->- {-# LINE 339 "./src-ag/PrintCode.ag" #-}+ {-# LINE 343 "./src-ag/PrintCode.ag" #-} _strictVar ++ _strictPatVars {-# LINE 3040 "dist/build/PrintCode.hs"#-} {-# INLINE rule320 #-}- {-# LINE 353 "./src-ag/PrintCode.ag" #-}+ {-# LINE 357 "./src-ag/PrintCode.ag" #-} rule320 = \ ((_lhsIbelowIrrefutable) :: Bool) ((_lhsIisDeclOfLet) :: Bool) ((_lhsIoptions) :: Options) ->- {-# LINE 353 "./src-ag/PrintCode.ag" #-}+ {-# LINE 357 "./src-ag/PrintCode.ag" #-} if bangpats _lhsIoptions && not _lhsIisDeclOfLet && not _lhsIbelowIrrefutable then \p -> "!" >|< p else id {-# LINE 3048 "dist/build/PrintCode.hs"#-} {-# INLINE rule321 #-}- {-# LINE 360 "./src-ag/PrintCode.ag" #-}+ {-# LINE 364 "./src-ag/PrintCode.ag" #-} rule321 = \ ((_lhsIoptions) :: Options) attr_ field_ ->- {-# LINE 360 "./src-ag/PrintCode.ag" #-}+ {-# LINE 364 "./src-ag/PrintCode.ag" #-} pp (attrname _lhsIoptions False field_ attr_) {-# LINE 3054 "dist/build/PrintCode.hs"#-} {-# INLINE rule322 #-}- {-# LINE 361 "./src-ag/PrintCode.ag" #-}+ {-# LINE 365 "./src-ag/PrintCode.ag" #-} rule322 = \ _addBang _ppVar ->- {-# LINE 361 "./src-ag/PrintCode.ag" #-}+ {-# LINE 365 "./src-ag/PrintCode.ag" #-} _addBang $ _ppVar {-# LINE 3060 "dist/build/PrintCode.hs"#-} {-# INLINE rule323 #-}- {-# LINE 362 "./src-ag/PrintCode.ag" #-}+ {-# LINE 366 "./src-ag/PrintCode.ag" #-} rule323 = \ ((_patIisUnderscore) :: Bool) ((_patIpp) :: PP_Doc) _ppVarBang ->- {-# LINE 362 "./src-ag/PrintCode.ag" #-}+ {-# LINE 366 "./src-ag/PrintCode.ag" #-} if _patIisUnderscore then _ppVarBang else _ppVarBang >|< "@" >|< _patIpp {-# LINE 3068 "dist/build/PrintCode.hs"#-} {-# INLINE rule324 #-}- {-# LINE 371 "./src-ag/PrintCode.ag" #-}+ {-# LINE 375 "./src-ag/PrintCode.ag" #-} rule324 = \ (_ :: ()) ->- {-# LINE 371 "./src-ag/PrintCode.ag" #-}+ {-# LINE 375 "./src-ag/PrintCode.ag" #-} False {-# LINE 3074 "dist/build/PrintCode.hs"#-} {-# INLINE rule325 #-}- {-# LINE 394 "./src-ag/PrintCode.ag" #-}+ {-# LINE 398 "./src-ag/PrintCode.ag" #-} rule325 = \ ((_lhsIoptions) :: Options) ((_patIpp') :: PP_Doc) attr_ field_ ->- {-# LINE 394 "./src-ag/PrintCode.ag" #-}+ {-# LINE 398 "./src-ag/PrintCode.ag" #-} let attribute | field_ == _LOC || field_ == nullIdent = locname' attr_ | otherwise = attrname _lhsIoptions False field_ attr_ in attribute >|< "@" >|< _patIpp'@@ -3121,27 +3121,27 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule331 #-}- {-# LINE 341 "./src-ag/PrintCode.ag" #-}+ {-# LINE 345 "./src-ag/PrintCode.ag" #-} rule331 = \ (_ :: ()) ->- {-# LINE 341 "./src-ag/PrintCode.ag" #-}+ {-# LINE 345 "./src-ag/PrintCode.ag" #-} [] {-# LINE 3129 "dist/build/PrintCode.hs"#-} {-# INLINE rule332 #-}- {-# LINE 365 "./src-ag/PrintCode.ag" #-}+ {-# LINE 369 "./src-ag/PrintCode.ag" #-} rule332 = \ ((_patIpp) :: PP_Doc) ->- {-# LINE 365 "./src-ag/PrintCode.ag" #-}+ {-# LINE 369 "./src-ag/PrintCode.ag" #-} text "~" >|< pp_parens _patIpp {-# LINE 3135 "dist/build/PrintCode.hs"#-} {-# INLINE rule333 #-}- {-# LINE 377 "./src-ag/PrintCode.ag" #-}+ {-# LINE 381 "./src-ag/PrintCode.ag" #-} rule333 = \ (_ :: ()) ->- {-# LINE 377 "./src-ag/PrintCode.ag" #-}+ {-# LINE 381 "./src-ag/PrintCode.ag" #-} True {-# LINE 3141 "dist/build/PrintCode.hs"#-} {-# INLINE rule334 #-}- {-# LINE 397 "./src-ag/PrintCode.ag" #-}+ {-# LINE 401 "./src-ag/PrintCode.ag" #-} rule334 = \ ((_patIpp) :: PP_Doc) ->- {-# LINE 397 "./src-ag/PrintCode.ag" #-}+ {-# LINE 401 "./src-ag/PrintCode.ag" #-} text "~" >|< pp_parens _patIpp {-# LINE 3147 "dist/build/PrintCode.hs"#-} {-# INLINE rule335 #-}@@ -3181,21 +3181,21 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule340 #-}- {-# LINE 366 "./src-ag/PrintCode.ag" #-}+ {-# LINE 370 "./src-ag/PrintCode.ag" #-} rule340 = \ (_ :: ()) ->- {-# LINE 366 "./src-ag/PrintCode.ag" #-}+ {-# LINE 370 "./src-ag/PrintCode.ag" #-} text "_" {-# LINE 3189 "dist/build/PrintCode.hs"#-} {-# INLINE rule341 #-}- {-# LINE 372 "./src-ag/PrintCode.ag" #-}+ {-# LINE 376 "./src-ag/PrintCode.ag" #-} rule341 = \ (_ :: ()) ->- {-# LINE 372 "./src-ag/PrintCode.ag" #-}+ {-# LINE 376 "./src-ag/PrintCode.ag" #-} True {-# LINE 3195 "dist/build/PrintCode.hs"#-} {-# INLINE rule342 #-}- {-# LINE 398 "./src-ag/PrintCode.ag" #-}+ {-# LINE 402 "./src-ag/PrintCode.ag" #-} rule342 = \ (_ :: ()) ->- {-# LINE 398 "./src-ag/PrintCode.ag" #-}+ {-# LINE 402 "./src-ag/PrintCode.ag" #-} text "_" {-# LINE 3201 "dist/build/PrintCode.hs"#-} {-# INLINE rule343 #-}@@ -3268,15 +3268,15 @@ in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule346 #-}- {-# LINE 348 "./src-ag/PrintCode.ag" #-}+ {-# LINE 352 "./src-ag/PrintCode.ag" #-} rule346 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: [PP_Doc]) ->- {-# LINE 348 "./src-ag/PrintCode.ag" #-}+ {-# LINE 352 "./src-ag/PrintCode.ag" #-} _hdIpp : _tlIpps {-# LINE 3276 "dist/build/PrintCode.hs"#-} {-# INLINE rule347 #-}- {-# LINE 388 "./src-ag/PrintCode.ag" #-}+ {-# LINE 392 "./src-ag/PrintCode.ag" #-} rule347 = \ ((_hdIpp') :: PP_Doc) ((_tlIpps') :: [PP_Doc]) ->- {-# LINE 388 "./src-ag/PrintCode.ag" #-}+ {-# LINE 392 "./src-ag/PrintCode.ag" #-} _hdIpp' : _tlIpps' {-# LINE 3282 "dist/build/PrintCode.hs"#-} {-# INLINE rule348 #-}@@ -3326,15 +3326,15 @@ in __result_ ) in C_Patterns_s44 v43 {-# INLINE rule357 #-}- {-# LINE 349 "./src-ag/PrintCode.ag" #-}+ {-# LINE 353 "./src-ag/PrintCode.ag" #-} rule357 = \ (_ :: ()) ->- {-# LINE 349 "./src-ag/PrintCode.ag" #-}+ {-# LINE 353 "./src-ag/PrintCode.ag" #-} [] {-# LINE 3334 "dist/build/PrintCode.hs"#-} {-# INLINE rule358 #-}- {-# LINE 389 "./src-ag/PrintCode.ag" #-}+ {-# LINE 393 "./src-ag/PrintCode.ag" #-} rule358 = \ (_ :: ()) ->- {-# LINE 389 "./src-ag/PrintCode.ag" #-}+ {-# LINE 393 "./src-ag/PrintCode.ag" #-} [] {-# LINE 3340 "dist/build/PrintCode.hs"#-} {-# INLINE rule359 #-}@@ -3428,21 +3428,21 @@ _chunksIpps {-# LINE 3430 "dist/build/PrintCode.hs"#-} {-# INLINE rule365 #-}- {-# LINE 412 "./src-ag/PrintCode.ag" #-}+ {-# LINE 416 "./src-ag/PrintCode.ag" #-} rule365 = \ (_ :: ()) ->- {-# LINE 412 "./src-ag/PrintCode.ag" #-}+ {-# LINE 416 "./src-ag/PrintCode.ag" #-} False {-# LINE 3436 "dist/build/PrintCode.hs"#-} {-# INLINE rule366 #-}- {-# LINE 446 "./src-ag/PrintCode.ag" #-}+ {-# LINE 450 "./src-ag/PrintCode.ag" #-} rule366 = \ ((_lhsImainFile) :: String) ->- {-# LINE 446 "./src-ag/PrintCode.ag" #-}+ {-# LINE 450 "./src-ag/PrintCode.ag" #-} _lhsImainFile {-# LINE 3442 "dist/build/PrintCode.hs"#-} {-# INLINE rule367 #-}- {-# LINE 448 "./src-ag/PrintCode.ag" #-}+ {-# LINE 452 "./src-ag/PrintCode.ag" #-} rule367 = \ ((_chunksIappendMain) :: [[PP_Doc]]) ((_chunksIimports) :: [String]) ((_lhsImainBlocksDoc) :: PP_Doc) ((_lhsImainName) :: String) ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIoptionsLine) :: String) ((_lhsIpragmaBlocks) :: String) _mainModuleFile ->- {-# LINE 448 "./src-ag/PrintCode.ag" #-}+ {-# LINE 452 "./src-ag/PrintCode.ag" #-} writeModule _mainModuleFile ( [ pp $ _lhsIpragmaBlocks , pp $ _lhsIoptionsLine@@ -3455,15 +3455,15 @@ ) {-# LINE 3457 "dist/build/PrintCode.hs"#-} {-# INLINE rule368 #-}- {-# LINE 459 "./src-ag/PrintCode.ag" #-}+ {-# LINE 463 "./src-ag/PrintCode.ag" #-} rule368 = \ ((_lhsImainFile) :: String) ->- {-# LINE 459 "./src-ag/PrintCode.ag" #-}+ {-# LINE 463 "./src-ag/PrintCode.ag" #-} replaceBaseName _lhsImainFile (takeBaseName _lhsImainFile ++ "_common") {-# LINE 3463 "dist/build/PrintCode.hs"#-} {-# INLINE rule369 #-}- {-# LINE 461 "./src-ag/PrintCode.ag" #-}+ {-# LINE 465 "./src-ag/PrintCode.ag" #-} rule369 = \ ((_chunksIappendCommon) :: [[PP_Doc]]) _commonFile ((_lhsIimportBlocks) :: PP_Doc) ((_lhsImainName) :: String) ((_lhsImoduleHeader) :: String -> String -> String -> Bool -> String) ((_lhsIoptionsLine) :: String) ((_lhsIpragmaBlocks) :: String) ((_lhsItextBlocks) :: PP_Doc) ->- {-# LINE 461 "./src-ag/PrintCode.ag" #-}+ {-# LINE 465 "./src-ag/PrintCode.ag" #-} writeModule _commonFile ( [ pp $ _lhsIpragmaBlocks , pp $ _lhsIoptionsLine@@ -3475,9 +3475,9 @@ ) {-# LINE 3477 "dist/build/PrintCode.hs"#-} {-# INLINE rule370 #-}- {-# LINE 471 "./src-ag/PrintCode.ag" #-}+ {-# LINE 475 "./src-ag/PrintCode.ag" #-} rule370 = \ ((_chunksIgenSems) :: IO ()) _genCommonModule _genMainModule ->- {-# LINE 471 "./src-ag/PrintCode.ag" #-}+ {-# LINE 475 "./src-ag/PrintCode.ag" #-} do _genMainModule _genCommonModule _chunksIgenSems@@ -3540,6 +3540,8 @@ sem_Type ( TEither left_ right_ ) = sem_Type_TEither ( sem_Type left_ ) ( sem_Type right_ ) sem_Type ( TMap key_ value_ ) = sem_Type_TMap ( sem_Type key_ ) ( sem_Type value_ ) sem_Type ( TIntMap value_ ) = sem_Type_TIntMap ( sem_Type value_ )+sem_Type ( TSet tp_ ) = sem_Type_TSet ( sem_Type tp_ )+sem_Type ( TIntSet ) = sem_Type_TIntSet -- semantic domain newtype T_Type = T_Type {@@ -3579,25 +3581,25 @@ rule380 = \ (_ :: ()) -> {-# LINE 259 "./src-ag/PrintCode.ag" #-} 2- {-# LINE 3583 "dist/build/PrintCode.hs"#-}+ {-# LINE 3585 "dist/build/PrintCode.hs"#-} {-# INLINE rule381 #-} {-# LINE 260 "./src-ag/PrintCode.ag" #-} rule381 = \ _l _r -> {-# LINE 260 "./src-ag/PrintCode.ag" #-} _l >#< "->" >-< _r- {-# LINE 3589 "dist/build/PrintCode.hs"#-}+ {-# LINE 3591 "dist/build/PrintCode.hs"#-} {-# INLINE rule382 #-} {-# LINE 261 "./src-ag/PrintCode.ag" #-} rule382 = \ ((_leftIpp) :: PP_Doc) ((_leftIprec) :: Int) -> {-# LINE 261 "./src-ag/PrintCode.ag" #-} if _leftIprec <= 2 then pp_parens _leftIpp else _leftIpp- {-# LINE 3595 "dist/build/PrintCode.hs"#-}+ {-# LINE 3597 "dist/build/PrintCode.hs"#-} {-# INLINE rule383 #-} {-# LINE 262 "./src-ag/PrintCode.ag" #-} rule383 = \ ((_rightIpp) :: PP_Doc) ((_rightIprec) :: Int) -> {-# LINE 262 "./src-ag/PrintCode.ag" #-} if _rightIprec < 2 then pp_parens _rightIpp else _rightIpp- {-# LINE 3601 "dist/build/PrintCode.hs"#-}+ {-# LINE 3603 "dist/build/PrintCode.hs"#-} {-# INLINE rule384 #-} rule384 = \ ((_lhsInested) :: Bool) -> _lhsInested@@ -3626,7 +3628,7 @@ rule386 = \ ((_rightIpp) :: PP_Doc) left_ -> {-# LINE 268 "./src-ag/PrintCode.ag" #-} (pp_block "(" ")" "," $ map (\(n,ns) -> hv_sp $ map pp (n:ns)) left_) >#< "=>" >#< _rightIpp- {-# LINE 3630 "dist/build/PrintCode.hs"#-}+ {-# LINE 3632 "dist/build/PrintCode.hs"#-} {-# INLINE rule387 #-} rule387 = \ ((_rightIprec) :: Int) -> _rightIprec@@ -3655,7 +3657,7 @@ rule389 = \ ((_rightIpp) :: PP_Doc) left_ -> {-# LINE 270 "./src-ag/PrintCode.ag" #-} left_ >#< _rightIpp- {-# LINE 3659 "dist/build/PrintCode.hs"#-}+ {-# LINE 3661 "dist/build/PrintCode.hs"#-} {-# INLINE rule390 #-} rule390 = \ ((_rightIprec) :: Int) -> _rightIprec@@ -3687,7 +3689,7 @@ rule392 = \ ((_argsIpps) :: PP_Docs) ((_funcIpp) :: PP_Doc) -> {-# LINE 265 "./src-ag/PrintCode.ag" #-} hv_sp (_funcIpp : _argsIpps)- {-# LINE 3691 "dist/build/PrintCode.hs"#-}+ {-# LINE 3693 "dist/build/PrintCode.hs"#-} {-# INLINE rule393 #-} rule393 = \ ((_funcIprec) :: Int) -> _funcIprec@@ -3719,13 +3721,13 @@ rule396 = \ (_ :: ()) -> {-# LINE 272 "./src-ag/PrintCode.ag" #-} 5- {-# LINE 3723 "dist/build/PrintCode.hs"#-}+ {-# LINE 3725 "dist/build/PrintCode.hs"#-} {-# INLINE rule397 #-} {-# LINE 273 "./src-ag/PrintCode.ag" #-} rule397 = \ ((_lhsInested) :: Bool) ((_tpsIpps) :: PP_Docs) -> {-# LINE 273 "./src-ag/PrintCode.ag" #-} ppTuple _lhsInested _tpsIpps- {-# LINE 3729 "dist/build/PrintCode.hs"#-}+ {-# LINE 3731 "dist/build/PrintCode.hs"#-} {-# INLINE rule398 #-} rule398 = \ ((_lhsInested) :: Bool) -> _lhsInested@@ -3751,13 +3753,13 @@ rule399 = \ (_ :: ()) -> {-# LINE 275 "./src-ag/PrintCode.ag" #-} 5- {-# LINE 3755 "dist/build/PrintCode.hs"#-}+ {-# LINE 3757 "dist/build/PrintCode.hs"#-} {-# INLINE rule400 #-} {-# LINE 276 "./src-ag/PrintCode.ag" #-} rule400 = \ ((_lhsInested) :: Bool) ((_tpsIpps) :: PP_Docs) -> {-# LINE 276 "./src-ag/PrintCode.ag" #-} ppUnboxedTuple _lhsInested _tpsIpps- {-# LINE 3761 "dist/build/PrintCode.hs"#-}+ {-# LINE 3763 "dist/build/PrintCode.hs"#-} {-# INLINE rule401 #-} rule401 = \ ((_lhsInested) :: Bool) -> _lhsInested@@ -3783,13 +3785,13 @@ rule402 = \ (_ :: ()) -> {-# LINE 278 "./src-ag/PrintCode.ag" #-} 5- {-# LINE 3787 "dist/build/PrintCode.hs"#-}+ {-# LINE 3789 "dist/build/PrintCode.hs"#-} {-# INLINE rule403 #-} {-# LINE 279 "./src-ag/PrintCode.ag" #-} rule403 = \ ((_tpIpp) :: PP_Doc) -> {-# LINE 279 "./src-ag/PrintCode.ag" #-} "[" >|< _tpIpp >|< "]"- {-# LINE 3793 "dist/build/PrintCode.hs"#-}+ {-# LINE 3795 "dist/build/PrintCode.hs"#-} {-# INLINE rule404 #-} rule404 = \ ((_lhsInested) :: Bool) -> _lhsInested@@ -3812,13 +3814,13 @@ rule405 = \ (_ :: ()) -> {-# LINE 281 "./src-ag/PrintCode.ag" #-} 5- {-# LINE 3816 "dist/build/PrintCode.hs"#-}+ {-# LINE 3818 "dist/build/PrintCode.hs"#-} {-# INLINE rule406 #-} {-# LINE 282 "./src-ag/PrintCode.ag" #-} rule406 = \ txt_ -> {-# LINE 282 "./src-ag/PrintCode.ag" #-} if reallySimple txt_ then text txt_ else pp_parens (text txt_)- {-# LINE 3822 "dist/build/PrintCode.hs"#-}+ {-# LINE 3824 "dist/build/PrintCode.hs"#-} {-# NOINLINE sem_Type_NontermType #-} sem_Type_NontermType :: (String) -> ([String]) -> (Bool) -> T_Type sem_Type_NontermType !arg_name_ !arg_params_ !arg_deforested_ = T_Type (return st50) where@@ -3839,13 +3841,13 @@ rule407 = \ (_ :: ()) -> {-# LINE 284 "./src-ag/PrintCode.ag" #-} 5- {-# LINE 3843 "dist/build/PrintCode.hs"#-}+ {-# LINE 3845 "dist/build/PrintCode.hs"#-} {-# INLINE rule408 #-} {-# LINE 285 "./src-ag/PrintCode.ag" #-} rule408 = \ _prefix name_ params_ -> {-# LINE 285 "./src-ag/PrintCode.ag" #-} _prefix >|< text name_ >#< hv_sp params_- {-# LINE 3849 "dist/build/PrintCode.hs"#-}+ {-# LINE 3851 "dist/build/PrintCode.hs"#-} {-# INLINE rule409 #-} {-# LINE 286 "./src-ag/PrintCode.ag" #-} rule409 = \ deforested_ ->@@ -3853,7 +3855,7 @@ if deforested_ then text "T_" else empty- {-# LINE 3857 "dist/build/PrintCode.hs"#-}+ {-# LINE 3859 "dist/build/PrintCode.hs"#-} {-# NOINLINE sem_Type_TMaybe #-} sem_Type_TMaybe :: T_Type -> T_Type sem_Type_TMaybe arg_tp_ = T_Type (return st50) where@@ -3876,13 +3878,13 @@ rule410 = \ (_ :: ()) -> {-# LINE 289 "./src-ag/PrintCode.ag" #-} 5- {-# LINE 3880 "dist/build/PrintCode.hs"#-}+ {-# LINE 3882 "dist/build/PrintCode.hs"#-} {-# INLINE rule411 #-} {-# LINE 290 "./src-ag/PrintCode.ag" #-} rule411 = \ ((_tpIpp) :: PP_Doc) -> {-# LINE 290 "./src-ag/PrintCode.ag" #-} text "Maybe" >#< pp_parens _tpIpp- {-# LINE 3886 "dist/build/PrintCode.hs"#-}+ {-# LINE 3888 "dist/build/PrintCode.hs"#-} {-# INLINE rule412 #-} rule412 = \ ((_lhsInested) :: Bool) -> _lhsInested@@ -3911,13 +3913,13 @@ rule413 = \ (_ :: ()) -> {-# LINE 291 "./src-ag/PrintCode.ag" #-} 5- {-# LINE 3915 "dist/build/PrintCode.hs"#-}+ {-# LINE 3917 "dist/build/PrintCode.hs"#-} {-# INLINE rule414 #-} {-# LINE 292 "./src-ag/PrintCode.ag" #-} rule414 = \ ((_leftIpp) :: PP_Doc) ((_rightIpp) :: PP_Doc) -> {-# LINE 292 "./src-ag/PrintCode.ag" #-} text "Either" >#< pp_parens _leftIpp >#< pp_parens _rightIpp- {-# LINE 3921 "dist/build/PrintCode.hs"#-}+ {-# LINE 3923 "dist/build/PrintCode.hs"#-} {-# INLINE rule415 #-} rule415 = \ ((_lhsInested) :: Bool) -> _lhsInested@@ -3949,13 +3951,13 @@ rule417 = \ (_ :: ()) -> {-# LINE 293 "./src-ag/PrintCode.ag" #-} 5- {-# LINE 3953 "dist/build/PrintCode.hs"#-}+ {-# LINE 3955 "dist/build/PrintCode.hs"#-} {-# INLINE rule418 #-} {-# LINE 294 "./src-ag/PrintCode.ag" #-} rule418 = \ ((_keyIpp) :: PP_Doc) ((_valueIpp) :: PP_Doc) -> {-# LINE 294 "./src-ag/PrintCode.ag" #-} text "Data.Map.Map" >#< pp_parens _keyIpp >#< pp_parens _valueIpp- {-# LINE 3959 "dist/build/PrintCode.hs"#-}+ {-# LINE 3961 "dist/build/PrintCode.hs"#-} {-# INLINE rule419 #-} rule419 = \ ((_lhsInested) :: Bool) -> _lhsInested@@ -3984,16 +3986,74 @@ rule421 = \ (_ :: ()) -> {-# LINE 295 "./src-ag/PrintCode.ag" #-} 5- {-# LINE 3988 "dist/build/PrintCode.hs"#-}+ {-# LINE 3990 "dist/build/PrintCode.hs"#-} {-# INLINE rule422 #-} {-# LINE 296 "./src-ag/PrintCode.ag" #-} rule422 = \ ((_valueIpp) :: PP_Doc) -> {-# LINE 296 "./src-ag/PrintCode.ag" #-} text "Data.IntMap.IntMap" >#< pp_parens _valueIpp- {-# LINE 3994 "dist/build/PrintCode.hs"#-}+ {-# LINE 3996 "dist/build/PrintCode.hs"#-} {-# INLINE rule423 #-} rule423 = \ ((_lhsInested) :: Bool) -> _lhsInested+{-# NOINLINE sem_Type_TSet #-}+sem_Type_TSet :: T_Type -> T_Type +sem_Type_TSet arg_tp_ = T_Type (return st50) where+ {-# NOINLINE st50 #-}+ !st50 = let+ v49 :: T_Type_v49 + v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let+ _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_))+ (T_Type_vOut49 _tpIpp _tpIprec) = inv_Type_s50 _tpX50 (T_Type_vIn49 _tpOnested)+ _lhsOprec :: Int+ _lhsOprec = rule424 ()+ _lhsOpp :: PP_Doc+ _lhsOpp = rule425 _tpIpp+ _tpOnested = rule426 _lhsInested+ !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec+ in __result_ )+ in C_Type_s50 v49+ {-# INLINE rule424 #-}+ {-# LINE 297 "./src-ag/PrintCode.ag" #-}+ rule424 = \ (_ :: ()) ->+ {-# LINE 297 "./src-ag/PrintCode.ag" #-}+ 5+ {-# LINE 4022 "dist/build/PrintCode.hs"#-}+ {-# INLINE rule425 #-}+ {-# LINE 298 "./src-ag/PrintCode.ag" #-}+ rule425 = \ ((_tpIpp) :: PP_Doc) ->+ {-# LINE 298 "./src-ag/PrintCode.ag" #-}+ text "Data.Set.Set" >#< pp_parens _tpIpp+ {-# LINE 4028 "dist/build/PrintCode.hs"#-}+ {-# INLINE rule426 #-}+ rule426 = \ ((_lhsInested) :: Bool) ->+ _lhsInested+{-# NOINLINE sem_Type_TIntSet #-}+sem_Type_TIntSet :: T_Type +sem_Type_TIntSet = T_Type (return st50) where+ {-# NOINLINE st50 #-}+ !st50 = let+ v49 :: T_Type_v49 + v49 = \ !(T_Type_vIn49 _lhsInested) -> ( let+ _lhsOprec :: Int+ _lhsOprec = rule427 ()+ _lhsOpp :: PP_Doc+ _lhsOpp = rule428 ()+ !__result_ = T_Type_vOut49 _lhsOpp _lhsOprec+ in __result_ )+ in C_Type_s50 v49+ {-# INLINE rule427 #-}+ {-# LINE 299 "./src-ag/PrintCode.ag" #-}+ rule427 = \ (_ :: ()) ->+ {-# LINE 299 "./src-ag/PrintCode.ag" #-}+ 5+ {-# LINE 4051 "dist/build/PrintCode.hs"#-}+ {-# INLINE rule428 #-}+ {-# LINE 300 "./src-ag/PrintCode.ag" #-}+ rule428 = \ (_ :: ()) ->+ {-# LINE 300 "./src-ag/PrintCode.ag" #-}+ text "Data.IntSet.IntSet"+ {-# LINE 4057 "dist/build/PrintCode.hs"#-} -- Types ------------------------------------------------------- -- wrapper@@ -4037,23 +4097,23 @@ (T_Type_vOut49 _hdIpp _hdIprec) = inv_Type_s50 _hdX50 (T_Type_vIn49 _hdOnested) (T_Types_vOut52 _tlIpps) = inv_Types_s53 _tlX53 (T_Types_vIn52 _tlOnested) _lhsOpps :: PP_Docs- _lhsOpps = rule424 _hdIpp _tlIpps- _hdOnested = rule425 _lhsInested- _tlOnested = rule426 _lhsInested+ _lhsOpps = rule429 _hdIpp _tlIpps+ _hdOnested = rule430 _lhsInested+ _tlOnested = rule431 _lhsInested !__result_ = T_Types_vOut52 _lhsOpps in __result_ ) in C_Types_s53 v52- {-# INLINE rule424 #-}+ {-# INLINE rule429 #-} {-# LINE 76 "./src-ag/PrintCode.ag" #-}- rule424 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) ->+ rule429 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 76 "./src-ag/PrintCode.ag" #-} _hdIpp : _tlIpps- {-# LINE 4052 "dist/build/PrintCode.hs"#-}- {-# INLINE rule425 #-}- rule425 = \ ((_lhsInested) :: Bool) ->+ {-# LINE 4112 "dist/build/PrintCode.hs"#-}+ {-# INLINE rule430 #-}+ rule430 = \ ((_lhsInested) :: Bool) -> _lhsInested- {-# INLINE rule426 #-}- rule426 = \ ((_lhsInested) :: Bool) ->+ {-# INLINE rule431 #-}+ rule431 = \ ((_lhsInested) :: Bool) -> _lhsInested {-# NOINLINE sem_Types_Nil #-} sem_Types_Nil :: T_Types @@ -4063,13 +4123,13 @@ v52 :: T_Types_v52 v52 = \ !(T_Types_vIn52 _lhsInested) -> ( let _lhsOpps :: PP_Docs- _lhsOpps = rule427 ()+ _lhsOpps = rule432 () !__result_ = T_Types_vOut52 _lhsOpps in __result_ ) in C_Types_s53 v52- {-# INLINE rule427 #-}+ {-# INLINE rule432 #-} {-# LINE 77 "./src-ag/PrintCode.ag" #-}- rule427 = \ (_ :: ()) ->+ rule432 = \ (_ :: ()) -> {-# LINE 77 "./src-ag/PrintCode.ag" #-} []- {-# LINE 4076 "dist/build/PrintCode.hs"#-}+ {-# LINE 4136 "dist/build/PrintCode.hs"#-}
src-generated/PrintOcamlCode.hs view
@@ -31,7 +31,7 @@ {-# LINE 32 "dist/build/PrintOcamlCode.hs" #-} import Control.Monad.Identity (Identity) import qualified Control.Monad.Identity-{-# LINE 144 "./src-ag/Code.ag" #-}+{-# LINE 146 "./src-ag/Code.ag" #-} -- Unboxed tuples -- unbox Whether unboxed tuples are wanted or not@@ -69,7 +69,7 @@ ppTuple False pps = "(" >|< pp_block " " ")" "," pps {-# LINE 71 "dist/build/PrintOcamlCode.hs" #-} -{-# LINE 175 "./src-ag/PrintOcamlCode.ag" #-}+{-# LINE 177 "./src-ag/PrintOcamlCode.ag" #-} toOcamlTC :: String -> String toOcamlTC (c:cs) = toLower c : cs@@ -124,9 +124,9 @@ in __result_ ) in C_CaseAlt_s2 v1 {-# INLINE rule0 #-}- {-# LINE 182 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 184 "./src-ag/PrintOcamlCode.ag" #-} rule0 = \ ((_exprIpp) :: PP_Doc) ((_leftIpp) :: PP_Doc) ->- {-# LINE 182 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 184 "./src-ag/PrintOcamlCode.ag" #-} _leftIpp >#< "->" >#< _exprIpp {-# LINE 132 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule1 #-}@@ -482,9 +482,9 @@ in __result_ ) in C_DataAlt_s14 v13 {-# INLINE rule30 #-}- {-# LINE 185 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 187 "./src-ag/PrintOcamlCode.ag" #-} rule30 = \ ((_argsIpps) :: PP_Docs) name_ ->- {-# LINE 185 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 187 "./src-ag/PrintOcamlCode.ag" #-} name_ >#< "of" >#< pp_block "" "" " * " (map pp_parens _argsIpps) {-# LINE 490 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_DataAlt_Record #-}@@ -502,9 +502,9 @@ in __result_ ) in C_DataAlt_s14 v13 {-# INLINE rule31 #-}- {-# LINE 186 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 188 "./src-ag/PrintOcamlCode.ag" #-} rule31 = \ ((_argsIpps) :: PP_Docs) ->- {-# LINE 186 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 188 "./src-ag/PrintOcamlCode.ag" #-} pp_block "{" "}" ";" _argsIpps {-# LINE 510 "dist/build/PrintOcamlCode.hs"#-} @@ -1051,9 +1051,9 @@ pp_parens $ vlist (_declsIpps ++ [_bodyIpp]) {-# LINE 1053 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule62 #-}- {-# LINE 218 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 220 "./src-ag/PrintOcamlCode.ag" #-} rule62 = \ (_ :: ()) ->- {-# LINE 218 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 220 "./src-ag/PrintOcamlCode.ag" #-} False {-# LINE 1059 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule63 #-}@@ -1124,9 +1124,9 @@ error "pp of Expr.Do not supported" {-# LINE 1126 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule69 #-}- {-# LINE 220 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 222 "./src-ag/PrintOcamlCode.ag" #-} rule69 = \ (_ :: ()) ->- {-# LINE 220 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 222 "./src-ag/PrintOcamlCode.ag" #-} False {-# LINE 1132 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule70 #-}@@ -1773,9 +1773,9 @@ in __result_ ) in C_NamedType_s35 v34 {-# INLINE rule117 #-}- {-# LINE 189 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 191 "./src-ag/PrintOcamlCode.ag" #-} rule117 = \ ((_tpIpp) :: PP_Doc) name_ ->- {-# LINE 189 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 191 "./src-ag/PrintOcamlCode.ag" #-} name_ >#< ":" >#< _tpIpp {-# LINE 1781 "dist/build/PrintOcamlCode.hs"#-} @@ -1905,15 +1905,15 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule120 #-}- {-# LINE 192 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 194 "./src-ag/PrintOcamlCode.ag" #-} rule120 = \ ((_patsIpps) :: PP_Docs) name_ ->- {-# LINE 192 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 194 "./src-ag/PrintOcamlCode.ag" #-} pp_parens $ name_ >#< hv_sp _patsIpps {-# LINE 1913 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule121 #-}- {-# LINE 202 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 204 "./src-ag/PrintOcamlCode.ag" #-} rule121 = \ (_ :: ()) ->- {-# LINE 202 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 204 "./src-ag/PrintOcamlCode.ag" #-} False {-# LINE 1919 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule122 #-}@@ -1946,15 +1946,15 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule125 #-}- {-# LINE 193 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 195 "./src-ag/PrintOcamlCode.ag" #-} rule125 = \ ((_patsIpps) :: PP_Docs) ->- {-# LINE 193 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 195 "./src-ag/PrintOcamlCode.ag" #-} pp_block "(" ")" "," _patsIpps {-# LINE 1954 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule126 #-}- {-# LINE 203 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 205 "./src-ag/PrintOcamlCode.ag" #-} rule126 = \ (_ :: ()) ->- {-# LINE 203 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 205 "./src-ag/PrintOcamlCode.ag" #-} False {-# LINE 1960 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule127 #-}@@ -1987,17 +1987,17 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule130 #-}- {-# LINE 195 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 197 "./src-ag/PrintOcamlCode.ag" #-} rule130 = \ ((_lhsIoptions) :: Options) ((_patIisUnderscore) :: Bool) attr_ field_ ->- {-# LINE 195 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 197 "./src-ag/PrintOcamlCode.ag" #-} if _patIisUnderscore then pp (attrname _lhsIoptions False field_ attr_) else error "pp of Pattern.Alias is only supported in the form (x@_)" {-# LINE 1997 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule131 #-}- {-# LINE 204 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 206 "./src-ag/PrintOcamlCode.ag" #-} rule131 = \ (_ :: ()) ->- {-# LINE 204 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 206 "./src-ag/PrintOcamlCode.ag" #-} False {-# LINE 2003 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule132 #-}@@ -2030,9 +2030,9 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule135 #-}- {-# LINE 198 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 200 "./src-ag/PrintOcamlCode.ag" #-} rule135 = \ (_ :: ()) ->- {-# LINE 198 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 200 "./src-ag/PrintOcamlCode.ag" #-} error "pp of Pattern.Irrefutable not supported" {-# LINE 2038 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule136 #-}@@ -2065,15 +2065,15 @@ in __result_ ) in C_Pattern_s41 v40 {-# INLINE rule140 #-}- {-# LINE 199 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 201 "./src-ag/PrintOcamlCode.ag" #-} rule140 = \ (_ :: ()) ->- {-# LINE 199 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 201 "./src-ag/PrintOcamlCode.ag" #-} text "_" {-# LINE 2073 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule141 #-}- {-# LINE 205 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 207 "./src-ag/PrintOcamlCode.ag" #-} rule141 = \ (_ :: ()) ->- {-# LINE 205 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 207 "./src-ag/PrintOcamlCode.ag" #-} True {-# LINE 2079 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule142 #-}@@ -2234,9 +2234,9 @@ _chunksIpps {-# LINE 2236 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule153 #-}- {-# LINE 214 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 216 "./src-ag/PrintOcamlCode.ag" #-} rule153 = \ (_ :: ()) ->- {-# LINE 214 "./src-ag/PrintOcamlCode.ag" #-}+ {-# LINE 216 "./src-ag/PrintOcamlCode.ag" #-} True {-# LINE 2242 "dist/build/PrintOcamlCode.hs"#-} {-# INLINE rule154 #-}@@ -2276,6 +2276,8 @@ sem_Type ( TEither left_ right_ ) = sem_Type_TEither ( sem_Type left_ ) ( sem_Type right_ ) sem_Type ( TMap key_ value_ ) = sem_Type_TMap ( sem_Type key_ ) ( sem_Type value_ ) sem_Type ( TIntMap value_ ) = sem_Type_TIntMap ( sem_Type value_ )+sem_Type ( TSet tp_ ) = sem_Type_TSet ( sem_Type tp_ )+sem_Type ( TIntSet ) = sem_Type_TIntSet -- semantic domain newtype T_Type = T_Type {@@ -2309,7 +2311,7 @@ rule156 = \ ((_leftIpp) :: PP_Doc) ((_rightIpp) :: PP_Doc) -> {-# LINE 161 "./src-ag/PrintOcamlCode.ag" #-} pp_parens (_leftIpp >#< "->" >#< _rightIpp)- {-# LINE 2313 "dist/build/PrintOcamlCode.hs"#-}+ {-# LINE 2315 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_CtxApp #-} sem_Type_CtxApp :: ([(String, [String])]) -> T_Type -> T_Type sem_Type_CtxApp _ arg_right_ = T_Type (return st50) where@@ -2329,7 +2331,7 @@ rule157 = \ (_ :: ()) -> {-# LINE 162 "./src-ag/PrintOcamlCode.ag" #-} error "pp of Type.CtxApp not supported"- {-# LINE 2333 "dist/build/PrintOcamlCode.hs"#-}+ {-# LINE 2335 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_QuantApp #-} sem_Type_QuantApp :: (String) -> T_Type -> T_Type sem_Type_QuantApp _ arg_right_ = T_Type (return st50) where@@ -2368,7 +2370,7 @@ rule159 = \ ((_argsIpps) :: PP_Docs) ((_funcIpp) :: PP_Doc) -> {-# LINE 163 "./src-ag/PrintOcamlCode.ag" #-} pp_parens (hv_sp (_argsIpps ++ [_funcIpp]))- {-# LINE 2372 "dist/build/PrintOcamlCode.hs"#-}+ {-# LINE 2374 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TupleType #-} sem_Type_TupleType :: T_Types -> T_Type sem_Type_TupleType arg_tps_ = T_Type (return st50) where@@ -2388,7 +2390,7 @@ rule160 = \ ((_tpsIpps) :: PP_Docs) -> {-# LINE 164 "./src-ag/PrintOcamlCode.ag" #-} pp_block "(" ")" "," _tpsIpps- {-# LINE 2392 "dist/build/PrintOcamlCode.hs"#-}+ {-# LINE 2394 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_UnboxedTupleType #-} sem_Type_UnboxedTupleType :: T_Types -> T_Type sem_Type_UnboxedTupleType arg_tps_ = T_Type (return st50) where@@ -2408,7 +2410,7 @@ rule161 = \ (_ :: ()) -> {-# LINE 166 "./src-ag/PrintOcamlCode.ag" #-} error "pp of Type.UnboxedTupleType is not supported"- {-# LINE 2412 "dist/build/PrintOcamlCode.hs"#-}+ {-# LINE 2414 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_List #-} sem_Type_List :: T_Type -> T_Type sem_Type_List arg_tp_ = T_Type (return st50) where@@ -2428,7 +2430,7 @@ rule162 = \ ((_tpIpp) :: PP_Doc) -> {-# LINE 167 "./src-ag/PrintOcamlCode.ag" #-} _tpIpp >#< "list"- {-# LINE 2432 "dist/build/PrintOcamlCode.hs"#-}+ {-# LINE 2434 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_SimpleType #-} sem_Type_SimpleType :: (String) -> T_Type sem_Type_SimpleType !arg_txt_ = T_Type (return st50) where@@ -2446,7 +2448,7 @@ rule163 = \ txt_ -> {-# LINE 168 "./src-ag/PrintOcamlCode.ag" #-} text txt_- {-# LINE 2450 "dist/build/PrintOcamlCode.hs"#-}+ {-# LINE 2452 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_NontermType #-} sem_Type_NontermType :: (String) -> ([String]) -> (Bool) -> T_Type sem_Type_NontermType !arg_name_ !arg_params_ _ = T_Type (return st50) where@@ -2464,7 +2466,7 @@ rule164 = \ name_ params_ -> {-# LINE 169 "./src-ag/PrintOcamlCode.ag" #-} pp_block "(" ")" " " (map text params_ ++ [text $ toOcamlTC name_])- {-# LINE 2468 "dist/build/PrintOcamlCode.hs"#-}+ {-# LINE 2470 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TMaybe #-} sem_Type_TMaybe :: T_Type -> T_Type sem_Type_TMaybe arg_tp_ = T_Type (return st50) where@@ -2484,7 +2486,7 @@ rule165 = \ ((_tpIpp) :: PP_Doc) -> {-# LINE 170 "./src-ag/PrintOcamlCode.ag" #-} _tpIpp >#< "opt"- {-# LINE 2488 "dist/build/PrintOcamlCode.hs"#-}+ {-# LINE 2490 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TEither #-} sem_Type_TEither :: T_Type -> T_Type -> T_Type sem_Type_TEither arg_left_ arg_right_ = T_Type (return st50) where@@ -2506,7 +2508,7 @@ rule166 = \ (_ :: ()) -> {-# LINE 171 "./src-ag/PrintOcamlCode.ag" #-} error "pp of Type.TEither is not supported"- {-# LINE 2510 "dist/build/PrintOcamlCode.hs"#-}+ {-# LINE 2512 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TMap #-} sem_Type_TMap :: T_Type -> T_Type -> T_Type sem_Type_TMap arg_key_ arg_value_ = T_Type (return st50) where@@ -2528,7 +2530,7 @@ rule167 = \ (_ :: ()) -> {-# LINE 172 "./src-ag/PrintOcamlCode.ag" #-} error "pp of Type.TMap is not supported"- {-# LINE 2532 "dist/build/PrintOcamlCode.hs"#-}+ {-# LINE 2534 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Type_TIntMap #-} sem_Type_TIntMap :: T_Type -> T_Type sem_Type_TIntMap arg_value_ = T_Type (return st50) where@@ -2548,7 +2550,45 @@ rule168 = \ (_ :: ()) -> {-# LINE 173 "./src-ag/PrintOcamlCode.ag" #-} error "pp of Type.TIntMap is not supported"- {-# LINE 2552 "dist/build/PrintOcamlCode.hs"#-}+ {-# LINE 2554 "dist/build/PrintOcamlCode.hs"#-}+{-# NOINLINE sem_Type_TSet #-}+sem_Type_TSet :: T_Type -> T_Type +sem_Type_TSet arg_tp_ = T_Type (return st50) where+ {-# NOINLINE st50 #-}+ !st50 = let+ v49 :: T_Type_v49 + v49 = \ !(T_Type_vIn49 ) -> ( let+ _tpX50 = Control.Monad.Identity.runIdentity (attach_T_Type (arg_tp_))+ (T_Type_vOut49 _tpIpp) = inv_Type_s50 _tpX50 (T_Type_vIn49 )+ _lhsOpp :: PP_Doc+ _lhsOpp = rule169 ()+ !__result_ = T_Type_vOut49 _lhsOpp+ in __result_ )+ in C_Type_s50 v49+ {-# INLINE rule169 #-}+ {-# LINE 174 "./src-ag/PrintOcamlCode.ag" #-}+ rule169 = \ (_ :: ()) ->+ {-# LINE 174 "./src-ag/PrintOcamlCode.ag" #-}+ error "pp of Type.TSet is not supported"+ {-# LINE 2574 "dist/build/PrintOcamlCode.hs"#-}+{-# NOINLINE sem_Type_TIntSet #-}+sem_Type_TIntSet :: T_Type +sem_Type_TIntSet = T_Type (return st50) where+ {-# NOINLINE st50 #-}+ !st50 = let+ v49 :: T_Type_v49 + v49 = \ !(T_Type_vIn49 ) -> ( let+ _lhsOpp :: PP_Doc+ _lhsOpp = rule170 ()+ !__result_ = T_Type_vOut49 _lhsOpp+ in __result_ )+ in C_Type_s50 v49+ {-# INLINE rule170 #-}+ {-# LINE 175 "./src-ag/PrintOcamlCode.ag" #-}+ rule170 = \ (_ :: ()) ->+ {-# LINE 175 "./src-ag/PrintOcamlCode.ag" #-}+ error "pp of Type.TIntSet is not supported"+ {-# LINE 2592 "dist/build/PrintOcamlCode.hs"#-} -- Types ------------------------------------------------------- -- wrapper@@ -2592,16 +2632,16 @@ (T_Type_vOut49 _hdIpp) = inv_Type_s50 _hdX50 (T_Type_vIn49 ) (T_Types_vOut52 _tlIpps) = inv_Types_s53 _tlX53 (T_Types_vIn52 ) _lhsOpps :: PP_Docs- _lhsOpps = rule169 _hdIpp _tlIpps+ _lhsOpps = rule171 _hdIpp _tlIpps !__result_ = T_Types_vOut52 _lhsOpps in __result_ ) in C_Types_s53 v52- {-# INLINE rule169 #-}+ {-# INLINE rule171 #-} {-# LINE 73 "./src-ag/PrintOcamlCode.ag" #-}- rule169 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) ->+ rule171 = \ ((_hdIpp) :: PP_Doc) ((_tlIpps) :: PP_Docs) -> {-# LINE 73 "./src-ag/PrintOcamlCode.ag" #-} _hdIpp : _tlIpps- {-# LINE 2605 "dist/build/PrintOcamlCode.hs"#-}+ {-# LINE 2645 "dist/build/PrintOcamlCode.hs"#-} {-# NOINLINE sem_Types_Nil #-} sem_Types_Nil :: T_Types sem_Types_Nil = T_Types (return st53) where@@ -2610,13 +2650,13 @@ v52 :: T_Types_v52 v52 = \ !(T_Types_vIn52 ) -> ( let _lhsOpps :: PP_Docs- _lhsOpps = rule170 ()+ _lhsOpps = rule172 () !__result_ = T_Types_vOut52 _lhsOpps in __result_ ) in C_Types_s53 v52- {-# INLINE rule170 #-}+ {-# INLINE rule172 #-} {-# LINE 74 "./src-ag/PrintOcamlCode.ag" #-}- rule170 = \ (_ :: ()) ->+ rule172 = \ (_ :: ()) -> {-# LINE 74 "./src-ag/PrintOcamlCode.ag" #-} []- {-# LINE 2623 "dist/build/PrintOcamlCode.hs"#-}+ {-# LINE 2663 "dist/build/PrintOcamlCode.hs"#-}
src/Ag.hs view
@@ -7,6 +7,7 @@ import Control.Monad (zipWithM_) import Data.Maybe import System.FilePath+import System.IO import qualified Data.Set as Set import qualified Data.Map as Map@@ -519,7 +520,7 @@ let ppErrs = PrErr.wrap_Errors (PrErr.sem_Errors errs) PrErr.Inh_Errors {PrErr.options_Inh_Errors = flags, PrErr.dups_Inh_Errors = []} if null errs then return fs- else do putStr . formatErrors $ PrErr.pp_Syn_Errors ppErrs+ else do hPutStrLn stderr . formatErrors $ PrErr.pp_Syn_Errors ppErrs failWithCode flags 1 return [] where
src/HsTokenScanner.hs view
@@ -29,7 +29,10 @@ iskw = locatein keywordstxt isop = locatein keywordsops isSymb = locatein specchars- isOpsym = locatein opchars+ -- See http://stackoverflow.com/questions/10548170/what-characters-are-permitted-for-haskell-operators+ isOpsym c = locatein opchars c+ -- For unicode operators+ || (not (isAscii c) && (isSymbol c || isPunctuation c)) isIdStart c = isLower c || c == '_'
src/Parser.hs view
@@ -11,6 +11,7 @@ import Data.List (intersperse) import Data.Char import Scanner (Input(..),scanLit,input)+import System.FilePath import Data.List import Expression import Macro --marcos@@ -62,8 +63,9 @@ depsAG :: Options -> [FilePath] -> String -> IO ([String], [Message Token Pos]) depsAG opts searchPath file- = do (_,_,fs,_,mesgs) <- parseFile False opts searchPath file- return (tail fs, mesgs) -- first file is always the file itself+ = do let fn = normalise file+ (_,_,fs,_,mesgs) <- parseFile False opts searchPath fn+ return (filter (/= fn) fs, mesgs) -- marcos: added the parameter 'agi' and the 'ext' part parseFile :: Bool -> Options -> [FilePath] -> String -> IO ([Elem],[String],[String], Maybe String,[Message Token Pos ])@@ -71,7 +73,7 @@ parseFile' :: [String] -> Bool -> Options -> [FilePath] -> String -> IO ([Elem],[String],[String], Maybe String,[Message Token Pos ]) parseFile' parsedfiles agi opts searchPath filename- = do file <- resolveFile opts searchPath filename+ = do file <- normalise `fmap` resolveFile opts searchPath filename if file `elem` parsedfiles then return ([], [], parsedfiles, Nothing, []) else do@@ -105,10 +107,11 @@ addElem e (es,fs,ext) = (e:es, fs, ext) addInc (fn,_) (es,fs,ext) | noIncludes opts = (es, fs, ext) -- skip includes- | otherwise = (es,fn:fs, ext)+ | otherwise = (es,normalise fn:fs, ext) addExt (fn,_) (es,fs,ext) | noIncludes opts = (es, fs, ext) -- skip includes- | otherwise = if agi then (es,fs, Just fn) else (es,fn:fs, ext) --marcos+ | otherwise = if agi then (es,fs, Just fn') else (es,fn':fs, ext) --marcos+ where fn' = normalise fn pCodescrapL = (\(ValToken _ str pos) -> (str, pos))<$> parseScrapL <?> "a code block"
src/Scanner.hs view
@@ -93,8 +93,8 @@ scan' ('=' : '>' : rs) = (reserved "=>" p, advc 2 p, rs) scan' ('=' :rs) = (reserved "=" p, advc 1 p, rs) scan' (':':'=':rs) = (reserved ":=" p, advc 2 p, rs)-- scan' (':':':':rs) {- | doubleColons opts -} = (reserved "::" p, advc 1 p, rs) -- recognize double colons too+ scan' (':':':':rs) = (reserved "::" p, advc 2 p, rs)+ scan' ('∷':rs) = (reserved "::" p, advc 1 p, rs) -- recognize unicode double colons too scan' (':' :rs) = (reserved ":" p, advc 1 p, rs) scan' ('|' :rs) = (reserved "|" p, advc 1 p, rs)
uuagc.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.8 build-type: Custom name: uuagc-version: 0.9.50+version: 0.9.50.1 license: BSD3 license-file: LICENSE maintainer: Jeroen Bransen <J.Bransen@uu.nl>@@ -29,7 +29,7 @@ build-depends: uuagc-cabal >= 1.0.2.0 build-depends: base >= 4, base < 5 -- Self dependency, depend on library below- build-depends: uuagc == 0.9.50+ build-depends: uuagc == 0.9.50.1 main-is: Main.hs hs-source-dirs: src-main