summaryrefslogtreecommitdiff
path: root/src/GF/API/IOGrammar.hs
blob: c2c2628ba7e014bcf0caf6271eabb277e7a5c375 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
----------------------------------------------------------------------
-- |
-- Module      : IOGrammar
-- Maintainer  : Aarne Ranta
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/03/08 18:08:58 $ 
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.15 $
--
-- for reading grammars and terms from strings and files
-----------------------------------------------------------------------------

module IOGrammar (shellStateFromFiles, 
		  getShellStateFromFiles) where

import Abstract
import qualified GFC
import PGrammar
import TypeCheck
import Compile
import ShellState

import Modules
import ReadFiles (isOldFile)
import Option
import Operations
import UseIO
import Arch

import Monad (liftM)

-- | a heuristic way of renaming constants is used
string2absTerm :: String -> String -> Term 
string2absTerm m = renameTermIn m . pTrm

renameTermIn :: String -> Term -> Term
renameTermIn m = refreshMetas [] . rename [] where
  rename vs t = case t of
    Abs x b -> Abs x (rename (x:vs) b)
    Vr c    -> if elem c vs then t else Q (zIdent m) c
    App f a -> App (rename vs f) (rename vs a)
    _ -> t

string2annotTree :: GFC.CanonGrammar -> Ident -> String -> Err Tree
string2annotTree gr m = annotate gr . string2absTerm (prt m) ---- prt

----string2paramList :: ConcreteST -> String -> [Term]
---string2paramList st = map (renameTrm (lookupConcrete st) . patt2term) . pPattList

shellStateFromFiles :: Options -> ShellState -> FilePath -> IOE ShellState
shellStateFromFiles opts st file = case fileSuffix file of
  "gfcm" -> do
     cenv <- compileOne opts (compileEnvShSt st []) file
     ioeErr $ updateShellState opts Nothing st cenv
  s | elem s ["cf","ebnf"] -> do
     let osb = addOptions (options []) opts
     grts <- compileModule osb st file
     ioeErr $ updateShellState opts Nothing st grts
  _ -> do
     b <- ioeIO $ isOldFile file
     let opts' = if b then (addOption showOld opts) else opts

     let osb = if oElem showOld opts' 
                 then addOptions (options []) opts' -- for old no emit
                 else addOptions (options [emitCode]) opts'
     grts <- compileModule osb st file
     let top = identC $ justModuleName file
     ioeErr $ updateShellState opts' (Just top) st grts
     --- liftM (changeModTimes rts) $ grammar2shellState opts gr

getShellStateFromFiles :: Options -> FilePath -> IO ShellState
getShellStateFromFiles os = 
  useIOE emptyShellState . 
  shellStateFromFiles os emptyShellState