forked from GitHub/gf-core
49 lines
1.8 KiB
Haskell
49 lines
1.8 KiB
Haskell
import Monad
|
|
|
|
main = do
|
|
ss <- readFile src >>= return . map words . lines
|
|
writeFile abstr "abstract OverGrammar = Structural,Numeral,Conjunction[ListS,ListNP,ListAP,ListAdv] ** {\n"
|
|
appendFile abstr "cat ImpForm ; Punct ;\n"
|
|
writeFile concr "concrete OverGrammarEng of OverGrammar = StructuralEng,NumeralEng,ConjunctionEng[ListS,ListNP,ListAP,ListAdv] ** open GrammarEng in {\n"
|
|
mapM_ (appendFile concr) [
|
|
"lincat ImpForm = {p : PImpForm ; s : Str} ;\n",
|
|
"lincat Punct = {p : PPunct ; s : Str} ;\n",
|
|
"param PImpForm = IFSg | IFPl | IFPol ;\n",
|
|
"param PPunct = PFullStop | PExclMark | PQuestMark ;\n",
|
|
"oper mkUttImp : PImpForm -> Str -> Pol -> Imp -> Utt = \\f,s,p,i -> {s = s ++ (case f of {\n",
|
|
" IFSg => UttImpSg p i ; IFPl => UttImpPl p i ; IFPol => UttImpPol p i}).s ; lock_Utt = <>} ;\n",
|
|
"oper mkPhrPunct : Phr -> PPunct -> Str -> Text -> Text = \\p,f,s,t -> {s = s ++ (case f of {\n",
|
|
" PFullStop => TFullStop p t ; PExclMark => TExclMark p t ; PQuestMark => TQuestMark p t}).s ;\n",
|
|
" lock_Text = <>} ;\n"
|
|
]
|
|
|
|
foldM process ("",0) ss
|
|
appendFile abstr "}\n"
|
|
appendFile concr "}\n"
|
|
return ()
|
|
|
|
src = "constr.gf"
|
|
abstr = "OverGrammar.gf"
|
|
concr = "OverGrammarEng.gf"
|
|
|
|
|
|
process env@(mk,count) line = case line of
|
|
('-':'-':_) : _ -> return env
|
|
_:rest | elem "=" rest && notElem "overload" rest -> do
|
|
let (fun,lin) = span (/="=") line
|
|
env2 <- process env fun
|
|
process env2 lin
|
|
mk1 : ":" : typ -> do
|
|
let mk2 = withCount count mk1
|
|
put abstr $ "fun" : mk2 : ":" : takeWhile (/="--") typ ++ [";\n"]
|
|
return $ (mk2,count)
|
|
"=" : trm -> do
|
|
put concr $ "lin" : mk : "=" : takeWhile (/=";") trm ++ [";\n"]
|
|
return $ (mk,count + 1)
|
|
_ -> return env
|
|
|
|
put file ws = appendFile file $ unwords ws
|
|
|
|
withCount count mk = "ovrld" ++ show count ++ "_" ++ mk
|
|
|