@@ -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
@@ -30,7 +33,9 @@ import Language.PureScript.Crash
3033import Language.PureScript.Names (Ident, runIdent)
3134import Language.PureScript.Pretty.Common
3235import Language.PureScript.PSString (PSString, decodeString, mkString)
36+
3337import CodeGen.IL.Common
38+import CodeGen.IL.Optimizer.TCO (tcoLoop)
3439
3540import qualified Language.PureScript.Constants as C
3641
@@ -72,6 +77,7 @@ literals = mkPattern' match'
7277 , currentIndent
7378 , return $ emit "}"
7479 ]
80+ match (Var _ ident) | ident == C.undefined = return $ emit undefinedName
7581 match (Var _ ident) = return $ emit ident
7682 match (VariableIntroduction _ ident value) = mconcat <$> sequence
7783 [ return . emit $ varDecl <> " " <> ident <> " " <> anyType
@@ -94,70 +100,42 @@ literals = mkPattern' match'
94100 , return $ emit ty
95101 , return $ emit ")"
96102 ]
97− -- match (App _ (StringLiteral _ u) [arg@Var{}])
98− -- | Just ty <- decodeString u = mconcat <$> sequence
99− -- [ prettyPrintIL' arg
100− -- , return $ emit ".("
101− -- , return $ emit ty
102− -- , return $ emit ")"
103− -- ]
104− -- match (App _ (StringLiteral _ u) [arg])
105− -- | Just ty <- decodeString u = mconcat <$> sequence
106− -- [ return $ emit "("
107− -- , prettyPrintIL' arg
108− -- , return $ emit ")"
109− -- , return $ emit ".("
110− -- , return $ emit ty
111− -- , return $ emit ")"
112− -- ]
113103 match (App _ (Var _ fn) [arg]) | fn == arrayLengthFn = mconcat <$> sequence
114− [ return $ emit arrayLengthFn
104+ [ return $ emit fn
115105 , return $ emit "("
116106 , prettyPrintIL' arg
117107 , return $ emit ")"
118108 ]
119− -- match (App _ (App _ (App _ (Indexer _ (Var _ fn) (Var _ fnMod)) [Indexer _ (Var _ dict) (Var _ dictMod)]) [x]) [y])
120− -- | fnMod == dictMod
121− -- , dictMod == C.dataEq || dictMod == C.dataOrd
122− -- , Just op <- renderOp fn
123− -- , Just t <- unboxType dict
124− -- = mconcat <$> sequence
125− -- [ return $ emit $ unbox' t x
126− -- , return $ emit op
127− -- , return $ emit $ unbox' t y
128− -- ]
129− -- match (App _ (App _ (App _ (Indexer _ (Var _ fn) (Var _ fnMod)) [Indexer _ (Var _ dict) (Var _ dictMod)]) [x]) [y])
130− -- | not (isLiteral x) && not (isLiteral y)
131− -- , fnMod == dictMod
132− -- , dictMod == C.dataSemiring || dictMod == C.dataRing ||
133− -- dictMod == C.dataEuclideanRing || dictMod == C.dataHeytingAlgebra
134− -- , Just op <- renderOp fn
135− -- , Just t <- unboxType dict
136− -- = mconcat <$> sequence
137− -- [ return $ emit $ unbox' t x
138− -- , return $ emit op
139− -- , return $ emit $ unbox' t y
140− -- ]
141− -- match (App _ (App _ (Indexer _ (Var _ fn) (Var _ fnMod)) [Indexer _ (Var _ dict) (Var _ dictMod)]) [n])
142− -- | fnMod == dictMod
143− -- , dictMod == C.dataRing
144− -- , fn == C.negate
145− -- , Just t <- unboxType dict
146− -- = mconcat <$> sequence
147− -- [ return $ emit "-("
148− -- , return $ emit $ unbox' t n
149− -- , return $ emit ")"
150− -- ]
151− -- match (App _ (App _ (Indexer _ (Var _ fn) (Var _ fnMod)) [Indexer _ (Var _ dict) (Var _ dictMod)]) [n])
152− -- | fnMod == dictMod
153− -- , dictMod == C.dataHeytingAlgebra
154− -- , fn == properToIL C.not
155− -- , Just t <- unboxType dict
156− -- = mconcat <$> sequence
157− -- [ return $ emit "!("
158− -- , return $ emit $ unbox' t n
159− -- , return $ emit ")"
160− -- ]
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+ ]
161139 match app@(App{})
162140 | (val, args) <- unApp app []
163141 , length args > 1
@@ -227,15 +205,36 @@ literals = mkPattern' match'
227205 , prettyPrintIL' (Var Nothing $ withPrefix name)
228206 , return $ emit "()"
229207 ]
230− match (Indexer _ prop val) = mconcat <$> sequence
231− [ return $ emit "Get("
232− , prettyPrintIL' val
233− , return $ emit ", "
208+ match (Indexer _ prop@StringLiteral{} val@ObjectLiteral{}) = mconcat <$> sequence
209+ [ prettyPrintIL' val
210+ , return $ emit "["
234211 , prettyPrintIL' prop
235− , return $ emit ")"
212+ , return $ emit "]"
213+ ]
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 "]"
236235 ]
237236 match (InstanceOf _ val ty) = mconcat <$> sequence
238− [ return $ emit "Contains("
237+ [ return $ emit "Is("
239238 , prettyPrintIL' val
240239 , return $ emit ", "
241240 , prettyPrintIL' ty
@@ -275,55 +274,6 @@ literals = mkPattern' match'
275274 , prettyPrintIL' thens
276275 , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
277276 ]
278−
279−
280− -- match (IfElse _ (Binary _ EqualTo cond (BooleanLiteral Nothing True)) thens elses)
281− -- | (App _ (App _ (App _ (Indexer _ (Var _ _) (Var _ fnMod)) [Indexer _ (Var _ dict) (Var _ dictMod)]) [x]) [y]) <- cond
282− -- , fnMod == dictMod
283− -- , dictMod == C.dataEq || dictMod == C.dataOrd
284− -- , Just _ <- unboxTypeInt dict
285− -- = mconcat <$> sequence
286− -- [ return $ emit "if "
287− -- , prettyPrintIL' cond
288− -- , return $ emit " "
289− -- , prettyPrintIL' thens
290− -- , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
291− -- ]
292− -- match (IfElse _ (Binary _ EqualTo cond (BooleanLiteral Nothing True)) thens elses) = mconcat <$> sequence
293− -- [ return $ emit "if "
294− -- , prettyPrintIL' (tyAssert cond C.heytingAlgebraBoolean)
295− -- , return $ emit " "
296− -- , prettyPrintIL' thens
297− -- , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
298− -- ]
299− -- match (IfElse _ (Binary _ EqualTo cond (BooleanLiteral Nothing False)) thens elses) = mconcat <$> sequence
300− -- [ return $ emit "if !("
301− -- , prettyPrintIL' (tyAssert cond C.heytingAlgebraBoolean)
302− -- , return $ emit ") "
303− -- , prettyPrintIL' thens
304− -- , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
305− -- ]
306− -- match (IfElse _ (Binary _ EqualTo x y@(NumericLiteral _ n)) thens elses) = mconcat <$> sequence
307− -- [ return $ emit "if "
308− -- , return $ emit $ unbox' t x
309− -- , return $ emit $ " == "
310− -- , prettyPrintIL' y
311− -- , return $ emit " "
312− -- , prettyPrintIL' thens
313− -- , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
314− -- ]
315− -- where
316− -- t | Left _ <- n = int
317− -- | Right _ <- n = float
318− -- match (IfElse _ (Binary _ EqualTo a b@StringLiteral{}) thens elses) = mconcat <$> sequence
319− -- [ return $ emit "if "
320− -- , return $ emit $ unbox' string a
321− -- , return $ emit $ " == "
322− -- , prettyPrintIL' b
323− -- , return $ emit " "
324− -- , prettyPrintIL' thens
325− -- , maybe (return mempty) (fmap (emit " else " <>) . prettyPrintIL') elses
326− -- ]
327277 match (IfElse _ cond thens elses) = mconcat <$> sequence
328278 [ return $ emit "if "
329279 , prettyPrintIL' cond
@@ -339,8 +289,6 @@ literals = mkPattern' match'
339289 -- match (Throw _ _) = return mempty
340290 match (Throw _ value) = mconcat <$> sequence
341291 [ return $ emit "panic("
342− , return $ emit "\"PatternMatchFailure: \""
343− , return $ emit " + "
344292 , prettyPrintIL' value
345293 , return $ emit ")"
346294 ]
@@ -448,7 +396,7 @@ prettyPrintIL' = A.runKleisli $ runPattern matchValue
448396 matchValue = buildPrettyPrinter operators (literals <+> fmap parensPos matchValue)
449397 operators :: (Emit gen) => OperatorTable PrinterState AST gen
450398 operators =
451− OperatorTable [ [ unary New "box" ]
399+ OperatorTable [ [ unary New "?" ]
452400 , [ unary Not "!"
453401 , unary BitwiseNot "~"
454402 , unary Positive "+"
@@ -459,8 +407,7 @@ prettyPrintIL' = A.runKleisli $ runPattern matchValue
459407 , [ binary Add "+"
460408 , binary Subtract "-" ]
461409 , [ binary ShiftLeft "<<"
462− , binary ShiftRight ">>"
463− , binary ZeroFillShiftRight ">>>" ]
410+ , binary ShiftRight ">>" ]
464411 , [ binary LessThan "<"
465412 , binary LessThanOrEqualTo "<="
466413 , binary GreaterThan ">"
@@ -499,19 +446,25 @@ interfaceSource :: Text -> [(Text,Bool)] -> [Ident] -> Text
499446interfaceSource _ _ _ = ""
500447
501448implHeaderSource :: Text -> [Text] -> Text -> Text
502−implHeaderSource mn imports _ =
449+implHeaderSource mn imports otherPrefix =
503450 "// Code generated by psgo. DO NOT EDIT.\n\n" <>
504− "package " <> (if mn == "Main" then "main" else mn) <> "\n\n" <>
505− "import . \"purescript\"\n" <>
506− (if mn == "Main"
507− then "import \"ffi\"\n"
508− else "") <>
509− T.concat imports <> "\n" <>
510− "type IGNORE_UNUSED_IMPORTS = bool\n" <>
511− "type _ = IGNORE_UNUSED_RUNTIME\n" <>
512− (if mn == "Main"
513− then "\nconst _ = ffi.Loader\n\n"
514− else "\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
515468
516469implFooterSource :: Text -> [Ident] -> Text
517470implFooterSource mn foreigns =
@@ -519,7 +472,7 @@ implFooterSource mn foreigns =
519472 (if null foreigns
520473 then ""
521474 else ("// Foreign values\n\n" <>
522− "var " <> foreignDict <> " = " <> dictType <> "{}\n\n" <>
475+ "var " <> foreignDict <> " = "<> foreignMod <> "(\"" <> mn <> "\")\n\n" <>
523476 (T.concat $ (\foreign' ->
524477 let name = moduleIdentToIL foreign' in
525478 varDecl <> " " <> initName name <> " Once\n" <>
@@ -529,17 +482,17 @@ implFooterSource mn foreigns =
529482 "() Any { \n" <>
530483 " " <> initName name <> ".Do(func() {\n" <>
531484 " " <> valueName name <> " = " <>
532− "SafeGet(" <> foreignDict <> ", " <>
533− (stringLiteral $ mkString name) <> ")\n" <>
485+ "Get(" <> foreignDict <> ", " <>
486+ (stringLiteral . mkString $ runIdent foreign') <> ")\n" <>
534487 " })\n" <>
535488 " return " <> valueName name <> "\n" <>
536489 "}\n\n") <$> foreigns))) <>
537− if mn == "Main" then mainSource else "\n"
490+ if mn == "Main" || mn == "Test.Main" then mainSource else "\n"
538491 where
539492 mainSource :: Text
540493 mainSource = "\
541494 \func main() {\n\
542− \ Run(PS__main())\n\
495+ \ Run(Ꞌmain())\n\
543496 \}\n\n\
544497 \"
545498
@@ -549,11 +502,26 @@ varDecl = "var"
549502renderArg :: Text -> Text -> Text
550503renderArg decl arg = arg <> " " <> decl
551504
505+foreignMod :: Text
506+foreignMod = "Foreign"
507+
552508foreignDict :: Text
553−foreignDict = "Foreign"
509+foreignDict = "foreign"
510+
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"
554522
555523initName :: Text -> Text
556−initName s = "ₒ" <> s
524+initName s = "ᛌ" <> s <> "_once"
557525
558526valueName :: Text -> Text
559−valueName s = "ₐ" <> s
527+valueName s = "ᛧ" <> s