@@ -7,6 +7,9 @@ module CodeGen.IL.Printer
77 , implHeaderSource
88 , implFooterSource
99 , isLiteral
10+ , modLabel
11+ , modPrefix
12+ , ffiLoader
1013 ) where
1114
1215import Prelude.Compat
@@ -15,7 +18,6 @@ import Control.Arrow ((<+>))
1518import Control.Monad (forM, mzero)
1619import Control.Monad.State (StateT, evalStateT)
1720import Control.PatternArrows
18−import Data.Char (isAscii)
1921import Data.List (filter, (\\))
2022import qualified Control.Arrow as A
2123
@@ -31,7 +33,9 @@ import Language.PureScript.Crash
3133import Language.PureScript.Names (Ident, runIdent)
3234import Language.PureScript.Pretty.Common
3335import Language.PureScript.PSString (PSString, decodeString, mkString)
36+
3437import CodeGen.IL.Common
38+import CodeGen.IL.Optimizer.TCO (tcoLoop)
3539
3640import qualified Language.PureScript.Constants as C
3741
@@ -49,26 +53,23 @@ literals = mkPattern' match'
4953 match (BooleanLiteral _ True) = return $ emit "true"
5054 match (BooleanLiteral _ False) = return $ emit "false"
5155 match (ArrayLiteral _ xs) = mconcat <$> sequence
52− [ return . emit $ arrayType <> "{ "
56+ [ return . emit $ arrayType <> "{"
5357 , intercalate (emit ", ") <$> forM xs prettyPrintIL'
54− , return $ emit " }"
58+ , return $ emit "}"
5559 ]
5660 -- match (ObjectLiteral _ []) = return $ emit "std::initializer_list<std::pair<const string, boxed>>{}"
5761 match (ObjectLiteral _ ps) = mconcat <$> sequence
58− [ return . emit $ dictType <> "{\n"
62+ [ return . emit $ dictType <> "{"
5963 , withIndent $ do
6064 ils <- forM ps $ \(key, value) -> do
6165 value' <- prettyPrintIL' value
62− return $ emit "{ " <> objectPropertyToString key <> value' <> emit " }"
63− indentString <- currentIndent
64− return $ intercalate (emit ",\n") $ map (indentString <>) ils
65− , return $ emit "\n"
66− , currentIndent
66+ return $ objectPropertyToString key <> value'
67+ return $ intercalate (emit " ") $ map (<> emit ",") ils
6768 , return $ emit "}"
6869 ]
6970 where
7071 objectPropertyToString :: (Emit gen) => PSString -> gen
71− objectPropertyToString s = emit $ stringLiteral s <> ", "
72+ objectPropertyToString s = emit $ stringLiteral s <> ": "
7273 match (Block _ sts) = mconcat <$> sequence
7374 [ return $ emit "{\n"
7475 , withIndent $ prettyStatements sts
@@ -76,9 +77,10 @@ literals = mkPattern' match'
7677 , currentIndent
7778 , return $ emit "}"
7879 ]
80+ match (Var _ ident) | ident == C.undefined = return $ emit undefinedName
7981 match (Var _ ident) = return $ emit ident
8082 match (VariableIntroduction _ ident value) = mconcat <$> sequence
81− [ return $ emit $ "boxed " <> ident
83+ [ return . emit $ varDecl <> " " <> ident <> " " <> anyType
8284 , maybe (return mempty) (fmap (emit " = " <>) . prettyPrintIL') value
8385 ]
8486 match (Assignment _ target value) = mconcat <$> sequence
@@ -87,163 +89,195 @@ literals = mkPattern' match'
8789 , prettyPrintIL' value
8890 ]
8991 match (App _ val []) = mconcat <$> sequence
90− [ prettyPrintIL' val
91− , return $ emit "()"
92+ [ return $ emit "Run("
93+ , prettyPrintIL' val
94+ , return $ emit ")"
9295 ]
93− match (App ss (App _ (App _ (Indexer _ (Var _ fn) (Var _ fnMod)) [Indexer _ (Var _ dict) (Var _ dictMod)]) [x]) [y])
94− | fnMod == dictMod
95− , dictMod == C.dataEq || dictMod == C.dataSemiring || dictMod == C.dataRing ||
96− dictMod == C.dataEuclideanRing || dictMod == C.dataHeytingAlgebra
97− , Just op <- renderOp fn
98− , Just t <- unboxType dict
99− = mconcat <$> sequence
100− [ return $ emit $ unbox' t x
101− , return $ emit op
102− , return $ emit $ unbox' t y
103− ]
104− match (App _ (App _ (Indexer _ (Var _ fn) (Var _ fnMod)) [Indexer _ (Var _ dict) (Var _ dictMod)]) [n])
105− | fnMod == dictMod
106− , dictMod == C.dataRing
107− , fn == C.negate
108− , Just t <- unboxType dict
109− = mconcat <$> sequence
110− [ return $ emit "-"
111− , return $ emit $ unbox' t n
112− ]
113− match (App _ (App _ (Indexer _ (Var _ fn) (Var _ fnMod)) [Indexer _ (Var _ dict) (Var _ dictMod)]) [n])
114− | fnMod == dictMod
115− , dictMod == C.dataHeytingAlgebra
116− , fn == properToIL C.not
117− , Just t <- unboxType dict
96+ match (App _ (StringLiteral _ u) [arg])
97+ | Just ty <- decodeString u = mconcat <$> sequence
98+ [ prettyPrintIL' arg
99+ , return $ emit ".("
100+ , return $ emit ty
101+ , return $ emit ")"
102+ ]
103+ match (App _ (Var _ fn) [arg]) | fn == arrayLengthFn = mconcat <$> sequence
104+ [ return $ emit fn
105+ , return $ emit "("
106+ , prettyPrintIL' arg
107+ , return $ emit ")"
108+ ]
109+ match (App _ (Var _ fn) args) | fn == indexFn = mconcat <$> sequence
110+ [ return $ emit fn
111+ , return $ emit "("
112+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
113+ , return $ emit ")"
114+ ]
115+ match (App _ (Var _ fn) args) | fn == tcoLoop = mconcat <$> sequence
116+ [ return $ emit fn
117+ , return $ emit "("
118+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
119+ , return $ emit ")"
120+ ]
121+ match (App _ (App Nothing (StringLiteral Nothing fnx) [fn@Function{}]) args)
122+ | Just ftype <- decodeString fnx
123+ , "Fn" `T.isPrefixOf` ftype = mconcat <$> sequence
124+ [ prettyPrintIL' fn
125+ , return $ emit "("
126+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
127+ , return $ emit ")"
128+ ]
129+ match (App _ (App Nothing (StringLiteral Nothing fnx) [fn]) args)
130+ | Just ftype <- decodeString fnx
131+ , "Fn" `T.isPrefixOf` ftype = mconcat <$> sequence
132+ [ prettyPrintIL' fn
133+ , return $ emit ".("
134+ , return $ emit ftype
135+ , return $ emit ")("
136+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
137+ , return $ emit ")"
138+ ]
139+ match app@(App{})
140+ | (val, args) <- unApp app []
141+ , length args > 1
118142 = mconcat <$> sequence
119− [ return $ emit "!"
120− , return $ emit $ unbox' t n
143+ [ return $ emit "Apply("
144+ , prettyPrintIL' val
145+ , return $ emit ", "
146+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
147+ , return $ emit ")"
121148 ]
122149 match (App _ val args) = mconcat <$> sequence
123− [ prettyPrintIL' val
124− , return $ emit "("
150+ [ return $ emit "Apply("
151+ , prettyPrintIL' val
152+ , return $ emit ", "
125153 , intercalate (emit ", ") <$> forM args prettyPrintIL'
126154 , return $ emit ")"
127155 ]
128156 match (Function _ (Just name) [] (Block _ [Return _ ret]))
129− | isLiteral ret = mconcat <$> sequence
130− [ return $ emit "auto "
131− , return $ emit name
132− , return $ emit "() -> const boxed& "
157+ | isComplexLiteral ret = mconcat <$> sequence
158+ [ return $ emit "\n"
159+ , return . emit $ varDecl <> " " <> initName name <> " Once\n"
160+ , prettyPrintIL' $ VariableIntroduction Nothing (valueName name) Nothing
161+ , return $ emit "\n\n"
162+ , return $ emit "func "
163+ , return . emit $ withPrefix name
164+ , return . emit $ "() " <> anyType <> " "
133165 , return $ emit "{\n"
134166 , withIndent $ do
135− indentString <- currentIndent
136− return $ indentString <> emit staticValueBegin
167+ indentString <- currentIndent
168+ return $ indentString <> (emit $ initName name <> ".Do(func() {\n") <>
169+ indentString <> indentString <> (emit $ valueName name <> " = ")
137170 , withIndent $ do
138171 case ret of
139172 Function _ Nothing args body -> mconcat <$> sequence
140− [ return $ emit "[]("
141− , return $ emit $ intercalate ", " (renderArg <$> args)
142− , return $ emit ") -> boxed "
173+ [ return $ emit "func("
174+ , return . emit $ intercalate ", " (renderArg anyType <$> args)
175+ , return . emit $ ") " <> anyType <> " "
143176 , prettyPrintIL' body
144177 ]
145178 _ -> do
146179 prettyPrintIL' ret
147− , return $ emit ";\n"
180+ , return $ emit "\n"
148181 , withIndent $ do
149− indentString <- currentIndent
150− return $ indentString <> emit staticValueEnd
151− , return $ emit "\n}"
182+ indentString <- currentIndent
183+ return $ indentString <> (emit $ "})\n" <> "return " <> valueName name <>"\n")
184+ , return $ emit "}\n\n"
152185 ]
153186 match (Function _ (Just name) [] ret) = mconcat <$> sequence
154− [ return $ emit "auto "
155− , return $ emit name
156− , return $ emit "() -> boxed "
187+ [ return $ emit "func "
188+ , return . emit $ withPrefix name
189+ , return . emit $ "() " <> anyType <> " "
157190 , prettyPrintIL' ret
158191 ]
159− match (Function _ name args ret) = mconcat <$> sequence
160− [ return $ emit captures
161− , return $ emit "("
162− , return $ emit $ intercalate ", " (render <$> args)
163− , return $ emit ") -> boxed "
192+ match (Function _ _ args ret) = mconcat <$> sequence
193+ [ return $ emit "func("
194+ , return . emit $ intercalate ", " (renderArg anyType <$> args)
195+ , return . emit $ ") " <> anyType <> " "
164196 , prettyPrintIL' ret
165197 ]
166− where
167− (captures, render)
168− | name == Just tcoLoop = ("[&]", renderArgByVal)
169− | otherwise = ("[=]", renderArg)
170− match (Indexer _ prop@(Var _ name) val) = mconcat <$> sequence
198+ match (Indexer _ (Var _ name) (Var _ "")) = mconcat <$> sequence
199+ [ prettyPrintIL' (Var Nothing $ withPrefix name)
200+ , return $ emit "()"
201+ ]
202+ match (Indexer _ (Var _ name) val) = mconcat <$> sequence
171203 [ prettyPrintIL' val
172− , return $ emit "::"
173− , prettyPrintIL' prop
204+ , return $ emit "."
205+ , prettyPrintIL' (Var Nothing $ withPrefix name)
174206 , return $ emit "()"
175207 ]
176− match (Indexer _ prop val) = mconcat <$> sequence
208+ match (Indexer _ prop@StringLiteral{} val@ObjectLiteral{}) = mconcat <$> sequence
177209 [ prettyPrintIL' val
178210 , return $ emit "["
179211 , prettyPrintIL' prop
180212 , return $ emit "]"
181213 ]
214+ match (Indexer _ prop@StringLiteral{} val) = mconcat <$> sequence
215+ [ prettyPrintIL' val
216+ , return $ emit ".("
217+ , return $ emit dictType
218+ , return $ emit ")["
219+ , prettyPrintIL' prop
220+ , return $ emit "]"
221+ ]
222+ match (Indexer _ index val@ArrayLiteral{}) = mconcat <$> sequence
223+ [ prettyPrintIL' val
224+ , return $ emit "["
225+ , prettyPrintIL' index
226+ , return $ emit "]"
227+ ]
228+ match (Indexer _ index val) = mconcat <$> sequence
229+ [ prettyPrintIL' val
230+ , return $ emit ".("
231+ , return $ emit arrayType
232+ , return $ emit ")["
233+ , prettyPrintIL' index
234+ , return $ emit "]"
235+ ]
182236 match (InstanceOf _ val ty) = mconcat <$> sequence
183− [ return . emit $ unbox' dictType val
184− , return $ emit ".contains("
237+ [ return $ emit "Is("
238+ , prettyPrintIL' val
239+ , return $ emit ", "
185240 , prettyPrintIL' ty
186241 , return $ emit ")"
187242 ]
188243 match (While _ cond sts) = mconcat <$> sequence
189− [ return $ emit "while ("
244+ [ return $ emit "for "
190245 , prettyPrintIL' cond
191− , return $ emit ") "
246+ , return $ emit " "
192247 , prettyPrintIL' sts
193248 ]
194249 match (For _ ident start end sts) = mconcat <$> sequence
195− [ return $ emit $ "for (boxed " <> ident <> " = "
250+ [ return $ emit $ "for var " <> ident <> " = "
196251 , prettyPrintIL' start
197252 , return $ emit $ "; " <> ident <> " < "
198253 , prettyPrintIL' end
199− , return $ emit $ "; " <> ident <> "++) "
254+ , return $ emit $ "; " <> ident <> "++ "
200255 , prettyPrintIL' sts
201256 ]
202257 match (ForIn _ ident obj sts) = mconcat <$> sequence
203− [ return $ emit $ "for (boxed " <> ident <> " in "
258+ [ return $ emit $ "for var " <> ident <> " in "
204259 , prettyPrintIL' obj
205− , return $ emit ") "
260+ , return $ emit " "
206261 , prettyPrintIL' sts
207262 ]
208− match (IfElse _ (Binary _ EqualTo cond (BooleanLiteral Nothing True)) thens elses) = mconcat <$> sequence
209− [ return $ emit "if ("
210− , return $ emit $ unbox' "bool" cond
211− , return $ emit ") "
212− , prettyPrintIL' thens
213− , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
214− ]
215− match (IfElse _ (Binary _ EqualTo cond (BooleanLiteral Nothing False)) thens elses) = mconcat <$> sequence
216− [ return $ emit "if (!("
217− , return $ emit $ unbox' "bool" cond
218− , return $ emit ")) "
219− , prettyPrintIL' thens
220− , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
221− ]
222− match (IfElse _ (Binary _ EqualTo x y@(NumericLiteral _ n)) thens elses) = mconcat <$> sequence
223− [ return $ emit "if ("
224− , return $ emit $ unbox' t x
225− , return $ emit $ " == "
226− , prettyPrintIL' y
227− , return $ emit ") "
263+ match (IfElse _ (Binary _ EqualTo cond@Binary{} (BooleanLiteral Nothing True)) thens elses) = mconcat <$> sequence
264+ [ return $ emit "if "
265+ , prettyPrintIL' cond
266+ , return $ emit " "
228267 , prettyPrintIL' thens
229268 , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
230269 ]
231− where
232− t | Left _ <- n = int
233− | Right _ <- n = float
234− match (IfElse _ (Binary _ EqualTo a b@StringLiteral{}) thens elses) = mconcat <$> sequence
235− [ return $ emit "if ("
236− , return $ emit $ unbox' string a
237− , return $ emit $ " == "
238− , prettyPrintIL' b
270+ match (IfElse _ (Binary _ EqualTo cond@Binary{} (BooleanLiteral Nothing False)) thens elses) = mconcat <$> sequence
271+ [ return $ emit "if !("
272+ , prettyPrintIL' cond
239273 , return $ emit ") "
240274 , prettyPrintIL' thens
241275 , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
242276 ]
243277 match (IfElse _ cond thens elses) = mconcat <$> sequence
244− [ return $ emit "if ("
278+ [ return $ emit "if "
245279 , prettyPrintIL' cond
246− , return $ emit ") "
280+ , return $ emit " "
247281 , prettyPrintIL' thens
248282 , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
249283 ]
@@ -251,11 +285,10 @@ literals = mkPattern' match'
251285 [ return $ emit "return "
252286 , prettyPrintIL' value
253287 ]
254− match (ReturnNoResult _) = return $ emit "return undefined"
288+ match (ReturnNoResult _) = return . emit $ "return " <> undefinedName
255289 -- match (Throw _ _) = return mempty
256290 match (Throw _ value) = mconcat <$> sequence
257− [ return $ emit "THROW_("
258− , return $ emit "\"PatternMatchFailure: \""
291+ [ return $ emit "panic("
259292 , prettyPrintIL' value
260293 , return $ emit ")"
261294 ]
@@ -295,7 +328,7 @@ literals = mkPattern' match'
295328 Nothing -> ""
296329
297330unary' :: (Emit gen) => UnaryOperator -> (AST -> Text) -> Operator PrinterState AST gen
298−unary' op mkStr = Wrap match (const)
331+unary' op mkStr = Wrap match (<>)
299332 where
300333 match :: (Emit gen) => Pattern PrinterState AST (gen, AST)
301334 match = mkPattern match'
@@ -304,7 +337,7 @@ unary' op mkStr = Wrap match (const)
304337 match' _ = Nothing
305338
306339unary :: (Emit gen) => UnaryOperator -> Text -> Operator PrinterState AST gen
307−unary op str = unary' op (\v -> str <> "(" <> prettyPrintIL1 v <> ")")
340+unary op str = unary' op (const str)
308341
309342negateOperator :: (Emit gen) => Operator PrinterState AST gen
310343negateOperator = unary' Negate (\v -> if isNegate v then "- " else "-")
@@ -330,11 +363,21 @@ isLiteral ObjectLiteral{} = True
330363isLiteral ArrayLiteral{} = True
331364isLiteral _ = False
332365
366+isComplexLiteral :: AST -> Bool
367+-- isComplexLiteral Function{} = True
368+isComplexLiteral ObjectLiteral{} = True
369+isComplexLiteral ArrayLiteral{} = True
370+isComplexLiteral _ = False
371+
372+unApp :: AST -> [AST] -> (AST, [AST])
373+unApp (App _ val [arg]) args = unApp val (arg : args)
374+unApp other args = (other, args)
375+
333376prettyStatements :: (Emit gen) => [AST] -> StateT PrinterState Maybe gen
334377prettyStatements sts = do
335378 ils <- forM sts prettyPrintIL'
336379 indentString <- currentIndent
337− return $ intercalate (emit "\n") $ map ((<> emit ";") . (indentString <>)) ils
380+ return $ intercalate (emit "\n") $ map (indentString <>) ils
338381
339382-- | Generate a pretty-printed string representing a collection of C++ expressions at the same indentation level
340383prettyPrintILWithSourceMaps :: [AST] -> (Text, [SMap])
@@ -353,7 +396,7 @@ prettyPrintIL' = A.runKleisli $ runPattern matchValue
353396 matchValue = buildPrettyPrinter operators (literals <+> fmap parensPos matchValue)
354397 operators :: (Emit gen) => OperatorTable PrinterState AST gen
355398 operators =
356− OperatorTable [ [ unary New "box" ]
399+ OperatorTable [ [ unary New "?" ]
357400 , [ unary Not "!"
358401 , unary BitwiseNot "~"
359402 , unary Positive "+"
@@ -364,8 +407,7 @@ prettyPrintIL' = A.runKleisli $ runPattern matchValue
364407 , [ binary Add "+"
365408 , binary Subtract "-" ]
366409 , [ binary ShiftLeft "<<"
367− , binary ShiftRight ">>"
368− , binary ZeroFillShiftRight ">>>" ]
410+ , binary ShiftRight ">>" ]
369411 , [ binary LessThan "<"
370412 , binary LessThanOrEqualTo "<="
371413 , binary GreaterThan ">"
@@ -383,15 +425,12 @@ prettyPrintIL1 :: AST -> Text
383425prettyPrintIL1 = maybe (internalError "Incomplete pattern") runPlainString . flip evalStateT (PrinterState 0) . prettyPrintIL'
384426
385427stringLiteral :: PSString -> Text
386−stringLiteral pss | Just s <- decodeString pss =
387− (if T.all isAscii s
388− then ""
389− else ("u8")) <> stringLiteral' s
428+stringLiteral pss | Just s <- decodeString pss = stringLiteral' s
390429 where
391430 stringLiteral' :: Text -> Text
392431 stringLiteral' s = "\"" <> T.concatMap encodeChar s <> "\""
393432 encodeChar :: Char -> Text
394− encodeChar '\0' = "\\0"
433+ encodeChar '\0' = "\\x00"
395434 encodeChar '\b' = "\\b"
396435 encodeChar '\t' = "\\t"
397436 encodeChar '\n' = "\\n"
@@ -403,62 +442,29 @@ stringLiteral pss | Just s <- decodeString pss =
403442 encodeChar c = T.singleton $ c
404443stringLiteral _ = "\"\\uFFFD\""
405444
406−unbox' :: Text -> AST -> Text
407−unbox' _ v@(NumericLiteral{}) = prettyPrintIL1 v
408−unbox' _ v@(BooleanLiteral{}) = prettyPrintIL1 v
409−unbox' _ v@(StringLiteral{}) = prettyPrintIL1 v
410−unbox' t v = unbox t <> "(" <> prettyPrintIL1 v <> ")"
411−
412−unboxType :: Text -> Maybe Text
413−unboxType t
414− | t == C.eqInt ||
415− t == C.semiringInt ||
416− t == C.ringInt
417− = Just int
418− | t == C.semiringNumber ||
419− t == C.ringNumber ||
420− t == C.euclideanRingNumber
421− = Just float
422− | t == C.heytingAlgebraBoolean
423− = Just bool
424− | otherwise = Nothing
425−
426−renderOp :: Text -> Maybe Text
427−renderOp op
428− | op == C.eq = Just " == "
429− | op == C.notEq = Just " != "
430− | op == C.add = Just " + "
431− | op == C.sub = Just " - "
432− | op == C.mul = Just " * "
433− | op == C.div = Just " / "
434− | op == C.conj = Just " && "
435− | op == C.disj = Just "|| "
436− | otherwise = Nothing
437−
438445interfaceSource :: Text -> [(Text,Bool)] -> [Ident] -> Text
439−interfaceSource mn values foreigns =
440− let foreigns' = identToIL <$> foreigns
441− valueNames = fst <$> values
442− values' = filter ((`notElem` foreigns') . fst) values ++
443− zip (foreigns' \\ valueNames) (repeat True)
444− in
445− "// Generated by psil compiler\n\n" <>
446− "#ifndef " <> mn <> "_H\n" <>
447− "#define " <> mn <> "_H\n\n" <>
448− "#include \"purescript.h\"\n\n" <>
449− "namespace " <> mn <> " {\n\n" <>
450− "using namespace purescript;\n\n" <>
451− (T.concat $ (\(export, static) ->
452− let rty = if static then "const boxed&" else "boxed" in
453− "auto " <> export <> "() -> " <> rty <> ";\n") <$> values') <> "\n" <>
454− "} // end namespace " <> mn <> "\n\n" <>
455− "#endif // " <> mn <> "_H\n\n"
446+interfaceSource _ _ _ = ""
456447
457448implHeaderSource :: Text -> [Text] -> Text -> Text
458−implHeaderSource mn imports interfaceImport =
459− T.concat imports <> "\n"<>
460− interfaceImport <> "\n\n" <>
461− "namespace " <> mn <> " {\n\n"
449+implHeaderSource mn imports otherPrefix =
450+ "// Code generated by psgo. DO NOT EDIT.\n\n" <>
451+ "package " <> (if mn == "Main" || mn == "Test_Main" then "main" else mn) <> "\n\n" <>
452+ "import . \"" <> runtime <> "\"\n" <>
453+ (if mn == "Main" || mn == "Test_Main"
454+ then "import _ \"" <> otherPrefix <> "/" <> ffiLoader <> "\"\n"
455+ else "\n") <>
456+ "import (\n" <>
457+ (T.concat $ formatImport <$> imports) <> ")\n\n" <>
458+ "type _ = Any\n\n"
459+ where
460+ formatImport :: Text -> Text
461+ formatImport s =
462+ "\t\"" <> otherPrefix <> "/" <> modPrefix <> "/" <> moduleRenamer s <> "\"\n"
463+ moduleRenamer :: Text -> Text
464+ moduleRenamer s
465+ | (s', sfx) <- T.breakOn moduleRenamerMarker s,
466+ not $ T.null sfx = s'
467+ moduleRenamer s = s
462468
463469implFooterSource :: Text -> [Ident] -> Text
464470implFooterSource mn foreigns =
@@ -466,50 +472,56 @@ implFooterSource mn foreigns =
466472 (if null foreigns
467473 then ""
468474 else ("// Foreign values\n\n" <>
469− "DEFINE_FOREIGN_DICTIONARY_AND_ACCESSOR()\n\n" <>
470− (T.concat $ (\foreign' -> "auto " <>
471− identToIL foreign' <>
472− "() -> const boxed& { " <>
473− staticValueBegin <>
474− foreignDict <> "().at(" <>
475− (stringLiteral . mkString $ runIdent foreign') <> "); " <>
476− staticValueEnd <>
477− " };\n") <$> foreigns) <>
478− "\n")) <>
479− "} // end namespace " <> mn <>
480− "\n\n" <>
481− if mn == "Main" then mainSource else "\n"
475+ "var " <> foreignDict <> " = "<> foreignMod <> "(\"" <> mn <> "\")\n\n" <>
476+ (T.concat $ (\foreign' ->
477+ let name = moduleIdentToIL foreign' in
478+ varDecl <> " " <> initName name <> " Once\n" <>
479+ varDecl <> " " <> valueName name <> " " <> anyType <> "\n\n" <>
480+ "func " <>
481+ withPrefix name <>
482+ "() Any { \n" <>
483+ " " <> initName name <> ".Do(func() {\n" <>
484+ " " <> valueName name <> " = " <>
485+ "Get(" <> foreignDict <> ", " <>
486+ (stringLiteral . mkString $ runIdent foreign') <> ")\n" <>
487+ " })\n" <>
488+ " return " <> valueName name <> "\n" <>
489+ "}\n\n") <$> foreigns))) <>
490+ if mn == "Main" || mn == "Test.Main" then mainSource else "\n"
482491 where
483492 mainSource :: Text
484493 mainSource = "\
485− \int main(int argc, const char * argv[]) {\n\
486− \ Main::main()();\n\
487− \ return 0;\n\
494+ \func main() {\n\
495+ \ Run(Ꞌmain())\n\
488496 \}\n\n\
489497 \"
490498
491499varDecl :: Text
492−varDecl = "const boxed"
493−
494−varRefDecl :: Text
495−varRefDecl = varDecl <> "&"
496−
497−renderArg' :: Text -> Text -> Text
498−renderArg' decl arg
499− | arg == unusedName = decl
500− | otherwise = decl <> " " <> arg
500+varDecl = "var"
501501
502−renderArg :: Text -> Text
503−renderArg = renderArg' varRefDecl
502+renderArg :: Text -> Text -> Text
503+renderArg decl arg = arg <> " " <> decl
504504
505−renderArgByVal :: Text -> Text
506−renderArgByVal = renderArg' varDecl
505+foreignMod :: Text
506+foreignMod = "Foreign"
507507
508508foreignDict :: Text
509509foreignDict = "foreign"
510510
511−staticValueBegin :: Text
512−staticValueBegin = "static const boxed _ = "
511+modLabel :: Text
512+modLabel = "purescript-native"
513+
514+modPrefix :: Text
515+modPrefix = modLabel <> "/output"
516+
517+runtime :: Text
518+runtime = "github.com/" <> modLabel <> "/go-runtime"
519+
520+ffiLoader :: Text
521+ffiLoader = modLabel <> "/ffi-loader"
522+
523+initName :: Text -> Text
524+initName s = "ᛌ" <> s <> "_once"
513525
514−staticValueEnd :: Text
515−staticValueEnd = "return _;"
526+valueName :: Text -> Text
527+valueName s = "ᛧ" <> s