Commit 9097c439 authored by rrt's avatar rrt
Browse files

[project @ 2001-06-13 15:50:57 by rrt]

Add an ext_name string to foreign dotnet types.
parent ea47b6e6
......@@ -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
......
{-
-----------------------------------------------------------------------------
$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 }
......
......@@ -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
......
......@@ -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
......
......@@ -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,
......
......@@ -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
-- 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<T>
-- 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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment