module Package ( Package(..), packageI, Prepackage(..), prepackageI, lowerTop ) where import Isomorphism -- Figure 3: Support code for packages -- The Package type is parameterized by five type variables: -- -- t The term type at the current level. This type is of the form -- "P3 (P2 (P1 TermZ))", where P3 is the term pseudomonad at the -- current level, and P2 and P1 are term pseudomonads below the -- current level. -- -- v The value type at the current level. This type is of the form -- "P3 (P2 (P1 ValueZ))", where P3 is the value pseudomonad at the -- current level, and P2 and P1 are value pseudomonads below the -- current level. -- -- t'' The term type at the top level. This type is of the form -- "((M & P5) & P4) (P3 (P2 (P1 TermZ)))", where P5 and P4 are -- the term pseudomonads above the current level. -- -- v'' The value type at the top level. This type is of the form -- "((M & P5) & P4) (P3 (P2 (P1 ValueZ)))", where P5 and P4 are -- the value pseudomonads above the current level. -- -- ve The type of values stored in the environment. -- -- Note that the following top-level term types are all isomorphic yet distinct -- with respect to the Haskell type system: -- -- (((((M & P5) & P4) & P3) & P2) & P1) TermZ -- t'' at level 0 -- ((((M & P5) & P4) & P3) & P2) (P1 TermZ) -- t'' at level 1 -- (((M & P5) & P4) & P3) (P2 (P1 TermZ)) -- t'' at level 2 -- ((M & P5) & P4) (P3 (P2 (P1 TermZ))) -- t'' at level 3 -- (M & P5) (P4 (P3 (P2 (P1 TermZ)))) -- t'' at level 4 -- M (P5 (P4 (P3 (P2 (P1 TermZ))))) -- t'' at level 5 -- P5 (P4 (P3 (P2 (P1 TermZ)))) -- M is the id monad -- -- Similarly, the following top-level value types are all isomorphic yet -- distinct: -- -- (((((M & P5) & P4) & P3) & P2) & P1) ValueZ -- v'' at level 0 -- ((((M & P5) & P4) & P3) & P2) (P1 ValueZ) -- v'' at level 1 -- (((M & P5) & P4) & P3) (P2 (P1 ValueZ)) -- v'' at level 2 -- ((M & P5) & P4) (P3 (P2 (P1 ValueZ))) -- v'' at level 3 -- (M & P5) (P4 (P3 (P2 (P1 ValueZ)))) -- v'' at level 4 -- M (P5 (P4 (P3 (P2 (P1 ValueZ)))))-- v'' at level 5 -- P5 (P4 (P3 (P2 (P1 ValueZ)))) -- M is the id monad -- -- As we work within Haskell's type system, we need to keep track of the -- isomorphisms between these various types. (Actually, there is one -- additional isomorphism to deal with, namely that introduced by FixF.) -- Steele defined a package as a list of routines. The list Steele -- constructed using his building blocks are actually heterogeneous -- and would not have passed the Haskell type checker if it were not -- for the program simplifier that Steele used to preprocess his code. -- Here We define a package as a record data type instead of a list -- of routines. -- Steele defined applyr to have type v'' -> v'' -> v''. Judging from -- figures 12 and 14, he seems to have meant v -> ve -> v''. data Package t v t'' v'' ve = Package { parser :: String -> [(t'', String)] , interpr :: t -> [(String, ve)] -> v'' , showvalr :: v -> String , complainr :: String -> v'' , makenumr :: Int -> v'' , makefunr :: (v'' -> v'') -> ve , applyr :: v -> ve -> v'' , namer :: String } -- packageI constructs an isomorphism between two Package types from -- five isomorphisms -- one for each type variable parameterizing the -- Package type. packageI :: Isomorphism t1 t2 -> Isomorphism v1 v2 -> Isomorphism t''1 t''2 -> Isomorphism v''1 v''2 -> Isomorphism ve1 ve2 -> Isomorphism (Package t1 v1 t''1 v''1 ve1) (Package t2 v2 t''2 v''2 ve2) packageI isomt isomv isomt'' isomv'' isomve = Isomorphism { iso = \p -> Package { parser = iso isom_parser $ parser p , interpr = iso isom_interpr $ interpr p , showvalr = iso isom_showvalr $ showvalr p , complainr = iso isom_complainr $ complainr p , makenumr = iso isom_makenumr $ makenumr p , makefunr = iso isom_makefunr $ makefunr p , applyr = iso isom_applyr $ applyr p , namer = iso isom_namer $ namer p } , osi = \p -> Package { parser = osi isom_parser $ parser p , interpr = osi isom_interpr $ interpr p , showvalr = osi isom_showvalr $ showvalr p , complainr = osi isom_complainr $ complainr p , makenumr = osi isom_makenumr $ makenumr p , makefunr = osi isom_makefunr $ makefunr p , applyr = osi isom_applyr $ applyr p , namer = osi isom_namer $ namer p } } where isom_parser = identityI =>= (mapI (isomt'' =|= identityI)) isom_interpr = isomt =>= (mapI (identityI =|= isomve)) =>= isomv'' isom_showvalr = isomv =>= identityI isom_complainr = identityI =>= isomv'' isom_makenumr = identityI =>= isomv'' isom_makefunr = (isomv'' =>= isomv'') =>= isomve isom_applyr = isomv =>= isomve =>= isomv'' isom_namer = identityI -- In Steele's formulation, a prepackage is simply a function taking -- the top package as argument and returning a package. In our code, a -- prepackage is comprised of this function plus two isomorphisms, one -- between top-level term types and one between top-level value types. -- For example, in a tower with 5 levels, a prepackage at level 3 has type -- -- Prepackage (Pt3 (Pt2 (Pt1 TermZ ))) --t -- (Pv3 (Pv2 (Pv1 ValueZ))) --v -- (((Mt & Pt5) & Pt4) (Pt3 (Pt2 (Pt1 TermZ )))) --t'' -- (((Mv & Pv5) & Pv4) (Pv3 (Pv2 (Pv1 ValueZ)))) --v'' -- ve --ve -- (FixF (((((Mt & Pt5) & Pt4) & Pt3) & Pt2) & Pt1) TermZ )--ut -- (FixF (((((Mv & Pv5) & Pv4) & Pv3) & Pv2) & Pv1) ValueZ)--uv -- -- It is a record with three items: -- -- isom_t'' :: Isomorphism t'' ut, i.e., an isomorphism -- between (((Mt & Pt5) & Pt4) (Pt3 (Pt2 (Pt1 TermZ )))) -- and (FixF (((((Mt & Pt5) & Pt4) & Pt3) & Pt2) & Pt1) TermZ ) -- -- isom_v'' :: Isomorphism v'' uv, i.e., an isomorphism -- between (((Mv & Pv5) & Pv4) (Pv3 (Pv2 (Pv1 ValueZ)))) -- and (FixF (((((Mv & Pv5) & Pv4) & Pv3) & Pv2) & Pv1) ValueZ) -- -- finalize :: Package ut uv ut uv ve -> Package t v t'' v'' ve data Prepackage t v t'' v'' ve ut uv = Prepackage { isom_t'' :: Isomorphism t'' ut , isom_v'' :: Isomorphism v'' uv , finalize :: Package ut uv ut uv ve -> Package t v t'' v'' ve } -- prepackageI constructs an isomorphism between two Prepackage types from -- seven isomorphisms -- one for each type variable parameterizing the -- Prepackage type. prepackageI :: Isomorphism t1 t2 -> Isomorphism v1 v2 -> Isomorphism t''1 t''2 -> Isomorphism v''1 v''2 -> Isomorphism ve1 ve2 -> Isomorphism ut1 ut2 -> Isomorphism uv1 uv2 -> Isomorphism (Prepackage t1 v1 t''1 v''1 ve1 ut1 uv1) (Prepackage t2 v2 t''2 v''2 ve2 ut2 uv2) prepackageI isomt isomv isomt'' isomv'' isomve isomut isomuv = Isomorphism { iso = \pp -> Prepackage { isom_t'' = iso isom_isom_t'' $ isom_t'' pp , isom_v'' = iso isom_isom_v'' $ isom_v'' pp , finalize = iso isom_finalize $ finalize pp } , osi = \pp -> Prepackage { isom_t'' = osi isom_isom_t'' $ isom_t'' pp , isom_v'' = osi isom_isom_v'' $ isom_v'' pp , finalize = osi isom_finalize $ finalize pp } } where isom_isom_t'' = isomorphismI isomt'' isomut isom_isom_v'' = isomorphismI isomv'' isomuv isom_finalize = packageI isomut isomuv isomut isomuv isomve =>= packageI isomt isomv isomt'' isomv'' isomve instance (Wrap t1 t2, Wrap v1 v2, Wrap t''1 t''2, Wrap v''1 v''2) => Wrap (Prepackage t1 v1 t''1 v''1 ve ut uv) (Prepackage t2 v2 t''2 v''2 ve ut uv) where wisom = prepackageI wisom wisom wisom wisom identityI identityI identityI -- Even though the "realTop" package (the one provided as input to the finalize -- function of each prepackage) is of type -- -- Package ut uv ut uv ve, -- -- it is often easier for each prepackage to work with an isomorphic "top" -- package, of type -- -- Package t'' v'' t'' v'' ve. -- -- The lowerTop function defined below encapsulates this transform. lowerTop :: Isomorphism t'' ut -> Isomorphism v'' uv -> Package ut uv ut uv ve -> Package t'' v'' t'' v'' ve lowerTop my_isom_t'' my_isom_v'' = osi (packageI my_isom_t'' my_isom_v'' my_isom_t'' my_isom_v'' identityI)