fix section desugaring

4 files changed, 18 insertions, 11 deletions

diff --git a/Makefile b/Makefile
index 2ccb05a2..0b87461a 100644
--- a/Makefile
+++ b/Makefile
@@ -3,7 +3,7 @@ all:
         cabal install --constraint="indentation -trifecta"
 
 repl:
-        cd test && ghci -Wall -fno-warn-name-shadowing -fno-warn-unused-matches -fno-warn-missing-signatures -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns -fno-warn-type-defaults -i../src runTests.hs
+        cd test && ghci -Wall -fno-warn-name-shadowing -fno-warn-unused-matches -fno-warn-missing-signatures -fno-warn-incomplete-patterns -fno-warn-overlapping-patterns -fno-warn-type-defaults -i../src -i../dist/build/autogen runTests.hs
 
 coverage:
         ./run-test-suite.sh --coverage
diff --git a/src/LambdaCube/Compiler/Parser.hs b/src/LambdaCube/Compiler/Parser.hs
index c8b78b0e..b2c0fef4 100644
--- a/src/LambdaCube/Compiler/Parser.hs
+++ b/src/LambdaCube/Compiler/Parser.hs
@@ -142,8 +142,7 @@ pattern SLabelEnd a = SBuiltin "labelend" `SAppV` a
 
 pattern SBuiltin s <- SGlobal (_, s) where SBuiltin s = SGlobal (debugSI $ "builtin " ++ s, s)
 
-pattern LeftSection  op e = SBuiltin "^leftSection"  `SAppV` SGlobal op `SAppV` e
-pattern RightSection e op = SBuiltin "^rightSection" `SAppV` e `SAppV` SGlobal op
+pattern Section e = SBuiltin "^section"  `SAppV` e
 
 sApp v a b = SApp (sourceInfo a <> sourceInfo b) v a b
 sBind v x a b = SBind (sourceInfo a <> sourceInfo b) v x a b
@@ -416,12 +415,8 @@ parseTerm prec = withRange setSI $ case prec of
         mkValues = foldr (\x xs -> SBuiltin "Tuple2" `SAppV` x `SAppV` xs)
                          (SBuiltin "Tuple0")
 
-    mkLeftSection op e  = SLam Visible (Wildcard SType) $ SGlobal op `SAppV` SVar (mempty, ".ls") 0 `SAppV` up1 e
-    mkRightSection e op = SLam Visible (Wildcard SType) $ SGlobal op `SAppV` up1 e `SAppV` SVar (mempty, ".rs") 0
-
+    mkTuple _ [Section e] = e
     mkTuple _ [x] = x
-    mkTuple _ [LeftSection op x]  = mkLeftSection op x
-    mkTuple _ [RightSection x op] = mkRightSection x op
     mkTuple (Namespace level _) xs = foldl SAppV (SBuiltin (tuple ++ show (length xs))) xs
       where tuple = case level of
                 Just TypeLevel -> "'Tuple"
@@ -442,10 +437,10 @@ parseTerm prec = withRange setSI $ case prec of
     calculatePrecs :: DesugarInfo -> [Either SIName SExp] -> P SExp
     calculatePrecs dcls = either fail return . f where
         f []                 = error "impossible"
-        f (Right t: xs)      = either (\(op, xs) -> RightSection (calcPrec' t xs) op) (calcPrec' t) <$> cont xs
+        f (Right t: xs)      = either (\(op, xs) -> Section $ SLamV $ SGlobal op `SAppV` up1 (calcPrec' t xs) `SAppV` SVar (mempty, ".rs") 0) (calcPrec' t) <$> cont xs
         f xs@(Left op@(_, "-"): _) = f $ Right (mkLit $ LInt 0): xs
         f (Left op: xs)      = g op xs >>= either (const $ Left "TODO: better error message @476")
-                                                  (\((op, e): oe) -> return $ LeftSection op $ calcPrec' e oe)
+                                                  (\((op, e): oe) -> return $ Section $ SLamV $ SGlobal op `SAppV` SVar (mempty, ".ls") 0 `SAppV` up1 (calcPrec' e oe))
         g op (Right t: xs)   = (second ((op, t):) +++ ((op, t):)) <$> cont xs
         g op []              = return $ Left (op, [])
         g op _               = Left "two operator is not allowed next to each-other"
diff --git a/testdata/language-features/section/section01.wip.lc b/testdata/language-features/section/section01.lc
index e235aaba..99c83a29 100644
--- a/testdata/language-features/section/section01.wip.lc
+++ b/testdata/language-features/section/section01.lc
@@ -2,4 +2,4 @@ _ !@! _ = ()
 
 value1 x = (x !@!)
 
-value2 x = (!@! x)
\ No newline at end of file
+value2 x = (!@! x)
diff --git a/testdata/language-features/section/section01.out b/testdata/language-features/section/section01.out
new file mode 100644
index 00000000..4b6e540f
--- /dev/null
+++ b/testdata/language-features/section/section01.out
@@ -0,0 +1,12 @@
+main is not found
+tooltips:
+testdata/language-features/section/section01.lc 1:3-1:6  {a} -> {b} -> a -> b->Tuple0
+testdata/language-features/section/section01.lc 1:11-1:13  Tuple0
+testdata/language-features/section/section01.lc 3:1-3:7  {a} -> {b} -> a -> b->Tuple0
+testdata/language-features/section/section01.lc 3:13-3:14  V5
+testdata/language-features/section/section01.lc 3:13-3:18  V0->Tuple0
+testdata/language-features/section/section01.lc 3:15-3:18  {a} -> {b} -> a -> b->Tuple0
+testdata/language-features/section/section01.lc 5:1-5:7  {a} -> {b} -> a -> b->Tuple0
+testdata/language-features/section/section01.lc 5:13-5:16  {a} -> {b} -> a -> b->Tuple0
+testdata/language-features/section/section01.lc 5:13-5:18  Tuple0
+testdata/language-features/section/section01.lc 5:17-5:18  V4