Skip to content

Commit 16dc48c

Browse files
sfultongsfultong
committed
fixing tests and apps
1 parent 15c9e06 commit 16dc48c

15 files changed

Lines changed: 254 additions & 654 deletions

‎app/Evaluare.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,8 @@ import qualified System.IO.Strict as Strict
2222
import qualified Telomare as Tel
2323
import Telomare (BasicExprF (..), CompiledExpr, CompiledExprF (..), StuckF (..))
2424
import qualified Telomare.Eval as TE
25-
import Telomare.Parser (AUPT, AnnotatedUPT (..), parseModule)
25+
import Telomare (AUPT, AnnotatedUPT (..))
26+
import Telomare.Parser (parseModule)
2627
import Text.Read (readMaybe)
2728

2829
type VtyExample t m =

‎app/LSP.hs‎

Lines changed: 35 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -42,14 +42,14 @@ import Language.LSP.Protocol.Types (NormalizedUri, Position (..), Range (..),
4242
import qualified Language.LSP.Protocol.Types as LSPTypes
4343
import Language.LSP.Server
4444

45-
import Telomare (LocTag (..), PatternF (..), ResolverError (..),
46-
SourcePosition (..), SourceSpan (..),
45+
import Telomare (AUPT, AnnotatedUPT (..), BasicExprF (..), HighTermF (..),
46+
LamTermF (..), LocTag (..), PatternA, PatternF (..),
47+
ResolverError (..), SourcePosition (..), SourceSpan (..),
4748
UnprocessedParsedTermF (..), letBindingName, letBindingValue,
4849
locStartLineColumn, locatedNameLoc, locatedNameText,
4950
renderResolverError)
5051
import Telomare.Eval (eval2IExpr)
51-
import Telomare.Parser (AUPT, AnnotatedUPT (..), PatternA, parseModule,
52-
parseModuleDetailed)
52+
import Telomare.Parser (parseModule, parseModuleDetailed)
5353
import Telomare.Resolver (main2Term3)
5454
import Text.Megaparsec.Error (ParseErrorBundle (..), errorBundlePretty,
5555
errorOffset)
@@ -406,27 +406,27 @@ unresolvedTerm :: Set.Set String -> AUPT -> [(String, Range)]
406406
unresolvedTerm globals = go Set.empty
407407
where
408408
go bound (loc :< term) = case term of
409-
VarUPF name
409+
UnprocessedParsedTermL (VarF name)
410410
| name `Set.member` bound || name `Set.member` globals -> []
411411
| otherwise -> [(name, locTagToRange loc)]
412412
LetUPF bindings body ->
413413
let localNames = Set.fromList $ letBindingName <$> bindings
414414
bound' = localNames <> bound
415415
in concatMap (go bound' . letBindingValue) bindings <> go bound' body
416-
LamUPF name body -> go (Set.insert (locatedNameText name) bound) body
416+
UnprocessedParsedTermL (LamF name body) -> go (Set.insert (locatedNameText name) bound) body
417417
UDTUPF names body -> go (Set.union (Set.fromList names) bound) body
418418
CaseUPF scrutinee cases ->
419419
go bound scrutinee <> concatMap (caseRefs bound) cases
420-
ITEUPF i t e -> concatMap (go bound) [i, t, e]
420+
UnprocessedParsedTermH (ITEF i t e) -> concatMap (go bound) [i, t, e]
421421
ListUPF items -> concatMap (go bound) items
422-
PairUPF a b -> concatMap (go bound) [a, b]
423-
AppUPF f x -> concatMap (go bound) [f, x]
424-
LeftUPF x -> go bound x
425-
RightUPF x -> go bound x
426-
TraceUPF x -> go bound x
427-
CheckUPF checkExpr body -> go bound checkExpr <> go bound body
428-
HashUPF x -> go bound x
429-
UnsizedRecursionUPF t r b -> concatMap (go bound) [t, r, b]
422+
UnprocessedParsedTermB (PairSF a b) -> concatMap (go bound) [a, b]
423+
UnprocessedParsedTermL (AppF f x) -> concatMap (go bound) [f, x]
424+
UnprocessedParsedTermH (HLeftF x) -> go bound x
425+
UnprocessedParsedTermH (HRightF x) -> go bound x
426+
UnprocessedParsedTermH (HTraceF x) -> go bound x
427+
UnprocessedParsedTermH (CheckF checkExpr body) -> go bound checkExpr <> go bound body
428+
UnprocessedParsedTermH (HashF x) -> go bound x
429+
UnprocessedParsedTermH (RecursionF t r b) -> concatMap (go bound) [t, r, b]
430430
_ -> []
431431

432432
caseRefs bound (pat, body) =
@@ -707,23 +707,23 @@ findIdentifierInLhs name lineText = go 0 lhs
707707
termReferences :: [String] -> AUPT -> [(String, Range)]
708708
termReferences bound (loc :< term) =
709709
let children = case term of
710-
VarUPF name
710+
UnprocessedParsedTermL (VarF name)
711711
| name `elem` bound -> []
712712
| otherwise -> [(name, locTagToRange loc)]
713-
ITEUPF i t e -> termReferences bound i <> termReferences bound t <> termReferences bound e
713+
UnprocessedParsedTermH (ITEF i t e) -> termReferences bound i <> termReferences bound t <> termReferences bound e
714714
LetUPF bindings body ->
715715
let localNames = letBindingName <$> bindings
716716
bound' = localNames <> bound
717717
in concatMap (termReferences bound' . letBindingValue) bindings <> termReferences bound' body
718718
ListUPF items -> concatMap (termReferences bound) items
719-
PairUPF a b -> termReferences bound a <> termReferences bound b
720-
AppUPF f x -> termReferences bound f <> termReferences bound x
721-
LamUPF var body -> termReferences (locatedNameText var : bound) body
722-
LeftUPF x -> termReferences bound x
723-
RightUPF x -> termReferences bound x
724-
TraceUPF x -> termReferences bound x
725-
CheckUPF checkExpr body -> termReferences bound checkExpr <> termReferences bound body
726-
HashUPF x -> termReferences bound x
719+
UnprocessedParsedTermB (PairSF a b) -> termReferences bound a <> termReferences bound b
720+
UnprocessedParsedTermL (AppF f x) -> termReferences bound f <> termReferences bound x
721+
UnprocessedParsedTermL (LamF var body) -> termReferences (locatedNameText var : bound) body
722+
UnprocessedParsedTermH (HLeftF x) -> termReferences bound x
723+
UnprocessedParsedTermH (HRightF x) -> termReferences bound x
724+
UnprocessedParsedTermH (HTraceF x) -> termReferences bound x
725+
UnprocessedParsedTermH (CheckF checkExpr body) -> termReferences bound checkExpr <> termReferences bound body
726+
UnprocessedParsedTermH (HashF x) -> termReferences bound x
727727
UDTUPF names body -> termReferences (names <> bound) body
728728
CaseUPF scrutinee cases -> termReferences bound scrutinee <> concatMap caseReferences cases
729729
_ -> []
@@ -744,7 +744,7 @@ localTermDefinitionAt :: LSPTypes.Uri
744744
-> AUPT
745745
-> Maybe LSPTypes.Location
746746
localTermDefinitionAt uri position env (loc :< term) = case term of
747-
VarUPF name
747+
UnprocessedParsedTermL (VarF name)
748748
| positionInRange position (locTagToRange loc) -> join $ Map.lookup name env
749749
| otherwise -> Nothing
750750
LetUPF bindings body ->
@@ -764,22 +764,22 @@ localTermDefinitionAt uri position env (loc :< term) = case term of
764764
, location <- foldMap pure $ localTermDefinitionAt uri position env' (letBindingValue binding)
765765
]
766766
in bindingDefinition <|> bindingRefs <|> localTermDefinitionAt uri position env' body
767-
ITEUPF i t e -> firstJust [i, t, e]
767+
UnprocessedParsedTermH (ITEF i t e) -> firstJust [i, t, e]
768768
ListUPF items -> firstJust items
769-
PairUPF a b -> firstJust [a, b]
770-
AppUPF f x -> firstJust [f, x]
771-
LamUPF name body ->
769+
UnprocessedParsedTermB (PairSF a b) -> firstJust [a, b]
770+
UnprocessedParsedTermL (AppF f x) -> firstJust [f, x]
771+
UnprocessedParsedTermL (LamF name body) ->
772772
let nameLoc = locatedNameLoc name
773773
location = LSPTypes.Location uri (locTagToRange nameLoc)
774774
env' = Map.insert (locatedNameText name) (Just location) env
775775
in if positionInRange position (locTagToRange nameLoc)
776776
then Just location
777777
else localTermDefinitionAt uri position env' body
778-
LeftUPF x -> localTermDefinitionAt uri position env x
779-
RightUPF x -> localTermDefinitionAt uri position env x
780-
TraceUPF x -> localTermDefinitionAt uri position env x
781-
CheckUPF checkExpr body -> firstJust [checkExpr, body]
782-
HashUPF x -> localTermDefinitionAt uri position env x
778+
UnprocessedParsedTermH (HLeftF x) -> localTermDefinitionAt uri position env x
779+
UnprocessedParsedTermH (HRightF x) -> localTermDefinitionAt uri position env x
780+
UnprocessedParsedTermH (HTraceF x) -> localTermDefinitionAt uri position env x
781+
UnprocessedParsedTermH (CheckF checkExpr body) -> firstJust [checkExpr, body]
782+
UnprocessedParsedTermH (HashF x) -> localTermDefinitionAt uri position env x
783783
UDTUPF names body -> localTermDefinitionAt uri position (foldr (`Map.insert` Nothing) env names) body
784784
CaseUPF scrutinee cases ->
785785
localTermDefinitionAt uri position env scrutinee

‎app/Repl.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -29,8 +29,8 @@ import System.Exit (exitSuccess)
2929
import qualified System.IO.Strict as Strict
3030
import Telomare
3131
import Telomare.Eval (compileUnitTestNoAbort)
32-
import Telomare.Parser (AUPT, AnnotatedUPT (..), TelomareParser,
33-
parseAssignment, parseLongExpr, parsePrelude)
32+
import Telomare.Parser (TelomareParser, parseAssignment, parseLongExpr,
33+
parsePrelude)
3434
import Telomare.Possible (evalPartial)
3535
import Telomare.PossibleData (DeferredEvalF (..), PartialExpr, deferredEE)
3636
import Telomare.Resolver (process)
@@ -275,7 +275,7 @@ main = do
275275
SimpleBackend -> wrapEval simpleEval'
276276
simpleEval' :: StuckExpr -> Either RunTimeError StuckExpr
277277
simpleEval' = eval
278-
wrapEval f = conv . fmap toTelomare . f . fromTelomare . (\x -> setEnvB (pairB (embed . embedS $ DeferSF (toEnum (-1)) x) zeroB))
278+
wrapEval f = conv . fmap toTelomare . f . fromTelomare . (\x -> SetEnvB (PairB (embed . embedS $ DeferSF (toEnum (-1)) x) ZeroB))
279279
conv = \case
280280
Right (Just x) -> Right x
281281
Left e -> Left e

0 commit comments

Comments
 (0)