55e092d · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Revert "Remove runtime type checks #93"

55e092dPhil Freeman13 years ago

psc/Main.hs+5−1

compare with golang

unifiedsplit

@@ -83,6 +83,10 @@ tco :: Term Bool

83tco = value $ flag $ (optInfo [ "tco" ])

84 { optDoc = "Perform tail call optimizations" }

86+performRuntimeTypeChecks :: Term Bool

87+performRuntimeTypeChecks = value $ flag $ (optInfo [ "runtime-type-checks" ])

88+ { optDoc = "Generate runtime type checks" }

89+

86noPrelude :: Term Bool

90noPrelude :: Term Bool

87noPrelude = value $ flag $ (optInfo [ "no-prelude" ])

91noPrelude = value $ flag $ (optInfo [ "no-prelude" ])

88 { optDoc = "Omit the Prelude" }

92 { optDoc = "Omit the Prelude" }

@@ -112,7 +116,7 @@ codeGenModules = value $ optAll [] $ (optInfo [ "codegen" ])

112 { optDoc = "A list of modules for which Javascript and externs should be generated. This argument can be used multiple times." }

116 { optDoc = "A list of modules for which Javascript and externs should be generated. This argument can be used multiple times." }

113

117

114options :: Term P.Options

118options :: Term P.Options

115−options = P.Options <$> tco <*> magicDo <*> runMain <*> noOpts <*> browserNamespace <*> dceModules <*> codeGenModules

119+options = P.Options <$> tco <*> performRuntimeTypeChecks <*> magicDo <*> runMain <*> noOpts <*> browserNamespace <*> dceModules <*> codeGenModules

116

120

117stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])

121stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])

118stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles

122stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles

psci/Main.hs+1−1

@@ -195,7 +195,7 @@ completion = completeWord Nothing " \t\n\r" findCompletions

195-- | Compilation options.

196--

197options :: P.Options

198−options = P.Options True True (Just "Main") True "PS" [] []

198+options = P.Options True False True (Just "Main") True "PS" [] []

199

200-- |

201-- Makes a volatile module to execute the current expression.

src/Language/PureScript/CodeGen/JS.hs+34

@@ -135,6 +135,7 @@ valueToJs opts m e (IfThenElse cond th el) = JSConditional (valueToJs opts m e c

135valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val)

136valueToJs opts m e (App val arg) = JSApp (valueToJs opts m e val) [valueToJs opts m e arg]

137valueToJs opts m e (Abs (Left arg) val) = JSFunction Nothing [identToJs arg] (JSBlock [JSReturn (valueToJs opts m (bindName m arg e) val)])

138+valueToJs opts m e (TypedValue _ (Abs (Left arg) val) ty) | optionsPerformRuntimeTypeChecks opts = let arg' = identToJs arg in JSFunction Nothing [arg'] (JSBlock $ runtimeTypeChecks arg' ty ++ [JSReturn (valueToJs opts m e val)])

138valueToJs _ m _ (Var ident) = varToJs m ident

139valueToJs _ m _ (Var ident) = varToJs m ident

139valueToJs opts m e (TypedValue _ val _) = valueToJs opts m e val

140valueToJs opts m e (TypedValue _ val _) = valueToJs opts m e val

140valueToJs _ _ _ (TypeClassDictionary _ _) = error "Type class dictionary was not replaced"

141valueToJs _ _ _ (TypeClassDictionary _ _) = error "Type class dictionary was not replaced"

@@ -172,6 +173,39 @@ bindNames m idents env = env { names = M.fromList [ ((m, ident), (noType, LocalV

172 where

173 where

173 noType = error "Temporary lambda variable type was read"

174 noType = error "Temporary lambda variable type was read"

174

175

176+

177+-- |

178+-- Generate code in the simplified Javascript intermediate representation for runtime type checks.

179+--

180+runtimeTypeChecks :: String -> Type -> [JS]

181+runtimeTypeChecks arg ty =

182+ let

183+ argTy = getFunctionArgumentType ty

184+ in

185+ maybe [] (argumentCheck (JSVar arg)) argTy

186+ where

187+ getFunctionArgumentType :: Type -> Maybe Type

188+ getFunctionArgumentType (TypeApp (TypeApp t funArg) _) | t == tyFunction = Just funArg

189+ getFunctionArgumentType (ForAll _ ty' _) = getFunctionArgumentType ty'

190+ getFunctionArgumentType _ = Nothing

191+ argumentCheck :: JS -> Type -> [JS]

192+ argumentCheck val t | t == tyNumber = [typeCheck val "number"]

193+ argumentCheck val t | t == tyString = [typeCheck val "string"]

194+ argumentCheck val t | t == tyBoolean = [typeCheck val "boolean"]

195+ argumentCheck val (TypeApp t _) | t == tyArray = [arrayCheck val]

196+ argumentCheck val (Object row) =

197+ let

198+ (pairs, _) = rowToList row

199+ in

200+ typeCheck val "object" : concatMap (\(prop, ty') -> argumentCheck (JSAccessor prop val) ty') pairs

201+ argumentCheck val (TypeApp (TypeApp t _) _) | t == tyFunction = [typeCheck val "function"]

202+ argumentCheck val (ForAll _ ty' _) = argumentCheck val ty'

203+ argumentCheck _ _ = []

204+ typeCheck :: JS -> String -> JS

205+ typeCheck js ty' = JSIfElse (JSBinary NotEqualTo (JSTypeOf js) (JSStringLiteral ty')) (JSBlock [JSThrow (JSStringLiteral $ ty' ++ " expected")]) Nothing

206+ arrayCheck :: JS -> JS

207+ arrayCheck js = JSIfElse (JSUnary Not (JSApp (JSAccessor "isArray" (JSVar "Array")) [js])) (JSBlock [JSThrow (JSStringLiteral "Array expected")]) Nothing

208+

175-- |

209-- |

176-- Generate code in the simplified Javascript intermediate representation for a reference to a

210-- Generate code in the simplified Javascript intermediate representation for a reference to a

177-- variable.

211-- variable.

src/Language/PureScript/Options.hs+5−1

@@ -23,6 +23,10 @@ data Options = Options {

23 -- Perform tail-call elimination

24 --

25 optionsTco :: Bool

26+ -- |

27+ -- Perform type checks at runtime

28+ --

29+ , optionsPerformRuntimeTypeChecks :: Bool

26 -- |

30 -- |

27 -- Inline calls to ret and bind for the Eff monad

31 -- Inline calls to ret and bind for the Eff monad

28 --

32 --

@@ -55,4 +59,4 @@ data Options = Options {

55-- Default compiler options

59-- Default compiler options

56--

60--

57defaultOptions :: Options

61defaultOptions :: Options

58−defaultOptions = Options False False Nothing False "PS" [] []

62+defaultOptions = Options False False False Nothing False "PS" [] []