summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/LambdaCube/Compiler/CoreToIR.hs9
-rw-r--r--src/LambdaCube/Compiler/Driver.hs9
-rw-r--r--src/LambdaCube/Compiler/Infer.hs5
-rw-r--r--testdata/concatmap01.out2
-rw-r--r--testdata/dotdot01.out2
-rw-r--r--testdata/dotdot02.out2
-rw-r--r--testdata/fromto.out2
-rw-r--r--testdata/ifThenElse01.out2
-rw-r--r--testdata/language-features/adt/adt01.out2
-rw-r--r--testdata/language-features/adt/adt02.out2
-rw-r--r--testdata/language-features/adt/adt05.out2
-rw-r--r--testdata/language-features/adt/gadt01.out2
-rw-r--r--testdata/listcompr01.out2
-rw-r--r--testdata/listcompr02.out2
-rw-r--r--testdata/listcompr03.out2
-rw-r--r--testdata/listcompr04.out2
-rw-r--r--testdata/listcompr05.out2
-rw-r--r--testdata/loopIssue.out2
-rw-r--r--testdata/primes.out2
-rw-r--r--testdata/reduce06.out2
-rw-r--r--testdata/swizzling.out2
-rw-r--r--testdata/typeclass0.out2
-rw-r--r--testdata/typesyn.out2
23 files changed, 31 insertions, 32 deletions
diff --git a/src/LambdaCube/Compiler/CoreToIR.hs b/src/LambdaCube/Compiler/CoreToIR.hs
index 58a35852..2e033598 100644
--- a/src/LambdaCube/Compiler/CoreToIR.hs
+++ b/src/LambdaCube/Compiler/CoreToIR.hs
@@ -10,7 +10,6 @@
10{-# OPTIONS_GHC -fno-warn-unused-binds #-} -- TODO: remove 10{-# OPTIONS_GHC -fno-warn-unused-binds #-} -- TODO: remove
11module LambdaCube.Compiler.CoreToIR 11module LambdaCube.Compiler.CoreToIR
12 ( compilePipeline 12 ( compilePipeline
13 , Exp, toExp, outputType, boolType, trueExp
14 ) where 13 ) where
15 14
16import Data.Char 15import Data.Char
@@ -95,9 +94,9 @@ newTextureTarget w h (TFrameBuffer _ a) = do
95 return $ Vector.length tv 94 return $ Vector.length tv
96newTextureTarget _ _ x = error $ "newTextureTarget illegal target type: " ++ ppShow x 95newTextureTarget _ _ x = error $ "newTextureTarget illegal target type: " ++ ppShow x
97 96
98compilePipeline :: IR.Backend -> Exp -> IR.Pipeline 97compilePipeline :: IR.Backend -> I.Exp -> IR.Pipeline
99compilePipeline b e = flip execState (emptyPipeline b) $ do 98compilePipeline b e = flip execState (emptyPipeline b) $ do
100 (subCmds,cmds) <- getCommands e 99 (subCmds,cmds) <- getCommands $ toExp e
101 modify (\s -> s {IR.commands = Vector.fromList subCmds <> Vector.fromList cmds}) 100 modify (\s -> s {IR.commands = Vector.fromList subCmds <> Vector.fromList cmds})
102 101
103mergeSlot a b = a 102mergeSlot a b = a
@@ -1085,7 +1084,3 @@ getSwizzChar = \case
1085 A0 "Sw" -> Just 'w' 1084 A0 "Sw" -> Just 'w'
1086 _ -> Nothing 1085 _ -> Nothing
1087 1086
1088outputType = I.TTyCon0 "'Output"
1089boolType = I.TTyCon0 "'Bool"
1090trueExp = TCon TBool "True"
1091
diff --git a/src/LambdaCube/Compiler/Driver.hs b/src/LambdaCube/Compiler/Driver.hs
index fafd6378..20ecb816 100644
--- a/src/LambdaCube/Compiler/Driver.hs
+++ b/src/LambdaCube/Compiler/Driver.hs
@@ -11,7 +11,7 @@ module LambdaCube.Compiler.Driver
11 , Pipeline 11 , Pipeline
12 , Infos, listInfos, Range(..) 12 , Infos, listInfos, Range(..)
13 , ErrorMsg(..) 13 , ErrorMsg(..)
14 , Exp, toExp, outputType, boolType, trueExp 14 , Exp, outputType, boolType, trueExp
15 15
16 , MMT, runMMT, mapMMT 16 , MMT, runMMT, mapMMT
17 , MM, runMM 17 , MM, runMM
@@ -42,8 +42,7 @@ import qualified Data.Text.IO as TIO
42 42
43import IR 43import IR
44import LambdaCube.Compiler.Pretty hiding ((</>)) 44import LambdaCube.Compiler.Pretty hiding ((</>))
45import LambdaCube.Compiler.Infer (Infos, listInfos, ErrorMsg(..), PolyEnv(..), Export(..), Module(..), ErrorT, throwErrorTCM, parseLC, joinPolyEnvs, filterPolyEnv, inference_, ImportItems (..), Range(..)) 45import LambdaCube.Compiler.Infer (Infos, listInfos, ErrorMsg(..), PolyEnv(..), Export(..), Module(..), ErrorT, throwErrorTCM, parseLC, joinPolyEnvs, filterPolyEnv, inference_, ImportItems (..), Range(..), Exp, outputType, boolType, trueExp)
46import qualified LambdaCube.Compiler.Infer as I
47import LambdaCube.Compiler.CoreToIR 46import LambdaCube.Compiler.CoreToIR
48 47
49type EName = String 48type EName = String
@@ -145,7 +144,7 @@ filterImports (ImportAllBut ns) = not . (`elem` ns)
145filterImports (ImportJust ns) = (`elem` ns) 144filterImports (ImportJust ns) = (`elem` ns)
146 145
147-- used in runTests 146-- used in runTests
148getDef :: MonadMask m => MName -> EName -> Maybe I.Exp -> MMT m (FilePath, Either String (Exp, I.Exp), Infos) 147getDef :: MonadMask m => MName -> EName -> Maybe Exp -> MMT m (FilePath, Either String (Exp, Exp), Infos)
149getDef m d ty = do 148getDef m d ty = do
150 (fname, pe) <- loadModule m 149 (fname, pe) <- loadModule m
151 return 150 return
@@ -153,7 +152,7 @@ getDef m d ty = do
153 , case Map.lookup d $ getPolyEnv pe of 152 , case Map.lookup d $ getPolyEnv pe of
154 Just (e, thy, si) 153 Just (e, thy, si)
155 | Just False <- (== thy) <$> ty -> Left $ "type of " ++ d ++ " should be " ++ show ty ++ " instead of " ++ ppShow thy -- TODO: better type comparison 154 | Just False <- (== thy) <$> ty -> Left $ "type of " ++ d ++ " should be " ++ show ty ++ " instead of " ++ ppShow thy -- TODO: better type comparison
156 | otherwise -> Right (toExp e, thy) 155 | otherwise -> Right (e, thy)
157 Nothing -> Left $ d ++ " is not found" 156 Nothing -> Left $ d ++ " is not found"
158 , infos pe 157 , infos pe
159 ) 158 )
diff --git a/src/LambdaCube/Compiler/Infer.hs b/src/LambdaCube/Compiler/Infer.hs
index 049c7652..8b4fd00c 100644
--- a/src/LambdaCube/Compiler/Infer.hs
+++ b/src/LambdaCube/Compiler/Infer.hs
@@ -17,6 +17,7 @@ module LambdaCube.Compiler.Infer
17 , Exp (..), GlobalEnv 17 , Exp (..), GlobalEnv
18 , pattern Var, pattern Fun, pattern CaseFun, pattern TyCaseFun, pattern App, pattern PMLabel, pattern FixLabel 18 , pattern Var, pattern Fun, pattern CaseFun, pattern TyCaseFun, pattern App, pattern PMLabel, pattern FixLabel
19 , pattern Con, pattern TyCon, pattern Lam, pattern Pi, pattern TTyCon0 19 , pattern Con, pattern TyCon, pattern Lam, pattern Pi, pattern TTyCon0
20 , outputType, boolType, trueExp
20 , downE 21 , downE
21 , litType 22 , litType
22 , initEnv, Env(..), pattern EBind2 23 , initEnv, Env(..), pattern EBind2
@@ -216,6 +217,10 @@ conTypeName (ConName _ _ _ t) = case snd (getParams t) of
216 TyCon n _ -> n 217 TyCon n _ -> n
217 _ -> error "impossible" 218 _ -> error "impossible"
218 219
220outputType = TTyCon0 "'Output"
221boolType = TBool
222trueExp = EBool True
223
219-------------------------------------------------------------------------------- label handling 224-------------------------------------------------------------------------------- label handling
220 225
221data LabelKind 226data LabelKind
diff --git a/testdata/concatmap01.out b/testdata/concatmap01.out
index 4791ed55..65af037c 100644
--- a/testdata/concatmap01.out
+++ b/testdata/concatmap01.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/dotdot01.out b/testdata/dotdot01.out
index 4791ed55..65af037c 100644
--- a/testdata/dotdot01.out
+++ b/testdata/dotdot01.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/dotdot02.out b/testdata/dotdot02.out
index 4791ed55..65af037c 100644
--- a/testdata/dotdot02.out
+++ b/testdata/dotdot02.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/fromto.out b/testdata/fromto.out
index 4791ed55..65af037c 100644
--- a/testdata/fromto.out
+++ b/testdata/fromto.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/ifThenElse01.out b/testdata/ifThenElse01.out
index 4791ed55..65af037c 100644
--- a/testdata/ifThenElse01.out
+++ b/testdata/ifThenElse01.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/language-features/adt/adt01.out b/testdata/language-features/adt/adt01.out
index 4791ed55..65af037c 100644
--- a/testdata/language-features/adt/adt01.out
+++ b/testdata/language-features/adt/adt01.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/language-features/adt/adt02.out b/testdata/language-features/adt/adt02.out
index 4791ed55..65af037c 100644
--- a/testdata/language-features/adt/adt02.out
+++ b/testdata/language-features/adt/adt02.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/language-features/adt/adt05.out b/testdata/language-features/adt/adt05.out
index 88d050b1..d596dc9c 100644
--- a/testdata/language-features/adt/adt05.out
+++ b/testdata/language-features/adt/adt05.out
@@ -1 +1 @@
main \ No newline at end of file main \ No newline at end of file
diff --git a/testdata/language-features/adt/gadt01.out b/testdata/language-features/adt/gadt01.out
index 4791ed55..65af037c 100644
--- a/testdata/language-features/adt/gadt01.out
+++ b/testdata/language-features/adt/gadt01.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/listcompr01.out b/testdata/listcompr01.out
index 4791ed55..65af037c 100644
--- a/testdata/listcompr01.out
+++ b/testdata/listcompr01.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/listcompr02.out b/testdata/listcompr02.out
index 4791ed55..65af037c 100644
--- a/testdata/listcompr02.out
+++ b/testdata/listcompr02.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/listcompr03.out b/testdata/listcompr03.out
index 4791ed55..65af037c 100644
--- a/testdata/listcompr03.out
+++ b/testdata/listcompr03.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/listcompr04.out b/testdata/listcompr04.out
index 4791ed55..65af037c 100644
--- a/testdata/listcompr04.out
+++ b/testdata/listcompr04.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/listcompr05.out b/testdata/listcompr05.out
index 4791ed55..65af037c 100644
--- a/testdata/listcompr05.out
+++ b/testdata/listcompr05.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/loopIssue.out b/testdata/loopIssue.out
index 4791ed55..65af037c 100644
--- a/testdata/loopIssue.out
+++ b/testdata/loopIssue.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/primes.out b/testdata/primes.out
index b74e882a..703d8fba 100644
--- a/testdata/primes.out
+++ b/testdata/primes.out
@@ -1 +1 @@
31 \ No newline at end of file 31 \ No newline at end of file
diff --git a/testdata/reduce06.out b/testdata/reduce06.out
index 4791ed55..65af037c 100644
--- a/testdata/reduce06.out
+++ b/testdata/reduce06.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/swizzling.out b/testdata/swizzling.out
index 4791ed55..65af037c 100644
--- a/testdata/swizzling.out
+++ b/testdata/swizzling.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/typeclass0.out b/testdata/typeclass0.out
index 4791ed55..65af037c 100644
--- a/testdata/typeclass0.out
+++ b/testdata/typeclass0.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
diff --git a/testdata/typesyn.out b/testdata/typesyn.out
index 4791ed55..65af037c 100644
--- a/testdata/typesyn.out
+++ b/testdata/typesyn.out
@@ -1 +1 @@
True \ No newline at end of file True \ No newline at end of file
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-29 16:32:20 +0000