language-oberon 0.3.2 → 0.3.3
raw patch · 3 files changed
+33/−28 lines, 3 filesdep ~basedep ~rank2classesdep ~template-haskellPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, rank2classes, template-haskell, transformers
API changes (from Hackage documentation)
Files
- ChangeLog.md +5/−0
- language-oberon.cabal +5/−5
- src/Language/Oberon/TypeChecker.hs +23/−23
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for language-oberon +## 0.3.3 -- 2022-09-26++* Using `OverloadedRecordDot` (GHC >= 9.2) instead of field accessors unsupported by GHC 9.6+* Bumped the upper bounds of `rank2classes`, `transformers`, and `template-haskell`+ ## 0.3.2 -- 2022-10-23 * Using `autochain` and new imports from grammatical-parsers-0.7
language-oberon.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: language-oberon-version: 0.3.2+version: 0.3.3 synopsis: Parser, pretty-printer, and more for the Oberon programming language description: The library and the executable support both the original Oberon and the Oberon-2 programming language, as described@@ -30,14 +30,14 @@ Language.Oberon.Abstract, Language.Oberon.AST, Language.Oberon.ConstantFolder, Language.Oberon.Grammar, Language.Oberon.Pretty, Language.Oberon.Reserializer, Language.Oberon.Resolver, Language.Oberon.TypeChecker- build-depends: base >= 4.12 && < 5, base-orphans >= 0.8.2 && < 1.0,+ build-depends: base >= 4.16 && < 5, base-orphans >= 0.8.2 && < 1.0, text < 3, containers >= 0.5 && < 1.0, filepath < 1.5, directory < 1.4, parsers >= 0.12.7 && < 0.13, input-parsers >= 0.2.2 && < 0.4, prettyprinter >= 1.2.1 && < 1.8, either == 5.*,- rank2classes >= 1.3 && < 1.5, grammatical-parsers >= 0.7 && < 0.8,+ rank2classes >= 1.3 && < 1.6, grammatical-parsers >= 0.7 && < 0.8, deep-transformations == 0.2.*,- transformers == 0.5.*,- template-haskell >= 2.11 && < 2.20+ transformers >= 0.5 && < 0.7,+ template-haskell >= 2.11 && < 2.21 default-language: Haskell2010 executable parse
src/Language/Oberon/TypeChecker.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds, DeriveGeneric, DuplicateRecordFields, FlexibleContexts, FlexibleInstances,- MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, ScopedTypeVariables, StandaloneDeriving,+ MultiParamTypeClasses, NamedFieldPuns, OverloadedRecordDot, OverloadedStrings,+ ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances, ViewPatterns #-} -- | Type checker for Oberon AST. The AST must have its ambiguities previously resolved by "Language.Oberon.Resolver".@@ -361,14 +362,14 @@ Atts (Synthesized (Auto TypeCheck)) (Abstract.FormalParameters l l Sem Sem) ~ SynTCSig l) => Synthesizer (Auto TypeCheck) (AST.ProcedureHeading l l) Sem Placed where synthesis _ (pos, AST.ProcedureHeading indirect namedef _sig) _inheritance (AST.ProcedureHeading _indirect _ sig) =- SynTCHead{errors= foldMap (\s-> errors (syn s :: SynTCSig l)) sig,+ SynTCHead{errors= foldMap ((.errors) . syn) sig, outsideEnv= Map.singleton (Abstract.nonQualIdent name) $ maybe (ProcedureType False [] Nothing) (signatureType . syn) sig, insideEnv= foldMap (signatureEnv . syn) sig} where name = Abstract.getIdentDefName namedef synthesis _ (pos, AST.TypeBoundHeading var receiverName receiverType indirect namedef _sig) InhTCDecl{env, pointerTargets} (AST.TypeBoundHeading _var _name _type _indirect _ sig) =- SynTCHead{errors= receiverError <> foldMap (\s-> errors (syn s :: SynTCSig l)) sig,+ SynTCHead{errors= receiverError <> foldMap ((.errors) . syn) sig, outsideEnv= case Map.lookup receiverType pointerTargets of Just targetName -> Map.singleton (Abstract.nonQualIdent targetName) methodType Nothing -> Map.singleton (Abstract.nonQualIdent receiverType) methodType,@@ -436,8 +437,7 @@ Synthesizer (Auto TypeCheck) (AST.FormalParameters l l) Sem Placed where synthesis _ (pos, AST.FormalParameters sections returnType) InhTC{env} (AST.FormalParameters sections' _) =- SynTCSig{errors= foldMap (\s-> errors (syn s :: SynTCSec l)) sections'- <> foldMap typeRefErrors returnType,+ SynTCSig{errors= foldMap ((.errors) . syn) sections' <> foldMap typeRefErrors returnType, signatureType= ProcedureType False (foldMap (sectionParameters . syn) sections') $ returnType >>= (`Map.lookup` env), signatureEnv= foldMap (sectionEnv . syn) sections'}@@ -449,7 +449,7 @@ Atts (Synthesized (Auto TypeCheck)) (Abstract.Type l l Sem Sem) ~ SynTCType l) => Synthesizer (Auto TypeCheck) (AST.FPSection l l) Sem Placed where synthesis _ (pos, AST.FPSection var names _typeDef) _inheritance (AST.FPSection _var _names typeDef) =- SynTCSec{errors= errors (syn typeDef :: SynTCType l),+ SynTCSec{errors= (syn typeDef).errors, sectionParameters= (var, definedType (syn typeDef)) <$ names, sectionEnv= Map.fromList (flip (,) (definedType $ syn typeDef) . Abstract.nonQualIdent <$> names)} @@ -465,8 +465,8 @@ pointerTarget= Nothing, definedType= fromMaybe UnknownType (Map.lookup q env)} synthesis _ (pos, AST.ArrayType _dims _itemType) InhTC{} (AST.ArrayType dimensions itemType) =- SynTCType{errors= foldMap (\d-> errors (syn d :: SynTCExp l)) dimensions- <> errors (syn itemType :: SynTCType l)+ SynTCType{errors= foldMap ((.errors) . syn) dimensions+ <> (syn itemType).errors <> foldMap (expectInteger . syn) dimensions, typeName= Nothing, pointerTarget= Nothing,@@ -476,7 +476,7 @@ integerValue SynTCExp{inferredType= IntegerType n} = n integerValue _ = 0 synthesis _ (pos, AST.RecordType base fields) InhTC{env} (AST.RecordType _base fields') =- SynTCType{errors= fst baseRecord <> foldMap (\f-> errors (syn f :: SynTCFields l)) fields',+ SynTCType{errors= fst baseRecord <> foldMap ((.errors) . syn) fields', typeName= Nothing, pointerTarget= Nothing, definedType= RecordType (maybe [] (maybe id (:) base . ancestry) $ snd baseRecord)@@ -490,12 +490,12 @@ (foldMap (Folded . (:[]) . Error () pos . UnknownName) base, Nothing) Nothing -> (mempty, Nothing) synthesis (Auto TypeCheck) _self _inheritance (AST.PointerType targetType') =- SynTCType{errors= errors (syn targetType' :: SynTCType l),+ SynTCType{errors= (syn targetType').errors, typeName= Nothing, pointerTarget= typeName (syn targetType'), definedType= PointerType (definedType $ syn targetType')} synthesis _ (pos, AST.ProcedureType signature) _inheritance (AST.ProcedureType signature') = - SynTCType{errors= foldMap (\s-> errors (syn s :: SynTCSig l)) signature',+ SynTCType{errors= foldMap ((.errors) . syn) signature', typeName= Nothing, pointerTarget= Nothing, definedType= maybe (ProcedureType False [] Nothing) (signatureType . syn) signature'}@@ -539,7 +539,7 @@ of SynTCDes{errors= Folded [], designatorType= t} -> procedureErrors t SynTCDes{errors= errs} -> errs)- <> foldMap (foldMap (\p-> errors (syn p :: SynTCExp l))) parameters'}+ <> foldMap (foldMap ((.errors) . syn)) parameters'} where procedureErrors (ProcedureType _ formalTypes Nothing) | length formalTypes /= maybe 0 (length . getZipList) parameters, not (length formalTypes == 2 && (length . getZipList <$> parameters) == Just 1@@ -554,13 +554,13 @@ procedureErrors (NominalType _ (Just t)) = procedureErrors t procedureErrors t = Folded [Error () pos (NonProcedureType t)] synthesis _ (pos, _) _inheritance (AST.While condition body) =- SynTC{errors= booleanExpressionErrors pos (syn condition) <> errors (syn body :: SynTC l)}+ SynTC{errors= booleanExpressionErrors pos (syn condition) <> (syn body).errors} synthesis _ (pos, _) _inheritance (AST.Repeat body condition) =- SynTC{errors= booleanExpressionErrors pos (syn condition) <> errors (syn body :: SynTC l)}+ SynTC{errors= booleanExpressionErrors pos (syn condition) <> (syn body).errors} synthesis _ (pos, _) _inheritance (AST.For _counter start end step body) = SynTC{errors= integerExpressionErrors pos (syn start) <> integerExpressionErrors pos (syn end)- <> foldMap (integerExpressionErrors pos . syn) step <> errors (syn body :: SynTC l)}+ <> foldMap (integerExpressionErrors pos . syn) step <> (syn body).errors} synthesis t self _ statement = SynTC{errors= AG.foldedField (Proxy :: Proxy "errors") t statement} instance (Abstract.Nameable l, Ord (Abstract.QualIdent l),@@ -575,7 +575,7 @@ assignmentCompatible pos supertype subtypeDef (Nothing, _) -> Folded [Error () pos (UnknownName var)] (_, Nothing) -> Folded [Error () pos (UnknownName subtype)]- <> errors (syn body :: SynTC l)},+ <> (syn body).errors}, AST.WithAlternative var subtype (Inherited $ InhTC $ maybe id (Map.insert var) (Map.lookup subtype env) env)) instance (Abstract.Nameable l,@@ -583,7 +583,7 @@ Atts (Synthesized (Auto TypeCheck)) (Abstract.StatementSequence l l Sem Sem) ~ SynTC l) => Synthesizer (Auto TypeCheck) (AST.ConditionalBranch l l) Sem Placed where synthesis _ (pos, _) _inheritance (AST.ConditionalBranch condition body) =- SynTC{errors= booleanExpressionErrors pos (syn condition) <> errors (syn body :: SynTC l)}+ SynTC{errors= booleanExpressionErrors pos (syn condition) <> (syn body).errors} instance {-# overlaps #-} (Abstract.Nameable l, Eq (Abstract.QualIdent l), Atts (Synthesized (Auto TypeCheck)) (Abstract.ConstExpression l l Sem Sem) ~ SynTCExp l) =>@@ -602,7 +602,7 @@ Atts (Synthesized (Auto TypeCheck)) (Abstract.Designator l l Sem Sem) ~ SynTCDes l) => Synthesizer (Auto TypeCheck) (AST.Expression l l) Sem Placed where synthesis _ (pos, AST.Relation op _ _) InhTC{} (AST.Relation _op left right) =- SynTCExp{errors= case errors (syn left :: SynTCExp l) <> errors (syn right :: SynTCExp l)+ SynTCExp{errors= case (syn left).errors <> (syn right).errors of Folded [] | t1 == t2 -> mempty | AST.In <- op -> membershipCompatible (ultimate t1) (ultimate t2)@@ -672,10 +672,10 @@ SynTCExp{errors= mempty, inferredType= BuiltinType "SET"} synthesis (Auto TypeCheck) _self _ (AST.Read designator) =- SynTCExp{errors= errors (syn designator :: SynTCDes l),+ SynTCExp{errors= (syn designator).errors, inferredType= designatorType (syn designator)} synthesis (Auto TypeCheck) _self _ (AST.Literal value) =- SynTCExp{errors= errors (syn value :: SynTCExp l),+ SynTCExp{errors= (syn value).errors, inferredType= inferredType (syn value)} synthesis _ (pos, AST.FunctionCall _designator (ZipList parameters)) _inheritance (AST.FunctionCall designator (ZipList parameters')) =@@ -693,7 +693,7 @@ SynTCDes{errors= Folded [], designatorType= t} -> Folded [Error () pos (NonFunctionType t)] SynTCDes{errors= errs} -> errs- <> foldMap (\p-> errors (syn p :: SynTCExp l)) parameters',+ <> foldMap ((.errors) . syn) parameters', inferredType= case syn designator of SynTCDes{designatorName= Just (Just "SYSTEM", name)}@@ -983,9 +983,9 @@ Full.Functor (Auto TypeCheck) (Abstract.Block l l)) => Environment l -> Map AST.Ident (Placed (AST.Module l l Placed Placed)) -> [Error AST.Ident l] checkModules predef modules =- getFolded (errors (syn (Transformation.apply (Auto TypeCheck) (wrap $ Auto TypeCheck Deep.<$> Modules modules)+ getFolded ((syn (Transformation.apply (Auto TypeCheck) (wrap $ Auto TypeCheck Deep.<$> Modules modules) `Rank2.apply`- Inherited (InhTCRoot predef)) :: SynTCMods l))+ Inherited (InhTCRoot predef))).errors) where wrap = (,) (0, Trailing [], 0) predefined, predefined2 :: (Abstract.Wirthy l, Ord (Abstract.QualIdent l)) => Environment l