implementation module SaplStruct import StdEnv, Map, Void, Error ltVarByName :: !SaplVar !SaplVar -> Bool ltVarByName a b = unpackVar a < unpackVar b eqVarByName :: !SaplVar !SaplVar -> Bool eqVarByName a b = unpackVar a == unpackVar b eqVarByNameLevel :: !SaplVar !SaplVar -> Bool eqVarByNameLevel a b = unpackVar a == unpackVar b && unpackLevel a == unpackLevel b ltVarByNameLevel :: !SaplVar !SaplVar -> Bool ltVarByNameLevel a b = unpackVar a < unpackVar b || (unpackVar a == unpackVar b && unpackLevel a < unpackLevel b) unpackLevel (NormalVar _ level) = level unpackLevel (StrictVar _ level) = level instance toString SaplVar where toString (NormalVar name 0) = name toString (NormalVar name level) = name +++ "_" +++ toString level toString (StrictVar name 0) = "!" +++ name toString (StrictVar name level) = "!" +++ name +++ "_" +++ toString level isStrictVar :: !SaplVar -> Bool isStrictVar (StrictVar _ _) = True isStrictVar _ = False eqStrictVar :: !String !SaplVar -> Bool eqStrictVar name1 (StrictVar name2 _) = name1 == name2 eqStrictVar _ _ = False toNormalVar :: !SaplVar -> SaplVar toNormalVar (StrictVar name level) = (NormalVar name level) toNormalVar v = v toStrictVar :: !SaplVar -> SaplVar toStrictVar (NormalVar name level) = (StrictVar name level) toStrictVar v = v unpackVar :: !SaplVar -> String unpackVar (NormalVar name _) = name unpackVar (StrictVar name _) = name unpackBindVar :: !SaplLetDef -> SaplVar unpackBindVar (SaplLetDef var _) = var toStrictBind :: !SaplLetDef -> SaplLetDef toStrictBind (SaplLetDef var body) = SaplLetDef (toStrictVar var) body unpackConsName :: !SaplPattern -> Maybe String unpackConsName (PCons cons _) = Just cons unpackConsName _ = Nothing isConsPattern :: !SaplPattern -> Bool isConsPattern (PCons _ _) = True isConsPattern _ = False isDefaultPattern :: !SaplPattern -> Bool isDefaultPattern PDefault = True isDefaultPattern _ = False