Skip to content

Commit

Permalink
mergen
Browse files Browse the repository at this point in the history
  • Loading branch information
@rubendg
rubendg committed Jan 27, 2012
1 parent d55640a commit d81a1f2
Show file tree
Hide file tree
Showing 6 changed files with 31 additions and 22 deletions.
2 changes: 1 addition & 1 deletion EHC/SVNREVISION
View file
Original file line number Original file line Diff line number Diff line change
@@ -1 +1 @@
2378M 2404M
2 changes: 1 addition & 1 deletion EHC/src/ehc/Core/ToJScript.cag
View file
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -631,7 +631,7 @@ ffiJScriptMkCall ty
mk = J.Expr_Call mk = J.Expr_Call
%%][90 %%][90
mkObj as = jsCall "primToPlainObj" as mkObj as = jsCall "primToPlainObj" as
mk = foreignexprEval (J.Expr_Sel,J.Expr_ArrInx,J.Expr_Call,id,mkObj,jsVar,J.Expr_Str) (forextractForeignExpr ent) mk = foreignexprEval (J.Expr_Sel,J.Expr_ArrInx,J.Expr_Call,id,mkObj,J.Expr_New,jsVar,J.Expr_Str) (forextractForeignExpr ent)
-- TODO: Reuse some of the foreign export code for this? It's more or less generating the same code... -- TODO: Reuse some of the foreign export code for this? It's more or less generating the same code...
-- TODO: Document that we require callback functions to be in IO -- TODO: Document that we require callback functions to be in IO
mkWrap n (e:_) = mkWrapFn as bdy mkWrap n (e:_) = mkWrapFn as bdy
Expand Down
8 changes: 7 additions & 1 deletion EHC/src/ehc/Foreign.cag
View file
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -71,6 +71,7 @@ foreignexprEval
, e -> [e] -> e -- call , e -> [e] -> e -- call
, e -> e -- as var/ptr , e -> e -- as var/ptr
, [e] -> e -- object , [e] -> e -- object
, e -> e -- new object
, String -> e -- name , String -> e -- name
, String -> e -- string , String -> e -- string
) )
Expand All @@ -79,7 +80,7 @@ foreignexprEval
-> [e] -- args -> [e] -- args
-> e -> e
foreignexprEval foreignexprEval
(mkSel,mkInx,mkCall,mkPtr,mkObj,mkNm,mkStr) (mkSel,mkInx,mkCall,mkPtr,mkObj,mkNewObj,mkNm,mkStr)
fexpr ent args fexpr ent args
= oeE oe = oeE oe
where argl = zip [1..] args where argl = zip [1..] args
Expand Down Expand Up @@ -120,6 +121,9 @@ foreignexprEval
ev (ForeignExpr_ObjData) ie = let ev (ForeignExpr_ObjData) ie = let
in mkOE ( mkObj (ieArgs ie) ) in mkOE ( mkObj (ieArgs ie) )
( Set.empty ) ( Set.empty )
ev (ForeignExpr_NewObj e) ie = let eo = ev e ie
in eo { oeEL = [mkNewObj $ oeE eo] }

evs feL ie = map (\e -> ev e ie) feL evs feL ie = map (\e -> ev e ie) feL
%%] %%]


Expand Down Expand Up @@ -151,6 +155,7 @@ instance Serialize ForeignExpr where
sput (ForeignExpr_AllArg ) = sputWord8 8 sput (ForeignExpr_AllArg ) = sputWord8 8
sput (ForeignExpr_Str a ) = sputWord8 9 >> sput a sput (ForeignExpr_Str a ) = sputWord8 9 >> sput a
sput (ForeignExpr_ObjData ) = sputWord8 10 sput (ForeignExpr_ObjData ) = sputWord8 10
sput (ForeignExpr_NewObj a ) = sputWord8 11 >> sput a
sget = do sget = do
t <- sgetWord8 t <- sgetWord8
case t of case t of
Expand All @@ -165,6 +170,7 @@ instance Serialize ForeignExpr where
8 -> return ForeignExpr_AllArg 8 -> return ForeignExpr_AllArg
9 -> liftM ForeignExpr_Str sget 9 -> liftM ForeignExpr_Str sget
10 -> return ForeignExpr_ObjData 10 -> return ForeignExpr_ObjData
11 -> liftM ForeignExpr_NewObj sget




instance Serialize ForeignEnt where instance Serialize ForeignEnt where
Expand Down
1 change: 1 addition & 0 deletions EHC/src/ehc/Foreign/AbsSyn.cag
View file
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -94,6 +94,7 @@ DATA ForeignExpr
| Empty -- nothing | Empty -- nothing
| Str str : String -- string constant | Str str : String -- string constant
| ObjData -- data export for JS objects | ObjData -- data export for JS objects
| NewObj expr : ForeignExpr


TYPE ForeignExprs = [ForeignExpr] TYPE ForeignExprs = [ForeignExpr]


Expand Down
34 changes: 17 additions & 17 deletions EHC/src/ehc/Foreign/Parser.chs
View file
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -121,22 +121,22 @@ pForeignVar = tokGetVal <$> (pVARID <|> pCONID)
pForeignExpr :: ForeignParser ForeignExpr pForeignExpr :: ForeignParser ForeignExpr
pForeignExpr pForeignExpr
= pExp = pExp
where pExp = pObj <|> mk <$> pPre <*> pExpB <*> pPost where pExp = pObj <|> mk <$> pPre <*> pExpB <*> pPost
pPre = pList pPtr pPre = pMb (ForeignExpr_NewObj <$ pNEW)
pPost = pList (pSel <|> pInx <|> pCall) pPost = pList (pSel <|> pInx <|> pCall)
pExpB = pArg <|> pEnt pExpB = pArg <|> pEnt
pArg = pPERCENT pManyArg = ForeignExpr_AllArg <$ pPERCENT <* pSTAR
<**> ( const ForeignExpr_AllArg <$ pSTAR pArg = (pPERCENT *> ((ForeignExpr_Arg . tokMkInt) <$> pInteger10Tk)) <|> pStr
<|> (\i _ -> ForeignExpr_Arg (tokMkInt i)) <$> pInteger10Tk pObj = ForeignExpr_ObjData <$ pOCURLY <* pCCURLY
) pEnt = ForeignExpr_EntNm <$> pForeignVar
<|> pStr pStr = (ForeignExpr_Str . tokMkStr) <$> pStringTk
pObj = ForeignExpr_ObjData <$ pOCURLY <* pCCURLY pInx = flip ForeignExpr_Inx <$ pOBRACK <*> pExp <* pCBRACK
pEnt = ForeignExpr_EntNm <$> pForeignVar pSel = flip ForeignExpr_Sel <$ pDOT <*> (pEnt <|> pArg)
pStr = (ForeignExpr_Str . tokMkStr) <$> pStringTk pCall = flip ForeignExpr_CallArgs <$ pOPAREN <*> pCallExpr <* pCPAREN
pPtr = ForeignExpr_Ptr <$ pAMPERSAND pCallExpr = ((\x -> [x]) <$> pManyArg) <|> (pListSep pCOMMA pArg)
pInx = (flip ForeignExpr_Inx) <$ pOBRACK <*> pExp <* pCBRACK
pSel = (flip ForeignExpr_Sel) <$ pDOT <*> pEnt mk = \pre e post -> let pre' = maybe [] ((flip (:)) []) pre
pCall = flip ForeignExpr_CallArgs <$ pOPAREN <*> pListSep pCOMMA pArg <* pCPAREN in foldr ($) e $ pre' ++ reverse post
mk = \pre e post -> foldr ($) e $ pre ++ reverse post
%%] %%]


6 changes: 4 additions & 2 deletions EHC/src/ehc/Scanner/Common.chs
View file
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -418,8 +418,8 @@ tyScanOpts
%%[90 %%[90
foreignEntScanOpts :: FFIWay -> ScanOpts foreignEntScanOpts :: FFIWay -> ScanOpts
foreignEntScanOpts way foreignEntScanOpts way
= o { scoKeywordsTxt = Set.fromList [ "dynamic", "wrapper", "h", "static" ] = o { scoKeywordsTxt = Set.fromList [ "dynamic", "wrapper", "h", "static", "new" ]
, scoSpecChars = Set.fromList ".&%[]()*{}" , scoSpecChars = Set.fromList ",.&%[]()*{}"
, scoDollarIdent = False , scoDollarIdent = False
, scoKeywExtraChars = Set.fromList wayKeywExtraChars , scoKeywExtraChars = Set.fromList wayKeywExtraChars
, scoAllowQualified = False , scoAllowQualified = False
Expand Down Expand Up @@ -934,6 +934,7 @@ pUNSAFE ,
pWRAPPER , pWRAPPER ,
pSTATIC , pSTATIC ,
pH , pH ,
pNEW ,
pAMPERSAND pAMPERSAND
:: IsParser p Token => p Token :: IsParser p Token => p Token


Expand All @@ -944,6 +945,7 @@ pWRAPPER = pKeyTk "wrapper" -- not a HS keyword, but only for foreign fu
pSTATIC = pKeyTk "static" -- not a HS keyword, but only for foreign function entity pSTATIC = pKeyTk "static" -- not a HS keyword, but only for foreign function entity
pH = pKeyTk "h" -- not a HS keyword, but only for foreign function entity pH = pKeyTk "h" -- not a HS keyword, but only for foreign function entity
pAMPERSAND = pKeyTk "&" -- not a HS keyword, but only for foreign function entity pAMPERSAND = pKeyTk "&" -- not a HS keyword, but only for foreign function entity
pNEW = pKeyTk "new"


tokKeywStrsEH90 = [ ] tokKeywStrsEH90 = [ ]
tokKeywStrsHS90 = [ "unsafe", "threadsafe", "dynamic" ] tokKeywStrsHS90 = [ "unsafe", "threadsafe", "dynamic" ]
Expand Down

0 comments on commit d81a1f2

Please sign in to comment.