Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

merge of Rubens js branch, compiler

  • Loading branch information...
commit f3221a7202fa7bcaa37a5fe263a8ada93fc2653a 1 parent fc315b0
@atzedijkstra atzedijkstra authored
View
13 EHC/src/ehc/Core/ToJavaScript.cag
@@ -301,7 +301,7 @@ SEM CExpr
%%% Generation: expr
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%[(8 javascript) hs
+%%[(8 javascript) hs export(jsModDeps)
-- | tracing
jsTr :: PP x => String -> x -> Seq.Seq J.Stat
jsTr m x = Seq.singleton $ J.Stat_Expr $ J.Expr_Call (jsVar $ mkHNm "trace") [J.Expr_Str m, J.Expr_Inline $ showPP $ pp x]
@@ -371,10 +371,13 @@ jsBody mkRet binds stats lastExpr
Seq.map (\(JBind _ n _ e _) -> J.jsVarDecl n e) binds
`Seq.union` stats
`Seq.union` Seq.fromList (map mkRet $ maybeToList lastExpr)
+
+jsModDeps (J.JavaScriptModule_Mod _ d _) = d
%%]
%%[(8 javascript)
ATTR CExpr CBound [ | | js: {J.Expr} ]
+ATTR CExpr AllBind [ | | dps USE {`Set.union`} {Set.empty} : {Set.Set String} ]
%%]
%%[(8 javascript)
@@ -399,6 +402,10 @@ SEM CExpr
. js = if null @argMbConL
then (@mkResJS $ @mkFFI [])
else (jsVar $ mkHNm $ forextractEnt @foreignEntInfo)
+ . dps = case @foreignEntInfo of
+ ForeignExtraction_Plain {} -> Set.fromList $ forextractIncludes @foreignEntInfo
+ _ -> Set.empty
+
| Let loc . (jbindsLet,jstatsLet)
= if @isGlobal
then ( @binds.jbinds, Seq.empty )
@@ -637,7 +644,9 @@ ffiJavaScriptMkCall ty
mkWrap n (e:_) = mkWrapFn as bdy
where as = map (mkHNm . ('v':) . show) [1..(tyNumArgs ty - 1)]
rn = mkHNm "res"
+ -- evaluate the composite parts of "res" before returning to the regular js world
bdy = [ J.jsVarDecl rn $ jsEvl $ jsApp e $ (map jsVar as) ++ [J.Expr_Arr []]
+ , J.Stat_Expr $ jsEvl $ J.Expr_ArrInx (jsVar rn) (jsIntConst 0)
, J.Stat_Ret $ jsEvl $ J.Expr_ArrInx (jsVar rn) (jsIntConst 1) ]
mkDyn _ (e:es) = J.Expr_Call e es
@@ -688,7 +697,7 @@ ATTR CodeAGItf CModule [ | | js: {J.JavaScriptModule} ]
%%[(8 javascript)
SEM CModule
- | Mod lhs . js = J.JavaScriptModule_Mod (@jsModTraceStats ++ @jsModInitStats ++ @jmodStats) @jmodStatsMain
+ | Mod lhs . js = J.JavaScriptModule_Mod (@jsModTraceStats ++ @jsModInitStats ++ @jmodStats) (Set.toList @expr.dps) @jmodStatsMain
%%[[8
loc . jsModInitStats = []
%%][50
View
51 EHC/src/ehc/EHC/CompilePhase/CompileJavaScript.chs
@@ -7,7 +7,7 @@ JavaScript compilation
%%[(8 codegen javascript) module {%{EH}EHC.CompilePhase.CompileJavaScript}
%%]
-%%[(8 codegen javascript) import(System.Directory)
+%%[(8 codegen javascript) import(System.Directory, Data.List(intercalate), Data.Either, System.Exit)
%%]
-- general imports
@@ -59,11 +59,14 @@ cpCompileJavaScript how othModNmL modNm
fpM = fpO modNm fp
fpExec = mkPerExecOutputFPath opts modNm fp (Just "js")
fpHtml = mkPerExecOutputFPath opts modNm fp (Just "html")
+
; when (isJust mbJs && targetIsJavaScript (ehcOptTarget opts))
(do { cpMsg modNm VerboseALot "Emit JavaScript"
; when (ehcOptVerbosity opts >= VerboseDebug)
(do { lift $ putStrLn $ "fpO : " ++ fpathToStr fpM
; lift $ putStrLn $ "fpExec: " ++ fpathToStr fpExec
+ ; lift $ putStrLn $ show (ehcOptImportFileLocPath opts)
+ ; lift $ putStrLn $ "module dependencies:" ++ intercalate "," (jsModDeps (fromJust mbJs))
})
%%[[8
; let ppMod = ppJavaScriptModule (fromJust mbJs)
@@ -71,18 +74,35 @@ cpCompileJavaScript how othModNmL modNm
; let ppMod = vlist $ [p] ++ (if ecuIsMainMod ecu then [pmain] else [])
where (p,pmain) = ppJavaScriptModule (fromJust mbJs)
%%]]
+ ; let fpDeps = map fpathFromStr (jsModDeps (fromJust mbJs))
+ ; let searchPath = ehcOptImportFileLocPath opts
+
+ ; jsDepsFound <- jsDepsToFPaths searchPath fpDeps
+
+ ; let someJsDepsNotFound = either (const True) (const False)
+
+ ; when (someJsDepsNotFound jsDepsFound)
+ (do { let Left notFound = jsDepsFound
+ ; err $ "Could not find external js dependencies: " ++ intercalate "," (map fpathToStr notFound)
+ })
+
+ ; let Right jsDeps = jsDepsFound
+
; lift $ putPPFPath fpM ("//" >#< modNm >-< ppMod) 1000
; case how of
FinalCompile_Exec
%%[[50
| ehcOptWholeProgOptimizationScope opts
- -> do { cpJavaScript (fpathToStr fpExec) (rts ++ map fpathToStr [fpM])
- ; mkHtml fpHtml [fpathToStr fpExec]
+ -> do { cpJavaScript (fpathToStr fpExec) (rts ++ [fpathToStr fpM])
+ ; mkHtml fpHtml ((map fpathToStr jsDeps) ++ [fpathToStr fpExec])
}
%%]]
| otherwise
- -> do { cpJavaScript (fpathToStr fpExec) (map fpathToStr [fpM])
- ; mkHtml fpHtml $ rts ++ map fpathToStr ([ fpO m fp | m <- othModNmL, let (_,_,_,fp) = crBaseInfo m cr ] ++ [fpExec])
+ -> do { cpJavaScript (fpathToStr fpExec) [fpathToStr fpM]
+ ; mkHtml fpHtml $ ( map fpathToStr jsDeps )
+ ++ rts
+ ++ [ fpathToStr (fpO m fp) | m <- othModNmL, let (_,_,_,fp) = crBaseInfo m cr ]
+ ++ [ fpathToStr fpExec ]
}
where rts = map (Cfg.mkInstalledRts opts Cfg.mkJavaScriptLibFilename Cfg.INST_LIB (Cfg.installVariant opts)) Cfg.libnamesRts
%%[[8
@@ -106,6 +126,27 @@ cpCompileJavaScript how othModNmL modNm
>-< "</body>"
>-< "</html>"
+ findJsDep :: FileLocPath -> FPath -> EHCompilePhase (Maybe FPath)
+ findJsDep searchPath dep = lift $ searchPathForReadableFile (map filelocDir searchPath) [Just "js"] dep
+
+ jsDepsToFPaths :: FileLocPath -> [FPath] -> EHCompilePhase (Either [FPath] [FPath])
+ jsDepsToFPaths searchPath deps = do
+ paths <- mapM (\dep -> do {
+ ; depFound <- findJsDep searchPath dep
+ ; maybe (return $ Left dep) (return . Right) depFound
+ }) deps
+
+ let allLeft = lefts paths
+ hasUnfoundJsDeps = not $ null $ allLeft
+
+ if hasUnfoundJsDeps
+ then return $ Left allLeft
+ else return $ Right $ rights paths
+
+ err :: String -> EHCompilePhase ()
+ err x = do
+ lift $ hPutStrLn stderr ("error: " ++ x)
+ lift $ exitFailure
%%]
View
8 EHC/src/ehc/Foreign.cag
@@ -215,12 +215,12 @@ instance Serialize JavaScriptCall where
0 -> liftM4 JavaScriptCall_Id sget sget sget sget
-}
instance Serialize JavaScriptCall where
- sput (JavaScriptCall_Id a b) = sputWord8 0 >> sput a >> sput b
- sput (JavaScriptCall_Dynamic ) = sputWord8 1
- sput (JavaScriptCall_Wrapper ) = sputWord8 2
+ sput (JavaScriptCall_Id a b c) = sputWord8 0 >> sput a >> sput b >> sput c
+ sput (JavaScriptCall_Dynamic ) = sputWord8 1
+ sput (JavaScriptCall_Wrapper ) = sputWord8 2
sget = do t <- sgetWord8
case t of
- 0 -> liftM2 JavaScriptCall_Id sget sget
+ 0 -> liftM3 JavaScriptCall_Id sget sget sget
1 -> return JavaScriptCall_Dynamic
2 -> return JavaScriptCall_Wrapper
View
1  EHC/src/ehc/Foreign/AbsSyn.cag
@@ -59,6 +59,7 @@ DATA JavaScriptCall
-- "g[%1]" , f x y ~> g[x](y)
-- "&%1.g[%2]", f x y ~> x.g[y]
-- mbIndexArgNr : {Maybe Int}
+ mbInclude : {Maybe String}
mbForeignExpr : {Maybe ForeignExpr}
| Dynamic
| Wrapper
View
1  EHC/src/ehc/Foreign/Extract.cag
@@ -81,6 +81,7 @@ ATTR ForeignAGItf AllForeign [ | | extr: ForeignExtraction ]
SEM JavaScriptCall
| Id lhs . extr = emptyForeignExtraction
{ forextractEnt = @nm
+ , forextractIncludes = maybeToList @mbInclude
, forextractForeignExpr = maybe (forextractForeignExpr emptyForeignExtraction) id @mbForeignExpr
}
| Wrapper lhs . extr = ForeignExtraction_Wrapper
View
8 EHC/src/ehc/Foreign/Parser.chs
@@ -111,11 +111,17 @@ pPrimCall dfltNm
%%[[(90 javascript)
pJavaScriptCall :: Maybe String -> ForeignParser JavaScriptCall
pJavaScriptCall dfltNm
- = JavaScriptCall_Id nm <$> pMb pForeignExpr
+ = (\inclJs e -> JavaScriptCall_Id nm (appendJs inclJs) e) <$> pMb pIncludeJs <*> pMb pForeignExpr
<|> JavaScriptCall_Dynamic <$ pDYNAMIC
<|> JavaScriptCall_Wrapper <$ pWRAPPER
where nm = maybe "" id dfltNm
+ appendJs (Just x) = Just (x ++ ".js")
+ appendJs Nothing = Nothing
+
+ pIncludeJs :: ForeignParser String
+ pIncludeJs = pForeignVar <* pDOT <* pJS
+
pForeignVar :: ForeignParser String
pForeignVar = tokGetVal <$> (pVARID <|> pCONID)
View
3  EHC/src/ehc/JavaScript/AbsSyn.cag
@@ -14,7 +14,8 @@ DATA AGItf
DATA JavaScriptModule
| Mod decls : StatL
- main : StatL
+ deps : {[String]}
+ main : StatL
%%]
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
View
4 EHC/src/ehc/Scanner/Common.chs
@@ -418,7 +418,7 @@ tyScanOpts
%%[90
foreignEntScanOpts :: FFIWay -> ScanOpts
foreignEntScanOpts way
- = o { scoKeywordsTxt = Set.fromList [ "dynamic", "wrapper", "h", "static", "new" ]
+ = o { scoKeywordsTxt = Set.fromList [ "dynamic", "wrapper", "h", "static", "new", "js" ]
, scoSpecChars = Set.fromList ",.&%[]()*{}"
, scoDollarIdent = False
, scoKeywExtraChars = Set.fromList wayKeywExtraChars
@@ -937,6 +937,7 @@ pUNSAFE ,
pSTATIC ,
pH ,
pNEW ,
+ pJS ,
pAMPERSAND
:: IsParser p Token => p Token
@@ -948,6 +949,7 @@ pSTATIC = pKeyTk "static" -- not a HS keyword, but only for foreign fun
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"
+pJS = pKeyTk "js"
tokKeywStrsEH90 = [ ]
tokKeywStrsHS90 = [ "unsafe", "threadsafe", "dynamic" ]

0 comments on commit f3221a7

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