Skip to content
Browse files

JScript FFI declarations can now use the new keyword. Fixed scanner t…

…o recognize commas (for multiple arguments). Made the JScript FFI syntax more restrictive with respect to the placement of argument wildcard(s).
  • Loading branch information...
1 parent 8f52055 commit ffa90197d0c29bc7d77fa94d7ed7ba7a6002a549 @rubendg rubendg committed
View
2 EHC/SVNREVISION
@@ -1 +1 @@
-2378M
+2404M
View
2 EHC/src/ehc/Core/ToJScript.cag
@@ -631,7 +631,7 @@ ffiJScriptMkCall ty
mk = J.Expr_Call
%%][90
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: Document that we require callback functions to be in IO
mkWrap n (e:_) = mkWrapFn as bdy
View
8 EHC/src/ehc/Foreign.cag
@@ -71,6 +71,7 @@ foreignexprEval
, e -> [e] -> e -- call
, e -> e -- as var/ptr
, [e] -> e -- object
+ , e -> e -- new object
, String -> e -- name
, String -> e -- string
)
@@ -79,7 +80,7 @@ foreignexprEval
-> [e] -- args
-> e
foreignexprEval
- (mkSel,mkInx,mkCall,mkPtr,mkObj,mkNm,mkStr)
+ (mkSel,mkInx,mkCall,mkPtr,mkObj,mkNewObj,mkNm,mkStr)
fexpr ent args
= oeE oe
where argl = zip [1..] args
@@ -120,6 +121,9 @@ foreignexprEval
ev (ForeignExpr_ObjData) ie = let
in mkOE ( mkObj (ieArgs ie) )
( 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
%%]
@@ -151,6 +155,7 @@ instance Serialize ForeignExpr where
sput (ForeignExpr_AllArg ) = sputWord8 8
sput (ForeignExpr_Str a ) = sputWord8 9 >> sput a
sput (ForeignExpr_ObjData ) = sputWord8 10
+ sput (ForeignExpr_NewObj a ) = sputWord8 11 >> sput a
sget = do
t <- sgetWord8
case t of
@@ -165,6 +170,7 @@ instance Serialize ForeignExpr where
8 -> return ForeignExpr_AllArg
9 -> liftM ForeignExpr_Str sget
10 -> return ForeignExpr_ObjData
+ 11 -> liftM ForeignExpr_NewObj sget
instance Serialize ForeignEnt where
View
1 EHC/src/ehc/Foreign/AbsSyn.cag
@@ -94,6 +94,7 @@ DATA ForeignExpr
| Empty -- nothing
| Str str : String -- string constant
| ObjData -- data export for JS objects
+ | NewObj expr : ForeignExpr
TYPE ForeignExprs = [ForeignExpr]
View
34 EHC/src/ehc/Foreign/Parser.chs
@@ -121,22 +121,22 @@ pForeignVar = tokGetVal <$> (pVARID <|> pCONID)
pForeignExpr :: ForeignParser ForeignExpr
pForeignExpr
= pExp
- where pExp = pObj <|> mk <$> pPre <*> pExpB <*> pPost
- pPre = pList pPtr
- pPost = pList (pSel <|> pInx <|> pCall)
- pExpB = pArg <|> pEnt
- pArg = pPERCENT
- <**> ( const ForeignExpr_AllArg <$ pSTAR
- <|> (\i _ -> ForeignExpr_Arg (tokMkInt i)) <$> pInteger10Tk
- )
- <|> pStr
- pObj = ForeignExpr_ObjData <$ pOCURLY <* pCCURLY
- pEnt = ForeignExpr_EntNm <$> pForeignVar
- pStr = (ForeignExpr_Str . tokMkStr) <$> pStringTk
- pPtr = ForeignExpr_Ptr <$ pAMPERSAND
- pInx = (flip ForeignExpr_Inx) <$ pOBRACK <*> pExp <* pCBRACK
- pSel = (flip ForeignExpr_Sel) <$ pDOT <*> pEnt
- pCall = flip ForeignExpr_CallArgs <$ pOPAREN <*> pListSep pCOMMA pArg <* pCPAREN
- mk = \pre e post -> foldr ($) e $ pre ++ reverse post
+ where pExp = pObj <|> mk <$> pPre <*> pExpB <*> pPost
+ pPre = pMb (ForeignExpr_NewObj <$ pNEW)
+ pPost = pList (pSel <|> pInx <|> pCall)
+ pExpB = pArg <|> pEnt
+ pManyArg = ForeignExpr_AllArg <$ pPERCENT <* pSTAR
+ pArg = (pPERCENT *> ((ForeignExpr_Arg . tokMkInt) <$> pInteger10Tk)) <|> pStr
+ pObj = ForeignExpr_ObjData <$ pOCURLY <* pCCURLY
+ pEnt = ForeignExpr_EntNm <$> pForeignVar
+ pStr = (ForeignExpr_Str . tokMkStr) <$> pStringTk
+ pInx = flip ForeignExpr_Inx <$ pOBRACK <*> pExp <* pCBRACK
+ pSel = flip ForeignExpr_Sel <$ pDOT <*> (pEnt <|> pArg)
+ pCall = flip ForeignExpr_CallArgs <$ pOPAREN <*> pCallExpr <* pCPAREN
+ pCallExpr = ((\x -> [x]) <$> pManyArg) <|> (pListSep pCOMMA pArg)
+
+ mk = \pre e post -> let pre' = maybe [] ((flip (:)) []) pre
+ in foldr ($) e $ pre' ++ reverse post
+
%%]
View
6 EHC/src/ehc/Scanner/Common.chs
@@ -418,8 +418,8 @@ tyScanOpts
%%[90
foreignEntScanOpts :: FFIWay -> ScanOpts
foreignEntScanOpts way
- = o { scoKeywordsTxt = Set.fromList [ "dynamic", "wrapper", "h", "static" ]
- , scoSpecChars = Set.fromList ".&%[]()*{}"
+ = o { scoKeywordsTxt = Set.fromList [ "dynamic", "wrapper", "h", "static", "new" ]
+ , scoSpecChars = Set.fromList ",.&%[]()*{}"
, scoDollarIdent = False
, scoKeywExtraChars = Set.fromList wayKeywExtraChars
, scoAllowQualified = False
@@ -934,6 +934,7 @@ pUNSAFE ,
pWRAPPER ,
pSTATIC ,
pH ,
+ pNEW ,
pAMPERSAND
:: IsParser p Token => p Token
@@ -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
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
+pNEW = pKeyTk "new"
tokKeywStrsEH90 = [ ]
tokKeywStrsHS90 = [ "unsafe", "threadsafe", "dynamic" ]

0 comments on commit ffa9019

Please sign in to comment.
Something went wrong with that request. Please try again.