Commit 436f5c87 authored by bbr's avatar bbr
Browse files

showing qualified terms seems to work

parent 0f3fa783
......@@ -426,8 +426,9 @@ inst newModName name vars classname =
[C.TCons (newModName,name) (map toTVar vars)])
curryInstance opts (Type origName vis vars consdecls)
= inst newModName name vars "Curry" [strEq,eq,propagate,foldCurry,typeName] --toTerm,fromTerm
curryInstance opts t@(Type origName vis vars consdecls)
= inst newModName name vars "Curry"
[strEq,eq,propagate,foldCurry,typeName,showFunction True opts t] --toTerm,fromTerm
where
(newModName,name) = consName opts origName
......@@ -785,40 +786,57 @@ genInstances cl genFunc opts (t:ts)
| otherwise = genFunc opts{consUse=InstanceDef} t :
genInstances cl genFunc opts ts
showInstance opts (Type origName vis vars consdecls) =
showInstance opts t@(Type origName vis vars consdecls) =
C.Instance (map (\v -> C.TypeClass (has "Show") [toTVar v]) vars)
(C.TypeClass (has "Show") [C.TCons (newModName,name) (map toTVar vars)])
[if isTuple (snd origName) then showTuple else showsPrec]
[showFunction False opts t]
where
(newModName,name) = consName opts origName
showsPrec = C.Func (newModName,"showsPrec") (transvis vis) untyped
(Just (map showsPrecRule consdecls++[showFreeVar]))
showsPrecRule (Cons cname@(_,cn) 0 _ []) =
showFunction showQ opts t@(Type origName vis vars consdecls)
| maybe False (elem Show) (lookup (snd $ typeName t) (extInsts opts))
= showsPrec [C.Rule [] (C.SimpleExpr (hasPresym "showsPrec")) []]
| otherwise = if isTuple (snd origName)
then showTuple
else showsPrec (map showsPrecRule consdecls++[showFreeVar])
where
showsPrecName = if showQ then "showQ" else "showsPrec"
showsPrecSym = (if showQ then extInstPresym (fst origName=="Prelude")
else hasPresym) showsPrecName
identifier (cm,cn) = if showQ then cm++"."++cn else cn
showsPrec rs = C.Func (newModName,showsPrecName)
(transvis vis) untyped
(Just rs)
(newModName,name) = consName opts origName
showsPrecRule (Cons cname 0 _ []) =
C.Rule [_x, C.PComb (consName opts cname) []]
(C.SimpleExpr
(app (hasPresym "showString") (string_ cn))) []
showsPrecRule (Cons cname@(m,n) arity _ args) =
(app (hasPresym "showString") (string_ (identifier cname)))) []
showsPrecRule (Cons cname arity _ args) =
C.Rule [C.PVar "d", C.PComb (consName opts cname) (map toPVar [1..arity])]
(C.SimpleExpr (fapp (hasPresym "showParen")
[lt (C.Var "d") app_prec,sym ("","showStr")]))
[C.LocalFunc (C.Func ("","showStr") (transvis vis) untyped
(Just [C.Rule [] (C.SimpleExpr showStr) []]))]
where
showStr = points (app (hasPresym "showString") (string_ (n++" ")):
showStr = points (app (hasPresym "showString") (string_ (identifier cname++" ")):
intersperse
(app (hasPresym "showString") (string_ " "))
(map callShowsPrec [1..arity]))
callShowsPrec i = fapp (hasPresym "showsPrec") [add_prec,toVar i]
callShowsPrec i = fapp showsPrecSym [add_prec,toVar i]
points = foldr1 point
point x y = fapp (hasPresym ".") [x,y]
showTuple = C.Func (newModName,"showsPrec") (transvis vis) untyped
showTuple = C.Func (newModName,showsPrecName) (transvis vis) untyped
(Just (map showTupleRule consdecls++[showFreeVar]))
showTupleRule (Cons cname arity _ args) =
......
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