Previous Up Next

Chapter 5  Программы

Введение

Преимущество одного языка программирования над другим заключается в простоте разработки качественных программ и легком сопровождении программного обеспечения. Первая часть книги, посвященная представлению языка Objective CAML, вполне естественно завершится реализацией нескольких программ.

В первой программе мы реализуем несколько функций запрашивающих информацию из базы данных. Наше внимание будет акцентировано на функциональном стиле программирования и использование списков. Таким образом пользователь будет иметь набор функций для формулирования и выполнения запросов прямо в языке Objective CAML. В этом примере мы покажем разработчику как он может с легкостью предоставить набор функций необходимых пользователю.

Вторая программа это интерпретатор BASIC1. Напомним, что подобные императивные языки принесли немалый успех первым микрокомпьютерам. Двадцать лет спустя, реализация таких языков является простой задачей. Несмотря на то что BASIC императивный язык, для написания интерпретатора мы воспользуемся функциональной частью Objective CAML, в частности для вычисления инструкций. Однако, для лексического и синтаксического анализа мы используем физически изменяемую структуру данных.

Третья программа — всем известная игра Minesweeper, которая входит в стандартный дистрибутив Windows. Цель игры — найти все спрятанные мины, исследуя рядом расположенные ячейки. Для реализации мы воспользуемся императивной частью языка, так как поле игры представлено в виде матрицы, которая будет изменятся после каждого хода игрока. Мы, также используем модуль Graphics для реализации интерфейса игры и обработки событий. Вычисление автоматически открывающихся ячеек будет сделано в функциональном стиле.

Данная программа использует модуль Graphics описанный в 4 главе (см. стр. ??) и несколько функций из модулей Random и Sys из главы 7 (см. стр. ?? и ??).

5.1  Запросы базы данных

Реализация базы данных, ее интерфейса и языка запросов — слишком амбициозный проект для данной книги и для знаний читателя в Objective CAML на данный момент. Тем не менее, ограничив задачу и используя лучшие возможности функционального программирования, можно реализовать достаточно интересное средство для обработки запросов. Мы изучим как использовать итераторы и частичное применение для написания и выполнения запросов. Также, мы увидим использование типа данных инкапсулирующих функциональные значения.

В этом примере мы будем работать над базой данных содержащей информацию о членах ассоциации. База храниться в файле association.dat.

5.1.1  Формат данных

Для хранения данных, большинство баз данных используют свой собственный, так называемый “проприетарный” формат. Чаще всего, есть возможность экспортировать эти данные в текстовый формат. Вот одна из возможных структур:

Файл ассоциации начинается так:

Num|Lastname|Firstname|Address|Tel|Email|Pref|Date|Amount
0:Chailloux:Emmanuel:Universite P6:0144274427:ec@lip6.fr:email:25.12.1998:100.00
1:Manoury:Pascal:Laboratoire PPS::pm@lip6.fr:mail:03.03.1997:150.00
2:Pagano:Bruno:Cristal:0139633963::mail:25.12.1998:150.00
3:Baro:Sylvain::0144274427:baro@pps.fr:email:01.03.1999:50.00

Теперь необходимо выбрать формат в котором программа будет хранить данные базы. У нас есть выбор: список или вектор карточек. Списком легче манипулировать; добавление и удаление карточек являются простыми операциями. Зато векторы предоставляют одинаковое время доступа к любой карточке. Так как мы желаем использовать все карточки, а не какие-то конкретно, каждый запрос обрабатывает все множество карточек. По этой причине мы выбираем списки. Для карточек у нас тот же самый выбор: список или вектор строк? В этом случае ситуация обратная; с одной стороны формат карточки зафиксирован для всей базы данных и мы не можем добавить новые поля. С другой стороны, в зависимости от будущих операции, мы используем лишь некоторые поля карточек, соответственно необходимо быстро получить к ним доступ.

Вполне естественным решением данной задачи будет использование вектора проиндексированного именами полей. Однако подобный тип не возможен в Objective CAML, мы воспользуемся обычным вектором (проиндексированный целыми числами) и функцией, которая возвращает имя поля в зависимости от индекса.

# type data_card = string array ;; # type data_base = { card_index : string -> int ; data : data_card list } ;;

Реализуем доступ к полю по имени n карточки dc базы данных db при помощи следующей функции:

# let field db n (dc:data_card) = dc.(db.card_index n) ;; val field : data_base -> string -> data_card -> string = <fun>

Мы принудительно привели тип переменной dc к data_card, тем самым наша функция field принимает лишь вектор строк, а не какой попало.

Проиллюстрируем на небольшом примере.

# let base_ex = { data = [ [|"Chailloux"; "Emmanuel"|] ; [|"Manoury"; "Pascal"|] ] ; card_index = function "Lastname"->0 | "Firstname"->1 | _->raise Not_found } ;; val base_ex : data_base = {card_index=<fun>; data=[[|"Chailloux"; "Emmanuel"|]; [|"Manoury"; "Pascal"|]]} # List.map (field base_ex "Lastname") base_ex.data ;; - : string list = ["Chailloux"; "Manoury"]

Выражение field base_ex “Lastname” вычисляется как функция, которая берет на вход карточку и возвращает поле “Lastname”. Используя List.map, мы применяем эту функцию к каждой карточке базы данных base_ex и в результате получаем список полей “Lastname”.

На этом примере показано, как мы собираемся использовать функциональный стиль программирования. В данном случае частичное применение функции field определяет функцию доступа к конкретному полю, независимо от числа карточек в базе данных. В то же время, в реализации функции field есть недостаток: если мы обращаемся каждый раз к одному и тому же полю, индекс вычисляется каждый раз. Мы предпочитаем следующую реализацию.

# let field base name = let i = base.card_index name in fun (card : data_card) -> card.(i) ;; val field : data_base -> string -> data_card -> string = <fun>

Здесь, после применения функции к аргументу, вычисляется индекс поля и используется в последующих вычислениях.

5.1.2  Чтение базы из файла

Для Objective CAML, файл с базой данных это множество линий. Наша задача состоит в том чтобы прочитать каждую линию, как строку, затем в разбить ее на части при помощи сепараторов и таким образом извлечь данные, а также данные для функции индексации полей.

Утилита для обработки линий

Нам нужна функция split, которая будет разбивать строку в соответствии с определенным разделителем. Для этого мы воспользуемся функцией suffix, возвращающая суффикс строки s начиная с позиции i. В этом нам помогут три предопределенные функции:

# let suffix s i = try String.sub s i ((String.length s)-i) with Invalid_argument("String.sub") -> "" ;; val suffix : string -> int -> string = <fun> # let split c s = let rec split_from n = try let p = String.index_from s n c in (String.sub s n (p-n)) :: (split_from (p+1)) with Not_found -> [ suffix s n ] in if s="" then [] else split_from 0 ;; val split : char -> string -> string list = <fun>

Обратите внимание на обработку исключений в этой функции, в особенности исключение Not_found.

Вычисление структуры data_base

Для того чтобы получить из списка вектор, достаточно воспользоваться соответствующей функцией из модуля Array (of_list). Вычисление функции индекса из списка имени полей может показаться сложной задачей, но к счастью модуль List предоставляет нам все необходимые для этого средства.

У нас имеется список строк, значит нам нужна функция, которая ассоциирует строке индекс, то есть ее положение или номер в списке.

# let mk_index list_names = let rec make_enum a b = if a > b then [] else a::(make_enum (a+1) b) in let list_index = (make_enum 0 ((List.length list_names) - 1)) in let assoc_index_name = List.combine list_names list_index in function name -> List.assoc name assoc_index_name ;; val mk_index : 'a list -> 'a -> int = <fun>

Для реализации этой функции, мы создаем список индексов, который мы комбинируем со списком имен полей. Таким образом вы получаем новый список ассоциаций с типом string * int list. Для того, чтобы найти индекс связанный с именем, воспользуемся специально созданной на подобный случай функцией assoc из библиотеки List. Функция mk_index возвращает функцию которая берет на входе имя и вызывает assoc с этим именем и списком построенным ранее.

Теперь мы готовы, к тому чтобы написать функцию читающую файлы базы данных в указанном формате.

# let read_base filename = let channel = open_in filename in let split_line = split ':' in let list_names = split '|' (input_line channel) in let rec read_file () = try let data = Array.of_list (split_line (input_line channel )) in data :: (read_file ()) with End_of_file -> close_in channel ; [] in { card_index = mk_index list_names ; data = read_file () } ;; val read_base : string -> data_base = <fun>

Считывание записей из файл осуществляется функцией read_file, которая рекурсивно оперирует входным каналом. Конец файла оповещается исключением End_of_file. В этом случае мы закроем канал и вернем пустой список.

Считаем файл ассоциации.

# let base_ex = read_base "association.dat" ;; val base_ex : data_base = {card_index=<fun>; data= [[|"0"; "Chailloux"; "Emmanuel"; "Universit\233 P6"; "0144274427"; "ec@lip6.fr"; "email"; "25.12.1998"; "100.00"|]; [|"1"; "Manoury"; "Pascal"; "Laboratoire PPS"; ...|]; ...]}

5.1.3  Общие принципы работы с базой данных

Богатство и сложность обработки множества данных базы пропорциональны богатству и сложности используемого языка запросов. Так как в данном случае мы решили использовать Objective CAML в качестве языка запросов, a priori ограничений на выражение запросов нет! Мы так же хотим предоставить несколько простых средств манипуляции карточками и их данными. Для получения желанной простоты, необходимо ограничить мощь Objective CAML, для этого определим несколько целей и принципов обработки.

Цель обработки данных заключается в получении так называемого состояния базы. Создание такого состояния базы можно разбить на три этапа:

Что мы и изобразили на рисунке 5.1.

Figure 5.1: Этапы запроса

В соответствии с этим, нам нужно 3 функции следующих типов:

Objective CAML предоставляет три функции высшего порядка, известные как итераторы, представленные на странице ??. Они соответствуют нашей спецификации.

# List.find_all ;; - : ('a -> bool) -> 'a list -> 'a list = <fun> # List.map ;; - : ('a -> 'b) -> 'a list -> 'b list = <fun> # List.fold_right ;; - : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b = <fun>

После того как мы определим функциональные аргументы, мы сможем воспользоваться этими функциями для реализации состояния в три этапа.

Для некоторых запросов нам понадобится следующая функция.

# List.iter ;; - : ('a -> unit) -> 'a list -> unit = <fun>

В случае, когда обработка данных ограничивается выводом на экран, вычислять нечего.

В следующих параграфах, мы увидим несколько простых методов обработки данных, а так же определение функций выражающих критерии выборки. Небольшой пример в заключении этой главы использует эти функции в соответствии с приведенными выше принципами.

5.1.4  Критерии выборки

В конкретном случае, логическая функция, которая определяет критерии выборки карточки, есть логическая комбинация свойств данных всех или части полей карточки. Каждое поле карточки, представленое строкой, может нести в себе информацию другого типа: целое число, число с плавающей запятой, etc.

Критерии выборки по одному полю

Выборка определенного поля по конкретному критерию будет осуществляется при помощи следующей функции data_base -> 'a -> string -> data_card -> bool. Параметр типом 'a соответствует типу информации хранимой в поле. Имя этого поля указанно аргументом с типом string.

Поля со строковым типом данных

Определим два простых теста для работы с этим типом данных: тест на равенство с другой строкой и тест на “не пустоту” строки.

# let eq_sfield db s n dc = (s = (field db n dc)) ;; val eq_sfield : data_base -> string -> string -> data_card -> bool = <fun> # let nonempty_sfield db n dc = ("" <> (field db n dc)) ;; val nonempty_sfield : data_base -> string -> data_card -> bool = <fun>
Поля со типом данных число с плавающей запятой

Для проверки информации содержащей числа с плавающей запятой достаточно перевести значение строки содержащей десятичное число в тип float. Вот несколько примеров полученных использованием настраиваемой функции tst_ffield :

# let tst_ffield r db v n dc = r v (float_of_string (field db n dc)) ;; val tst_ffield : ('a -> float -> 'b) -> data_base -> 'a -> string -> data_card -> 'b = <fun> # let eq_ffield = tst_ffield (=) ;; # let lt_ffield = tst_ffield (<) ;; # let le_ffield = tst_ffield (<=) ;; (* etc. *)

Тип у данных функций:

data_base -> float -> string -> data_card -> bool.

Этот тип информации немного сложней, он зависит от представления даты в базе данных и требует определения способа сравнения дат.

Установим формат даты карточки как строку дд.мм.гггг. Для того чтобы получить дополнительные возможности сравнения, добавим в формат даты символ '_', заменяющий день, месяц или год. Даты сравниваются в лексикографическом порядке в формате (год, месяц, день). Для того чтобы мы могли пользоваться выражениями как “до июля 1998”, будем использовать сопоставление с образцом даты: “_.07.1998”. Сравнение даты с образцом реализуется функцией tst_dfield, которая анализирует образец и создает ad hoc сравнивающую функцию. Для того чтобы определить эту универсальную функцию проверки даты, нам понадобятся несколько дополнительных функций.

Напишем две функции преобразующие дату (ints_of_string) и образцы даты (ints_of_dpat) в триплет целых чисел. Мы заменим символ '_' образца на целое число 0.

# let split_date = split '.' ;; val split_date : string -> string list = <fun> # let ints_of_string d = try match split_date d with [d;m;y] -> [int_of_string y; int_of_string m; int_of_string d] | _ -> failwith "Bad date format" with Failure("int_of_string") -> failwith "Bad date format" ;; val ints_of_string : string -> int list = <fun> # let ints_of_dpat d = let int_of_stringpat = function "_" -> 0 | s -> int_of_string s in try match split_date d with [d;m;y] -> [ int_of_stringpat y; int_of_stringpat m; int_of_stringpat d ] | _ -> failwith "Bad date format" with Failure("int_of_string") -> failwith "Bad date pattern" ;; val ints_of_dpat : string -> int list = <fun>

Напишем функцию теста, которая использует отношение целых r. Здесь мы реализуем лексикографический порядок, при этом мы обрабатываем специальный случай с нулем.

# let rec app_dtst r d1 d2 = match d1, d2 with [] , [] -> false | (0::d1) , (_::d2) -> app_dtst r d1 d2 | (n1::d1) , (n2::d2) -> (r n1 n2) || ((n1 = n2) && (app_dtst r d1 d2)) | _, _ -> failwith "Bad date pattern or format" ;; val app_dtst : (int -> int -> bool) -> int list -> int list -> bool = <fun>

Наконец, определим универсальную функцию tst_dfield со следующими аргументами: отношение r, база данных db, образец dp, имя поля nm и карточка dc. Эта функция проверяет, что образец и извлеченное поле удовлетворяют отношение.

# let tst_dfield r db dp nm dc = r (ints_of_dpat dp) (ints_of_string (field db nm dc)) ;; val tst_dfield : (int list -> int list -> 'a) -> data_base -> string -> string -> data_card -> 'a = <fun>

Теперь применим функцию к трем отношениям.

# let eq_dfield = tst_dfield (=) ;; # let le_dfield = tst_dfield (<=) ;; # let ge_dfield = tst_dfield (>=) ;;

Тип этих функций следующий:

data_base -> string -> string -> data_card -> bool.

Композиция критериев

Три первые аргумента проверок, которые мы определили — база данных, значение и имя поля. Когда мы пишем запросы базы данных, значения этих аргументов известны. Для базы base_ex проверка <<до июля 1998>> пишется следующим образом.

# ge_dfield base_ex "_.07.1998" "Date" ;; - : data_card -> bool = <fun>

Получается, что проверка это функция имеющая тип data_card -> bool. Теперь нам нужно получить логические комбинации результатов подобных функций, примененных к одной и той же карточке. Для этого воспользуемся следующим итератором.

# let fold_funs b c fs dc = List.fold_right (fun f -> fun r -> c (f dc) r) fs b ;; val fold_funs : 'a -> ('b -> 'a -> 'a) -> ('c -> 'b) list -> 'c -> 'a = <fun>

Здесь b — значение базы, функция c — логический оператор, fs — список функций проверки по полю и dc — карточка.

В следующем примере получаем конъюнкцию (логическое произведение) и дизъюнкцию (логическая сумма) списка проверок.

# let and_fold fs = fold_funs true (&) fs ;; val and_fold : ('a -> bool) list -> 'a -> bool = <fun> # let or_fold fs = fold_funs false (or) fs ;; val or_fold : ('a -> bool) list -> 'a -> bool = <fun>

Для удобства определим отрицание функции проверки.

# let not_fun f dc = not (f dc) ;; val not_fun : ('a -> bool) -> 'a -> bool = <fun>

Для того, чтобы выбрать карточку, дата которой находится в определенном интервале, воспользуемся комбинаторными операторами.

# let date_interval db d1 d2 = and_fold [(le_dfield db d1 "Date"); (ge_dfield db d2 "Date")] ;; val date_interval : data_base -> string -> string -> data_card -> bool = <fun>

5.1.5  Обработка и вычисление

Трудно представить себе все возможные обработки карточек или множество данных полученных после этой обработки. Тем не менее можно с уверенностью определить два класса таких обработок: численное вычисление и форматирование данных для печати. Рассмотрим каждый каждый случай на примере.

Форматирование

Подготовим к печати строку, содержащую имя члена ассоциации и кое-какую информацию.

Начнем с определения функции, которая из списка строк и разделителя создает строку состоящую из элемент списка разделенных сепаратором.

# let format_list c = let s = String.make 1 c in List.fold_left (fun x y -> if x="" then y else x^s^y) "" ;; val format_list : char -> string list -> string = <fun>

Определим функцию extract, которая создает список из полей с информацией, она извлекает из каждой карточки данные полей, имена которых переданы в списке.

# let extract db ns dc = List.map (fun n -> field db n dc) ns ;; val extract : data_base -> string list -> data_card -> string list = <fun>

Функция форматирования для печати выглядит следующим образом.

# let format_line db ns dc = (String.uppercase (field db "Lastname" dc)) ^" "^(field db "Firstname" dc) ^"\t"^(format_list '\t' (extract db ns dc)) ^"\n" ;; val format_line : data_base -> string list -> data_card -> string = <fun>

Аргумент ns является списком с именами полей, которые нас интересуют. Поля разделены символом табуляции (''), а строка заканчивается возвратом каретки.

Вот как можно вывести на экран имена и фамилии членов ассоциации.

# List.iter print_string (List.map (format_line base_ex []) base_ex.data) ;; CHAILLOUX Emmanuel MANOURY Pascal PAGANO Bruno BARO Sylvain - : unit = ()

Числовое вычисление

Давайте вычислим сумму членских взносов для определенного множества карточек. Для этого достаточно извлечь нужное поле, привести к целому типу и вычислить сумму. Нужный результат может быть получен композицией этих функций. Для упрощения записи, определим инфиксный оператор композиции.

# let (++) f g x = g (f x) ;; val ++ : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c = <fun>

Воспользуемся этим оператором в следующем определении.

# let total db dcs = List.fold_right ((field db "Amount") ++ float_of_string ++ (+.)) dcs 0.0 ;; val total : data_base -> data_card list -> float = <fun>

Аналогичным образом можно применить эту функцию ко всей базе денных.

# total base_ex base_ex.data ;; - : float = 450

5.1.6  Пример

В заключении, проиллюстрируем на примере принципы, которые мы представили ранее в этой главе.

Рассмотрим два типа запроса базы данных:

Списки адресов

Для создания этих списков мы сначала выбираем в соответствии со значением поля “Pref” релевантные карточки, затем используем функцию format_line.

# let mail_addresses db = let dcs = List.find_all (eq_sfield db "mail" "Pref") db.data in List.map (format_line db ["Mail"]) dcs ;; val mail_addresses : data_base -> string list = <fun> # let email_addresses db = let dcs = List.find_all (eq_sfield db "email" "Pref") db.data in List.map (format_line db ["Email"]) dcs ;; val email_addresses : data_base -> string list = <fun>

Состояние взносов

Вычисление состояния взносов выполняется по обычному принципы: выборка, затем обработка. В данном случае обработка состоит из двух частей: форматирование и вычисление общей суммы взносов.

# let fees_state db d1 d2 = let dcs = List.find_all (date_interval db d1 d2) db.data in let ls = List.map (format_line db ["Date";"Amount"]) dcs in let t = total db dcs in ls, t ;; val fees_state : data_base -> string -> string -> string list * float = <fun>

В результате этой функции мы получим пару состоящую из списка строк с информацией и суммы взносов.

Основная программа

Основная программа состоит из интерактивного цикла, выводящего результат запроса, который пользователь выбрал из меню. Здесь мы используем императивный стиль программирования, за исключением вывода результата при помощи итератора.

# let main() = let db = read_base "association.dat" in let finished = ref false in while not !finished do print_string" 1: List of mail addresses\n"; print_string" 2: List of email addresses\n"; print_string" 3: Received fees\n"; print_string" 0: Exit\n"; print_string"Your choice: "; match read_int() with 0 -> finished := true | 1 -> (List.iter print_string (mail_addresses db)) | 2 -> (List.iter print_string (email_addresses db)) | 3 -> (let d1 = print_string"Start date: "; read_line() in let d2 = print_string"End date: "; read_line() in let ls, t = fees_state db d1 d2 in List.iter print_string ls; print_string"Total: "; print_float t; print_newline()) | _ -> () done; print_string"bye\n" ;; val main : unit -> unit = <fun>

Мы вернемся к этому примеру в главе 20, чтобы добавить к нему интерфейс при помощи web навигатора.

5.1.7  Дополнительные возможности

Вполне естественным будет добавить в базу данных нашего примера информацию о типе каждого поля. Эта информация пригодится в случае если мы хотим определить универсальные (generic) операторы сравнения со следующим типом data_base -> 'a -> string -> data_card -> bool. Имя поля (третий аргумент) позволяет передевать управление соответствующей функции сравнения и проверки.

5.2  Интерпретатор языка BASIC

В данном разделе мы рассмотрим интерпретатор языка Basic. Это программа, которая выполняет другие программы написанные на языке Basic. Конечно, мы ограничимся лишь частью команд этого языка, наш интерпретатор будет распознавать следующие команды:

Каждая строка программы Basic помечена номером и содержит лишь одну инструкцию. Программа, вычисляющая факториал для числа введенного с клавиатуры, выглядит следующим образом:

5 REM inputting the argument 10 PRINT " factorial of:" 20 INPUT A 30 LET B = 1 35 REM beginning of the loop 40 IF A <= 1 THEN 80 50 LET B = B * A 60 LET A = A - 1 70 GOTO 40 75 REM prints the result 80 PRINT B

Реализуем также мини–редактор по принципу интерактивного цикла. У нас должна быть возможность добавлять новые строки, вывод программы и ее вычисление. Запуск предыдущей программы осуществляется командой RUN. Пример вычисления этой программы.

> RUN factorial of: ? 5 120

Это вычисление можно разбить на несколько разных этапов.

Описание абстрактного синтаксиса
необходимо определить типы данных для описания программ на Basic, а так же другие компоненты (строки, комментарии, выражения, и т.д.)
Вывод программы
эта часть состоит в переводе программы на Basic из внутреннего формата в строки, для того чтобы вывести ее на экран.
Лексический и синтаксический анализ
обе эти части проделывают обратную операцию, то есть перевод строки во внутренний формат программы на Basic (абстрактный синтаксис)
Вычисление
это основа интерпретатора. Далее мы увидим что функциональный язык как Objective CAML особенно хорошо подходит для решения подобных проблем.
Интерактивный цикл
здесь реализуется все вышесказанное.

5.2.1  Абстрактный синтаксис

В таблице представлен конкретный синтаксис в форме BNF программы на Basic. Мы вернемся к данному способу описания языка в главе  10 на странице  ??.

Unary_Op        ::=     -    |    !
Binary_Op       ::=     +    |    -    |    *    |    /    |    %
        |       =    |    <    |    >    |    <=    |    >=    |    <>
        |       &    |    ' | '
Expression      ::=     integer
        |       variable
        |       "string"
        |       Unary_Op   Expression
        |       Expression   Binary_Op   Expression
        |       ( Expression )
Command         ::=     REM string
        |       GOTO integer
        |       LET variable = Expression
        |       PRINT Expression
        |       INPUT variable
        |       IF Expression THEN integer
 
Line    ::=     integer Command
 
Program         ::=     Line
        |       Line Program
 
Phrase  ::=     Line | RUN | LIST | END

Заметим, что правильность выражения с точки зрения грамматики не означает возможность его вычисления. Например, 1+"hello" есть выражение, однако его невозможно вычислить. Это сделано с целью облегчить абстрактный синтаксис языка Basic. Расплата за это — программы на Basic, синтаксически правильные, могут привести к ошибке из–за несоответствия типов.

Теперь определить типы данных Objective CAML просто, достаточно перевести абстрактный синтаксис в тип сумма.

# type unr_op = UMINUS | NOT ;; # type bin_op = PLUS | MINUS | MULT | DIV | MOD | EQUAL | LESS | LESSEQ | GREAT | GREATEQ | DIFF | AND | OR ;; # type expression = ExpInt of int | ExpVar of string | ExpStr of string | ExpUnr of unr_op * expression | ExpBin of expression * bin_op * expression ;; # type command = Rem of string | Goto of int | Print of expression | Input of string | If of expression * int | Let of string * expression ;; # type line = { num : int ; cmd : command } ;; # type program = line list ;;

Определим синтаксис команд для мини–редактора.

# type phrase = Line of line | List | Run | PEnd ;;

Обычно, чтобы облегчить синтаксис, программистам разрешается не указывать все скобки. Например, под выражением 1+3*4 подразумевается 1+(3*4). Для этого, каждому оператору языка присваивается целое число — приоритет:

# let priority_uop = function NOT -> 1 | UMINUS -> 7 let priority_binop = function MULT | DIV -> 6 | PLUS | MINUS -> 5 | MOD -> 4 | EQUAL | LESS | LESSEQ | GREAT | GREATEQ | DIFF -> 3 | AND | OR -> 2 ;; val priority_uop : unr_op -> int = <fun> val priority_binop : bin_op -> int = <fun>

Целые числа означают, так называемый, приоритет операторов. Далее мы увидим как они используются при синтаксическом анализе или выводе программ на экран.

5.2.2  Вывод программы на экран

Для того, чтобы вывести программу хранящуюся в памяти, необходимо уметь перевести строку программы из абстрактного синтаксиса в строку символов.

Перевод операторов может быть получен легко и просто:

# let pp_binop = function PLUS -> "+" | MULT -> "*" | MOD -> "%" | MINUS -> "-" | DIV -> "/" | EQUAL -> " = " | LESS -> " < " | LESSEQ -> " <= " | GREAT -> " > " | GREATEQ -> " >= " | DIFF -> " <> " | AND -> " & " | OR -> " | " let pp_unrop = function UMINUS -> "-" | NOT -> "!" ;; val pp_binop : bin_op -> string = <fun> val pp_unrop : unr_op -> string = <fun>

Вывод выражений соблюдает приоритет операторов для того чтобы получить выражение с минимумом скобок. Мы используем скобки лишь в случае если оператор в под–выражении справа от оператора менее приоритетный всего оператор целого выражения. К тому же, арифметические операторы ассоциативные слева, это значит что выражение 1-2-3 эквивалентно (1-2)-3.

Чтобы получить данный результат, создадим две функции ppl и ppr, которые будут обрабатывать левые и правые под–деревья соответственно. У этих функций два аргумента: дерево выражений и приоритет оператора в корне дерева, основываясь на значении последнего мы решим нужны–ли скобки в выражении или нет. Чтобы учитывать ассоциативность операторов мы различаем левое под–дерево от правого. Если приоритет текущего оператора одинаков с корневым, то ставить скобки для левого под–дерева не нужно. Для правого под–дерева скобки могут понадобиться, как в следующих случаях: 1-(2-3) or 1-(2+3).

Начальное дерево рассматривается как левое под–дерево оператора с минимальным приоритетом (0). Вот как работает функция вывода выражений pp_expression:

# let parenthesis x = "(" ^ x ^ ")";; val parenthesis : string -> string = <fun> # let pp_expression = let rec ppl pr = function ExpInt n -> (string_of_int n) | ExpVar v -> v | ExpStr s -> "\"" ^ s ^ "\"" | ExpUnr (op,e) -> let res = (pp_unrop op)^(ppl (priority_uop op) e) in if pr=0 then res else parenthesis res | ExpBin (e1,op,e2) -> let pr2 = priority_binop op in let res = (ppl pr2 e1)^(pp_binop op)^(ppr pr2 e2) (* parenthesis if priority is not greater *) in if pr2 >= pr then res else parenthesis res and ppr pr exp = match exp with (* right subtrees only differ for binary operators *) ExpBin (e1,op,e2) -> let pr2 = priority_binop op in let res = (ppl pr2 e1)^(pp_binop op)^(ppr pr2 e2) in if pr2 > pr then res else parenthesis res | _ -> ppl pr exp in ppl 0 ;; val pp_expression : expression -> string = <fun>

Для вывода инструкций, воспользуемся предыдущей функцией. При этом добавим номер перед каждой инструкцией.

# let pp_command = function Rem s -> "REM " ^ s | Goto n -> "GOTO " ^ (string_of_int n) | Print e -> "PRINT " ^ (pp_expression e) | Input v -> "INPUT " ^ v | If (e,n) -> "IF "^(pp_expression e)^" THEN "^(string_of_int n) | Let (v,e) -> "LET " ^ v ^ " = " ^ (pp_expression e) ;; val pp_command : command -> string = <fun> # let pp_line l = (string_of_int l.num) ^ " " ^ (pp_command l.cmd) ;; val pp_line : line -> string = <fun>

5.2.3  Лексический анализ

Синтаксический и лексический анализ реализуют противоположную выводу на экран операцию. Для полученной строки создается синтаксическое дерево. Лексический анализ разбивает строку инструкции на независимые лексические части, называемые лексемами. Для этого добавим следующий тип в Objective CAML:

# type lexeme = Lint of int | Lident of string | Lsymbol of string | Lstring of string | Lend ;;

Для обозначения конца выражения мы добавили специальную лексему Lend. Она не является частью анализируемой строки, а добавляется функцией лексического анализа (см. стр. ??).

Для анализа строки мы используем тип запись содержащую изменяемое поле, значение которого указывает на часть строки, которую осталось обработать. Размер строки будет необходим во многих случаях, поэтому мы храним это константное значение в записи.

# type string_lexer = {string:string; mutable current:int; size:int } ;;

Такой способ определения лексического анализа можно рассматривать как применение функции к значению с типом string_lexer, в результате чего получим значение типа lexeme. Изменение индекса строки, которую осталось проанализировать, получается в результате побочного эффекта.

# let init_lex s = { string=s; current=0 ; size=String.length s } ;; val init_lex : string -> string_lexer = <fun> # let forward cl = cl.current <- cl.current+1 ;; val forward : string_lexer -> unit = <fun> # let forward_n cl n = cl.current <- cl.current+n ;; val forward_n : string_lexer -> int -> unit = <fun> # let extract pred cl = let st = cl.string and pos = cl.current in let rec ext n = if n<cl.size && (pred st.[n]) then ext (n+1) else n in let res = ext pos in cl.current <- res ; String.sub cl.string pos (res-pos) ;; val extract : (char -> bool) -> string_lexer -> string = <fun>

Следующие функции извлекают лексему из строки и изменяют маркер текущей позиции. Функции extract_int и extract_ident извлекают целое число и идентификатор соответственно.

# let extract_int = let is_int = function '0'..'9' -> true | _ -> false in function cl -> int_of_string (extract is_int cl) let extract_ident = let is_alpha_num = function 'a'..'z' | 'A'..'Z' | '0' .. '9' | '_' -> true | _ -> false in extract is_alpha_num ;; val extract_int : string_lexer -> int = <fun> val extract_ident : string_lexer -> string = <fun>

Функция lexer использует обе предыдущие функции для извлечения лексем.

# exception LexerError ;; exception LexerError # let rec lexer cl = let lexer_char c = match c with ' ' | '\t' -> forward cl ; lexer cl | 'a'..'z' | 'A'..'Z' -> Lident (extract_ident cl) | '0'..'9' -> Lint (extract_int cl) | '"' -> forward cl ; let res = Lstring (extract ((<>) '"') cl) in forward cl ; res | '+' | '-' | '*' | '/' | '%' | '&' | '|' | '!' | '=' | '(' | ')' -> forward cl; Lsymbol (String.make 1 c) | '<' | '>' -> forward cl; if cl.current >= cl.size then Lsymbol (String.make 1 c) else let cs = cl.string.[cl.current] in ( match (c,cs) with ('<','=') -> forward cl; Lsymbol "<=" | ('>','=') -> forward cl; Lsymbol ">=" | ('<','>') -> forward cl; Lsymbol "<>" | _ -> Lsymbol (String.make 1 c) ) | _ -> raise LexerError in if cl.current >= cl.size then Lend else lexer_char cl.string.[cl.current] ;; val lexer : string_lexer -> lexeme = <fun>

Принцип действия функции lexer очень простой: здесь анализируется текущий символ строки, в зависимости от его значения возвращается соответствующая лексема и текущая позиция перемещается на начало следующей лексемы. Это очень простой и эффективный подход, две лексемы могут различаться по первому же символу. Для символа `<' необходимо проверить следующий символ, за ним может следовать `=' или `>' и является другой лексемой. То же самое касается символа `>'.

5.2.4  Синтаксический анализ

При анализе выражений языка возникают некоторые проблемы; знание начала выражения не достаточно для того, чтобы определить всю его структуру. Пусть мы анализируем часть строки 1+2+3. В зависимости от того, что за этим следует +4 или *4, полученные деревья для части 1+2+3 различаются (см. рис. 5.2).

Figure 5.2: Деревья абстрактного синтаксиса

Однако, структура дерева для 1+2 одинакова в обоих случаях, поэтому мы можем его построить. В связи с тем что у нас отсутствует информация о части +3, мы временно сохраним это информацию до нужного момента.

При построении дерева абстрактного синтаксиса мы воспользуемся стековым автоматом, схожий с тем, который используется yacc (см. стр. ??). Лексему читаются одна за другой и помещаются в стек до тех пор, пока у нас не будет достаточно информации, чтобы построить выражение. После этого, лексемы удаляются из стека и заменяются построенным выражением. Эта операция называется редукцией.

Тип помещаемых в стек элементов следующий:

# type exp_elem = Texp of expression (* expression *) | Tbin of bin_op (* binary operator *) | Tunr of unr_op (* unary operator *) | Tlp (* left parenthesis *) ;;

Заметим, что правые скобки не сохраняются, так как лишь левые скобки важны при операции редукции.

На рисунке 5.3 проиллюстрировано изменение стека при анализе выражения (1+2*3)*4. Символ над стрелкой есть текущий символ строки.

Figure 5.3: Basic: Пример создания дерева абстрактного синтаксиса

Определим исключение для синтаксических ошибок.

# exception ParseError ;;

Сначала определим операторы при помощи символов.

# let unr_symb = function "!" -> NOT | "-" -> UMINUS | _ -> raise ParseError let bin_symb = function "+" -> PLUS | "-" -> MINUS | "*" -> MULT | "/" -> DIV | "%" -> MOD | "=" -> EQUAL | "<" -> LESS | "<=" -> LESSEQ | ">" -> GREAT | ">=" -> GREATEQ | "<>" -> DIFF | "&" -> AND | "|" -> OR | _ -> raise ParseError let tsymb s = try Tbin (bin_symb s) with ParseError -> Tunr (unr_symb s) ;; val unr_symb : string -> unr_op = <fun> val bin_symb : string -> bin_op = <fun> val tsymb : string -> exp_elem = <fun>

Функция reduce реализует редукцию стека. Существует два случая, в которых стек начинается:

Кроме того, другой аргумент функции reduce — это минимальный приоритет, который должен иметь оператор, чтобы редукция имела место. Для приведения без условий достаточно указать минимальный нулевой приоритет.

# let reduce pr = function (Texp e)::(Tunr op)::st when (priority_uop op) >= pr -> (Texp (ExpUnr (op,e)))::st | (Texp e1)::(Tbin op)::(Texp e2)::st when (priority_binop op) >= pr -> (Texp (ExpBin (e2,op,e1)))::st | _ -> raise ParseError ;; val reduce : int -> exp_elem list -> exp_elem list = <fun>

Заметим, что элементы выражения помещаются в стек в порядке чтения, из–за чего необходимо поменять местами операнды бинарной операции.

stack_or_reduce это главная функция синтаксического анализа, в соответствии с переданной ей лексемой она либо помещает новый элемент в стек либо выполняет редукцию.

# let rec stack_or_reduce lex stack = match lex , stack with Lint n , _ -> (Texp (ExpInt n))::stack | Lident v , _ -> (Texp (ExpVar v))::stack | Lstring s , _ -> (Texp (ExpStr s))::stack | Lsymbol "(" , _ -> Tlp::stack | Lsymbol ")" , (Texp e)::Tlp::st -> (Texp e)::st | Lsymbol ")" , _ -> stack_or_reduce lex (reduce 0 stack) | Lsymbol s , _ -> let symbol = if s<>"-" then tsymb s (* remove the ambiguity of the ``-'' symbol *) (* according to the last exp element put on the stack *) else match stack with (Texp _)::_ -> Tbin MINUS | _ -> Tunr UMINUS in ( match symbol with Tunr op -> (Tunr op)::stack | Tbin op -> ( try stack_or_reduce lex (reduce (priority_binop op) stack ) with ParseError -> (Tbin op)::stack ) | _ -> raise ParseError ) | _ , _ -> raise ParseError ;; val stack_or_reduce : lexeme -> exp_elem list -> exp_elem list = <fun>

После того как все лексемы извлечены и помещены в стек, дерево абстрактного синтаксиса может быть построено из элементов оставшихся в стеке — это задача функции reduce_all. Если анализируемое выражение было правильно сформировано, то в стеке должен остаться лишь один элемент, содержащий дерево этого выражения.

# let rec reduce_all = function | [] -> raise ParseError | [Texp x] -> x | st -> reduce_all (reduce 0 st) ;; val reduce_all : exp_elem list -> expression = <fun>

Основной функцией анализа выражений является parse_exp. Она просматривает строку, извлекает различные лексемы и передает их функции stack_or_reduce. Анализ прекращается, когда текущая лексема соответствует предикату переданному в аргументе.

# let parse_exp stop cl = let p = ref 0 in let rec parse_one stack = let l = ( p:=cl.current ; lexer cl) in if not (stop l) then parse_one (stack_or_reduce l stack) else ( cl.current <- !p ; reduce_all stack ) in parse_one [] ;; val parse_exp : (lexeme -> bool) -> string_lexer -> expression = <fun>

Заметим, что лексема, которая определяет конец анализа, не используется при построении выражения. Для того чтобы проанализировать эту лексему позднее, необходимо установить текущую позицию на ее начало (переменная p).

Перейдем теперь к анализу строки с инструкцией.

# let parse_cmd cl = match lexer cl with Lident s -> ( match s with "REM" -> Rem (extract (fun _ -> true) cl) | "GOTO" -> Goto (match lexer cl with Lint p -> p | _ -> raise ParseError) | "INPUT" -> Input (match lexer cl with Lident v -> v | _ -> raise ParseError) | "PRINT" -> Print (parse_exp ((=) Lend) cl) | "LET" -> let l2 = lexer cl and l3 = lexer cl in ( match l2 ,l3 with (Lident v,Lsymbol "=") -> Let (v,parse_exp ((=) Lend) cl) | _ -> raise ParseError ) | "IF" -> let test = parse_exp ((=) (Lident "THEN")) cl in ( match ignore (lexer cl) ; lexer cl with Lint n -> If (test,n) | _ -> raise ParseError ) | _ -> raise ParseError ) | _ -> raise ParseError ;; val parse_cmd : string_lexer -> command = <fun>

И наконец, главная функция синтаксического анализа команд введенных пользователем в интерактивном цикле.

# let parse str = let cl = init_lex str in match lexer cl with Lint n -> Line { num=n ; cmd=parse_cmd cl } | Lident "LIST" -> List | Lident "RUN" -> Run | Lident "END" -> PEnd | _ -> raise ParseError ;; val parse : string -> phrase = <fun>

5.2.5  Вычисление

Программа на Basic состоит из набора строк и выполнение начинается с первой строки. Интерпретация строки программы заключается в исполнении задачи инструкции, которая находится на этой строке. Существует три множества инструкций: ввод/вывод (PRINT и INPUT), декларация переменных или присвоение (LET) и переход (GOTO и THEN). Инструкции ввода/вывода реализуют взаимодействие с пользователем, для этого будут использованы соответствующие команды Objective CAML.

Для объявления и присвоения переменных, необходимо уметь вычислить значение арифметического выражение и знать расположение в памяти этой переменной. Результат вычисление выражения может быть либо целым числом, либо булевым значением, либо строкой. Сгруппируем их в типе value.

# type value = Vint of int | Vstr of string | Vbool of bool ;;

При объявлении переменной, нужно выделить память, чтобы хранить значение ассоциированное этой переменной. Для изменении переменной необходимо поменять значение связанно с именем переменной. Соответственно, программа Basic использует окружение, которое хранит связки имя переменной–значение. Данное окружение представлено в виде списка из пар (имя, значение).

# type environment = (string * value) list ;;

Для того чтобы получить содержимое переменной мы используем ее имя. При изменении значения переменной, меняется соответствующая пара.

В инструкциях перехода, условного или безусловного, указывается номер строки на которой должно продолжится выполнение программы. По умолчанию — это следующая строка. В связи с этим, необходимо запомнить номер текущей строки.

Список инструкций из которых состоит программа, редактируемая в интерактивном цикле, не подходит для эффективного выполнения программы. Действительно, для того чтобы реализовать переход (If и Goto) необходимо пересмотреть весь список инструкций, чтобы найти строку с нужным номером. Для того чтобы можно было напрямую перейти на нужную строку, достаточно заменить структуру списка на вектор. В данном случае при переходе будет использоваться не номер строки, а ее индекс в векторе. В этом случае, перед запуском программы командой RUN, проделаем пре–обработку инструкций, называемую компоновкой (assembly). По некоторым причинам, которые будут объяснены в следующем параграфе, скомпонованная программа представлена вектором строк, а не инструкций.

# type code = line array ;;

Как и для калькулятора из прошлых глав, вычислитель использует состояние, которое изменяется при каждом вычислении. Информация, которую необходимо знать в каждый момент — это программа в целом, следующая строка на выполнение и значения переменных. Выполняемая программа отличается от программы набранной в интерактивном цикле. Вместо того списка инструкций, мы используем вектор инструкций. Таким образом состояние программы описывается следующим типом.

# type state_exec = { line:int ; xprog:code ; xenv:environment } ;;

Ошибки могут возникнуть в двух следующих случаях: вычисление выражения и переход на несуществующую строку. Соответственно, нужно обработать эти оба случая, чтобы интерпретатор корректно останавливался и выводил сообщение об ошибке. Определим исключение, а также функцию, которая будет его возбуждать и указывать номер строки на которой оно произошло.

# exception RunError of int let runerr n = raise (RunError n) ;; exception RunError of int val runerr : int -> 'a = <fun>
Компоновка

Компоновка программы, состоящей из списка нумерованных строк (тип program), заключается в переводе списка в вектор и корректировки инструкций перехода. Эта корректировка реализуется связкой номера строки и соответствующего ей индекса вектора. Для облегчения задачи, мы создаем вектор нумерованных строки. Данный вектор будет просматриваться каждый раз, когда необходимо найти индекс связанный со строкой. Если номер строки не найден, будет возвращено значение -1.

# exception Result_lookup_index of int ;; exception Result_lookup_index of int # let lookup_index tprog num_line = try for i=0 to (Array.length tprog)-1 do let num_i = tprog.(i).num in if num_i=num_line then raise (Result_lookup_index i) else if num_i>num_line then raise (Result_lookup_index (-1)) done ; (-1 ) with Result_lookup_index i -> i ;; val lookup_index : line array -> int -> int = <fun> # let assemble prog = let tprog = Array.of_list prog in for i=0 to (Array.length tprog)-1 do match tprog.(i).cmd with Goto n -> let index = lookup_index tprog n in tprog.(i) <- { tprog.(i) with cmd = Goto index } | If(c,n) -> let index = lookup_index tprog n in tprog.(i) <- { tprog.(i) with cmd = If (c,index) } | _ -> () done ; tprog ;; val assemble : line list -> line array = <fun>
Вычисление выражений

Функция вычисления выражений обходит дерево абстрактного синтаксиса и выполняет операции, указанные в каждом узле дерева.

В следующих случаях возбуждается исключение RunError: несоответствие типов, деление на ноль и необъявленная переменная.

# let rec eval_exp n envt expr = match expr with ExpInt p -> Vint p | ExpVar v -> ( try List.assoc v envt with Not_found -> runerr n ) | ExpUnr (UMINUS,e) -> ( match eval_exp n envt e with Vint p -> Vint (-p) | _ -> runerr n ) | ExpUnr (NOT,e) -> ( match eval_exp n envt e with Vbool p -> Vbool (not p) | _ -> runerr n ) | ExpStr s -> Vstr s | ExpBin (e1,op,e2) -> match eval_exp n envt e1 , op , eval_exp n envt e2 with Vint v1 , PLUS , Vint v2 -> Vint (v1 + v2) | Vint v1 , MINUS , Vint v2 -> Vint (v1 - v2) | Vint v1 , MULT , Vint v2 -> Vint (v1 * v2) | Vint v1 , DIV , Vint v2 when v2<>0 -> Vint (v1 / v2) | Vint v1 , MOD , Vint v2 when v2<>0 -> Vint (v1 mod v2) | Vint v1 , EQUAL , Vint v2 -> Vbool (v1 = v2) | Vint v1 , DIFF , Vint v2 -> Vbool (v1 <> v2) | Vint v1 , LESS , Vint v2 -> Vbool (v1 < v2) | Vint v1 , GREAT , Vint v2 -> Vbool (v1 > v2) | Vint v1 , LESSEQ , Vint v2 -> Vbool (v1 <= v2) | Vint v1 , GREATEQ , Vint v2 -> Vbool (v1 >= v2) | Vbool v1 , AND , Vbool v2 -> Vbool (v1 && v2) | Vbool v1 , OR , Vbool v2 -> Vbool (v1 || v2) | Vstr v1 , PLUS , Vstr v2 -> Vstr (v1 ^ v2) | _ , _ , _ -> runerr n ;; val eval_exp : int -> (string * value) list -> expression -> value = <fun>
Вычисление инструкций

Для того, чтобы реализовать вычисление строки инструкций, нам понадобятся несколько дополнительных функций.

Добавление новой связки (имя переменной–значение) в окружение, заменяет старую, с таким же именем, если она существует.

# let rec add v e env = match env with [] -> [v,e] | (w,f)::l -> if w=v then (v,e)::l else (w,f)::(add v e l) ;; val add : 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list = <fun>

Другая функция, для вывода целых чисел или строк, пригодится при вычислении команды PRINT.

# let print_value v = match v with Vint n -> print_int n | Vbool true -> print_string "true" | Vbool false -> print_string "false" | Vstr s -> print_string s ;; val print_value : value -> unit = <fun>

Вычисление инструкции есть переход из одного состояния в другое. В частности, окружение будет изменено, если инструкция это присвоение. Значение следующей строки на выполнение изменяется каждый раз. Если строка не существует, вернем значение -1.

# let next_line state = let n = state.line+1 in if n < Array.length state.xprog then n else -1 ;; val next_line : state_exec -> int = <fun> # let eval_cmd state = match state.xprog.(state.line).cmd with Rem _ -> { state with line = next_line state } | Print e -> print_value (eval_exp state.line state.xenv e) ; print_newline () ; { state with line = next_line state } | Let(v,e) -> let ev = eval_exp state.line state.xenv e in { state with line = next_line state ; xenv = add v ev state.xenv } | Goto n -> { state with line = n } | Input v -> let x = try read_int () with Failure "int_of_string" -> 0 in { state with line = next_line state; xenv = add v (Vint x) state.xenv } | If (t,n) -> match eval_exp state.line state.xenv t with Vbool true -> { state with line = n } | Vbool false -> { state with line = next_line state } | _ -> runerr state.line ;; val eval_cmd : state_exec -> state_exec = <fun>

При каждом вызове функция перехода из одного состояние в другое eval_cmd ищет текущую строку, выполняет ее и затем устанавливает номер следующей строки как текущую строку. Если мы достигли последней строки программы, то номеру текущей строки присваивается значение -1, что позволит нам остановить программу.

Вычисление программы

Будет рекурсивно применять функцию перехода, до тех пор, пока не получим состояние, в котором номер текущей строки равен -1.

# let rec run state = if state.line = -1 then state else run (eval_cmd state) ;; val run : state_exec -> state_exec = <fun>

5.2.6  Последние штрихи

Осталось лишь реализовать мини–редактор и собрать воедино все части программы, реализованные ранее.

Функция insert вставляет новую строку в соответствующее место в программе.

# let rec insert line p = match p with [] -> [line] | l::prog -> if l.num < line.num then l::(insert line prog) else if l.num=line.num then line::prog else line::l::prog ;; val insert : line -> line list -> line list = <fun>

Функция print_prog выводит на экран код программы.

# let print_prog prog = let print_line x = print_string (pp_line x) ; print_newline () in print_newline () ; List.iter print_line prog ; print_newline () ;; val print_prog : line list -> unit = <fun>

Функция one_command либо добавляет строку, либо выполняет команду. Она управляет состоянием интерактивного цикла, состоящего из программы и окружения. Это состояние, представленное типом loop_state, отличается от состояние выполнения программы.

# type loop_state = { prog:program; env:environment } ;; # exception End ;;
# let one_command state = print_string "> " ; flush stdout ; try match parse (input_line stdin) with Line l -> { state with prog = insert l state.prog } | List -> (print_prog state.prog ; state ) | Run -> let tprog = assemble state.prog in let xstate = run { line = 0; xprog = tprog; xenv = state.env } in {state with env = xstate.xenv } | PEnd -> raise End with LexerError -> print_string "Illegal character\n"; state | ParseError -> print_string "syntax error\n"; state | RunError n -> print_string "runtime error at line "; print_int n ; print_string "\n"; state ;; val one_command : loop_state -> loop_state = <fun>

Главной функцией является go, она запускает интерактивный цикл Basic.

# let go () = try print_string "Mini-BASIC version 0.1\n\n"; let rec loop state = loop (one_command state) in loop { prog = []; env = [] } with End -> print_string "See you later...\n";; val go : unit -> unit = <fun>

Цикл реализуется локальной функцией loop. Цикл заканчивается при возбуждении исключения End функцией one_command.

Пример C+/C-

Вернемся к игре C+/C-, описанной в главе 2 на странице ??. Вот ее эквивалент, написанный на Basic.

10 PRINT "Give the hidden number: " 20 INPUT N 30 PRINT "Give a number: " 40 INPUT R 50 IF R = N THEN 110 60 IF R < N THEN 90 70 PRINT "C-" 80 GOTO 30 90 PRINT "C+" 100 GOTO 30 110 PRINT "CONGRATULATIONS"

Пример запуска данной программы.

> RUN
Give the hidden number:
64
Give a number:
88
C-
Give a number:
44
C+
Give a number:
64
CONGRATULATIONS

5.2.7  Что дальше?

Данный интерпретатор Basic обладает минимумом возможностей. Тем, кто желает его обогатить, мы предлагаем следующие расширения:

  1. числа с плавающей запятой: наш интерпретатор распознает лишь целые числа, булевы значения и строки. Добавьте числа с плавающей запятой, а так же соответствующие операции в грамматику языка. Кроме лексического анализа, необходимо изменить вычисление с учетом приведения типов между целыми числами и числами с плавающей запятой.
  2. векторы: то есть добавить к синтаксису инструкцию DIM var[x], при помощи который объявляется вектор var размером x. А так же выражение var[i], которое ссылается на i–ый элемент вектора var.
  3. директивы: добавить директивы SAVE "file_name" и LOAD "file_name" для записи файла на диск и загрузки с диска соответственно.
  4. подпрограммы: вызов подпрограммы осуществляется инструкцией GOSUB номер строки. Эта инструкция реализует переход на этот номер и сохраняет при этом номер строки из которой произошел вызов. Инструкция RETURN продолжает выполнение программы со строки, которая следует за последним вызовом GOSUB, если она существует, или выходит из программы. Для этого, вычисление должно контролировать не только окружение, но и стек, в котором хранятся адреса возврата различных вызовов GOSUB. При помощи инструкции GOSUB можно объявлять рекурсивные подпрограммы.

5.3  Minesweeper

Напомним вкратце правила игры: необходимо исследовать минное поле, не попав при этом ни на одну из них. Минное поле — это двумерный массив, несколько элементов которого содержат скрытые мины, а остальные пусты. В начале игры, клетки поля закрыты и игрок должен их исследовать одну за одной. Игрок побеждает, если он исследовал все клетки поля, не содержащие мин.

На каждом этапе игры игрок может либо “открыть” клетку либо пометить ее как “заминированной”. Если он открыл клетку с миной, то игрок проигрывает. Иначе клетка меняет свой вид и в ней выводится число заминированных клеток вокруг (максимум 8). Если игрок пометил клетку как заминированную, то он не может ее открыть, не убрав метку.

Figure 5.4: Копия экрана

Разделим реализацию программы на три части.

  1. описание абстрактной игры, состоящей из внутреннего представления минного поля и функций управляющих этим представлением.
  2. графическое описание игры с соответствующими функциями рисования клеток.
  3. часть, отвечающая за взаимодействие между двумя предыдущими частями.

5.3.1  Абстрактное минное поле

В этой части мы рассмотрим минное поле как абстрактную сущность, не уделяя внимания способам вывода на экран.

Конфигурация

Минное поле характеризуется своими размерами и числом заминированных клеток. Сгруппируем эти три параметра в одной записи и определим конфигурацию по умолчанию: размер 10x10 и 15 мин.

# type config = { nbcols : int ; nbrows : int ; nbmines : int };; # let default_config = { nbcols=10; nbrows=10; nbmines=15 } ;;
Минное поле

Вполне естественно будет определить минное поле как двумерный массив. Так же нужно уточнить натуру элементов массива и информацию, которую необходимо знать для каждого из них. Состояние клетки может быть:

Последняя информация не так важна, это значение можно вычислить в нужный момент. Но будет проще сделать данный расчет раз и навсегда в начале игры.

Клетка представлена записью с четырьмя полями, хранящими вышеуказанную информацию.

# type cell = { mutable mined : bool ; mutable seen : bool ; mutable flag : bool ; mutable nbm : int } ;;

Двумерный массив есть вектор векторов клеток.

# type board = cell array array ;;
Итератор

Далее в программе нам понадобится применять функцию к каждой клетке поля. Реализуем универсальный итератор iter_cells, который применяет указанную функцию f к каждому элементу массива конфигурации cf.

# let iter_cells cf f = for i=0 to cf.nbcols-1 do for j=0 to cf.nbrows-1 do f (i,j) done done ;; val iter_cells : config -> (int * int -> 'a) -> unit = <fun>

Здесь мы получили хорошее сочетание функционального и императивного стилей. Для итеративного применения функции с побочным эффектом (она не возвращает результат) ко всем элементам массива, используется функция высшего порядка (функция, аргумент которой есть другая функция).

Инициализация

Расположение заминированных клеток будет определяться случайно. Для r и c, число линий и колонок заминированного поля, и m число мин, необходимо получить список состоящий из m чисел в интервале от 1 до r*c. В алгоритме подразумевается, что m<r*c, однако необходимо сделать эту проверку в программе.

Простым решением этой задачи будет создание пустого списка. Затем мы генерируем случайное число и размещаем его в список, если оно уже не принадлежит списку. Повторим эту операцию до тех пор, пока в списке не будет m чисел. Для этих целей, воспользуемся следующими функциями из модулей Random и Sys:

Random.int
:int->int для входного аргумента n возвращает случайное число в диапазоне от 0 до n−1.
Random.init
: int->unit инициализация генератора случайных чисел.
Sys.time
: unit->float возвращает время использования процессора в миллисекундах с начала запуска программы. Эта функция используется при инициализации генератора случайных чисел при каждой новой игре.

Модули, содержащие эти функции, описаны в главе 7 на страницах ?? и ?? соответственно.

У функции, случайно выбирающей заминированные клетки, два аргумента: общее число клеток (cr) и число мин(m). Она возвращает список из m линейных координат.

# let random_list_mines cr m = let cell_list = ref [] in while (List.length !cell_list) < m do let n = Random.int cr in if not (List.mem n !cell_list) then cell_list := n :: !cell_list done ; !cell_list ;; val random_list_mines : int -> int -> int list = <fun>

Мы не можем заявить что эта функция, так она написана, закончится через определенное число итераций. Если генератор случайных чисел достаточно хороший, то можно лишь с уверенностью сказать, что вероятность того что эта функция не закончится равна нулю. Откуда мы получаем парадоксальное суждение: <<функция закончится если она выполняется бесконечно>>. Однако, на практике эта функция никогда нас не подводила, поэтому удовольствуемся данным негарантированным определением для генерации списка заминированных клеток.

Для того, чтобы при каждой новой игре получить разные заминированные клетки, нужно инициализировать генератор случайных чисел. Инициализировать будем при помощи процессорного времени в миллисекундах, которое истекло с момента запуска программы.

# let generate_seed () = let t = Sys.time () in let n = int_of_float (t*.1000.0) in Random.init(n mod 100000) ;; val generate_seed : unit -> unit = <fun>

Практика показывает, что одна и та же программа затрачивает в среднем одинаковое время, из–за чего мы получаем схожий результат функции generate_seed. В связи с этим, функция Unix.time предпочтительней (см. гл. 17).

Во время инициализации минного поля, а так же в ходе игры, необходимо знать для данной клетки число окружающих заминированных клеток (функция neighbors). При вычислении множества соседних клеток, мы учитываем крайние клетки, у которых меньше соседей, чем у тех что находятся в середине поля (функция valid).

# let valid cf (i,j) = i>=0 && i<cf.nbcols && j>=0 && j<cf.nbrows ;; val valid : config -> int * int -> bool = <fun> # let neighbors cf (x,y) = let ngb = [x-1,y-1; x-1,y; x-1,y+1; x,y-1; x,y+1; x+1,y-1; x+1,y; x+1,y+1] in List.filter (valid cf) ngb ;; val neighbors : config -> int * int -> (int * int) list = <fun>

Инициализация минного поля реализуется функцией initialize_board, она выполняет четыре задачи:

  1. генерация списка заминированных клеток
  2. создание двумерного массива состоящего из разных клеток
  3. пометка заминированных клеток
  4. вычисление количества заминированных соседних клеток для каждой незаминированой клетки

В этой функции используется несколько локальных функций, которые мы вкратце опишем.

# let initialize_board cf = let cell_init () = { mined=false; seen=false; flag=false; nbm=0 } in let copy_cell_init b (i,j) = b.(i).(j) <- cell_init() in let set_mined b n = b.(n / cf.nbrows).(n mod cf.nbrows).mined <- true in let count_mined_adj b (i,j) = let x = ref 0 in let inc_if_mined (i,j) = if b.(i).(j).mined then incr x in List.iter inc_if_mined (neighbors cf (i,j)) ; !x in let set_count b (i,j) = if not b.(i).(j).mined then b.(i).(j).nbm <- count_mined_adj b (i,j) in let list_mined = random_list_mines (cf.nbcols*cf.nbrows) cf.nbmines in let board = Array.make_matrix cf.nbcols cf.nbrows (cell_init ()) in iter_cells cf (copy_cell_init board) ; List.iter (set_mined board) list_mined ; iter_cells cf (set_count board) ; board ;; val initialize_board : config -> cell array array = <fun>
Открытие клетки

Если во время игры игрок открывает клетку у которой нет ни одного заминированного соседа, он с уверенностью может открыть соседние клетки, до тех пор пока есть такие клетки. Для того, чтобы избавить игрока от этой нудного момента игры, не требующего размышления, игра сама откроет нужные клетки в этом случае. При открытии клетки функция cells_to_see возвращает список клеток которые можно открыть.

Идея алгоритма достаточно просто излагается: если у открытой клетки есть заминированные соседи, то список ограничивается лишь этой самой клеткой, иначе список состоит из ее соседей, а так же из соседей ее соседей. Трудность состоит в том, чтобы написать незацикливающуюся программу, так как клетка является соседом самой себе. Надо избежать проверки по несколько раз одной и той же клетки поля. Для того, чтобы знать какая клетка была открыта, создадим вектор visited булевых значений. Размер вектора соответствует количеству клеток. Если элемент вектора равен true, это значит что соответствующая клетка была исследована. Рекурсивный поиск клеток осуществляется только среди непомеченных клеток.

Используя список соседних клеток, функция relevant, вычисляет два под–списка. Каждый под–список состоит из незаминированных, неоткрытых, непомеченных игроком и непроверенных клеток (которым соответствует значение false в векторе visited, прим. пер.). Первый под–список включает соседей, у которых есть как минимум один заминированных сосед, второй состоит из соседних клеток без заминированных соседей. Эти клетки помечаются как проверенные. Заметим, что помеченные игроком клетки, даже если они на самом деле незаминированы, исключаются из списков. Смысл метки заключается как раз в том, чтобы избежать открытия клетки.

Функция cells_to_see_rec рекурсивно реализует цикл поиска. Исходя из обновляемого списка клеток, которые необходимо проверить, она возвращает список клеток, которые будут открыты. Начальный список содержит лишь последнюю открытую клетку, которая помечена как проверенная.

# let cells_to_see bd cf (i,j) = let visited = Array.make_matrix cf.nbcols cf.nbrows false in let rec relevant = function [] -> ([],[]) | ((x,y) as c)::t -> let cell=bd.(x).(y) in if cell.mined || cell.flag || cell.seen || visited.(x).(y) then relevant t else let (l1,l2) = relevant t in visited.(x).(y) <- true ; if cell.nbm=0 then (l1,c::l2) else (c::l1,l2) in let rec cells_to_see_rec = function [] -> [] | ((x,y) as c)::t -> if bd.(x).(y).nbm<>0 then c :: (cells_to_see_rec t) else let (l1,l2) = relevant (neighbors cf c) in (c :: l1) @ (cells_to_see_rec (l2 @ t)) in visited.(i).(j) <- true ; cells_to_see_rec [(i,j)] ;; val cells_to_see : cell array array -> config -> int * int -> (int * int) list = <fun>

С первого взгляда, аргумент cells_to_see_rec увеличивается между двумя последовательными вызовами функции, тогда как рекуррентное отношение основывается на этом аргументе. Соответственно, может возникнуть вопрос — заканчивается ли эта функция? Использование вектора visited гарантирует, что уже проверенная клетка не будет включена в результат relevant. В то же время, клетки, которые добавляются в список проверяемых клеток, происходят из relevant. Этим гарантируется, что определенная клетка будет возвращена relevant всего один раз и в следствии она будет представлена в единственном экземпляре в списке проверяемых клеток. Раз количество клеток ограничено, значит наша функция тоже закончится.

На этом неграфическая часть игры заканчивается. Рассмотрим стиль программирования, которым мы воспользовались. Выбор изменяемых структур данных вынуждает использовать императивный стиль с циклами и присвоением. Однако, для решения дополнительных задач мы применили списки и функции обработки в функциональном стиле. Стиль программирования предписывается структурами данных, которыми мы манипулируем. Функция cells_to_see тому хороший пример: она использует списки и, вполне естественно, эта функция написана в функциональном стиле. Для хранения информации о проверенных клетках мы используем вектор, обновление вектора осуществляется императивно. Конечно, мы могли бы сделать тоже самое в чисто функциональном стиле, используя список. Однако, цена этого решения выше, чем для предыдущего (поиск элемента в списке напрямую зависит от размера списка, тогда как для вектора время поиск есть константная величина) и оно не является более простым.

5.3.2  Игровой интерфейс

Эта часть игры зависит от структур данных, которые представляют состояние игры (см. стр. ??). Цель этой части — изобразить на экране различные компоненты игры, как на рисунке 5.5. Для этого воспользуемся функциями рисования блоков, описанными ранее на стр. ??.

Figure 5.5: Основное окно игры

Свойства различных компонентов игры описываются следующими параметрами.

# let b0 = 3 ;; # let w1 = 15 ;; # let w2 = w1 ;; # let w4 = 20 + 2*b0 ;; # let w3 = w4*default_config.nbcols + 2*b0 ;; # let w5 = 40 + 2*b0 ;;
# let h1 = w1 ;; # let h2 = 30 ;; # let h3 = w5+20 + 2*b0 ;; # let h4 = h2 ;; # let h5 = 20 + 2*b0 ;; # let h6 = w5 + 2*b0 ;;

При помощи этих параметров мы расширим базовую конфигурацию игры (значения с типом config) и определим новую запись window_config. В поле cf содержится минимальная конфигурация. Каждой компоненте, изображенной на экране, ассоциируем блок: основное окно (поле main_box), минное поле (поле field_box), диалоговое окно (поле dialog_box) из двух блоков (поля d1_box и d2_box), кнопка для пометки (поле flag_box) и текущая клетка (поле current_box).

# type window_config = { cf : config ; main_box : box_config ; field_box : box_config ; dialog_box : box_config ; d1_box : box_config ; d2_box : box_config ; flag_box : box_config ; mutable current_box : box_config ; cell : int*int -> (int*int) ; coor : int*int -> (int*int) } ;;

Кроме этого, значение с типом window_config содержит две функции:

Конфигурация

Определим функцию, которая создает графическую конфигурацию (с типом window_config) в соответствии с минимальной конфигурацией (с типом config) и вышеописанных параметров. Значения параметров некоторых компонент зависят друг от друга. Например, ширина основного блока зависит от ширины блока минного поля, которых в свою очередь зависит от количества столбцов. Чтобы не вычислять одно и то же по несколько раз, мы будем постепенно инициализировать эти поля. В отсутствии специальных функций данный этап инициализации немного нудный.

# let make_box x y w h bw r = { x=x; y=y; w=w; h=h; bw=bw; r=r; b1_col=gray1; b2_col=gray3; b_col=gray2 } ;; val make_box : int -> int -> int -> int -> int -> relief -> box_config = <fun> # let make_wcf cf = let wcols = b0 + cf.nbcols*w4 + b0 and hrows = b0 + cf.nbrows*h5 + b0 in let main_box = let gw = (b0 + w1 + wcols + w2 + b0) and gh = (b0 + h1 + hrows + h2 + h3 + h4 + b0) in make_box 0 0 gw gh b0 Top and field_box = make_box w1 h1 wcols hrows b0 Bot in let dialog_box = make_box ((main_box.w - w3) / 2) (b0+h1+hrows+h2) w3 h3 b0 Bot in let d1_box = make_box (dialog_box.x + b0) (b0 + h1 + hrows + h2) ((w3-w5)/2-(2*b0)) (h3-(2*b0)) 5 Flat in let flag_box = make_box (d1_box.x + d1_box.w) (d1_box.y + (h3-h6) / 2) w5 h6 b0 Top in let d2_box = make_box (flag_box.x + flag_box.w) d1_box.y d1_box.w d1_box.h 5 Flat in let current_box = make_box 0 0 w4 h5 b0 Top in { cf = cf; main_box = main_box; field_box=field_box; dialog_box=dialog_box; d1_box=d1_box; flag_box=flag_box; d2_box=d2_box; current_box = current_box; cell = (fun (i,j) -> ( w1+b0+w4*i , h1+b0+h5*j)) ; coor = (fun (x,y) -> ( (x-w1)/w4 , (y-h1)/h5 )) } ;; val make_wcf : config -> window_config = <fun>
Вывод клеток

Теперь нам предстоит определить функции вывода клеток в различных случаях: клетка может быть открыта или закрыта, содержать или нет информацию. Вывод (блока) текущей клетки всегда будет осуществляться (поле cc_bcf).

Определим две функции изменяющие конфигурацию текущей клетки; одна закрывает клетку, другая открывает ее.

# let close_ccell wcf i j = let x,y = wcf.cell (i,j) in wcf.current_box <- {wcf.current_box with x=x; y=y; r=Top} ;; val close_ccell : window_config -> int -> int -> unit = <fun> # let open_ccell wcf i j = let x,y = wcf.cell (i,j) in wcf.current_box <- {wcf.current_box with x=x; y=y; r=Flat} ;; val open_ccell : window_config -> int -> int -> unit = <fun>

В зависимости от ситуации, необходимо выводить информацию на клетках. Для каждого случая мы определяем функцию.

Вывод закрытой клетки:

# let draw_closed_cc wcf i j = close_ccell wcf i j; draw_box wcf.current_box ;; val draw_closed_cc : window_config -> int -> int -> unit = <fun>

Вывести открытую клетку с числом мин:

# let draw_num_cc wcf i j n = open_ccell wcf i j ; draw_box wcf.current_box ; if n<>0 then draw_string_in_box Center (string_of_int n) wcf.current_box Graphics.white ;; val draw_num_cc : window_config -> int -> int -> int -> unit = <fun>

Вывод клетки, содержащей мину:

# let draw_mine_cc wcf i j = open_ccell wcf i j ; let cc = wcf.current_box in draw_box wcf.current_box ; Graphics.set_color Graphics.black ; Graphics.fill_circle (cc.x+cc.w/2) (cc.y+cc.h/2) (cc.h/3) ;; val draw_mine_cc : window_config -> int -> int -> unit = <fun>

Вывод заминированной и помеченной клетки:

# let draw_flag_cc wcf i j = close_ccell wcf i j ; draw_box wcf.current_box ; draw_string_in_box Center "!" wcf.current_box Graphics.blue ;; val draw_flag_cc : window_config -> int -> int -> unit = <fun>

Вывод ошибочно помеченной клетки:

# let draw_cross_cc wcf i j = let x,y = wcf.cell (i,j) and w,h = wcf.current_box.w, wcf.current_box.h in let a=x+w/4 and b=x+3*w/4 and c=y+h/4 and d=y+3*h/4 in Graphics.set_color Graphics.red ; Graphics.set_line_width 3 ; Graphics.moveto a d ; Graphics.lineto b c ; Graphics.moveto a c ; Graphics.lineto b d ; Graphics.set_line_width 1 ;; val draw_cross_cc : window_config -> int -> int -> unit = <fun>

В ходе игры, выбор соответствующей функции вывода клетки осуществляется следующим:

# let draw_cell wcf bd i j = let cell = bd.(i).(j) in match (cell.flag, cell.seen , cell.mined ) with (true,_,_) -> draw_flag_cc wcf i j | (_,false,_) -> draw_closed_cc wcf i j | (_,_,true) -> draw_mine_cc wcf i j | _ -> draw_num_cc wcf i j cell.nbm ;; val draw_cell : window_config -> cell array array -> int -> int -> unit = <fun>

Для вывода клеток в конце игры, воспользуемся специальной функцией. Она немного отличается от предыдущих тем, что к концу все клетки должны быть открыты. К тому же, на ошибочно помеченных клетках выводится красный крест.

# let draw_cell_end wcf bd i j = let cell = bd.(i).(j) in match (cell.flag, cell.mined ) with (true,true) -> draw_flag_cc wcf i j | (true,false) -> draw_num_cc wcf i j cell.nbm; draw_cross_cc wcf i j | (false,true) -> draw_mine_cc wcf i j | (false,false) -> draw_num_cc wcf i j cell.nbm ;; val draw_cell_end : window_config -> cell array array -> int -> int -> unit = <fun>
Вывод остальных компонентов

Состояние режима отметки клеток отображается выпуклым или вогнутым блоком с надписью ON или OFF:

# let draw_flag_switch wcf on = if on then wcf.flag_box.r <- Bot else wcf.flag_box.r <- Top ; draw_box wcf.flag_box ; if on then draw_string_in_box Center "ON" wcf.flag_box Graphics.red else draw_string_in_box Center "OFF" wcf.flag_box Graphics.blue ;; val draw_flag_switch : window_config -> bool -> unit = <fun>

Выведем надпись о предназначении помечающей кнопки.

# let draw_flag_title wcf = let m = "Flagging" in let w,h = Graphics.text_size m in let x = (wcf.main_box.w-w)/2 and y0 = wcf.dialog_box.y+wcf.dialog_box.h in let y = y0+(wcf.main_box.h-(y0+h))/2 in Graphics.moveto x y ; Graphics.draw_string m ;; val draw_flag_title : window_config -> unit = <fun>

На протяжении всей игры число клеток, которые осталось открыть и число помеченных клеток выводится в диалоговом окне с обеих сторон помечающей кнопки.

# let print_score wcf nbcto nbfc = erase_box wcf.d1_box ; draw_string_in_box Center (string_of_int nbcto) wcf.d1_box Graphics.blue ; erase_box wcf.d2_box ; draw_string_in_box Center (string_of_int (wcf.cf.nbmines-nbfc)) wcf.d2_box ( if nbfc>wcf.cf.nbmines then Graphics.red else Graphics.blue ) ;; val print_score : window_config -> int -> int -> unit = <fun>

Чтобы нарисовать начальное минное поле, нужно вывести (число линий)×(число столбцов) раз закрытую клетку. Хоть это и один и тот же рисунок каждый раз необходимо нарисовать и заполнить прямоугольный и четыре трапеции, на это может уйти немало времени. Для ускорения этого процесса, воспользуемся следующей техникой: нарисуем один раз клетку, захватим ее в виде растрового изображения (bitmap) и затем скопируем эту кнопку в нужных местах.

# let draw_field_initial wcf = draw_closed_cc wcf 0 0 ; let cc = wcf.current_box in let bitmap = draw_box cc ; Graphics.get_image cc.x cc.y cc.w cc.h in let draw_bitmap (i,j) = let x,y=wcf.cell (i,j) in Graphics.draw_image bitmap x y in iter_cells wcf.cf draw_bitmap ;; val draw_field_initial : window_config -> unit = <fun>

В конце игры, все минное поле открывается и на неправильно помеченных клетках ставится красный крест.

# let draw_field_end wcf bd = iter_cells wcf.cf (fun (i,j) -> draw_cell_end wcf bd i j) ;; val draw_field_end : window_config -> cell array array -> unit = <fun>

И наконец, основная функция вывода на экран открывает графический контекст и выводит начальное состояние различных компонент.

# let open_wcf wcf = Graphics.open_graph ( " " ^ (string_of_int wcf.main_box.w) ^ "x" ^ (string_of_int wcf.main_box.h) ) ; draw_box wcf.main_box ; draw_box wcf.dialog_box ; draw_flag_switch wcf false ; draw_box wcf.field_box ; draw_field_initial wcf ; draw_flag_title wcf ; print_score wcf ((wcf.cf.nbrows*wcf.cf.nbcols)-wcf.cf.nbmines) 0 ;; val open_wcf : window_config -> unit = <fun>

Заметим, что все графические функции используют конфигурацию с типом window_config. Это делает их независимыми от расположения компонент игры. Если мы пожелаем изменить это расположение, код функций останется неизменным, необходимо будет лишь обновить конфигурацию.

5.3.3  Взаимодействие между программой и игроком

Определим возможные действия игрока:

Напомним, что событие Graphics должно быть связанно с записью (Graphics.status), в которой хранится информация о текущем состоянии клавиатуры и мыши в момент возникновения события. Все события мыши, кроме нажатия на кнопку пометки или на клетку минного поля, игнорируются. Чтобы различать оба события, создадим соответствующий тип.

# type clickon = Out | Cell of (int*int) | SelectBox ;;

Действия нажатия и отпускания кнопки мыши соответствуют двум разным событиям. Если оба события произошли на одной и той же компоненте (клетка минного поля или кнопка пометки), то такой клик считается правильным о обрабатывается.

# let locate_click wcf st1 st2 = let clickon_of st = let x = st.Graphics.mouse_x and y = st.Graphics.mouse_y in if x>=wcf.flag_box.x && x<=wcf.flag_box.x+wcf.flag_box.w && y>=wcf.flag_box.y && y<=wcf.flag_box.y+wcf.flag_box.h then SelectBox else let (x2,y2) = wcf.coor (x,y) in if x2>=0 && x2<wcf.cf.nbcols && y2>=0 && y2<wcf.cf.nbrows then Cell (x2,y2) else Out in let r1=clickon_of st1 and r2=clickon_of st2 in if r1=r2 then r1 else Out ;; val locate_click : window_config -> Graphics.status -> Graphics.status -> clickon = <fun>

Сердце программы находится в функции loop и заключается в ожидании и обработке событий. Эта функция похожа на skel, описанной на странице ??, однако здесь мы точнее определяем тип события мыши. Условия остановки цикла следующие:

Объединим данные, необходимые функциям обрабатывающим взаимодействие с игроком, в записи minesw_cf.

# type minesw_cf = { wcf : window_config; bd : cell array array; mutable nb_flagged_cells : int; mutable nb_hidden_cells : int; mutable flag_switch_on : bool } ;;

Эти поля соответствуют:

Теперь мы готовы, к тому чтобы написать основной цикл.

# let loop d f_init f_key f_mouse f_end = f_init (); try while true do let st = Graphics.wait_next_event [Graphics.Button_down;Graphics.Key_pressed] in if st.Graphics.keypressed then f_key st.Graphics.key else let st2 = Graphics.wait_next_event [Graphics.Button_up] in f_mouse (locate_click d.wcf st st2) done with End -> f_end ();; val loop : minesw_cf -> (unit -> 'a) -> (char -> 'b) -> (clickon -> 'b) -> (unit -> unit) -> unit = <fun>

Функции инициализации, окончания и обработки клавиатуры достаточно банальны.

# let d_init d () = open_wcf d.wcf let d_end () = Graphics.close_graph() let d_key c = if c='q' || c='Q' then raise End;; val d_init : minesw_cf -> unit -> unit = <fun> val d_end : unit -> unit = <fun> val d_key : char -> unit = <fun>

Для обработки событий мыши нам понадобится несколько дополнительных функций.

# let flag_cell d i j = if d.bd.(i).(j).flag then ( d.nb_flagged_cells <- d.nb_flagged_cells -1; d.bd.(i).(j).flag <- false ) else ( d.nb_flagged_cells <- d.nb_flagged_cells +1; d.bd.(i).(j).flag <- true ); draw_cell d.wcf d.bd i j; print_score d.wcf d.nb_hidden_cells d.nb_flagged_cells;; val flag_cell : minesw_cf -> int -> int -> unit = <fun> # let ending d str = draw_field_end d.wcf d.bd; erase_box d.wcf.flag_box; draw_string_in_box Center str d.wcf.flag_box Graphics.black; ignore(Graphics.wait_next_event [Graphics.Button_down;Graphics.Key_pressed]); raise End;; val ending : minesw_cf -> string -> 'a = <fun> # let reveal d i j = let reveal_cell (i,j) = d.bd.(i).(j).seen <- true; draw_cell d.wcf d.bd i j; d.nb_hidden_cells <- d.nb_hidden_cells -1 in List.iter reveal_cell (cells_to_see d.bd d.wcf.cf (i,j)); print_score d.wcf d.nb_hidden_cells d.nb_flagged_cells; if d.nb_hidden_cells = 0 then ending d "WON";; val reveal : minesw_cf -> int -> int -> unit = <fun>

Функция, обрабатывающая события мыши, сопоставляет значение типа clickon.

# let d_mouse d click = match click with Cell (i,j) -> if d.bd.(i).(j).seen then () else if d.flag_switch_on then flag_cell d i j else if d.bd.(i).(j).flag then () else if d.bd.(i).(j).mined then ending d "LOST" else reveal d i j | SelectBox -> d.flag_switch_on <- not d.flag_switch_on; draw_flag_switch d.wcf d.flag_switch_on | Out -> () ;; val d_mouse : minesw_cf -> clickon -> unit = <fun>

При создании конфигурации игры, нам необходимо три параметра: число линий, число колонок и число мин.

# let create_minesw nb_c nb_r nb_m = let nbc = max default_config.nbcols nb_c and nbr = max default_config.nbrows nb_r in let nbm = min (nbc*nbr) (max 1 nb_m) in let cf = { nbcols=nbc ; nbrows=nbr ; nbmines=nbm } in generate_seed () ; let wcf = make_wcf cf in { wcf = wcf ; bd = initialize_board wcf.cf; nb_flagged_cells = 0; nb_hidden_cells = cf.nbrows*cf.nbcols-cf.nbmines; flag_switch_on = false } ;; val create_minesw : int -> int -> int -> minesw_cf = <fun>

Функция, запускающая игру, сначала создает конфигурацию игры с помощью трех выше указанных параметров и запускает цикл обработки событий.

# let go nbc nbr nbm = let d = create_minesw nbc nbr nbm in loop d (d_init d) d_key (d_mouse d) (d_end);; val go : int -> int -> int -> unit = <fun>

Вызов go 10 10 10 запускает игру, показную на изображении 5.4.

Что дальше?

Из данной программы можно сделать самостоятельный исполняемый файл. В главе 6 объяснено как это сделать. После этого, можно сделать игру более удобной, передавая размер минного поля в командной строке. Передача аргументов рассматривается в главе 7, где приводится пример для данной игры (см. стр. ??).

Другое интересное расширение — научить машину саму открывать клетки. Для этого необходимо уметь определять следующий правильный ход и играть его первым в этом случае. Затем вычислить вероятность присутствия мины для каждой клетки и играть клетку, для которой это значение минимально.

Previous Up Next