diff --git a/src-ag/Code.ag b/src-ag/Code.ag --- a/src-ag/Code.ag +++ b/src-ag/Code.ag @@ -130,6 +130,8 @@ | TMap key : Type value : Type | TIntMap value : Type + | TSet tp : Type + | TIntSet DATA Lhs | Pattern3 pat3 : Pattern | Pattern3SM pat3 : Pattern diff --git a/src-ag/DefaultRules.ag b/src-ag/DefaultRules.ag --- a/src-ag/DefaultRules.ag +++ b/src-ag/DefaultRules.ag @@ -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> 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) diff --git a/src-ag/PrintCleanCode.ag b/src-ag/PrintCleanCode.ag --- a/src-ag/PrintCleanCode.ag +++ b/src-ag/PrintCleanCode.ag @@ -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" { diff --git a/src-ag/PrintCode.ag b/src-ag/PrintCode.ag --- a/src-ag/PrintCode.ag +++ b/src-ag/PrintCode.ag @@ -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" { diff --git a/src-ag/PrintOcamlCode.ag b/src-ag/PrintOcamlCode.ag --- a/src-ag/PrintOcamlCode.ag +++ b/src-ag/PrintOcamlCode.ag @@ -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 diff --git a/src-generated/Code.hs b/src-generated/Code.hs --- a/src-generated/Code.hs +++ b/src-generated/Code.hs @@ -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 ------------------------------------------------------- {- diff --git a/src-generated/DefaultRules.hs b/src-generated/DefaultRules.hs --- a/src-generated/DefaultRules.hs +++ b/src-generated/DefaultRules.hs @@ -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> - {-# 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 diff --git a/src-generated/GenerateCode.hs b/src-generated/GenerateCode.hs --- a/src-generated/GenerateCode.hs +++ b/src-generated/GenerateCode.hs @@ -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 diff --git a/src-generated/PrintCleanCode.hs b/src-generated/PrintCleanCode.hs --- a/src-generated/PrintCleanCode.hs +++ b/src-generated/PrintCleanCode.hs @@ -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 diff --git a/src-generated/PrintCode.hs b/src-generated/PrintCode.hs --- a/src-generated/PrintCode.hs +++ b/src-generated/PrintCode.hs @@ -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"#-} diff --git a/src-generated/PrintOcamlCode.hs b/src-generated/PrintOcamlCode.hs --- a/src-generated/PrintOcamlCode.hs +++ b/src-generated/PrintOcamlCode.hs @@ -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"#-} diff --git a/src/Ag.hs b/src/Ag.hs --- a/src/Ag.hs +++ b/src/Ag.hs @@ -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 diff --git a/src/HsTokenScanner.hs b/src/HsTokenScanner.hs --- a/src/HsTokenScanner.hs +++ b/src/HsTokenScanner.hs @@ -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 == '_' diff --git a/src/Parser.hs b/src/Parser.hs --- a/src/Parser.hs +++ b/src/Parser.hs @@ -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" diff --git a/src/Scanner.hs b/src/Scanner.hs --- a/src/Scanner.hs +++ b/src/Scanner.hs @@ -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) diff --git a/uuagc.cabal b/uuagc.cabal --- a/uuagc.cabal +++ b/uuagc.cabal @@ -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 @@ -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