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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
module Main where
import System
import Char
-- generate Finnish lexicon implementations with 1 or more
-- characteristic arguments
-- usage: runghc MkLex.hs 3
main = do
i:_ <- getArgs
ss <- readFile src >>= return . filter (not . (all isSpace)) . lines
initiate i
mapM_ (mkLex (read i) . uncurry (++)) (zip nums ss)
putStrLn "}"
--src = "correct-NSK.txt"
--tgt = "NSK"
src = "correct-Omat.txt"
tgt = "Omat"
--src = "aino.txt"
--tgt = "Aino"
--src = "duodecim.txt"
--tgt = "Duodecim"
initiate 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
|
