@@ -7,6 +7,9 @@ module CodeGen.IL.Printer
7 , implHeaderSource
7 , implHeaderSource
8 , implFooterSource
8 , implFooterSource
9 , isLiteral
9 , isLiteral
12import Prelude.Compat
15import Prelude.Compat
@@ -15,7 +18,6 @@ import Control.Arrow ((<+>))
15import Control.Monad (forM, mzero)
18import Control.Monad (forM, mzero)
16import Control.Monad.State (StateT, evalStateT)
19import Control.Monad.State (StateT, evalStateT)
17import Control.PatternArrows
20import Control.PatternArrows
18−import Data.Char (isAscii)
19import Data.List (filter, (\\))
21import Data.List (filter, (\\))
20import qualified Control.Arrow as A
22import qualified Control.Arrow as A
@@ -31,7 +33,9 @@ import Language.PureScript.Crash
31import Language.PureScript.Names (Ident, runIdent)
33import Language.PureScript.Names (Ident, runIdent)
32import Language.PureScript.Pretty.Common
34import Language.PureScript.Pretty.Common
33import Language.PureScript.PSString (PSString, decodeString, mkString)
35import Language.PureScript.PSString (PSString, decodeString, mkString)
34import CodeGen.IL.Common
37import CodeGen.IL.Common
38+import CodeGen.IL.Optimizer.TCO (tcoLoop)
36import qualified Language.PureScript.Constants as C
40import qualified Language.PureScript.Constants as C
@@ -49,26 +53,23 @@ literals = mkPattern' match'
49 match (BooleanLiteral _ True) = return $ emit "true"
53 match (BooleanLiteral _ True) = return $ emit "true"
50 match (BooleanLiteral _ False) = return $ emit "false"
54 match (BooleanLiteral _ False) = return $ emit "false"
51 match (ArrayLiteral _ xs) = mconcat <$> sequence
55 match (ArrayLiteral _ xs) = mconcat <$> sequence
52− [ return . emit $ arrayType <> "{ "
56+ [ return . emit $ arrayType <> "{"
53 , intercalate (emit ", ") <$> forM xs prettyPrintIL'
57 , intercalate (emit ", ") <$> forM xs prettyPrintIL'
54− , return $ emit " }"
58+ , return $ emit "}"
56 -- match (ObjectLiteral _ []) = return $ emit "std::initializer_list<std::pair<const string, boxed>>{}"
60 -- match (ObjectLiteral _ []) = return $ emit "std::initializer_list<std::pair<const string, boxed>>{}"
57 match (ObjectLiteral _ ps) = mconcat <$> sequence
61 match (ObjectLiteral _ ps) = mconcat <$> sequence
58− [ return . emit $ dictType <> "{\n"
62+ [ return . emit $ dictType <> "{"
59 , withIndent $ do
63 , withIndent $ do
60 ils <- forM ps $ \(key, value) -> do
64 ils <- forM ps $ \(key, value) -> do
61 value' <- prettyPrintIL' value
65 value' <- prettyPrintIL' value
62− return $ emit "{ " <> objectPropertyToString key <> value' <> emit " }"
66+ return $ objectPropertyToString key <> value'
63− indentString <- currentIndent
64− return $ intercalate (emit ",\n") $ map (indentString <>) ils
67+ return $ intercalate (emit " ") $ map (<> emit ",") ils
67 , return $ emit "}"
68 , return $ emit "}"
70 objectPropertyToString :: (Emit gen) => PSString -> gen
71 objectPropertyToString :: (Emit gen) => PSString -> gen
71− objectPropertyToString s = emit $ stringLiteral s <> ", "
72+ objectPropertyToString s = emit $ stringLiteral s <> ": "
72 match (Block _ sts) = mconcat <$> sequence
73 match (Block _ sts) = mconcat <$> sequence
73 [ return $ emit "{\n"
74 [ return $ emit "{\n"
74 , withIndent $ prettyStatements sts
75 , withIndent $ prettyStatements sts
@@ -76,9 +77,10 @@ literals = mkPattern' match'
76 , currentIndent
77 , currentIndent
77 , return $ emit "}"
78 , return $ emit "}"
80+ match (Var _ ident) | ident == C.undefined = return $ emit undefinedName
79 match (Var _ ident) = return $ emit ident
81 match (Var _ ident) = return $ emit ident
80 match (VariableIntroduction _ ident value) = mconcat <$> sequence
82 match (VariableIntroduction _ ident value) = mconcat <$> sequence
81− [ return $ emit $ "boxed " <> ident
83+ [ return . emit $ varDecl <> " " <> ident <> " " <> anyType
82 , maybe (return mempty) (fmap (emit " = " <>) . prettyPrintIL') value
84 , maybe (return mempty) (fmap (emit " = " <>) . prettyPrintIL') value
84 match (Assignment _ target value) = mconcat <$> sequence
86 match (Assignment _ target value) = mconcat <$> sequence
@@ -87,163 +89,195 @@ literals = mkPattern' match'
87 , prettyPrintIL' value
89 , prettyPrintIL' value
89 match (App _ val []) = mconcat <$> sequence
91 match (App _ val []) = mconcat <$> sequence
92+ [ return $ emit "Run("
90− [ prettyPrintIL' val
93+ , prettyPrintIL' val
91− , return $ emit "()"
94+ , return $ emit ")"
93− match (App ss (App _ (App _ (Indexer _ (Var _ fn) (Var _ fnMod)) [Indexer _ (Var _ dict) (Var _ dictMod)]) [x]) [y])
96+ match (App _ (StringLiteral _ u) [arg])
94− | fnMod == dictMod
97+ | Just ty <- decodeString u = mconcat <$> sequence
95− , dictMod == C.dataEq || dictMod == C.dataSemiring || dictMod == C.dataRing ||
98+ [ prettyPrintIL' arg
96− dictMod == C.dataEuclideanRing || dictMod == C.dataHeytingAlgebra
99+ , return $ emit ".("
97− , Just op <- renderOp fn
100+ , return $ emit ty
98− , Just t <- unboxType dict
101+ , return $ emit ")"
103+ match (App _ (Var _ fn) [arg]) | fn == arrayLengthFn = mconcat <$> sequence
106+ , prettyPrintIL' arg
109+ match (App _ (Var _ fn) args) | fn == indexFn = mconcat <$> sequence
112+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
115+ match (App _ (Var _ fn) args) | fn == tcoLoop = mconcat <$> sequence
118+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
121+ match (App _ (App Nothing (StringLiteral Nothing fnx) [fn@Function{}]) args)
122+ | Just ftype <- decodeString fnx
99− = mconcat <$> sequence
123+ , "Fn" `T.isPrefixOf` ftype = mconcat <$> sequence
100− [ return $ emit $ unbox' t x
125+ , return $ emit "("
101− , return $ emit op
126+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
102− , return $ emit $ unbox' t y
127+ , return $ emit ")"
104− match (App _ (App _ (Indexer _ (Var _ fn) (Var _ fnMod)) [Indexer _ (Var _ dict) (Var _ dictMod)]) [n])
129+ match (App _ (App Nothing (StringLiteral Nothing fnx) [fn]) args)
105− | fnMod == dictMod
130+ | Just ftype <- decodeString fnx
106− , dictMod == C.dataRing
108− , Just t <- unboxType dict
109− = mconcat <$> sequence
131+ , "Fn" `T.isPrefixOf` ftype = mconcat <$> sequence
110− [ return $ emit "-"
133+ , return $ emit ".("
111− , return $ emit $ unbox' t n
134+ , return $ emit ftype
112− ]
135+ , return $ emit ")("
113− match (App _ (App _ (Indexer _ (Var _ fn) (Var _ fnMod)) [Indexer _ (Var _ dict) (Var _ dictMod)]) [n])
136+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
114− | fnMod == dictMod
137+ , return $ emit ")"
115− , dictMod == C.dataHeytingAlgebra
138+ ]
116− , fn == properToIL C.not
139+ match app@(App{})
117− , Just t <- unboxType dict
140+ | (val, args) <- unApp app []
118 = mconcat <$> sequence
142 = mconcat <$> sequence
119− [ return $ emit "!"
143+ [ return $ emit "Apply("
144+ , prettyPrintIL' val
120− , return $ emit $ unbox' t n
145+ , return $ emit ", "
146+ , intercalate (emit ", ") <$> forM args prettyPrintIL'
122 match (App _ val args) = mconcat <$> sequence
149 match (App _ val args) = mconcat <$> sequence
150+ [ return $ emit "Apply("
123− [ prettyPrintIL' val
151+ , prettyPrintIL' val
124− , return $ emit "("
152+ , return $ emit ", "
125 , intercalate (emit ", ") <$> forM args prettyPrintIL'
153 , intercalate (emit ", ") <$> forM args prettyPrintIL'
126 , return $ emit ")"
154 , return $ emit ")"
128 match (Function _ (Just name) [] (Block _ [Return _ ret]))
156 match (Function _ (Just name) [] (Block _ [Return _ ret]))
129− | isLiteral ret = mconcat <$> sequence
157+ | isComplexLiteral ret = mconcat <$> sequence
130− [ return $ emit "auto "
158+ [ return $ emit "\n"
159+ , return . emit $ varDecl <> " " <> initName name <> " Once\n"
160+ , prettyPrintIL' $ VariableIntroduction Nothing (valueName name) Nothing
161+ , return $ emit "\n\n"
131− , return $ emit name
162+ , return $ emit "func "
163+ , return . emit $ withPrefix name
132− , return $ emit "() -> const boxed& "
164+ , return . emit $ "() " <> anyType <> " "
133 , return $ emit "{\n"
165 , return $ emit "{\n"
134 , withIndent $ do
166 , withIndent $ do
135− indentString <- currentIndent
167+ indentString <- currentIndent
136− return $ indentString <> emit staticValueBegin
168+ return $ indentString <> (emit $ initName name <> ".Do(func() {\n") <>
169+ indentString <> indentString <> (emit $ valueName name <> " = ")
137 , withIndent $ do
170 , withIndent $ do
138 case ret of
171 case ret of
139 Function _ Nothing args body -> mconcat <$> sequence
172 Function _ Nothing args body -> mconcat <$> sequence
140− [ return $ emit "[]("
173+ [ return $ emit "func("
141− , return $ emit $ intercalate ", " (renderArg <$> args)
174+ , return . emit $ intercalate ", " (renderArg anyType <$> args)
142− , return $ emit ") -> boxed "
175+ , return . emit $ ") " <> anyType <> " "
143 , prettyPrintIL' body
176 , prettyPrintIL' body
146 prettyPrintIL' ret
179 prettyPrintIL' ret
147− , return $ emit ";\n"
180+ , return $ emit "\n"
148 , withIndent $ do
181 , withIndent $ do
149− indentString <- currentIndent
182+ indentString <- currentIndent
150− return $ indentString <> emit staticValueEnd
183+ return $ indentString <> (emit $ "})\n" <> "return " <> valueName name <>"\n")
151− , return $ emit "\n}"
184+ , return $ emit "}\n\n"
153 match (Function _ (Just name) [] ret) = mconcat <$> sequence
186 match (Function _ (Just name) [] ret) = mconcat <$> sequence
154− [ return $ emit "auto "
187+ [ return $ emit "func "
155− , return $ emit name
188+ , return . emit $ withPrefix name
156− , return $ emit "() -> boxed "
189+ , return . emit $ "() " <> anyType <> " "
157 , prettyPrintIL' ret
190 , prettyPrintIL' ret
159− match (Function _ name args ret) = mconcat <$> sequence
192+ match (Function _ _ args ret) = mconcat <$> sequence
160− [ return $ emit captures
193+ [ return $ emit "func("
162− , return $ emit $ intercalate ", " (render <$> args)
194+ , return . emit $ intercalate ", " (renderArg anyType <$> args)
163− , return $ emit ") -> boxed "
195+ , return . emit $ ") " <> anyType <> " "
164 , prettyPrintIL' ret
196 , prettyPrintIL' ret
166− where
198+ match (Indexer _ (Var _ name) (Var _ "")) = mconcat <$> sequence
167− (captures, render)
199+ [ prettyPrintIL' (Var Nothing $ withPrefix name)
168− | name == Just tcoLoop = ("[&]", renderArgByVal)
200+ , return $ emit "()"
169− | otherwise = ("[=]", renderArg)
201+ ]
170− match (Indexer _ prop@(Var _ name) val) = mconcat <$> sequence
202+ match (Indexer _ (Var _ name) val) = mconcat <$> sequence
171 [ prettyPrintIL' val
203 [ prettyPrintIL' val
172− , return $ emit "::"
204+ , return $ emit "."
173− , prettyPrintIL' prop
205+ , prettyPrintIL' (Var Nothing $ withPrefix name)
174 , return $ emit "()"
206 , return $ emit "()"
176− match (Indexer _ prop val) = mconcat <$> sequence
208+ match (Indexer _ prop@StringLiteral{} val@ObjectLiteral{}) = mconcat <$> sequence
177 [ prettyPrintIL' val
209 [ prettyPrintIL' val
178 , return $ emit "["
210 , return $ emit "["
179 , prettyPrintIL' prop
211 , prettyPrintIL' prop
180 , return $ emit "]"
212 , return $ emit "]"
214+ match (Indexer _ prop@StringLiteral{} val) = mconcat <$> sequence
215+ [ prettyPrintIL' val
216+ , return $ emit ".("
217+ , return $ emit dictType
218+ , return $ emit ")["
219+ , prettyPrintIL' prop
222+ match (Indexer _ index val@ArrayLiteral{}) = mconcat <$> sequence
223+ [ prettyPrintIL' val
225+ , prettyPrintIL' index
228+ match (Indexer _ index val) = mconcat <$> sequence
229+ [ prettyPrintIL' val
230+ , return $ emit ".("
231+ , return $ emit arrayType
232+ , return $ emit ")["
233+ , prettyPrintIL' index
182 match (InstanceOf _ val ty) = mconcat <$> sequence
236 match (InstanceOf _ val ty) = mconcat <$> sequence
183− [ return . emit $ unbox' dictType val
237+ [ return $ emit "Is("
238+ , prettyPrintIL' val
184− , return $ emit ".contains("
239+ , return $ emit ", "
185 , prettyPrintIL' ty
240 , prettyPrintIL' ty
186 , return $ emit ")"
241 , return $ emit ")"
188 match (While _ cond sts) = mconcat <$> sequence
243 match (While _ cond sts) = mconcat <$> sequence
189− [ return $ emit "while ("
244+ [ return $ emit "for "
190 , prettyPrintIL' cond
245 , prettyPrintIL' cond
191− , return $ emit ") "
246+ , return $ emit " "
192 , prettyPrintIL' sts
247 , prettyPrintIL' sts
194 match (For _ ident start end sts) = mconcat <$> sequence
249 match (For _ ident start end sts) = mconcat <$> sequence
195− [ return $ emit $ "for (boxed " <> ident <> " = "
250+ [ return $ emit $ "for var " <> ident <> " = "
196 , prettyPrintIL' start
251 , prettyPrintIL' start
197 , return $ emit $ "; " <> ident <> " < "
252 , return $ emit $ "; " <> ident <> " < "
198 , prettyPrintIL' end
253 , prettyPrintIL' end
199− , return $ emit $ "; " <> ident <> "++) "
254+ , return $ emit $ "; " <> ident <> "++ "
200 , prettyPrintIL' sts
255 , prettyPrintIL' sts
202 match (ForIn _ ident obj sts) = mconcat <$> sequence
257 match (ForIn _ ident obj sts) = mconcat <$> sequence
203− [ return $ emit $ "for (boxed " <> ident <> " in "
258+ [ return $ emit $ "for var " <> ident <> " in "
204 , prettyPrintIL' obj
259 , prettyPrintIL' obj
205− , return $ emit ") "
260+ , return $ emit " "
206 , prettyPrintIL' sts
261 , prettyPrintIL' sts
208− match (IfElse _ (Binary _ EqualTo cond (BooleanLiteral Nothing True)) thens elses) = mconcat <$> sequence
263+ match (IfElse _ (Binary _ EqualTo cond@Binary{} (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
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
222− match (IfElse _ (Binary _ EqualTo x y@(NumericLiteral _ n)) thens elses) = mconcat <$> sequence
223− [ return $ emit "if ("
264+ [ return $ emit "if "
224− , return $ emit $ unbox' t x
225− , return $ emit $ " == "
226− , prettyPrintIL' y
265+ , prettyPrintIL' cond
227− , return $ emit ") "
266+ , return $ emit " "
228 , prettyPrintIL' thens
267 , prettyPrintIL' thens
229 , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
268 , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
232− t | Left _ <- n = int
233− | Right _ <- n = float
234− match (IfElse _ (Binary _ EqualTo a b@StringLiteral{}) thens elses) = mconcat <$> sequence
270+ match (IfElse _ (Binary _ EqualTo cond@Binary{} (BooleanLiteral Nothing False)) thens elses) = mconcat <$> sequence
235− [ return $ emit "if ("
271+ [ return $ emit "if !("
236− , return $ emit $ unbox' string a
237− , return $ emit $ " == "
238− , prettyPrintIL' b
272+ , prettyPrintIL' cond
239 , return $ emit ") "
273 , return $ emit ") "
240 , prettyPrintIL' thens
274 , prettyPrintIL' thens
241 , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
275 , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
243 match (IfElse _ cond thens elses) = mconcat <$> sequence
277 match (IfElse _ cond thens elses) = mconcat <$> sequence
244− [ return $ emit "if ("
278+ [ return $ emit "if "
245 , prettyPrintIL' cond
279 , prettyPrintIL' cond
246− , return $ emit ") "
280+ , return $ emit " "
247 , prettyPrintIL' thens
281 , prettyPrintIL' thens
248 , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
282 , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
@@ -251,11 +285,10 @@ literals = mkPattern' match'
251 [ return $ emit "return "
285 [ return $ emit "return "
252 , prettyPrintIL' value
286 , prettyPrintIL' value
254− match (ReturnNoResult _) = return $ emit "return undefined"
288+ match (ReturnNoResult _) = return . emit $ "return " <> undefinedName
255 -- match (Throw _ _) = return mempty
289 -- match (Throw _ _) = return mempty
256 match (Throw _ value) = mconcat <$> sequence
290 match (Throw _ value) = mconcat <$> sequence
257− [ return $ emit "THROW_("
291+ [ return $ emit "panic("
258− , return $ emit "\"PatternMatchFailure: \""
259 , prettyPrintIL' value
292 , prettyPrintIL' value
260 , return $ emit ")"
293 , return $ emit ")"
@@ -295,7 +328,7 @@ literals = mkPattern' match'
295 Nothing -> ""
328 Nothing -> ""
297unary' :: (Emit gen) => UnaryOperator -> (AST -> Text) -> Operator PrinterState AST gen
330unary' :: (Emit gen) => UnaryOperator -> (AST -> Text) -> Operator PrinterState AST gen
298−unary' op mkStr = Wrap match (const)
331+unary' op mkStr = Wrap match (<>)
300 match :: (Emit gen) => Pattern PrinterState AST (gen, AST)
333 match :: (Emit gen) => Pattern PrinterState AST (gen, AST)
301 match = mkPattern match'
334 match = mkPattern match'
@@ -304,7 +337,7 @@ unary' op mkStr = Wrap match (const)
304 match' _ = Nothing
337 match' _ = Nothing
306unary :: (Emit gen) => UnaryOperator -> Text -> Operator PrinterState AST gen
339unary :: (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)
309negateOperator :: (Emit gen) => Operator PrinterState AST gen
342negateOperator :: (Emit gen) => Operator PrinterState AST gen
310negateOperator = unary' Negate (\v -> if isNegate v then "- " else "-")
343negateOperator = unary' Negate (\v -> if isNegate v then "- " else "-")
@@ -330,11 +363,21 @@ isLiteral ObjectLiteral{} = True
330isLiteral ArrayLiteral{} = True
363isLiteral ArrayLiteral{} = True
331isLiteral _ = False
364isLiteral _ = False
366+isComplexLiteral :: AST -> Bool
367+-- isComplexLiteral Function{} = True
368+isComplexLiteral ObjectLiteral{} = True
369+isComplexLiteral ArrayLiteral{} = True
370+isComplexLiteral _ = False
372+unApp :: AST -> [AST] -> (AST, [AST])
373+unApp (App _ val [arg]) args = unApp val (arg : args)
374+unApp other args = (other, args)
333prettyStatements :: (Emit gen) => [AST] -> StateT PrinterState Maybe gen
376prettyStatements :: (Emit gen) => [AST] -> StateT PrinterState Maybe gen
334prettyStatements sts = do
377prettyStatements sts = do
335 ils <- forM sts prettyPrintIL'
378 ils <- forM sts prettyPrintIL'
336 indentString <- currentIndent
379 indentString <- currentIndent
337− return $ intercalate (emit "\n") $ map ((<> emit ";") . (indentString <>)) ils
380+ return $ intercalate (emit "\n") $ map (indentString <>) ils
339-- | Generate a pretty-printed string representing a collection of C++ expressions at the same indentation level
382-- | Generate a pretty-printed string representing a collection of C++ expressions at the same indentation level
340prettyPrintILWithSourceMaps :: [AST] -> (Text, [SMap])
383prettyPrintILWithSourceMaps :: [AST] -> (Text, [SMap])
@@ -353,7 +396,7 @@ prettyPrintIL' = A.runKleisli $ runPattern matchValue
353 matchValue = buildPrettyPrinter operators (literals <+> fmap parensPos matchValue)
396 matchValue = buildPrettyPrinter operators (literals <+> fmap parensPos matchValue)
354 operators :: (Emit gen) => OperatorTable PrinterState AST gen
397 operators :: (Emit gen) => OperatorTable PrinterState AST gen
355 operators =
398 operators =
356− OperatorTable [ [ unary New "box" ]
399+ OperatorTable [ [ unary New "?" ]
357 , [ unary Not "!"
400 , [ unary Not "!"
358 , unary BitwiseNot "~"
401 , unary BitwiseNot "~"
359 , unary Positive "+"
402 , unary Positive "+"
@@ -364,8 +407,7 @@ prettyPrintIL' = A.runKleisli $ runPattern matchValue
364 , [ binary Add "+"
407 , [ binary Add "+"
365 , binary Subtract "-" ]
408 , binary Subtract "-" ]
366 , [ binary ShiftLeft "<<"
409 , [ binary ShiftLeft "<<"
367− , binary ShiftRight ">>"
410+ , binary ShiftRight ">>" ]
368− , binary ZeroFillShiftRight ">>>" ]
369 , [ binary LessThan "<"
411 , [ binary LessThan "<"
370 , binary LessThanOrEqualTo "<="
412 , binary LessThanOrEqualTo "<="
371 , binary GreaterThan ">"
413 , binary GreaterThan ">"
@@ -383,15 +425,12 @@ prettyPrintIL1 :: AST -> Text
383prettyPrintIL1 = maybe (internalError "Incomplete pattern") runPlainString . flip evalStateT (PrinterState 0) . prettyPrintIL'
425prettyPrintIL1 = maybe (internalError "Incomplete pattern") runPlainString . flip evalStateT (PrinterState 0) . prettyPrintIL'
385stringLiteral :: PSString -> Text
427stringLiteral :: PSString -> Text
386−stringLiteral pss | Just s <- decodeString pss =
428+stringLiteral pss | Just s <- decodeString pss = stringLiteral' s
389− else ("u8")) <> stringLiteral' s
391 stringLiteral' :: Text -> Text
430 stringLiteral' :: Text -> Text
392 stringLiteral' s = "\"" <> T.concatMap encodeChar s <> "\""
431 stringLiteral' s = "\"" <> T.concatMap encodeChar s <> "\""
393 encodeChar :: Char -> Text
432 encodeChar :: Char -> Text
394− encodeChar '\0' = "\\0"
433+ encodeChar '\0' = "\\x00"
395 encodeChar '\b' = "\\b"
434 encodeChar '\b' = "\\b"
396 encodeChar '\t' = "\\t"
435 encodeChar '\t' = "\\t"
397 encodeChar '\n' = "\\n"
436 encodeChar '\n' = "\\n"
@@ -403,62 +442,29 @@ stringLiteral pss | Just s <- decodeString pss =
403 encodeChar c = T.singleton $ c
442 encodeChar c = T.singleton $ c
404stringLiteral _ = "\"\\uFFFD\""
443stringLiteral _ = "\"\\uFFFD\""
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 <> ")"
412−unboxType :: Text -> Maybe Text
415− t == C.semiringInt ||
418− | t == C.semiringNumber ||
419− t == C.ringNumber ||
420− t == C.euclideanRingNumber
422− | t == C.heytingAlgebraBoolean
424− | otherwise = Nothing
426−renderOp :: Text -> Maybe Text
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
438interfaceSource :: Text -> [(Text,Bool)] -> [Ident] -> Text
445interfaceSource :: Text -> [(Text,Bool)] -> [Ident] -> Text
439−interfaceSource mn values foreigns =
446+interfaceSource _ _ _ = ""
440− let foreigns' = identToIL <$> foreigns
441− valueNames = fst <$> values
442− values' = filter ((`notElem` foreigns') . fst) values ++
443− zip (foreigns' \\ valueNames) (repeat True)
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"
457implHeaderSource :: Text -> [Text] -> Text -> Text
448implHeaderSource :: Text -> [Text] -> Text -> Text
458−implHeaderSource mn imports interfaceImport =
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"
459− T.concat imports <> "\n"<>
457+ (T.concat $ formatImport <$> imports) <> ")\n\n" <>
460− interfaceImport <> "\n\n" <>
458+ "type _ = Any\n\n"
461− "namespace " <> mn <> " {\n\n"
459+ where
460+ formatImport :: Text -> Text
462+ "\t\"" <> otherPrefix <> "/" <> modPrefix <> "/" <> moduleRenamer s <> "\"\n"
463+ moduleRenamer :: Text -> Text
465+ | (s', sfx) <- T.breakOn moduleRenamerMarker s,
466+ not $ T.null sfx = s'
463implFooterSource :: Text -> [Ident] -> Text
469implFooterSource :: Text -> [Ident] -> Text
464implFooterSource mn foreigns =
470implFooterSource mn foreigns =
@@ -466,50 +472,56 @@ implFooterSource mn foreigns =
466 (if null foreigns
472 (if null foreigns
468 else ("// Foreign values\n\n" <>
474 else ("// Foreign values\n\n" <>
469− "DEFINE_FOREIGN_DICTIONARY_AND_ACCESSOR()\n\n" <>
475+ "var " <> foreignDict <> " = "<> foreignMod <> "(\"" <> mn <> "\")\n\n" <>
470− (T.concat $ (\foreign' -> "auto " <>
476+ (T.concat $ (\foreign' ->
471− identToIL foreign' <>
477+ let name = moduleIdentToIL foreign' in
472− "() -> const boxed& { " <>
478+ varDecl <> " " <> initName name <> " Once\n" <>
473− staticValueBegin <>
479+ varDecl <> " " <> valueName name <> " " <> anyType <> "\n\n" <>
474− foreignDict <> "().at(" <>
480+ "func " <>
483+ " " <> initName name <> ".Do(func() {\n" <>
484+ " " <> valueName name <> " = " <>
485+ "Get(" <> foreignDict <> ", " <>
475− (stringLiteral . mkString $ runIdent foreign') <> "); " <>
486+ (stringLiteral . mkString $ runIdent foreign') <> ")\n" <>
476− staticValueEnd <>
487+ " })\n" <>
488+ " return " <> valueName name <> "\n" <>
477− " };\n") <$> foreigns) <>
489+ "}\n\n") <$> foreigns))) <>
479− "} // end namespace " <> mn <>
481− if mn == "Main" then mainSource else "\n"
490+ if mn == "Main" || mn == "Test.Main" then mainSource else "\n"
483 mainSource :: Text
492 mainSource :: Text
484 mainSource = "\
493 mainSource = "\
485− \int main(int argc, const char * argv[]) {\n\
494+ \func main() {\n\
486− \ Main::main()();\n\
495+ \ Run(Ꞌmain())\n\
491varDecl :: Text
499varDecl :: Text
492−varDecl = "const boxed"
500+varDecl = "var"
495−varRefDecl = varDecl <> "&"
497−renderArg' :: Text -> Text -> Text
499− | arg == unusedName = decl
500− | otherwise = decl <> " " <> arg
502−renderArg :: Text -> Text
502+renderArg :: Text -> Text -> Text
503−renderArg = renderArg' varRefDecl
503+renderArg decl arg = arg <> " " <> decl
505−renderArgByVal :: Text -> Text
505+foreignMod :: Text
506−renderArgByVal = renderArg' varDecl
506+foreignMod = "Foreign"
508foreignDict :: Text
508foreignDict :: Text
509foreignDict = "foreign"
509foreignDict = "foreign"
511−staticValueBegin :: Text
511+modLabel :: Text
512−staticValueBegin = "static const boxed _ = "
512+modLabel = "purescript-native"
515+modPrefix = modLabel <> "/output"
518+runtime = "github.com/" <> modLabel <> "/go-runtime"
521+ffiLoader = modLabel <> "/ffi-loader"
523+initName :: Text -> Text
524+initName s = "ᛌ" <> s <> "_once"
514−staticValueEnd :: Text
526+valueName :: Text -> Text
515−staticValueEnd = "return _;"
527+valueName s = "ᛧ" <> s