git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix for #179
68e90f1Gary Burgess
examples/passing/Functions2.pursnew file+17
compare with golang
unifiedsplit
@@ -0,0 +1,17 @@
1+module Functions2 where
2+
3+ import Prelude
4+
5+ test :: forall a b. a -> b -> a
6+ test = \const _ -> const
7+
8+module Main where
9+
10+ import Prelude
11+ import Functions2
12+
13+ main = do
14+ let value = test "Done" {}
15+ if value == "Done"
16+ then Trace.trace "Done"
17+ else Errors.throwError "Not done"
src/Language/PureScript/CodeGen/JS.hs+8−1
@@ -116,13 +116,20 @@ valueToJs opts m e (Case values binders) = bindersToJs opts m e binders (map (va
116valueToJs opts m e (IfThenElse cond th el) = JSConditional (valueToJs opts m e cond) (valueToJs opts m e th) (valueToJs opts m e el)
116valueToJs opts m e (IfThenElse cond th el) = JSConditional (valueToJs opts m e cond) (valueToJs opts m e th) (valueToJs opts m e el)
117valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val)
117valueToJs opts m e (Accessor prop val) = JSAccessor prop (valueToJs opts m e val)
118valueToJs opts m e (App val arg) = JSApp (valueToJs opts m e val) [valueToJs opts m e arg]
118valueToJs opts m e (App val arg) = JSApp (valueToJs opts m e val) [valueToJs opts m e arg]
119−valueToJs opts m e (Abs arg val) = JSFunction Nothing [identToJs arg] (JSBlock [JSReturn (valueToJs opts m e val)])
119+valueToJs opts m e (Abs arg val) = JSFunction Nothing [identToJs arg] (JSBlock [JSReturn (valueToJs opts m (bindName m arg e) val)])
120valueToJs opts m e (TypedValue _ (Abs arg val) ty) | optionsPerformRuntimeTypeChecks opts = let arg' = identToJs arg in JSFunction Nothing [arg'] (JSBlock $ runtimeTypeChecks arg' ty ++ [JSReturn (valueToJs opts m e val)])
120valueToJs opts m e (TypedValue _ (Abs arg val) ty) | optionsPerformRuntimeTypeChecks opts = let arg' = identToJs arg in JSFunction Nothing [arg'] (JSBlock $ runtimeTypeChecks arg' ty ++ [JSReturn (valueToJs opts m e val)])
121valueToJs _ m e (Var ident) = varToJs m e ident
121valueToJs _ m e (Var ident) = varToJs m e ident
122valueToJs opts m e (TypedValue _ val _) = valueToJs opts m e val
122valueToJs opts m e (TypedValue _ val _) = valueToJs opts m e val
123valueToJs _ _ _ (TypeClassDictionary _ _) = error "Type class dictionary was not replaced"
123valueToJs _ _ _ (TypeClassDictionary _ _) = error "Type class dictionary was not replaced"
124valueToJs _ _ _ _ = error "Invalid argument to valueToJs"
124valueToJs _ _ _ _ = error "Invalid argument to valueToJs"
125
125
126+-- |
127+-- Temporarily extends the environment to include a local variable name introduced by a lambda
128+-- abstraction. The stored type is incorrect, but not used.
129+--
130+bindName :: ModuleName -> Ident -> Environment -> Environment
131+bindName m ident env = env { names = M.insert (m, ident) (unit, LocalVariable) $ names env }
132+
126runtimeTypeChecks :: String -> Type -> [JS]
133runtimeTypeChecks :: String -> Type -> [JS]
127runtimeTypeChecks arg ty =
134runtimeTypeChecks arg ty =
128 let
135 let