forked from GitHub/gf-core
restored work on Extend and Rename
This commit is contained in:
@@ -43,6 +43,8 @@ import Data.Char
|
||||
import qualified Data.Map as Map
|
||||
import Data.List (genericReplicate)
|
||||
|
||||
import Debug.Trace (trace) ----
|
||||
|
||||
-- based on the skeleton Haskell module generated by the BNF converter
|
||||
|
||||
type Result = Err String
|
||||
@@ -73,7 +75,7 @@ transModDef :: ModDef -> Err (Ident,Module)
|
||||
transModDef x = case x of
|
||||
MModule compl mtyp body -> do
|
||||
|
||||
--- let mstat' = transComplMod compl
|
||||
let isCompl = transComplMod compl
|
||||
|
||||
(trDef, mtyp', id') <- case mtyp of
|
||||
MAbstract id -> do
|
||||
@@ -90,9 +92,9 @@ transModDef x = case x of
|
||||
open' <- transIdent open
|
||||
mkModRes id (MTInstance open') body
|
||||
|
||||
mkBody (trDef, mtyp', id') body
|
||||
mkBody (isCompl, trDef, mtyp', id') body
|
||||
where
|
||||
mkBody xx@(trDef, mtyp', id') bod = case bod of
|
||||
mkBody xx@(isc, trDef, mtyp', id') bod = case bod of
|
||||
MNoBody incls -> do
|
||||
mkBody xx $ MBody (Ext incls) NoOpens []
|
||||
MBody extends opens defs -> do
|
||||
@@ -102,7 +104,7 @@ transModDef x = case x of
|
||||
let defs' = Map.fromListWith unifyJudgements
|
||||
[(i,Left d) | Left ds <- defs0, (i,d) <- ds]
|
||||
let flags' = Map.fromList [f | Right fs <- defs0, f <- fs]
|
||||
return (id', Module mtyp' [] [] extends' opens' flags' defs')
|
||||
return (id', Module mtyp' isc [] [] extends' opens' flags' defs')
|
||||
|
||||
MWith m insts -> mkBody xx $ MWithEBody [] m insts NoOpens []
|
||||
MWithBody m insts opens defs -> mkBody xx $ MWithEBody [] m insts opens defs
|
||||
@@ -116,7 +118,7 @@ transModDef x = case x of
|
||||
let defs' = Map.fromListWith unifyJudgements
|
||||
[(i,Left d) | Left ds <- defs0, (i,d) <- ds]
|
||||
let flags' = Map.fromList [f | Right fs <- defs0, f <- fs]
|
||||
return (id', Module mtyp' [] [(m',insts')] extends' opens' flags' defs')
|
||||
return (id', Module mtyp' isc [] [(m',insts')] extends' opens' flags' defs')
|
||||
_ -> fail "deprecated module form"
|
||||
|
||||
|
||||
@@ -128,6 +130,11 @@ transModDef x = case x of
|
||||
getTopDefs :: [TopDef] -> [TopDef]
|
||||
getTopDefs x = x
|
||||
|
||||
transComplMod :: ComplMod -> Bool
|
||||
transComplMod x = case x of
|
||||
CMCompl -> True
|
||||
CMIncompl -> False
|
||||
|
||||
transExtend :: Extend -> Err [(Ident,MInclude)]
|
||||
transExtend x = case x of
|
||||
Ext ids -> mapM transIncludedExt ids
|
||||
@@ -279,7 +286,7 @@ transResDef x = case x of
|
||||
_ -> [(c,j)]
|
||||
isOverloading (G.Vr keyw) c fs =
|
||||
prIdent keyw == "overload" && -- overload is a "soft keyword"
|
||||
False ---- all (== GP.prt c) (map (GP.prt . fst) fs)
|
||||
True ---- all (== GP.prt c) (map (GP.prt . fst) fs)
|
||||
|
||||
transParDef :: ParDef -> Err (Ident, [(Ident,G.Context)])
|
||||
transParDef x = case x of
|
||||
@@ -426,7 +433,7 @@ transExp x = case x of
|
||||
exp' <- transExp exp
|
||||
defs0 <- mapM locdef2fields defs
|
||||
defs' <- mapM tryLoc $ concat defs0
|
||||
return $ exp' ---- M.mkLet defs' exp'
|
||||
return $ M.mkLet defs' exp'
|
||||
where
|
||||
tryLoc (c,(mty,Just e)) = return (c,(mty,e))
|
||||
tryLoc (c,_) = Bad $ "local definition of" +++ prIdent c +++ "without value"
|
||||
|
||||
Reference in New Issue
Block a user