program Spanish_Verbs;

{
Conjugating Spanish Verbs: A Complete Specification

The program below conjugates all Spanish verbs. Given an infinitive,
it computes the class of the verb, and uses the class to derive the
stems and endings for all tenses.

Why teach a computer to conjugate Spanish verbs? My purpose was
primarily pedagogical. I find the published descriptions of how to
conjugate Spanish verbs frustratingly incomplete, imprecise, and
disorganized. A program to accomplish the conjugating is, in contrast,
by its very nature formal, precise, complete, and verifiably correct.

One way to implement the program, of course, would be to have it merely
look up each form in a big table. This would work, but would have no
interest. What one wants instead is a program that wherever possible
works using general linguistic rules. The program below, which has
subprograms for diphthonguizing, weakening, respelling, and so on,
represents my best effort to arrive at such general rules.

I find the program helpful in several ways. Studying the way features are
computed is the simplest possible way to learn how irregularities are distributed.
By studying the program's transformations, one can quickly internalize
its linguistic knowledge. For example, its 'irregular_imperfect'
subprogram hilights the fact that Spanish has only two irregular
imperfects - those of 'ir' and of 'ser'.

The program was developed as an MPW tool. Although I paid no
attention to performance issues, its responses are essentially
immediate.}

{ FEATURES }

type
	feature = (
	
		{ Accentuation }
		accent_present, accent_preterite, accent_participle, accent_imos, 	
		
		{ Orthography }
		c_qu,	qu_c,
		c_g, c_zc,
		c_z, z_c,
		g_gu, gu_g,
		g_j,
		l_lg, n_ng, s_sg,
		u_uy, uu_uuy, {Why is _y necessary?}
		a_aig, o_oig,																		
		
		{ Unusual respellings }
		re_r, u_utrema, o_oy, ues_hues, cab_quep,
		hab_hay, sab_sep, sab_s,												

		{ Diphthongization }
		diphthongs, semidiphthongs,
		
		{ Weakening }
		weak_preterite, weak_present, weak_subjunctive, weak_gerund, 
		
		{ Present }
		pres_haber, pres_ser, pres_estar, pres_ir, pres_dar,
		pres_reir,	pres_ver, pres_saber,								
		
		{ Future }
		future_CVr_Cr, future_CVr_Vr, future_VCV2r_V2r, future_CVr_Cdr,
				
		{ Imperative }
		imperative_is_stem, imperative_irr,							
		
		{ Imperfect }
		imperfect_estar, imperfect_ir,
		
		{ Preterite }
		pret_j, pret_y, pret_c_z, pret_nll,					
		
		{ Classes }
		pret_dij, pret_duj, pret_pus, pret_quis, pret_sup, pret_tuv,
		pret_traj, pret_vin,												
		
		{ Onesies }
		pret_anduv, pret_cup, pret_estuv, pret_hub, pret_hic, pret_pud,
		pret_satisfic, pret_di, pret_fui, pret_vi, pret_eron,
																								
				
		{ Past Participle }
		pp,
		
		{ Gerund }
		ger_reir, ger_ver,  {currently the same as pres_reir, pres_ver}
		
		{ Infinitives }
		inf_podrir, inf_ver													
		
		);
		
	set_of_features = set of feature;
	
const
	first_feature = accent_present;
	last_feature = inf_ver;

{ FORMS }

const
	num_forms = 6;
	all = [1..num_forms];

type
	forms = 1..num_forms;
	set_of_forms = set of forms;

{ PHONEMES }

type
	set_of_char = set of char;
	
const
	soft_vowels = ['e', 'i', '', ''];
	hard_vowels = ['a', 'o', 'u', '', '', ''];
	accented_vowels = ['', '', '', '', ''];
	vowels = hard_vowels + soft_vowels;

{ TENSES }

type
	tense = (present, imperfect, preterite, future, conditional,
			 present_subjunctive, imperfect_subjunctive1,
			 imperfect_subjunctive2, imperative, nonpersonals);
	set_of_tenses = set of tense;
			 
const
	first_tense = present;
	last_tense = nonpersonals; { It is important that this be last }
	gerund = 1;
	participle = 2;
	
{ VERBS }

type
	morpheme = string[15];
	morphemes = array[1..num_forms] of morpheme;

	stem = morpheme;
	stems = morphemes;

	ending = morpheme;
	endings = morphemes;
	
	conjugations = 1..3;

	str255 = string[255];
	str25 = string[25];
	
	verb = record
		infinitive: str25;
		f: set_of_features;
		s: array[tense] of stems;
		e: array[tense] of endings;
		end;

var
	present_endings, preterite_endings,
		imperfect_endings, pres_subj_endings, non_personal_endings: 
			array[conjugations] of endings;
		
	subjects, future_endings, conditional_endings,
		imperf_subj1_endings, imperf_subj2_endings: endings;
		
	tense_names: array[tense] of string[30];

{ UTILITIES }

{ Duplicate a morpheme }

function dup(the_morpheme: str255): morphemes;
	var i: integer; rv: stems;
begin
	for i := 1 to num_forms do
		rv[i] := the_morpheme;
	dup := rv;
end;

{ Construct an array of morphemes from a blank-delimited list }
	
function morphs(the_morphemes: str255): morphemes;
	var i, p: integer; rv: stems;
begin
	if the_morphemes[length(the_morphemes)] <> ' ' then
		the_morphemes := concat(the_morphemes, ' ');
	for i := 1 to num_forms do begin
		p := pos(' ', the_morphemes);
		rv[i] := copy(the_morphemes, 1, p-1);
		delete(the_morphemes, 1, p); end;	
	morphs := rv;
end;

{ Construct one tense from its stems and endings}

procedure assign(var v: verb; t: tense; s: stems; e: endings);
begin
	v.s[t] := s;
	v.e[t] := e;
end;

function ends_with(s: string; ending: string): boolean;
	var p: integer;
begin
	ends_with := false;
	p := pos(ending, s);
	if p = 0 then exit(ends_with);
	ends_with := p = length(s) - length(ending) + 1;
end;

{ Given an infinitive, compute the set of features for the verb }

function feature_set(verb: string): set_of_features;

var the_feature: feature;
		rv: set_of_features;

function match(verb, pattern: string): boolean;
	var v, p, i: integer; sc: set of char; negated: boolean;
begin
	match := false;
	p := length(pattern);
	v := length(verb);
	while p >= 1 do begin
		case pattern[p] of
		']': begin
			i := p - 1;
			sc := [];
			negated := false;
			while pattern[i] <> '[' do begin
				if pattern[i] = '' then
					negated := true
				else
					sc := sc + [pattern[i]];
				i := i - 1;
			end;
			if negated and (verb[v] in sc) then exit(match)
			else if not(verb[v] in sc) then exit(match);
			p := i; end;
		'C': if verb[v] in ['a', 'e', 'i', 'o',
				'u', '', '', '', '', ''] then exit(match);
		'-': begin match := true; exit(match); end;
		otherwise
			if pattern[p] <> verb[v] then exit(match);
		end;
		p := p - 1;
		v := v - 1;
	end;
	match := v = 0;
end;

procedure check(s: string);
begin
	if match(verb, s) then rv := rv + [The_Feature];
end;
procedure except(s: string);
begin
	if match(verb, s) then rv := rv - [The_Feature];
end;

begin

rv := [];
{ Accentuation }
 The_Feature :=   accent_present;
		check('ahincar');
		check('ahuchear');
		check('-ahigar');
		check('ciar');
		check('vaciar');
		check('rociar'); 
		check('adiar');
		check('jadiar');
		check('-fiar'); except('amafiar'{?});
		check('vigiar');
		check('cuchichiar');
		check('enlejiar');
		check('liar');
		check('aliar');
		check('abaliar');
		check('engaliar');
		check('desaliar');
		check('ampliar');
		check('desliar');
		check('miar');
		check('jipiar');
		check('espiar');
		check('ispiar');
		check('expiar');
		check('-riar'); except('cariar');
		check('asalariar');
		check('calabriar');
		check('descriar');
		check('aseriar');
		check('agriar');
		check('desagriar');
		check('coriar');
		check('desmemoriar');
		check('emburriar');
		check('desmurriar');
		check('canturriar}');
		check('demasiar');
		check('anestasiar');
		check('autopsiar');
		check('tataratiar');
		check('cuantiar');
		check('hastiar');
		check('enhastiar');
		check('amnistiar');
		check('-guiar'); except('menguiar');
		check('baquiar');
		check('esquiar');
		check('-viar'); except('-graviar'); except('abreviar');
		check('aliviar');
		check('diluviar');
		check('ahijar');
		check('desahijar');
		check('prohijar');
		check('acairelar?');
		check('reilar');
		check('ahilar');
		check('raspahilar');
		check('respahilar');
		check('rehilar');
		check('sobrehilar');
		check('-aullar');
		check('-traillar');
		check('-aullar');
		check('-islar');
		check('-embaular');
		check('maular');
		check('taimar');
		check('-ahumar'); except('ahumar'{?});
		check('amainar');
		check('sainar');
		check('desainar');
		check('enzainar');
		check('descafeinar');
		check('amohinar');
		check('amaitinar');
		check('aunar');
		check('aupar');
		check('ahilerar');
		check('airar');
		check('desairar');
		check('parausar');
		check('parahusar');
		check('-ahitar');
		check('desbarahustar');
		check('adecuar');
		check('licuar');
		check('colicuar');
		check('promiscuar');
		check('-duar');
		check('-luar');
		check('-nuar');
		check('puar');
		check('-ruar'); except('arruar');
		check('acensuar');
		check('-tuar');
		check('ganzuar');
		check('-aizar'); except('judaizar');
		check('europeizar');
		check('-ohibir');
		check('reunir');
			
 The_Feature :=   accent_preterite;
		check('-aer'); except('traer');
		check('-r');
		
 The_Feature :=   accent_preterite;
		check('-aer');
		
 The_Feature :=   accent_imos;
		check('-r');

{ Orthography }
 The_Feature :=   c_qu;
		check('-car');
 The_Feature :=   qu_c;
		check('-quir');


 The_Feature :=   c_g;
		check('-facer');
		check('-hacer');
		check('-macer');
		check('-decir');

 The_Feature :=   c_zc;
		check('-placer');
		check('-nacer');
		check('-pacer');
		check('yacer');
		check('-ecer'); except('mecer'); except('remecer');
		check('-nocer');
		check('-ducir');
		check('-lucir');


 The_Feature :=   c_z;
		check('mecer');
		check('remecer');
		check('-Ccer');
		check('-cocer');
		check('-Ccir');
		
 The_Feature :=   z_c;
		check('-zar');


 The_Feature :=   g_gu;
		check('-gar');

 The_Feature :=   gu_g;
		check('-guir');

 The_Feature :=   g_j;
		check('-ger');
		check('-gir');


 The_Feature :=   l_lg;
		check('-valer');
		check('-salir');

 The_Feature :=   n_ng;
		check('-tener');
		check('-poner');
		check('-venir');

 The_Feature :=   s_sg;
		check('-asir');


 The_Feature :=   u_uy;
		check('-uir'); except('-guir');
		check('-gir'); {[Phonetical!]}
 The_Feature :=   uu_uuy;
		check('-uir'); except('-guir');
		check('-gir'); {[Phonetical!] [Why necessary?]}

 The_Feature :=   a_aig;
		check('-aer');

 The_Feature :=   o_oig;
		check('-oer');
		check('-or');


{ Unusual respellings }
 The_Feature :=   re_r;
		check('-rer');

 The_Feature :=   u_utrema;
		check('-guar');

 The_Feature :=   o_oy;
		check('-or');

 The_Feature :=   ues_hues;
		check('desosar');

 The_Feature :=   cab_quep;
		check('caber');


 The_Feature :=   hab_hay;
		check('haber');

 The_Feature :=   sab_sep;
		check('-saber');

 The_Feature :=   sab_s;
		check('-saber');


{ Diphthongization }
 The_Feature :=   diphthongs;
		check('-probar');
		check('-herbar');
		check('-volcar');
		check('-clocar');
		check('desflocar,');
		check('enllocar');
		check('enrocar?');
		check('-trocar');
		check('-aporcar'); except('aporcar'{+});
		check('-beldar');
		check('-goldar');
		check('-soldar');
		check('hacendar');
		check('-mendar'); except('arremendar');
		check('rodar');
		check('sonrodar');
		check('jamerdar');
		check('-cordar');
		check('desencorvear');
		check('cegar');

		check('-plegar');
		check('negar');
		check('abnegar');
		check('denegar');
		check('renegar');
		check('desnegar,');
		check('regar');
		check('-fregar');
		check('sorregar');
		check('-estregar');
		check('-segar');
		check('-olgar');
		check('derrengar');
		check('alongar');
		check('rogar');
		check('jugar');
		check('temblar');
		check('-moblar');

		check('-poblar');
		check('helar');
		check('deshelar');
		check('melar');
		check('desmelar');
		check('collar'); except('amacollar');
		check('follar');
		check('afollar');
		check('degollar');
		check('hollar');
		check('rehollar');
		check('remollar');
		check('desollar');

		check('resollar');
		check('colar');
		check('recolar');
		check('socolar');
		check('trascolar');
		check('escolar');

		check('dolar');
		check('-ajolar');
		check('amolar');
		check('remolar');
		check('-solar'); except('-risolar');

		check('-volar');
		check('azolar');
		check('anzolar');
		check('abuolar');
		check('femar');
		check('dezmar');
		check('tronar');

		check('atronar');
		check('retronar');
		check('sonar');
		check('asonar');
		check('resonar');
		check('disonar');
		check('grandisonar');

		check('unisonar');
		check('consonar');
		check('tonar');
		check('gobernar');
		check('-gobernar');
		check('infernar');
		check('apernar');

		check('entrepernar');
		check('despernar');
		check('-invernar');
		check('-cornar');
		check('alebrar');
		check('-quebrar');

		check('-embrar');
		check('-pedrar');
		check('deslendrar');
		check('encorar');
		check('-aforar');
		check('agorar');
		check('malagorar');

		check('engorar');
		check('ajorar');
		check('atorar');
		check('-errar'); except('berrar'{?});
		check('-contrar');
		check('adestrar');

		check('-mostrar');
		check('confesar');
		check('-tesar');
		check('-travesar');
		check('incensar');
		check('pensar');
		check('repensar');

		check('-engrosar');
		check('desosar');
		check('-pretar');
		check('-soltar');
		check('-centar'); except('adecentar');
		check('-dentar,'); except('accidentar');

		check('-alentar');
		check('mentar');
		check('amentar');
 
		check('sementar');
		check('-cimentar');
		check('regimentar');
		check('salpimentar');
		check('escarmentar');

		check('sarmentar');
		check('ensarmentar');
		check('emparentar');
		check('ensangrentar');
		check('sentar');

		check('asentar');
		check('desasentar');
		check('rusentar');
		check('tentar');
		check('atentar');
		check('desatentar');
 
		check('retentar');
		check('destentar');
		check('-ventar');
		check('-contar');
		check('encubertar');
		check('-certar');

		check('despertar');
		check('entortar');
		check('-festar');
		check('-hestar');
		check('asestar');
		check('atestar');

		check('-costar');
		check('-nostar');
		check('-tostar');
		check('-nevar');
		check('encovar');
		check('renovar');
		check('-pezar');

		check('-lenzar');
		check('-menzar');
		check('-vergonzar');
		check('-forzar'); except('alforzar');
		check('-soar');
		check('-cocer');
		check('-torcer');
		check('heder');
		check('-cender');
		check('defender');
		check('hender');

		check('tender');
		check('poder');
		check('perder');
		check('-morder');
		check('-oler');
		check('cerner');
		check('-erer');
		check('-erter');

		check('-olver');
		check('-over');
		check('hendir');
		check('-ormir');
		check('-cernir');
		check('-erir');
		check('-irir');
		check('-morir');

		check('-entir');
		check('-ertir');
		check('-hervir');

			
 The_Feature :=   semidiphthongs;
		check('-tener');
		check('-venir'); {[Diphthongization distorted by n => ng]}

{ Weakening }
 The_Feature :=   weak_preterite;
		check('-cebir');
		check('-edir');
		check('rendir');
		check('-egir');
		check('-henchir');
		check('-emir');
		check('-dormir');
 
		check('-erir');
		check('-morir');
		check('-etir');
		check('-entir');
		check('-ertir');
		check('-estir');
		check('-eguir');
 
		check('-erguir');
		check('-ervir');
		check('-eir');

 The_Feature :=   weak_present;
		check('-cebir');
		check('-decir');
		check('-edir');
		check('rendir');
		check('-egir');
		check('-henchir');
		check('-emir');
		check('-etir');

		check('-estir');
		check('-eguir');
		check('-erguir');
		check('-servir');
		check('-eir');
 
 The_Feature :=   weak_subjunctive;
		check('-e[bcdgmtr]ir');
		check('rendir');
		check('-henchir');
		check('-e[nrs]tir');
		check('-eguir');

		check('erguir');
		check('-dormir');
		check('-morir');
		check('-ervir');

 The_Feature :=   weak_gerund;
		check('poder');
		check('-e[bcdgmrt]ir');
		check('rendir');
		check('-henchir');
		check('-dormir');
		check('-venir');

		check('-morir');
		check('-e[nsr]tir');
		check('-eguir');
		check('-erguir');
		check('-ervir');


{ Present }
 The_Feature :=   pres_haber;
		check('haber');

 The_Feature :=   pres_ser;
		check('ser');

 The_Feature :=   pres_estar;
		check('estar');

 The_Feature :=   pres_ir;
		check('ir');

 The_Feature :=   pres_dar;
		check('dar');


 The_Feature :=   pres_reir;
		check('-rer');

 The_Feature :=   pres_ver;
		check('-ver'); except('-volver'); except('-mover');
 The_Feature :=   pres_saber;
		check('-saber');


{ Future }
 The_Feature :=   future_CVr_Cr;
		check('-aber');
		check('-oder');
		check('-querer');

 The_Feature :=   future_CVr_Vr;
		check('-facer');
		check('-hacer');
		check('-macer');

 The_Feature :=   future_VCV2r_V2r;
		check('-decir');

 The_Feature :=   future_CVr_Cdr;
		check('-valer');
		check('-tener');
		check('-poner');
		check('-salir');
		check('-venir');


{ Imperative }
 The_Feature :=   imperative_is_stem;
		check('-tener');
		check('-poner');
		check('-salir');
		check('-venir');

 The_Feature :=   imperative_irr;
		check('-haber');
		check('-facer'); except('satisfacer');
		check('-hacer');
		check('ir');
		check('-decir'); except('predecir'); except('maldecir'); except('bendecir');

{ Imperfect }
 The_Feature :=   imperfect_estar;
		check('estar');

 The_Feature :=   imperfect_ir;
		check('ir');


{ Preterite }
 The_Feature :=   pret_j;
		check('-traer');
		check('-decir');
		check('-ducir');

 The_Feature :=   pret_y;
		check('-aer');
		check('-eer');
		check('-oer');
		check('[gq]uir');
		check('-gir');
		check('embar');
		check('-or');

 The_Feature :=   pret_c_z;
		check('-facer');
		check('-hacer');
		check('-macer');

 The_Feature :=   pret_nll;
		check('-ller');
		check('-er');


{ Classes }
 The_Feature :=   pret_dij;
		check('-decir');

 The_Feature :=   pret_duj;
		check('-ducir');

 The_Feature :=   pret_pus;
		check('-poner');

 The_Feature :=   pret_quis;
		check('-querer');

 The_Feature :=   pret_sup;
		check('-saber');

 The_Feature :=   pret_tuv;
		check('-tener');


 The_Feature :=   pret_traj;
		check('-traer');

 The_Feature :=   pret_vin;
		check('-venir');


{ Onesies }
 The_Feature :=   pret_anduv;
		check('andar');

 The_Feature :=   pret_cup;
		check('caber');

 The_Feature :=   pret_estuv;
		check('estar');

 The_Feature :=   pret_hub;
		check('haber');

 The_Feature :=   pret_hic;
		check('hacer');

 The_Feature :=   pret_pud;
		check('poder');


 The_Feature :=   pret_satisfic;
		check('satisfacer');

 The_Feature :=   pret_di;
		check('dar');

 The_Feature :=   pret_fui;
		check('ser');
		check('ir');

 The_Feature :=   pret_vi;
		check('ver');

 The_Feature :=   pret_eron;
		check('ser');
		check('ir');


{ Past Participle }
 The_Feature :=   pp;
		check('-facer');
		check('-hacer');
		check('-macer');
		check('-poner');
		check('-ver'); except('llover'); except('-mover');
		check('-decir');
		check('-podrir');
		check('-pudrir');
		check('-vivir');

{ Gerund }
 The_Feature :=   ger_reir;

 The_Feature :=   ger_ver;

{ Infinitives }
 The_Feature :=   inf_podrir;
		check('-podrir');
		check('-pudrir');

 The_Feature :=   inf_ver;
		check('-ver'); except('-olver'); except('-mover'); except('llover');
		
		feature_set := rv;
		
end {feature_set};

{ LINGUISTIC PRIMITIVES }

{ Decide whether the given ending is accented }

function unaccented(e: ending): boolean;
	var i, n_vowels: integer;
begin
	unaccented := false;
	n_vowels := 0;
	for i := 1 to length(e) do begin
		if e[i] in accented_vowels then exit(unaccented);
		if e[i] in vowels then begin
			n_vowels := n_vowels + 1;
			if n_vowels > 1 then exit(unaccented); end;
	end;
	unaccented := true;
end;

{ Compute the accented form of a vowel }

function accented(ch: char): char;
begin
	case ch of
		'a': accented := '';
		'e': accented := '';
		'i': accented := '';
		'o': accented := '';
		'u': accented := '';
		otherwise accented := ch;
	end;
end;

{ Given a vowel and its context, return the dipthong }

function diphthong(previous, the_vowel: char): string;
begin
	case the_vowel of 
		'e', 'i': if previous = '$' then diphthong := 'ye'
					else diphthong := 'ie';
		'o', 'u': if previous = 'g' then diphthong := 'e'
				 else if previous = '$' then diphthong := 'hue'
				 else diphthong := 'ue';
		otherwise diphthong := '??'; end;
end;

{ Find the last true vowel in a stem }

function last_vowel_in(the_stem: str255): integer;
	var i: integer;
begin
	i := length(the_stem);
	if (the_stem[length(the_stem)] = 'u')
			and (the_stem[length(the_stem)-1] = 'g') then
		i := i - 1;
	while (not(the_stem[i] in vowels)) and (i>0) do
		i := i - 1;
	last_vowel_in := i;
end;

{ Return the weakened form of a vowel }

function weakened(the_vowel: char): char;
begin
	case the_vowel of
		'e': weakened := 'i';
		'o': weakened := 'u';
		otherwise weakened := the_vowel;
	end;
end;

{ Decide whether a verb is 1st, 2nd, or 3rd conjugation }

function conjugation_of(inf: str255): conjugations;
	label 9;
begin
	if inf[length(inf)] <> 'r' then
		goto 9;
	case inf[length(inf)-1] of
		'a': conjugation_of := 1;
		'e': conjugation_of := 2;
		'i', '': conjugation_of := 3;
		otherwise 9: begin
			writeln('Bad infinitive ', inf);
			halt;
		end; end;
end;

{ VERB TRANSFORMATIONS }

{ Accentuate the stem }

procedure accentuate(var s: stem);
	var i: integer;
begin
	i := last_vowel_in(s);
	s[i] := accented(s[i]);
end;

{ Accentuate the stem if the ending is unaccented }

procedure accent(var v: verb; f: feature; tenses: set_of_tenses);
	var ch: char; i: integer; t: tense;
begin
	if not (f in v.f) then exit(accent);
	for t := first_tense to last_tense do if t in tenses then
		for i := 1 to num_forms do 
			if unaccented(v.e[t][i]) then
				accentuate(v.s[t][i]);
end;

{ Change accented vowels in stem to diphthongs }

procedure diphthonguize(var v: verb; fe: feature; tenses: set_of_tenses;
		which: set_of_forms);
	var i, f: integer; ch0, ch: char; t: tense;
begin
	if not (fe in v.f) then exit(diphthonguize);
	for t := first_tense to last_tense do if t in tenses then
		for f := 1 to num_forms do
			if (f in which) and (unaccented(v.e[t][f])) then begin
				i := last_vowel_in(v.s[t][f]);
				ch := v.s[t][f][i];
				if i > 1 then ch0 := v.s[t, f, i-1] else ch0 := '$';
				delete(v.s[t][f], i, 1);
				insert(diphthong(ch0, ch), v.s[t][f], i); end;
end;

{ Weaken accented vowels in the stem }

procedure weaken(var v: verb; f: feature; tenses: set_of_tenses;
		which: set_of_forms);
	var ch: char; i, w: integer; t: tense;
begin
	if not (f in v.f) then exit(weaken);
	for t := first_tense to last_tense do if t in tenses then
		for w := 1 to num_forms do
			if (w in which) or ((which = []) and (unaccented(v.e[t][w]))) then begin
				i := last_vowel_in(v.s[t][w]);
				v.s[t][w,i] := weakened(v.s[t][w,i]); end;
end;

{ Change the spelling of "orthographic" verbs }

procedure respell(var v: verb; f: feature; tenses: set_of_tenses;
		s1, s2: str25; c: set_of_char);
	var
		t: tense; i, w: integer; ch: char;
begin
	if not (f in v.f) then exit(respell);
	for t := first_tense to last_tense do
		if t in tenses then
			for w := 1 to num_forms do if v.e[t][w][1] in c then begin
				i := length(v.s[t][w]) - length(s1) + 1;
				if copy(v.s[t][w], i, length(s1)) = s1 then begin
					delete(v.s[t][w], i, length(s1));
					v.s[t][w] := concat(v.s[t][w], s2); end; end;
end;

{ Replace the specified character in the given context }

procedure contract(var v: verb; f: feature; tenses: set_of_tenses;
		before: set_of_char; the_char: char; after: set_of_char; replacement: str25);
	var
		t: tense; i, w: integer; ch: char;
begin
	if not (f in v.f) then exit(contract);
	for t := first_tense to last_tense do
		if t in tenses then
			for w := 1 to num_forms do begin
				if (v.s[t, w, length(v.s[t,w])] in before)
						and (v.e[t][w][1] = the_char)
						and (v.e[t, w, 2] in after) then begin
					delete(v.e[t, w], 1, 1);
					v.e[t, w] := concat(replacement, v.e[t,w]); end; end;
end;

{ Replace the old stem and ending with the new ones }

procedure irregular(var v: verb; fe: feature;
		t: tense; f: forms;
		old_stem, new_stem: stem; new_ending: ending);
	var
		p: integer;
begin
	if not(fe in v.f) then exit(irregular);
	p := pos(old_stem, v.s[t, f]);
	if p = 0 then exit(irregular);
	if not (p = length(v.s[t, f]) - length(old_stem) + 1) then exit(irregular);
	v.s[t, f, 0] := chr(ord(v.s[t, f, 0]) - length(old_stem));
	v.s[t, f] := concat(v.s[t, f], new_stem);
	v.e[t, f] := new_ending;
end;

{ IRREGULAR PRETERITES }

procedure do_irregular_preterites(var v: verb);

	procedure strong(var v: verb; f: feature;
			key: str25; new_stem: stem; p1, p3: ending);
		var p: integer;
	begin
		if not(f in v.f) then exit(strong);
		p := pos(key, v.infinitive);
		if p = 0 then exit(strong);
		new_stem := concat(copy(v.infinitive, 1, p-1), new_stem);
		assign(v, preterite, dup(new_stem), preterite_endings[2]);
		v.e[preterite][1] := p1;
		v.e[preterite][3] := p3;
	end;
	
begin
		strong(v, pret_dij, 'decir', 'dij', 'e', 'o');
		strong(v, pret_duj, 'ducir', 'duj', 'e', 'o');
		strong(v, pret_pus, 'poner', 'pus', 'e', 'o');
		strong(v, pret_quis, 'querer', 'quis', 'e', 'o');
		strong(v, pret_sup, 'saber', 'sup', 'e', 'o');
		strong(v, pret_tuv, 'tener', 'tuv', 'e', 'o');
		strong(v, pret_traj, 'traer', 'traj', 'e', 'o');
		strong(v, pret_vin, 'venir', 'vin', 'e', 'o');
 
		strong(v, pret_anduv, 'andar', 'anduv', 'e', 'o');
		strong(v, pret_cup, 'caber', 'cup', 'e', 'o');
		strong(v, pret_estuv, 'estar', 'estuv', 'e', 'o');
		strong(v, pret_hub, 'haber', 'hub', 'e', 'o');
		strong(v, pret_hic, 'hacer', 'hic', 'e', 'o');
		strong(v, pret_pud, 'poder', 'pud', 'e', 'o');
		strong(v, pret_satisfic, 'satisfacer', 'satisfic', 'e', 'o');

		strong(v, pret_di, 'dar', 'd', 'i', 'io');
		strong(v, pret_fui, 'ser', 'fu', 'i', 'e');
		strong(v, pret_fui, 'ir', 'fu', 'i', 'e');
		strong(v, pret_vi, 'ver', 'v', 'i', 'io');
		
		weaken(v, weak_preterite,	[preterite], [3,6]);
		
		contract(v, pret_y,
				[preterite, nonpersonals], vowels, 'i', vowels, 'y');
							
		contract(v, pret_j,
			[preterite], ['j'], 'i', ['e'], '');
			
		contract(v, pret_nll, [preterite, nonpersonals], ['', 'l'], 'i',
				vowels, '');
		
		if accent_preterite in v.f then begin
			v.e[preterite, 2, 1] := accented(v.e[preterite, 2, 1]);
			v.e[preterite, 4, 1] := accented(v.e[preterite, 4, 1]);
			v.e[preterite, 5, 1] := accented(v.e[preterite, 5, 1]);
			end;
			
		if accent_participle in v.f then
			v.e[nonpersonals, participle, 1] := accented(v.e[nonpersonals, participle, 1]);
		
		respell(v, re_r, [preterite], 're', 'r', ['i']);
		
		respell(v, pret_c_z, [preterite], 'c', 'z', hard_vowels);
		
		if pret_eron in v.f then
			v.e[preterite, 6] := 'eron';
		
end;

{ IRREGULAR PRESENTS }

procedure do_irregular_presents(var v: verb);

begin
	{ DIPHTHONGUIZING VERBS }	
	diphthonguize(v, diphthongs, [present, present_subjunctive], all);
	diphthonguize(v, semidiphthongs, [present], [2,3,6]);
	
	{ WEAKENING VERBS }
	weaken(v, weak_subjunctive, [present_subjunctive], [4,5]);
	weaken(v, weak_gerund, [nonpersonals], [gerund]);
	weaken(v, weak_present, [present, present_subjunctive], []);
						
	{ ACCENT-CHANGING VERBS }
	accent(v, accent_present,	[present, present_subjunctive]);
	if accent_imos in v.f then
				v.e[present, 4, 1] := accented(v.e[present, 4, 1]);
						
	{ ORTHOGRAPHIC VERBS }
	respell(v, c_g, [present, present_subjunctive],
		'c', 'g', hard_vowels);
	respell(v, c_zc, [first_tense .. last_tense], 
		'c', 'zc', hard_vowels);

	respell(v, c_qu, [first_tense .. last_tense],
		'c', 'qu', soft_vowels);	 
	respell(v, qu_c, [first_tense .. last_tense],
		'qu', 'c', hard_vowels);	 

	respell(v, c_z, [first_tense .. last_tense],
		'c', 'z', hard_vowels);
	respell(v, z_c, [first_tense .. last_tense],
		'z', 'c', soft_vowels);
		
	respell(v, g_gu, [first_tense .. last_tense],
		'g', 'gu', soft_vowels);
	respell(v, gu_g, [first_tense .. last_tense],
		'gu', 'g', hard_vowels);
		
	respell(v, g_j, [first_tense .. last_tense],
		'g', 'j', hard_vowels);
		
	respell(v, l_lg, [first_tense .. last_tense],
		'l', 'lg', hard_vowels);	
	respell(v, s_sg, [present, present_subjunctive],
		's', 'sg', hard_vowels);
	respell(v, n_ng, [present, present_subjunctive],
		'n', 'ng', hard_vowels);
		
	respell(v, u_uy, [first_tense..last_tense],
		'u', 'uy', vowels - ['i', '']);
	respell(v, uu_uuy, [first_tense..last_tense],
		'', 'y', vowels - ['i', '']);
		
	respell(v, a_aig, [present, present_subjunctive],
		'a', 'aig', hard_vowels);
	respell(v, o_oig, [present, present_subjunctive],
		'o', 'oig', hard_vowels);

	{ SPECIAL RESPELLINGS }
	respell(v, u_utrema, [first_tense .. last_tense], 'u', '', soft_vowels);
	respell(v, o_oy, [present], 'o', 'oy', ['e']);
	respell(v, ues_hues, [present, present_subjunctive], 'ues', 'hues', vowels);
	respell(v, cab_quep, [present, present_subjunctive], 'cab', 'quep', hard_vowels);
	respell(v, hab_hay, [present_subjunctive], 'hab', 'hay', hard_vowels);
	respell(v, sab_sep, [present_subjunctive], 'sab', 'sep', hard_vowels);
	
	{ IRREGULAR PARTICIPLES }
	irregular(v, pp, nonpersonals, participle, 'dec', 'dic', 'ho');
	irregular(v, pp, nonpersonals, participle, 'hac', 'hec', 'ho');
	irregular(v, pp, nonpersonals, participle, 'pon', 'pues', 'to');
	irregular(v, pp, nonpersonals, participle, 'satisfac', 'satisfec', 'ho');
	irregular(v, pp, nonpersonals, participle, 've', 'vis', 'to');
	irregular(v, pp, nonpersonals, participle, 'volv', 'vuel', 'to');
	irregular(v, pp, nonpersonals, participle, 'escrib', 'escri', 'to');
	irregular(v, pp, nonpersonals, participle, 'pudr', 'podr', 'ido');
	irregular(v, pp, nonpersonals, participle, 'romp', 'ro', 'to');

	irregular(v, pp, nonpersonals, participle, 'abr', 'abier', 'to');
	irregular(v, pp, nonpersonals, participle, 'cubr', 'cubier', 'to');
	

{ BRUTE IRREGULARITIES }

	if pres_haber in v.f then	assign(v, present, dup('h'), morphs('e as a emos abis an'));
		
	if pres_ser in v.f then begin
		assign(v, present, morphs('s e e s s s '), morphs('oy res s omos ois on'));
		v.s[present_subjunctive] := dup('se'); end;

	if pres_estar in v.f then begin
		v.e[present] := morphs('oy s  amos is n');
		v.e[present_subjunctive] := morphs(' s  emos is n'); end;
		
	if pres_ir in v.f then begin
		assign(v, present, dup('v'), morphs('oy as a amos ais an'));
		v.s[present_subjunctive] := dup('vay');
		end;
		
	if pres_dar in v.f then begin
		v.e[present, 1] := 'oy';
		v.e[present_subjunctive, 1] := '';
		v.e[present_subjunctive, 3] := '';	end;
		
	if pres_reir in v.f then begin
		respell(v, re_r, [present, present_subjunctive], 're', 'r', vowels - ['i', '']);
		v.s[present_subjunctive, 4] := 'ri';
		v.s[present_subjunctive, 5] := 'ri';
		v.s[nonpersonals, gerund] := copy(v.infinitive, 1, length(v.infinitive) - 3);	end;

	if pres_ver in v.f then begin
		v.e[present] := morphs('o s  mos is n');
		v.s[nonpersonals, gerund] := copy(v.infinitive, 1, length(v.infinitive) - 2);
	end;

	if pres_saber in v.f then irregular(v, sab_s, present, 1, 'sab', 's', '');
	
end;

{ IRREGULAR IMPERFECTS }
procedure do_irregular_imperfects(var v: verb);
begin
	if imperfect_estar in v.f then assign(v, imperfect, dup('er'), pres_subj_endings[2]);
	if imperfect_ir in v.f then assign(v, imperfect, dup('ib'), morphs('a as a amos ais an'));
end;

{ IRREGULAR FUTURES }

function do_irregular_futures(v: verb): stem;
	var rv: stem;
begin
	rv := v.infinitive;
	if rv[length(rv)-1] = '' then
		rv[length(rv)-1] := 'i';
		
	if future_CVr_Cr in v.f then
		delete(rv, length(rv) - 1, 1);
	if future_CVr_Vr in v.f then
		delete(rv, length(rv) - 2, 2);
	if future_VCV2r_V2r in v.f then
		delete(rv, length(rv) - 3, 2);
	if future_CVr_Cdr in v.f then
		rv[length(rv)-1] := 'd';
	do_irregular_futures := rv;
end;

{ IRREGULAR IMPERATIVES }

procedure do_irregular_imperatives(var v : verb);
begin

	if imperative_is_stem in v.f then begin
		v.s[imperative, 2] := copy(v.infinitive, 1, length(v.infinitive)-2);
		v.e[imperative, 2] := ''; end;
		
	irregular(v, imperative_irr, imperative, 2, 'h', 'h', 'e');
	irregular(v, imperative_irr, imperative, 2, 'dic', 'd', 'i');
	irregular(v, imperative_irr, imperative, 2, 'v', 'v', 'e');
	irregular(v, imperative_irr, imperative, 2, 'hac', 'haz', '');
	
end;

{ CONJUGATE A VERB }

function conjugate(infinitive: str255): verb;
	var
		root, imperf_subj_stem, fut_stem: stems; 
		t: tense; temp: stem;
		i: integer;	v: verb; n: conjugations;
begin
			
	{ INITIALIZE }
	for t := first_tense to last_tense do
		assign(v, t, dup('?'), dup('?'));
	
	{ INFINITIVE }
	v.infinitive := infinitive;
	
	{ CONJUGATION, ROOT, FEATURES }
	n := conjugation_of(v.infinitive);
	
	v.f := feature_set(v.infinitive);
	
	if inf_podrir in v.f then v.infinitive := 'pudrir';
	
	if inf_ver in v.f then root := dup(copy(v.infinitive, 1, length(v.infinitive) -1))
	else root := dup(copy(v.infinitive, 1, length(v.infinitive)-2));
	
	{ GERUND, PARTICIPLE }
	assign(v, nonpersonals, root, non_personal_endings[n]);
	
	{ PRESENT }
	assign(v, present, root, present_endings[n]);
	
	{ IMPERFECT }
	assign(v, imperfect, root, imperfect_endings[n]);
	
	{ IRREGULAR IMPERFECTS }
	do_irregular_imperfects(v);
	
	{ PRETERITE }
	assign(v, preterite, root, preterite_endings[n]);
	
	{ IRREGULAR PRETERITES }
	do_irregular_preterites(v);
	
	{ IRREGULAR FUTURES }
	fut_stem := dup(do_irregular_futures(v));
	
	{ FUTURE }
	assign(v, future, fut_stem, future_endings);
	
	{ CONDITIONAL }
	assign(v, conditional, fut_stem, conditional_endings);
	
	{ PRESENT SUBJUNCTIVE }
	assign(v, present_subjunctive, root, pres_subj_endings[n]);
	
	{ ROOT OF IMPERFECT SUBJUNCTIVE }
	temp := concat(v.s[preterite] [6], v.e[preterite] [6]);
	temp[0] := pred(pred(pred(temp[0])));
	imperf_subj_stem := dup(temp);
	accentuate(imperf_subj_stem[4]);
	
	{ IMPERFECT SUBJUNCTIVE }
	assign(v, imperfect_subjunctive1, imperf_subj_stem, imperf_subj1_endings);
	assign(v, imperfect_subjunctive2, imperf_subj_stem, imperf_subj2_endings);
	
	{ IRREGULAR PRESENTS }
	do_irregular_presents(v);
	
	{ IMPERATIVE }
	v.s[imperative, 2] := v.s[present, 3];
	v.e[imperative, 2] := v.e[present, 3];
	
	v.s[imperative, 5] := v.infinitive;
	delete(v.s[imperative, 5], length(v.s[imperative, 5]), 1);
	v.e[imperative, 5] := 'd';
	
	{ IRREGULAR IMPERATIVES }
	do_irregular_imperatives(v);
	
	{ THE CONJUGATED VERB }
	conjugate := v;
end;

{ USER INTERFACE }

procedure print_conjugation(v: verb);
	var t: tense; i: integer; s1, s2: str255;
		temp, cw1, cw2, cw3: integer;
		
	{ Compute column widths }
	
	procedure w(t1, t2: tense);
		var i: integer;
	begin
		for i := 1 to 3 do begin
			temp := length(subjects[i]) + 1 + length(v.s[t1,i]) + length(v.e[t1, i]);
			if temp > cw1 then cw1 := temp;
			temp := length(subjects[i+3]) + 1 + length(v.s[t1,i+3]) + length(v.e[t1, i+3]);
			if temp > cw2 then cw2 := temp;
			temp := length(subjects[i]) + 1 + length(v.s[t2,i]) + length(v.e[t2, i]);
			if temp > cw3 then cw3 := temp; end;
		if cw1 + cw2 < length(tense_names[t1]) then
			cw2 := length(tense_names[t1]) - cw1;
			
	end {w};
	
	{ Print two tenses in columns }
	
	procedure p(t1, t2: tense);
		var s1, s2, s3, s4: str255; i: integer;
	begin
		writeln;
			
		writeln(tense_names[t1], ' | ':cw1 + cw2 + 6 - length(tense_names[t1]), tense_names[t2]);
		for i := 1 to 3 do begin
			s1 := concat(subjects[i], ' ', v.s[t1][i], v.e[t1][i]);
			s2 := concat(subjects[i+3], ' ', v.s[t1][i+3], v.e[t1][i+3]);
			s3 := concat(subjects[i], ' ', v.s[t2][i], v.e[t2][i]);
			s4 := concat(subjects[i+3], ' ', v.s[t2][i+3], v.e[t2][i+3]);
			writeln(s1, ' | ': cw1+3 -length(s1), 
							s2, ' | ': cw2+3 -length(s2),
							s3, ' | ': cw3+3  - length(s3), s4); end;
	end;
begin
	
	cw1 := 0; cw2 := 0; cw3 := 0;
	w(present, present_subjunctive);
	w(imperfect, imperfect_subjunctive1);
	w(preterite, imperfect_subjunctive2);
	w(future, conditional);

	writeln;
	writeln('Infinitive: ', v.infinitive);
	writeln('------------');
	p(present, present_subjunctive);
	p(imperfect, imperfect_subjunctive1);
	p(preterite, imperfect_subjunctive2);
	p(future, conditional);
	
	writeln;
	writeln('Imperatives ', v.s[imperative, 2], v.e[imperative, 2],
									  '  ',	v.s[imperative, 5], v.e[imperative, 5]);
	writeln('Gerundive ', v.s[nonpersonals, gerund], v.e[nonpersonals, gerund]);
	writeln('Participle ', v.s[nonpersonals, participle], v.e[nonpersonals, participle]);
end;

{ INITIALIZATION }

procedure initialize;
begin
	
	{ SUBJECTS }
	
	subjects            	:= morphs('yo tu l nosotros vosotros ellos');
	
	{ ENDINGS }
	
	present_endings[1]  	:= morphs('o as a amos is an');
	present_endings[2]  	:= morphs('o es e emos is en');
	present_endings[3] 		:= morphs('o es e imos s en');
	
	future_endings      	:= morphs(' s  emos is n');
	conditional_endings 	:= morphs('a as a amos ais an');
	
	imperfect_endings[1]  := morphs('aba abas aba bamos abais aban');
	imperfect_endings[2]	:= conditional_endings;
	imperfect_endings[3]	:= conditional_endings;
	
	preterite_endings[1] 	:= morphs(' aste  amos asteis aron');
	preterite_endings[2]	:= morphs(' iste i imos isteis ieron');
	preterite_endings[3]	:= preterite_endings[2];
	
	pres_subj_endings[1]			:= present_endings[2];
	pres_subj_endings[1] [1]		:= 'e';
	pres_subj_endings[2]			:= present_endings[1];
	pres_subj_endings[2] [1]		:= 'a';
	pres_subj_endings[3]			:= pres_subj_endings[2];
	
	imperf_subj1_endings			:= morphs('ra ras ra ramos rais ran');
	imperf_subj2_endings			:= morphs('se ses se semos seis sen');
	
	non_personal_endings[1] := morphs('ando ado        ');
	non_personal_endings[2] := morphs('iendo ido       ');
	non_personal_endings[3] := non_personal_endings[2];
	
	{ TENSE NAMES }
	
	tense_names[present] := 'Present Indicative';
	tense_names[imperfect] := 'Imperfect Indicative';
	tense_names[preterite] := 'Preterite Indicative';
	tense_names[future] := 'Future Indicative';
	tense_names[conditional] := 'Conditional';
	tense_names[present_subjunctive] := 'Present Subjunctive';
	tense_names[imperfect_subjunctive1] := 'Imperfect Subjunctive (1)';
	tense_names[imperfect_subjunctive2] := 'Imperfect Subjunctive (2)';
	

end;

{ MAIN }

{ Conjugate one verb and print it }

procedure show(infinitive: str255);
	var v: verb;
begin
	if (length(infinitive) < 2)
			| (not(infinitive[length(infinitive)-1] in ['a', 'e', 'i', ''])) then begin
		writeln('Bad infinitive');
		exit(show); end;
	v := conjugate(infinitive);
	print_conjugation(v);
end;

procedure main;
	var verb: string;
begin
	repeat
		writeln;
		writeln('Enter verb: ');
		readln(verb);
		if verb = '' then leave;
		case verb[1] of
			otherwise	show(verb); end;
		until false;
end;

begin
	initialize;
	main;
end.
Comments Home


Internet Cataloguing-in-Publication Data
Mundie, David A.
    A Program to Conjugate Spanish Verbs / David A. Mundie
    Pittsburgh, PA : Polymath Systems  1995
    465 dc-20
                                        [MARC]