summaryrefslogtreecommitdiff
path: root/src/GF/Compile/ShellState.hs
diff options
context:
space:
mode:
authoraarne <unknown>2004-12-29 13:48:41 +0000
committeraarne <unknown>2004-12-29 13:48:41 +0000
commit46f85fb13a569e27863565b4ec99800038e3fd68 (patch)
tree7ed6a706c39192140bf768caf7e55559a1672926 /src/GF/Compile/ShellState.hs
parentbba1cb2d108225f6078b6a12af3cc9256329ac7b (diff)
command cm
Diffstat (limited to 'src/GF/Compile/ShellState.hs')
-rw-r--r--src/GF/Compile/ShellState.hs15
1 files changed, 9 insertions, 6 deletions
diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs
index 34224e641..ae80af572 100644
--- a/src/GF/Compile/ShellState.hs
+++ b/src/GF/Compile/ShellState.hs
@@ -210,12 +210,14 @@ purgeShellState sh = ShSt {
changeMain :: Maybe Ident -> ShellState -> Err ShellState
changeMain Nothing (ShSt _ _ cs ms ss cfs pis mos os rs acs s) =
- return (ShSt Nothing Nothing cs ms ss cfs pis mos os rs acs s)
-changeMain (Just c) (ShSt _ _ cs ms ss cfs pis mos os rs acs s) =
- case lookup c (map fst cs) of
- Just i -> do
- a <- M.abstractOfConcrete ms i
- return (ShSt (Just a) (Just i) cs ms ss cfs pis mos os rs acs s)
+ return (ShSt Nothing Nothing [] ms ss cfs pis mos os rs acs s)
+changeMain (Just c) st@(ShSt _ _ cs ms ss cfs pis mos os rs acs s) =
+ case lookup c (M.modules ms) of
+ Just _ -> do
+ a <- M.abstractOfConcrete ms c
+ let cas = M.allConcretes ms a
+ let cs' = [((c,c),True) | c <- cas]
+ return (ShSt (Just a) (Just c) cs' ms ss cfs pis mos os rs acs s)
_ -> P.prtBad "The state has no concrete syntax named" c
-- form just one state grammar, if unique, from a canonical grammar
@@ -385,6 +387,7 @@ getLangNameOpt opts file =
-- modify state
type ShellStateOper = ShellState -> ShellState
+type ShellStateOperErr = ShellState -> Err ShellState
reinitShellState :: ShellStateOper
reinitShellState = const emptyShellState