diff options
Diffstat (limited to 'ghc/compiler/yaccParser')
28 files changed, 418 insertions, 440 deletions
diff --git a/ghc/compiler/yaccParser/U_atype.hi b/ghc/compiler/yaccParser/U_atype.hi index 4652a7c653..eeb0e97bf3 100644 --- a/ghc/compiler/yaccParser/U_atype.hi +++ b/ghc/compiler/yaccParser/U_atype.hi @@ -5,5 +5,4 @@ import ProtoName(ProtoName) import U_list(U_list) data U_atype = U_atc ProtoName U_list Int rdU_atype :: _Addr -> _PackedString -> _State _RealWorld -> (U_atype, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/compiler/yaccParser/U_binding.hi b/ghc/compiler/yaccParser/U_binding.hi index 890ee5af55..d6a71c3513 100644 --- a/ghc/compiler/yaccParser/U_binding.hi +++ b/ghc/compiler/yaccParser/U_binding.hi @@ -5,7 +5,6 @@ import ProtoName(ProtoName) import U_hpragma(U_hpragma) import U_list(U_list) import U_ttype(U_ttype) -data U_binding = U_tbind U_list U_ttype U_list U_list Int U_hpragma | U_nbind U_ttype U_ttype Int U_hpragma | U_pbind U_list Int | U_fbind U_list Int | U_abind U_binding U_binding | U_lbind U_binding U_binding | U_ebind U_list U_binding Int | U_hbind U_list U_binding Int | U_ibind U_list ProtoName U_ttype U_binding Int U_hpragma | U_dbind U_list Int | U_cbind U_list U_ttype U_binding Int U_hpragma | U_sbind U_list U_ttype Int U_hpragma | U_mbind _PackedString U_list U_list Int | U_nullbind | U_import _PackedString U_list U_list U_binding _PackedString Int | U_hiding _PackedString U_list U_list U_binding _PackedString Int | U_vspec_uprag ProtoName U_list Int | U_vspec_ty_and_id U_ttype U_list | U_ispec_uprag ProtoName U_ttype Int | U_inline_uprag ProtoName U_list Int | U_deforest_uprag ProtoName Int | U_magicuf_uprag ProtoName _PackedString Int | U_abstract_uprag ProtoName Int | U_dspec_uprag ProtoName U_list Int +data U_binding = U_tbind U_list U_ttype U_list U_list Int U_hpragma | U_nbind U_ttype U_ttype Int U_hpragma | U_pbind U_list Int | U_fbind U_list Int | U_abind U_binding U_binding | U_ibind U_list ProtoName U_ttype U_binding Int U_hpragma | U_dbind U_list Int | U_cbind U_list U_ttype U_binding Int U_hpragma | U_sbind U_list U_ttype Int U_hpragma | U_mbind _PackedString U_list U_list Int | U_nullbind | U_import _PackedString U_list U_list U_binding _PackedString Int | U_hiding _PackedString U_list U_list U_binding _PackedString Int | U_vspec_uprag ProtoName U_list Int | U_vspec_ty_and_id U_ttype U_list | U_ispec_uprag ProtoName U_ttype Int | U_inline_uprag ProtoName U_list Int | U_deforest_uprag ProtoName Int | U_magicuf_uprag ProtoName _PackedString Int | U_abstract_uprag ProtoName Int | U_dspec_uprag ProtoName U_list Int rdU_binding :: _Addr -> _PackedString -> _State _RealWorld -> (U_binding, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/compiler/yaccParser/U_coresyn.hi b/ghc/compiler/yaccParser/U_coresyn.hi index f8cb66f89f..80f4eeeac1 100644 --- a/ghc/compiler/yaccParser/U_coresyn.hi +++ b/ghc/compiler/yaccParser/U_coresyn.hi @@ -8,5 +8,4 @@ import U_ttype(U_ttype) data U_coresyn = U_cobinder ProtoName U_ttype | U_colit U_literal | U_colocal U_coresyn | U_cononrec U_coresyn U_coresyn | U_corec U_list | U_corec_pair U_coresyn U_coresyn | U_covar U_coresyn | U_coliteral U_literal | U_cocon U_coresyn U_list U_list | U_coprim U_coresyn U_list U_list | U_colam U_list U_coresyn | U_cotylam U_list U_coresyn | U_coapp U_coresyn U_list | U_cotyapp U_coresyn U_ttype | U_cocase U_coresyn U_coresyn | U_colet U_coresyn U_coresyn | U_coscc U_coresyn U_coresyn | U_coalg_alts U_list U_coresyn | U_coalg_alt U_coresyn U_list U_coresyn | U_coprim_alts U_list U_coresyn | U_coprim_alt U_literal U_coresyn | U_conodeflt | U_cobinddeflt U_coresyn U_coresyn | U_co_primop _PackedString | U_co_ccall _PackedString Int U_list U_ttype | U_co_casm U_literal Int U_list U_ttype | U_co_preludedictscc U_coresyn | U_co_alldictscc _PackedString _PackedString U_coresyn | U_co_usercc _PackedString _PackedString _PackedString U_coresyn U_coresyn | U_co_autocc U_coresyn _PackedString _PackedString U_coresyn U_coresyn | U_co_dictcc U_coresyn _PackedString _PackedString U_coresyn U_coresyn | U_co_scc_noncaf | U_co_scc_caf | U_co_scc_nondupd | U_co_scc_dupd | U_co_id _PackedString | U_co_orig_id _PackedString _PackedString | U_co_sdselid ProtoName ProtoName | U_co_classopid ProtoName ProtoName | U_co_defmid ProtoName ProtoName | U_co_dfunid ProtoName U_ttype | U_co_constmid ProtoName ProtoName U_ttype | U_co_specid U_coresyn U_list | U_co_wrkrid U_coresyn rdU_coresyn :: _Addr -> _PackedString -> _State _RealWorld -> (U_coresyn, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/compiler/yaccParser/U_entidt.hi b/ghc/compiler/yaccParser/U_entidt.hi index b0b3f9e7ac..b7f7806064 100644 --- a/ghc/compiler/yaccParser/U_entidt.hi +++ b/ghc/compiler/yaccParser/U_entidt.hi @@ -4,5 +4,4 @@ import PreludePS(_PackedString) import U_list(U_list) data U_entidt = U_entid _PackedString | U_enttype _PackedString | U_enttypeall _PackedString | U_enttypecons _PackedString U_list | U_entclass _PackedString U_list | U_entmod _PackedString rdU_entidt :: _Addr -> _PackedString -> _State _RealWorld -> (U_entidt, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/compiler/yaccParser/U_finfot.hi b/ghc/compiler/yaccParser/U_finfot.hi index 3f76893626..7082efb8c0 100644 --- a/ghc/compiler/yaccParser/U_finfot.hi +++ b/ghc/compiler/yaccParser/U_finfot.hi @@ -1,7 +1,6 @@ {-# GHC_PRAGMA INTERFACE VERSION 5 #-} interface U_finfot where import PreludePS(_PackedString) -data U_finfot = U_nofinfo | U_finfo _PackedString _PackedString +data U_finfot = U_finfo _PackedString _PackedString rdU_finfot :: _Addr -> _PackedString -> _State _RealWorld -> (U_finfot, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/compiler/yaccParser/U_hpragma.hi b/ghc/compiler/yaccParser/U_hpragma.hi index 273b68e255..7c04df6faa 100644 --- a/ghc/compiler/yaccParser/U_hpragma.hi +++ b/ghc/compiler/yaccParser/U_hpragma.hi @@ -6,5 +6,4 @@ import U_coresyn(U_coresyn) import U_list(U_list) data U_hpragma = U_no_pragma | U_idata_pragma U_list U_list | U_itype_pragma | U_iclas_pragma U_list | U_iclasop_pragma U_hpragma U_hpragma | U_iinst_simpl_pragma _PackedString U_hpragma | U_iinst_const_pragma _PackedString U_hpragma U_list | U_iinst_spec_pragma _PackedString U_hpragma U_list | U_igen_pragma U_hpragma U_hpragma U_hpragma U_hpragma U_hpragma U_list | U_iarity_pragma Int | U_iupdate_pragma _PackedString | U_ideforest_pragma | U_istrictness_pragma _PackedString U_hpragma | U_imagic_unfolding_pragma _PackedString | U_iunfolding_pragma U_hpragma U_coresyn | U_iunfold_always | U_iunfold_if_args Int Int _PackedString Int | U_iname_pragma_pr ProtoName U_hpragma | U_itype_pragma_pr U_list Int U_hpragma | U_iinst_pragma_3s U_list Int U_hpragma U_list | U_idata_pragma_4s U_list rdU_hpragma :: _Addr -> _PackedString -> _State _RealWorld -> (U_hpragma, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/compiler/yaccParser/U_list.hi b/ghc/compiler/yaccParser/U_list.hi index 7888acb708..a04ed6cfbf 100644 --- a/ghc/compiler/yaccParser/U_list.hi +++ b/ghc/compiler/yaccParser/U_list.hi @@ -3,5 +3,4 @@ interface U_list where import PreludePS(_PackedString) data U_list = U_lcons _Addr U_list | U_lnil rdU_list :: _Addr -> _PackedString -> _State _RealWorld -> (U_list, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/compiler/yaccParser/U_literal.hi b/ghc/compiler/yaccParser/U_literal.hi index 81371541e0..a85bf0fe2a 100644 --- a/ghc/compiler/yaccParser/U_literal.hi +++ b/ghc/compiler/yaccParser/U_literal.hi @@ -3,5 +3,4 @@ interface U_literal where import PreludePS(_PackedString) data U_literal = U_integer _PackedString | U_intprim _PackedString | U_floatr _PackedString | U_doubleprim _PackedString | U_floatprim _PackedString | U_charr _PackedString | U_charprim _PackedString | U_string _PackedString | U_stringprim _PackedString | U_clitlit _PackedString _PackedString | U_norepi _PackedString | U_norepr _PackedString _PackedString | U_noreps _PackedString rdU_literal :: _Addr -> _PackedString -> _State _RealWorld -> (U_literal, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/compiler/yaccParser/U_pbinding.hi b/ghc/compiler/yaccParser/U_pbinding.hi index 65171f2e9b..7c9cb1321c 100644 --- a/ghc/compiler/yaccParser/U_pbinding.hi +++ b/ghc/compiler/yaccParser/U_pbinding.hi @@ -6,5 +6,4 @@ import U_list(U_list) import U_treeHACK(U_tree) data U_pbinding = U_pgrhs U_tree U_list U_binding _PackedString Int rdU_pbinding :: _Addr -> _PackedString -> _State _RealWorld -> (U_pbinding, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/compiler/yaccParser/U_treeHACK.hi b/ghc/compiler/yaccParser/U_treeHACK.hi index 940d424651..19aafd6311 100644 --- a/ghc/compiler/yaccParser/U_treeHACK.hi +++ b/ghc/compiler/yaccParser/U_treeHACK.hi @@ -9,7 +9,5 @@ import U_ttype(U_ttype) type U_infixTree = (ProtoName, U_tree, U_tree) data U_tree = U_hmodule _PackedString U_list U_list U_binding Int | U_ident ProtoName | U_lit U_literal | U_tuple U_list | U_ap U_tree U_tree | U_lambda U_list U_tree Int | U_let U_binding U_tree | U_casee U_tree U_list | U_ife U_tree U_tree U_tree | U_par U_tree | U_as ProtoName U_tree | U_lazyp U_tree | U_plusp U_tree U_literal | U_wildp | U_restr U_tree U_ttype | U_comprh U_tree U_list | U_qual U_tree U_tree | U_guard U_tree | U_def U_tree | U_tinfixop (ProtoName, U_tree, U_tree) | U_lsection U_tree ProtoName | U_rsection ProtoName U_tree | U_eenum U_tree U_list U_list | U_llist U_list | U_ccall _PackedString _PackedString U_list | U_scc _PackedString U_tree | U_negate U_tree rdU_infixTree :: _Addr -> _PackedString -> _State _RealWorld -> ((ProtoName, U_tree, U_tree), _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_tree :: _Addr -> _PackedString -> _State _RealWorld -> (U_tree, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/compiler/yaccParser/U_ttype.hi b/ghc/compiler/yaccParser/U_ttype.hi index 8dceb92f30..1f2db9a094 100644 --- a/ghc/compiler/yaccParser/U_ttype.hi +++ b/ghc/compiler/yaccParser/U_ttype.hi @@ -5,5 +5,4 @@ import ProtoName(ProtoName) import U_list(U_list) data U_ttype = U_tname ProtoName U_list | U_namedtvar ProtoName | U_tllist U_ttype | U_ttuple U_list | U_tfun U_ttype U_ttype | U_context U_list U_ttype | U_unidict ProtoName U_ttype | U_unityvartemplate ProtoName | U_uniforall U_list U_ttype | U_ty_maybe_nothing | U_ty_maybe_just U_ttype rdU_ttype :: _Addr -> _PackedString -> _State _RealWorld -> (U_ttype, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} diff --git a/ghc/compiler/yaccParser/UgenAll.hi b/ghc/compiler/yaccParser/UgenAll.hi index 85e484e417..a4f54058b6 100644 --- a/ghc/compiler/yaccParser/UgenAll.hi +++ b/ghc/compiler/yaccParser/UgenAll.hi @@ -2,7 +2,7 @@ interface UgenAll where import PreludePS(_PackedString) import PreludePrimIO(returnPrimIO, thenPrimIO) -import ProtoName(ProtoName) +import ProtoName(ProtoName(..)) import SrcLoc(SrcLoc) import U_atype(U_atype(..), rdU_atype) import U_binding(U_binding(..), rdU_binding) @@ -17,12 +17,13 @@ import U_treeHACK(U_infixTree(..), U_tree(..), rdU_infixTree, rdU_tree) import U_ttype(U_ttype(..), rdU_ttype) import UgenUtil(ParseTree(..), U_VOID_STAR(..), U_hstring(..), U_long(..), U_numId(..), U_stringId(..), U_unkId(..), UgnM(..), getSrcFileUgn, initUgn, ioToUgnM, mkSrcLocUgn, rdU_VOID_STAR, rdU_hstring, rdU_long, rdU_numId, rdU_stringId, rdU_unkId, returnUgn, setSrcFileUgn, thenUgn) infixr 1 `thenPrimIO` +data ProtoName data U_atype = U_atc ProtoName U_list Int -data U_binding = U_tbind U_list U_ttype U_list U_list Int U_hpragma | U_nbind U_ttype U_ttype Int U_hpragma | U_pbind U_list Int | U_fbind U_list Int | U_abind U_binding U_binding | U_lbind U_binding U_binding | U_ebind U_list U_binding Int | U_hbind U_list U_binding Int | U_ibind U_list ProtoName U_ttype U_binding Int U_hpragma | U_dbind U_list Int | U_cbind U_list U_ttype U_binding Int U_hpragma | U_sbind U_list U_ttype Int U_hpragma | U_mbind _PackedString U_list U_list Int | U_nullbind | U_import _PackedString U_list U_list U_binding _PackedString Int | U_hiding _PackedString U_list U_list U_binding _PackedString Int | U_vspec_uprag ProtoName U_list Int | U_vspec_ty_and_id U_ttype U_list | U_ispec_uprag ProtoName U_ttype Int | U_inline_uprag ProtoName U_list Int | U_deforest_uprag ProtoName Int | U_magicuf_uprag ProtoName _PackedString Int | U_abstract_uprag ProtoName Int | U_dspec_uprag ProtoName U_list Int +data U_binding = U_tbind U_list U_ttype U_list U_list Int U_hpragma | U_nbind U_ttype U_ttype Int U_hpragma | U_pbind U_list Int | U_fbind U_list Int | U_abind U_binding U_binding | U_ibind U_list ProtoName U_ttype U_binding Int U_hpragma | U_dbind U_list Int | U_cbind U_list U_ttype U_binding Int U_hpragma | U_sbind U_list U_ttype Int U_hpragma | U_mbind _PackedString U_list U_list Int | U_nullbind | U_import _PackedString U_list U_list U_binding _PackedString Int | U_hiding _PackedString U_list U_list U_binding _PackedString Int | U_vspec_uprag ProtoName U_list Int | U_vspec_ty_and_id U_ttype U_list | U_ispec_uprag ProtoName U_ttype Int | U_inline_uprag ProtoName U_list Int | U_deforest_uprag ProtoName Int | U_magicuf_uprag ProtoName _PackedString Int | U_abstract_uprag ProtoName Int | U_dspec_uprag ProtoName U_list Int data U_coresyn = U_cobinder ProtoName U_ttype | U_colit U_literal | U_colocal U_coresyn | U_cononrec U_coresyn U_coresyn | U_corec U_list | U_corec_pair U_coresyn U_coresyn | U_covar U_coresyn | U_coliteral U_literal | U_cocon U_coresyn U_list U_list | U_coprim U_coresyn U_list U_list | U_colam U_list U_coresyn | U_cotylam U_list U_coresyn | U_coapp U_coresyn U_list | U_cotyapp U_coresyn U_ttype | U_cocase U_coresyn U_coresyn | U_colet U_coresyn U_coresyn | U_coscc U_coresyn U_coresyn | U_coalg_alts U_list U_coresyn | U_coalg_alt U_coresyn U_list U_coresyn | U_coprim_alts U_list U_coresyn | U_coprim_alt U_literal U_coresyn | U_conodeflt | U_cobinddeflt U_coresyn U_coresyn | U_co_primop _PackedString | U_co_ccall _PackedString Int U_list U_ttype | U_co_casm U_literal Int U_list U_ttype | U_co_preludedictscc U_coresyn | U_co_alldictscc _PackedString _PackedString U_coresyn | U_co_usercc _PackedString _PackedString _PackedString U_coresyn U_coresyn | U_co_autocc U_coresyn _PackedString _PackedString U_coresyn U_coresyn | U_co_dictcc U_coresyn _PackedString _PackedString U_coresyn U_coresyn | U_co_scc_noncaf | U_co_scc_caf | U_co_scc_nondupd | U_co_scc_dupd | U_co_id _PackedString | U_co_orig_id _PackedString _PackedString | U_co_sdselid ProtoName ProtoName | U_co_classopid ProtoName ProtoName | U_co_defmid ProtoName ProtoName | U_co_dfunid ProtoName U_ttype | U_co_constmid ProtoName ProtoName U_ttype | U_co_specid U_coresyn U_list | U_co_wrkrid U_coresyn data U_entidt = U_entid _PackedString | U_enttype _PackedString | U_enttypeall _PackedString | U_enttypecons _PackedString U_list | U_entclass _PackedString U_list | U_entmod _PackedString -data U_finfot = U_nofinfo | U_finfo _PackedString _PackedString +data U_finfot = U_finfo _PackedString _PackedString data U_hpragma = U_no_pragma | U_idata_pragma U_list U_list | U_itype_pragma | U_iclas_pragma U_list | U_iclasop_pragma U_hpragma U_hpragma | U_iinst_simpl_pragma _PackedString U_hpragma | U_iinst_const_pragma _PackedString U_hpragma U_list | U_iinst_spec_pragma _PackedString U_hpragma U_list | U_igen_pragma U_hpragma U_hpragma U_hpragma U_hpragma U_hpragma U_list | U_iarity_pragma Int | U_iupdate_pragma _PackedString | U_ideforest_pragma | U_istrictness_pragma _PackedString U_hpragma | U_imagic_unfolding_pragma _PackedString | U_iunfolding_pragma U_hpragma U_coresyn | U_iunfold_always | U_iunfold_if_args Int Int _PackedString Int | U_iname_pragma_pr ProtoName U_hpragma | U_itype_pragma_pr U_list Int U_hpragma | U_iinst_pragma_3s U_list Int U_hpragma U_list | U_idata_pragma_4s U_list data U_list = U_lcons _Addr U_list | U_lnil data U_literal = U_integer _PackedString | U_intprim _PackedString | U_floatr _PackedString | U_doubleprim _PackedString | U_floatprim _PackedString | U_charr _PackedString | U_charprim _PackedString | U_string _PackedString | U_stringprim _PackedString | U_clitlit _PackedString _PackedString | U_norepi _PackedString | U_norepr _PackedString _PackedString | U_noreps _PackedString @@ -39,57 +40,30 @@ type U_stringId = _PackedString type U_unkId = ProtoName type UgnM a = _PackedString -> _State _RealWorld -> (a, _State _RealWorld) returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld) - {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-} thenPrimIO :: (_State _RealWorld -> (a, _State _RealWorld)) -> (a -> _State _RealWorld -> (b, _State _RealWorld)) -> _State _RealWorld -> (b, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "SSL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: u0 -> _State _RealWorld -> (u1, _State _RealWorld)) (u4 :: _State _RealWorld) -> case _APP_ u2 [ u4 ] of { _ALG_ _TUP_2 (u5 :: u0) (u6 :: _State _RealWorld) -> _APP_ u3 [ u5, u6 ]; _NO_DEFLT_ } _N_ #-} rdU_atype :: _Addr -> _PackedString -> _State _RealWorld -> (U_atype, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_binding :: _Addr -> _PackedString -> _State _RealWorld -> (U_binding, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_coresyn :: _Addr -> _PackedString -> _State _RealWorld -> (U_coresyn, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_entidt :: _Addr -> _PackedString -> _State _RealWorld -> (U_entidt, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_finfot :: _Addr -> _PackedString -> _State _RealWorld -> (U_finfot, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_hpragma :: _Addr -> _PackedString -> _State _RealWorld -> (U_hpragma, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_list :: _Addr -> _PackedString -> _State _RealWorld -> (U_list, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_literal :: _Addr -> _PackedString -> _State _RealWorld -> (U_literal, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_pbinding :: _Addr -> _PackedString -> _State _RealWorld -> (U_pbinding, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_infixTree :: _Addr -> _PackedString -> _State _RealWorld -> ((ProtoName, U_tree, U_tree), _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_tree :: _Addr -> _PackedString -> _State _RealWorld -> (U_tree, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_ttype :: _Addr -> _PackedString -> _State _RealWorld -> (U_ttype, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "U(P)LU(P)" {_A_ 3 _U_ 222 _N_ _N_ _N_ _N_} _N_ _N_ #-} getSrcFileUgn :: _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld) - {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 2 XC 4 \ (u0 :: _PackedString) (u1 :: _State _RealWorld) -> case u1 of { _ALG_ S# (u2 :: State# _RealWorld) -> _!_ _TUP_2 [_PackedString, (_State _RealWorld)] [u0, u1]; _NO_DEFLT_ } _N_ #-} initUgn :: _PackedString -> (_PackedString -> _State _RealWorld -> (a, _State _RealWorld)) -> _State _RealWorld -> (a, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _F_ _IF_ARGS_ 1 3 XXX 3 _/\_ u0 -> \ (u1 :: _PackedString) (u2 :: _PackedString -> _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: _State _RealWorld) -> _APP_ u2 [ u1, u3 ] _N_ #-} ioToUgnM :: (_State _RealWorld -> (a, _State _RealWorld)) -> _PackedString -> _State _RealWorld -> (a, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 102 _N_ _S_ "SAL" {_A_ 2 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 2 _/\_ u0 -> \ (u1 :: _State _RealWorld -> (u0, _State _RealWorld)) (u2 :: _State _RealWorld) -> _APP_ u1 [ u2 ] _N_} _F_ _IF_ARGS_ 1 3 XXX 2 _/\_ u0 -> \ (u1 :: _State _RealWorld -> (u0, _State _RealWorld)) (u2 :: _PackedString) (u3 :: _State _RealWorld) -> _APP_ u1 [ u3 ] _N_ #-} mkSrcLocUgn :: Int -> _PackedString -> _State _RealWorld -> (SrcLoc, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "LLU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_VOID_STAR :: _Addr -> _PackedString -> _State _RealWorld -> (_Addr, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXC 4 \ (u0 :: _Addr) (u1 :: _PackedString) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [_Addr, (_State _RealWorld)] [u0, u2]; _NO_DEFLT_ } _N_ #-} rdU_hstring :: _Addr -> _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld) - {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 3 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_long :: Int -> _PackedString -> _State _RealWorld -> (Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXC 4 \ (u0 :: Int) (u1 :: _PackedString) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [Int, (_State _RealWorld)] [u0, u2]; _NO_DEFLT_ } _N_ #-} rdU_numId :: _Addr -> _PackedString -> _State _RealWorld -> (Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 1 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_stringId :: _Addr -> _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld) - {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 1 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_unkId :: _Addr -> _PackedString -> _State _RealWorld -> (ProtoName, _State _RealWorld) - {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 1 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-} returnUgn :: b -> a -> _State _RealWorld -> (b, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 202 _N_ _S_ "LLS" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: u1) (u3 :: u0) (u4 :: _State _RealWorld) -> case u4 of { _ALG_ S# (u5 :: State# _RealWorld) -> _!_ _TUP_2 [u1, (_State _RealWorld)] [u2, u4]; _NO_DEFLT_ } _N_ #-} setSrcFileUgn :: _PackedString -> (_PackedString -> _State _RealWorld -> (a, _State _RealWorld)) -> _PackedString -> _State _RealWorld -> (a, _State _RealWorld) - {-# GHC_PRAGMA _A_ 4 _U_ 2102 _N_ _S_ "LSAL" {_A_ 3 _U_ 212 _N_ _N_ _F_ _IF_ARGS_ 1 3 XXX 3 _/\_ u0 -> \ (u1 :: _PackedString) (u2 :: _PackedString -> _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: _State _RealWorld) -> _APP_ u2 [ u1, u3 ] _N_} _F_ _IF_ARGS_ 1 4 XXXX 3 _/\_ u0 -> \ (u1 :: _PackedString) (u2 :: _PackedString -> _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: _PackedString) (u4 :: _State _RealWorld) -> _APP_ u2 [ u1, u4 ] _N_ #-} thenUgn :: (b -> _State _RealWorld -> (a, _State _RealWorld)) -> (a -> b -> _State _RealWorld -> (c, _State _RealWorld)) -> b -> _State _RealWorld -> (c, _State _RealWorld) - {-# GHC_PRAGMA _A_ 4 _U_ 1122 _N_ _S_ "SSLL" _F_ _ALWAYS_ _/\_ u0 u1 u2 -> \ (u3 :: u1 -> _State _RealWorld -> (u0, _State _RealWorld)) (u4 :: u0 -> u1 -> _State _RealWorld -> (u2, _State _RealWorld)) (u5 :: u1) (u6 :: _State _RealWorld) -> case _APP_ u3 [ u5, u6 ] of { _ALG_ _TUP_2 (u7 :: u0) (u8 :: _State _RealWorld) -> _APP_ u4 [ u7, u5, u8 ]; _NO_DEFLT_ } _N_ #-} diff --git a/ghc/compiler/yaccParser/UgenUtil.hi b/ghc/compiler/yaccParser/UgenUtil.hi index d5735cfe38..2aa2ea1003 100644 --- a/ghc/compiler/yaccParser/UgenUtil.hi +++ b/ghc/compiler/yaccParser/UgenUtil.hi @@ -7,7 +7,7 @@ import ProtoName(ProtoName) import SrcLoc(SrcLoc) infixr 1 `thenPrimIO` type ParseTree = _Addr -data ProtoName {-# GHC_PRAGMA Unk _PackedString | Imp _PackedString _PackedString [_PackedString] _PackedString | Prel Name #-} +data ProtoName type U_VOID_STAR = _Addr type U_hstring = _PackedString type U_long = Int @@ -16,33 +16,18 @@ type U_stringId = _PackedString type U_unkId = ProtoName type UgnM a = _PackedString -> _State _RealWorld -> (a, _State _RealWorld) getSrcFileUgn :: _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld) - {-# GHC_PRAGMA _A_ 2 _U_ 21 _N_ _S_ "LU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 2 XC 4 \ (u0 :: _PackedString) (u1 :: _State _RealWorld) -> case u1 of { _ALG_ S# (u2 :: State# _RealWorld) -> _!_ _TUP_2 [_PackedString, (_State _RealWorld)] [u0, u1]; _NO_DEFLT_ } _N_ #-} initUgn :: _PackedString -> (_PackedString -> _State _RealWorld -> (a, _State _RealWorld)) -> _State _RealWorld -> (a, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 212 _N_ _S_ "LSL" _F_ _IF_ARGS_ 1 3 XXX 3 _/\_ u0 -> \ (u1 :: _PackedString) (u2 :: _PackedString -> _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: _State _RealWorld) -> _APP_ u2 [ u1, u3 ] _N_ #-} ioToUgnM :: (_State _RealWorld -> (a, _State _RealWorld)) -> _PackedString -> _State _RealWorld -> (a, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 102 _N_ _S_ "SAL" {_A_ 2 _U_ 12 _N_ _N_ _F_ _IF_ARGS_ 1 2 XX 2 _/\_ u0 -> \ (u1 :: _State _RealWorld -> (u0, _State _RealWorld)) (u2 :: _State _RealWorld) -> _APP_ u1 [ u2 ] _N_} _F_ _IF_ARGS_ 1 3 XXX 2 _/\_ u0 -> \ (u1 :: _State _RealWorld -> (u0, _State _RealWorld)) (u2 :: _PackedString) (u3 :: _State _RealWorld) -> _APP_ u1 [ u3 ] _N_ #-} mkSrcLocUgn :: Int -> _PackedString -> _State _RealWorld -> (SrcLoc, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 121 _N_ _S_ "LLU(P)" {_A_ 3 _U_ 122 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_VOID_STAR :: _Addr -> _PackedString -> _State _RealWorld -> (_Addr, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXC 4 \ (u0 :: _Addr) (u1 :: _PackedString) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [_Addr, (_State _RealWorld)] [u0, u2]; _NO_DEFLT_ } _N_ #-} rdU_hstring :: _Addr -> _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld) - {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 3 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_long :: Int -> _PackedString -> _State _RealWorld -> (Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 201 _N_ _S_ "LAU(P)" {_A_ 2 _U_ 22 _N_ _N_ _N_ _N_} _F_ _IF_ARGS_ 0 3 XXC 4 \ (u0 :: Int) (u1 :: _PackedString) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [Int, (_State _RealWorld)] [u0, u2]; _NO_DEFLT_ } _N_ #-} rdU_numId :: _Addr -> _PackedString -> _State _RealWorld -> (Int, _State _RealWorld) - {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 1 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_stringId :: _Addr -> _PackedString -> _State _RealWorld -> (_PackedString, _State _RealWorld) - {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 1 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-} rdU_unkId :: _Addr -> _PackedString -> _State _RealWorld -> (ProtoName, _State _RealWorld) - {-# GHC_PRAGMA _A_ 1 _U_ 122 _N_ _S_ "U(P)" {_A_ 1 _U_ 201 _N_ _N_ _N_ _N_} _N_ _N_ #-} returnPrimIO :: a -> _State _RealWorld -> (a, _State _RealWorld) - {-# GHC_PRAGMA _A_ 2 _U_ 22 _N_ _S_ "LS" _F_ _ALWAYS_ _/\_ u0 -> \ (u1 :: u0) (u2 :: _State _RealWorld) -> case u2 of { _ALG_ S# (u3 :: State# _RealWorld) -> _!_ _TUP_2 [u0, (_State _RealWorld)] [u1, u2]; _NO_DEFLT_ } _N_ #-} returnUgn :: b -> a -> _State _RealWorld -> (b, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 202 _N_ _S_ "LLS" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: u1) (u3 :: u0) (u4 :: _State _RealWorld) -> case u4 of { _ALG_ S# (u5 :: State# _RealWorld) -> _!_ _TUP_2 [u1, (_State _RealWorld)] [u2, u4]; _NO_DEFLT_ } _N_ #-} setSrcFileUgn :: _PackedString -> (_PackedString -> _State _RealWorld -> (a, _State _RealWorld)) -> _PackedString -> _State _RealWorld -> (a, _State _RealWorld) - {-# GHC_PRAGMA _A_ 4 _U_ 2102 _N_ _S_ "LSAL" {_A_ 3 _U_ 212 _N_ _N_ _F_ _IF_ARGS_ 1 3 XXX 3 _/\_ u0 -> \ (u1 :: _PackedString) (u2 :: _PackedString -> _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: _State _RealWorld) -> _APP_ u2 [ u1, u3 ] _N_} _F_ _IF_ARGS_ 1 4 XXXX 3 _/\_ u0 -> \ (u1 :: _PackedString) (u2 :: _PackedString -> _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: _PackedString) (u4 :: _State _RealWorld) -> _APP_ u2 [ u1, u4 ] _N_ #-} thenPrimIO :: (_State _RealWorld -> (a, _State _RealWorld)) -> (a -> _State _RealWorld -> (b, _State _RealWorld)) -> _State _RealWorld -> (b, _State _RealWorld) - {-# GHC_PRAGMA _A_ 3 _U_ 112 _N_ _S_ "SSL" _F_ _ALWAYS_ _/\_ u0 u1 -> \ (u2 :: _State _RealWorld -> (u0, _State _RealWorld)) (u3 :: u0 -> _State _RealWorld -> (u1, _State _RealWorld)) (u4 :: _State _RealWorld) -> case _APP_ u2 [ u4 ] of { _ALG_ _TUP_2 (u5 :: u0) (u6 :: _State _RealWorld) -> _APP_ u3 [ u5, u6 ]; _NO_DEFLT_ } _N_ #-} thenUgn :: (b -> _State _RealWorld -> (a, _State _RealWorld)) -> (a -> b -> _State _RealWorld -> (c, _State _RealWorld)) -> b -> _State _RealWorld -> (c, _State _RealWorld) - {-# GHC_PRAGMA _A_ 4 _U_ 1122 _N_ _S_ "SSLL" _F_ _ALWAYS_ _/\_ u0 u1 u2 -> \ (u3 :: u1 -> _State _RealWorld -> (u0, _State _RealWorld)) (u4 :: u0 -> u1 -> _State _RealWorld -> (u2, _State _RealWorld)) (u5 :: u1) (u6 :: _State _RealWorld) -> case _APP_ u3 [ u5, u6 ] of { _ALG_ _TUP_2 (u7 :: u0) (u8 :: _State _RealWorld) -> _APP_ u4 [ u7, u5, u8 ]; _NO_DEFLT_ } _N_ #-} diff --git a/ghc/compiler/yaccParser/binding.ugn b/ghc/compiler/yaccParser/binding.ugn index 6c7b19e079..680a0b16ad 100644 --- a/ghc/compiler/yaccParser/binding.ugn +++ b/ghc/compiler/yaccParser/binding.ugn @@ -29,14 +29,18 @@ type binding; gfline : long; >; abind : < gabindfst : binding; gabindsnd : binding; >; +/*OLD:95/08: lbind : < glbindfst : binding; glbindsnd : binding; >; - ebind : < gebindl : list; +*/ +/*OLD:95/08: ebind : < gebindl : list; gebind : binding; geline : long; >; - hbind : < ghbindl : list; +*/ +/*OLD: 95/08: hbind : < ghbindl : list; ghbind : binding; ghline : long; >; +*/ ibind : < gibindc : list; gibindid : unkId; gibindi : ttype; @@ -65,6 +69,11 @@ type binding; giebinddef : binding; giebindfile : stringId; giebindline : long; >; +/* "hiding" is used in a funny way: + it has to have the *exact* same structure as "import"; + because what we do is: create an "import" then change + its tag to "hiding". Yeeps. (WDP 95/08) +*/ hiding : < gihbindmod : stringId; gihbindexp : list; gihbindren : list; diff --git a/ghc/compiler/yaccParser/finfot.ugn b/ghc/compiler/yaccParser/finfot.ugn index 9cf60eb75f..1ac68993bc 100644 --- a/ghc/compiler/yaccParser/finfot.ugn +++ b/ghc/compiler/yaccParser/finfot.ugn @@ -7,6 +7,6 @@ import UgenUtil import Util %}} type finfot; - nofinfo : < >; +/*OLD:95/08: nofinfo : < >; */ finfo : < fi1: stringId; fi2: stringId; >; end; diff --git a/ghc/compiler/yaccParser/hschooks.c b/ghc/compiler/yaccParser/hschooks.c index d19f628450..2700839712 100644 --- a/ghc/compiler/yaccParser/hschooks.c +++ b/ghc/compiler/yaccParser/hschooks.c @@ -36,8 +36,9 @@ StackOverflowHook (stack_size) #if 0 /* nothing to add here, really */ void -MallocFailHook (request_size) +MallocFailHook (request_size, msg) I_ request_size; /* in bytes */ + char *msg; { fprintf(stderr, "malloc: failed on request for %lu bytes\n", request_size); } diff --git a/ghc/compiler/yaccParser/hslexer.flex b/ghc/compiler/yaccParser/hslexer.flex index 7d0ce0fc60..902f3bd173 100644 --- a/ghc/compiler/yaccParser/hslexer.flex +++ b/ghc/compiler/yaccParser/hslexer.flex @@ -64,7 +64,7 @@ #define _isconstr(s) (CharTable[*s]&(_C)) BOOLEAN isconstr PROTO((char *)); /* fwd decl */ -unsigned char CharTable[NCHARS] = { +static unsigned char CharTable[NCHARS] = { /* nul */ 0, 0, 0, 0, 0, 0, 0, 0, /* bs */ 0, _S, _S, _S, _S, 0, 0, 0, /* dle */ 0, 0, 0, 0, 0, 0, 0, 0, @@ -115,12 +115,12 @@ char *input_filename = NULL; /* Always points to a dynamically allocated string * have been renamed as hsXXXXX rather than yyXXXXX. --JSM */ -int hslineno = 0; /* Line number at end of token */ +static int hslineno = 0; /* Line number at end of token */ int hsplineno = 0; /* Line number at end of previous token */ -int hscolno = 0; /* Column number at end of token */ +static int hscolno = 0; /* Column number at end of token */ int hspcolno = 0; /* Column number at end of previous token */ -int hsmlcolno = 0; /* Column number for multiple-rule lexemes */ +static int hsmlcolno = 0; /* Column number for multiple-rule lexemes */ int startlineno = 0; /* The line number where something starts */ int endlineno = 0; /* The line number where something ends */ @@ -142,12 +142,15 @@ static int nested_comments; /* For counting comment nesting depth */ /* Essential forward declarations */ -static VOID hsnewid PROTO((char *, int)); -static VOID layout_input PROTO((char *, int)); -static VOID cleartext (NO_ARGS); -static VOID addtext PROTO((char *, unsigned)); -static VOID addchar PROTO((char)); +static void hsnewid PROTO((char *, int)); +static void layout_input PROTO((char *, int)); +static void cleartext (NO_ARGS); +static void addtext PROTO((char *, unsigned)); +static void addchar PROTO((char)); static char *fetchtext PROTO((unsigned *)); +static void new_filename PROTO((char *)); +static int Return PROTO((int)); +static void hsentercontext PROTO((int)); /* Special file handling for IMPORTS */ /* Note: imports only ever go *one deep* (hence no need for a stack) WDP 94/09 */ @@ -817,10 +820,14 @@ NL [\n\r] * Simple comments and whitespace. Normally, we would just ignore these, but * in case we're processing a string escape, we need to note that we've seen * a gap. + * + * Note that we cater for a comment line that *doesn't* end in a newline. + * This is incorrect, strictly speaking, but seems like the right thing + * to do. Reported by Rajiv Mirani. (WDP 95/08) */ %} -<Code,GlaExt,StringEsc>"--".*{NL}{WS}* | +<Code,GlaExt,StringEsc>"--".*{NL}?{WS}* | <Code,GlaExt,GhcPragma,UserPragma,StringEsc>{WS}+ { noGap = FALSE; } %{ @@ -947,11 +954,11 @@ NL [\n\r] This allows unnamed sources to be piped into the parser. */ +extern BOOLEAN acceptPrim; + void -yyinit() +yyinit(void) { - extern BOOLEAN acceptPrim; - input_filename = xstrdup("<stdin>"); /* We must initialize the input buffer _now_, because we call @@ -964,9 +971,8 @@ yyinit() PUSH_STATE(Code); } -void -new_filename(f) /* This looks pretty dodgy to me (WDP) */ - char *f; +static void +new_filename(char *f) /* This looks pretty dodgy to me (WDP) */ { if (input_filename != NULL) free(input_filename); @@ -986,8 +992,8 @@ new_filename(f) /* This looks pretty dodgy to me (WDP) */ forcing insertion of ; or } as appropriate */ -BOOLEAN -hsshouldindent() +static BOOLEAN +hsshouldindent(void) { return (!forgetindent && INDENTON); } @@ -995,7 +1001,7 @@ hsshouldindent() /* Enter new context and set new indentation level */ void -hssetindent() +hssetindent(void) { #ifdef HSP_DEBUG fprintf(stderr, "hssetindent:hscolno=%d,hspcolno=%d,INDENTPT[%d]=%d\n", hscolno, hspcolno, icontexts, INDENTPT); @@ -1024,7 +1030,7 @@ hssetindent() /* Enter a new context without changing the indentation level */ void -hsincindent() +hsincindent(void) { #ifdef HSP_DEBUG fprintf(stderr, "hsincindent:hscolno=%d,hspcolno=%d,INDENTPT[%d]=%d\n", hscolno, hspcolno, icontexts, INDENTPT); @@ -1035,16 +1041,15 @@ hsincindent() /* Turn off indentation processing, usually because an explicit "{" has been seen */ void -hsindentoff() +hsindentoff(void) { forgetindent = TRUE; } /* Enter a new layout context. */ -void -hsentercontext(indent) - int indent; +static void +hsentercontext(int indent) { /* Enter new context and set indentation as specified */ if (++icontexts >= MAX_CONTEXTS) { @@ -1063,7 +1068,7 @@ hsentercontext(indent) /* Exit a layout context */ void -hsendindent() +hsendindent(void) { --icontexts; #ifdef HSP_DEBUG @@ -1075,9 +1080,8 @@ hsendindent() * Return checks the indentation level and returns ;, } or the specified token. */ -int -Return(tok) - int tok; +static int +Return(int tok) { #ifdef HSP_DEBUG extern int yyleng; @@ -1174,12 +1178,11 @@ yylex() **********************************************************************/ /* setyyin(file) open file as new lex input buffer */ +extern FILE *yyin; + void -setyyin(file) - char *file; +setyyin(char *file) { - extern FILE *yyin; - hsbuf_save = YY_CURRENT_BUFFER; if ((yyin = fopen(file, "r")) == NULL) { char errbuf[ERR_BUF_SIZE]; @@ -1210,10 +1213,8 @@ setyyin(file) #endif } -static VOID -layout_input(text, len) -char *text; -int len; +static void +layout_input(char *text, int len) { #ifdef HSP_DEBUG fprintf(stderr, "Scanning \"%s\"\n", text); @@ -1243,7 +1244,7 @@ int len; } void -setstartlineno() +setstartlineno(void) { startlineno = hsplineno; #if 1/*etags*/ @@ -1269,8 +1270,8 @@ static struct { char *text; } textcache = { 0, 0, NULL }; -static VOID -cleartext() +static void +cleartext(void) { /* fprintf(stderr, "cleartext\n"); */ textcache.next = 0; @@ -1280,10 +1281,8 @@ cleartext() } } -static VOID -addtext(text, length) -char *text; -unsigned length; +static void +addtext(char *text, unsigned length) { /* fprintf(stderr, "addtext: %d %s\n", length, text); */ @@ -1298,13 +1297,8 @@ unsigned length; textcache.next += length; } -static VOID -#ifdef __STDC__ +static void addchar(char c) -#else -addchar(c) - char c; -#endif { /* fprintf(stderr, "addchar: %c\n", c); */ @@ -1316,8 +1310,7 @@ addchar(c) } static char * -fetchtext(length) -unsigned *length; +fetchtext(unsigned *length) { /* fprintf(stderr, "fetchtext: %d\n", textcache.next); */ @@ -1338,10 +1331,8 @@ unsigned *length; hsnewid Enters an id of length n into the symbol table. */ -static VOID -hsnewid(name, length) -char *name; -int length; +static void +hsnewid(char *name, int length) { char save = name[length]; @@ -1351,8 +1342,7 @@ int length; } BOOLEAN -isconstr(s) /* walks past leading underscores before using the macro */ - char *s; +isconstr(char *s) /* walks past leading underscores before using the macro */ { char *temp = s; diff --git a/ghc/compiler/yaccParser/hsparser.y b/ghc/compiler/yaccParser/hsparser.y index fb2d934366..398104e4e1 100644 --- a/ghc/compiler/yaccParser/hsparser.y +++ b/ghc/compiler/yaccParser/hsparser.y @@ -39,7 +39,7 @@ * * **********************************************************************/ -BOOLEAN expect_ccurly = FALSE; /* Used to signal that a CCURLY could be inserted here */ +static BOOLEAN expect_ccurly = FALSE; /* Used to signal that a CCURLY could be inserted here */ extern BOOLEAN nonstandardFlag; extern BOOLEAN etags; @@ -81,7 +81,7 @@ extern int startlineno; * * **********************************************************************/ -list fixlist; +/* OLD 95/08: list fixlist; */ static int Fixity = 0, Precedence = 0; struct infix; @@ -927,7 +927,7 @@ iimport : importkey modid OPAREN import_list CPAREN interface: INTERFACE modid - { fixlist = Lnil; + { /* OLD 95/08: fixlist = Lnil; */ strcpy(iface_name, id_to_string($2)); } WHERE ibody @@ -1505,10 +1505,7 @@ kexp : LAMBDA /* SCC Expression */ | SCC STRING exp - { extern BOOLEAN ignoreSCC; - extern BOOLEAN warnSCC; - - if (ignoreSCC) { + { if (ignoreSCC) { if (warnSCC) fprintf(stderr, "\"%s\", line %d: _scc_ (`set [profiling] cost centre') ignored\n", @@ -1567,26 +1564,6 @@ aexp : var { $$ = mkident($1); } the starting line for definitions. */ -/*TESTTEST -bind : opatk - | vark lampats - { $$ = mkap($1,$2); } - | opatk varop opat %prec PLUS - { - $$ = mkinfixop($2,$1,$3); - } - ; - -opatk : dpatk - | opatk conop opat %prec PLUS - { - $$ = mkinfixop($2,$1,$3); - precparse($$); - } - ; - -*/ - opatk : dpatk | opatk op opat %prec PLUS { @@ -1676,12 +1653,6 @@ aapatk : conk { $$ = mkident($1); } ; -/* - The mkpars are so that infix parsing doesn't get confused. - - KH. -*/ - tuple : OPAREN exp COMMA texps CPAREN { if (ttree($4) == tuple) $$ = mktuple(mklcons($2, gtuplelist((struct Stuple *) $4))); @@ -1692,6 +1663,11 @@ tuple : OPAREN exp COMMA texps CPAREN { $$ = mktuple(Lnil); } ; +/* + The mkpar is so that infix parsing doesn't get confused. + + KH. +*/ texps : exp { $$ = mkpar($1); } | exp COMMA texps { if (ttree($3) == tuple) @@ -1736,11 +1712,13 @@ quals : qual { $$ = lsing($1); } ; qual : { inpat = TRUE; } exp { inpat = FALSE; } qualrest - { if ($4 == NULL) + { if ($4 == NULL) { + patternOrExpr(/*wanted:*/ LEGIT_EXPR,$2); $$ = mkguard($2); - else - { - checkpatt($2); + } else { + patternOrExpr(/*wanted:*/ LEGIT_PATT,$2); + $$ = mkqual($2,$4); +/* OLD: WDP 95/08 if(ttree($4)==def) { tree prevpatt_save = PREVPATT; @@ -1749,8 +1727,8 @@ qual : { inpat = TRUE; } exp { inpat = FALSE; } qualrest PREVPATT = prevpatt_save; } else - $$ = mkqual($2,$4); - } +*/ + } } ; @@ -2062,13 +2040,13 @@ hsperror(s) yyerror(s); } +extern char *yytext; +extern int yyleng; + void yyerror(s) char *s; { - extern char *yytext; - extern int yyleng; - /* We want to be able to distinguish 'error'-raised yyerrors from yyerrors explicitly coded by the parser hacker. */ diff --git a/ghc/compiler/yaccParser/id.c b/ghc/compiler/yaccParser/id.c index 0dfd419f77..72e2fca205 100644 --- a/ghc/compiler/yaccParser/id.c +++ b/ghc/compiler/yaccParser/id.c @@ -14,6 +14,7 @@ #include "utils.h" /* partain: special version for strings that may have NULs (etc) in them + (used in UgenUtil.lhs) */ long get_hstring_len(hs) @@ -137,8 +138,7 @@ hash_index(ident) The hash function. Returns 0 for Null strings. */ -static unsigned hash_fn(ident) -char *ident; +static unsigned hash_fn(char *ident) { unsigned len = (unsigned) strlen(ident); unsigned res; diff --git a/ghc/compiler/yaccParser/import_dirlist.c b/ghc/compiler/yaccParser/import_dirlist.c index dc0eaec938..d81de59c23 100644 --- a/ghc/compiler/yaccParser/import_dirlist.c +++ b/ghc/compiler/yaccParser/import_dirlist.c @@ -40,7 +40,7 @@ access(const char *fileName, const char *mode) { FILE *fp = fopen(fileName, mode); if (fp != NULL) { - (VOID) fclose(fp); + (void) fclose(fp); return 0; } return 1; @@ -51,7 +51,7 @@ access(const char *fileName, const char *mode) list imports_dirlist, sys_imports_dirlist; /* The imports lists */ extern char HiSuffix[]; extern char PreludeHiSuffix[]; -extern BOOLEAN ExplicitHiSuffixGiven; +/* OLD 95/08: extern BOOLEAN ExplicitHiSuffixGiven; */ #define MAX_MATCH 16 @@ -59,11 +59,8 @@ extern BOOLEAN ExplicitHiSuffixGiven; This finds a module along the imports directory list. */ -VOID -find_module_on_imports_dirlist(module_name, is_sys_import, returned_filename) - char *module_name; - BOOLEAN is_sys_import; - char *returned_filename; +void +find_module_on_imports_dirlist(char *module_name, BOOLEAN is_sys_import, char *returned_filename) { char try[FILENAME_SIZE]; @@ -77,7 +74,9 @@ find_module_on_imports_dirlist(module_name, is_sys_import, returned_filename) BOOLEAN tried_source_dir = FALSE; char *try_end; - char *suffix_to_use = (is_sys_import) ? PreludeHiSuffix : HiSuffix; + char *suffix_to_use = (is_sys_import) ? PreludeHiSuffix : HiSuffix; + char *suffix_to_report = suffix_to_use; /* save this for reporting, because we + might change suffix_to_use later */ int modname_len = strlen(module_name); /* @@ -197,13 +196,13 @@ find_module_on_imports_dirlist(module_name, is_sys_import, returned_filename) switch ( no_of_matches ) { default: fprintf(stderr,"Warning: found %d %s files for module \"%s\"\n", - no_of_matches, suffix_to_use, module_name); + no_of_matches, suffix_to_report, module_name); break; case 0: { char disaster_msg[MODNAME_SIZE+1000]; sprintf(disaster_msg,"can't find interface (%s) file for module \"%s\"%s", - suffix_to_use, module_name, + suffix_to_report, module_name, (strncmp(module_name, "PreludeGlaIO", 12) == 0) ? "\n(The PreludeGlaIO interface no longer exists);" :( diff --git a/ghc/compiler/yaccParser/infix.c b/ghc/compiler/yaccParser/infix.c index d53131bd18..9e17a1ec01 100644 --- a/ghc/compiler/yaccParser/infix.c +++ b/ghc/compiler/yaccParser/infix.c @@ -81,11 +81,14 @@ enteriscope() ninfix = 0; } +#if 0 +/* UNUSED */ void exitiscope() { --iscope; } +#endif void exposeis() @@ -102,9 +105,7 @@ exposeis() static int -ionelookup(name,iscope) - id name; - int iscope; +ionelookup(id name, int iscope) { int i; char *iname = id_to_string(name); @@ -140,15 +141,13 @@ nfixes() } char * -fixop(n) - int n; +fixop(int n) { return infixtab[iscope][n].iname; } char * -fixtype(n) - int n; +fixtype(int n) { switch(infixtab[iscope][n].ifixity) { case INFIXL: @@ -165,7 +164,8 @@ fixtype(n) } } - +#if 0 +/* UNUSED? */ int fixity(n) int n; @@ -175,6 +175,7 @@ fixity(n) #endif return(n < 0? INFIXL: infixtab[iscope][n].ifixity); } +#endif /* 0 */ long int diff --git a/ghc/compiler/yaccParser/main.c b/ghc/compiler/yaccParser/main.c index 0c6e197b42..ea1accdeb1 100644 --- a/ghc/compiler/yaccParser/main.c +++ b/ghc/compiler/yaccParser/main.c @@ -20,9 +20,7 @@ **********************************************************************/ int -main(argc, argv) - int argc; - char **argv; +main(int argc, char **argv) { Lnil = mklnil(); /* The null list -- used in lsing, etc. */ all = mklnil(); /* This should be the list of all derivable types */ diff --git a/ghc/compiler/yaccParser/printtree.c b/ghc/compiler/yaccParser/printtree.c index 719f87cf8c..1300baf87d 100644 --- a/ghc/compiler/yaccParser/printtree.c +++ b/ghc/compiler/yaccParser/printtree.c @@ -18,7 +18,7 @@ /* fwd decls, necessary and otherwise */ static void ptree PROTO( (tree) ); -static void plist PROTO( (void (*)(), list) ); +static void plist PROTO( (void (*)(/*NOT WORTH IT: void * */), list) ); static void pid PROTO( (id) ); static void pstr PROTO( (char *) ); static void pbool PROTO( (BOOLEAN) ); @@ -68,8 +68,7 @@ tree t; char/string lexer comments. (WDP 94/11) */ static void -print_string(str) - hstring str; +print_string(hstring str) { char *gs; char c; @@ -95,13 +94,12 @@ print_string(str) } static int -get_character(str) - hstring str; +get_character(hstring str) { int c = (int)((str->bytes)[0]); if (str->len != 1) { /* ToDo: assert */ - fprintf(stderr, "get_character: length != 1? (%d: %s)\n", str->len, str->bytes); + fprintf(stderr, "get_character: length != 1? (%ld: %s)\n", str->len, str->bytes); } if (c < 0) { @@ -112,8 +110,7 @@ get_character(str) } static void -pliteral(t) - literal t; +pliteral(literal t) { switch(tliteral(t)) { case integer: @@ -188,7 +185,7 @@ again: case par: t = gpare(t); goto again; case hmodule: PUTTAG('M'); - printf("#%u\t",ghmodline(t)); + printf("#%lu\t",ghmodline(t)); pid(ghname(t)); pstr(input_filename); prbind(ghmodlist(t)); @@ -229,7 +226,7 @@ again: case lambda: PUTTAG('l'); - printf("#%u\t",glamline(t)); + printf("#%lu\t",glamline(t)); plist(ptree,glampats(t)); ptree(glamexpr(t)); break; @@ -357,7 +354,7 @@ again: static void plist(fun, l) - void (*fun)(); + void (*fun)(/* NOT WORTH IT: void * */); list l; { if (tlist(l) == lcons) { @@ -374,7 +371,7 @@ pid(i) id i; { if(hashIds) - printf("!%u\t", hash_index(i)); + printf("!%lu\t", hash_index(i)); else printf("#%s\t", id_to_string(i)); } @@ -393,7 +390,7 @@ prbind(b) switch(tbinding(b)) { case tbind: PUTTAG('t'); - printf("#%u\t",gtline(b)); + printf("#%lu\t",gtline(b)); plist(pttype, gtbindc(b)); plist(pid, gtbindd(b)); pttype(gtbindid(b)); @@ -402,19 +399,19 @@ prbind(b) break; case nbind : PUTTAG('n'); - printf("#%u\t",gnline(b)); + printf("#%lu\t",gnline(b)); pttype(gnbindid(b)); pttype(gnbindas(b)); ppragma(gnpragma(b)); break; case pbind : PUTTAG('p'); - printf("#%u\t",gpline(b)); + printf("#%lu\t",gpline(b)); plist(ppbinding, gpbindl(b)); break; case fbind : PUTTAG('f'); - printf("#%u\t",gfline(b)); + printf("#%lu\t",gfline(b)); plist(ppbinding, gfbindl(b)); break; case abind : @@ -424,7 +421,7 @@ prbind(b) break; case cbind : PUTTAG('$'); - printf("#%u\t",gcline(b)); + printf("#%lu\t",gcline(b)); plist(pttype,gcbindc(b)); pttype(gcbindid(b)); prbind(gcbindw(b)); @@ -432,7 +429,7 @@ prbind(b) break; case ibind : PUTTAG('%'); - printf("#%u\t",giline(b)); + printf("#%lu\t",giline(b)); plist(pttype,gibindc(b)); pid(gibindid(b)); pttype(gibindi(b)); @@ -441,14 +438,14 @@ prbind(b) break; case dbind : PUTTAG('D'); - printf("#%u\t",gdline(b)); + printf("#%lu\t",gdline(b)); plist(pttype,gdbindts(b)); break; /* signature(-like) things, including user pragmas */ case sbind : PUTTAGSTR("St"); - printf("#%u\t",gsline(b)); + printf("#%lu\t",gsline(b)); plist(pid,gsbindids(b)); pttype(gsbindid(b)); ppragma(gspragma(b)); @@ -456,41 +453,41 @@ prbind(b) case vspec_uprag: PUTTAGSTR("Ss"); - printf("#%u\t",gvspec_line(b)); + printf("#%lu\t",gvspec_line(b)); pid(gvspec_id(b)); plist(pttype,gvspec_tys(b)); break; case ispec_uprag: PUTTAGSTR("SS"); - printf("#%u\t",gispec_line(b)); + printf("#%lu\t",gispec_line(b)); pid(gispec_clas(b)); pttype(gispec_ty(b)); break; case inline_uprag: PUTTAGSTR("Si"); - printf("#%u\t",ginline_line(b)); + printf("#%lu\t",ginline_line(b)); pid(ginline_id(b)); plist(pid,ginline_howto(b)); break; case deforest_uprag: PUTTAGSTR("Sd"); - printf("#%u\t",gdeforest_line(b)); + printf("#%lu\t",gdeforest_line(b)); pid(gdeforest_id(b)); break; case magicuf_uprag: PUTTAGSTR("Su"); - printf("#%u\t",gmagicuf_line(b)); + printf("#%lu\t",gmagicuf_line(b)); pid(gmagicuf_id(b)); pid(gmagicuf_str(b)); break; case abstract_uprag: PUTTAGSTR("Sa"); - printf("#%u\t",gabstract_line(b)); + printf("#%lu\t",gabstract_line(b)); pid(gabstract_id(b)); break; case dspec_uprag: PUTTAGSTR("Sd"); - printf("#%u\t",gdspec_line(b)); + printf("#%lu\t",gdspec_line(b)); pid(gdspec_id(b)); plist(pttype,gdspec_tys(b)); break; @@ -499,14 +496,14 @@ prbind(b) case mbind: PUTTAG('7'); - printf("#%u\t",gmline(b)); + printf("#%lu\t",gmline(b)); pid(gmbindmodn(b)); plist(pentid,gmbindimp(b)); plist(prename,gmbindren(b)); break; case import: PUTTAG('e'); - printf("#%u\t",giebindline(b)); + printf("#%lu\t",giebindline(b)); pstr(giebindfile(b)); pid(giebindmod(b)); plist(pentid,giebindexp(b)); @@ -515,7 +512,7 @@ prbind(b) break; case hiding: PUTTAG('h'); - printf("#%u\t",gihbindline(b)); + printf("#%lu\t",gihbindline(b)); pstr(gihbindfile(b)); pid(gihbindmod(b)); plist(pentid,gihbindexp(b)); @@ -597,7 +594,7 @@ patype(a) switch (tatype(a)) { case atc : PUTTAG('1'); - printf("#%u\t",gatcline(a)); + printf("#%lu\t",gatcline(a)); pid(gatcid(a)); plist(pttype, gatctypel(a)); break; @@ -659,7 +656,7 @@ pfixes() PUTTAG('L'); pstr(fixop(i)); pstr(fixtype(i)); - printf("#%u\t",precedence(i)); + printf("#%lu\t",precedence(i)); } } PUTTAG('N'); @@ -672,7 +669,7 @@ ppbinding(p) { switch(tpbinding(p)) { case pgrhs : PUTTAG('W'); - printf("#%u\t",ggline(p)); + printf("#%lu\t",ggline(p)); pid(ggfuncname(p)); ptree(ggpat(p)); plist(pgrhses,ggdexprs(p)); diff --git a/ghc/compiler/yaccParser/syntax.c b/ghc/compiler/yaccParser/syntax.c index 6719ccbe79..e64f978488 100644 --- a/ghc/compiler/yaccParser/syntax.c +++ b/ghc/compiler/yaccParser/syntax.c @@ -37,8 +37,12 @@ extern BOOLEAN hashIds, etags; /* Forward Declarations */ -char *ineg PROTO((char *)); -tree unparen PROTO((tree)); +char *ineg PROTO((char *)); +static tree unparen PROTO((tree)); +static void is_conapp_patt PROTO((int, tree, tree)); +static void rearrangeprec PROTO((tree, tree)); +static void error_if_expr_wanted PROTO((int, char *)); +static void error_if_patt_wanted PROTO((int, char *)); tree fns[MAX_CONTEXTS] = { NULL }; short samefn[MAX_CONTEXTS] = { 0 }; @@ -46,6 +50,8 @@ tree prevpatt[MAX_CONTEXTS] = { NULL }; BOOLEAN inpat = FALSE; +static BOOLEAN checkorder2 PROTO((binding, BOOLEAN)); +static BOOLEAN checksig PROTO((BOOLEAN, binding)); /* check infix value in range 0..9 @@ -74,12 +80,14 @@ checkfixity(vals) Check Previous Pattern usage */ +/* UNUSED: void checkprevpatt() { if (PREVPATT == NULL) hsperror("\"'\" used before a function definition"); } +*/ void checksamefn(fn) @@ -99,6 +107,8 @@ checksamefn(fn) Check that a list of types is a list of contexts */ +#if 0 +/* UNUSED */ void checkcontext(context) list context; @@ -122,6 +132,7 @@ checkcontext(context) context = ltl(context); } } +#endif /* 0 */ void checkinpat() @@ -130,15 +141,21 @@ checkinpat() hsperror("syntax error"); } +/* ------------------------------------------------------------------------ +*/ + void -checkpatt(e) - tree e; +patternOrExpr(int wanted, tree e) + /* see utils.h for what args are */ { switch(ttree(e)) { - case ident: + case ident: /* a pattern or expr */ + break; + case wildp: - break; + error_if_expr_wanted(wanted, "wildcard in expression"); + break; case lit: switch (tliteral(glit(e))) { @@ -148,24 +165,31 @@ checkpatt(e) case doubleprim: case floatprim: case string: + case stringprim: case charr: case charprim: - case stringprim: - break; - default: - hsperror("not a valid literal pattern"); + break; /* pattern or expr */ + + case clitlit: + error_if_patt_wanted(wanted, "``literal-literal'' in pattern"); + + default: /* the others only occur in pragmas */ + hsperror("not a valid literal pattern or expression"); } break; case negate: - if (ttree(gnexp(e)) != lit) { - hsperror("syntax error: \"-\" applied to a non-literal"); - } else { - literal l = glit(gnexp(e)); - - if (tliteral(l) != integer && tliteral(l) != floatr) { - hsperror("syntax error: \"-\" applied to a non-number"); - } + { tree sub = gnexp(e); + if (ttree(sub) != lit) { + error_if_patt_wanted(wanted, "\"-\" applied to a non-literal"); + } else { + literal l = glit(sub); + + if (tliteral(l) != integer && tliteral(l) != floatr) { + error_if_patt_wanted(wanted, "\"-\" applied to a non-number"); + } + } + patternOrExpr(wanted, sub); } break; @@ -174,109 +198,177 @@ checkpatt(e) tree f = gfun(e); tree a = garg(e); - checkconap(f, a); + is_conapp_patt(wanted, f, a); /* does nothing unless wanted == LEGIT_PATT */ + patternOrExpr(wanted, f); + patternOrExpr(wanted, a); } break; case as: - checkpatt(gase(e)); + error_if_expr_wanted(wanted, "`as'-pattern instead of an expression"); + patternOrExpr(wanted, gase(e)); break; case lazyp: - checkpatt(glazyp(e)); + error_if_expr_wanted(wanted, "irrefutable pattern instead of an expression"); + patternOrExpr(wanted, glazyp(e)); break; case plusp: - checkpatt(gplusp(e)); + patternOrExpr(wanted, gplusp(e)); break; case tinfixop: { - tree f = ginfun((struct Sap *)e), + tree f = ginfun((struct Sap *)e), a1 = ginarg1((struct Sap *)e), a2 = ginarg2((struct Sap *)e); struct Splusp *e_plus; - checkpatt(a1); - - if (ttree(f) == ident && strcmp(id_to_string(gident(f)),"+")==0) - { - if(ttree(a2) != lit || tliteral((literal) ttree(a2)) != integer) - hsperror("syntax error: non-integer in (n+k) pattern"); - - if(ttree(a1) == wildp || (ttree(a1) == ident && !isconstr(gident(a1)))) - { - e->tag = plusp; - e_plus = (struct Splusp *) e; - *Rgplusp(e_plus) = a1; - *Rgplusi(e_plus) = glit(a2); - } - else - hsperror("syntax error: non-variable in (n+k) pattern"); - } - else - { - if(ttree(f) == ident && !isconstr(gident(f))) - hsperror("syntax error: variable application in pattern"); - checkpatt(a2); - } + patternOrExpr(wanted, a1); + patternOrExpr(wanted, a2); + + if (wanted == LEGIT_PATT) { + if (ttree(f) == ident && strcmp(id_to_string(gident(f)),"+")==0) { + + if(ttree(a2) != lit || tliteral((literal) ttree(a2)) != integer) + hsperror("non-integer in (n+k) pattern"); + + if(ttree(a1) == wildp || (ttree(a1) == ident && !isconstr(gident(a1)))) + { + e->tag = plusp; + e_plus = (struct Splusp *) e; + *Rgplusp(e_plus) = a1; + *Rgplusi(e_plus) = glit(a2); + } + else + hsperror("non-variable in (n+k) pattern"); + + } else { + if(ttree(f) == ident && !isconstr(gident(f))) + hsperror("variable application in pattern"); + } + } } break; case tuple: { - list tup = gtuplelist(e); - while (tlist(tup) == lcons) - { - checkpatt(lhd(tup)); - tup = ltl(tup); - } + list tup; + for (tup = gtuplelist(e); tlist(tup) == lcons; tup = ltl(tup)) { + patternOrExpr(wanted, lhd(tup)); + } } break; - case par: - checkpatt(gpare(e)); + case par: /* parenthesised */ + patternOrExpr(wanted, gpare(e)); break; case llist: { - list l = gllist(e); - while (tlist(l) == lcons) - { - checkpatt(lhd(l)); - l = ltl(l); - } + list l; + for (l = gllist(e); tlist(l) == lcons; l = ltl(l)) { + patternOrExpr(wanted, lhd(l)); + } } break; #ifdef DPH case proc: { - list pids = gprocid(e); - while (tlist(pids) == lcons) - { - checkpatt(lhd(pids)); - pids = ltl(pids); - } - checkpatt(gprocdata(e)); + list pids; + for (pids = gprocid(e); tlist(pids) == lcons; pids = ltl(pids)) { + patternOrExpr(wanted, lhd(pids)); + } + patternOrExpr(wanted, gprocdata(e)); } break; #endif /* DPH */ + case lambda: + case let: + case casee: + case ife: + case restr: + case comprh: + case lsection: + case rsection: + case eenum: + case ccall: + case scc: + error_if_patt_wanted(wanted, "unexpected construct in a pattern"); + break; + default: - hsperror("not a pattern"); + hsperror("not a pattern or expression"); } } +static void +is_conapp_patt(int wanted, tree f, tree a) +{ + if (wanted == LEGIT_EXPR) + return; /* that was easy */ + + switch(ttree(f)) + { + case ident: + if (isconstr(gident(f))) + { + patternOrExpr(wanted, a); + return; + } + { + char errbuf[ERR_BUF_SIZE]; + sprintf(errbuf,"not a constructor application -- %s",gident(f)); + hsperror(errbuf); + } -BOOLEAN /* return TRUE if LHS is a pattern; FALSE if a function */ -is_patt_or_fun(e, outer_level) - tree e; - BOOLEAN outer_level; - /* only needed because x+y is a *function* at - the "outer level", but an n+k *pattern* at - any "inner" level. Sigh. */ + case ap: + is_conapp_patt(wanted, gfun(f), garg(f)); + patternOrExpr(wanted, a); + return; + + case par: + is_conapp_patt(wanted, gpare(f), a); + break; + + case tuple: + { + char errbuf[ERR_BUF_SIZE]; + sprintf(errbuf,"tuple pattern `applied' to arguments (missing comma?)"); + hsperror(errbuf); + } + break; + + default: + hsperror("not a constructor application"); + } +} + +static void +error_if_expr_wanted(int wanted, char *msg) +{ + if (wanted == LEGIT_EXPR) + hsperror(msg); +} + +static void +error_if_patt_wanted(int wanted, char *msg) +{ + if (wanted == LEGIT_PATT) + hsperror(msg); +} + +/* ---------------------------------------------------------------------- */ + +static BOOLEAN /* return TRUE if LHS is a pattern; FALSE if a function */ +is_patt_or_fun(tree e, BOOLEAN outer_level) + /* "outer_level" only needed because x+y is a *function* at + the "outer level", but an n+k *pattern* at + any "inner" level. Sigh. */ { switch(ttree(e)) { @@ -308,7 +400,7 @@ is_patt_or_fun(e, outer_level) #ifdef DPH case proc: #endif - checkpatt(e); + patternOrExpr(LEGIT_PATT, e); return TRUE; case ident: @@ -327,7 +419,7 @@ is_patt_or_fun(e, outer_level) tree fn = function(e); /*fprintf(stderr,"ap:f=%d %s (%d),a=%d %s\n",ttree(gfun(e)),(ttree(gfun(e)) == ident) ? (gident(gfun(e))) : "",ttree(fn),ttree(garg(e)),(ttree(garg(e)) == ident) ? (gident(garg(e))) : "");*/ - checkpatt(a); + patternOrExpr(LEGIT_PATT, a); if(ttree(fn) == ident) return(isconstr(gident(fn))); @@ -348,8 +440,8 @@ is_patt_or_fun(e, outer_level) struct Splusp *e_plus; /* Even function definitions must have pattern arguments */ - checkpatt(a1); - checkpatt(a2); + patternOrExpr(LEGIT_PATT, a1); + patternOrExpr(LEGIT_PATT, a2); if (ttree(f) == ident) { @@ -404,7 +496,7 @@ function(e) switch (ttree(e)) { case ap: - checkpatt(garg(e)); + patternOrExpr(LEGIT_PATT, garg(e)); return(function(gfun(e))); case par: @@ -416,7 +508,7 @@ function(e) } -tree +static tree unparen(e) tree e; { @@ -426,46 +518,6 @@ unparen(e) return(e); } -void -checkconap(f, a) - tree f, a; -{ - switch(ttree(f)) - { - case ident: - if (isconstr(gident(f))) - { - checkpatt(a); - return; - } - { - char errbuf[ERR_BUF_SIZE]; - sprintf(errbuf,"syntax error: not a constructor application -- %s",gident(f)); - hsperror(errbuf); - } - - case ap: - checkconap(gfun(f), garg(f)); - checkpatt(a); - return; - - case par: - checkconap(gpare(f), a); - break; - - case tuple: - { - char errbuf[ERR_BUF_SIZE]; - sprintf(errbuf,"syntax error: tuple pattern `applied' to arguments (missing comma?)"); - hsperror(errbuf); - } - break; - - default: - hsperror("syntax error: not a constructor application"); - } -} - /* Extend a function by adding a new definition to its list of bindings. @@ -501,22 +553,21 @@ binding rule; */ void -precparse(t) - tree t; +precparse(tree t) { #if 0 -#ifdef HSP_DEBUG +# ifdef HSP_DEBUG fprintf(stderr,"precparse %x\n",ttree(t)); -#endif +# endif #endif if(ttree(t) == tinfixop) { tree left = ginarg1((struct Sap *)t); #if 0 -#ifdef HSP_DEBUG +# ifdef HSP_DEBUG fprintf(stderr,"precparse:t=");ptree(t);printf("\nleft=");ptree(left);printf("\n"); -#endif +# endif #endif if(ttree(left) == negate) @@ -542,10 +593,10 @@ precparse(t) *ttabpos = infixlookup(tid); #if 0 -#ifdef HSP_DEBUG +# ifdef HSP_DEBUG fprintf(stderr,"precparse: lid=%s; tid=%s,ltab=%d,ttab=%d\n", id_to_string(lid),id_to_string(tid),pprecedence(lefttabpos),pprecedence(ttabpos)); -#endif +# endif #endif if (pprecedence(lefttabpos) < pprecedence(ttabpos)) @@ -577,9 +628,8 @@ precparse(t) The recursive call to precparse ensures this filters down as necessary. */ -void -rearrangeprec(t1,t2) - tree t1, t2; +static void +rearrangeprec(tree t1, tree t2) { tree arg3 = ginarg2((struct Sap *)t2); id id1 = gident(ginfun((struct Sap *)t1)), @@ -633,6 +683,8 @@ ineg(i) return(p); } +#if 0 +/* UNUSED: at the moment */ void checkmodname(import,interface) id import, interface; @@ -644,6 +696,7 @@ checkmodname(import,interface) hsperror(errbuf); } } +#endif /* 0 */ /* Check the ordering of declarations in a cbody. @@ -661,7 +714,7 @@ checkorder(decls) checkorder2(decls,TRUE); } -BOOLEAN +static BOOLEAN checkorder2(decls,sigs) binding decls; BOOLEAN sigs; @@ -681,7 +734,7 @@ checkorder2(decls,sigs) } -BOOLEAN +static BOOLEAN checksig(sig,decl) BOOLEAN sig; binding decl; diff --git a/ghc/compiler/yaccParser/tree.ugn b/ghc/compiler/yaccParser/tree.ugn index dd8715db0b..decf7e36d5 100644 --- a/ghc/compiler/yaccParser/tree.ugn +++ b/ghc/compiler/yaccParser/tree.ugn @@ -61,7 +61,12 @@ type tree; qual : < gqpat : tree; gqexp : tree; >; guard : < ggexp : tree; >; - def : < ggdef : tree; >; + def : < ggdef : tree; >; /* unused, I believe WDP 95/08 */ +/* "tinfixop" is an odd bird: + we clobber its tag into another "tree", thus marking + that tree as infixery. We do not create tinfixops + per se. (WDP 95/08) +*/ tinfixop: < gdummy : infixTree; >; lsection: < glsexp : tree; glsop : unkId; >; diff --git a/ghc/compiler/yaccParser/type2context.c b/ghc/compiler/yaccParser/type2context.c index 185dc6438f..1be4394990 100644 --- a/ghc/compiler/yaccParser/type2context.c +++ b/ghc/compiler/yaccParser/type2context.c @@ -15,7 +15,7 @@ /* Imported Values */ extern list Lnil; -VOID is_context_format PROTO((ttype)); /* forward */ +static void is_context_format PROTO((ttype)); /* forward */ /* partain: see also the comment by "decl" in hsparser.y. @@ -102,7 +102,7 @@ type2context(t) /* is_context_format is the same as "type2context" except that it just performs checking */ /* ttype is either "tycon" [class] or "tycon (named)tvar" [class var] */ -VOID +static void is_context_format(t) ttype t; { diff --git a/ghc/compiler/yaccParser/util.c b/ghc/compiler/yaccParser/util.c index 5f72496381..7245626d50 100644 --- a/ghc/compiler/yaccParser/util.c +++ b/ghc/compiler/yaccParser/util.c @@ -56,14 +56,17 @@ int minAcceptablePragmaVersion = 5; /* 0.26 or greater ONLY */ int maxAcceptablePragmaVersion = 5; /* 0.26+ */ int thisIfacePragmaVersion = 0; -char *input_file_dir; /* The directory where the input file is. */ +static char *input_file_dir; /* The directory where the input file is. */ char HiSuffix[64] = ".hi"; /* can be changed with -h flag */ char PreludeHiSuffix[64] = ".hi"; /* can be changed with -g flag */ -BOOLEAN ExplicitHiSuffixGiven = 0; +/* OLD 95/08: BOOLEAN ExplicitHiSuffixGiven = 0; */ static BOOLEAN verbose = FALSE; /* Set for verbose messages. */ +/* Forward decls */ +static void who_am_i PROTO((void)); + /********************************************************************** * * * * @@ -116,7 +119,7 @@ process_args(argc,argv) case 'h': strcpy(HiSuffix, *argv+1); - ExplicitHiSuffixGiven = 1; +/*OLD 95/08: ExplicitHiSuffixGiven = 1; */ keep_munging_option = FALSE; break; @@ -228,8 +231,8 @@ error(s) exit(1); } -void -who_am_i() +static void +who_am_i(void) { fprintf(stderr,"Glasgow Haskell parser, version %s\n", PARSER_VERSION); } @@ -258,9 +261,7 @@ lconc(l1, l2) } list -lapp(l1, l2) - list l1; - VOID_STAR l2; +lapp(list l1, VOID_STAR l2) { list t; diff --git a/ghc/compiler/yaccParser/utils.h b/ghc/compiler/yaccParser/utils.h index e43303e720..3b5b2ed709 100644 --- a/ghc/compiler/yaccParser/utils.h +++ b/ghc/compiler/yaccParser/utils.h @@ -34,14 +34,14 @@ extern list sys_imports_dirlist; extern char HiSuffix[]; extern char PreludeHiSuffix[]; -extern void process_args PROTO((int, char **)); +void process_args PROTO((int, char **)); /* end of util.c stuff */ -extern list mklcons PROTO((void *h, list t)); /* if we have PROTO, we have "void *" */ -extern list lapp PROTO((list l1, void *l2)); -extern list lconc PROTO((list l1, list l2)); -extern list mktruecase PROTO((tree t)); +list mklcons PROTO((void *h, list t)); /* if we have PROTO, we have "void *" */ +list lapp PROTO((list l1, void *l2)); +list lconc PROTO((list l1, list l2)); +list mktruecase PROTO((tree t)); #define lsing(l) mklcons(l, Lnil) /* Singleton Lists */ #define ldub(l1, l2) mklcons(l1, lsing(l2)) /* Two-element Lists */ @@ -50,91 +50,90 @@ extern list mktruecase PROTO((tree t)); #define SAMEFN samefn[icontexts] #define PREVPATT prevpatt[icontexts] -extern tree *Rginfun PROTO((struct Sap *)); -extern tree *Rginarg1 PROTO((struct Sap *)); -extern tree *Rginarg2 PROTO((struct Sap *)); +tree *Rginfun PROTO((struct Sap *)); +tree *Rginarg1 PROTO((struct Sap *)); +tree *Rginarg2 PROTO((struct Sap *)); #define ginfun(xx) *Rginfun(xx) #define ginarg1(xx) *Rginarg1(xx) #define ginarg2(xx) *Rginarg2(xx) -extern id installid PROTO((char *)); /* Create a new identifier */ -extern hstring installHstring PROTO((int, char *)); /* Create a new literal string */ +id installid PROTO((char *)); /* Create a new identifier */ +hstring installHstring PROTO((int, char *)); /* Create a new literal string */ -extern id install_literal PROTO((char *)); -extern char *id_to_string PROTO((id)); +id install_literal PROTO((char *)); +char *id_to_string PROTO((id)); -extern struct infix *infixlookup(); +struct infix *infixlookup PROTO((id)); /* partain additions */ -extern char *xmalloc PROTO((unsigned)); /* just a GNU-style error-checking malloc */ -extern int printf PROTO((const char *, ...)); -extern int fprintf PROTO((FILE *, const char *, ...)); -/*varies (sun/alpha): extern int fputc PROTO((char, FILE *)); */ -extern int fputs PROTO((const char *, FILE *)); -extern int sscanf PROTO((const char *, const char *, ...)); -extern long strtol PROTO((const char *, char **, int)); -extern size_t fread PROTO((void *, size_t, size_t, FILE *)); -extern int fclose PROTO((FILE *)); -extern int isatty PROTO((int)); +char *xmalloc PROTO((unsigned)); /* just a GNU-style error-checking malloc */ +int printf PROTO((const char *, ...)); +int fprintf PROTO((FILE *, const char *, ...)); +/*varies (sun/alpha): int fputc PROTO((char, FILE *)); */ +int fputs PROTO((const char *, FILE *)); +int sscanf PROTO((const char *, const char *, ...)); +long strtol PROTO((const char *, char **, int)); +size_t fread PROTO((void *, size_t, size_t, FILE *)); +int fclose PROTO((FILE *)); +int isatty PROTO((int)); /*extern ??? _filbuf */ /*extern ??? _flsbuf */ -extern void format_string PROTO((FILE *, unsigned char *, int)); -extern tree mkbinop PROTO((char *, tree, tree)); -extern tree mkinfixop PROTO((char *, tree, tree)); -extern list type2context PROTO((ttype)); -extern pbinding createpat PROTO((list, binding)); -extern void process_args PROTO((int, char **)); -extern void hash_init PROTO((void)); -extern void print_hash_table PROTO((void)); -extern long int hash_index PROTO((id)); -extern void yyinit PROTO((void)); -extern int yyparse PROTO((void)); -extern int yylex PROTO((void)); -extern void setyyin PROTO((char *)); -extern void yyerror PROTO((char *)); -extern void error PROTO((char *)); -extern void hsperror PROTO((char *)); -extern void enteriscope PROTO((void)); -extern void exposeis PROTO((void)); -extern void makeinfix PROTO((id, int, int)); -extern int nfixes PROTO((void)); -extern long int precedence PROTO((int)); -extern int pprecedence PROTO((struct infix *)); -extern void rearrangeprec PROTO((tree, tree)); -extern int pfixity PROTO((struct infix *)); -extern void hsincindent PROTO((void)); -extern void hssetindent PROTO((void)); -extern void hsentercontext PROTO((int)); -extern void hsendindent PROTO((void)); -extern void hsindentoff PROTO((void)); - -extern int checkfixity PROTO((char *)); -extern void checksamefn PROTO((char *)); -extern void checkcontext PROTO((list)); -extern void checkinpat PROTO((void)); -extern void checkpatt PROTO((tree)); -extern BOOLEAN lhs_is_patt PROTO((tree)); -extern tree function PROTO((tree)); -extern void checkconap PROTO((tree, tree)); -extern void extendfn PROTO((binding, binding)); -extern void precparse PROTO((tree)); -extern void checkorder PROTO((binding)); -extern BOOLEAN checkorder2 PROTO((binding, BOOLEAN)); -extern BOOLEAN checksig PROTO((BOOLEAN, binding)); -extern void checkprec PROTO((tree, id, BOOLEAN)); -extern BOOLEAN isconstr PROTO((char *)); -extern void setstartlineno PROTO((void)); -extern void pprogram PROTO((tree)); -extern void who_am_i PROTO((void)); -extern void new_filename PROTO((char *)); -extern int Return PROTO((int)); +void format_string PROTO((FILE *, unsigned char *, int)); +tree mkbinop PROTO((char *, tree, tree)); +tree mkinfixop PROTO((char *, tree, tree)); +list type2context PROTO((ttype)); +pbinding createpat PROTO((list, binding)); +void process_args PROTO((int, char **)); +void hash_init PROTO((void)); +void print_hash_table PROTO((void)); +long int hash_index PROTO((id)); +void yyinit PROTO((void)); +int yyparse PROTO((void)); +int yylex PROTO((void)); +void setyyin PROTO((char *)); +void yyerror PROTO((char *)); +void error PROTO((char *)); +void hsperror PROTO((char *)); +void enteriscope PROTO((void)); +void exposeis PROTO((void)); +void makeinfix PROTO((id, int, int)); +int nfixes PROTO((void)); +long int precedence PROTO((int)); +int pprecedence PROTO((struct infix *)); +int pfixity PROTO((struct infix *)); +void pprogram PROTO((tree)); +void hsincindent PROTO((void)); +void hssetindent PROTO((void)); +void hsendindent PROTO((void)); +void hsindentoff PROTO((void)); + +int checkfixity PROTO((char *)); +void checksamefn PROTO((char *)); +void checkinpat PROTO((void)); + +void patternOrExpr PROTO((int,tree)); +/* the "int" arg says what we want; it is one of: */ +#define LEGIT_PATT 1 +#define LEGIT_EXPR 2 + +BOOLEAN lhs_is_patt PROTO((tree)); +tree function PROTO((tree)); +void extendfn PROTO((binding, binding)); +void precparse PROTO((tree)); +void checkorder PROTO((binding)); +void checkprec PROTO((tree, id, BOOLEAN)); +BOOLEAN isconstr PROTO((char *)); +void setstartlineno PROTO((void)); +void find_module_on_imports_dirlist PROTO((char *, BOOLEAN, char *)); +char *fixop PROTO((int)); +char *fixtype PROTO((int)); /* mattson additions */ -extern char *xstrdup PROTO((char *)); /* Duplicate a string */ -extern char *xstrndup PROTO((char *, unsigned));/* Duplicate a substring */ -extern char *xrealloc PROTO((char *, unsigned));/* Re-allocate a string */ +char *xstrdup PROTO((char *)); /* Duplicate a string */ +char *xstrndup PROTO((char *, unsigned)); /* Duplicate a substring */ +char *xrealloc PROTO((char *, unsigned)); /* Re-allocate a string */ #endif /* __UTILS_H */ |