(* Substant.sml * Copyright 1996 Peter Sestoft.  
   Må kopieres og modificeres jvfr. GNU General Public License *)
   
open Basis;
infix &&

datatype substantiv = 
    RegS of genus * bool * string * string * string * string * string vector
         (* artk    bes?   ubs/en   bes/en   ubs/fl   bes/fl   præfixer *)

val f = false and t = true

val substantiver = 
#[RegS (fk,  t, "aktivitet", "-en", "-er", "-ne", #[""]),
 RegS (fk,  t, "analyse", "-n", "-r", "-ne", 
       #["", "data", "problem", "samfunds", "system"]),
 RegS (fk,  f, "anvendelse", "-n", "-r", "-ne", 
       #["", "software", "teknologi"]),
 RegS (itk, f, "arbejde", "-t", "", "", 
       #["", "forsknings", "udviklings", "sam", "udrednings"]),
 RegS (itk, t, "behov", "-et", "-", "-ene", 
       #["", "organisations"]),
 RegS (itk, t, "center", "centret", "centre", "-ne", #[""]),
 RegS (itk, f, "design", "-et", "", "", #[""]),
 RegS (fk,  t, "dimension", "-en", "-er", "-ne", #[""]),
 RegS (fk,  f, "effektivitet", "-en", "", "", #[""]),
 RegS (itk, t, "eksempel", "eksemplet", "eksempler", "-ne", #[""]),
 RegS (fk,  t, "ekspertise", "-n", "-r", "-ne", 
       #["", "organisations", "software", "uddannelses"]),
 RegS (fk,  t, "enhed", "-en", "-er", "-ne", 
       #["", "center", "forsknings"]),
 RegS (fk,  t, "evaluering", "-en", "-er", "-ne", 
       #["", "projekt", "forsknings"]),
 RegS (fk,  t, "faktor", "-en", "-er", "-ne", #[""]),
 RegS (fk,  f, "forandring", "-en", "-er", "-ne", #[""]),
 RegS (itk, t, "foregangsland", "-et", "-e", "-ne", #[""]),
 RegS (fk,  t, "forsker", "-en", "-e", "forskerne", 
       #["", "erhvervs", "kontrakt", "senior"]),
 RegS (fk,  f, "forskning", "-en", "", "", 
       #["", "grund", "kontrakt"]),
 RegS (itk, t, "forslag", "-et", "-", "-ene", #[""]),
 RegS (fk,  t, "gruppe", "-n", "-r", "-ne", 
       #["", "arbejds", "forsker"]),
 RegS (itk, f, "indhold", "-et", "", "", #[""]),
 RegS (fk,  f, "indførelse", "-n", "", "", 
       #["edb-", "system", "teknologi"]),
 RegS (fk,  t, "indsats", "-en", "", "", #["", "forsknings"]),
 RegS (itk, t, "initiativ", "-et", "-er", "-ne", 
       #["", "forsknings", "omstillings"]),
 RegS (fk,  t, "institution", "-en", "-er", "-ne", 
       #["", "forsknings"]),
 RegS (itk, t, "kommissorium", "kommissoriet", "kommissorier", "-ne", #[""]),
 RegS (fk,  f, "kommunikation", "", "", "", #[""]),
 RegS (itk, t, "koncept", "-et", "-er", "-ne", 
       #["", "kvalitets"]),
 RegS (fk,  t, "konklusion", "-en", "-er", "-ne", #[""]),
 RegS (fk,  f, "koordinering", "-en", "", "", #[""]),
 RegS (fk,  t, "kultur", "-en", "", "", #[""]),
 RegS (fk,  t, "kvalitet", "-en", "-er", "-ne", 
       #["", "livs", "software"]),
 RegS (fk,  f, "læring", "-en", "", "", #[""]),
 RegS (fk,  t, "metode", "-n", "-r", "-ne", #[""]),
 RegS (itk, t, "miljø", "-et", "-er", "-ne", 
       #["", "forsknings", "lærings", "undervisnings"]),
 RegS (itk, t, "ministerium", "ministeriet", "ministerier", "-ne", 
       #["", "forsknings", "miljø", "undervisnings"]),
 RegS (fk,  t, "model", "-len", "-ler", "-ne", #[""]),
 RegS (itk, t, "netværk", "-et", "-", "-erne", #[""]),
 RegS (itk, t, "niveau", "-et", "-er", "-ne", #[""]),
 RegS (itk, t, "område", "-t", "-r", "-ne", 
       #["", "indsats", "problem"]),
 RegS (fk,  f, "omstilling", "-en", "", "", #[""]),
 RegS (fk,  t, "organisation", "-en", "-er", "-ne", 
       #["", "arbejds"]),
 RegS (itk, t, "paradigme", "-t", "-r", "-ne",
       #["", "omstillings", "videns"]),
 RegS (fk,  t, "parameter", "-en", "parametre", "-ne", 
       #["", "evaluerings", "konkurrence"]),
 RegS (itk, t, "partnerskab", "-et", "-er", "-ne", #[""]),
 RegS (fk,  t, "politik", "-ken", "", "", 
       #["", "forsknings", "IT-", "teknologi", "uddannelses"]),
 RegS (itk, t, "potentiale", "-t", "-r", "-ne", 
       #["", "samarbejds", "udviklings"]),
 RegS (itk, t, "problem", "-et", "-er", "-ne", #["", "samarbejds"]),
 RegS (fk,  t, "proces", "-sen", "-ser", "-ne", 
       #["", "beslutnings", "forsknings", "uddannelses", "udviklings"]),
 RegS (itk, t, "program", "-met", "-mer", "-ne", 
       #["forsknings", "udviklings", "undervisnings"]),
 RegS (itk, t, "projekt", "-et", "-er", "-ne", 
       #["", "forsknings", "udviklings"]),
 RegS (fk,  t, "prototype", "-n", "-r", "-ne", #["", "software"]),
 RegS (fk,  t, "rapport", "-en", "-er", "-ne", 
       #["", "arbejds", "forsknings"]),
 RegS (fk,  t, "relation", "-en", "-er", "-ne", #[""]),
 RegS (itk, t, "resultat", "-et", "-er", "-ne", 
       #["", "evaluerings", "forsknings"]),
 RegS (fk,  t, "ressource", "-n", "-r", "-ne", #[""]),
 RegS (itk, t, "råd", "-et", "-", "-ene", 
       #["center", "forsknings", "uddannelses"]),
 RegS (itk, t, "samfund", "-et", "", "", 
       #["", "industri", "info-", "informations", "videns"]),
 RegS (itk, f, "samspil", "-let", "", "", #[""]),
 RegS (itk, t, "scenario", "scenariet", "scenarier", "-ne", #[""]),
 RegS (fk,  t, "situation", "-en", "-er", "-ne", 
       #["", "arbejds", "brugs"]),
 RegS (fk,  f, "software", "-n", "", "", 
       #["", "apparat"]),
 RegS (fk,  t, "stilling", "-en", "-er", "-ne", 
       #["ind", "problem"]),
 RegS (fk,  t, "struktur", "-en", "-er", "-ne", 
       #["", "virksomheds", "samfunds"]),
 RegS (fk,  t, "synsvinkel", "synsvinklen", "synsvinkler", "-ne",
       #["bruger", "leder", "organisations", "software", "teknologi"]),
 RegS (itk, t, "system", "-et", "-er", "-ne", 
       #["", "edb-", "informations", "IT-", "kommunikations"]),
 RegS (fk,  f, "teknik", "-ken", "-ker", "-ne", 
       #["", "edb-", "produktions"]),
 RegS (fk,  t, "teknologi", "-en", "-er", "-ne", 
       #["", "informations", "kommunikations", "koncern", 
         "multimedie", "netværks", "software"]),
 RegS (fk,  f, "teori", "-en", "-er", "-ne", #[""]),
 RegS (fk,  t, "tilpasning", "-en", "", "", #[""]),
 RegS (fk,  f, "uddannelse", "-n", "-r", "-ne", 
       #["efter", "videre"]),
 RegS (fk,  t, "undersøgelse", "-n", "-r", "-ne", #[""]),
 RegS (itk, t, "universitet", "-et", "-er", "-ne", #[""]),
 RegS (itk, t, "udvalg", "-et", "-", "-ene", #[""]),
 RegS (itk, f, "udstyr", "-et", "", "", #[""]),
 RegS (fk,  t, "udvikling", "-en", "", "",
       #["", "IT-", "samfunds", "edb-", "kvalitets", "produkt", "videre"]),
 RegS (fk,  f, "viden", "", "", "", #[""]),
 RegS (fk,  t, "virksomhed", "-en", "-er", "-ne", 
       #["", "software"]),
 RegS (fk,  t, "virkning", "-en", "-er", "-ne", #[""])
]

fun boejS (RegS(koen, artk, ubsen, besen, ubsfl, besfl, _)) form =
    case form of 
        (ubs, ent) => ubsen
      | (bes, ent) => tilfoej ubsen besen
      | (ubs, flt) => tilfoej ubsen ubsfl
      | (bes, flt) => tilfoej (tilfoej ubsen ubsfl) besfl

fun koenS (RegS(koen, _, _, _, _, _, _)) = koen

fun taelleligS (RegS(_, artk, _, _, _, _, _)) = artk

fun muligS (RegS(koen, artk, ubsen, besen, ubsfl, besfl, prefs)) =
    (Vector.fromList
     (List.mapPartial (fn (s, f) => if s="" then NONE else SOME f)
                      [(ubsen, (ubs, ent)), 
                       (besen, (bes, ent)), 
                       (ubsfl, (ubs, flt)), 
                       (besfl, (bes, flt))]),
    prefs)

fun dobbeltS praefikser pref = 
    if Vector.length praefikser > 2 andalso pref <> "" andalso ssh 0.2 then
        let val pref1 = vaelgikke [pref, ""] praefikser
        in 
            if String.sub(pref1, size pref1 - 1) = #"-" then Str pref1
            else Str (pref1 ^ "-")
        end
        && (if ssh 0.3 then 
                if ssh 0.2 then Str "og/eller" else Str "eller"
            else Str "og")
    else
        Tom

fun vaelg formkrav =
    let val subst                = vaelgfra substantiver
        val (former, praefikser) = muligS subst
        val praef                = vaelgfra praefikser 
        val form = case formkrav of
                       NONE          => vaelgfra former
                     | SOME (b, flt) => if taelleligS subst then (b, flt) 
                                        else (b, ent)
                     | SOME form     => form
        val nom = dobbeltS praefikser praef && Str (praef ^ boejS subst form) 
    in (form, koenS subst, nom, taelleligS subst) end
    handle Umulig => vaelg formkrav

fun possesiv Tom        = Tom
  | possesiv (Str s)    = Str (s ^ "s")
  | possesiv (s1 && s2) =
    case possesiv s2 of 
        Tom => possesiv s1
      | s2' => s1 && s2'