mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-16 16:29:32 -06:00
97 lines
2.7 KiB
Haskell
97 lines
2.7 KiB
Haskell
module Main where
|
|
|
|
import System
|
|
import Char
|
|
|
|
-- generate Finnish lexicon implementations with 1 or more
|
|
-- characteristic arguments
|
|
-- usage: runghc MkLex.hs 3 name
|
|
|
|
main = do
|
|
i:tgt:_ <- getArgs
|
|
let src = "correct-" ++ tgt ++ ".txt"
|
|
ss <- readFile src >>= return . filter (not . (all isSpace)) . lines
|
|
initiate tgt i
|
|
mapM_ (mkLex (read i) . uncurry (++)) (zip nums ss)
|
|
putStrLn "}"
|
|
|
|
initiate tgt i = mapM_ putStrLn [
|
|
"--# -path=.:alltenses",
|
|
"",
|
|
header i,
|
|
""
|
|
]
|
|
where
|
|
header i = case i of
|
|
"0" -> "abstract " ++ tgt ++ "Abs = Cat ** {\n\nfun testN : N -> Utt ;\n"
|
|
_ -> unlines [
|
|
"concrete " ++ tgt ++ i ++
|
|
" of " ++ tgt ++ "Abs = CatFin ** open Nominal, ResFin, Prelude in {",
|
|
"",
|
|
"lin testN talo = let t = talo.s in ss (",
|
|
" t ! NCase Sg Nom ++",
|
|
" t ! NCase Sg Gen ++",
|
|
" t ! NCase Sg Part ++",
|
|
" t ! NCase Sg Ess ++",
|
|
" t ! NCase Sg Illat ++",
|
|
" t ! NCase Pl Gen ++",
|
|
" t ! NCase Pl Part ++",
|
|
" t ! NCase Pl Ess ++",
|
|
" t ! NCase Pl Iness ++",
|
|
" t ! NCase Pl Illat",
|
|
" ) ;"
|
|
]
|
|
|
|
nums = map prt [1 ..] where
|
|
prt i = (if i < 10 then "0" else "") ++ show i ++ ". "
|
|
|
|
mkLex 0 line = case words line of
|
|
num:sana:_ -> do
|
|
let nimi = "n" ++ init num ++ "_" ++ sana
|
|
putStrLn $ "fun " ++ nimi ++ "_N : N ;"
|
|
_ -> return ()
|
|
|
|
mkLex 1 line = case words line of
|
|
num:sana:_ -> do
|
|
let nimi = "n" ++ init num ++ "_" ++ sana
|
|
putStrLn $ "lin " ++ nimi ++ "_N = mk1N \"" ++ sana ++ "\" ;"
|
|
_ -> return ()
|
|
|
|
mkLex 2 line = case words line of
|
|
num:sana:sanan:_ -> do
|
|
let nimi = "n" ++ init num ++ "_" ++ sana
|
|
putStrLn $ "lin " ++ nimi ++
|
|
"_N = mk2N \"" ++ sana ++ "\" \"" ++ sanan ++ "\" ;"
|
|
_ -> return ()
|
|
|
|
mkLex 3 line = case words line of
|
|
num:sana:sanan:_:_:_:_:sanoja:_ -> do
|
|
let nimi = "n" ++ init num ++ "_" ++ sana
|
|
putStrLn $ "lin " ++ nimi ++
|
|
"_N = mk3N \"" ++ sana ++ "\" \"" ++ sanan ++ "\" \"" ++ sanoja ++ "\" ;"
|
|
_ -> return ()
|
|
|
|
mkLex 4 line = case words line of
|
|
num:sana:sanan:sanaa:_:_:_:sanoja:_ -> do
|
|
let nimi = "n" ++ init num ++ "_" ++ sana
|
|
putStrLn $ "lin " ++ nimi ++
|
|
"_N = mk4N \"" ++ sana ++ "\" \"" ++ sanan ++
|
|
"\" \"" ++ sanaa ++ "\" \"" ++ sanoja ++ "\" ;"
|
|
_ -> return ()
|
|
|
|
|
|
-- to initiate from a noun list
|
|
|
|
mkLex 11 line = case words line of
|
|
_:"--":_ -> return ()
|
|
num:sana0:_ -> do
|
|
let sana = uncompound sana0
|
|
let nimi = "n" ++ init num ++ "_" ++ sana
|
|
putStrLn $ "fun " ++ nimi ++ "_N : N ;"
|
|
putStrLn $ "lin " ++ nimi ++ "_N = mk1N \"" ++ sana ++ "\" ;"
|
|
_ -> return ()
|
|
|
|
-- from sora+tie to tie
|
|
|
|
uncompound = reverse . takeWhile (/= '+') . reverse
|