mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
68 lines
2.1 KiB
Haskell
68 lines
2.1 KiB
Haskell
module Main where
|
|
|
|
import Control.Monad
|
|
import Data.Maybe
|
|
import Data.Char
|
|
import System.Cmd
|
|
import System.Directory
|
|
import System.Environment
|
|
import System.Exit
|
|
|
|
|
|
-- To clone a project from one language to another:
|
|
--
|
|
-- 1. for each Module in 'modules', copy ModuleFROM to ModuleTO
|
|
-- 2. in each ModuleTO, replace substrings FROM by TO, if not prefixes of an Ident
|
|
-- 3. in each ModuleTO in 'specifics', comment out every line in the body, except
|
|
-- those whose first word is in 'commons'.
|
|
--
|
|
-- Syntax: runghc Clone FROM TO
|
|
-- Example: runhugs Clone Swe Nor
|
|
|
|
-- The following lines are for the resource grammar project, and can be changed
|
|
-- to fit other projects.
|
|
|
|
modules = [
|
|
"Adjective", "Adverb", "Cat", "Conjunction", "Extra", "Grammar", "Idiom", "Lang", "Noun", "Numeral",
|
|
"Phrase", "Question", "Relative", "Sentence", "Symbol", "Text", "Verb",
|
|
"All", "Res", "Paradigms"]
|
|
++ specifics
|
|
specifics = ["Lexicon","Structural"]
|
|
commons = []
|
|
|
|
main = do
|
|
from:to:_ <- getArgs
|
|
mapM_ (clone from to) modules
|
|
|
|
clone from to pref = do
|
|
s <- readFile (pref ++ from ++ ".gf")
|
|
writeFile (pref ++ to ++ ".gf") (commentIf (isSpecific pref) (replaceLang from to s))
|
|
|
|
isSpecific = flip elem specifics
|
|
|
|
replaceLang s1 s2 = repl where
|
|
repl s = case s of
|
|
c:cs -> case splitAt lgs s of
|
|
(pre,c:rest) | pre == s1 && elem c " \n\t,:=(){}.-[];" -> s2 ++ [c] ++ repl rest
|
|
_ -> c : repl cs
|
|
_ -> s
|
|
lgs = 3 -- length s1
|
|
|
|
-- the file name has the form p....pLLL.gf, i.e. 3-letter lang name, suffix .gf
|
|
getLangName fi =
|
|
let (nal,ferp) = splitAt 3 (drop 3 (reverse fi)) in
|
|
(reverse ferp,reverse nal)
|
|
|
|
commentIf c = if c then (unlines . commentBody . lines) else id
|
|
|
|
commentBody ss = header ++ map comment body ++ ["}"] where
|
|
(header,body) = break (isJment . words) ss
|
|
isJment ws = case ws of
|
|
k:_ | elem k ["flags","lin","lincat","oper","param"] -> True
|
|
_ -> False
|
|
comment l = case l of
|
|
_ | take 2 l == "--" -> l -- already commented
|
|
_ | all isSpace l -> l -- empty line
|
|
_ | elem (head (words l)) commons -> l -- in 'commons'
|
|
_ -> "--" ++ l
|