git.iko.soy/rowtype-yoga/purescm
on bytevector help sign in
Fix string literals codegen (#101)

* Bump package set to 0.15.7-20230402 * Add tests for string literals * Fix unicode literals handling in strings --------- Co-authored-by: JordanMartinez <jordanalex.martinez@protonmail.com>

commit3840ec9164369cc2e4d1f0d84bb11a7851162858 authorturlando <turlando@users.noreply.github.com> dateMon 3 Apr 2023, 17:06 (4 years ago) parent0232d1d
5 files changed+190−2
compare with bytevector
unifiedsplit
spago.yaml+1−1 src/PureScript/Backend/Chez/Convert.purs+1−1 src/PureScript/Backend/Chez/Syntax.purs+21 test-snapshots/src/snapshots-input/Snapshot.Literals.String.purs+79 test-snapshots/src/snapshots-output/Snapshot.Literals.String.ss+88
spago.yaml+1−1
@@ -44,7 +44,7 @@ package:
4444 - refs
4545workspace:
4646 package_set:
47− registry: 19.1.0
47+ registry: 20.0.1
4848 extra_packages:
4949 backend-optimizer:
5050 git: https://github.com/JordanMartinez/purescript-backend-optimizer
src/PureScript/Backend/Chez/Convert.purs+1−1
@@ -219,7 +219,7 @@ codegenLiteral :: CodegenEnv -> Literal NeutralExpr -> ChezExpr
219219codegenLiteral codegenEnv = case _ of
220220 LitInt i -> S.Integer $ wrap $ show i
221221 LitNumber n -> S.Float $ wrap $ show n
222− LitString s -> S.String $ Json.stringify $ Json.fromString s
222+ LitString s -> S.String $ S.jsonToChezString $ Json.stringify $ Json.fromString s
223223 LitChar c -> S.Identifier $ "#\\" <> CodeUnits.singleton c
224224 LitBoolean b -> S.Identifier $ if b then "#t" else "#f"
225225 LitArray a -> S.vector $ codegenExpr codegenEnv <$> a
src/PureScript/Backend/Chez/Syntax.purs+21
@@ -10,8 +10,12 @@ import Data.Array.NonEmpty as NEA
1010import Data.Array.NonEmpty as NonEmptyArray
1111import Data.Maybe (Maybe(..), maybe)
1212import Data.Newtype (class Newtype, un)
13+import Data.String.Regex as R
14+import Data.String.Regex.Unsafe as R.Unsafe
15+import Data.String.Regex.Flags as R.Flags
1316import Dodo (Doc)
1417import Dodo as D
18+import Partial.Unsafe (unsafeCrashWith)
1519import Prim as Prim
1620import PureScript.Backend.Chez.Constants (libChezSchemePrefix, scmPrefixed)
1721import PureScript.Backend.Optimizer.CoreFn (Ident(..), ModuleName(..), Prop(..), Qualified(..))
@@ -347,6 +351,23 @@ toChezIdent i (Level l) = case i of
347351 _ -> i' <> show l
348352 Nothing -> "_" <> show l
349353
354+jsonToChezString :: Prim.String -> Prim.String
355+jsonToChezString str = unicodeReplace str
356+ where
357+ unicodeRegex :: R.Regex
358+ unicodeRegex = R.Unsafe.unsafeRegex """\\u([A-F\d]{4})""" R.Flags.global
359+
360+ unicodeReplace :: Prim.String -> Prim.String
361+ unicodeReplace s = R.replace' unicodeRegex unicodeReplaceMatch s
362+
363+ unicodeReplaceMatch
364+ :: Prim.String
365+ -> Prim.Array (Maybe Prim.String)
366+ -> Prim.String
367+ unicodeReplaceMatch _ = case _ of
368+ [ (Just x) ] -> "\\x" <> x <> ";"
369+ _ -> unsafeCrashWith "Error matching at unicodeReplaceMatch in jsonToChezString"
370+
350371--
351372
352373chezCond :: NonEmptyArray { c :: ChezExpr, e :: ChezExpr } -> Maybe ChezExpr -> ChezExpr
test-snapshots/src/snapshots-input/Snapshot.Literals.String.pursnew file+79
@@ -0,0 +1,79 @@
1+module Snapshot.Literals.String where
2+
3+block1 :: String
4+block1 = """block"""
5+
6+block2 :: String
7+block2 = """
8+foo
9+bar
10+"""
11+
12+block3 :: String
13+block3 = """foo
14+bar"""
15+
16+block4 :: String
17+block4 = """foo
18+bar
19+baz"""
20+
21+block5 :: String
22+block5 = """foo
23+bar
24+baz
25+"""
26+
27+---
28+
29+escape1 :: String
30+escape1 = "\t"
31+
32+escape2 :: String
33+escape2 = "\n"
34+
35+escape3 :: String
36+escape3 = "\r"
37+
38+escape4 :: String
39+escape4 = "\r"
40+
41+escape5 :: String
42+escape5 = "\r\n"
43+
44+escape6 :: String
45+escape6 = "\\"
46+
47+escape7 :: String
48+escape7 = "\""
49+
50+escape8 :: String
51+escape8 = "\'"
52+
53+---
54+
55+-- Lowest valid code point
56+unicode1 :: String
57+unicode1 = "\x0"
58+
59+unicode2 :: String
60+unicode2 = "\x10ffff"
61+
62+-- Emoji
63+unicode3 :: String
64+unicode3 = "\x2713"
65+
66+-- Unicode literal with leading zero. Should be equal to unicode3.
67+unicode4 :: String
68+unicode4 = "\x02713"
69+
70+-- Multiple unicode literals in a single string
71+unicode5 :: String
72+unicode5 = "Foo \x2713 Bar \x2713 \n Baz \x2713"
73+
74+unicode6 :: String
75+unicode6 = "2342\x2713"
76+
77+-- String with ^H
78+unicode7 :: String
79+unicode7 = "Foo \x8\x8\x8\x8 Bar"
test-snapshots/src/snapshots-output/Snapshot.Literals.String.ssnew file+88
@@ -0,0 +1,88 @@
1+#!r6rs
2+#!chezscheme
3+(library
4+ (Snapshot.Literals.String lib)
5+ (export
6+ block1
7+ block2
8+ block3
9+ block4
10+ block5
11+ escape1
12+ escape2
13+ escape3
14+ escape4
15+ escape5
16+ escape6
17+ escape7
18+ escape8
19+ unicode1
20+ unicode2
21+ unicode3
22+ unicode4
23+ unicode5
24+ unicode6
25+ unicode7)
26+ (import
27+ (prefix (chezscheme) scm:)
28+ (prefix (_Chez_Runtime lib) rt:))
29+
30+ (scm:define unicode7
31+ "Foo \b\b\b\b Bar")
32+
33+ (scm:define unicode6
34+ "2342✓")
35+
36+ (scm:define unicode5
37+ "Foo ✓ Bar ✓ \n Baz ✓")
38+
39+ (scm:define unicode4
40+ "✓")
41+
42+ (scm:define unicode3
43+ "✓")
44+
45+ (scm:define unicode2
46+ "􏿿")
47+
48+ (scm:define unicode1
49+ "\x0000;")
50+
51+ (scm:define escape8
52+ "'")
53+
54+ (scm:define escape7
55+ "\"")
56+
57+ (scm:define escape6
58+ "\\")
59+
60+ (scm:define escape5
61+ "\r\n")
62+
63+ (scm:define escape4
64+ "\r")
65+
66+ (scm:define escape3
67+ "\r")
68+
69+ (scm:define escape2
70+ "\n")
71+
72+ (scm:define escape1
73+ "\t")
74+
75+ (scm:define block5
76+ "foo\nbar\nbaz\n")
77+
78+ (scm:define block4
79+ "foo\nbar\nbaz")
80+
81+ (scm:define block3
82+ "foo\nbar")
83+
84+ (scm:define block2
85+ "\nfoo\nbar\n")
86+
87+ (scm:define block1
88+ "block"))