Verified Commit 6b970942 authored by Camil Staps's avatar Camil Staps 🚀

Add support for abstract newtypes to Clean.Types

parent e8aabfa0
Pipeline #41521 passed with stage
in 1 minute and 48 seconds
......@@ -85,6 +85,7 @@ from StdMaybe import :: Maybe
//* A record with its internal identifier, existentially quantified variables and fields
| TDRSynonym !Type //* A type synonym
| TDRAbstract !(Maybe TypeDefRhs) //* An abstract type
| TDRAbstractNewType !Constructor //* An abstract newtype
| TDRAbstractSynonym !Type //* An abstract type synonym
/**
......
......@@ -200,10 +200,11 @@ removeTypeContexts (Strict t) = Strict (removeTypeContexts t)
constructorsToFunctions :: !TypeDef -> [(String,Type,Maybe Priority)]
constructorsToFunctions {td_name,td_uniq,td_args,td_rhs} = case td_rhs of
TDRCons _ conses -> map consfun conses
TDRMoreConses conses -> map consfun conses
TDRNewType cons -> [consfun cons]
_ -> []
TDRCons _ conses -> map consfun conses
TDRMoreConses conses -> map consfun conses
TDRNewType cons -> [consfun cons]
TDRAbstractNewType cons -> [consfun cons]
_ -> []
where
consfun :: !Constructor -> (String, Type, Maybe Priority)
consfun c = (c.cons_name, Func c.cons_args ret c.cons_context, c.cons_priority)
......@@ -256,4 +257,5 @@ typeRhsRestrictions (TDRMoreConses cs) = flatten [c \\ {cons_context=TypeContext
typeRhsRestrictions (TDRRecord _ _ _) = []
typeRhsRestrictions (TDRSynonym _) = []
typeRhsRestrictions (TDRAbstract _) = []
typeRhsRestrictions (TDRAbstractNewType {cons_context=TypeContext c}) = c
typeRhsRestrictions (TDRAbstractSynonym _) = []
......@@ -91,6 +91,8 @@ where
= 'Clean.Types'.TDRAbstract Nothing
toTypeDefRhs (AbstractTypeSpec _ atype)
= 'Clean.Types'.TDRAbstractSynonym ('Clean.Types'.toType atype)
toTypeDefRhs (AbstractNewTypeCons _ atype)
= 'Clean.Types'.TDRAbstractNewType ('Clean.Types'.toType atype)
toTypeDefRhs (ExtensibleConses pcs)
= 'Clean.Types'.TDRCons True (map 'Clean.Types'.toConstructor pcs)
toTypeDefRhs (MoreConses id pcs)
......
......@@ -118,6 +118,7 @@ where
print _ (TDRSynonym t) = " :== " -- t
print _ (TDRAbstract Nothing) = []
print _ (TDRAbstract (Just rhs)) = " /*" -- rhs -- " */"
print _ (TDRAbstractNewType c) = " (=: " -- c -- ")"
print _ (TDRAbstractSynonym t) = " (:== " -- t -- ")"
printADT :: !Bool ![Constructor] -> String
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment