summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
2011e9b)
Had to add support for dynamic C calls and for foreign labels (Addr#
constants). Actually I only did the printing side -- parsing is not
done yet. But at least now you can build the libraries with -fext-core.
I also got the function arrow to print out properly again (it was
printing fully-qualified and z-coded!)
I also added a field for calling convention name to the External
data constructor in ExternalCore.Exp (for static C calls).
I'm not exactly sure where to document all of this, so I haven't done
that, though I did comment the code a bit.
| Case Exp Vbind Ty [Alt] {- non-empty list -}
| Cast Exp Ty
| Note String Exp
| Case Exp Vbind Ty [Alt] {- non-empty list -}
| Cast Exp Ty
| Note String Exp
+ | External String String Ty {- target name, convention, and type -}
+ | DynExternal String Ty {- convention and type (incl. Addr# of target as first arg) -}
+ | Label String
+primMname = "base:GHC.Prim"
-tcArrow = (primMname, "ZLzmzgZR")
+tcArrow = (primMname, "(->)")
case globalIdDetails v of
-- a DataConId represents the Id of a worker, which is a varName. -- sof 4/02
-- DataConId _ -> C.Dcon (make_con_qid (Var.varName v))
case globalIdDetails v of
-- a DataConId represents the Id of a worker, which is a varName. -- sof 4/02
-- DataConId _ -> C.Dcon (make_con_qid (Var.varName v))
- FCallId (CCall (CCallSpec (StaticTarget nm) _ _)) -> C.External (unpackFS nm) (make_ty (idType v))
- FCallId _ -> error "MkExternalCore died: can't handle non-static-C foreign call"
+ FCallId (CCall (CCallSpec (StaticTarget nm) callconv _))
+ -> C.External (unpackFS nm) (showSDoc (ppr callconv)) (make_ty (idType v))
+ FCallId (CCall (CCallSpec DynamicTarget callconv _))
+ -> C.DynExternal (showSDoc (ppr callconv)) (make_ty (idType v))
+ FCallId _
+ -> pprPanic "MkExternalCore died: can't handle non-{static,dynamic}-C foreign call"
+ (ppr v)
_ -> C.Var (make_var_qid (Var.varName v))
_ -> C.Var (make_var_qid (Var.varName v))
-make_exp (Lit (l@(MachLabel s _))) = error "MkExternalCore died: can't handle \"foreign label\" declarations"
+make_exp (Lit (l@(MachLabel s _))) = C.Label (unpackFS s)
make_exp (Lit l) = C.Lit (make_lit l)
make_exp (App e (Type t)) = C.Appt (make_exp e) (make_ty t)
make_exp (App e1 e2) = C.App (make_exp e1) (make_exp e2)
make_exp (Lit l) = C.Lit (make_lit l)
make_exp (App e (Type t)) = C.Appt (make_exp e) (make_ty t)
make_exp (App e1 e2) = C.App (make_exp e1) (make_exp e2)
$$ (indent (braces (vcat (punctuate (char ';') (map palt alts)))))
pexp (Cast e co) = (text "%cast" <+> pexp e) $$ paty co
pexp (Note s e) = (text "%note" <+> pstring s) $$ pexp e
$$ (indent (braces (vcat (punctuate (char ';') (map palt alts)))))
pexp (Cast e co) = (text "%cast" <+> pexp e) $$ paty co
pexp (Note s e) = (text "%note" <+> pstring s) $$ pexp e
-pexp (External n t) = (text "%external" <+> pstring n) $$ paty t
+pexp (External n cc t) = (text "%external" <+> text cc <+> pstring n) $$ paty t
+pexp (DynExternal cc t) = (text "%dynexternal" <+> text cc) $$ paty t
+pexp (Label n) = (text "%label" <+> pstring n)