From: rrt Date: Wed, 13 Jun 2001 15:50:58 +0000 (+0000) Subject: [project @ 2001-06-13 15:50:57 by rrt] X-Git-Tag: Approximately_9120_patches~1765 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=9097c4392e0f95f8dcbde07a1997680ec2a02d46;p=ghc-hetmet.git [project @ 2001-06-13 15:50:57 by rrt] Add an ext_name string to foreign dotnet types. --- diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs index 28778b7..ebf82a7 100644 --- a/ghc/compiler/hsSyn/HsDecls.lhs +++ b/ghc/compiler/hsSyn/HsDecls.lhs @@ -43,6 +43,7 @@ import Class ( FunDep, DefMeth(..) ) import CStrings ( CLabelString ) import Outputable import SrcLoc ( SrcLoc ) +import FastString \end{code} @@ -261,9 +262,10 @@ data TyClDecl name pat tcdLoc :: SrcLoc } - | ForeignType { tcdName :: name, -- See remarks about IfaceSig above - tcdFoType :: FoType, - tcdLoc :: SrcLoc } + | ForeignType { tcdName :: name, -- See remarks about IfaceSig above + tcdExtName :: Maybe FastString, + tcdFoType :: FoType, + tcdLoc :: SrcLoc } | TyData { tcdND :: NewOrData, tcdCtxt :: HsContext name, -- context diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y index 872257f..9269c59 100644 --- a/ghc/compiler/parser/Parser.y +++ b/ghc/compiler/parser/Parser.y @@ -1,6 +1,6 @@ {- ----------------------------------------------------------------------------- -$Id: Parser.y,v 1.67 2001/06/11 12:21:17 simonpj Exp $ +$Id: Parser.y,v 1.68 2001/06/13 15:50:57 rrt Exp $ Haskell grammar. @@ -402,8 +402,8 @@ fordecl : srcloc 'label' ext_name varid '::' sigtype | srcloc 'import' 'dotnet' ext_name varid '::' sigtype { ForD (ForeignImport $5 $7 (DNImport (DNCallSpec ($4 `orElse` mkExtName $5))) $1) } - | srcloc 'import' 'dotnet' 'type' tycon - { TyClD (ForeignType $5 DNType $1) } + | srcloc 'import' 'dotnet' 'type' ext_name tycon + { TyClD (ForeignType $6 $5 DNType $1) } decls :: { [RdrBinding] } : decls ';' decl { $3 : $1 } diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y index 47fda3a..9254ef2 100644 --- a/ghc/compiler/rename/ParseIface.y +++ b/ghc/compiler/rename/ParseIface.y @@ -352,7 +352,7 @@ decl : src_loc qvar_name '::' type maybe_idinfo | src_loc 'type' qtc_name tv_bndrs '=' type { TySynonym $3 $4 $6 $1 } | src_loc 'foreign' 'type' qtc_name - { ForeignType $4 DNType $1 } + { ForeignType $4 Nothing DNType $1 } | src_loc 'data' opt_decl_context qtc_name tv_bndrs constrs { mkTyData DataType $3 $4 $5 $6 (length $6) Nothing $1 } | src_loc 'newtype' opt_decl_context qtc_name tv_bndrs newtype_constr diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs index c89a88b..e7add89 100644 --- a/ghc/compiler/rename/RnExpr.lhs +++ b/ghc/compiler/rename/RnExpr.lhs @@ -916,7 +916,7 @@ precParseErr op1 op2 sectionPrecErr op arg_op section = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"), nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op), - nest 4 (ptext SLIT("In the section:") <+> quotes (ppr section))] + nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))] nonStdGuardErr guard = hang (ptext diff --git a/ghc/compiler/typecheck/TcTyClsDecls.lhs b/ghc/compiler/typecheck/TcTyClsDecls.lhs index 9fa3806..0044d67 100644 --- a/ghc/compiler/typecheck/TcTyClsDecls.lhs +++ b/ghc/compiler/typecheck/TcTyClsDecls.lhs @@ -329,8 +329,8 @@ buildTyConOrClass dflags is_rec kenv rec_vrcs rec_details | otherwise -> DataTyCon buildTyConOrClass dflags is_rec kenv rec_vrcs rec_details - (ForeignType {tcdName = tycon_name}) - = ATyCon (mkForeignTyCon tycon_name liftedTypeKind 0 []) + (ForeignType {tcdName = tycon_name, tcdExtName = tycon_ext_name}) + = ATyCon (mkForeignTyCon tycon_name tycon_ext_name liftedTypeKind 0 []) buildTyConOrClass dflags is_rec kenv rec_vrcs rec_details (ClassDecl {tcdName = class_name, tcdTyVars = tyvar_names, diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs index 015d0b3..4fc0348 100644 --- a/ghc/compiler/types/TyCon.lhs +++ b/ghc/compiler/types/TyCon.lhs @@ -64,6 +64,7 @@ import Name ( Name, nameUnique, NamedThing(getName) ) import PrelNames ( Unique, Uniquable(..), anyBoxConKey ) import PrimRep ( PrimRep(..), isFollowableRep ) import Outputable +import FastString \end{code} %************************************************************************ @@ -135,8 +136,9 @@ data TyCon primTyConRep :: PrimRep, -- Many primitive tycons are unboxed, but some are -- boxed (represented by pointers). The PrimRep tells. - isUnLifted :: Bool -- Most primitive tycons are unlifted, + isUnLifted :: Bool, -- Most primitive tycons are unlifted, -- but foreign-imported ones may not be + tyConExtName :: Maybe FastString } | TupleTyCon { @@ -297,9 +299,11 @@ mkTupleTyCon name kind arity tyvars con boxed gen_info } -- Foreign-imported (.NET) type constructors are represented --- as primitive, but *lifted*, TyCons for now. --- They have PtrRep -mkForeignTyCon name kind arity arg_vrcs +-- as primitive, but *lifted*, TyCons for now. They are lifted +-- because the Haskell type T representing the (foreign) .NET +-- type T is actually implemented (in ILX) as a thunk +-- They have PtrRep +mkForeignTyCon name ext_name kind arity arg_vrcs = PrimTyCon { tyConName = name, tyConUnique = nameUnique name, @@ -307,7 +311,8 @@ mkForeignTyCon name kind arity arg_vrcs tyConArity = arity, tyConArgVrcs = arg_vrcs, primTyConRep = PtrRep, - isUnLifted = False + isUnLifted = False, + tyConExtName = ext_name } @@ -319,7 +324,8 @@ mkPrimTyCon name kind arity arg_vrcs rep tyConArity = arity, tyConArgVrcs = arg_vrcs, primTyConRep = rep, - isUnLifted = True + isUnLifted = True, + tyConExtName = Nothing } mkSynTyCon name kind arity tyvars rhs argvrcs