Skip to content

Commit d0802ef

Browse files
UnisayUnisay
committed
Handle Lua-reserved words when used as table keys
1 parent b94e4f5 commit d0802ef

6 files changed

Lines changed: 78 additions & 23 deletions

File tree

‎lib/Language/PureScript/Backend/Lua.hs‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ import Language.PureScript.Backend.IR.Linker (UberModule (..))
2323
import Language.PureScript.Backend.IR.Linker qualified as Linker
2424
import Language.PureScript.Backend.IR.Query (usesPrimModule, usesRuntimeLazy)
2525
import Language.PureScript.Backend.Lua.Fixture qualified as Fixture
26+
import Language.PureScript.Backend.Lua.Key qualified as Key
2627
import Language.PureScript.Backend.Lua.Linker.Foreign qualified as Foreign
2728
import Language.PureScript.Backend.Lua.Name qualified as Lua
2829
import Language.PureScript.Backend.Lua.Name qualified as Name
@@ -230,7 +231,10 @@ fromExp foreigns topLevelNames modname ir = case ir of
230231
let foreignExports ∷ Lua.Exp =
231232
Lua.table
232233
[ Lua.tableRowNV name (Lua.ForeignSourceExp src)
233-
| (name, src) ← toList exports
234+
| (key, src) ← toList exports
235+
-- Export tables can contain Lua-reserved words as keys
236+
-- for example: `{ ["for"] = 42 }`
237+
, let name = Key.toSafeName key
234238
, name `elem` names
235239
]
236240
pure case foreignHeader of

‎lib/Language/PureScript/Backend/Lua/Key.hs‎

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,44 @@
1+
{- | This module defines the data type `Key` which is used to represent the
2+
keys of a Lua table.
3+
-}
4+
module Language.PureScript.Backend.Lua.Key
5+
( Key (..)
6+
, parser
7+
, toSafeName
8+
) where
9+
10+
import Language.PureScript.Backend.Lua.Name (Name)
11+
import Language.PureScript.Backend.Lua.Name qualified as Name
12+
import Text.Megaparsec qualified as Mega
13+
import Text.Megaparsec.Char qualified as M
14+
15+
data Key = KeyName Name | KeyReserved Text
16+
deriving stock (Eq, Show)
17+
18+
toSafeName ∷ Key → Name
19+
toSafeName (KeyName n) = n
20+
toSafeName (KeyReserved t) = Name.makeSafe t
21+
22+
type Parser = Mega.Parsec Void Text
23+
24+
parser ∷ Parser Key
25+
parser = (nameParser <|> reservedParser) <* M.space
26+
where
27+
nameParser ∷ Parser Key
28+
nameParser = KeyName <$> Name.parser
29+
30+
reservedParser ∷ Parser Key
31+
reservedParser = brackets $ quotes do
32+
KeyReserved <$> Mega.choice (M.string <$> toList Name.reserved)
33+
34+
brackets ∷ Parser a → Parser a
35+
brackets = between '[' ']'
36+
37+
quotes ∷ Parser a → Parser a
38+
quotes = between '\"' '\"'
39+
40+
between ∷ Char → Char → Parser c → Parser c
41+
between open close p = char open *> p <* char close
42+
43+
char ∷ Char → Parser ()
44+
char c = M.char c *> M.space

‎lib/Language/PureScript/Backend/Lua/Linker/Foreign.hs‎

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -15,8 +15,8 @@ import Data.DList (DList)
1515
import Data.DList qualified as DL
1616
import Data.String qualified as String
1717
import Data.Text qualified as Text
18-
import Language.PureScript.Backend.Lua.Name (Name)
19-
import Language.PureScript.Backend.Lua.Name qualified as Name
18+
import Language.PureScript.Backend.Lua.Key (Key)
19+
import Language.PureScript.Backend.Lua.Key qualified as Key
2020
import Path (Abs, Dir, File, Path, toFilePath, (</>))
2121
import Path qualified
2222
import Path.IO qualified as Path
@@ -27,7 +27,7 @@ import Text.Megaparsec.Char qualified as MP
2727
import Text.Show (Show (..))
2828
import Prelude hiding (show)
2929

30-
data Source = Source {header ∷ Maybe Text, exports ∷ NonEmpty (Name, Text)}
30+
data Source = Source {header ∷ Maybe Text, exports ∷ NonEmpty (Key, Text)}
3131
deriving stock (Eq, Show)
3232

3333
{- | Parse a foreign source file which has to be in the following format:
@@ -84,23 +84,23 @@ parseForeignSource foreigns path = runExceptT do
8484

8585
type Parser = Parsec Void Text
8686

87-
moduleParser ∷ Parser (NonEmpty (Name, Text))
87+
moduleParser ∷ Parser (NonEmpty (Key, Text))
8888
moduleParser = do
8989
MP.string "return" *> MP.space1
9090
char '{'
9191
exports ← NE.sepEndBy1 foreignExport (char ',')
9292
char '}'
9393
pure exports
9494

95-
foreignExport ∷ Parser (Name, Text)
95+
foreignExport ∷ Parser (Key, Text)
9696
foreignExport = do
97-
exportName ← Name.parser <* MP.space1
97+
exportKey ← Key.parser
9898
char '='
99-
exportValue ← valueParser <* MP.space
100-
pure (exportName, toText exportValue)
99+
exportValue ← valueParser
100+
pure (exportKey, toText exportValue)
101101

102102
valueParser ∷ Parser String
103-
valueParser = char '(' *> go 0 DL.empty
103+
valueParser = char '(' *> go 0 DL.empty <* MP.space
104104
where
105105
go ∷ Int → DList Char → Parser String
106106
go numToClose value = do

‎lib/Language/PureScript/Backend/Lua/Name.hs‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ module Language.PureScript.Backend.Lua.Name
1111
, specialNameType
1212
, specialNameCtor
1313
, join2
14+
, reserved
1415
) where
1516

1617
import Data.Char qualified as Char
@@ -51,7 +52,7 @@ fromText t =
5152
| Text.length n > 0
5253
, checkFirst (Text.head n)
5354
, Text.all checkRest (Text.tail n)
54-
, Set.notMember n reservedNames →
55+
, Set.notMember n reserved →
5556
Just (Name n)
5657
_ → Nothing
5758
where
@@ -69,13 +70,12 @@ makeSafe ∷ HasCallStack ⇒ Text → Name
6970
makeSafe unsafe = unsafeName safest
7071
where
7172
safest =
72-
if safer `Set.member` reservedNames
73+
if safer `Set.member` reserved
7374
then '_' `Text.cons` safer `Text.snoc` '_'
7475
else safer
7576
safer =
76-
Text.replace "$" "_S_"
77-
. Text.replace "." "_"
78-
$ Text.replace "'" "Prime" unsafe
77+
Text.replace "$" "_S_" . Text.replace "." "_" $
78+
Text.replace "'" "Prime" unsafe
7979

8080
unsafeName ∷ HasCallStack ⇒ Text → Name
8181
unsafeName n =
@@ -94,8 +94,8 @@ specialNameType = Name "$type"
9494
specialNameCtor ∷ Name
9595
specialNameCtor = Name "$ctor"
9696

97-
reservedNames ∷ Set Text
98-
reservedNames =
97+
reserved ∷ Set Text
98+
reserved =
9999
Set.fromList
100100
[ "and"
101101
, "break"

‎pslua.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -132,6 +132,7 @@ library
132132
Language.PureScript.Backend.Lua
133133
Language.PureScript.Backend.Lua.DeadCodeEliminator
134134
Language.PureScript.Backend.Lua.Fixture
135+
Language.PureScript.Backend.Lua.Key
135136
Language.PureScript.Backend.Lua.Linker.Foreign
136137
Language.PureScript.Backend.Lua.Name
137138
Language.PureScript.Backend.Lua.Optimizer

‎test/Language/PureScript/Backend/Lua/Linker/Foreign/Spec.hs‎

Lines changed: 12 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -7,8 +7,9 @@ module Language.PureScript.Backend.Lua.Linker.Foreign.Spec where
77

88
import Data.List.NonEmpty qualified as NE
99
import Data.String.Interpolate (__i)
10+
import Language.PureScript.Backend.Lua.Key (Key (..))
1011
import Language.PureScript.Backend.Lua.Linker.Foreign
11-
import Language.PureScript.Backend.Lua.Name (Name, unsafeName)
12+
import Language.PureScript.Backend.Lua.Name (unsafeName)
1213
import Path (relfile, toFilePath, (</>))
1314
import Path.IO (withSystemTempDir)
1415
import Test.HUnit (Assertion)
@@ -65,13 +66,18 @@ rawExports =
6566
return {
6667
foo = (42),
6768
bar = ("ok"),
68-
baz = (function(unused) return zoo end)
69+
baz = (function(unused) return zoo end),
70+
[ "if"]= (function() return "if" end),
6971
}
7072
|]
7173

72-
parsedExports ∷ NE.NonEmpty (Name, Text)
74+
parsedExports ∷ NE.NonEmpty (Key, Text)
7375
parsedExports =
74-
(unsafeName "foo", "42")
75-
:| [ (unsafeName "bar", "\"ok\"")
76-
, (unsafeName "baz", "function(unused) return zoo end")
76+
(unsafeKey "foo", "42")
77+
:| [ (unsafeKey "bar", "\"ok\"")
78+
, (unsafeKey "baz", "function(unused) return zoo end")
79+
, (KeyReserved "if", "function() return \"if\" end")
7780
]
81+
82+
unsafeKey ∷ Text → Key
83+
unsafeKey = KeyName . unsafeName

0 commit comments

Comments
 (0)