Commit 67e0dfe9 authored by Mart Lubbers's avatar Mart Lubbers Committed by Camil Staps

Remove qualified as

parent 7ef2ae97
......@@ -28,7 +28,7 @@ import Text.Language
import Text.Parsers.Simple.ParserCombinators
from Clean.Types import :: Type, :: TypeRestriction
import qualified Clean.Types.Parse as T
from Clean.Types.Parse import parseType
from Clean.Types.Util import instance toString Type
gDefault{|Maybe|} _ = Nothing
......@@ -171,7 +171,7 @@ where
docBlockToDoc{|ParamDoc|} _ = abort "error in docBlockToDoc{|ParamDoc|}\n"
docBlockToDoc{|Type|} (Left []) = Left InternalNoDataError
docBlockToDoc{|Type|} (Left ss) = case [v \\ Just v <- map ('T'.parseType o fromString) ss] of
docBlockToDoc{|Type|} (Left ss) = case [v \\ Just v <- map (parseType o fromString) ss] of
[] -> Left (UnknownError "no parsable type")
vs -> Right (last vs, [])
docBlockToDoc{|Type|} _ = abort "error in docBlockToDoc{|Type|}\n"
......@@ -201,7 +201,7 @@ where
skipSpaces = pMany (pSatisfy isSpace) *> pYield undef
pTypeWithColonOrSemicolon = (pMany (pSatisfy \c -> c <> ':' && c <> ';') <* pOneOf [':;'])
>>= \t -> case 'T'.parseType t of
>>= \t -> case parseType t of
Nothing -> pError "type could not be parsed"
Just t -> pure t
......@@ -210,13 +210,13 @@ where
docBlockToDoc{|Property|} _ = abort "error in docBlockToDoc{|Property|}\n"
docBlockToDoc{|PropertyVarInstantiation|} (Left [s]) = case split "=" s of
[var:type:[]] -> case 'T'.parseType (fromString type) of
[var:type:[]] -> case parseType (fromString type) of
Just t -> Right (PropertyVarInstantiation (trim var, t), [])
Nothing -> Left (UnknownError "type could not be parsed")
_ -> Left (UnknownError "property var instantiation could not be parsed")
docBlockToDoc{|PropertyVarInstantiation|} _ = abort "error in docBlockToDoc{|PropertyVarInstantiation|}\n"
docBlockToDoc{|PropertyTestGenerator|} (Left [s]) = case 'T'.parseType (fromString sig) of
docBlockToDoc{|PropertyTestGenerator|} (Left [s]) = case parseType (fromString sig) of
Just t -> Right (PropertyTestGenerator t (trimMultiLine imp), [])
Nothing -> Left (UnknownError "type could not be parsed")
where
......
......@@ -13,8 +13,7 @@ import StdTuple
import Control.Monad
import Data.Error
import Data.Functor
from Data.Map import :: Map
import qualified Data.Map as M
from Data.Map import :: Map(..), newMap, put, get
import Data.Maybe
import System.File
import System.FilePath
......@@ -226,17 +225,17 @@ instance < CommentIndex where < (CI a b c) (CI d e f) = (a,b,c) < (d,e,f)
putCC k v coll :== case commentIndex k of
Nothing -> coll
Just k -> 'M'.put k v coll
Just k -> put k v coll
emptyCollectedComments :: CollectedComments
emptyCollectedComments = 'M'.newMap
emptyCollectedComments = newMap
getComment :: !a !CollectedComments -> Maybe String | commentIndex a
getComment elem coll = (\cc -> cc.content) <$> (flip 'M'.get coll =<< commentIndex elem)
getComment elem coll = (\cc -> cc.content) <$> (flip get coll =<< commentIndex elem)
collectComments :: ![CleanComment] !ParsedModule -> CollectedComments
collectComments comments pm
# coll = 'M'.newMap
# coll = newMap
# (comments,coll) = case comments of
[] -> ([], coll)
[c:cs]
......
......@@ -10,7 +10,7 @@ definition module Clean.Types.CoclTransform
from Clean.Types import class toType, class toTypeVar, class toTypeDef,
class toTypeDefRhs, class toConstructor, class toRecordField,
class toTypeContext, class toMaybePriority
import qualified Clean.Types as T
import qualified Clean.Types
from Data.Maybe import :: Maybe
// Clean compiler frontend
......@@ -30,4 +30,4 @@ instance toConstructor 'syntax'.ParsedConstructor
instance toRecordField 'syntax'.ParsedSelector
instance toMaybePriority 'syntax'.Priority
pdType :: !'syntax'.ParsedDefinition -> Maybe 'T'.Type
pdType :: !'syntax'.ParsedDefinition -> Maybe 'Clean.Types'.Type
......@@ -5,7 +5,7 @@ from StdList import map
from Clean.Types import class toType, class toTypeVar, class toTypeDef,
class toTypeDefRhs, class toConstructor, class toRecordField,
::TypeRestriction
import qualified Clean.Types as T
import qualified Clean.Types
import Control.Applicative
import Control.Monad
import Control.Monad.State
......@@ -17,103 +17,103 @@ import qualified Data.Map as M
import syntax
import qualified syntax
instance 'T'.toTypeContext ['syntax'.TypeContext]
instance 'Clean.Types'.toTypeContext ['syntax'.TypeContext]
where
toTypeContext context
= ['T'.Instance gds.glob_object.ds_ident.id_name (map 'T'.toType tc_types)
= ['Clean.Types'.Instance gds.glob_object.ds_ident.id_name (map 'Clean.Types'.toType tc_types)
\\ {tc_class=(TCClass gds),tc_types} <- context] ++
['T'.Derivation gtc_generic.glob_object.ds_ident.id_name ('T'.toType t)
['Clean.Types'.Derivation gtc_generic.glob_object.ds_ident.id_name ('Clean.Types'.toType t)
\\ {tc_class=(TCGeneric {gtc_generic}),tc_types=[t]} <- context]
instance 'T'.toTypeContext 'syntax'.TypeContext where toTypeContext tc = 'T'.toTypeContext [tc]
instance 'Clean.Types'.toTypeContext 'syntax'.TypeContext where toTypeContext tc = 'Clean.Types'.toTypeContext [tc]
instance toType 'syntax'.ATypeVar
where
toType {atv_attribute=TA_Unique,atv_variable}
= 'T'.Uniq ('T'.Var ('T'.toTypeVar atv_variable))
toType {atv_variable} = 'T'.Var ('T'.toTypeVar atv_variable)
= 'Clean.Types'.Uniq ('Clean.Types'.Var ('Clean.Types'.toTypeVar atv_variable))
toType {atv_variable} = 'Clean.Types'.Var ('Clean.Types'.toTypeVar atv_variable)
instance toType 'syntax'.AType
where
toType {at_type,at_attribute}
| at_attribute == TA_Unique = 'T'.Uniq ('T'.toType at_type)
| otherwise = 'T'.toType at_type
| at_attribute == TA_Unique = 'Clean.Types'.Uniq ('Clean.Types'.toType at_type)
| otherwise = 'Clean.Types'.toType at_type
instance toType 'syntax'.Type
where
toType (TA tsi ats) = case tsi.type_ident.id_name of
"_String" = 'T'.Type "String" []
type_name = 'T'.Type tsi.type_ident.id_name (map 'T'.toType ats)
toType (TAS tsi ats ss) = 'T'.Type tsi.type_ident.id_name
[if s 'T'.Strict id ('T'.toType t) \\ t <- ats & s <- strictnessListToBools ss]
toType (TB bt) = 'T'.Type (toString bt) []
toType (TV tv) = 'T'.Var tv.tv_ident.id_name
toType (GTV tv) = 'T'.Var tv.tv_ident.id_name
toType (t1 --> t2) = 'T'.Func ['T'.toType t1] ('T'.toType t2) []
toType ((CV cv) :@: ats) = 'T'.Cons cv.tv_ident.id_name (map 'T'.toType ats)
toType (TFAC tvas t tc) = 'T'.Forall (map 'T'.toType tvas) ('T'.toType t) ('T'.toTypeContext tc)
toType TArrow = 'T'.Arrow Nothing
toType (TArrow1 t) = 'T'.Arrow (Just ('T'.toType t))
toType (TQualifiedIdent _ s ts) = 'T'.Type s (map 'T'.toType ts)
"_String" = 'Clean.Types'.Type "String" []
type_name = 'Clean.Types'.Type tsi.type_ident.id_name (map 'Clean.Types'.toType ats)
toType (TAS tsi ats ss) = 'Clean.Types'.Type tsi.type_ident.id_name
[if s 'Clean.Types'.Strict id ('Clean.Types'.toType t) \\ t <- ats & s <- strictnessListToBools ss]
toType (TB bt) = 'Clean.Types'.Type (toString bt) []
toType (TV tv) = 'Clean.Types'.Var tv.tv_ident.id_name
toType (GTV tv) = 'Clean.Types'.Var tv.tv_ident.id_name
toType (t1 --> t2) = 'Clean.Types'.Func ['Clean.Types'.toType t1] ('Clean.Types'.toType t2) []
toType ((CV cv) :@: ats) = 'Clean.Types'.Cons cv.tv_ident.id_name (map 'Clean.Types'.toType ats)
toType (TFAC tvas t tc) = 'Clean.Types'.Forall (map 'Clean.Types'.toType tvas) ('Clean.Types'.toType t) ('Clean.Types'.toTypeContext tc)
toType TArrow = 'Clean.Types'.Arrow Nothing
toType (TArrow1 t) = 'Clean.Types'.Arrow (Just ('Clean.Types'.toType t))
toType (TQualifiedIdent _ s ts) = 'Clean.Types'.Type s (map 'Clean.Types'.toType ts)
toType _ = abort "CoclUtils: unimplemented Type\n"
instance toType 'syntax'.SymbolType
where
toType {st_args,st_result,st_context,st_args_strictness}
= 'T'.Func [if s 'T'.Strict id ('T'.toType t) \\ t <- st_args & s <- strictnessListToBools st_args_strictness]
('T'.toType st_result) ('T'.toTypeContext st_context)
= 'Clean.Types'.Func [if s 'Clean.Types'.Strict id ('Clean.Types'.toType t) \\ t <- st_args & s <- strictnessListToBools st_args_strictness]
('Clean.Types'.toType st_result) ('Clean.Types'.toTypeContext st_context)
instance toTypeVar 'syntax'.TypeVar where toTypeVar {tv_ident} = tv_ident.id_name
instance toTypeDef 'syntax'.ParsedTypeDef
where
toTypeDef {td_ident,td_attribute,td_args,td_rhs}
= 'T'.typedef td_ident.id_name
= 'Clean.Types'.typedef td_ident.id_name
(td_attribute == TA_Unique)
(map 'T'.toType td_args)
('T'.toTypeDefRhs td_rhs)
(map 'Clean.Types'.toType td_args)
('Clean.Types'.toTypeDefRhs td_rhs)
instance toTypeDefRhs 'syntax'.RhsDefsOfType
where
toTypeDefRhs (ConsList pcs)
= 'T'.TDRCons False (map 'T'.toConstructor pcs)
= 'Clean.Types'.TDRCons False (map 'Clean.Types'.toConstructor pcs)
toTypeDefRhs (SelectorList id exi_vars _ pss)
= 'T'.TDRRecord id.id_name
(map (\t -> 'T'.toTypeVar t.atv_variable) exi_vars)
(map 'T'.toRecordField pss)
= 'Clean.Types'.TDRRecord id.id_name
(map (\t -> 'Clean.Types'.toTypeVar t.atv_variable) exi_vars)
(map 'Clean.Types'.toRecordField pss)
toTypeDefRhs (TypeSpec atype)
= 'T'.TDRSynonym ('T'.toType atype)
= 'Clean.Types'.TDRSynonym ('Clean.Types'.toType atype)
toTypeDefRhs (NewTypeCons cons)
= 'T'.TDRNewType ('T'.toConstructor cons)
= 'Clean.Types'.TDRNewType ('Clean.Types'.toConstructor cons)
toTypeDefRhs (EmptyRhs _)
= 'T'.TDRAbstract Nothing
= 'Clean.Types'.TDRAbstract Nothing
toTypeDefRhs (AbstractTypeSpec _ atype)
= 'T'.TDRAbstractSynonym ('T'.toType atype)
= 'Clean.Types'.TDRAbstractSynonym ('Clean.Types'.toType atype)
toTypeDefRhs (ExtensibleConses pcs)
= 'T'.TDRCons True (map 'T'.toConstructor pcs)
= 'Clean.Types'.TDRCons True (map 'Clean.Types'.toConstructor pcs)
toTypeDefRhs (MoreConses id pcs)
= 'T'.TDRMoreConses (map 'T'.toConstructor pcs)
= 'Clean.Types'.TDRMoreConses (map 'Clean.Types'.toConstructor pcs)
instance toConstructor 'syntax'.ParsedConstructor
where
toConstructor {pc_cons_ident,pc_arg_types,pc_args_strictness,pc_exi_vars,pc_context,pc_cons_prio}
= 'T'.constructor pc_cons_ident.id_name
[if s 'T'.Strict id ('T'.toType t) \\ t <- pc_arg_types & s <- strictnessListToBools pc_args_strictness]
(map (\t -> 'T'.toTypeVar t.atv_variable) pc_exi_vars)
('T'.toTypeContext pc_context)
('T'.toMaybePriority pc_cons_prio)
= 'Clean.Types'.constructor pc_cons_ident.id_name
[if s 'Clean.Types'.Strict id ('Clean.Types'.toType t) \\ t <- pc_arg_types & s <- strictnessListToBools pc_args_strictness]
(map (\t -> 'Clean.Types'.toTypeVar t.atv_variable) pc_exi_vars)
('Clean.Types'.toTypeContext pc_context)
('Clean.Types'.toMaybePriority pc_cons_prio)
instance 'T'.toMaybePriority 'syntax'.Priority
instance 'Clean.Types'.toMaybePriority 'syntax'.Priority
where
toMaybePriority NoPrio = Nothing
toMaybePriority (Prio LeftAssoc i) = Just ('T'.LeftAssoc i)
toMaybePriority (Prio RightAssoc i) = Just ('T'.RightAssoc i)
toMaybePriority (Prio NoAssoc i) = Just ('T'.NoAssoc i)
toMaybePriority (Prio LeftAssoc i) = Just ('Clean.Types'.LeftAssoc i)
toMaybePriority (Prio RightAssoc i) = Just ('Clean.Types'.RightAssoc i)
toMaybePriority (Prio NoAssoc i) = Just ('Clean.Types'.NoAssoc i)
instance toRecordField 'syntax'.ParsedSelector
where
toRecordField {ps_selector_ident,ps_field_type,ps_field_annotation}
= 'T'.recordfield ps_selector_ident.id_name (if ps_field_annotation=:AN_Strict 'T'.Strict id ('T'.toType ps_field_type))
= 'Clean.Types'.recordfield ps_selector_ident.id_name (if ps_field_annotation=:AN_Strict 'Clean.Types'.Strict id ('Clean.Types'.toType ps_field_type))
strictnessListToBools :: !StrictnessList -> [Bool]
strictnessListToBools NotStrict = repeat False
......@@ -123,15 +123,15 @@ strictnessListToBools (StrictList i l) = strictnessListToBools (Strict i) ++ str
:: TypeDerivState =
{ tds_var_index :: Int
, tds_allows_new_idents :: Bool
, tds_map :: 'M'.Map String 'T'.Type
, tds_map :: 'M'.Map String 'Clean.Types'.Type
}
tds_var_index tds = tds.tds_var_index
tds_allows_new_idents tds = tds.tds_allows_new_idents
tds_map tds = tds.tds_map
class coclType a :: !a -> StateT TypeDerivState Maybe 'T'.Type
class coclType a :: !a -> StateT TypeDerivState Maybe 'Clean.Types'.Type
store :: !String !'T'.Type -> StateT TypeDerivState Maybe 'T'.Type
store :: !String !'Clean.Types'.Type -> StateT TypeDerivState Maybe 'Clean.Types'.Type
store id t = modify (\tds -> {tds & tds_map='M'.put id t tds.tds_map}) $> t
allowNewIdents :: !Bool -> StateT TypeDerivState Maybe ()
......@@ -140,7 +140,7 @@ allowNewIdents b = modify \tds -> {tds & tds_allows_new_idents=b}
fail :: StateT a Maybe b
fail = StateT \_ -> Nothing
pdType :: !'syntax'.ParsedDefinition -> Maybe 'T'.Type
pdType :: !'syntax'.ParsedDefinition -> Maybe 'Clean.Types'.Type
pdType pd = evalStateT (coclType pd)
{ tds_var_index = 0
, tds_allows_new_idents = True
......@@ -154,7 +154,7 @@ where
mapM coclType args >>= \argts ->
allowNewIdents False >>|
coclType ewl_expr >>= \rt ->
store id ('T'.Func argts rt [])
store id ('Clean.Types'.Func argts rt [])
coclType _
= fail
......@@ -169,16 +169,16 @@ where
fail
Just t -> pure t
where
var :: Int -> 'T'.Type
var n = 'T'.Var (if (n < 26) {toChar n + 'a'} ("v" +++ toString n))
var :: Int -> 'Clean.Types'.Type
var n = 'Clean.Types'.Var (if (n < 26) {toChar n + 'a'} ("v" +++ toString n))
coclType _ = fail
instance coclType 'syntax'.BasicValue
where
coclType (BVI _) = pure ('T'.Type "Int" [])
coclType (BVInt _) = pure ('T'.Type "Int" [])
coclType (BVC _) = pure ('T'.Type "Char" [])
coclType (BVB _) = pure ('T'.Type "Bool" [])
coclType (BVR _) = pure ('T'.Type "Real" [])
coclType (BVS _) = pure ('T'.Type "String" [])
coclType (BVI _) = pure ('Clean.Types'.Type "Int" [])
coclType (BVInt _) = pure ('Clean.Types'.Type "Int" [])
coclType (BVC _) = pure ('Clean.Types'.Type "Char" [])
coclType (BVB _) = pure ('Clean.Types'.Type "Bool" [])
coclType (BVR _) = pure ('Clean.Types'.Type "Real" [])
coclType (BVS _) = pure ('Clean.Types'.Type "String" [])
......@@ -15,7 +15,7 @@ from Data.Func import $
import Data.Functor
import Data.GenEq
import Data.List
import qualified Data.Map as M
from Data.Map import :: Map(..), get
import Data.Maybe
import Data.Tuple
from Text import class Text (concat), instance Text String
......@@ -191,7 +191,7 @@ propagate_uniqueness p (Strict t)
propagate_uniqueness p t
= t
resolve_synonyms :: ('M'.Map String [TypeDef]) !Type -> ([TypeDef], Type)
resolve_synonyms :: (Map String [TypeDef]) !Type -> ([TypeDef], Type)
resolve_synonyms tds (Type t ts)
# (syns, ts) = appFst (removeDupTypedefs o flatten) $ unzip $ map (resolve_synonyms tds) ts
= case candidates of
......@@ -210,7 +210,7 @@ resolve_synonyms tds (Type t ts)
-> appFst ((++) [syn:syns]) $ resolve_synonyms tds t
_ -> abort "error in resolve_synonyms_Type\n"
where
candidates = [td \\ td=:{td_rhs=TDRSynonym syn} <- fromMaybe [] $ 'M'.get t tds
candidates = [td \\ td=:{td_rhs=TDRSynonym syn} <- fromMaybe [] $ get t tds
| length td.td_args <= tslen && (isType syn || length td.td_args == tslen)]
where tslen = length ts
resolve_synonyms tds (Func is r tc)
......@@ -276,7 +276,7 @@ reduceArities (Forall tvs t tc) = Forall tvs (reduceArities t) tc
reduceArities (Arrow mt) = Arrow (reduceArities <$> mt)
reduceArities (Strict t) = Strict $ reduceArities t
normalise_type :: (String -> Bool) !('M'.Map String [TypeDef]) !Type -> (!Type, ![TypeDef], ![TypeVar])
normalise_type :: (String -> Bool) !(Map String [TypeDef]) !Type -> (!Type, ![TypeDef], ![TypeVar])
normalise_type alwaysUnique tds t
# t = reduceArities t
# (syns,t) = resolve_synonyms tds t
......
implementation module Codec.Compression.Snappy
import StdClass
import StdInt
import StdMisc
import StdString
import StdEnv
import Data._Array
import System._Pointer
import System._Pointer, Data._Array
import Text
snappy_max_compressed_length :: !Int -> Int
......@@ -28,7 +24,7 @@ where
snappy_compress :: !.String -> .String
snappy_compress s
#! n = snappy_max_compressed_length (size s)
#! c = createArrayUnsafe (n+1)
#! c = unsafeCreateArray (n+1)
#! (r,len) = compress s (size s) c
| r <> 0 = abort ("Invalid return status of snappy_compress: " <+ r <+ "\n")
= {c \\ c <-: c & i <- [0..len-1]}
......@@ -41,7 +37,7 @@ where
snappy_uncompress :: !.String -> .String
snappy_uncompress s
#! n = snappy_uncompressed_length s
#! u = createArrayUnsafe (n+1)
#! u = unsafeCreateArray (n+1)
#! (r,len) = uncompress s (size s) u
| r <> 0 = abort ("Invalid return status of snappy_uncompress: " <+ r <+ "\n")
= {c \\ c <-: u & i <- [0..len-1]}
......
......@@ -2,8 +2,7 @@ implementation module Control.Applicative
import Control.Monad
import Data.Func, Data.Functor, System.IO, Data.List, Data.Maybe
from Data.Monoid import class Monoid, class Semigroup
import qualified Data.Monoid as DM
import Data.Monoid
from StdFunc import id, o, flip, const
class Applicative f | Functor f
......@@ -24,14 +23,14 @@ instance Functor (Const m) where
fmap _ (Const v) = Const v
instance Semigroup (Const a b) | Semigroup a where
mappend (Const a) (Const b) = Const ('DM'.mappend a b)
mappend (Const a) (Const b) = Const (mappend a b)
instance Monoid (Const a b) | Monoid a where
mempty = Const 'DM'.mempty
mempty = Const mempty
instance Applicative (Const m) | Monoid m where
pure _ = Const 'DM'.mempty
(<*>) (Const f) (Const v) = Const ('DM'.mappend f v)
pure _ = Const mempty
(<*>) (Const f) (Const v) = Const (mappend f v)
unwrapMonad :: !(WrappedMonad m a) -> m a
unwrapMonad (WrapMonad x) = x
......
implementation module Control.GenFMap
import StdGeneric, StdEnv, Data._Array, Control.GenMonad
import StdGeneric, StdEnv, Control.GenMonad
from Data.Maybe import :: Maybe(..)
derive bimap (,), []
......@@ -32,7 +32,6 @@ updateAssocList key value default_val [(k,v):xs]
= (old_val, [(k, v) : xs])
derive bimap FMap, Maybe
bimap{|{}|} bma = {map_to = mapArray bma.map_to, map_from = mapArray bma.map_from}
generic gLookupFMap key :: key (FMap value) -> FMap value
gLookupFMap{|Char|} key (FMChar xs) = lookupAssocList key FMEmpty xs
......
implementation module Control.GenMap
import StdClass, StdArray, StdInt, StdFunc
import StdGeneric, Data._Array
import StdGeneric
generic gMap a b :: .a -> .b
gMap{|c|} x = x
......@@ -12,7 +12,7 @@ gMap{|EITHER|} fl fr (RIGHT x) = RIGHT (fr x)
gMap{|CONS|} f (CONS x) = CONS (f x)
gMap{|FIELD|} f (FIELD x) = FIELD (f x)
gMap{|OBJECT|} f (OBJECT x) = OBJECT (f x)
gMap{|{}|} f xs = mapArray f xs
gMap{|{!}|} f xs = mapArray f xs
gMap{|{}|} f xs = {f x\\x<-:xs}
gMap{|{!}|} f xs = {f x\\x<-:xs}
derive gMap [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
implementation module Control.GenMapSt
import StdGeneric, Data._Array
derive bimap (,)
import StdGeneric, StdEnv, Data.Array, Data._Array
generic gMapLSt a b :: .a .st -> (.b, .st)
gMapLSt{|c|} x st = (x, st)
gMapLSt{|UNIT|} _ st = (UNIT, st)
gMapLSt{|PAIR|} fx fy (PAIR x y) st
# (x, st) = fx x st
# (y, st) = fy y st
= (PAIR x y, st)
# (x, st) = fx x st
# (y, st) = fy y st
= (PAIR x y, st)
gMapLSt{|EITHER|} fl fr x st = mapStEITHER fl fr x st
gMapLSt{|CONS|} f x st = mapStCONS f x st
gMapLSt{|FIELD|} f x st = mapStFIELD f x st
......@@ -23,11 +21,11 @@ derive gMapLSt [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
generic gMapRSt a b :: .a .st -> (.b, .st)
gMapRSt{|c|} x st = (x, st)
gMapRSt{|UNIT|} _ st = (UNIT, st)
gMapRSt{|PAIR|} fx fy (PAIR x y) st
# (y, st) = fy y st
# (x, st) = fx x st
= (PAIR x y, st)
gMapRSt{|EITHER|} fx fy x st = mapStEITHER fx fy x st
gMapRSt{|PAIR|} fx fy (PAIR x y) st
# (y, st) = fy y st
# (x, st) = fx x st
= (PAIR x y, st)
gMapRSt{|EITHER|} fx fy x st = mapStEITHER fx fy x st
gMapRSt{|CONS|} f x st = mapStCONS f x st
gMapRSt{|FIELD|} f x st = mapStFIELD f x st
gMapRSt{|OBJECT|} f x st = mapStOBJECT f x st
......@@ -36,19 +34,46 @@ gMapRSt{|{!}|} f x st = mapArrayRSt f x st
derive gMapRSt [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
mapStEITHER fl fr (LEFT x) st
# (x, st) = fl x st
# (x, st) = fl x st
= (LEFT x, st)
mapStEITHER fl fr (RIGHT x) st
# (x, st) = fr x st
# (x, st) = fr x st
= (RIGHT x, st)
mapStCONS f (CONS x) st
# (x, st) = f x st
# (x, st) = f x st
= (CONS x, st)
mapStFIELD f (FIELD x) st
# (x, st) = f x st
= (FIELD x, st)
mapStOBJECT f (OBJECT x) st
# (x, st) = f x st
= (OBJECT x, st)
mapStFIELD f (FIELD x) st
# (x, st) = f x st
= (FIELD x, st)
mapStOBJECT f (OBJECT x) st
# (x, st) = f x st