Commit 2e7ea4cb authored by Bernd Brassel's avatar Bernd Brassel
Browse files

prelude and simple modules compile

parent a907e126
......@@ -37,26 +37,19 @@ CY = $(CYMAKEBIN) -e
LIBS = $(shell $(BIN)kicslib)
KICS = $(BIN)kics -nouserlibpath -v 6 -make
SRCS = $(SRC)kics.hs $(SRC)kicsi.hs $(SRC)Generate.hs $(SRC)kicslib.hs
SRCS = $(SRC)kics.hs $(SRC)kicsi.hs $(SRC)kicslib.hs
########################################################
## the make destinations
########################################################
all: $(SRC)InstallDir.hs $(BIN)generate $(BIN)kicslib $(BIN)kics \
all: $(SRC)InstallDir.hs $(BIN)kicslib $(BIN)kics \
$(BIN)kicsi libs cpns www tools
.PHONY: tools
tools: $(SRC)InstallDir.hs $(BIN)makeExternalInterface $(BIN)prettyflat\
$(BIN)currytest $(BIN)prettyacy
$(BIN)generate: $(SRC)Generate.hi
$(GHC) $(SRC)Generate.hs -o $(BIN)generate
$(SRC)$(KICSSUB)AutoGenerated2.hs: $(BIN)generate
$(BIN)generate $(SRC)
$(SRC)InstallDir.hs: prerequisites
@echo "module InstallDir where" > $(SRC)InstallDir.hs.tmp
@echo "installDir = \""`pwd`"\"" >> $(SRC)InstallDir.hs.tmp
......@@ -110,7 +103,7 @@ runtime: $(SRC)InstallDir.hs
$(GHC) -fno-cse $(SRC)Curry.hs
.PHONY: libs
libs: $(BIN)kics $(SRC)$(KICSSUB)AutoGenerated2.hs runtime $(BIN)makeacy
libs: $(BIN)kics runtime $(BIN)makeacy
$(KICS) $(LIB)All_Libraries
cd $(LIB); ../../bin/makeacy All_Libraries
......@@ -260,12 +253,6 @@ src/CurryToHaskell.o : src/MetaProgramming/FlatCurryGoodies.hi
src/CurryToHaskell.o : src/MetaProgramming/FlatCurry.hi
src/kicslib.o : src/kicslib.hs
src/kicslib.o : src/Config.hi
src/Generate.o : src/Generate.hs
src/Generate.o : src/Names.hi
src/Generate.o : src/FunctionalProg.hi
src/Generate.o : src/CurryToHaskell.hi
src/Generate.o : src/Config.hi
src/Generate.o : src/SafeCalls.hi
src/kicsi.o : src/kicsi.hs
src/kicsi.o : src/MyReadline.hi
src/kicsi.o : src/Names.hi
......
......@@ -15,10 +15,7 @@ import Maybe
import SafeCalls
import Brace
import Config
import Names (dataHsName,instHsName,funcHsName,
extDataHsName,extInstHsName,extFuncHsName,
extDataModName,extInstModName,extFuncModName,
dataModName,instModName,modName,dbgModName,
import Names (modName,dbgModName,funcHsName,
elimInfix,funName,functionName,constructorName)
import qualified Names as N
import Monad
......@@ -240,7 +237,6 @@ transform typeMapping aux opts0 (Prog name imports types funcs _)
-- the file names of these modules are:
funcFileName = funcHsName (filename opts)
dataFileName = dataHsName (filename opts)
mainFileName = "Main.hs"
-- import lists
......@@ -353,9 +349,9 @@ df = ("Prelude","allValuesD")
bf = ("Prelude","allValuesB")
pr = ("Interactive","printTerm")
hd = ("Prelude","head")
f ... g = Comb FuncCall (flatPre ".")
f ... g = Comb FuncCall (addPre ".")
[Comb (FuncPartCall 1) f [],Comb (FuncPartCall 1) g []]
ap_ f e = Comb FuncCall (flatPre ".") [Comb (FuncPartCall 1) f [],e]
ap_ f e = Comb FuncCall (addPre ".") [Comb (FuncPartCall 1) f [],e]
------------------------------------------------------
-- transformation of type declarations
......@@ -443,13 +439,13 @@ curryInstance opts t@(Type origName vis vars consdecls)
eq = C.Func (newModName,"eq") (transvis vis) untyped
(Just
(map eqRule consdecls
++otherwiseExp 3 (baseTypesym isPrelude "C_False")))
++otherwiseExp 3 (concupresym opts "False")))
eqRule (Cons cname arity _ _) =
rule [C.PComb (consName opts cname) (map toPVar [1..arity]),
C.PComb (consName opts cname) (map (toPVar' "y") [1..arity])]
(noguard $ if arity==0 then baseTypesym isPrelude "C_True"
else foldr1 (\ e es -> fapp (fbasesym opts "&&") (addStateArg [e,es]))
(noguard $ if arity==0 then concupresym opts "True"
else foldr1 (\ e es -> fapp (funcupresym "&&") (addStateArg [e,es]))
(map eqArgs [1..arity])) []
where
eqArgs i = fapp (extInstPresym isPrelude "genEq") (addStateArg [toVar i,toVar' "y" i])
......@@ -484,20 +480,20 @@ curryInstance opts t@(Type origName vis vars consdecls)
(map toTermRule (zip [1..] consdecls) ++
[C.Rule [_x,_x,
C.PComb (newModName,name++"FreeVar") [C.PVar "r"]]
(noguard $ app (baseTypesym isPrelude "C_Free")
(app (c_int isPrelude)
(noguard $ app (cupresym "C_Free")
(app c_int
(app (hasPresym "toInteger")
(C.Var "r")))) []]))
toTermRule (nr,(Cons cname arity _ _)) =
C.Rule [C.PVar "mode",C.PVar "store",
C.PComb (consName opts cname) (map toPVar [1..arity])]
(noguard $ fapp (baseTypesym isPrelude "C_Data")
(noguard $ fapp (cupresym "C_Data")
[toInt nr,c_string_ origMod (snd cname),
dList isPrelude (map su [1..arity])]) []
where
su i = fapp (basesym "ctcStore")
[C.Var "mode",app (basesym "toC_Term") (C.Var "mode"),
su i = fapp (cusym "ctcStore")
[C.Var "mode",app (cusym "toC_Term") (C.Var "mode"),
C.Var "store",toVar i]
fromTerm = C.Func (newModName,"fromC_Term") (transvis vis) untyped
......@@ -519,7 +515,7 @@ curryInstance opts t@(Type origName vis vars consdecls)
pname = dpList isPrelude (map (toPChar opts) (snd cname))
pts = dpList isPrelude (map toPVar [1..arity])
e = noguard $ fapp (sym (consName opts cname))
(map (app (basesym "fromC_Term") . toVar) [1..arity])
(map (app (cusym "fromC_Term") . toVar) [1..arity])
rule c args = C.Rule [C.PComb (baseType isPrelude c) args] e []
......@@ -554,22 +550,22 @@ baseCurryInstance opts (Type origName vis vars consdecls)
[1..arity]) []]
nflambda gr i e =
fapp (basesym (if gr then "gnfCTC" else "nfCTC"))
fapp (cusym (if gr then "gnfCTC" else "nfCTC"))
[C.Lambda [toPVar' "v" i,toPVar' "state" i] e,toVar i,toVar' "state" (i-1)]
free s t = C.Func (newModName,s) (transvis vis) untyped
(Just [C.Rule [C.PVar "i"] (noguard $
fapp (basesym "withRef") [
fapp (cusym "withRef") [
C.Lambda [C.PVar "r"] $
fapp (sym (orName opts origName))
[fapp (basesym "mkRef") [C.Var "r",maxAr,C.Var "i"],
[fapp (cusym "mkRef") [C.Var "r",maxAr,C.Var "i"],
list_ (map freeCons consdecls)],
maxAr]) []])
where
maxAr = C.Var (show (foldr max 0 (map consArity consdecls)))
freeCons (Cons cname arity _ _) =
fapp (sym (consName opts cname))
(snd $ foldr addOne (0,[]) (replicate arity (app (basesym t))))
(snd $ foldr addOne (0,[]) (replicate arity (app (cusym t))))
addOne e (n,es) =
(n+1,e (fapp (hasPresym "+") [C.Var "r",toHInt n]):es)
......@@ -584,11 +580,11 @@ baseCurryInstance opts (Type origName vis vars consdecls)
(map tester [(orName, 2, "Branching"),
(failName, 1, "Failed")] ++
[C.Rule [_x]
(noguard $ (basesym "Val")) []]))
(noguard $ (cusym "Val")) []]))
tester (namer,arity,nameTest) =
C.Rule [C.PComb (namer opts origName) (take arity (repeat (_x)))]
(noguard (basesym nameTest)) []
(noguard (cusym nameTest)) []
selector nameSel namer arity number =
C.Func (newModName,nameSel) (transvis vis) untyped
......@@ -644,7 +640,7 @@ transFunc opts typeMapping (Func fname arity vis t (Rule lhs rhs))
transFunc opts _ (Func (m,fname) arity vis t (External _)) =
C.Func (funName (m,fname)) (transvis vis) (transFType opts arity t)
(Just [rule (map toPVar [1..arity])
(noguard (fapp (C.Symbol (extFuncModName m,fname))
(noguard (fapp (C.Symbol (modName m,fname))
(addStateArg (map toVar [1..arity])))) []])
......@@ -752,7 +748,7 @@ transRule (as,v:bs) opts (Branch (LPattern l@(Charc _)) e)
= rule ps (C.GuardedExpr [(guard,transExpr opts e)]) []
where
guard = app (extInstPresym False "isC_True")
(fapp (fbasesym opts "===") [toVar v,toLit opts l])
(fapp (funcupresym "===") [toVar v,toLit opts l])
ps = map toPVar as ++ toPVar v : map toPVar bs
transRule (as,v:bs) opts (Branch (LPattern l) e)
= rule ps (noguard (transExpr opts e)) []
......@@ -785,8 +781,8 @@ genInstances cl genFunc opts (t:ts)
genInstances cl genFunc opts ts
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)])
C.Instance (map (\v -> C.TypeClass (addPre "Show") [toTVar v]) vars)
(C.TypeClass (addPre "Show") [C.TCons (newModName,name) (map toTVar vars)])
[showFunction False opts t]
where
(newModName,name) = consName opts origName
......@@ -865,8 +861,8 @@ showFunction showQ opts t@(Type origName vis vars consdecls)
readInstance :: Config.Options -> TypeDecl -> C.InstanceDecl
readInstance opts (Type origName@(modName,name) vis vars consdecls) =
C.Instance (map (\v -> C.TypeClass (has "Read") [toTVar v]) vars)
(C.TypeClass (has "Read") [C.TCons (newModName,newName) (map toTVar vars)])
C.Instance (map (\v -> C.TypeClass (addPre "Read") [toTVar v]) vars)
(C.TypeClass (addPre "Read") [C.TCons (newModName,newName) (map toTVar vars)])
[if isTuple (snd origName) then readTuple else readsPrec]
where
c@(newModName,newName) = consName opts origName
......@@ -980,6 +976,20 @@ addGlobalDefs opts gs [(s,b,prog)] = [(s,b,prog{C.funcDecls=gs'++C.funcDecls pro
-- constants and abbreviations for flat, resp. abstract curry
----------------------------------------------------------------
-- prelude symbols
sym = C.Symbol
prelude = "Prelude"
addPre = (,) prelude
hasPresym = sym . addPre
cupresym = sym . (,) (modName prelude)
funcupresym = sym . funName . addPre
concupresym opts = sym . consName opts . addPre
-- symbols from Curry library
curryModule = "Curry"
cu = (,) curryModule
cusym = sym . cu
part opts i e =
if i<2
then primValue opts (C.Lambda (addStatePat [toPVar' "v" 1]) e)
......@@ -1016,15 +1026,15 @@ dotted opts n p
| n == 0 = p
| otherwise = dotted opts (n-1) (cp opts [p])
prelPCons s = C.PComb (consName opts (addPre s))
prelPCons opts s = C.PComb (consName opts (addPre s))
pO opts x = prelPCons "O" [x]
pI opts x = prelPCons "I" [x]
pIHi opts = prelPCons "IHi" []
pO opts x = prelPCons opts "O" [x]
pI opts x = prelPCons opts "I" [x]
pIHi opts = prelPCons opts "IHi" []
p0 opts = prelPCons "Zero" []
pPos opts x = prelPCons "Pos" [x]
pNeg opts x = prelPCons "Neg" [x]
p0 opts = prelPCons opts "Zero" []
pPos opts x = prelPCons opts "Pos" [x]
pNeg opts x = prelPCons opts "Neg" [x]
public = C.Public
......@@ -1081,28 +1091,8 @@ flatGst x = Comb FuncCall (addPre "getSearchTree") [x]
mid = hasPresym "id"
sym = C.Symbol
cupresym = sym . addPre
cusym s = sym (cu s)
fcusym s = sym (funName ("Prelude",s))
cu s = ("Curry",s)
basesym s = sym (ba s)
baseTypesym isP s = sym (baseType isP s)
baseType _ s = addPre s
fbasesym opts s
| currentModule opts=="Prelude" = sym (extInstModName "Prelude",functionName s)
| otherwise = presym (functionName s)
ba s = ("Curry",s)
toVar i = C.Var (xvar i)
toVar' s i = C.Var (varName s i)
......@@ -1120,7 +1110,6 @@ toTVar i = C.TVar (varName "t" i)
primValue opts v =
app (sym $ consName opts{extCons=True} (addPre "PrimValue")) v
addPre s = ("Prelude",s)
toList [] = C.Symbol ("","[]")
toList (x:xs) = app2 (C.Symbol ("",":")) x (toList xs)
......@@ -1128,10 +1117,6 @@ toList (x:xs) = app2 (C.Symbol ("",":")) x (toList xs)
toPList [] = C.PComb ("","[]") []
toPList (x:xs) = C.PComb ("",":") [x,toPList xs]
hasPresym s = sym (has s)
has s = ("Prelude",s)
toPLit opts (Intc i) = toPInt opts i
toPLit opts (Charc c) = toPChar opts c
toPLit opts (Floatc f) = toPFloat opts f
......@@ -1150,7 +1135,7 @@ toPNat opts n
m = mod n 2
toPChar opts c
| currentModule opts=="Prelude" = C.PComb (dataModName "Prelude","C_Char") [C.PLit (C.Charc c)]
| currentModule opts=="Prelude" = C.PComb (modName "Prelude","C_Char") [C.PLit (C.Charc c)]
| otherwise = C.PComb (modName "Prelude","C_Char") [C.PLit (C.Charc c)]
toPFloat opts n = primPValue opts (C.PLit (C.Floatc n))
......@@ -1164,7 +1149,7 @@ toLit opts (Floatc f) = toFloat opts f
toInt n = C.Lit (C.Intc (toInteger n))
toHInt n = C.Lit (C.HasIntc (toInteger n))
c_int isP = baseTypesym isP "C_Int"
c_int = cupresym "C_Int"
toChar opts c = app (sym (consName opts ("Prelude","Char"))) (C.Lit (C.Charc c))
toFloat opts f = primValue opts (C.Lit (C.Floatc f))
......@@ -1192,13 +1177,13 @@ nil = sym ("","[]")
string_ n = list_ (map char_ n)
c_char_ c = fapp (basesym "C_Char") [C.Lit (C.Charc c)]
c_char_ c = fapp (cusym "C_Char") [C.Lit (C.Charc c)]
c_list_ [] = c_nil
c_list_ (x:xs) = c_cons_ x (c_list_ xs)
c_cons_ x xs = fapp (presym ":<") [x,xs]
c_nil = presym "List"
c_cons_ x xs = fapp (cupresym ":<") [x,xs]
c_nil = cupresym "List"
bc_list_ [] = bc_nil
bc_list_ (x:xs) = bc_cons_ x (bc_list_ xs)
......@@ -1209,8 +1194,8 @@ dList False = c_list_
dpList True = bc_plist_
dpList False = c_plist_
bc_cons_ x xs = fapp (presym ":<") [x,xs]
bc_nil = presym "List"
bc_cons_ x xs = fapp (cupresym ":<") [x,xs]
bc_nil = cupresym "List"
c_string_ "Prelude" n = bc_list_ (map c_char_ n)
c_string_ _ n = c_list_ (map c_char_ n)
......@@ -1226,14 +1211,14 @@ pnil = C.PComb ("","[]") []
c_plist_ [] = c_pnil
c_plist_ (x:xs) = c_pcons_ x (c_plist_ xs)
c_pcons_ x xs = C.PComb (pre ":<") [x,xs]
c_pnil = C.PComb ("DataPrelude","List") []
c_pcons_ x xs = C.PComb (addPre ":<") [x,xs]
c_pnil = C.PComb (addPre "List") []
bc_plist_ [] = bc_pnil
bc_plist_ (x:xs) = bc_pcons_ x (bc_plist_ xs)
bc_pcons_ x xs = C.PComb ("DataPrelude",":<") [x,xs]
bc_pnil = C.PComb ("DataPrelude","List") []
bc_pcons_ x xs = C.PComb (addPre ":<") [x,xs]
bc_pnil = C.PComb (addPre "List") []
pstring_ n = plist_ (map pchar_ n)
......
module Main where
import SafeCalls
import Config
import CurryToHaskell hiding (consName)
import FunctionalProg
import Debug.Trace
import Names hiding (consName)
import System.Environment
import List
main = safe $ do
as <- safeIO getArgs
let dir = if null as then "" else head as
(opts,_) <- safeIO readConfig
callFrontend opts{filename="Generate"}
curryProg <- safeReadFlat opts "Generate.fcy"
let [(_,_,prog)] = transform tMap undefined opts curryProg
file1 = "AutoGenerated1"
auto1 = emptyProg {progName=file1,
imports=["Curry"],
typeDecls=map correctTD (filter inAuto1 $ typeDecls prog)}
writeProgram opts (dir++file1++".hs",True,auto1)
safeIO $ putStrLn ("File "++dir++file1++".hs written")
let file2 = "AutoGenerated2"
auto2 = emptyProg {progName=file2,
imports=["Curry",dataModName "Prelude"],
instanceDecls=filter inAuto2 $
--map (repairID rename) $
--filter goodInstances $
instanceDecls prog,
funcDecls=funcDecls prog}
writeProgram opts (dir++file2++".hs",True,auto2)
safeIO $ putStrLn ("File "++dir++file2++".hs written")
correctTD t@Type{typeName=(m,"C_List")} = noC_ t
correctTD t@Type{typeName=(m,"C_Prim")} = noC_ t
correctTD t@Type{typeName=(m,"C_Char")} = correctPrim t
correctTD t@Type{typeName=(m,"C_Int")} = correctPrim t
correctTD t@Type{typeName=(m,"C_Four")} = t{derive=nub ("Eq":derive t)}
correctTD t = t
noC_ t@Type{typeName=(m,'C':'_':n),consDecls=cs} =
t{typeName=(m,n),consDecls=map noC_ConsDecl cs}
noC_ConsDecl c@Cons{consName = (m,'C':'_':name),consArgs=args} =
c{consName = (m,name),consArgs = map noC_Args args}
noC_ConsDecl c@Cons{consArgs=args} = c{consName = ("",":<"),consArgs = map noC_Args args}
noC_Args x@(TVar _) = x
noC_Args (FuncType t1 t2) = FuncType (noC_Args t1) (noC_Args t2)
noC_Args t@(TCons (_,"C_Exceptions") []) = t
noC_Args (TCons (m,'C':'_':n) ts) = TCons (m,n) (map noC_Args ts)
noC_Args (TCons n ts) = TCons n (map noC_Args ts)
correctPrim t@Type{consDecls=c:cs} = t {consDecls=correctP c:cs}
correctP c@Cons{consName = (m,n)} = c{consArgs=[TCons ("",newName n) []],strictArgs=True}
newName "C_Char" = "Char"
newName "C_Int" = "Integer"
inAuto1 t = not $ elem (snd (typeName t)) ["C_Success","C_Bool","C_Char"]
inAuto2 i = not $ elem (snd (className inst)) ["Show","Read","Curry"] ||
elem tName ["C_Char","C_Prim"]
where
inst = instanciated i
tName = name $ head $ classArgs inst
name (TCons (_,n) _) = n
goodInstances i =
not (elem (name $ head $ classArgs $ instanciated i)
["C_Success","C_Bool","C_Char","C_Int","C_Prim"]) &&
if elem (snd $ className $ instanciated i) ["Show","Read"]
then not (elem (name $ head $ classArgs $ instanciated i)
["C_List","C_Int","C_Char","C_Prim"])
else True
where
name (TCons (_,n) _) = n
rename ("DataGenerate",n) = rename ("PrepareBaseTypes",n)
rename ("CurryGenerateCTC",n) = rename ("PrepareBaseTypes",n)
rename ("DataPrelude",n) = rename ("PrepareBaseTypes",n)
rename (m,'C':'_':'L':'i':'s':'t':n) = (m,"List"++n)
rename (m,'C':'_':'P':'r':'i':'m':n) = (m,"Prim"++n)
rename (m,"C_:<") = (m,":<")
rename x = x
tMap (m,"True") = (m,"Bool")
tMap (m,"False") = (m,"Bool")
tMap x = x
----------------------------------
-- repairing
----------------------------------
repair f prog@Prog{typeDecls=tds,instanceDecls=ids} =
prog{typeDecls=map (repairTD f) tds,
instanceDecls=map (repairID f) ids}
repairTD f t@Type{typeName=n,consDecls=cds} =
t{typeName=f n,
consDecls=map (repairCD f) cds}
repairTD f t@TypeSyn{typeName=n,typeExpr=e} =
t{typeName=f n,
typeExpr=repairTE f e}
repairID f i@Instance{instanciated=inst,instanceFunc=fds} =
i{instanciated=repairTC f inst,
instanceFunc = map (repairFD f) fds}
repairTC f tc@TypeClass { className=n,classArgs=tes} =
tc{className=f n,
classArgs= map (repairTE f) tes}
repairCD f c@Cons { consName=n,consArgs=tes} =
c{consName=f n,
consArgs=map (repairTE f) tes}
repairTE f x@(TVar _) = x
repairTE f (FuncType t1 t2) = FuncType (repairTE f t1) (repairTE f t2)
repairTE f (TCons n tes) = TCons (f n) (map (repairTE f) tes)
repairTE f (TConstr tcs te) = TConstr (map (repairTC f) tcs) (repairTE f te)
repairFD f func@Func{ funcName=fn,funcType=mft,funcBody=fb} =
func{ funcName=f fn,
funcType=maybe Nothing (Just. repairTE f) mft,
funcBody=maybe Nothing (Just . map (repairR f)) fb}
repairR f r@Rule { patterns=ps,rhs=rhs,locDecls=ls} =
r { patterns=map (repairP f) ps,
rhs=repairRhs f rhs,
locDecls=map (repairLD f) ls}
repairRhs f (SimpleExpr e) = SimpleExpr (repairE f e)
repairRhs f (GuardedExpr ges) =
GuardedExpr ( map (\ (x,y) -> (repairE f x,repairE f y)) ges)
repairLD f (LocalFunc fd) = LocalFunc (repairFD f fd)
repairLD f (LocalPat p e lds) =
LocalPat (repairP f p) (repairE f e) (map (repairLD f) lds)
repairE f (Symbol n) = Symbol (f n)
repairE f (Apply e1 e2) = Apply (repairE f e1) (repairE f e2)
repairE f (Lambda ps e) = Lambda (map (repairP f) ps) (repairE f e)
repairE f (LetDecl lds e) = LetDecl (map (repairLD f) lds) (repairE f e)
repairE f (DoExpr xs) = DoExpr (map (repairS f) xs)
repairE f (ListComp e xs) = ListComp (repairE f e) (map (repairS f) xs)
repairE f (Case e bs) = Case (repairE f e) (map (repairB f) bs)
repairE _ x = x
repairS f (SExpr e) = SExpr (repairE f e)
repairS f (SPat p e) = SPat (repairP f p) (repairE f e)
repairS f (SLet lds) = SLet (map (repairLD f) lds)
repairP f (PComb n ps) = PComb (f n) (map (repairP f) ps)
repairP f (AsPat n p) = AsPat n (repairP f p)
repairP f x = x
repairB f (Branch p e)= Branch (repairP f p) (repairE f e)
\ No newline at end of file
......@@ -20,11 +20,10 @@ preludeConstructorName n
constructorName = preludeConstructorName
consName extFuncs (m,n) =
consName (m,n) =
case m of
"Prelude" -> (dataDefMod extFuncs m,preludeConstructorName n)
"" -> ("",preludeConstructorName n)
_ -> (dataDefMod extFuncs m,constructorName n)
_ -> (modName m,constructorName n)
{-
......@@ -36,18 +35,9 @@ extConsName exts (m,n) = case m of
datamod = if elem (m,n) exts then extDataModName else dataModName
-}
dataDefMod :: Bool -> String -> String
dataDefMod False = modName
dataDefMod True = instModName
-- function names
preludeFunctionName s@"share" = s
preludeFunctionName n = functionName n
functionName n | isInfixOpName n = elimInfix n
| otherwise = 'c':'_':n
funName (p@"Prelude",n) = (modName p,preludeFunctionName n)
funName (m,n) = (modName m,functionName n)
elimInfix name = "op_"++concat (intersperse "_" (map (show . ord) name))
......@@ -61,41 +51,13 @@ insertName :: String -> FilePath -> FilePath
insertName s xs = replaceFileName xs (s++takeFileName xs)
modName s = insertName "Curry.Module." s
dataMName = "Data"
instMName = "Instances"
funcMName = "Functions"
dbgMName = "Oracle"
external = insertName "External"
extDataMName = external dataMName
extInstMName = external instMName
extFuncMName = external funcMName
dataModName = insertName dataMName
instModName = insertName instMName
funcModName = insertName funcMName
dbgModName = insertName dbgMName
extDataModName = insertName extDataMName
extInstModName = insertName extInstMName
extFuncModName = insertName extFuncMName
dataHsName s = replaceExtension (dataModName s) ".hs"
instHsName s = replaceExtension (instModName s) ".hs"
funcHsName s = replaceExtension s ".hs"
extDataHsName s = replaceExtension (extDataModName s) ".hs"
extInstHsName s = replaceExtension (extInstModName s) ".hs"
extFuncHsName s = replaceExtension (extFuncModName s) ".hs"
externalSpecName s = replaceExtension s ".hs.include"